]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/fq/fzout.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 / fzout.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/18 16:10:51 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 SUBROUTINE FZOUT (LUNP,IXDIVP,LENTP,IEVP,CHOPT,NIOP,NUHP,IUHEAD)
14
15C- MAIN SEQUENTIAL OUTPUT ROUTINE, USER CALLED
16
17#include "zebra/zstate.inc"
18#include "zebra/zunit.inc"
19#include "zebra/zvfaut.inc"
20#include "zebra/mqsys.inc"
21#include "zebra/eqlqf.inc"
22#include "zebra/mzct.inc"
23#include "zebra/fzcx.inc"
24C-------------- End CDE --------------
25 DIMENSION LUNP(9),IXDIVP(9),LENTP(9),IEVP(9)
26 DIMENSION NIOP(9),NUHP(9),IUHEAD(99)
27 CHARACTER CHOPT*(*)
28 DIMENSION IUHDAT(3)
29#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
30 DIMENSION NAMESR(2)
31 DATA NAMESR / 4HFZOU, 4HT /
32#endif
33#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
34 DATA NAMESR / 6HFZOUT /
35#endif
36#if !defined(CERNLIB_QTRHOLL)
37 CHARACTER NAMESR*8
38 PARAMETER (NAMESR = 'FZOUT ')
39#endif
40
41#include "zebra/q_jbit.inc"
42#include "zebra/q_jbyt.inc"
43
44#include "zebra/qtrace.inc"
45
46 LUNNX = LUNP(1)
47 IXDIVX = IXDIVP(1)
48 LENTRX = LENTP(1)
49 IEVFLX = IEVP(1)
50 IOCHX(1)= NIOP(1)
51 NWUHOR = MAX (NUHP(1),0)
52 NWUHX = MIN (NWUHOR,400)
53 NWFILX = 0
54 NWMEMT = 0
55 ICOPYX = 0
56
57C-- Set current output unit
58
59 IF (LUNNX.NE.LUNX) CALL FZLOC (LUNNX,2)
60#if defined(CERNLIB_QDEBPRI)
61 IF (LOGLVX.GE.3)
62 + WRITE (IQLOG,9111) LUNNX,LENTRX,IEVFLX,IACTVX,CHOPT
63 9111 FORMAT (1X/' FZOUT- Enter for LUN=',I3,
64 F' LENTRY,IEVFL,IACTV,OPT=',I8,2I3,1X,A)
65
66#endif
67#if defined(CERNLIB_QDEBUG)
68 IF (IQVSTA.NE.0) CALL ZVAUTX
69#endif
70#if defined(CERNLIB_QPRINT)
71 IF (NWUHOR.GT.NWUHX) THEN
72 IF (LOGLVX.GE.-2) WRITE (IQLOG,9112) LUNX,NWUHOR
73 ENDIF
74 9112 FORMAT (1X/' FZOUT. LUN=',I4,' Of ',I4,' user header words',
75 F' only 400 are taken !!!')
76#endif
77#if defined(CERNLIB_FZCHANNEL)
78 IF (IACMOX.EQ.3) THEN
79 IF (IADOPX.EQ.0) GO TO 907
80 ENDIF
81
82#endif
83#if defined(CERNLIB_FZMEMORY)
84 IF (IFIFOX.EQ.3) THEN
85 IADOPX = IQ(KQSP+LQFX+8)
86 IF (IADOPX.EQ.0) GO TO 907
87 IQ(KQSP+LQFX+1) = IADOPX
88 ENDIF
89
90#endif
91C- from FZRUN to 401
92 IF (IEVFLX.LT.0) GO TO 401
93C- from FZENDO to 411
94 IF (IEVFLX.GE.2) GO TO 411
95 IF (IACTVX.GE.16) GO TO 901
96
97 21 NWTXX = 0
98 NWSEGX = 0
99 NWTABX = 0
100 NWBKX = 0
101 NWUHCX = 0
102 NWIOX = 0
103
104C-- Ready I/O characteristic
105
106 IF (NWUHX.EQ.0) GO TO 39
107
108 IF (IOCHX(1)) 34, 32, 33
109 32 IOCHX(1) = 3
110 33 NWIOX = 1
111 IF (IOCHX(1).LT.8) GO TO 38
112 34 NWIOX = JBYT (IOCHX(1), 7,5)
113 J = JBYT (IOCHX(1),12,5)
114 IF (JBYT (IOCHX(1), 1,6).NE.1) GO TO 903
115 IF (NWIOX.GT.16) GO TO 903
116 IF (NWIOX.NE.J+1) GO TO 903
117
118 IF (NWIOX.GT.1) CALL UCOPY (NIOP,IOCHX,NWIOX)
119 38 NWUHCX = NWUHX + NWIOX
120 39 CONTINUE
121
122C---- Ready text vector
123
124 LTEXTX = LQ(KQSP+LQFX-2)
125 IF (LTEXTX.NE.0) CALL FZOTXT
126
127C---- Construct table of material to be written
128
129 CALL UOPTC (CHOPT,'DISZMLNP',IOPTXD)
130 IOPTXN = IOPTXN + IOPTXS + IOPTXZ
131
132 IF (IOPTXZ.NE.0) GO TO 121
133
134 CALL MZSDIV (IXDIVX,0)
135 JQSTMV = -1
136 MODTBX = 0
137 JFLGAX = 0
138 CALL FZOTAB
139 IF (IQUEST(1).NE.0) GO TO 999
140 IF (IOPTXN.NE.0) NWTABX=0
141
142C------ Output of pilot records
143
144 121 IDX(2) = 3
145 IF (IEVFLX.NE.0) IDX(2)=2
146 NWMEMT = 20 + NWUHCX + NWSEGX + NWTXX + NWTABX + NWBKX
147
148#if defined(CERNLIB_QDEBPRI)
149 IF (LOGLVX.EQ.2)
150 +WRITE (IQLOG,9121) LUNX,JQSTOR,LENTRX,NWTABX,NWBKX,IEVFLX,CHOPT
151 9121 FORMAT (' FZOUT- LUN=',I4,' Store/LENTRY=',I3,I9,
152 F' NWTAB,NWBANK=',I5,I7,' Evfl/Opt=',I3,1X,A)
153
154#endif
155#if defined(CERNLIB_FZFFNAT)
156 IF (IFIFOX.EQ.0) THEN
157 CALL FZOFFN (IUHEAD)
158 GO TO 124
159 ENDIF
160#endif
161#if defined(CERNLIB_FZMEMORY)
162 IF (IFIFOX.EQ.3) THEN
163 IF (NWMEMT.GT.IQ(KQSP+LQFX+9)) GO TO 909
164 ENDIF
165#endif
166 CALL FZOFFX (IUHEAD)
167 124 IQ(KQSP+LQFX+15) = IQ(KQSP+LQFX+15) + 1
168
169 IACTVX = 12
170 IF (NWBKX.EQ.0) GO TO 190
171
172C------ Write out material according to table
173
174#if defined(CERNLIB_QDEBPRI)
175 IF (LOGLVX.GE.3) WRITE (IQLOG,9140) NWTABX,NWBKX
176 9140 FORMAT (10X,'NWTAB/NWBK =',2I9)
177#endif
178 IQ(KQSP+LQFX+16) = IQ(KQSP+LQFX+16) + 1
179
180 IDX(2) = 0
181#if defined(CERNLIB_FZFFNAT)
182 IF (IFIFOX.EQ.0) THEN
183 CALL FZOFFN (0)
184 GO TO 191
185 ENDIF
186#endif
187 CALL FZOFFX (0)
188 GO TO 191
189
190C---- Test for pseudo end-of-tape
191
192 190 IQ(KQSP+LQFX+17) = IQ(KQSP+LQFX+17) + 1
193 191 NUM1 = IQ(KQSP+LQFX+19)
194 NUM2 = IQ(KQSP+LQFX+20)
195 192 IF (NUM2.GE.1000000) THEN
196 NUM1 = NUM1 + 1
197 NUM2 = NUM2 - 1000000
198 IQ(KQSP+LQFX+19) = NUM1
199 IQ(KQSP+LQFX+20) = NUM2
200 GO TO 192
201 ENDIF
202
203 LIM1 = IQ(KQSP+LQFX+37)
204 LIM2 = IQ(KQSP+LQFX+38)
205
206 IF (LIM1+LIM2.EQ.0) GO TO 991
207 IF (NUM1-LIM1) 991, 196, 197
208 196 IF (NUM2.LT.LIM2) GO TO 991
209
210 197 IQUEST(1) = 1
211 GO TO 992
212
213C-------------------------------------------------
214C- Write start-of-run
215C- Write end-of-run, end-of-file
216C-------------------------------------------------
217
218C- from FZRUN to 401
219 401 JRUN = LENTRX
220 JRUNCR = IQ(KQSP+LQFX+29)
221 IF (JRUN.LT.0) GO TO 410
222 IF (IACTVX.LT.11) GO TO 406
223 IF (IACTVX.GE.14) GO TO 406
224 JTRA = 1
225 NWUHU = 0
226C- precede start-of-run by end-of-run
227 GO TO 422
228
229C-- Write start-of-run
230
231 406 IACTVX = 11
232 JRUNX = 1
233 JRUN = LENTRX
234 IF (JRUN.EQ.0) JRUN=JRUNCR+1
235 IQ(KQSP+LQFX+29) = JRUN
236 IQ(KQSP+LQFX+14) = IQ(KQSP+LQFX+14) + 1
237#if defined(CERNLIB_QPRINT)
238 IF (LOGLVX.GE.0) WRITE (IQLOG,9406) LUNX,JRUN
239 9406 FORMAT (1X/' FZOUT. LUN=',I4,' Write Start-of-Run ',I6)
240#endif
241 JTRA = 2
242 NWUHU = NWUHX
243 GO TO 424
244
245C- IACTV : last action IEVFL : action requested
246C-
247C- 11 StoR written
248C- 12 d/s written
249C- 13 buffer flushed 13 flush buffer
250C- 14 EOR written 14 write EOR
251C- 15 first EOF written 15 write EoF
252C- 16 second EOF written 16 write EoD
253C- 17 attempted write after eod
254
255 410 IEVFLX = 14
256C- from FZENDO to 411
257 411 IF (IEVFLX.LT.13) GO TO 902
258 IF (IEVFLX.GE.17) GO TO 902
259 IF (IACTVX.LT.11) GO TO 991
260 IF (IEVFLX.LE.IACTVX) GO TO 991
261
262 IF (IEVFLX.GE.14) GO TO 421
263 IACTVX = 13
264 JTRA = 3
265 GO TO 441
266
267C---- Write end-of-run
268
269 421 IF (IACTVX.GE.14) GO TO 461
270 JRUNCR = IQ(KQSP+LQFX+29)
271 JTRA = 4
272 NWUHU = NWUHX
273
274 422 IQ(KQSP+LQFX+13) = IQ(KQSP+LQFX+13) + 1
275#if defined(CERNLIB_QPRINT)
276 IF (LOGLVX.GE.0) WRITE (IQLOG,9421) LUNX,JRUNCR
277 9421 FORMAT (' FZOUT. LUN=',I4,' Write End-of-Run ',I8)
278#endif
279C-- flush the buffer before EoR
280 IF (IACTVX.LT.13) THEN
281 IF (IFIFOX.NE.0) THEN
282 IDX(2) = -1
283 CALL FZOFFX (IUHEAD)
284 ENDIF
285 ENDIF
286 IACTVX = 14
287 JRUNX = 0
288 JRUN = 0
289
290C-- Write StoR/EoR record
291
292 424 IDX(1) = 1 + NWUHU
293 IDX(2) = 1
294 IQUEST(11) = JRUN
295#if defined(CERNLIB_FZFFNAT)
296 IF (IFIFOX.EQ.0) THEN
297 CALL FZOFFN (IUHEAD)
298 GO TO 426
299 ENDIF
300#endif
301 CALL FZOFFX (IUHEAD)
302 426 CONTINUE
303
304 IF (JBIT(MSTATX,15).NE.0) GO TO 441
305 IF (JTRA.EQ.2) GO TO 991
306
307C-- Flush the buffer after operation
308
309 441 IF (IFIFOX.NE.0) THEN
310 IDX(2) = -1
311 CALL FZOFFX (0)
312 ENDIF
313
314 GO TO ( 406, 991, 991, 461, 471), JTRA
315
316C---- Write end-of-file / end-of-data
317
318 461 IF (IEVFLX.LT.15) GO TO 991
319 IF (IACTVX.EQ.15) GO TO 471
320 NWUHU = 0
321 JTRA = 5
322 IQ(KQSP+LQFX+12) = IQ(KQSP+LQFX+12) + 1
323#if defined(CERNLIB_QPRINT)
324 IF (LOGLVX.GE.0) WRITE (IQLOG,9464) LUNX
325 9464 FORMAT (' FZOUT. LUN=',I4,' Write Zebra EoF')
326#endif
327
328 JRUNX = 0
329 IDX(1) = 4
330 IDX(2) = 1
331 IUHDAT(1) = IQ(KQSP+LQFX+34)
332 IUHDAT(2) = IQ(KQSP+LQFX+35)
333 IUHDAT(3) = IQ(KQSP+LQFX+33) + 1
334 IQUEST(11) = -1
335#if defined(CERNLIB_FZFFNAT)
336 IF (IFIFOX.EQ.0) THEN
337 CALL FZOFFN (IUHDAT)
338 GO TO 426
339 ENDIF
340#endif
341 CALL FZOFFX (IUHDAT)
342 GO TO 426
343
344C-- Write true EOF
345
346 471 NEOF = JBYT (MSTATX,13,2)
347 IF (IEVFLX.EQ.15) THEN
348 NEOFU = MOD (NEOF,2)
349 ELSE
350 NEOFU = MAX (0,NEOF-1)
351 ENDIF
352 IF (NEOFU.EQ.0) GO TO 474
353
354 IQUEST(11) = NEOFU
355 IQUEST(12) = NEOF
356 IDX(2) = 13 - IEVFLX
357#if defined(CERNLIB_FZFFNAT)
358 IF (IFIFOX.EQ.0) THEN
359 CALL FZOFFN (0)
360 GO TO 473
361 ENDIF
362#endif
363 CALL FZOFFX (0)
364 473 IQ(KQSP+LQFX+11) = IQ(KQSP+LQFX+11) + IQUEST(11)
365
366 474 IACTVX = IEVFLX
367#if defined(CERNLIB_QPRINT)
368 IF (LOGLVX.GE.0) THEN
369 IF (IEVFLX.NE.16) THEN
370 WRITE (IQLOG,9474) LUNX
371 ELSE
372 WRITE (IQLOG,9475) LUNX
373 ENDIF
374 ENDIF
375 9474 FORMAT (' FZOUT. LUN=',I4,' End-of-File')
376 9475 FORMAT (' FZOUT. LUN=',I4,' End-of-Data')
377#endif
378 GO TO 991
379
380C-------------------------------------------------
381C- ERROR HANDLING
382C-------------------------------------------------
383
384 901 IF (IACTVX.EQ.18) GO TO 21
385 IF (IACTVX.EQ.17) CALL ZFATAM ('FZOUT - Going beyond EoD.')
386 IACTVX = 17
387 IQUEST(1) = -1
388 GO TO 992
389
390 902 IQUEST(11) = IEVFLX
391 CALL ZFATAM ('FZOUT - Faulty parameter IEVENT.')
392
393 903 IQUEST(11) = IOCHX(1)
394 CALL ZFATAM ('FZOUT - IOCH invalid.')
395
396#if defined(CERNLIB_FZCHANNEL)||defined(CERNLIB_FZMEMORY)
397 907 IQUEST(1) = -2
398 IQUEST(11) = LUNX
399 IF (IEVFLX.GE.2) GO TO 992
400 CALL ZFATAM ('FZOUT - User routine / buffer not connected.')
401#endif
402#if defined(CERNLIB_FZMEMORY)
403 909 IQUEST(1) = -2
404 IQUEST(2) = 14
405 IQUEST(8) = IQ(KQSP+LQFX+9)
406 IQUEST(9) = NWMEMT
407 IF (IOPTXP.EQ.0) CALL ZTELL (14,1)
408 GO TO 999
409#endif
410C-------------------------------------------------
411C- COMMON EXIT
412C-------------------------------------------------
413
414 991 IQUEST(1) = 0
415 992 IQUEST(2) = 0
416 IQUEST(5) = IQ(KQSP+LQFX+31)
417 IQUEST(6) = IQ(KQSP+LQFX+32)
418 IQ(KQSP+LQFX+2) = IACTVX
419#if defined(CERNLIB_FZMEMORY)
420 IF (IFIFOX.EQ.3)
421 +IQUEST(9) = IQ(KQSP+LQFX+1) - IQ(KQSP+LQFX+8)
422#endif
423 IQUEST(10) = NWMEMT
424 IQUEST(11) = NWBKX
425 IQUEST(12) = NWTABX
426 IQUEST(13) = IQ(KQSP+LQFX+15)
427 IQUEST(14) = IQ(KQSP+LQFX+19)
428 IQUEST(15) = IQ(KQSP+LQFX+20)
429 IQUEST(16) = IQ(KQSP+LQFX+21)
430 IQUEST(17) = IQ(KQSP+LQFX+22)
431#include "zebra/qtrace99.inc"
432 RETURN
433 END
434* ==================================================
435#include "zebra/qcardl.inc"