*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/28 16:24:25  mclareni
* Initial revision
*
*
#include "hepdb/pilot.h"
#if defined(CERNLIB__P3CHILD)
* Ignoring t=dummy
#endif
      SUBROUTINE CDKXIN (ITIME, IUDIV, LU, LSUP, JBIAS, NWKEY, KEY,
     +                   IPREC, IRC)
*     =============================================================
*
************************************************************************
*                                                                      *
*        SUBR. CDKXIN (ITIME, IUDIV, LU*, LSUP, JBIAS, NWKEY*, *KEY*,  *
*                      IPREC*, IRC*)                                   *
*                                                                      *
*   Fetches from disk to a ZEBRA bank data valid for a given time      *
*                                                                      *
*   Restrictions : This routine is called internally by other routines *
*                  in HEPDB. One should be very careful in using this  *
*                  routine. For example, the character option for      *
*                  special selection scheme like options S or N in     *
*                  CDUSEM is not present in this routine and they can  *
*                  be switched on or off only by a prior call to CDUSEM*
*                                                                      *
*   Arguments :                                                        *
*                                                                      *
*     ITIME    Time for which data are required to be valid            *
*     IUDIV    Division index where bank is expected                   *
*     LU       Address of the bank in memory                           *
*     LSUP     Supporting link of the bank (see MZBOOK)                *
*     JBIAS    Link bias for creating the data bank (see MZBOOK)       *
*     NWKEY    Number of key elements                                  *
*     KEY      Vector of keys (On input if any key beyond element 8 or *
*              element 5 is nonzero,data are retrieved according to its*
*              content; on output it contains the key elements for the *
*              current data)                                           *
*     IPREC    Precision word; (If IPREC > 0, data are stored with     *
*              IPREC significant digits right to the decimal points; if*
*              IPREC < 0, data are stored with IPREC insignificant     *
*              digits left to the decimal point.)                      *
*     IRC      Return code (see below)                                 *
*                                                                      *
*   Called by CDCHCK, CDGETDB,CDGNAM, CDPART, CDPRDT, CDPURK, CDRHLP,  *
*             CDRNAM, CDRTFZ, CDUSP3                                   *
*                                                                      *
*   Error Condition :                                                  *
*                                                                      *
*     IRC       =  0 : No error                                        *
*               = 31 : Illegal Pathname                                *
*               = 33 : No valid data for the given set of keys and     *
*                      program version number                          *
*               = 35 : Wrong reference to data objects in update mode  *
*                                                                      *
************************************************************************
*
#include "hepdb/caopts.inc"
#include "hepdb/cdcblk.inc"
#include "hepdb/ckkeys.inc"
#include "hepdb/clinks.inc"
#include "hepdb/ctkxin.inc"
#include "hepdb/ctpath.inc"
#if defined(CERNLIB__P3CHILD)
#include "hepdb/p3dbl3.inc"
#endif
      DIMENSION       ITIME(9), KEY(9), LSUP(9), LU(9)
      CHARACTER       PATHN*80
#include "zebra/q_jbit.inc"
* Ignoring t=pass
*
*     ------------------------------------------------------------------
*
#if defined(CERNLIB__P3CHILD)
      IF (IPASP3.GT.1) THEN
        IKYLCT = KEY(IDHKSN)
        IPRVCT = IKYLCT
        NWKYCK = NWKEY
        CALL UCOPY (KEY, KEYNCK, NWKEY)
        GO TO 5
      ENDIF
#endif
      IPRVCT = KEY(IDHUSI)
      NWKEY  = NWKYCK
      NKEYS  = NKEYCK
      CALL RZCDIR (PATHN, 'R')
      MAXL   = LENOCC (PATHN)
*
* *** Check the validity limits from the Keys
*
    5 NTIMCT = 0
      MNKYCT = -999
      DO 10 I = 1, NPARCD
        KYENCD(I) = IBIGCD
        INRSCT(I) = 100000
   10 CONTINUE
      IDNRCT = 0
      KEY6CT = 0
      KY6NCT = 0
      ICURCT = 1
      ISTP   = NWKYCK + 1
#if defined(CERNLIB__P3CHILD)
      IF (IPASP3.GT.1)                                      GO TO 40
#endif
      IOPTP  = JBIT (IQ(KOFSCD+LCDRCD+IKDRCD+IDHFLG), JPRTCD)
*
* *** Select by the key number
*
      IF (IOKYCA(IDHKSN).NE.0)  THEN
        IKYLCT = KEY(IDHKSN)
        IPRVCT = IKYLCT
*
        IF (IOPTP.EQ.0)  THEN
*
          IF (IKYLCT.GT.0 .AND. IKYLCT.LE.NKEYCK)  THEN
            GO TO 35
          ELSE
            GO TO 993
          ENDIF
*
        ELSE
*
          DO 15 JK = 1, NKEYCK
            IK     = NKEYCK + 1 - JK
            KPNT   = IUHUNT (IK, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
     +                       NKEYCK*ISTP, ISTP)
            IF (KPNT.NE.0) THEN
              IPNT   = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
            ELSE
              IPNT   = KOFSCD + LCDRCD + IKDRCD + (IK - 1) * ISTP
            ENDIF
            KEY5   = IQ(IPNT+MOBJCD)
            IF (IKYLCT.GT.KEY5)                             GO TO 20
   15     CONTINUE
          GO TO 993
   20     KOFF   = KEY5
          CALL CDPATH (TOP2CT, IK)
          CALL RZCDIR (TOP2CT, ' ')
          IF (IQUEST(1).NE.0)                               GO TO 991
          IKYLCT = KEY(IDHKSN) - KOFF
*
*     Check not valid in case of deleted keys
*
*         IF (IKYLCT.GT.IQUEST(7)) THEN
*           GO TO 993
*         ELSE
            NKEYCK = IQUEST(7)
            NWKYCK = IQUEST(8)
            LCDRCD = IQUEST(11)
            IKDRCD = IQUEST(13)
            CALL CDKEYT
            ISTP   = NWKYCK + 1
            GO TO 35
*         ENDIF
        ENDIF
*
      ENDIF
*
* *** Select by the Key values
*
      IF (IOPTP.EQ.0)  THEN
*
        CALL CDSEKY (ITIME, KEY)
*
      ELSE
*
        DO 25 JK = 1, NKEYS
          ICURCT = NKEYS + 1 - JK
          CALL CDPATH (TOP2CT, ICURCT)
          IF (JK.NE.1) THEN
            CALL RZCDIR (PATHN, ' ')
            IF (IQUEST(1).NE.0)                             GO TO 991
            LCDRCD = IQUEST(11)
            IKDRCD = IQUEST(13)
          ENDIF
          KPNT   = IUHUNT (ICURCT, IQ(KOFSCD+LCDRCD+IKDRCD+MPSRCD),
     +                     NKEYS*ISTP, ISTP)
          IF (KPNT.NE.0) THEN
            IPNT   = KOFSCD + LCDRCD + IKDRCD + KPNT - MPSRCD
          ELSE
            IPNT   = KOFSCD + LCDRCD + IKDRCD + (ICURCT - 1) * ISTP
          ENDIF
          CALL CDPSEL (ITIME, KEY, IQ(IPNT+1), 0, ISEL)
          IF (ISEL.NE.0)                                    GO TO 25
*
          CALL RZCDIR (TOP2CT, ' ')
          IF (IQUEST(1).NE.0)                               GO TO 991
          NKEYCK = IQUEST(7)
          LCDRCD = IQUEST(11)
          IKDRCD = IQUEST(13)
          CALL CDSEKY (ITIME, KEY)
          IF (NTIMCT.NE.0 .AND. JBIT(KEY6CT,JIGNCD).EQ.0)   GO TO 30
*
   25   CONTINUE
*
      ENDIF
*
* *** Check if valid data exist
*
   30 ISTP   = NWKYCK + 1
      IF (NTIMCT.EQ.0 .OR. JBIT(KEY6CT,JIGNCD).NE.0)  THEN
*
        IF (KY6NCT.NE.0)  THEN
          IKYLCT = KY6NCT
*
        ELSE IF (IOPNCA.NE.0 .AND. IDNRCT.NE.0)  THEN
*
*  **     Take the nearest neighbour
*
          NTIMCT = -1
          IKYLCT = IDNRCT
          IF (IOPTP.NE.0 .AND. IUSECT.NE.ICURCT)  THEN
            CALL CDPATH (TOP2CT, IUSECT)
            PAT2CT = PATHN(1:MAXL)//'/'//TOP2CT
            CALL RZCDIR (PAT2CT, ' ')
            IF (IQUEST(1).NE.0)                             GO TO 991
            NKEYCK = IQUEST(7)
            LCDRCD = IQUEST(11)
            IKDRCD = IQUEST(13)
          ENDIF
#if defined(CERNLIB__DEBUG)
          IF (IDEBCD.GT.1)  THEN
            IPNT   = KOFSCD + LCDRCD + IKDRCD + (IDNRCT - 1) * ISTP
            IARGCD(1) = ITIME(1)
            IARGCD(2) = IQ(IPNT+NOF1CK+1)
            IARGCD(3) = IQ(IPNT+NOF1CK+2)
            CALL CDPRNT (LPRTCD, '(/,'' CDKXIN : Warning --> Data val'//
     +           'id at time '',I10,'' does not exist. Data valid bet'//
     +           'ween '',2I10,'' are returned'')', IARGCD, 3)
          ENDIF
#endif
*
        ELSE
*
*  **     None exists; return with error message
*
          GO TO 993
*
        ENDIF
*
      ENDIF
*
* *** Read in the data
*
   35 ICYCL  = 9999
      CALL CDKEYR (IKYLCT, NWKYCK, KEYNCK)
   40 KEY6CT = KEYNCK(IDHFLG)
      IF (JBIT(KEY6CT,JIGNCD).NE.0) GO TO 993
      KEY(IDHKSN) = IKYLCT
      LSTRCL(2) = 0
      IF (NTIMCT.EQ.-1) THEN
        DO 45 I = 1, NPARCD-1
          KYENCD(I) = KEYNCK(NOF1CK+2*I-1)
   45   CONTINUE
        KYENCD(NPARCD) = KEYNCK(NOF1CK+2*NPARCD-1) + 1
      ENDIF
*
      IF (IOPKCA.NE.0)  THEN
*
*  **   Only the keys are needed
*
        CALL UCOPY (KEYNCK, KEY, NWKYCK)
*
      ELSE IF (JBIT(KEY6CT,JRZUCD) .NE. 0)  THEN
*
*  **   Data are stored in RZ way
*
        LSTRCL(2) = LSUP(1)
        CALL CDRZIN (IUDIV, LSTRCL(2), JBIAS, KEY, ICYCL, PATHN, IRC)
        LSUP(1) = LSTRCL(2)
        LSTRCL(2) = 0
        IF (JBIAS.GT.0)  THEN
          LU(1)  = LSUP(1)
        ELSE
          LU(1)  = LQ(KOFUCD+LSUP(1)+JBIAS)
        ENDIF
        IF (IRC.NE.0)                                       GO TO 998
*
        CALL UCOPY (KEYNCK, KEY, NWKYCK)
*
      ELSE
*
*  **   Read in standard DB format
*
        CALL CDRZIN (IDISCD, LSTRCL(2), 2, KEY, ICYCL, PATHN, IRC)
        IF (IRC.NE.0)                                       GO TO 998
        CALL UCOPY (KEYNCK, KEY, NWKYCK)
*
*  **   If the data is update - uncompress and proceed updating
*
        IF (KEY(IDHPTR).NE.0)  THEN
#if defined(CERNLIB__P3CHILD)
          IF (IPASP3.EQ.2) THEN
            IK   = 1
            GO TO 55
          ENDIF
#endif
          DO 50 I = 1, NKEYCK
            IPNT   = KOFSCD + LCDRCD + IKDRCD + ISTP * (I-1)
            IF (KEY(IDHPTR).EQ.IQ(IPNT+IDHKSN))  THEN
              IK     = I
#if defined(CERNLIB__P3CHILD)
              IF (IPASP3.EQ.1) THEN
                IRC    = 0
                CALL CDRZIN (IDISCD, LREFCD(5), 2, IK, ' ', IRC)
                GO TO 998
              ENDIF
#endif
              GO TO 55
            ENDIF
   50     CONTINUE
          GO TO 995
*
   55     CALL CDUNCP (LSTRCL(2), LREFCL(3), IK, IRC)
        ELSE
#if defined(CERNLIB__P3CHILD)
          IF (IPASP3.EQ.1) THEN
            IRC    = 0
            GO TO 998
          ENDIF
#endif
          CALL CDUNCP (LSTRCL(2), LREFCL(3), 0, IRC)
        ENDIF
*
*  **   Drop the compressed data
*
        CALL MZDROP (IDISCD, LSTRCL(2), ' ')
        IF (IRC.NE.0)                                       GO TO 998
*
*  **   Copy from internal Data Base system to user format
*
        CALL CDTOUS (LREFCL(3), IUDIV, LU(1), LSUP(1),JBIAS, IPREC, IRC)
*
        CALL MZDROP (IDISCD, LREFCL(3), ' ')
        IF (IRC.NE.0)                                       GO TO 998
*
      ENDIF
      GO TO 998
*
* *** Error messages
*
  991 IRC    = 31
#if defined(CERNLIB__DEBUG)
      IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKXIN : Illegal '//
     +   'path name '//PATHN//TOP2CT(1:8)//''')', IARGCD, 0)
#endif
      GO TO 999
*
  993 IRC    = 33
#if defined(CERNLIB__DEBUG)
      IF (IDEBCD.GT.0) THEN
        IARGCD(1) = IPRVCT
        CALL UCOPY (ITIME, IARGCD(2), NPARCD)
        NARG      = MIN (4, NPARCD+1)
        CALL CDPRNT (LPRTCD, '(/,'' CDKXIN : No valid data can be fou'//
     +       'nd for Program Version'',I6,'' and ISEL'',3I10)', IARGCD,
     +       NARG)
      ENDIF
#endif
      GO TO 998
*
  995 IRC    = 35
      IQUEST(11)= KEY(IDHPTR)
#if defined(CERNLIB__DEBUG)
      IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDKXIN : Key 2 ref'//
     +   'erence '',I4,'' cannot be found among the Key 1 values'')',
     +   IQUEST(11), 1)
#endif
      GO TO 998
*
  998 IF (IOPTP.NE.0)  THEN
        CALL RZCDIR (PATHN, ' ')
        IF (IQUEST(1).NE.0) THEN
          IF (IRC.EQ.0)                                     GO TO 991
        ELSE
          LCDRCD = IQUEST(11)
          IKDRCD = IQUEST(13)
          NKEYCK = IQUEST(7)
          NWKYCK = IQUEST(8)
        ENDIF
      ENDIF
*                                                             END CDKXIN
  999 END
