]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/fq/fzin.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / fq / fzin.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/18 16:10:36 mclareni
6* Incorporate changes from J.Zoll for version 3.77
7*
8* Revision 1.1.1.1 1996/03/06 10:47:14 mclareni
9* Zebra
10*
11*
12#include "zebra/pilot.h"
13 SUBROUTINE FZIN (LUNP,IXDIVP,LSUPP,JBIASP,CHOPT,NUHP,IUHEAD)
14
15C- MAIN SEQUENTIAL INPUT ROUTINE, USER CALLED
16
17#include "zebra/zbcd.inc"
18#include "zebra/zmach.inc"
19#include "zebra/zunit.inc"
20#include "zebra/zvfaut.inc"
21#include "zebra/mqsys.inc"
22#include "zebra/eqlqf.inc"
23#include "zebra/mzcn.inc"
24#include "zebra/mzct.inc"
25#include "zebra/fzci.inc"
26#include "zebra/fzcseg.inc"
27#include "zebra/fzcocc.inc"
28C-------------- End CDE --------------
29 DIMENSION LUNP(9),IXDIVP(9),LSUPP(9),JBIASP(9)
30 DIMENSION NUHP(9),IUHEAD(99)
31 DIMENSION MOPTV(6)
32 EQUIVALENCE (MOPTV(1),IOPTIE)
33 EQUIVALENCE (LRTYP,IDI(2))
34 CHARACTER CHOPT*(*)
35#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
36 DIMENSION NAMESR(2)
37 DATA NAMESR / 4HFZIN, 4H /
38#endif
39#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
40 DATA NAMESR / 6HFZIN /
41#endif
42#if !defined(CERNLIB_QTRHOLL)
43 CHARACTER NAMESR*8
44 PARAMETER (NAMESR = 'FZIN ')
45#endif
46
47
48#include "zebra/qtrace.inc"
49
50 LUNNI = LUNP(1)
51 IXDIVI = IXDIVP(1)
52 CALL UOPTC (CHOPT,'ERSATDFGH234',IOPTIE)
53 IOPTIF = IOPTIF + IOPTIG + IOPTIH
54 IF (IOPTI2(1).NE.0) IOPTIR = 2
55 IF (IOPTI2(2).NE.0) IOPTIR = 3
56 IF (IOPTI2(3).NE.0) IOPTIR = 4
57
58C-- Set current input unit
59
60 IF (LUNNI.NE.LUNI) CALL FZLOC (LUNNI,1)
61#if defined(CERNLIB_QDEBPRI)
62 IF (LOGLVI.GE.2) THEN
63 IF (LOGLVI.GE.3) WRITE (IQLOG,9110)
64 WRITE (IQLOG,9111) LUNNI,NUHP(1),MOPTV
65 ENDIF
66 9110 FORMAT (1X)
67 9111 FORMAT (' FZIN- Entered for LUN=',I4,' NUH=',I5,
68 F' E/R/S/A/T/D= ',6I1)
69#endif
70
71 NWRDAI = IQ(KQSP+LQFI+20)
72 NRECAI = IQ(KQSP+LQFI+21)
73 JRETCD = 0
74 JERROR = 0
75 NWERR = 0
76 NQOCC = 0
77 JOPT = IOPTIT + IOPTIA + IOPTID
78 IF (JOPT.EQ.0) GO TO 141
79
80C-- Re-entry for pending d/s
81
82 IF (IOPTIR.NE.0) GO TO 714
83 LRTYP = IQ(KQSP+LQFI+27)
84 NWTABI = IQ(KQSP+LQFI+41)
85 NWBKI = IQ(KQSP+LQFI+42)
86 LENTRI = IQ(KQSP+LQFI+43)
87 IF (JOPT.GE.2) GO TO 711
88 IF (LRTYP.GE.5) GO TO 712
89 IF (LRTYP.LE.1) GO TO 712
90 IF (IOPTIT.NE.0) GO TO 121
91 IEVFLI = 3 - LRTYP
92 NWUMXI = 0
93 IF (IOPTIA.NE.0) GO TO 154
94 GO TO 151
95
96C---- Ready segment table for the user
97
98 121 LFISEG = LQFI + JAUSEG
99 NQSEG = IQ(KQSP+LFISEG) / 3
100 IF (NQSEG.NE.0) THEN
101 N = 2*NQSEG
102 CALL UCOPY (IQ(KQSP+LFISEG+1),IQSEGH,N)
103 CALL VZERO (IQSEGD,NQSEG)
104 ENDIF
105 IQSGLU = LUNI
106 IQUEST(1) = 0
107 GO TO 999
108
109C-----------------------------------------------------
110C- obtain and digest next pilot record
111C-----------------------------------------------------
112
113 141 IF (IACTVI.GE.6) GO TO 701
114#if defined(CERNLIB_QDEBUG)
115 IF (IQVSTA.NE.0) THEN
116 ISV = IQVID(2)
117 CALL ZVAUTX
118 IF (IQVID(2).NE.ISV) THEN
119 IQVREM(1,3) = IQVID(1)
120 IQVREM(2,3) = IQVID(2)
121 ENDIF
122 ENDIF
123#endif
124 142 NWUMXI = NUHP(1)
125 NWUHI = 0
126
127 JPENDG = IQ(KQSP+LQFI+30)
128 IQ(KQSP+LQFI+30) = 0
129 IF (JPENDG.EQ.1) GO TO 301
130 IF (JPENDG.EQ.2) GO TO 311
131
132#if defined(CERNLIB_FZFFNAT)
133 IF (IFIFOI.EQ.0) THEN
134 CALL FZIFFN (1)
135 GO TO 144
136 ENDIF
137#endif
138 CALL FZIFFX (1)
139 144 IF (JRETCD.NE.0) GO TO 391
140
141 IF (NWBKI.EQ.0) IQ(KQSP+LQFI+17) = IQ(KQSP+LQFI+17) + 1
142
143C-- check DAT record wanted / needed
144
145 IF (IOPTIF+IPILI(3).EQ.0) GO TO 145
146
147 IF (IOPTIH.NE.0) THEN
148 IF (IPILI(3).NE.1) GO TO 142
149 GO TO 145
150 ENDIF
151
152 IF (IPILI(3).NE.0) THEN
153 IF (IOPTIF.EQ.0) GO TO 142
154 ENDIF
155
156C-- Copy header vector to user
157
158 145 IF (NWUMXI.LE.0) GO TO 146
159 NWUHI = MIN (NWUHI, NWUMXI)
160 NUHP(1) = NWUHI
161 IF (NWUHI.GT.0) CALL UCOPY (LQ(LUHEAI),IUHEAD,NWUHI)
162
163C-- Return if selective call
164
165 146 IF (IOPTIS.EQ.0) GO TO 154
166 IQ(KQSP+LQFI+41) = NWTABI
167 IQ(KQSP+LQFI+42) = NWBKI
168 IQ(KQSP+LQFI+43) = LENTRI
169#if defined(CERNLIB_QDEBPRI)
170 IF (LOGLVI.GE.3) WRITE (IQLOG,9146)
171 9146 FORMAT (' FZIN- Exit for S option.')
172#endif
173 GO TO 991
174
175C-------------------------------------------------
176C- read table and d/s, relocate
177C-------------------------------------------------
178
179C-- Re-entry with D-option
180
181 151 IF (IQSGLU.NE.LUNI) GO TO 713
182 GO TO 155
183
184C-- Re-entry with A-option
185
186 154 NQSEG = 0
187 155 IF (NWBKI.NE.0) GO TO 157
188
189C-- Empty d/s
190
191 LRTYP = 0
192 LENTRI = 0
193 GO TO 189
194
195C-- Get store / division
196
197 157 CALL MZSDIV (IXDIVI,7)
198 IF (JQDIVI.EQ.0) JQDIVI=2
199 LQSYSR(KQT+1) = LSUPP(1)
200
201#if defined(CERNLIB_QDEBPRI)
202 IF (LOGLVI.GE.3)
203 + WRITE (IQLOG,9157) JQSTOR,JQDIVI,NWTABI,NWBKI
204 9157 FORMAT (' FZIN- accept d/s into STORE/def.DIV.=',2I4,
205 F' need memory for NWTB/NWBK=',I5,I7)
206#endif
207
208C-- Ready memory occupation table, reserve space
209
210 CALL FZIMTB
211 IF (JRETCD.NE.0) GO TO 390
212
213C-- Early table
214
215 LFIEAR = LQFI + JAUEAR
216 NTBE = IQ(KQSP+LFIEAR)
217 IF (NTBE.NE.0) THEN
218 LTBR = LQTA + NWTABI
219 CALL UCOPY (IQ(KQSP+LFIEAR+1),LQ(LTBR),NWTABI)
220 GO TO 159
221 ENDIF
222
223C-- Read the long table
224
225 IF (NWTABI.EQ.0) GO TO 159
226#if defined(CERNLIB_FZFFNAT)
227 IF (IFIFOI.EQ.0) THEN
228 CALL FZIFFN (2)
229 GO TO 158
230 ENDIF
231#endif
232 CALL FZIFFX (2)
233 158 IF (JRETCD.NE.0) GO TO 391
234
235C-- Read the data
236
237 159 CONTINUE
238#if defined(CERNLIB_FZFFNAT)
239 IF (IFIFOI.EQ.0) THEN
240 CALL FZIFFN (3)
241 GO TO 160
242 ENDIF
243#endif
244 CALL FZIFFX (3)
245 160 IF (JRETCD.NE.0) GO TO 391
246
247C-- Relocation
248
249 CALL FZIREL
250 IF (JRETCD.NE.0) GO TO 391
251
252C-------------------------------------------------------------
253C- done : link and return
254C-------------------------------------------------------------
255
256 181 JB = JBIASP(1)
257 IF (JB.GE.2) THEN
258 LSUPP(1) = LENTRI
259 ELSE
260 LSUPP(1) = LQSYSR(KQT+1)
261 CALL ZSHUNT (IXDIVI,LENTRI,LSUPP,JB,1)
262 ENDIF
263
264 IQ(KQSP+LQFI+16) = IQ(KQSP+LQFI+16) + 1
265
266 189 LRTYP = 8
267#if defined(CERNLIB_QDEBPRI)
268 IF (LOGLVI.GE.3) WRITE (IQLOG,9189) NWTABI,NWBKI,IEVFLI
269 9189 FORMAT (' FZIN- exit for d/s with NWTB,NWBK,IEVENT=',
270 F 2I6,I9,I2)
271#endif
272 GO TO 991
273
274C-------------------------------------------------------------
275C- Exit to exceptions
276C-------------------------------------------------------------
277
278C-- Pending EoF
279
280 301 JRETCD = -1
281 GO TO 781
282
283C-- Pending start/end of run
284
285 311 LFIIOC = LQFI + JAUIOC
286 NWUHI = IQ(KQSP+LFIIOC)
287 LUHEAI = LQWKFZ
288 CALL UCOPY (IQ(KQSP+LFIIOC+1),LQ(LUHEAI),NWUHI)
289 JRETCD = -2
290 GO TO 421
291
292C-- Side exceptions
293
294 390 IF (JRETCD.LT.0) GO TO 155
295 391 IF (JRETCD.NE.-2) GO TO 781
296
297C-------------------------------------------------
298C- end-of-file / end-of-run
299C-------------------------------------------------
300
301C---- Normal S/E-OF-RUN
302
303 421 CALL FZIDIA
304 IF (LQ(LUHEAI).GT.0) GO TO 424
305
306C-- End of run
307
308 IF (IOPTIR.EQ.1) GO TO 142
309 IF (IOPTIR.GE.IACTVI) GO TO 142
310 GO TO 427
311
312C-- Start of run
313
314 424 IF (IOPTIR.GE.2) GO TO 142
315 427 IF (NWUMXI.LE.0) GO TO 997
316 NWUHI = MIN (NWUHI-1, NWUMXI)
317 NUHP(1) = NWUHI
318 IF (NWUHI.GT.0) CALL UCOPY (LQ(LUHEAI+1),IUHEAD(1),NWUHI)
319 GO TO 997
320
321C-------------------------------------------------
322C- ERROR CONDITIONS
323C-------------------------------------------------
324
325C-- Reading beyond end-of-data
326
327 701 IF (IACTVI.EQ.8) GO TO 142
328 IF (IACTVI.EQ.18) GO TO 142
329 JRETCD = -3
330 GO TO 781
331
332C---- User error
333
334C- JERROR = 14 options (R,2,3,4) not allowed with (T,A,D)
335 714 JERROR = 1
336
337C- JERROR = 13 no segment table for entry with D option
338 713 JERROR = JERROR + 1
339
340C- JERROR = 12 no pending d/s for entry with T A D options
341 712 JERROR = JERROR + 1
342
343C- JERROR = 11 multiple options T A D not allowed
344 711 JERROR = 11 + JERROR
345 JRETCD = 4
346
347C------ Print error message
348
349 781 CALL FZIDIA
350
351C-- Abandon reserved space, if any
352
353 IF (NQOCC.EQ.0) GO TO 997
354 DO 784 J=1,NQOCC
355 JDIV = IQOCDV(J)
356 NW = IQOCSP(J)
357 IF (IQMODE(KQT+JDIV).EQ.0) THEN
358 LQEND(KQT+JDIV) = LQEND(KQT+JDIV) - NW
359 ELSE
360 LQSTA(KQT+JDIV) = LQSTA(KQT+JDIV) + NW
361 ENDIF
362 784 CONTINUE
363 GO TO 997
364
365C-- Common exit
366
367 991 IQUEST(1) = 0
368 IQUEST(5) = IQ(KQSP+LQFI+31)
369 IQUEST(6) = IQ(KQSP+LQFI+32)
370 IQUEST(11) = IEVFLI
371 IQUEST(12) = IPILI(3)
372 IQUEST(13) = LENTRI
373 IQUEST(14) = NWBKI
374 LFIIOC = LQFI + JAUIOC
375 NWIOI = IQ(KQSP+LFIIOC)
376 CALL UCOPY (IQ(KQSP+LFIIOC),IQUEST(20),NWIOI+1)
377
378 IF (NWRDAI.GE.1000000) THEN
379 IQ(KQSP+LQFI+19) = IQ(KQSP+LQFI+19) + 1
380 NWRDAI = NWRDAI - 1000000
381 ENDIF
382
383 997 IQ(KQSP+LQFI+26) = IQUEST(1)
384 IQ(KQSP+LQFI+27) = LRTYP
385 IQ(KQSP+LQFI+2) = IACTVI
386 IQ(KQSP+LQFI+20) = NWRDAI
387 IQ(KQSP+LQFI+21) = NRECAI
388 IQUEST(2) = NRECAI
389 IQUEST(3) = IQ(KQSP+LQFI+22)
390 IQSGLU = 0
391
392#include "zebra/qtrace99.inc"
393 RETURN
394 END
395* ==================================================
396#include "zebra/qcardl.inc"