5 * Revision 1.2 1996/04/18 16:10:33 mclareni
6 * Incorporate changes from J.Zoll for version 3.77
8 * Revision 1.1.1.1 1996/03/06 10:47:13 mclareni
12 #include "zebra/pilot.h"
13 SUBROUTINE FZIFFX (JSTAGE)
15 C- Service routine to FZIN for exchange mode
17 #include "zebra/zbcd.inc"
18 #include "zebra/zmach.inc"
19 #include "zebra/zunit.inc"
20 #include "zebra/mqsys.inc"
21 #include "zebra/eqlqf.inc"
22 #include "zebra/mzcn.inc"
23 #include "zebra/mzct.inc"
24 #include "zebra/mzioc.inc"
25 #include "zebra/mzcwk.inc"
26 #include "zebra/fzci.inc"
27 #include "zebra/fzcseg.inc"
28 #include "zebra/fzcocc.inc"
29 C-------------- End CDE --------------
32 #if defined(CERNLIB_QMVDS)
35 EQUIVALENCE (MPILOT(1),IPILI(1))
36 EQUIVALENCE (LRTYP,IDI(2)), (ICHDAT,CHDATA)
37 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
39 DATA NAMESR / 4HFZIF, 4HFX /
41 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
42 DATA NAMESR / 6HFZIFFX /
44 #if !defined(CERNLIB_QTRHOLL)
46 PARAMETER (NAMESR = 'FZIFFX ')
48 DATA CHDATA / 12345.0 /
50 #include "zebra/q_jbyt.inc"
52 #include "zebra/qtrace.inc"
54 GO TO (101,201,301), JSTAGE
56 C-----------------------------------------------------
57 C- OBTAIN AND DIGEST NEXT PILOT RECORD
58 C-----------------------------------------------------
62 LBPARI = LQFI + INCBPI
63 #if defined(CERNLIB_FZCHANNEL)
65 IF (IADOPI.EQ.0) GO TO 740
68 #if defined(CERNLIB_FZMEMORY)
70 IADOPI = IQ(KQSP+LQFI+8)
71 IQ(KQSP+LQFI+1) = IADOPI
72 IF (IADOPI.EQ.0) GO TO 740
73 CALL VZERO (IQ(KQSP+LBPARI-9),9)
75 #if (defined(CERNLIB_QDEVZE))&&(defined(CERNLIB_FZMEMORY))
76 IF (LOGLVI.GE.3) WRITE (IQLOG,9142) IADOPI
77 9142 FORMAT (' DEVZE FZIN, relative buffer adr =',I9)
79 #if defined(CERNLIB_FZMEMORY)
82 #if defined(CERNLIB_QDEBPRI)
83 IF (LOGLVI.GE.3) WRITE (IQLOG,9101) IOPTIR,IOPTIE
84 9101 FORMAT (' FZIFFX- Hunt for pilot, options RUN/EVENT =',2I2)
89 IF (IFLAGI.NE.0) GO TO 999
90 #if defined(CERNLIB_QDEBPRI)
91 IF (LOGLVI.GE.3) WRITE (IQLOG,9102) NRECAI,IDI
92 9102 FORMAT (' FZIFFX- Seen LR #',I7,' with NWRL/LRTYP=',I7,I3)
95 IF (LRTYP.GE.4) GO TO 100
96 IF (LRTYP.EQ.1) GO TO 422
98 #if defined(CERNLIB_FQXISN)
99 CALL FZITRN (IPILI,10)
101 #if !defined(CERNLIB_FQXISN)
102 IF (IDAFOI.EQ.0) THEN
103 CALL FZITRN (IPILI,10)
110 CALL FZITRX (IPILI,10)
113 IF (IFLAGI.NE.0) GO TO 999
117 IQ(KQSP+LQFI+15) = IQ(KQSP+LQFI+15) + 1
119 C-- check values in pilot head
121 IF (IPILI(1).NE.ICHDAT) GO TO 741
122 IF (NWTXI .LT.0) GO TO 743
123 IF (NWSEGI.GE.61) GO TO 743
124 IF (NWSEGI.LT.0) GO TO 743
125 IF (NWTABI.LT.0) GO TO 744
126 IF (NWBKI .LT.0) GO TO 744
127 IF (NWUHCI.LT.0) GO TO 745
129 C-- skip to start/end of run
130 IF (IOPTIR.NE.0) THEN
135 IF (IEVFLI.LT.IOPTIE) GO TO 100
137 #if defined(CERNLIB_QDEBPRI)
138 IF (LOGLVI.GE.3) WRITE (IQLOG,9107,ERR=107) MPILOT,MPILOT
140 9107 FORMAT (10X,'The 10 pilot control words : ',
142 #if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
143 F/1X,4O23/1X,4O23/1X,2O23
144 F/1H0,9X,F13.1,3(9X,I14)/1X,4(9X,I14)/1X,2(9X,I14))
146 #if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
147 F/10X,4Z17/10X,4Z17/10X,2Z17
148 F/1H0,9X,F17.1,3I17/10X,4I17/10X,2I17)
151 C-- Read I/O char. for User Header Vector
155 LFIIOC = LQFI + JAUIOC
157 IF (NWUHCI.EQ.0) GO TO 121
159 #if defined(CERNLIB_FQXISN)
160 CALL FZITRN (IOCHI,1)
162 #if !defined(CERNLIB_FQXISN)
163 IF (IDAFOI.EQ.0) THEN
164 CALL FZITRN (IOCHI,1)
169 CALL FZITRX (IOCHI,1)
172 IF (IFLAGI.NE.0) GO TO 999
174 NWIOI = JBYT (IOCHI(1),7,5)
177 IF (IOCHI(1).GE.8) GO TO 742
178 IF (IOCHI(1).LT.0) GO TO 742
179 IF (IOCHI(1).EQ.0) IOCHI(1)=1
181 J = JBYT (IOCHI(1),12,5)
182 IF (J+1.NE.NWIOI) GO TO 742
184 IF (NWIOI.LT.2) GO TO 116
186 #if defined(CERNLIB_FQXISN)
187 CALL FZITRN (IQ(KQSP+LFIIOC+2),NWIOI-1)
189 #if !defined(CERNLIB_FQXISN)
190 IF (IDAFOI.EQ.0) THEN
191 CALL FZITRN (IQ(KQSP+LFIIOC+2),NWIOI-1)
196 CALL FZITRX (IOCHI(2),NWIOI-1)
197 CALL UCOPY (IOCHI(2),IQ(KQSP+LFIIOC+2),NWIOI-1)
200 IF (IFLAGI.NE.0) GO TO 999
202 116 IQ(KQSP+LFIIOC) = NWIOI
203 IQ(KQSP+LFIIOC+1) = IOCHI(1)
205 C-- Read User Header Vector
208 NWUHA = NWUHCI - NWIOI
209 NWUHI = MIN (NWUHA,NWUMXI)
210 #if defined(CERNLIB_FQXISN)
211 CALL FZITRN (LQ(LUHEAI),NWUHI)
213 #if !defined(CERNLIB_FQXISN)
214 IF (IDAFOI.EQ.0) THEN
215 CALL FZITRN (LQ(LUHEAI),NWUHI)
218 CALL FZITRX (LQ(LUHEAI),NWUHI)
221 IF (IFLAGI.NE.0) GO TO 999
222 N4SKII = NWUHA - NWUHI
224 #if defined(CERNLIB_QDEBPRI)
225 IF (LOGLVI.GE.3) THEN
227 IF (LOGLVI.GE.4) THEN
228 WRITE (IQLOG,9113) NWIOI
229 WRITE (IQLOG,9115) (IOCHI(J),J=1,NWIOI)
232 WRITE (IQLOG,9114) NWUHI,N
233 WRITE (IQLOG,9115) (LQ(LUHEAI+J),J=0,N-1)
235 9113 FORMAT (10X,I2,' words I/O characteristic for UHV =')
236 9114 FORMAT (10X,I4,' words of User Header accepted, dump the first'
239 #if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
240 9115 FORMAT (1X,4O23)
242 #if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
243 9115 FORMAT (10X,4Z17)
247 C---- Read the Segment Table
249 121 LFISEG = LQFI + JAUSEG
250 IF (NWSEGI.EQ.0) GO TO 124
252 #if defined(CERNLIB_FQXISN)
253 CALL FZITRN (IQ(KQSP+LFISEG+1),NWSEGI)
255 #if !defined(CERNLIB_FQXISN)
256 IF (IDAFOI.EQ.0) THEN
257 CALL FZITRN (IQ(KQSP+LFISEG+1),NWSEGI)
263 CALL FZITRX (IQ(KQSP+LFISEG+1),2*NSEG)
264 IF (IFLAGI.NE.0) GO TO 999
267 CALL FZITRX (IQ(KQSP+LFISEG+1+2*NSEG),NSEG)
270 IF (IFLAGI.NE.0) GO TO 999
272 124 IQ(KQSP+LFISEG) = NWSEGI
274 C---- Read the Text Vector
276 LTEXT = LQ(KQSP+LQFI-2)
277 IF (LTEXT.NE.0) IQ(KQSP+LTEXT+1)=0
278 IF (NWTXI.EQ.0) GO TO 141
281 N4SKII = N4SKII + NWTXI
285 C-- increase the size of the text buffer if necessary
287 NINC = NWTXI + 4 - IQ(KQSP+LTEXT-1)
290 CALL MZPUSH (JQPDVS,LTEXT,0,NINC,'.')
295 C-- transmit to text buffer
297 #if defined(CERNLIB_FQXISN)
298 CALL FZITRN (IQ(KQSP+LTEXT+5),NWTXI)
300 #if !defined(CERNLIB_FQXISN)
301 IF (IDAFOI.EQ.0) THEN
302 CALL FZITRN (IQ(KQSP+LTEXT+5),NWTXI)
308 CALL FZITRX (IQ(KQSP+LTEXT+5),NWTXI)
311 IF (IFLAGI.NE.0) GO TO 999
312 IQ(KQSP+LTEXT+1) = NWTXI
314 C---- No early table words
316 141 LFIEAR = LQFI + JAUEAR
322 C-------------------------------------------------
324 C-------------------------------------------------
330 #if defined(CERNLIB_FQXISN)
331 CALL FZITRN (LQ(LIN),NWTABI)
333 #if !defined(CERNLIB_FQXISN)
334 IF (IDAFOI.EQ.0) THEN
335 CALL FZITRN (LQ(LIN),NWTABI)
340 CALL FZITRX (LQ(LIN),NWTABI)
343 IF (IFLAGI.NE.0) GO TO 999
347 C-------------------------------------------------
349 C-------------------------------------------------
355 302 IF (LQ(LMT+1).NE.0) GO TO 311
357 C---- Skip segment to be ignored
359 N4SKII = N4SKII - LQ(LMT+3)
362 C-------- Read segment to accept
366 #if !defined(CERNLIB_FQXISN)
367 IF (IDAFOI.EQ.0) GO TO 341
369 C------ Read segment in exchange mode, bank-by-bank
373 C- Next bank : first word
377 CALL FZITRX (LQ(KQS+LIN),1)
378 IF (IFLAGI.NE.0) GO TO 999
380 NST = JBYT (IWD,1,16) - 12
382 #if (!defined(CERNLIB_FQXISN))&&(defined(CERNLIB_QDEBPRI))
383 IF (LOGLVI.GE.4) WRITE (IQLOG,9322) LIN,L4CURI-L4STAI-1,NST
384 9322 FORMAT (' FZIFFX- Next bank : Lst, NWdone, NIO+NL =',I9,2I6)
386 #if !defined(CERNLIB_FQXISN)
387 IF (NST.LT.0) GO TO 326
393 IF (IQLS+8.GE.LEND) GO TO 752
395 C- I/O words, links, next-link, up-link
399 C- origin, numeric ID
407 C- NL, NS, ND, status
411 CALL FZITRX (LQ(KQS+LIN+1), NST+9)
412 IF (IFLAGI.NE.0) GO TO 999
413 IQNIO = JBYT (IQ(KQS+IQLS),19,4)
414 IQNL = IQ(KQS+IQLS-3)
415 IQND = IQ(KQS+IQLS-1)
417 #if (!defined(CERNLIB_FQXISN))&&(defined(CERNLIB_QDEBPRI))
418 IF (LOGLVI.GE.4) THEN
419 IQID = IQ(KQS+IQLS-4)
420 WRITE (IQLOG,9323) IQID,IQNL,IQND,IQNIO
422 9323 FORMAT (' FZIFFX- ID,NL,ND,NIO = ',A4,2I8,I4)
424 #if !defined(CERNLIB_FQXISN)
425 IF (IQNIO+IQNL.NE.NST) GO TO 751
426 IF (IQND.LT.0) GO TO 751
429 LIN = IQLS + IQND + 9
430 IF (IQND.EQ.0) GO TO 324
431 IF (LIN.GT.LEND) GO TO 753
433 CALL MZIOCR (LQ(KQS+IQLN))
434 CALL FZITRX (IQ(KQS+IQLS+1), IQND)
435 IF (IFLAGI.NE.0) GO TO 999
436 324 IF (LIN.LT.LEND) GO TO 322
439 C-- Short dead region
441 326 NWD = JBYT (IWD,17,IQDROP-17)
442 IF (NWD.EQ.0) GO TO 751
443 IF (NWD.NE.NST+12) GO TO 751
444 IF (JBYT(IWD,IQDROP,IQBITW-IQDROP).NE.1) GO TO 751
446 IF (LIN+NWD.GT.LEND) GO TO 754
450 CALL FZITRX (LQ(KQS+LIN+1), NWD-1)
451 IF (IFLAGI.NE.0) GO TO 999
454 IF (LIN.LT.LEND) GO TO 322
458 C------ Read segment in native mode
460 341 CALL FZITRN (LQ(KQS+LSTA),LEND-LSTA)
461 IF (IFLAGI.NE.0) GO TO 999
463 C-- Verify bank chaining
466 344 IWD = LQ(KQS+LIN)
467 NST = JBYT (IWD,1,16) - 12
468 IF (NST.LT.0) GO TO 346
474 IF (IQLS+8.GE.LEND) GO TO 752
476 IQNIO = JBYT (IQ(KQS+IQLS),19,4)
477 IQNL = IQ(KQS+IQLS-3)
478 IQND = IQ(KQS+IQLS-1)
479 IF (IQNIO+IQNL.NE.NST) GO TO 751
480 IF (IQND.LT.0) GO TO 751
482 LIN = IQLS + IQND + 9
483 IF (LEND-LIN) 753, 348, 344
485 C-- Short dead region
487 346 NWD = JBYT (IWD,17,IQDROP-17)
488 IF (NWD.EQ.0) GO TO 751
489 IF (NWD.NE.NST+12) GO TO 751
490 IF (JBYT(IWD,IQDROP,IQBITW-IQDROP).NE.1) GO TO 751
492 IF (LEND-LIN) 754, 348, 344
497 IF (LMT.LT.LQMTE) GO TO 302
499 IF (N4SKII.NE.0) THEN
500 #if defined(CERNLIB_FQXISN)
501 CALL FZITRN (IPILI,0)
503 #if !defined(CERNLIB_FQXISN)
504 IF (IDAFOI.EQ.0) THEN
505 CALL FZITRN (IPILI,0)
507 CALL FZITRX (IPILI,0)
510 IF (IFLAGI.NE.0) GO TO 999
513 IF (N4RESI.NE.0) GO TO 755
516 C-------------------------------------------------
517 C- START / END-OF-RUN
518 C-------------------------------------------------
521 NWUHI = MIN (IDI(1), NQWKTT)
522 #if defined(CERNLIB_FQXISN)
523 CALL FZITRN (LQ(LUHEAI),NWUHI)
525 #if !defined(CERNLIB_FQXISN)
526 IF (IDAFOI.EQ.0) THEN
527 CALL FZITRN (LQ(LUHEAI),NWUHI)
532 CALL FZITRX (LQ(LUHEAI),NWUHI)
535 IF (IFLAGI.NE.0) GO TO 999
539 IQ(KQSP+LBPARI-7) = 0
542 C-------------------------------------------------
544 C-------------------------------------------------
546 #if defined(CERNLIB_FZMEMORY)||defined(CERNLIB_FZCHANNEL)
547 C- JERROR = 240 user routine or buffer not connected for C/M mode
555 C- JERROR = 241 check-word which should be 12345.0 is wrong
564 C- JERROR = 242 control wd of I/O char. for user header invalid
572 C- JERROR = 243 NWSEGI or NWTXI wrong
579 C- JERROR = 244 NWTABI or NWBKI wrong
586 C- JERROR = 245 NWUHCI wrong
596 C- JERROR = 251 inconsistent bank parameters
600 C- JERROR = 252 link part of bank overshoots segment end
604 C- JERROR = 253 data part of bank overshoots segment end
608 C- JERROR = 254 short dead region overshoots segment end
612 C- JERROR = 255 bank material does not end exactly with LR
617 780 IQ(KQSP+LBPARI-9) = -3
618 IQ(KQSP+LBPARI-1) = 0
619 #include "zebra/qtrace99.inc"
622 * ==================================================
623 #include "zebra/qcardl.inc"