* * $Id$ * * $Log$ * Revision 1.1.1.1 1996/03/06 10:47:11 mclareni * Zebra * * #include "zebra/pilot.h" SUBROUTINE FZIREC C- Logical record controls, exchange file format C- service routine to FZIFFX of FZIN C- This routine is called with C- IFLAGI > 0 from FZIFFX to initiate the next d/s making sure C- that the block containing its beginning is C- in the buffer, skipping if nec. trailing records C- of the previous d/s C- = 0 from FZIFFX to copy the buffer control params. C- between the control-bank and /FZCI/ (for speed) C- < 0 from FZITR to read continuation blocks (phR) C- into the buffer #include "zebra/zunit.inc" #include "zebra/mqsys.inc" #include "zebra/eqlqf.inc" #include "zebra/fzci.inc" C-------------- End CDE -------------- #include "fzntolds.inc" #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M)) DIMENSION NAMESR(2) DATA NAMESR / 4HFZIR, 4HEC / #endif #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M)) DATA NAMESR / 6HFZIREC / #endif #if !defined(CERNLIB_QTRHOLL) CHARACTER NAMESR*8 PARAMETER (NAMESR = 'FZIREC ') #endif #include "zebra/qtrace.inc" C- buffer parameters : C- C- -9 non-zero : last LR abended C- -7 expected next Ph record number C- -6 =0 if current block is steering C- =1 if current block is last in burst C- =2 if cur. block is last-but-one in burst, etc C- -5 # of fast records still pending C- C- -4 N4SKII, # of words to be skipped C- before next transmission C- -3 N4RESI, # of words in LR still to be done C- -2 N4DONI, # of words already out of buffer C- -1 N4ENDI, # of words in buffer before start of next LR C- if =0 : buffer empty C- if =MAXREI : LR continues in next block C- LBPARI +0 maximum size of buffer, words C- +1 expected size of PhR, local machine words C- +2 INCBUF step to buffer C- +3 off-set from start-of-buffer for reading C- the packed record C- +4 (off-set for output) C- -1 space for left double-precision word saved C- L4STAI +0 first word of normal buffer IFLIN = IFLAGI IFLAGI = 0 LBPARI = LQFI + INCBPI IF (IFLIN) 61, 71, 21 C----------------------------------------------------------- C------ IFLAGI > 0 : start new d/s C----------------------------------------------------------- 21 ICARRL = 0 IFLRST = IQ(KQSP+LBPARI-9) INCBUF = IQ(KQSP+LBPARI+2) L4STAI = KQSP+8 + LBPARI + INCBUF NLRPAD = 0 JFAST = IQ(KQSP+LBPARI-6) N4SKII = 0 N4ENDI = IQ(KQSP+LBPARI-1) #if defined(CERNLIB_QDEBPRI) IF (LOGLVI.GE.3) + WRITE (IQLOG,9022) IFLIN,IFLRST,JFAST,N4ENDI,MAXREI 9022 FORMAT (1X/' FZIREC- Going for next LR, Buffer Status :' F/10X,'IFLAGI, Restart?, Fast?, NWtoLR, NWbuf =',6I6) #endif C-- Re-start LR after error IF (IFLRST.NE.0) THEN IQ(KQSP+LBPARI-9) = 0 IF (N4ENDI.GT.0) THEN IF (N4ENDI.LT.MAXREI-1) GO TO 51 ENDIF IFLAGI = -1 GO TO 27 ENDIF C-- Start afresh IF (N4ENDI.NE.0) GO TO 31 IFLAGI = -2 27 CALL VZERO (IQ(KQSP+LBPARI-8),8) N4RESI = 0 N4DONI = 0 GO TO 46 C---- Normal continuation on current buffer 31 N4RESI = IQ(KQSP+LBPARI-3) N4DONI = IQ(KQSP+LBPARI-2) #if defined(CERNLIB_QDEBPRI) IF (LOGLVI.GE.3) WRITE (IQLOG,9031) N4RESI,N4DONI,N4ENDI 9031 FORMAT (10X,'Status of last LR : NWrest, NWdone, NWend =' F,3I5) #endif C-- Skip trailing words of last LR IF (N4RESI.EQ.0) GO TO 41 34 NWNEW = MIN (N4ENDI-N4DONI, N4RESI) N4DONI = N4DONI + NWNEW N4RESI = N4RESI - NWNEW IF (N4RESI.EQ.0) GO TO 41 IF (N4ENDI.NE.MAXREI) GO TO 821 N4SKII = N4RESI NWFAST = IQ(KQSP+LBPARI-5) * MAXREI IF (NWFAST.LE.N4SKII) GO TO 46 N4SKII = NWFAST N4RESI = NWFAST IFLAGI = -2 GO TO 46 C-- New Ph record if buffer exhausted 41 IF (N4DONI.NE.N4ENDI) GO TO 822 ICARRL = 0 IF (N4ENDI.LT.MAXREI-1) GO TO 51 IF (N4ENDI.GT.MAXREI-1) GO TO 46 MCARRL = LQ(L4STAI+MAXREI-1) IF (MCARRL.EQ.0) GO TO 46 ICARRL = 1 JRECNO = IQ(KQSP+LQFI+33) JDSADR = N4ENDI JFAST = IQ(KQSP+LBPARI-6) #if defined(CERNLIB_QDEBPRI) IF (LOGLVI.GE.3) WRITE (IQLOG,9043) MCARRL 9043 FORMAT (' FZIREC- Saved LR length',I6,' across to next PhR') #endif 46 IF (IFIFOI.LE.1) THEN CALL FZIPHR #if defined(CERNLIB_FZDACC) ELSEIF (IFIFOI.EQ.2) THEN CALL FZIPHD #endif #if defined(CERNLIB_FZMEMORY) ELSEIF (IFIFOI.EQ.3) THEN CALL FZIPHM #endif #if defined(CERNLIB_FZALFA) ELSEIF (IFIFOI.EQ.4) THEN CALL FZIPHA #endif ENDIF C-- read failure ? IF (IFLAGI.NE.0) THEN IF (IFLIN.GT.0) THEN IF (JRETCD.EQ.1) JRETCD=-1 ENDIF GO TO 999 ENDIF C-- LR length last word of previous block ? IF (ICARRL.NE.0) THEN N4ENDI = N4DONI - 1 LQ(L4STAI+N4ENDI) = MCARRL ENDIF C-- still discarding previous d/s ? IF (IFLIN.GT.0) THEN IF (N4RESI.GT.0) GO TO 34 ENDIF C---- Start new logical record 51 N4DONI = N4ENDI N4SKII = 0 IF (N4ENDI.EQ.MAXREI-1) GO TO 41 IF (ICARRL.EQ.0) THEN JRECNO = IQ(KQSP+LQFI+33) JDSADR = N4DONI JFAST = IQ(KQSP+LBPARI-6) ENDIF ICARRL = 0 L4CURI = L4STAI + N4DONI + 2 IDI(1) = LQ(L4CURI-2) IDI(2) = LQ(L4CURI-1) IF (IDI(1).EQ.0) IDI(2)=5 #if defined(CERNLIB_QDEBPRI) IF (LOGLVI.GE.3) WRITE (IQLOG,9053) JFAST,N4DONI,IDI 9053 FORMAT (' FZIREC- Start LR : Fast?, NWdone, Length, Type=' F,I5,I6,I8,I3) #endif N4RESI = IDI(1) IF (N4RESI.LT.0) GO TO 826 IF (N4RESI.GT.NTOLDS) GO TO 826 IF (IDI(2).GE.5) GO TO 57 IF (IDI(2).EQ.4) GO TO 53 C-- LR type 1, 2, 3 IF (IDI(2).LE.0) GO TO 825 IF (IFLIN.LT.0) GO TO 824 IF (JFAST.NE.0) GO TO 827 IQ(KQSP+LQFI+31) = JRECNO IQ(KQSP+LQFI+32) = JDSADR 53 N4DONI = N4DONI + 2 N4ENDI = MIN (MAXREI, N4DONI+N4RESI) L4ENDI = L4STAI + N4ENDI NRECAI = NRECAI + 1 IF (IFLIN.GE.0) GO TO 77 N4SKII = NSKISV GO TO 77 C-- Skip padding records 57 IF (IDI(2).GE.7) GO TO 825 IF (N4RESI.GT.MAXREI) GO TO 828 NLRPAD = NLRPAD + 1 IF (NLRPAD.GE.5) GO TO 829 N4DONI = N4DONI + 1 N4ENDI = MIN (MAXREI, N4DONI+N4RESI) NWNEW = MIN (N4ENDI-N4DONI, N4RESI) N4DONI = N4DONI + NWNEW N4RESI = N4RESI - NWNEW GO TO 41 C----------------------------------------------------------- C------ IFLAGI = -1 : ready continuation Ph / L record C----------------------------------------------------------- 61 ICARRY = 0 N4DONI = L4CURI - L4STAI NWNEW = N4DONI - IQ(KQSP+LBPARI-2) N4RESI = N4RESI - NWNEW IF (N4DONI.EQ.MAXREI+1) THEN ICARRY = 1 MCARRY = LQ(L4CURI-2) N4RESI = N4RESI + 1 ENDIF #if defined(CERNLIB_QDEBPRI) IF (LOGLVI.GE.3) WRITE (IQLOG,9061) N4RESI,N4DONI,MAXREI,ICARRY 9061 FORMAT (1X/' FZIREC- Need continuation PhR/LR, Buffer Status :' F/10X,'Rest LR, NWdone, NWbuf, NWcarry =',3I7,I4) #endif C-- Start continuation LR IF (N4RESI.EQ.0) THEN NLRPAD = 0 NSKISV = N4SKII N4SKII = 0 GO TO 41 ENDIF C-- Get continuation PhR IF (IFIFOI.LE.1) THEN CALL FZIPHR #if defined(CERNLIB_FZDACC) ELSEIF (IFIFOI.EQ.2) THEN CALL FZIPHD #endif #if defined(CERNLIB_FZMEMORY) ELSEIF (IFIFOI.EQ.3) THEN CALL FZIPHM #endif #if defined(CERNLIB_FZALFA) ELSEIF (IFIFOI.EQ.4) THEN CALL FZIPHA #endif ENDIF IF (IFLAGI.NE.0) GO TO 999 L4CURI = L4STAI + N4DONI L4ENDI = L4STAI + N4ENDI IF (ICARRY.NE.0) THEN N4RESI = N4RESI + 1 N4DONI = N4DONI - 1 L4CURI = L4CURI - 1 LQ(L4CURI) = MCARRY ENDIF GO TO 77 C----------------------------------------------------------- C------ IFLAGI = 0 : set buffer parameters C----------------------------------------------------------- 71 IF (L4STAI.NE.0) GO TO 74 C-- Copy parameters from control bank to COMMON N4SKII = IQ(KQSP+LBPARI-4) N4RESI = IQ(KQSP+LBPARI-3) N4DONI = IQ(KQSP+LBPARI-2) N4ENDI = IQ(KQSP+LBPARI-1) INCBUF = IQ(KQSP+LBPARI+2) L4STAI = KQSP+8 + LBPARI + INCBUF L4CURI = L4STAI + N4DONI L4ENDI = L4STAI + N4ENDI GO TO 999 C-- Up-date parameters in control bank 74 N4DONI = L4CURI - L4STAI NWNEW = N4DONI - IQ(KQSP+LBPARI-2) N4RESI = N4RESI - NWNEW 77 IQ(KQSP+LBPARI-4) = N4SKII IQ(KQSP+LBPARI-3) = N4RESI IQ(KQSP+LBPARI-2) = N4DONI IQ(KQSP+LBPARI-1) = N4ENDI #include "zebra/qtrace99.inc" RETURN C----------------------------------------------------------- C- ERROR CONDITIONS C----------------------------------------------------------- C- JERROR = 221 LR overshoots physical record control 821 JERROR = 221 IQUEST(14) = N4DONI IQUEST(15) = N4RESI NWERR = 2 GO TO 871 C- JERROR = 222 LR undershoots physical record control 822 JERROR = 222 IQUEST(14) = N4DONI IQUEST(15) = N4ENDI NWERR = 2 GO TO 871 C- JERROR = 223 LR expected to start at start of new PhR C!823 JERROR = 223 C! IQUEST(14) = N4ENDI C! NWERR = 1 C! GO TO 871 C- JERROR = 224 LR type 1,2,3 seen when 4 expected 824 JERROR = 224 IQUEST(14) = N4ENDI NWERR = 1 GO TO 871 C- JERROR = 225 Faulty LR type 825 JERROR = -1 C- JERROR = 226 Faulty LR length 826 JERROR = JERROR - 1 C- JERROR = 227 LR of type 1,2,3 must start on steering block 827 JERROR = JERROR - 1 C- JERROR = 228 Padding record longer than one physical record 828 JERROR = JERROR - 1 C- JERROR = 229 More than 4 padding records in a row 829 JERROR = 229 + JERROR IQUEST(14) = N4DONI IQUEST(15) = N4RESI IQUEST(16) = IDI(2) NWERR = 3 N4ENDI = 0 871 IQ(KQSP+LBPARI-9) = -2 IFLAGI = -2 JRETCD = 6 GO TO 77 END * ================================================== #include "zebra/qcardl.inc"