]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/fq/fzirec.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 / fzirec.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
6* Zebra
7*
8*
9#include "zebra/pilot.h"
10 SUBROUTINE FZIREC
11
12C- Logical record controls, exchange file format
13C- service routine to FZIFFX of FZIN
14
15C- This routine is called with
16C- IFLAGI > 0 from FZIFFX to initiate the next d/s making sure
17C- that the block containing its beginning is
18C- in the buffer, skipping if nec. trailing records
19C- of the previous d/s
20C- = 0 from FZIFFX to copy the buffer control params.
21C- between the control-bank and /FZCI/ (for speed)
22C- < 0 from FZITR to read continuation blocks (phR)
23C- into the buffer
24
25#include "zebra/zunit.inc"
26#include "zebra/mqsys.inc"
27#include "zebra/eqlqf.inc"
28#include "zebra/fzci.inc"
29C-------------- End CDE --------------
30#include "fzntolds.inc"
31#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
32 DIMENSION NAMESR(2)
33 DATA NAMESR / 4HFZIR, 4HEC /
34#endif
35#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
36 DATA NAMESR / 6HFZIREC /
37#endif
38#if !defined(CERNLIB_QTRHOLL)
39 CHARACTER NAMESR*8
40 PARAMETER (NAMESR = 'FZIREC ')
41#endif
42
43
44#include "zebra/qtrace.inc"
45
46
47C- buffer parameters :
48C-
49C- -9 non-zero : last LR abended
50C- -7 expected next Ph record number
51C- -6 =0 if current block is steering
52C- =1 if current block is last in burst
53C- =2 if cur. block is last-but-one in burst, etc
54C- -5 # of fast records still pending
55C-
56C- -4 N4SKII, # of words to be skipped
57C- before next transmission
58C- -3 N4RESI, # of words in LR still to be done
59C- -2 N4DONI, # of words already out of buffer
60C- -1 N4ENDI, # of words in buffer before start of next LR
61C- if =0 : buffer empty
62C- if =MAXREI : LR continues in next block
63C- LBPARI +0 maximum size of buffer, words
64C- +1 expected size of PhR, local machine words
65C- +2 INCBUF step to buffer
66C- +3 off-set from start-of-buffer for reading
67C- the packed record
68C- +4 (off-set for output)
69C- -1 space for left double-precision word saved
70C- L4STAI +0 first word of normal buffer
71
72 IFLIN = IFLAGI
73 IFLAGI = 0
74 LBPARI = LQFI + INCBPI
75 IF (IFLIN) 61, 71, 21
76
77C-----------------------------------------------------------
78C------ IFLAGI > 0 : start new d/s
79C-----------------------------------------------------------
80
81 21 ICARRL = 0
82 IFLRST = IQ(KQSP+LBPARI-9)
83 INCBUF = IQ(KQSP+LBPARI+2)
84 L4STAI = KQSP+8 + LBPARI + INCBUF
85
86 NLRPAD = 0
87 JFAST = IQ(KQSP+LBPARI-6)
88 N4SKII = 0
89 N4ENDI = IQ(KQSP+LBPARI-1)
90#if defined(CERNLIB_QDEBPRI)
91 IF (LOGLVI.GE.3)
92 + WRITE (IQLOG,9022) IFLIN,IFLRST,JFAST,N4ENDI,MAXREI
93 9022 FORMAT (1X/' FZIREC- Going for next LR, Buffer Status :'
94 F/10X,'IFLAGI, Restart?, Fast?, NWtoLR, NWbuf =',6I6)
95#endif
96
97C-- Re-start LR after error
98
99 IF (IFLRST.NE.0) THEN
100 IQ(KQSP+LBPARI-9) = 0
101 IF (N4ENDI.GT.0) THEN
102 IF (N4ENDI.LT.MAXREI-1) GO TO 51
103 ENDIF
104 IFLAGI = -1
105 GO TO 27
106 ENDIF
107
108C-- Start afresh
109
110 IF (N4ENDI.NE.0) GO TO 31
111 IFLAGI = -2
112 27 CALL VZERO (IQ(KQSP+LBPARI-8),8)
113 N4RESI = 0
114 N4DONI = 0
115 GO TO 46
116
117C---- Normal continuation on current buffer
118
119 31 N4RESI = IQ(KQSP+LBPARI-3)
120 N4DONI = IQ(KQSP+LBPARI-2)
121#if defined(CERNLIB_QDEBPRI)
122 IF (LOGLVI.GE.3) WRITE (IQLOG,9031) N4RESI,N4DONI,N4ENDI
123 9031 FORMAT (10X,'Status of last LR : NWrest, NWdone, NWend ='
124 F,3I5)
125#endif
126
127C-- Skip trailing words of last LR
128
129 IF (N4RESI.EQ.0) GO TO 41
130 34 NWNEW = MIN (N4ENDI-N4DONI, N4RESI)
131 N4DONI = N4DONI + NWNEW
132 N4RESI = N4RESI - NWNEW
133 IF (N4RESI.EQ.0) GO TO 41
134 IF (N4ENDI.NE.MAXREI) GO TO 821
135 N4SKII = N4RESI
136 NWFAST = IQ(KQSP+LBPARI-5) * MAXREI
137 IF (NWFAST.LE.N4SKII) GO TO 46
138 N4SKII = NWFAST
139 N4RESI = NWFAST
140 IFLAGI = -2
141 GO TO 46
142
143C-- New Ph record if buffer exhausted
144
145 41 IF (N4DONI.NE.N4ENDI) GO TO 822
146 ICARRL = 0
147 IF (N4ENDI.LT.MAXREI-1) GO TO 51
148 IF (N4ENDI.GT.MAXREI-1) GO TO 46
149 MCARRL = LQ(L4STAI+MAXREI-1)
150 IF (MCARRL.EQ.0) GO TO 46
151 ICARRL = 1
152 JRECNO = IQ(KQSP+LQFI+33)
153 JDSADR = N4ENDI
154 JFAST = IQ(KQSP+LBPARI-6)
155#if defined(CERNLIB_QDEBPRI)
156 IF (LOGLVI.GE.3) WRITE (IQLOG,9043) MCARRL
157 9043 FORMAT (' FZIREC- Saved LR length',I6,' across to next PhR')
158#endif
159
160 46 IF (IFIFOI.LE.1) THEN
161 CALL FZIPHR
162#if defined(CERNLIB_FZDACC)
163 ELSEIF (IFIFOI.EQ.2) THEN
164 CALL FZIPHD
165#endif
166#if defined(CERNLIB_FZMEMORY)
167 ELSEIF (IFIFOI.EQ.3) THEN
168 CALL FZIPHM
169#endif
170#if defined(CERNLIB_FZALFA)
171 ELSEIF (IFIFOI.EQ.4) THEN
172 CALL FZIPHA
173#endif
174 ENDIF
175
176C-- read failure ?
177 IF (IFLAGI.NE.0) THEN
178 IF (IFLIN.GT.0) THEN
179 IF (JRETCD.EQ.1) JRETCD=-1
180 ENDIF
181 GO TO 999
182 ENDIF
183
184C-- LR length last word of previous block ?
185 IF (ICARRL.NE.0) THEN
186 N4ENDI = N4DONI - 1
187 LQ(L4STAI+N4ENDI) = MCARRL
188 ENDIF
189
190C-- still discarding previous d/s ?
191 IF (IFLIN.GT.0) THEN
192 IF (N4RESI.GT.0) GO TO 34
193 ENDIF
194
195C---- Start new logical record
196
197 51 N4DONI = N4ENDI
198 N4SKII = 0
199 IF (N4ENDI.EQ.MAXREI-1) GO TO 41
200 IF (ICARRL.EQ.0) THEN
201 JRECNO = IQ(KQSP+LQFI+33)
202 JDSADR = N4DONI
203 JFAST = IQ(KQSP+LBPARI-6)
204 ENDIF
205 ICARRL = 0
206 L4CURI = L4STAI + N4DONI + 2
207 IDI(1) = LQ(L4CURI-2)
208 IDI(2) = LQ(L4CURI-1)
209 IF (IDI(1).EQ.0) IDI(2)=5
210#if defined(CERNLIB_QDEBPRI)
211 IF (LOGLVI.GE.3) WRITE (IQLOG,9053) JFAST,N4DONI,IDI
212 9053 FORMAT (' FZIREC- Start LR : Fast?, NWdone, Length, Type='
213 F,I5,I6,I8,I3)
214#endif
215 N4RESI = IDI(1)
216 IF (N4RESI.LT.0) GO TO 826
217 IF (N4RESI.GT.NTOLDS) GO TO 826
218 IF (IDI(2).GE.5) GO TO 57
219 IF (IDI(2).EQ.4) GO TO 53
220
221C-- LR type 1, 2, 3
222
223 IF (IDI(2).LE.0) GO TO 825
224 IF (IFLIN.LT.0) GO TO 824
225 IF (JFAST.NE.0) GO TO 827
226 IQ(KQSP+LQFI+31) = JRECNO
227 IQ(KQSP+LQFI+32) = JDSADR
228
229 53 N4DONI = N4DONI + 2
230 N4ENDI = MIN (MAXREI, N4DONI+N4RESI)
231 L4ENDI = L4STAI + N4ENDI
232 NRECAI = NRECAI + 1
233 IF (IFLIN.GE.0) GO TO 77
234 N4SKII = NSKISV
235 GO TO 77
236
237C-- Skip padding records
238
239 57 IF (IDI(2).GE.7) GO TO 825
240 IF (N4RESI.GT.MAXREI) GO TO 828
241 NLRPAD = NLRPAD + 1
242 IF (NLRPAD.GE.5) GO TO 829
243 N4DONI = N4DONI + 1
244 N4ENDI = MIN (MAXREI, N4DONI+N4RESI)
245
246 NWNEW = MIN (N4ENDI-N4DONI, N4RESI)
247 N4DONI = N4DONI + NWNEW
248 N4RESI = N4RESI - NWNEW
249 GO TO 41
250
251C-----------------------------------------------------------
252C------ IFLAGI = -1 : ready continuation Ph / L record
253C-----------------------------------------------------------
254
255 61 ICARRY = 0
256 N4DONI = L4CURI - L4STAI
257 NWNEW = N4DONI - IQ(KQSP+LBPARI-2)
258 N4RESI = N4RESI - NWNEW
259
260 IF (N4DONI.EQ.MAXREI+1) THEN
261 ICARRY = 1
262 MCARRY = LQ(L4CURI-2)
263 N4RESI = N4RESI + 1
264 ENDIF
265
266#if defined(CERNLIB_QDEBPRI)
267 IF (LOGLVI.GE.3) WRITE (IQLOG,9061) N4RESI,N4DONI,MAXREI,ICARRY
268 9061 FORMAT (1X/' FZIREC- Need continuation PhR/LR, Buffer Status :'
269 F/10X,'Rest LR, NWdone, NWbuf, NWcarry =',3I7,I4)
270#endif
271
272C-- Start continuation LR
273
274 IF (N4RESI.EQ.0) THEN
275 NLRPAD = 0
276 NSKISV = N4SKII
277 N4SKII = 0
278 GO TO 41
279 ENDIF
280
281C-- Get continuation PhR
282
283 IF (IFIFOI.LE.1) THEN
284 CALL FZIPHR
285#if defined(CERNLIB_FZDACC)
286 ELSEIF (IFIFOI.EQ.2) THEN
287 CALL FZIPHD
288#endif
289#if defined(CERNLIB_FZMEMORY)
290 ELSEIF (IFIFOI.EQ.3) THEN
291 CALL FZIPHM
292#endif
293#if defined(CERNLIB_FZALFA)
294 ELSEIF (IFIFOI.EQ.4) THEN
295 CALL FZIPHA
296#endif
297 ENDIF
298 IF (IFLAGI.NE.0) GO TO 999
299
300 L4CURI = L4STAI + N4DONI
301 L4ENDI = L4STAI + N4ENDI
302
303 IF (ICARRY.NE.0) THEN
304 N4RESI = N4RESI + 1
305 N4DONI = N4DONI - 1
306 L4CURI = L4CURI - 1
307 LQ(L4CURI) = MCARRY
308 ENDIF
309 GO TO 77
310
311C-----------------------------------------------------------
312C------ IFLAGI = 0 : set buffer parameters
313C-----------------------------------------------------------
314
315 71 IF (L4STAI.NE.0) GO TO 74
316
317C-- Copy parameters from control bank to COMMON
318
319 N4SKII = IQ(KQSP+LBPARI-4)
320 N4RESI = IQ(KQSP+LBPARI-3)
321 N4DONI = IQ(KQSP+LBPARI-2)
322 N4ENDI = IQ(KQSP+LBPARI-1)
323 INCBUF = IQ(KQSP+LBPARI+2)
324 L4STAI = KQSP+8 + LBPARI + INCBUF
325 L4CURI = L4STAI + N4DONI
326 L4ENDI = L4STAI + N4ENDI
327 GO TO 999
328
329C-- Up-date parameters in control bank
330
331 74 N4DONI = L4CURI - L4STAI
332 NWNEW = N4DONI - IQ(KQSP+LBPARI-2)
333 N4RESI = N4RESI - NWNEW
334
335 77 IQ(KQSP+LBPARI-4) = N4SKII
336 IQ(KQSP+LBPARI-3) = N4RESI
337 IQ(KQSP+LBPARI-2) = N4DONI
338 IQ(KQSP+LBPARI-1) = N4ENDI
339
340#include "zebra/qtrace99.inc"
341 RETURN
342
343C-----------------------------------------------------------
344C- ERROR CONDITIONS
345C-----------------------------------------------------------
346
347C- JERROR = 221 LR overshoots physical record control
348 821 JERROR = 221
349 IQUEST(14) = N4DONI
350 IQUEST(15) = N4RESI
351 NWERR = 2
352 GO TO 871
353
354C- JERROR = 222 LR undershoots physical record control
355 822 JERROR = 222
356 IQUEST(14) = N4DONI
357 IQUEST(15) = N4ENDI
358 NWERR = 2
359 GO TO 871
360
361C- JERROR = 223 LR expected to start at start of new PhR
362C!823 JERROR = 223
363C! IQUEST(14) = N4ENDI
364C! NWERR = 1
365C! GO TO 871
366
367C- JERROR = 224 LR type 1,2,3 seen when 4 expected
368 824 JERROR = 224
369 IQUEST(14) = N4ENDI
370 NWERR = 1
371 GO TO 871
372
373
374C- JERROR = 225 Faulty LR type
375 825 JERROR = -1
376
377C- JERROR = 226 Faulty LR length
378 826 JERROR = JERROR - 1
379
380C- JERROR = 227 LR of type 1,2,3 must start on steering block
381 827 JERROR = JERROR - 1
382
383C- JERROR = 228 Padding record longer than one physical record
384 828 JERROR = JERROR - 1
385
386C- JERROR = 229 More than 4 padding records in a row
387 829 JERROR = 229 + JERROR
388
389 IQUEST(14) = N4DONI
390 IQUEST(15) = N4RESI
391 IQUEST(16) = IDI(2)
392 NWERR = 3
393 N4ENDI = 0
394
395 871 IQ(KQSP+LBPARI-9) = -2
396 IFLAGI = -2
397 JRETCD = 6
398 GO TO 77
399 END
400* ==================================================
401#include "zebra/qcardl.inc"