5 * Revision 1.2 1996/04/18 16:10:47 mclareni
6 * Incorporate changes from J.Zoll for version 3.77
8 * Revision 1.1.1.1 1996/03/06 10:47:11 mclareni
12 #include "zebra/pilot.h"
13 #if defined(CERNLIB_FZFFNAT)
14 SUBROUTINE FZOFFN (IUHEAD)
16 C- Write operations for file format native,
17 C- subsidiary to FZOUT
19 C- Controlling parameter : IDX(2)
21 C- IDX(2) = 1 write start/end-of-run
22 C- > 1 write pilot for d/s
23 C- = 0 write bank material for d/s
24 C- (= -1 flush the buffer in exchange mode)
28 #include "zebra/zunit.inc"
29 #include "zebra/mqsys.inc"
30 #include "zebra/eqlqf.inc"
31 #include "zebra/mzct.inc"
32 #include "zebra/mzcwk.inc"
33 #include "zebra/fzcx.inc"
34 #include "zebra/fzcseg.inc"
35 C-------------- End CDE --------------
37 DIMENSION LV(6), NV(6)
38 EQUIVALENCE (L1,LV(1)), (L2,LV(2)), (L3,LV(3))
39 +, (L4,LV(4)), (L5,LV(5)), (L6,LV(6))
40 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
42 DATA NAMESR / 4HFZOF, 4HFN /
44 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
45 DATA NAMESR / 6HFZOFFN /
47 #if !defined(CERNLIB_QTRHOLL)
49 PARAMETER (NAMESR = 'FZOFFN ')
53 #include "zebra/qtrace.inc"
55 IF (IDX(2)) 401, 201, 101
56 101 IF (IDX(2).EQ.1) GO TO 301
58 C-----------------------------------------------------------
59 C------ WRITE PILOT INFORMATION, STARTING LR AND D/S
60 C-----------------------------------------------------------
62 NWMAX = MIN (MAXREX,1020)
77 LV(1) = LOCF (IQSEGH(1,1)) - LQASTO
88 IF (NW.GT.NWMAX) GO TO 127
90 LV(JSEND) = KQSP+8 + LTX + 5
97 IF (NWTABX.GE.41) GO TO 127
99 IF (NW.GT.NWMAX) GO TO 127
101 IF (NWTABX.NE.0) THEN
108 C-- Transmit pilot record
113 IF (NU.NE.0) GO TO ( 140, 141, 142, 143, 144), JSEND
114 GO TO ( 130, 131, 132, 133, 134), JSEND
116 130 CALL FZON1 (IPILX,N)
119 131 CALL FZON2 (IPILX,N,LQ(L1),NV(1))
122 132 CALL FZON3 (IPILX,N,LQ(L1),NV(1),LQ(L2),NV(2))
125 133 CALL FZON4 (IPILX,N,LQ(L1),NV(1),LQ(L2),NV(2),LQ(L3),NV(3))
128 134 CALL FZON5 (IPILX,N,LQ(L1),NV(1),LQ(L2),NV(2),LQ(L3),NV(3)
132 140 CALL FZON2 (IPILX,N,IUHEAD,NU)
135 141 CALL FZON3 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1))
138 142 CALL FZON4 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1),LQ(L2),NV(2))
141 143 CALL FZON5 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1),LQ(L2),NV(2)
145 144 CALL FZON6 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1),LQ(L2),NV(2)
146 +, LQ(L3),NV(3),LQ(L4),NV(4))
150 IF (JDONE) 171, 181, 999
152 C---- Pilot continuation: text/table
154 171 IF (NWTABX.GE.41) GO TO 174
155 IF (NWTABX.EQ.0) GO TO 174
156 IF (NWTXX+NWTABX.GT.MAXREX) GO TO 174
157 CALL FZON2 (IQ(KQSP+LTX+5),NWTXX,LQ(LQTA),NWTABX)
161 174 CALL FZON1 (IQ(KQSP+LTX+5),NWTXX)
163 C-- Pilot continuation: table only (only FZOUT)
165 181 IF (NWTABX.EQ.0) GO TO 999
166 IF (ICOPYX.NE.0) GO TO 999
169 182 N = MIN (NT,MAXREX)
173 IF (NT.NE.0) GO TO 182
175 #include "zebra/qtrace99.inc"
178 C-----------------------------------------------------------
179 C-- WRITE BANK MATERIAL
180 C-----------------------------------------------------------
182 201 MINREC = MAXREX/2
187 IF (NQSEG.EQ.0) NDOSG=NWBKX
189 #if defined(CERNLIB_QDEVZE)
190 IF (LOGLVX.GE.5) WRITE (IQLOG,9801)
191 9801 FORMAT (' FZOFFN- Entered for bank material.')
220 IF (NOV.GT.0) GO TO 261
221 IF (LTB.EQ.LQTE) GO TO 268
222 IF (NDOSG.EQ.0) GO TO 270
223 IF (NOV.GE.-10) GO TO 270
224 IF (JSEND.LT.6) GO TO 243
225 IF (NWS.GE.MINREC) GO TO 270
227 C-- 6 sectors have less than MINREC words
228 C-- Compact to TEMP buffer
230 IF (LTEMPX.EQ.0) LTEMPX = LQWKFZ - KQS
235 IF (LV(1).EQ.LTEMPX) THEN
243 CALL UCOPY (LQ(KQS+L),LQ(KQS+LOV+NOV),N)
252 C-- Last sector overflows MAXREX words
259 C-- End of material, with overflow on last sector
263 C-- End of material reached, send last record
267 C------ Write 1 record
269 270 GO TO ( 271, 272, 273, 274, 275, 276), JSEND
271 271 CALL FZON1 (LQ(KQS+L1),NV(1))
273 272 CALL FZON2 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2))
275 273 CALL FZON3 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2),LQ(KQS+L3),NV(3))
277 274 CALL FZON4 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2),LQ(KQS+L3),NV(3),
280 275 CALL FZON5 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2),LQ(KQS+L3),NV(3),
281 + LQ(KQS+L4),NV(4),LQ(KQS+L5),NV(5))
283 276 CALL FZON6 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2),LQ(KQS+L3),NV(3),
284 + LQ(KQS+L4),NV(4),LQ(KQS+L5),NV(5),LQ(KQS+L6),NV(6))
286 C---- Overflow material pending ?
288 279 IF (IDX(2).EQ.8) GO TO 999
289 IF (NOV.LE.0) GO TO 242
293 IF (NOV.GT.0) GO TO 282
295 C-- End of all material ?
297 IF (LTB.EQ.LQTE) GO TO 267
298 IF (NOV.EQ.0) GO TO 271
302 IF (NDOSG.NE.0) GO TO 257
305 C-- Overflow on overflow
311 C-----------------------------------------------------------
312 C-- WRITE START/END-OF-RUN
313 C-----------------------------------------------------------
315 301 JRUN = IQUEST(11)
318 CALL FZON2 (JRUN,1,IUHEAD,NWUHU)
324 C-----------------------------------------------------------
326 C-----------------------------------------------------------
328 C- NEOF = 1 EoF 1 only IDX(1) = -2 EoF
329 C- 2 EOF 2 only -3 EoD
332 401 NEOFU = IQUEST(11)
338 IF (NEOF.GT.0) GO TO 412
339 #if defined(CERNLIB_QPRINT)
340 IF (LOGLVX.GE.0) WRITE (IQLOG,9414) LUNX,IQUEST(11)
341 9414 FORMAT (' FZOFFN. LUN=',I4,' Write',I2,' System EOF')
345 * ==================================================
346 #include "zebra/qcardl.inc"