]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/fq/fzipha.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Use tgt_ prefix for binary target directories
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / fq / fzipha.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:11 mclareni
9* Zebra
10*
11*
12#include "zebra/pilot.h"
13#if defined(CERNLIB_FZALFA)
14 SUBROUTINE FZIPHA
15
16C- Read next physical record image in ALFA exchange mode
17C- Service routine to FZIN, called only via FZIREC
18
19C- Input : IFLAGI = 0 normal read
20C- -1 recover to next steering block
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/zstate.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 "fzstamp.inc"
39
40#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
41 DIMENSION NAMESR(2)
42 DATA NAMESR / 4HFZIP, 4HHA /
43#endif
44#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
45 DATA NAMESR / 6HFZIPHA /
46#endif
47#if !defined(CERNLIB_QTRHOLL)
48 CHARACTER NAMESR*8
49 PARAMETER (NAMESR = 'FZIPHA ')
50#endif
51
52
53#include "zebra/qtrace.inc"
54
55C---- Skip to next steering block
56
57 IF (IFLAGI.LT.0) THEN
58 NFASTI = 0
59 NRSKIP = 1
60 GO TO 20
61 ENDIF
62
63C---- Dedide skip of fast records
64
65 N4SKIP = MIN (N4SKII,N4RESI)
66 NFASTI = IQ(KQSP+LBPARI-5)
67 NRSKIP = 0
68 IF (N4SKIP.LT.MAXREI) GO TO 20
69 IF (NFASTI.EQ.0) GO TO 20
70 NRSKIP = MIN (NFASTI, N4SKIP / MAXREI)
71
72 20 NW4IN = MAXREI
73 IQ(KQSP+LBPARI-6) = NFASTI
74
75
76C---- Read one physical record
77
78 31 NBLK = IQ(KQSP+LQFI+22) + 1
79#if defined(CERNLIB_QDEBPRI)
80 IF (LOGLVI.GE.3)
81 + WRITE (IQLOG,9031) NBLK,NW4IN,NFASTI,NRSKIP
82 9031 FORMAT (1X/' FZIPHA- Reading Block',I7,
83 F', NW32,NRfast,NRskip=',4I6)
84#endif
85
86 CALL FZIASC (NRSKIP)
87 IF (IQUEST(1)) 841, 33, 818
88 33 JFASTR = IQUEST(92)
89
90 IQ(KQSP+LQFI+22) = NBLK
91 NWRDAI = NWRDAI + MAXREI
92
93 IF (JFASTR.EQ.0) THEN
94 LQ(L4STAI) = MCCW1
95 LQ(L4STAI+1) = MCCW2
96 LQ(L4STAI+2) = MCCW3
97 LQ(L4STAI+3) = MCCW4
98 ENDIF
99
100C-- Short/full dump of record read
101
102#if defined(CERNLIB_QDEBPRI)
103 IF (LOGLVI.LT.3) GO TO 51
104 IF (JFASTR.NE.0) THEN
105 IF (NRSKIP.NE.0) GO TO 51
106 ENDIF
107
108 CALL FZIDUM (LQ(L4STAI),NW4IN)
109#endif
110
111C-----------------------------------------------------------
112C---- Fast record expected
113C-----------------------------------------------------------
114
115 51 IF (NFASTI.EQ.0) GO TO 61
116 IF (JFASTR.EQ.0) GO TO 54
117 NFASTI = NFASTI - 1
118 IQ(KQSP+LBPARI-5) = NFASTI
119 IF (NRSKIP.EQ.0) GO TO 53
120
121C-- skip record
122 N4SKII = N4SKII - MAXREI
123 N4RESI = N4RESI - MAXREI
124 NRSKIP = NRSKIP - 1
125 GO TO 20
126
127C-- deliver record
128 53 N4DONI = 0
129 N4ENDI = MIN (N4RESI,MAXREI)
130 IFLAGI = 0
131#include "zebra/qtrace99.inc"
132 RETURN
133
134C-- Unexpected steering record
135
136 54 CALL FZICHH (0, LQ(L4STAI),0)
137 IF (IQUEST(1).NE.0) GO TO 807
138
139 N4ENDI = NTLRI
140 IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
141 GO TO 808
142
143C-----------------------------------------------------------
144C---- Steering record expected
145C-----------------------------------------------------------
146
147 61 IF (JFASTR.NE.0) GO TO 71
148 CALL FZICHH (0, LQ(L4STAI),IFLAGI)
149 IF (IQUEST(1).NE.0) GO TO 72
150 N4ENDI = NTLRI
151
152 IF (IFLAGI.LT.0) GO TO 73
153
154 N4DONI = 8
155 IF (N4ENDI.EQ.0) N4ENDI=MAXREI
156
157 62 IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
158 IF (JRECI.NE.0) JRECI = JRECI + 1
159 IQ(KQSP+LBPARI-7) = JRECI
160 IQ(KQSP+LBPARI-5) = NFSTI
161 IFLAGI = 0
162 GO TO 999
163
164C-- Recover to next steering record
165
166 71 IF (IFLAGI.EQ.-1) GO TO 20
167 GO TO 803
168
169 72 IF (IQUEST(1).EQ.3) GO TO 802
170 IF (IFLAGI.EQ.-1) GO TO 20
171 GO TO 801
172
173C-- Recovery to this steering record
174
175 73 IF (NTLRI.EQ.0) GO TO 20
176 N4DONI = NTLRI
177 GO TO 62
178
179C-----------------------------------------------------------
180C- ERROR CONDITIONS
181C-----------------------------------------------------------
182
183
184C- JERROR = 301 Block header faulty
185 801 JERROR = 301
186 GO TO 817
187
188C- JERROR = 302 Block size does not match expectation
189 802 JERROR = 302
190 IQUEST(14) = MAXREI
191 IQUEST(15) = NWRI
192 NWERR = 2
193 GO TO 817
194
195C- JERROR = 303 Unexpected fast record
196 803 JERROR = 303
197 GO TO 817
198
199C- JERROR = 307 Unexpected and faulty steering block
200 807 JERROR = 307
201 GO TO 817
202
203C- JERROR = 308 Unexpected but valid steering block
204 808 JERROR = 308
205 IQUEST(14) = NTLRI
206 IQUEST(15) = LQ(L4STAI+8)
207 IQUEST(16) = LQ(L4STAI+9)
208 NWERR = 3
209 JRETCD = 5
210
211 IQ(KQSP+LBPARI-7) = 0
212 IQ(KQSP+LBPARI-6) = 0
213 IQ(KQSP+LBPARI-5) = NFSTI
214 IQ(KQSP+LBPARI-1) = N4ENDI
215 GO TO 819
216
217 817 JRETCD = 6
218 818 IQ(KQSP+LBPARI-1) = 0
219 819 IQ(KQSP+LBPARI-9)= -1
220 820 IFLAGI = 1
221 GO TO 999
222
223C-- EoF seen
224
225 841 JRETCD = 1
226 IQ(KQSP+LBPARI-7) = 0
227 IQ(KQSP+LBPARI-5) = 0
228 IQ(KQSP+LBPARI-1) = 0
229 GO TO 820
230 END
231* ==================================================
232#include "zebra/qcardl.inc"
233#endif