]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/fq/fziffn.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 / fziffn.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/18 16:10:31 mclareni
6* Incorporate changes from J.Zoll for version 3.77
7*
8* Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
9* Zebra
10*
11*
12#include "zebra/pilot.h"
13#if defined(CERNLIB_FZFFNAT)
14 SUBROUTINE FZIFFN (JSTAGE)
15
16C- Read operations for file format native
17C- subsidiary to FZIN
18
19C- Controlling parameter : JSTAGE
20C-
21C- JSTAGE = 1 : read the first pilot record
22C- 2 : read the tables into memory
23C- 3 : read the bank material
24
25#include "zebra/zbcd.inc"
26#include "zebra/zmach.inc"
27#include "zebra/zunit.inc"
28#include "zebra/mqsys.inc"
29#include "zebra/eqlqf.inc"
30#include "zebra/mzcn.inc"
31#include "zebra/mzct.inc"
32#include "zebra/mzcwk.inc"
33#include "zebra/fzci.inc"
34#include "zebra/fzcseg.inc"
35#include "zebra/fzcocc.inc"
36C-------------- End CDE --------------
37 DIMENSION MPILOT(10)
38 REAL CHDATA
39#if defined(CERNLIB_QMVDS)
40 SAVE CHDATA
41#endif
42 EQUIVALENCE (MPILOT(1),IPILI(1))
43 EQUIVALENCE (LRTYP,IDI(2)), (ICHDAT,CHDATA)
44#if defined(CERNLIB_QREADFULL)
45 COMMON /SLATE/ NRSLAT, DUMMY(39)
46#endif
47#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
48 DIMENSION NAMESR(2)
49 DATA NAMESR / 4HFZIF, 4HFN /
50#endif
51#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
52 DATA NAMESR / 6HFZIFFN /
53#endif
54#if !defined(CERNLIB_QTRHOLL)
55 CHARACTER NAMESR*8
56 PARAMETER (NAMESR = 'FZIFFN ')
57#endif
58 DATA CHDATA / 12345.0 /
59
60#include "zebra/q_jbyt.inc"
61
62#include "zebra/qtrace.inc"
63
64 GO TO (101,201,301), JSTAGE
65
66C-----------------------------------------------------
67C- obtain and digest next pilot record
68C-----------------------------------------------------
69
70 101 LIN = LQWKFZ
71
72 102 NWR = NQWKTT
73 CALL XINBS (LUNI,LRTYP,1,LQ(LIN),NWR)
74#if defined(CERNLIB_QDEBPRI)
75 IF (LOGLVI.GE.3) WRITE (IQLOG,9102) NRECAI+1,NWR,LRTYP
76 9102 FORMAT (' FZIFFN- hunt for pilot, seen LR #',I7,
77 F' with NWRL/LRTYP=',I7,I3)
78#endif
79 IF (NWR.EQ.0) GO TO 412
80 IF (NWR.LT.0) GO TO 751
81 NRECAI = NRECAI + 1
82 NWRDAI = NWRDAI + NWR + 3
83 IF (LRTYP.LE.0) GO TO 741
84 IF (LRTYP.GT.9) GO TO 741
85 IF (LRTYP.GE.4) GO TO 102
86 IF (LRTYP.EQ.1) GO TO 427
87
88 IACTVI = 2
89 IEVFLI = 3 - LRTYP
90 IQ(KQSP+LQFI+15) = IQ(KQSP+LQFI+15) + 1
91 IF (IOPTIR.NE.0) GO TO 102
92 IF (IEVFLI.LT.IOPTIE) GO TO 102
93
94 CALL UCOPY (LQ(LIN),IPILI,26)
95#if defined(CERNLIB_QDEBPRI)
96 IF (LOGLVI.GE.3) WRITE (IQLOG,9107,ERR=107) MPILOT,MPILOT
97 107 CONTINUE
98 9107 FORMAT (10X,'the 10 pilot control words : ',
99#endif
100#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
101 F/1X,4O23/1X,4O23/1X,2O23
102 F/1H0,9X,F13.1,3(9X,I14)/1X,4(9X,I14)/1X,2(9X,I14))
103#endif
104#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
105 F/10X,4Z17/10X,4Z17/10X,2Z17
106 F/1H0,9X,F17.1,3I17/10X,4I17/10X,2I17)
107#endif
108 IF (IPILI(1).NE.ICHDAT) GO TO 742
109
110C-- Copy user header
111
112 NWDONE = NWUHCI + 10
113 NWIOI = 0
114 NWUHI = 0
115 LFIIOC = LQFI + JAUIOC
116 IQ(KQSP+LFIIOC) = 0
117 IF (NWUMXI.LE.0) GO TO 121
118
119 IF (NWUHCI.EQ.0) THEN
120 NWUHI = 0
121 GO TO 121
122 ENDIF
123
124 NWIOI = JBYT (IOCHI(1),7,5)
125 IF (NWIOI.EQ.0) THEN
126 NWIOI = 1
127 IF (IOCHI(1).GE.8) GO TO 743
128 IF (IOCHI(1).LT.0) GO TO 743
129 IF (IOCHI(1).EQ.0) IOCHI(1)=1
130 ELSE
131 J = JBYT (IOCHI(1),12,5)
132 IF (J+1.NE.NWIOI) GO TO 743
133 ENDIF
134 IQ(KQSP+LFIIOC) = NWIOI
135 CALL UCOPY (IOCHI,IQ(KQSP+LFIIOC+1),NWIOI)
136
137 NWUHI = NWUHCI - NWIOI
138 LUHEAI = LIN + 10 + NWIOI
139#if defined(CERNLIB_QDEBPRI)
140 IF (LOGLVI.GE.3) THEN
141 N = MIN (8,NWUHI)
142 IF (LOGLVI.GE.4) THEN
143 WRITE (IQLOG,9113) NWIOI
144 WRITE (IQLOG,9115) (IOCHI(J),J=1,NWIOI)
145 N = NWUHI
146 ENDIF
147 WRITE (IQLOG,9114) NWUHI,N
148 WRITE (IQLOG,9115) (LQ(LUHEAI+J),J=0,N-1)
149 ENDIF
150 9113 FORMAT (10X,I2,' words I/O characteristic for UHV =')
151 9114 FORMAT (10X,I4,' words of User Header accepted, dump the first'
152 F,I5)
153#endif
154#if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
155 9115 FORMAT (1X,4O23)
156#endif
157#if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
158 9115 FORMAT (10X,4Z17)
159#endif
160
161C---- Save the segment table
162
163 121 LFISEG = LQFI + JAUSEG
164 IF (NWSEGI.EQ.0) GO TO 124
165 IF (NWSEGI.GE.61) GO TO 744
166 IF (NWSEGI.LT.0) GO TO 744
167 IF (NWTABI.EQ.0) THEN
168 NWDONE = NWDONE + NWSEGI
169 NWSEGI = 0
170 ELSE
171 CALL UCOPY (LQ(LIN+NWDONE),IQ(KQSP+LFISEG+1),NWSEGI)
172 NWDONE = NWDONE + NWSEGI
173 ENDIF
174 124 IQ(KQSP+LFISEG) = NWSEGI
175
176C---- Save the text vector
177
178 LTEXT = LQ(KQSP+LQFI-2)
179 IF (LTEXT.NE.0) IQ(KQSP+LTEXT+1)=0
180 IF (NWTXI.EQ.0) GO TO 141
181
182C-- Increase the size of the text buffer if necessary
183
184 IF (LTEXT.EQ.0) GO TO 131
185 NINC = NWTXI + 4 - IQ(KQSP+LTEXT-1)
186 IF (NINC.LE.0) GO TO 131
187
188 NQWKTB = NQWKTT
189 CALL MZPUSH (JQPDVS,LTEXT,0,NINC,'.')
190
191C-- Read the text vector
192
193 131 IF (NWDONE.LT.NWR) GO TO 136
194 132 LIN = LQWKTB
195 NWR = NQWKTT
196 CALL XINBS (LUNI,MRTYP,1,LQ(LIN),NWR)
197#if defined(CERNLIB_QDEBPRI)
198 IF (LOGLVI.GE.3) WRITE (IQLOG,9132) NRECAI+1,NWR,MRTYP
199 9132 FORMAT (10X,'expect pilot continuation, seen LR #',I7,
200 F' with NWRL/LRTYP=',I7,I3)
201#endif
202 IF (NWR.EQ.0) GO TO 411
203 IF (NWR.LT.0) GO TO 751
204 NRECAI = NRECAI + 1
205 NWRDAI = NWRDAI + NWR + 3
206
207 IF (MRTYP-4) 134, 135, 133
208 133 IF (MRTYP.LT.7) GO TO 132
209 134 LRTYP = MRTYP
210 IF (LRTYP.EQ.1) GO TO 424
211 GO TO 731
212
213 135 NWDONE = 0
214
215C-- Store into the text buffer
216
217 136 IF (NWR-NWDONE.LT.NWTXI) GO TO 745
218 IF (LTEXT.NE.0) THEN
219 IQ(KQSP+LTEXT+1) = NWTXI
220 CALL UCOPY (LQ(LIN+NWDONE),IQ(KQSP+LTEXT+5),NWTXI)
221 ENDIF
222 NWDONE = NWDONE + NWTXI
223
224C---- Save early table words
225
226 141 NTBE = NWR - NWDONE
227 LFIEAR = LQFI + JAUEAR
228 IQ(KQSP+LFIEAR) = NTBE
229
230 IF (NTBE.NE.0) THEN
231 IF (NTBE.NE.NWTABI) GO TO 746
232 IF (NTBE.GE.41) GO TO 746
233 CALL UCOPY (LQ(LIN+NWDONE),IQ(KQSP+LFIEAR+1),NTBE)
234 ENDIF
235 GO TO 999
236
237C-------------------------------------------------
238C- read table
239C-------------------------------------------------
240
241 201 LIN = LQTA + NWTABI
242 204 NWR = LQTE - LIN
243 CALL XINBS (LUNI,LRTYP,1,LQ(LIN),NWR)
244#if defined(CERNLIB_QDEBPRI)
245 IF (LOGLVI.GE.3) WRITE (IQLOG,9204) NRECAI+1,NWR,LRTYP
246 9204 FORMAT (' FZIFFN- expect table, seen LR #',I7,
247 F' with NWRL/LRTYP=',I7,I3)
248#endif
249 IF (NWR.EQ.0) GO TO 411
250 IF (NWR.LT.0) GO TO 751
251 NRECAI = NRECAI + 1
252 NWRDAI = NWRDAI + NWR + 3
253 IF (LRTYP.EQ.1) GO TO 424
254 IF (LRTYP.LT.4) GO TO 732
255 IF (LRTYP.GE.7) GO TO 732
256 IF (LRTYP.GE.5) GO TO 204
257 LIN = LIN + NWR
258 IF (LIN-LQTE) 204, 999, 747
259
260C-------------------------------------------------
261C- read the data
262C-------------------------------------------------
263
264 301 LMT = LQMTA
265 302 IF (LQ(LMT+1).NE.0) GO TO 311
266
267C-- Skip segment to be ignored
268
269 NWSK = LQ(LMT+3)
270 LIN = LQWKFZ
271#if defined(CERNLIB_QREADFULL)
272 304 NWR = NQWKTT
273 CALL XINBS (LUNI,LRTYP,1,LQ(LIN+2),NWR)
274 IDI(1) = NWR
275 NWRU = NWR
276#endif
277#if !defined(CERNLIB_QREADFULL)
278 304 NWR = 3
279 CALL XINBF (LUNI,LQ(LIN),NWR)
280 IDI(1) = LQ(LIN)
281 IDI(2) = LQ(LIN+1)
282 NWRU = 1
283#endif
284#if defined(CERNLIB_QDEBPRI)
285 IF (LOGLVI.GE.3) WRITE (IQLOG,9314) NRECAI+1,IDI
286#endif
287 IF (NWR.EQ.0) GO TO 411
288 IF (NWR.LT.0) GO TO 751
289 NRECAI = NRECAI + 1
290 NWRDAI = NWRDAI + IDI(1) + 3
291 IF (LRTYP.EQ.1) GO TO 421
292 IF (LRTYP.LT.5) GO TO 733
293 IF (LRTYP.LT.7) GO TO 304
294 IF (LRTYP.GE.9) GO TO 733
295 NWSK = NWSK + IDI(1)
296 IF (NWSK.GE.0) GO TO 307
297 IF (LRTYP.EQ.7) GO TO 304
298 GO TO 734
299
300 307 IF (NWSK.EQ.0) GO TO 318
301 GO TO 734
302
303C-- Read segment to accept
304
305 311 LSTA = LQ(LMT+3)
306 LEND = LQ(LMT+4)
307
308 LIN = LSTA
309 314 NWR = LEND - LIN
310 CALL XINBS (LUNI,LRTYP,1,LQ(KQS+LIN),NWR)
311#if defined(CERNLIB_QDEBPRI)
312 IF (LOGLVI.GE.3) WRITE (IQLOG,9314) NRECAI+1,NWR,LRTYP
313 9314 FORMAT (' FZIFFN- expect bank material, seen LR #',I7,
314 F' with NWRL/LRTYP=',I7,I3)
315#endif
316 IF (NWR.EQ.0) GO TO 411
317 IF (NWR.LT.0) GO TO 751
318 NRECAI = NRECAI + 1
319 NWRDAI = NWRDAI + NWR + 3
320 IF (LRTYP.EQ.1) GO TO 424
321 IF (LRTYP.LT.5) GO TO 733
322 IF (LRTYP.LT.7) GO TO 314
323 IF (LRTYP.GE.9) GO TO 733
324 LIN = LIN + NWR
325 IF (LIN.GE.LEND) GO TO 317
326 IF (LRTYP.EQ.7) GO TO 314
327 GO TO 735
328
329 317 IF (LIN.GT.LEND) GO TO 735
330 318 LMT = LMT + 8
331 IF (LMT.LT.LQMTE) GO TO 302
332 IF (LRTYP.NE.8) GO TO 736
333 GO TO 999
334
335C-------------------------------------------------
336C- end-of-file / end-of-run
337C-------------------------------------------------
338
339C-- Unexpected end-of-file
340
341 411 JRETCD = 1
342 GO TO 999
343
344C-- Normal EOF
345
346 412 JRETCD = -1
347 GO TO 999
348
349C------ Unexpected start/end of run
350
351 421 LIN = LIN + 2
352 NWR = NWRU - 2
353
354 424 JRETCD = 2
355 NWRU = MIN (78, NWR)
356 LFIIOC = LQFI + JAUIOC
357 IQ(KQSP+LFIIOC) = NWRU
358 CALL UCOPY (LQ(LIN),IQ(KQSP+LFIIOC+1),NWRU)
359 GO TO 999
360
361C---- Normal S/E-OF-RUN
362
363 427 JRETCD = -2
364 NWUHI = NWR
365 LUHEAI = LIN
366 GO TO 999
367
368C-------------------------------------------------
369C- ERROR CONDITIONS
370C-------------------------------------------------
371
372C-- BAD DATA
373
374C- JERROR = 137 emergency stop record seen
375 737 JERROR = 137
376 JRETCD = 8
377 GO TO 780
378
379C- JERROR = 136 last bank material record needed is not type 8
380 736 JERROR = 136
381 GO TO 739
382
383C- JERROR = 135 end of segm read does not coincide with LR
384 735 JERROR = 135
385 IQUEST(14)= (LMT-LQMTA)/8 + 1
386 IQUEST(15)= LEND - LSTA
387 IQUEST(16)= LIN - LEND
388 NWERR = 3
389 GO TO 739
390
391C- JERROR = 134 end of segm skipped does not coincide with LR
392 734 JERROR = 134
393 IQUEST(14)= (LMT-LQMTA)/8 + 1
394 IQUEST(15)= -LQ(LMT+3)
395 IQUEST(16)= NWSK
396 NWERR = 3
397 GO TO 739
398
399C- record of unexpected record type read
400C- JERROR = 133 expect bank material
401 733 JERROR = 1
402
403C- JERROR = 132 expect pilot continuation for table
404 732 JERROR = JERROR + 1
405
406C- JERROR = 131 expect pilot continuation for text vector
407 731 JERROR = 131 + JERROR
408 IF (LRTYP.EQ.9) GO TO 737
409
410 739 JRETCD = 5
411 GO TO 780
412
413C-- BAD CONSTRUCTION
414
415C- JERROR = 147 table end does not coincide with LR
416 747 JERROR = 147
417 IQUEST(14)= NWTABI
418 IQUEST(15)= LIN - LQTE
419 NWERR = 2
420 GO TO 749
421
422C- JERROR = 146 number of early table words wrong
423 746 JERROR = 146
424 IQUEST(14)= NWTABI
425 IQUEST(15)= NTBE
426 NWERR = 2
427 GO TO 749
428
429C- JERROR = 145 text vector NWTXI words longer than its record
430 745 JERROR = 145
431 IQUEST(14)= NWTXI
432 IQUEST(15)= NWR - NWDONE
433 IQUEST(16)= NWDONE
434 NWERR = 3
435 GO TO 749
436
437C- JERROR = 144 NWSEGI wrong
438 744 JERROR = 144
439 IQUEST(14)= NWSEGI
440 NWERR = 1
441 GO TO 749
442
443C- JERROR = 143 control wd of I/O char. for user header invalid
444 743 JERROR = 143
445 IQUEST(14)= NWUHCI
446 IQUEST(15)= 0
447 IQUEST(16)= IOCHI(1)
448 NWERR = 3
449 GO TO 749
450
451C- JERROR = 142 check-word which should be 12345.0 is wrong
452 742 JERROR = 142
453 IQUEST(14)= 0
454 IQUEST(15)= 0
455 IQUEST(16)= IPILI(1)
456 IQUEST(17)= ICHDAT
457 NWERR = 4
458 GO TO 749
459
460C- JERROR = 141 LRTYP invalid when hunting for pilot
461 741 JERROR = 141
462
463 749 JRETCD = 6
464 GO TO 780
465
466C-- READ ERROR
467
468 751 JERROR = 151
469 IQUEST(14) = -NWR
470 NWERR = 1
471 JRETCD = 7
472
473 780 CONTINUE
474#include "zebra/qtrace99.inc"
475 RETURN
476 END
477* ==================================================
478#include "zebra/qcardl.inc"
479#endif