[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / rz / rzink.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/24 17:26:55  mclareni
* Extend the include file cleanup to dzebra, rz and tq, and also add
* dependencies in some cases.
*
* Revision 1.1.1.1  1996/03/06 10:47:24  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE RZINK(KEYU,ICYCLE,CHOPT)
*
************************************************************************
*
*         To find and decode KEYU,ICYCLE
* Input:
*   KEYU    Keyword vector of the information to be read
*   ICYCLE  Cycle number of the key to be read
*           ICYCLE > highest cycle number means read the highest cycle
*           ICYCLE = 0 means read the lowest cycle
*   CHOPT   Character variable specifying the options selected.
*           data structure
*             default
*                   Same as 'D' below
*             'A'   Read continuation of the previously read data structure
*                   with identifier KEYU,ICYCLE
*                   Given that option implies that the record was written with
*                   the same option by a call to RZOUT.
*             'C'   Provide   information   about   the   cycle   numbers
*                   associated with KEY.
*                   The  total number  of  cycles  and the  cycle  number
*                   identifiers of the 19 highest  cycles are returned in
*                   IQUEST(50) and IQUEST(51..89) respectively
*             'D'   Read the  Data structure  with the  (key,cycle)  pair
*                   specified.
*             'N'   Read the neighbouring. keys (i.e. those preceding and
*                   following KEY).
*                   The  key-vectors of  the previous  and  next key  are
*                   available   respectively   as   IQUEST(31..35)    and
*                   IQUEST(41..45), see below.
*             'R'   Read data into existing bank at LSUP,JBIAS
*             'S'   KEYU(1) contains the key serial number
*                   IQUEST(20)= serial number of the key in directory
*                   IQUEST(21..20+NWKEY)=KEY(1....NWKEY)
*
* Called by RZIN,RZVIN
*
*  Author  : R.Brun DD/US/PD
*  Written : 09.05.86
*  Last mod: 11.09.89
*          : 04.03.94 S.Banerjee (Change in cycle structure)
*          : 23.03.95 J.Shiers - check on K/C blocks is on KEY(1)
*
************************************************************************
#include "zebra/rzcl.inc"
#include "zebra/rzclun.inc"
#include "zebra/rzcout.inc"
#include "zebra/rzk.inc"
#include "zebra/rzckey.inc"
#include "zebra/rzcycle.inc"
      CHARACTER*(*) CHOPT
      DIMENSION KEYU(*)
      EQUIVALENCE (IOPTA,IQUEST(91)), (IOPTC,IQUEST(92))
     +,    (IOPTD,IQUEST(93)), (IOPTN,IQUEST(94)), (IOPTR,IQUEST(95))
     +,    (IOPTS,IQUEST(96))
*
*-----------------------------------------------------------------------
*
#include "zebra/q_jbyt.inc"
*
      IQUEST(1)=0
      CALL UOPTC(CHOPT,'ACDNRS',IQUEST(91))
*
*           Search KEY and CYCLE
*
      LK=IQ(KQSP+LCDIR+KLK)
      NKEYS=IQ(KQSP+LCDIR+KNKEYS)
      NWKEY=IQ(KQSP+LCDIR+KNWKEY)
      IQUEST(7)=NKEYS
      IQUEST(8)=NWKEY
      IF(NKEYS.EQ.0)GO TO 90
*
      IF(IOPTS.NE.0)THEN
         IK1=KEYU(1)
         IK2=IK1
         IF(IK1.GT.NKEYS.OR.IK1.LE.0)THEN
            IQUEST(1)=1
            IQUEST(2)=IK1
            RETURN
         ENDIF
      ELSE
         IK1=1
         IK2=NKEYS
         DO 5 I=1,NWKEY
            IKDES=(I-1)/10
            IKBIT1=3*I-30*IKDES-2
            IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
               KEY(I)=KEYU(I)
            ELSE
               CALL ZHTOI(KEYU(I),KEY(I),1)
            ENDIF
   5     CONTINUE
      ENDIF
      DO 30 I=IK1,IK2
         LKC=LK+(NWKEY+1)*(I-1)
         IF(IOPTS.EQ.0)THEN
            DO 10 K=1,NWKEY
               IF(IQ(KQSP+LCDIR+LKC+K).NE.KEY(K))GO TO 30
  10        CONTINUE
         ELSE
            DO 15 K=1,NWKEY
               IF(K.LT.10)THEN
                  IKDES=(K-1)/10
                  IKBIT1=3*K-30*IKDES-2
                  IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
                     IQUEST(20+K)=IQ(KQSP+LCDIR+LKC+K)
                  ELSE
                     CALL ZITOH(IQ(KQSP+LCDIR+LKC+K),IQUEST(20+K),1)
                  ENDIF
               ENDIF
  15        CONTINUE
         ENDIF
         IQUEST(20)=I
         LCYC=IQ(KQSP+LCDIR+LKC)
         IF (KVSCYC.NE.0) THEN
*           IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.I) THEN
*
*    Check should be on content of KEY(1)
*
            IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.IQ(KQSP+LCDIR+LKC+1)) THEN
               IQUEST(1) = 11
               GO TO 99
            ENDIF
         ENDIF
         NC=0
  20     NC=NC+1
         ICY = JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12)
         IF(ICY.EQ.ICYCLE)GO TO 50
         IF(NC.EQ.1.AND.ICYCLE.GT.ICY)GO TO 50
         IF (KVSCYC.EQ.0) THEN
            LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC),1,16)
         ELSE
            LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC)
         ENDIF
         IF(LCOLD.EQ.0.AND.LCOLD.NE.LCYC.AND.ICYCLE.EQ.0)GO TO 50
         LCYC=LCOLD
         IF(LCYC.NE.0)GO TO 20
         GO TO 90
  30  CONTINUE
      GO TO 90
*
*           Cycle has been found
*           Read record descriptor
*
  50  IF (KVSCYC.EQ.0) THEN
         IR1   = JBYT(IQ(KQSP+LCDIR+LCYC+KFRCYC),17,16)
         IR2   = JBYT(IQ(KQSP+LCDIR+LCYC+KSRCYC),17,16)
         IP1   = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,16)
         NW    = JBYT(IQ(KQSP+LCDIR+LCYC+KNWCYC), 1,20)
      ELSE
         IR1   = IQ(KQSP+LCDIR+LCYC+KFRCYC)
         IR2   = IQ(KQSP+LCDIR+LCYC+KSRCYC)
         IP1   = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,20)
         NW    = IQ(KQSP+LCDIR+LCYC+KNWCYC)
      ENDIF
      N1    = NW
      IQUEST(2)=1
      IF(IR2.NE.0)IQUEST(2)=(NW-N1-1)/LREC+2
      IQUEST(3)=IR1
      IQUEST(4)=IP1
      IQUEST(5)=IR2
      IQUEST(6)=ICY
      IQUEST(12)=NW
      IQUEST(14)=IQ(KQSP+LCDIR+LCYC+1)
      IQUEST(15)=LCYC
C
C           C option given
C
      IF(IOPTC.NE.0)THEN
         IQUEST(50)=0
         LC1=LCYC
  51     IQUEST(50)=IQUEST(50)+1
         IF (KVSCYC.EQ.0) THEN
            LCOLD = JBYT(IQ(KQSP+LCDIR+LC1+KPPCYC),1,16)
         ELSE
            LCOLD = IQ(KQSP+LCDIR+LC1+KPPCYC)
         ENDIF
         IF(IQUEST(50).LE.19)THEN
            NC=IQUEST(50)
            IQUEST(50+NC)=JBYT(IQ(KQSP+LCDIR+LC1+KCNCYC),21,12)
            IQUEST(70+NC)=IQ(KQSP+LCDIR+LC1+KFLCYC)
         ENDIF
         IF(LCOLD.NE.0.AND.LCOLD.NE.LC1)THEN
            LC1=LCOLD
            GO TO 51
         ENDIF
      ENDIF
C
C           N option given. return neighbours
C
      IF(IOPTN.NE.0)THEN
         IF(I.EQ.1)THEN
            IQUEST(30)=0
         ELSE
            IQUEST(30)=NWKEY
            DO 52 J=1,NWKEY
               IF(J.LT.10)THEN
                  LKCJ=LK+(NWKEY+1)*(I-2)
                  IQUEST(30+J)=IQ(KQSP+LCDIR+LKCJ+J)
                  IKDES=(J-1)/10
                  IKBIT1=3*J-30*IKDES-2
                  IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
                     CALL ZITOH(IQUEST(30+J),IQUEST(30+J),1)
                  ENDIF
               ENDIF
  52        CONTINUE
         ENDIF
         IF(I.EQ.NKEYS)THEN
            IQUEST(40)=0
         ELSE
            IQUEST(40)=NWKEY
            DO 53 J=1,NWKEY
               IF(J.LT.10)THEN
                  LKCJ=LK+(NWKEY+1)*I
                  IQUEST(40+J)=IQ(KQSP+LCDIR+LKCJ+J)
                  IKDES=(J-1)/10
                  IKBIT1=3*J-30*IKDES-2
                  IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
                     CALL ZITOH(IQUEST(40+J),IQUEST(40+J),1)
                  ENDIF
               ENDIF
  53        CONTINUE
         ENDIF
      ENDIF
      GO TO 99
*
*           Error
*
  90  IQUEST(1)=1
      IF(IOPTN.NE.0)THEN
         IF(NKEYS.GT.0)THEN
            IQUEST(30)=NWKEY
            IQUEST(40)=NWKEY
            DO 91 J=1,NWKEY
               IF(J.GE.10)GO TO 91
               LKCJ=LK+(NWKEY+1)*(NKEYS-1)
               IQUEST(30+J)=IQ(KQSP+LCDIR+LK+J)
               IQUEST(40+J)=IQ(KQSP+LCDIR+LKCJ+J)
               IKDES=(J-1)/10
               IKBIT1=3*J-30*IKDES-2
               IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
                  CALL ZITOH(IQUEST(30+J),IQUEST(30+J),1)
                  CALL ZITOH(IQUEST(40+J),IQUEST(40+J),1)
               ENDIF
  91        CONTINUE
         ENDIF
      ENDIF
*
  99  RETURN
      END
Commit	Line	Data
fe4da5cc	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=3I-30IKDES-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=3K-30IKDES-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=3J-30IKDES-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=3J-30IKDES-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=3J-30IKDES-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