]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/fq/fziphr.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / fq / fziphr.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/18 16:10:41 mclareni
6* Incorporate changes from J.Zoll for version 3.77
7*
8* Revision 1.1.1.1 1996/03/06 10:47:15 mclareni
9* Zebra
10*
11*
12#include "zebra/pilot.h"
13 SUBROUTINE FZIPHR
14
15C- Read next physical record in sequential mode
16C- Service routine to FZIN, called only via FZIREC
17
18C- Input : IFLAGI = 0 normal read
19C- -1 recover to next steering block
20C- -2 start
21
22C- N4SKII is used for rapid skip of fast blocks
23
24C- Output : IFLAGI = 0 all is well
25C- otherwise : ready for re-start
26
27#include "zebra/zbcd.inc"
28#include "zebra/zmach.inc"
29#include "zebra/zunit.inc"
30#include "zebra/mqsys.inc"
31#include "zebra/eqlqf.inc"
32#include "zebra/fzci.inc"
33#include "fzhci.inc"
34C-------------- End CDE --------------
35
36* Declaratives, DIMENSION etc.
37#include "fziphrd1.inc"
38* Ignoring t=pass
39
40#include "fzstamp.inc"
41#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
42 DIMENSION NAMESR(2)
43 DATA NAMESR / 4HFZIP, 4HHR /
44#endif
45#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
46 DATA NAMESR / 6HFZIPHR /
47#endif
48#if !defined(CERNLIB_QTRHOLL)
49 CHARACTER NAMESR*8
50 PARAMETER (NAMESR = 'FZIPHR ')
51#endif
52
53* Declaratives, DATA
54#include "fziphrd2.inc"
55* Ignoring t=pass
56
57
58#include "zebra/qtrace.inc"
59
60C---- DECIDE START ADR AND LENGTH FOR READ
61
62 NWMREC = IQ(KQSP+LBPARI+1)
63 NFASTI = IQ(KQSP+LBPARI-5)
64 N4SKIP = MIN (N4SKII,N4RESI)
65 NRSKIP = 0
66 IF (N4SKIP.GE.MAXREI) THEN
67 IF (NFASTI.NE.0) NRSKIP = MIN (NFASTI, N4SKIP / MAXREI)
68 ENDIF
69
70 20 NW4IN = MAXREI
71 NWMIN = NWMREC
72
73 IQ(KQSP+LBPARI-6) = NFASTI
74
75 LIN = L4STAI
76#if !defined(CERNLIB_QREADFULL)
77 IF (NRSKIP.GE.2) THEN
78 NW4IN = 90
79 NWMIN = NW4IN
80 ENDIF
81#endif
82#if defined(CERNLIB_FQNEEDPK)
83 IF (IUPAKI.NE.0) GO TO 31
84
85C-- Exchange Data Format needing to be unpacked
86
87 LIN = LIN + IQ(KQSP+LBPARI+3)
88#endif
89#if (!defined(CERNLIB_QREADFULL))&&(defined(CERNLIB_FQNEEDPK))
90 IF (NW4IN.EQ.MAXREI) GO TO 31
91#include "fznwmach.inc"
92* Ignoring t=pass
93#endif
94
95C---- READ ONE PHYSICAL RECORD
96
97 31 IQ(KQSP+LQFI+33) = IQ(KQSP+LQFI+33) + 1
98 NBLK = IQ(KQSP+LQFI+22) + 1
99#if defined(CERNLIB_QDEBPRI)
100 IF (LOGLVI.GE.3)
101 + WRITE (IQLOG,9031) NBLK,NW4IN,NWMIN,NFASTI,NRSKIP
102 9031 FORMAT (1X/' FZIPHR- Reading Block',I7,
103 F', NW32,NWmach,NRfast,NRskip=',4I6)
104
105#endif
106#if defined(CERNLIB_FZLIBC)
107 IF (IACMOI.EQ.2) THEN
108 NWR = NWMREC
109 CALL CFGET (IADOPI, MEDIUI, NWMREC, NWR, LQ(LIN), ISW)
110 IF (ISW.EQ.-1) GO TO 841
111 IF (ISW.NE.0) GO TO 843
112 IF (NWR.EQ.NWMREC) NW4IN = MAXREI
113 GO TO 39
114 ENDIF
115
116#endif
117#if defined(CERNLIB_FZCHANNEL)
118 IF (IACMOI.EQ.3) THEN
119 CALL JUMPST (IADOPI)
120 ICODE = 0
121 IQUEST(1) = LUNI
122 IQUEST(2) = NWMREC
123 IQUEST(3) = ISTENI
124 IQUEST(4) = 0
125 IQUEST(5) = MEDIUI - 4
126 IQUEST(6) = NWMREC
127 CALL JUMPX2 (LQ(LIN),ICODE)
128 ISW = IQUEST(1)
129 IF (ISW.LT.0) GO TO 841
130 IF (ISW.NE.0) GO TO 843
131 NWR = IQUEST(2)
132 IF (NWR.EQ.NWMREC) NW4IN = MAXREI
133 GO TO 39
134 ENDIF
135
136#endif
137#if defined(CERNLIB_FZFORTRAN)
138#include "fziphr32.inc"
139 36 NWR = NWMIN
140 CALL XINBF (LUNI,LQ(LIN),NWR)
141 IF (NWR.EQ.0) GO TO 841
142 ISW = -NWR
143 IF (NWR.LT.0) GO TO 843
144 NWR = MIN (NWR,NWMIN)
145#endif
146 39 IQ(KQSP+LQFI+22) = NBLK
147 NWRDAI = NWRDAI + MAXREI
148 NW4USE = NW4IN
149
150C---- UNPACK / BYTE-SWOP
151
152#if defined(CERNLIB_FQNEEDCV)
153 IF (IUPAKI.NE.0) GO TO 47
154 IF (NRSKIP.NE.0) NW4USE = 8
155 IF (IFLAGI.EQ.-1) NW4USE = 8
156
157#endif
158#if defined(CERNLIB_FQNEEDCV)
159#include "fziphr42.inc"
160#endif
161
162C-- Short/full dump of record read
163
164 47 CONTINUE
165#if defined(CERNLIB_QDEBPRI)
166 IF (LOGLVI.GE.3) CALL FZIDUM (LQ(L4STAI),NW4USE)
167#endif
168
169C-----------------------------------------------------------
170C---- FAST RECORD EXPECTED
171C-----------------------------------------------------------
172
173 IF (NFASTI.EQ.0) GO TO 61
174 IF (LQ(L4STAI).EQ.MCCW1) GO TO 54
175 52 NFASTI = NFASTI - 1
176 IQ(KQSP+LBPARI-5) = NFASTI
177 IF (NRSKIP.EQ.0) GO TO 53
178
179C-- skip record
180 N4SKII = N4SKII - MAXREI
181 N4RESI = N4RESI - MAXREI
182 NRSKIP = NRSKIP - 1
183 GO TO 20
184
185C-- deliver record
186 53 N4DONI = 0
187 N4ENDI = MIN (N4RESI,MAXREI)
188 IFLAGI = 0
189#include "zebra/qtrace99.inc"
190 RETURN
191
192C---- Unexpected steering record
193
194 54 CALL FZICHH (0, LQ(L4STAI),1)
195 IF (IQUEST(1).EQ.0) GO TO 52
196#if defined(CERNLIB_FQNEEDCV)
197C-- Unpack all words read
198 IF (NW4USE.LT.NW4IN) THEN
199 NW4USE = NW4IN
200 GO TO 42
201 ENDIF
202#endif
203
204 IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
205 N4ENDI = NTLRI
206 IF (JMODI.EQ.4) GO TO 809
207 IF (NW4IN.EQ.MAXREI) GO TO 808
208
209C-- recover start/end-of-run in partially read record
210
211 IF (JMODI.EQ.0) GO TO 806
212 IF (JMODI.GT.2) GO TO 806
213 IF (NTLRI+3.GT.NW4IN) GO TO 805
214
215 LRCUR = L4STAI + NTLRI + 1
216 LRLG = LQ(LRCUR-1)
217 LRTP = LQ(LRCUR)
218 IF (LRLG.LT.1) GO TO 806
219 IF (LRLG.GT.401) GO TO 806
220 IF (LRTP.NE.1) GO TO 806
221 IF (LQ(LRCUR+1).LT.0) GO TO 806
222 LRLG = MIN (LRLG, NW4IN-NTLRI-2)
223 NUSED = NTLRI + LRLG + 2
224 LQ(LRCUR-1) = LRLG
225 LRCUR = LRCUR + LRLG + 1
226 LQ(LRCUR) = MAXREI - NUSED - 1
227 LQ(LRCUR+1) = 5
228 NFSTI = 0
229 GO TO 807
230
231C-----------------------------------------------------------
232C---- STEERING RECORD EXPECTED
233C-----------------------------------------------------------
234
235 61 CALL FZICHH (0, LQ(L4STAI),IFLAGI)
236 IF (IQUEST(1).NE.0) GO TO 71
237 N4ENDI = NTLRI
238
239 IF (IFLAGI.LT.0) GO TO 73
240
241 JREX = IQ(KQSP+LBPARI-7)
242 IF (JREX.NE.0) THEN
243 IF (JRECI.NE.0) THEN
244 IF (JRECI.NE.JREX) GO TO 804
245 ENDIF
246 ENDIF
247
248 N4DONI = 8
249 IF (N4ENDI.EQ.0) N4ENDI= MAXREI
250
251 62 IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
252 IF (JRECI.NE.0) JRECI = JRECI + 1
253 IQ(KQSP+LBPARI-7) = JRECI
254 IQ(KQSP+LBPARI-5) = NFSTI
255 IFLAGI = 0
256 GO TO 999
257
258C---- Recover to next steering record
259
260 71 IF (IQUEST(1).EQ.3) GO TO 802
261 IF (IFLAGI.EQ.-1) GO TO 20
262 GO TO 801
263
264C-- Recovery to this steering record
265
266 73 IF (NTLRI.EQ.0) GO TO 20
267#if defined(CERNLIB_FQNEEDCV)
268 IF (NW4USE.LT.NW4IN) THEN
269 NW4USE = NW4IN
270 GO TO 42
271 ENDIF
272#endif
273 N4DONI = NTLRI
274 GO TO 62
275
276C-----------------------------------------------------------
277C- ERROR CONDITIONS
278C-----------------------------------------------------------
279
280
281C- JERROR = 201 Block header faulty
282 801 JERROR = 201
283 GO TO 817
284
285C- JERROR = 202 Block size does not match expectation
286 802 JERROR = 202
287 IQUEST(14) = MAXREI
288 IQUEST(15) = NWRI
289 NWERR = 2
290 GO TO 817
291
292C- JERROR = 204 Break in block sequence number
293 804 JERROR = 204
294 JRETCD = 5
295 IQUEST(14) = JREX
296 IQUEST(15) = JRECI
297 NWERR = 2
298 GO TO 811
299
300C- JERROR = 205 Fast burst stopped by unusable start/end-of-run
301 805 JERROR = -1
302
303C- JERROR = 206 Fast burst stopped by unusable steering block
304 806 JERROR = JERROR - 1
305 N4ENDI = 0
306
307C- JERROR = 207 Fast burst stopped by usable start/end-of-run
308C- in unusable steering block
309 807 JERROR = JERROR - 1
310
311C- JERROR = 208 Fast burst stopped by usable steering block
312 808 JERROR = 208 + JERROR
313 IQUEST(14) = NTLRI
314 IQUEST(15) = LQ(L4STAI+8)
315 IQUEST(16) = LQ(L4STAI+9)
316 NWERR = 3
317 JRETCD = 5
318 GO TO 811
319
320C- JERROR = 209 Emergency stop block
321 809 JERROR = 209
322 JRETCD = 8
323 N4ENDI = 0
324
325 811 IQ(KQSP+LBPARI-7) = 0
326 IQ(KQSP+LBPARI-6) = 0
327 IQ(KQSP+LBPARI-5) = NFSTI
328 IQ(KQSP+LBPARI-1) = N4ENDI
329 GO TO 819
330
331 817 JRETCD = 6
332 818 IQ(KQSP+LBPARI-1) = 0
333 819 IQ(KQSP+LBPARI-9)= -1
334 820 IFLAGI = 1
335 GO TO 999
336
337C-- EoF seen
338
339 841 JRETCD = 1
340 IQ(KQSP+LBPARI-7) = 0
341 IQ(KQSP+LBPARI-5) = 0
342 IQ(KQSP+LBPARI-1) = 0
343 GO TO 820
344
345C-- Read error
346
347 843 JRETCD = 7
348 JERROR = 215
349 NWERR = 1
350 IQUEST(14) = ISW
351 GO TO 818
352 END
353* ==================================================
354#include "zebra/qcardl.inc"