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