MINICERN/packlib/zebra/rz/rzink.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:55  mclareni
   6 * Extend the include file cleanup to dzebra, rz and tq, and also add
   7 * dependencies in some cases.
   8 *
   9 * Revision 1.1.1.1  1996/03/06 10:47:24  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZINK(KEYU,ICYCLE,CHOPT)
  15 *
  16 ************************************************************************
  17 *
  18 *         To find and decode KEYU,ICYCLE
  19 * Input:
  20 *   KEYU    Keyword vector of the information to be read
  21 *   ICYCLE  Cycle number of the key to be read
  22 *           ICYCLE > highest cycle number means read the highest cycle
  23 *           ICYCLE = 0 means read the lowest cycle
  24 *   CHOPT   Character variable specifying the options selected.
  25 *           data structure
  26 *             default
  27 *                   Same as 'D' below
  28 *             'A'   Read continuation of the previously read data structure
  29 *                   with identifier KEYU,ICYCLE
  30 *                   Given that option implies that the record was written with
  31 *                   the same option by a call to RZOUT.
  32 *             'C'   Provide   information   about   the   cycle   numbers
  33 *                   associated with KEY.
  34 *                   The  total number  of  cycles  and the  cycle  number
  35 *                   identifiers of the 19 highest  cycles are returned in
  36 *                   IQUEST(50) and IQUEST(51..89) respectively
  37 *             'D'   Read the  Data structure  with the  (key,cycle)  pair
  38 *                   specified.
  39 *             'N'   Read the neighbouring. keys (i.e. those preceding and
  40 *                   following KEY).
  41 *                   The  key-vectors of  the previous  and  next key  are
  42 *                   available   respectively   as   IQUEST(31..35)    and
  43 *                   IQUEST(41..45), see below.
  44 *             'R'   Read data into existing bank at LSUP,JBIAS
  45 *             'S'   KEYU(1) contains the key serial number
  46 *                   IQUEST(20)= serial number of the key in directory
  47 *                   IQUEST(21..20+NWKEY)=KEY(1....NWKEY)
  48 *
  49 * Called by RZIN,RZVIN
  50 *
  51 *  Author  : R.Brun DD/US/PD
  52 *  Written : 09.05.86
  53 *  Last mod: 11.09.89
  54 *          : 04.03.94 S.Banerjee (Change in cycle structure)
  55 *          : 23.03.95 J.Shiers - check on K/C blocks is on KEY(1)
  56 *
  57 ************************************************************************
  58 #include "zebra/rzcl.inc"
  59 #include "zebra/rzclun.inc"
  60 #include "zebra/rzcout.inc"
  61 #include "zebra/rzk.inc"
  62 #include "zebra/rzckey.inc"
  63 #include "zebra/rzcycle.inc"
  64       CHARACTER*(*) CHOPT
  65       DIMENSION KEYU(*)
  66       EQUIVALENCE (IOPTA,IQUEST(91)), (IOPTC,IQUEST(92))
  67      +,    (IOPTD,IQUEST(93)), (IOPTN,IQUEST(94)), (IOPTR,IQUEST(95))
  68      +,    (IOPTS,IQUEST(96))
  69 *
  70 *-----------------------------------------------------------------------
  71 *
  72 #include "zebra/q_jbyt.inc"
  73 *
  74       IQUEST(1)=0
  75       CALL UOPTC(CHOPT,'ACDNRS',IQUEST(91))
  76 *
  77 *           Search KEY and CYCLE
  78 *
  79       LK=IQ(KQSP+LCDIR+KLK)
  80       NKEYS=IQ(KQSP+LCDIR+KNKEYS)
  81       NWKEY=IQ(KQSP+LCDIR+KNWKEY)
  82       IQUEST(7)=NKEYS
  83       IQUEST(8)=NWKEY
  84       IF(NKEYS.EQ.0)GO TO 90
  85 *
  86       IF(IOPTS.NE.0)THEN
  87          IK1=KEYU(1)
  88          IK2=IK1
  89          IF(IK1.GT.NKEYS.OR.IK1.LE.0)THEN
  90             IQUEST(1)=1
  91             IQUEST(2)=IK1
  92             RETURN
  93          ENDIF
  94       ELSE
  95          IK1=1
  96          IK2=NKEYS
  97          DO 5 I=1,NWKEY
  98             IKDES=(I-1)/10
  99             IKBIT1=3*I-30*IKDES-2
 100             IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
 101                KEY(I)=KEYU(I)
 102             ELSE
 103                CALL ZHTOI(KEYU(I),KEY(I),1)
 104             ENDIF
 105    5     CONTINUE
 106       ENDIF
 107       DO 30 I=IK1,IK2
 108          LKC=LK+(NWKEY+1)*(I-1)
 109          IF(IOPTS.EQ.0)THEN
 110             DO 10 K=1,NWKEY
 111                IF(IQ(KQSP+LCDIR+LKC+K).NE.KEY(K))GO TO 30
 112   10        CONTINUE
 113          ELSE
 114             DO 15 K=1,NWKEY
 115                IF(K.LT.10)THEN
 116                   IKDES=(K-1)/10
 117                   IKBIT1=3*K-30*IKDES-2
 118                   IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
 119                      IQUEST(20+K)=IQ(KQSP+LCDIR+LKC+K)
 120                   ELSE
 121                      CALL ZITOH(IQ(KQSP+LCDIR+LKC+K),IQUEST(20+K),1)
 122                   ENDIF
 123                ENDIF
 124   15        CONTINUE
 125          ENDIF
 126          IQUEST(20)=I
 127          LCYC=IQ(KQSP+LCDIR+LKC)
 128          IF (KVSCYC.NE.0) THEN
 129 *           IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.I) THEN
 130 *
 131 *    Check should be on content of KEY(1)
 132 *
 133             IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.IQ(KQSP+LCDIR+LKC+1)) THEN
 134                IQUEST(1) = 11
 135                GO TO 99
 136             ENDIF
 137          ENDIF
 138          NC=0
 139   20     NC=NC+1
 140          ICY = JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12)
 141          IF(ICY.EQ.ICYCLE)GO TO 50
 142          IF(NC.EQ.1.AND.ICYCLE.GT.ICY)GO TO 50
 143          IF (KVSCYC.EQ.0) THEN
 144             LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC),1,16)
 145          ELSE
 146             LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC)
 147          ENDIF
 148          IF(LCOLD.EQ.0.AND.LCOLD.NE.LCYC.AND.ICYCLE.EQ.0)GO TO 50
 149          LCYC=LCOLD
 150          IF(LCYC.NE.0)GO TO 20
 151          GO TO 90
 152   30  CONTINUE
 153       GO TO 90
 154 *
 155 *           Cycle has been found
 156 *           Read record descriptor
 157 *
 158   50  IF (KVSCYC.EQ.0) THEN
 159          IR1   = JBYT(IQ(KQSP+LCDIR+LCYC+KFRCYC),17,16)
 160          IR2   = JBYT(IQ(KQSP+LCDIR+LCYC+KSRCYC),17,16)
 161          IP1   = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,16)
 162          NW    = JBYT(IQ(KQSP+LCDIR+LCYC+KNWCYC), 1,20)
 163       ELSE
 164          IR1   = IQ(KQSP+LCDIR+LCYC+KFRCYC)
 165          IR2   = IQ(KQSP+LCDIR+LCYC+KSRCYC)
 166          IP1   = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,20)
 167          NW    = IQ(KQSP+LCDIR+LCYC+KNWCYC)
 168       ENDIF
 169       N1    = NW
 170       IQUEST(2)=1
 171       IF(IR2.NE.0)IQUEST(2)=(NW-N1-1)/LREC+2
 172       IQUEST(3)=IR1
 173       IQUEST(4)=IP1
 174       IQUEST(5)=IR2
 175       IQUEST(6)=ICY
 176       IQUEST(12)=NW
 177       IQUEST(14)=IQ(KQSP+LCDIR+LCYC+1)
 178       IQUEST(15)=LCYC
 179 C
 180 C           C option given
 181 C
 182       IF(IOPTC.NE.0)THEN
 183          IQUEST(50)=0
 184          LC1=LCYC
 185   51     IQUEST(50)=IQUEST(50)+1
 186          IF (KVSCYC.EQ.0) THEN
 187             LCOLD = JBYT(IQ(KQSP+LCDIR+LC1+KPPCYC),1,16)
 188          ELSE
 189             LCOLD = IQ(KQSP+LCDIR+LC1+KPPCYC)
 190          ENDIF
 191          IF(IQUEST(50).LE.19)THEN
 192             NC=IQUEST(50)
 193             IQUEST(50+NC)=JBYT(IQ(KQSP+LCDIR+LC1+KCNCYC),21,12)
 194             IQUEST(70+NC)=IQ(KQSP+LCDIR+LC1+KFLCYC)
 195          ENDIF
 196          IF(LCOLD.NE.0.AND.LCOLD.NE.LC1)THEN
 197             LC1=LCOLD
 198             GO TO 51
 199          ENDIF
 200       ENDIF
 201 C
 202 C           N option given. return neighbours
 203 C
 204       IF(IOPTN.NE.0)THEN
 205          IF(I.EQ.1)THEN
 206             IQUEST(30)=0
 207          ELSE
 208             IQUEST(30)=NWKEY
 209             DO 52 J=1,NWKEY
 210                IF(J.LT.10)THEN
 211                   LKCJ=LK+(NWKEY+1)*(I-2)
 212                   IQUEST(30+J)=IQ(KQSP+LCDIR+LKCJ+J)
 213                   IKDES=(J-1)/10
 214                   IKBIT1=3*J-30*IKDES-2
 215                   IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
 216                      CALL ZITOH(IQUEST(30+J),IQUEST(30+J),1)
 217                   ENDIF
 218                ENDIF
 219   52        CONTINUE
 220          ENDIF
 221          IF(I.EQ.NKEYS)THEN
 222             IQUEST(40)=0
 223          ELSE
 224             IQUEST(40)=NWKEY
 225             DO 53 J=1,NWKEY
 226                IF(J.LT.10)THEN
 227                   LKCJ=LK+(NWKEY+1)*I
 228                   IQUEST(40+J)=IQ(KQSP+LCDIR+LKCJ+J)
 229                   IKDES=(J-1)/10
 230                   IKBIT1=3*J-30*IKDES-2
 231                   IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
 232                      CALL ZITOH(IQUEST(40+J),IQUEST(40+J),1)
 233                   ENDIF
 234                ENDIF
 235   53        CONTINUE
 236          ENDIF
 237       ENDIF
 238       GO TO 99
 239 *
 240 *           Error
 241 *
 242   90  IQUEST(1)=1
 243       IF(IOPTN.NE.0)THEN
 244          IF(NKEYS.GT.0)THEN
 245             IQUEST(30)=NWKEY
 246             IQUEST(40)=NWKEY
 247             DO 91 J=1,NWKEY
 248                IF(J.GE.10)GO TO 91
 249                LKCJ=LK+(NWKEY+1)*(NKEYS-1)
 250                IQUEST(30+J)=IQ(KQSP+LCDIR+LK+J)
 251                IQUEST(40+J)=IQ(KQSP+LCDIR+LKCJ+J)
 252                IKDES=(J-1)/10
 253                IKBIT1=3*J-30*IKDES-2
 254                IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
 255                   CALL ZITOH(IQUEST(30+J),IQUEST(30+J),1)
 256                   CALL ZITOH(IQUEST(40+J),IQUEST(40+J),1)
 257                ENDIF
 258   91        CONTINUE
 259          ENDIF
 260       ENDIF
 261 *
 262   99  RETURN
 263       END