MINICERN/packlib/zebra/rz/rzin.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:54  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 RZIN(IXDIV,LSUP,JBIAS,KEYU,ICYCLE,CHOPT)
  15 *
  16 ************************************************************************
  17 *
  18 *        To read one record and create the corresponding data structure
  19 *           which will be pointed by (LSUP,JBIAS) in division IXDIV
  20 * Input:
  21 *   IXDIV   Index of the division to receive the data structure
  22 *           IXDIV = 0 means division 2 of the primary store
  23 *   *LSUP*
  24 *   JBIAS   JBIAS < 1 : LSUP is the supporting bank and JBIAS is the link
  25 *           bias specifying where the data structure has to be introduced
  26 *           into this bank, i.e.  the data structure will be connected to
  27 *           LQ(LSUP+JBIAS).
  28 *           JBIAS =  1 :  LSUP  is the  supporting link,  i.e.   the data
  29 *           structure is connected to LSUP (top level data structure)
  30 *           JBIAS = 2 : Stand alone data structure, no connection.
  31 *   KEYU    Keyword vector of the information to be read
  32 *   ICYCLE  Cycle number of the key to be read
  33 *           ICYCLE > highest cycle number means read the highest cycle
  34 *           ICYCLE = 0 means read the lowest cycle
  35 *   CHOPT   Character variable specifying the options selected.
  36 *           data structure
  37 *             default
  38 *                   Same as 'D' below
  39 *             'A'   Read continuation of the previously read data structure
  40 *                   with identifier KEYU,ICYCLE
  41 *                   Given that option implies that the record was written with
  42 *                   the same option by a call to RZOUT.
  43 *             'C'   Provide   information   about   the   cycle   numbers
  44 *                   associated with KEY.
  45 *                   The  total number  of  cycles  and the  cycle  number
  46 *                   identifiers of the 19 highest  cycles are returned in
  47 *                   IQUEST(50) and IQUEST(51..89) respectively
  48 *             'D'   Read the  Data structure  with the  (key,cycle)  pair
  49 *                   specified.
  50 *             'N'   Read the neighbouring. keys (i.e. those preceding and
  51 *                   following KEY).
  52 *                   The  key-vectors of  the previous  and  next key  are
  53 *                   available   respectively   as   IQUEST(31..35)    and
  54 *                   IQUEST(41..45), see below.
  55 *             'R'   Read data into existing bank at LSUP,JBIAS
  56 *             'S'   KEYU(1) contains the key serial number
  57 * Output:
  58 *   *LSUP*  For JBIAS = 1  or 2,  LSUP contains the entry  address to the
  59 *           data structure
  60 *           In any case IQUEST(11) returns the entry address
  61 *
  62 * Called by <USER>
  63 *
  64 *  Author  : R.Brun DD/US/PD
  65 *  Written : 12.04.86
  66 *  Last mod: 20.12.90
  67 *          : 12.07.94 Return bank address when the input address is 0
  68 *                     and the data was written with RZVOUT.
  69 *                     Return IQUEST(11) correctly.
  70 *
  71 ************************************************************************
  72 #include "zebra/rzcl.inc"
  73 #include "zebra/rzclun.inc"
  74 #include "zebra/rzk.inc"
  75       CHARACTER*(*) CHOPT
  76       DIMENSION KEYU(*)
  77       DIMENSION LSUP(1),JBIAS(1),IQK(10),IQKS(10)
  78       EQUIVALENCE (IOPTA,IQUEST(91)), (IOPTC,IQUEST(92))
  79      +,      (IOPTD,IQUEST(93)), (IOPTN,IQUEST(94)), (IOPTR,IQUEST(95))
  80      +,      (IOPTS,IQUEST(96))
  81 *
  82 *-----------------------------------------------------------------------
  83 *
  84 #include "zebra/q_jbyt.inc"
  85 *
  86 *           Make sure input buffer exists
  87 *
  88       LRIN=LQ(KQSP+LTOP-7)
  89       IF(LRIN.EQ.0)THEN
  90          CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
  91          IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
  92          IQ(KQSP+LTOP+KIRIN)=0
  93       ENDIF
  94 *
  95 *          Find KEY,CYCLE
  96 *
  97       CALL RZINK(KEYU,ICYCLE,CHOPT)
  98       IF(IQUEST(1).NE.0)GO TO 99
  99       IF(IOPTC.NE.0.AND.IOPTD.EQ.0)GO TO 99
 100       IDTIME=IQUEST(14)
 101       IDNW  =IQUEST(12)
 102       IF(IOPTS.NE.0)CALL UCOPY(IQUEST(20),IQKS,10)
 103       IF(IOPTN.NE.0)THEN
 104          IF(IOPTD.EQ.0)GO TO 99
 105          CALL UCOPY(IQUEST(41),IQK,10)
 106       ENDIF
 107 *
 108       LBANK=0
 109       IF(LSUP(1).NE.0)THEN
 110          CALL MZSDIV(IXDIV,1)
 111          IF(JBIAS(1).LE.0)LBANK=LQ(KQS+LSUP(1)+JBIAS(1))
 112          IF(JBIAS(1).GT.0)LBANK=LSUP(1)
 113       ENDIF
 114 *
 115       IFORM=JBYT(IQUEST(14),1,3)
 116       IF(IFORM.EQ.0)THEN
 117 *
 118 *           Read data structure into LBANK
 119 *
 120          CALL RZINS(IXDIV,LSUP,JBIAS,LBANK)
 121 *
 122       ELSE
 123 *
 124 *          Case when record has been written with RZVOUT
 125 *
 126          NDATA=IQUEST(12)
 127          IF(LBANK.NE.0)THEN
 128             IF(NDATA.LE.IQ(KQS+LBANK-1))THEN
 129                CALL RZREAD(IQ(KQS+LBANK+1),NDATA,1,IFORM)
 130                IQUEST(11) = LBANK
 131             ELSE
 132                IQUEST(1)=3
 133             ENDIF
 134          ELSE
 135             CALL MZBOOK(IXDIV,LFROM,LSUP,JBIAS,'RZIN',0,0,NDATA,
 136      +                  IFORM,-1)
 137             CALL RZREAD(IQ(KQS+LFROM+1),NDATA,1,IFORM)
 138             IQUEST(11) = LFROM
 139          ENDIF
 140       ENDIF
 141       IQUEST(14)=IDTIME
 142       IQUEST(12)=IDNW
 143       IF(IOPTN.NE.0)CALL UCOPY(IQK ,IQUEST(41),10)
 144       IF(IOPTS.NE.0)CALL UCOPY(IQKS,IQUEST(20),10)
 145 *
 146   99  RETURN
 147       END