| fe4da5cc |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 5 | * Revision 1.2 1996/04/18 16:10:47 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_FZFFNAT) |
| 14 | SUBROUTINE FZOFFN (IUHEAD) |
| 15 | |
| 16 | C- Write operations for file format native, |
| 17 | C- subsidiary to FZOUT |
| 18 | |
| 19 | C- Controlling parameter : IDX(2) |
| 20 | C- |
| 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) |
| 25 | C- = -2 End-of-File |
| 26 | C- = -3 End-of-Data |
| 27 | |
| 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 -------------- |
| 36 | DIMENSION IUHEAD(99) |
| 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)) |
| 41 | DIMENSION NAMESR(2) |
| 42 | DATA NAMESR / 4HFZOF, 4HFN / |
| 43 | #endif |
| 44 | #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M)) |
| 45 | DATA NAMESR / 6HFZOFFN / |
| 46 | #endif |
| 47 | #if !defined(CERNLIB_QTRHOLL) |
| 48 | CHARACTER NAMESR*8 |
| 49 | PARAMETER (NAMESR = 'FZOFFN ') |
| 50 | #endif |
| 51 | |
| 52 | |
| 53 | #include "zebra/qtrace.inc" |
| 54 | |
| 55 | IF (IDX(2)) 401, 201, 101 |
| 56 | 101 IF (IDX(2).EQ.1) GO TO 301 |
| 57 | |
| 58 | C----------------------------------------------------------- |
| 59 | C------ WRITE PILOT INFORMATION, STARTING LR AND D/S |
| 60 | C----------------------------------------------------------- |
| 61 | |
| 62 | NWMAX = MIN (MAXREX,1020) |
| 63 | NWPILA = 10 + NWIOX |
| 64 | NW = NWPILA |
| 65 | JSEND = 0 |
| 66 | JDONE = -1 |
| 67 | |
| 68 | C-- Do user header |
| 69 | |
| 70 | NW = NW + NWUHX |
| 71 | |
| 72 | C-- Do segment table |
| 73 | |
| 74 | IF (NWSEGX.NE.0) THEN |
| 75 | NW = NW + NWSEGX |
| 76 | JSEND = 2 |
| 77 | LV(1) = LOCF (IQSEGH(1,1)) - LQASTO |
| 78 | LV(2) = LV(1) + 40 |
| 79 | NV(1) = 2*NQSEG |
| 80 | NV(2) = NQSEG |
| 81 | ENDIF |
| 82 | |
| 83 | C-- Do text vector |
| 84 | |
| 85 | IF (NWTXX.NE.0) THEN |
| 86 | LTX = LTEXTX |
| 87 | NW = NW + NWTXX |
| 88 | IF (NW.GT.NWMAX) GO TO 127 |
| 89 | JSEND = JSEND + 1 |
| 90 | LV(JSEND) = KQSP+8 + LTX + 5 |
| 91 | NV(JSEND) = NWTXX |
| 92 | ENDIF |
| 93 | JDONE = 0 |
| 94 | |
| 95 | C-- Do early table |
| 96 | |
| 97 | IF (NWTABX.GE.41) GO TO 127 |
| 98 | NW = NW + NWTABX |
| 99 | IF (NW.GT.NWMAX) GO TO 127 |
| 100 | |
| 101 | IF (NWTABX.NE.0) THEN |
| 102 | JSEND = JSEND + 1 |
| 103 | LV(JSEND) = LQTA |
| 104 | NV(JSEND) = NWTABX |
| 105 | ENDIF |
| 106 | JDONE = 1 |
| 107 | |
| 108 | C-- Transmit pilot record |
| 109 | |
| 110 | 127 N = NWPILA |
| 111 | NU = NWUHX |
| 112 | JSEND = JSEND + 1 |
| 113 | IF (NU.NE.0) GO TO ( 140, 141, 142, 143, 144), JSEND |
| 114 | GO TO ( 130, 131, 132, 133, 134), JSEND |
| 115 | |
| 116 | 130 CALL FZON1 (IPILX,N) |
| 117 | GO TO 149 |
| 118 | |
| 119 | 131 CALL FZON2 (IPILX,N,LQ(L1),NV(1)) |
| 120 | GO TO 149 |
| 121 | |
| 122 | 132 CALL FZON3 (IPILX,N,LQ(L1),NV(1),LQ(L2),NV(2)) |
| 123 | GO TO 149 |
| 124 | |
| 125 | 133 CALL FZON4 (IPILX,N,LQ(L1),NV(1),LQ(L2),NV(2),LQ(L3),NV(3)) |
| 126 | GO TO 149 |
| 127 | |
| 128 | 134 CALL FZON5 (IPILX,N,LQ(L1),NV(1),LQ(L2),NV(2),LQ(L3),NV(3) |
| 129 | +, LQ(L4),NV(4)) |
| 130 | GO TO 149 |
| 131 | |
| 132 | 140 CALL FZON2 (IPILX,N,IUHEAD,NU) |
| 133 | GO TO 149 |
| 134 | |
| 135 | 141 CALL FZON3 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1)) |
| 136 | GO TO 149 |
| 137 | |
| 138 | 142 CALL FZON4 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1),LQ(L2),NV(2)) |
| 139 | GO TO 149 |
| 140 | |
| 141 | 143 CALL FZON5 (IPILX,N,IUHEAD,NU,LQ(L1),NV(1),LQ(L2),NV(2) |
| 142 | +, LQ(L3),NV(3)) |
| 143 | GO TO 149 |
| 144 | |
| 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)) |
| 147 | |
| 148 | 149 IDX(2) = 4 |
| 149 | IQUEST(7) = JDONE |
| 150 | IF (JDONE) 171, 181, 999 |
| 151 | |
| 152 | C---- Pilot continuation: text/table |
| 153 | |
| 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) |
| 158 | IQUEST(7) = 1 |
| 159 | GO TO 999 |
| 160 | |
| 161 | 174 CALL FZON1 (IQ(KQSP+LTX+5),NWTXX) |
| 162 | |
| 163 | C-- Pilot continuation: table only (only FZOUT) |
| 164 | |
| 165 | 181 IF (NWTABX.EQ.0) GO TO 999 |
| 166 | IF (ICOPYX.NE.0) GO TO 999 |
| 167 | NT = NWTABX |
| 168 | L = LQTA |
| 169 | 182 N = MIN (NT,MAXREX) |
| 170 | CALL FZON1 (LQ(L),N) |
| 171 | L = L + N |
| 172 | NT = NT - N |
| 173 | IF (NT.NE.0) GO TO 182 |
| 174 | |
| 175 | #include "zebra/qtrace99.inc" |
| 176 | RETURN |
| 177 | |
| 178 | C----------------------------------------------------------- |
| 179 | C-- WRITE BANK MATERIAL |
| 180 | C----------------------------------------------------------- |
| 181 | |
| 182 | 201 MINREC = MAXREX/2 |
| 183 | LTEMPX = 0 |
| 184 | LTB = LQTA |
| 185 | JSEG = 0 |
| 186 | NDOSG = 0 |
| 187 | IF (NQSEG.EQ.0) NDOSG=NWBKX |
| 188 | IDX(2) = 7 |
| 189 | #if defined(CERNLIB_QDEVZE) |
| 190 | IF (LOGLVX.GE.5) WRITE (IQLOG,9801) |
| 191 | 9801 FORMAT (' FZOFFN- Entered for bank material.') |
| 192 | #endif |
| 193 | |
| 194 | 242 JSEND = 0 |
| 195 | NWS = 0 |
| 196 | |
| 197 | C-- Load next sector |
| 198 | |
| 199 | 243 L = LQ(LTB) |
| 200 | LE = LQ(LTB+1) |
| 201 | N = LE - L |
| 202 | JSEND = JSEND + 1 |
| 203 | LV(JSEND) = L |
| 204 | NV(JSEND) = N |
| 205 | |
| 206 | NWS = NWS + N |
| 207 | NOV = NWS - MAXREX |
| 208 | LTB = LTB + 2 |
| 209 | |
| 210 | C-- Next segment ? |
| 211 | |
| 212 | IF (NDOSG.EQ.0) THEN |
| 213 | JSEG = JSEG + 1 |
| 214 | NDOSG = IQSEGD(JSEG) |
| 215 | ENDIF |
| 216 | NDOSG = NDOSG - N |
| 217 | |
| 218 | C-- Send ? |
| 219 | |
| 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 |
| 226 | |
| 227 | C-- 6 sectors have less than MINREC words |
| 228 | C-- Compact to TEMP buffer |
| 229 | |
| 230 | IF (LTEMPX.EQ.0) LTEMPX = LQWKFZ - KQS |
| 231 | |
| 232 | LOV = LTEMPX |
| 233 | NOV = 0 |
| 234 | JGO = 1 |
| 235 | IF (LV(1).EQ.LTEMPX) THEN |
| 236 | NOV = NV(1) |
| 237 | JGO = 2 |
| 238 | ENDIF |
| 239 | |
| 240 | DO 256 J=JGO,6 |
| 241 | L = LV(J) |
| 242 | N = NV(J) |
| 243 | CALL UCOPY (LQ(KQS+L),LQ(KQS+LOV+NOV),N) |
| 244 | 256 NOV = NOV + N |
| 245 | LV(1) = LOV |
| 246 | NV(1) = NOV |
| 247 | |
| 248 | 257 JSEND = 1 |
| 249 | NWS = NV(1) |
| 250 | GO TO 243 |
| 251 | |
| 252 | C-- Last sector overflows MAXREX words |
| 253 | |
| 254 | 261 N = N - NOV |
| 255 | LOV = L + N |
| 256 | NV(JSEND) = N |
| 257 | GO TO 270 |
| 258 | |
| 259 | C-- End of material, with overflow on last sector |
| 260 | |
| 261 | 267 JSEND = 1 |
| 262 | |
| 263 | C-- End of material reached, send last record |
| 264 | |
| 265 | 268 IDX(2) = 8 |
| 266 | |
| 267 | C------ Write 1 record |
| 268 | |
| 269 | 270 GO TO ( 271, 272, 273, 274, 275, 276), JSEND |
| 270 | |
| 271 | 271 CALL FZON1 (LQ(KQS+L1),NV(1)) |
| 272 | GO TO 279 |
| 273 | 272 CALL FZON2 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2)) |
| 274 | GO TO 279 |
| 275 | 273 CALL FZON3 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2),LQ(KQS+L3),NV(3)) |
| 276 | GO TO 279 |
| 277 | 274 CALL FZON4 (LQ(KQS+L1),NV(1),LQ(KQS+L2),NV(2),LQ(KQS+L3),NV(3), |
| 278 | + LQ(KQS+L4),NV(4)) |
| 279 | GO TO 279 |
| 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)) |
| 282 | GO TO 279 |
| 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)) |
| 285 | |
| 286 | C---- Overflow material pending ? |
| 287 | |
| 288 | 279 IF (IDX(2).EQ.8) GO TO 999 |
| 289 | IF (NOV.LE.0) GO TO 242 |
| 290 | LV(1) = LOV |
| 291 | NV(1) = NOV |
| 292 | NOV = NOV - MAXREX |
| 293 | IF (NOV.GT.0) GO TO 282 |
| 294 | |
| 295 | C-- End of all material ? |
| 296 | |
| 297 | IF (LTB.EQ.LQTE) GO TO 267 |
| 298 | IF (NOV.EQ.0) GO TO 271 |
| 299 | |
| 300 | C-- End of segment ? |
| 301 | |
| 302 | IF (NDOSG.NE.0) GO TO 257 |
| 303 | GO TO 271 |
| 304 | |
| 305 | C-- Overflow on overflow |
| 306 | |
| 307 | 282 NV(1) = MAXREX |
| 308 | LOV = LOV + MAXREX |
| 309 | GO TO 271 |
| 310 | |
| 311 | C----------------------------------------------------------- |
| 312 | C-- WRITE START/END-OF-RUN |
| 313 | C----------------------------------------------------------- |
| 314 | |
| 315 | 301 JRUN = IQUEST(11) |
| 316 | NWUHU = IDX(1) - 1 |
| 317 | IF (NWUHU.NE.0) THEN |
| 318 | CALL FZON2 (JRUN,1,IUHEAD,NWUHU) |
| 319 | ELSE |
| 320 | CALL FZON1 (JRUN,1) |
| 321 | ENDIF |
| 322 | GO TO 999 |
| 323 | |
| 324 | C----------------------------------------------------------- |
| 325 | C-- ENDFILE |
| 326 | C----------------------------------------------------------- |
| 327 | |
| 328 | C- NEOF = 1 EoF 1 only IDX(1) = -2 EoF |
| 329 | C- 2 EOF 2 only -3 EoD |
| 330 | C- 3 EOF 1 + 2 |
| 331 | |
| 332 | 401 NEOFU = IQUEST(11) |
| 333 | NEOF = IQUEST(12) |
| 334 | IQUEST(11) = NEOFU |
| 335 | NEOF = NEOFU |
| 336 | 412 ENDFILE LUNX |
| 337 | NEOF = NEOF - 1 |
| 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') |
| 342 | #endif |
| 343 | GO TO 999 |
| 344 | END |
| 345 | * ================================================== |
| 346 | #include "zebra/qcardl.inc" |
| 347 | #endif |
git://git.uio.no / u / mrichter / AliRoot.git / blame