5 * Revision 1.2 1996/04/18 16:10:48 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"
15 C- Write one physical record
16 C- service routine to FZOUT
18 #include "zebra/zunit.inc"
19 #include "zebra/mqsys.inc"
20 #include "zebra/eqlqf.inc"
21 #include "zebra/mzcn.inc"
22 #include "zebra/mzioc.inc"
23 #include "zebra/fzcx.inc"
24 C-------------- End CDE --------------
26 #include "fzstamp.inc"
28 * Declaratives, DIMENSION etc.
29 #include "fzophrd1.inc"
32 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
34 DATA NAMESR / 4HFZOP, 4HHR /
36 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
37 DATA NAMESR / 6HFZOPHR /
39 #if !defined(CERNLIB_QTRHOLL)
41 PARAMETER (NAMESR = 'FZOPHR ')
45 #include "fzophrd2.inc"
48 #include "zebra/qtrace.inc"
53 IF (JOP.LT.-1) GO TO 81
54 IQ(KQSP+LQFX+22) = IQ(KQSP+LQFX+22) + 1
55 IQ(KQSP+LQFX+33) = IQ(KQSP+LQFX+33) + 1
57 JFAST = IQ(KQSP+LBPARX-6)
58 NFASTX = IQ(KQSP+LBPARX-5)
59 IF (JFAST.NE.0) GO TO 17
68 IQ(KQSP+LQFX+23)= IQ(KQSP+LQFX+23) + 1
69 #if defined(CERNLIB_QDEVZE)
71 IF (LOGLVX.GE.3) WRITE (IQLOG,9716) J,NFASTX
72 9716 FORMAT (' FZOPHR- write steering record #',I5,' NFASTX=',2I4)
78 17 NFASTX = NFASTX - 1
79 IQ(KQSP+LBPARX-5) = NFASTX
80 #if defined(CERNLIB_QDEVZE)
81 IF (LOGLVX.GE.3) WRITE (IQLOG,9717)
82 9717 FORMAT (' FZOPHR- write fast record')
84 19 IQ(KQSP+LBPARX-6) = NFASTX
86 C----------- Output of the record ----------------------
89 NWR = IQ(KQSP+LBPARX+1)
92 #if defined(CERNLIB_FZALFA)
93 IF (IFIFOX.EQ.4) GO TO 78
95 #if defined(CERNLIB_FQNEEDCV)
97 C-- Pack the record, if needed
99 IF (IUPAKX.NE.0) GO TO 24
100 NWPK = MAXREX - NWFILX
103 #if defined(CERNLIB_FQNEEDCV)
104 #include "fzophr22.inc"
106 #if defined(CERNLIB_FQNEEDCV)
110 #if defined(CERNLIB_FZDACC)
111 IF (IFIFOX.EQ.2) GO TO 51
113 #if defined(CERNLIB_FZMEMORY)
114 IF (IFIFOX.EQ.3) GO TO 71
117 C-----------------------------------------------------------
118 C---- Output Sequential
119 C-----------------------------------------------------------
121 IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + NWR
123 #if defined(CERNLIB_FZCHANNEL)
124 C-- Output sequential channel
126 IF (IACMOX.EQ.3) THEN
133 IQUEST(5) = MEDIUX - 4
134 CALL JUMPX2 (LQ(LWR),ICODE)
139 #if defined(CERNLIB_FZLIBC)
140 C-- Output sequential with calls to the C library
142 IF (IACMOX.EQ.2) THEN
143 CALL CFPUT (IADOPX, MEDIUX, NWR, LQ(LWR), ISW)
156 #if defined(CERNLIB_FZFORTRAN)
157 C-- Output sequential with Fortran calls
159 #include "fzophr44.inc"
162 #if defined(CERNLIB_FZFORTRAN)
163 #include "fzophr45.inc"
166 #if defined(CERNLIB_FZDACC)
167 C-----------------------------------------------------------
168 C---- Output Direct Access
169 C-----------------------------------------------------------
171 51 JREC = IQ(KQSP+LQFX+33)
172 IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + NWR
175 #if defined(CERNLIB_FZDACCH)
176 C-- Output random channel
178 IF (IACMOX.EQ.3) THEN
185 IQUEST(5) = MEDIUX - 4
186 CALL JUMPX2 (LQ(LWR),ICODE)
191 #if defined(CERNLIB_FZDACCL)
192 C-- Output random with calls to the C library
194 IF (IACMOX.EQ.2) THEN
195 CALL CFPUT (IADOPX, MEDIUX, NWR, LQ(LWR), ISW)
208 #if defined(CERNLIB_FZDACCF)
209 #include "fzophr55.inc"
212 #if defined(CERNLIB_FZMEMORY)
213 C-----------------------------------------------------------
214 C---- Output in memory mode
215 C-----------------------------------------------------------
217 71 LBUF = IQ(KQSP+LQFX+1)
218 CALL UCOPY (LQ(LWR),LQ(LBUF),NWU)
219 IQ(KQSP+LQFX+1) = IQ(KQSP+LQFX+1) + NWU
220 IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + NWU
224 #if defined(CERNLIB_FZALFA)
225 C-----------------------------------------------------------
226 C---- Output ALFA format
227 C-----------------------------------------------------------
229 78 CALL FZOASC (LUNX,L4STAX,L4ENDX,JFAST,L4STOX,0)
230 IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + MAXREX
234 C-----------------------------------------------------------
236 C-----------------------------------------------------------
238 C- NEOFM = 1 EoF 1 only IDX(1) = -2 EoF
239 C- 2 EOF 2 only -3 EoD
242 81 IF (IFIFOX.GE.2) GO TO 999
243 IF (IACMOX.GE.3) GO TO 999
246 #if defined(CERNLIB_FZLIBC)
247 IF (IACMOX.EQ.2) THEN
248 CALL CFWEOF (IADOPX, MEDIUX, IQUEST(11))
253 #include "fzophre1.inc"
260 #if defined(CERNLIB_QPRINT)
261 IF (LOGLVX.GE.0) WRITE (IQLOG,9089) LUNX,IQUEST(11)
262 9089 FORMAT (' FZOPHR. LUN=',I4,' Write',I2,' System EOF')
265 #include "zebra/qtrace99.inc"
268 * ==================================================
269 #include "zebra/qcardl.inc"