MINICERN/packlib/zebra/fq/fzipha.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:10:38  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_FZALFA)
  14       SUBROUTINE FZIPHA
  15
  16 C-    Read next physical record image in ALFA exchange mode
  17 C-    Service routine to FZIN, called only via FZIREC
  18
  19 C-    Input :      IFLAGI = 0  normal read
  20 C-                         -1  recover to next steering block
  21
  22 C-                 N4SKII      is used for rapid skip of fast blocks
  23
  24 C-    Output :     IFLAGI = 0  all is well
  25 C-                             otherwise : ready for re-start
  26
  27 #include "zebra/zbcd.inc"
  28 #include "zebra/zmach.inc"
  29 #include "zebra/zstate.inc"
  30 #include "zebra/zunit.inc"
  31 #include "zebra/mqsys.inc"
  32 #include "zebra/eqlqf.inc"
  33 #include "zebra/fzci.inc"
  34 #include "fzhci.inc"
  35 C--------------    End CDE                             --------------
  36
  37 *      Declaratives, DIMENSION etc.
  38 #include "fzstamp.inc"
  39
  40 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  41       DIMENSION    NAMESR(2)
  42       DATA  NAMESR / 4HFZIP, 4HHA   /
  43 #endif
  44 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  45       DATA  NAMESR / 6HFZIPHA /
  46 #endif
  47 #if !defined(CERNLIB_QTRHOLL)
  48       CHARACTER    NAMESR*8
  49       PARAMETER   (NAMESR = 'FZIPHA  ')
  50 #endif
  51
  52
  53 #include "zebra/qtrace.inc"
  54
  55 C----              Skip to next steering block
  56
  57       IF (IFLAGI.LT.0)  THEN
  58           NFASTI = 0
  59           NRSKIP = 1
  60           GO TO 20
  61         ENDIF
  62
  63 C----              Dedide skip of fast records
  64
  65       N4SKIP = MIN (N4SKII,N4RESI)
  66       NFASTI = IQ(KQSP+LBPARI-5)
  67       NRSKIP = 0
  68       IF (N4SKIP.LT.MAXREI)        GO TO 20
  69       IF (NFASTI.EQ.0)             GO TO 20
  70       NRSKIP = MIN (NFASTI, N4SKIP / MAXREI)
  71
  72    20 NW4IN  = MAXREI
  73       IQ(KQSP+LBPARI-6) = NFASTI
  74
  75
  76 C----              Read one physical record
  77
  78    31 NBLK = IQ(KQSP+LQFI+22) + 1
  79 #if defined(CERNLIB_QDEBPRI)
  80       IF (LOGLVI.GE.3)
  81      +      WRITE (IQLOG,9031) NBLK,NW4IN,NFASTI,NRSKIP
  82  9031 FORMAT (1X/' FZIPHA-  Reading Block',I7,
  83      F', NW32,NRfast,NRskip=',4I6)
  84 #endif
  85
  86       CALL FZIASC (NRSKIP)
  87       IF    (IQUEST(1))      841, 33, 818
  88    33 JFASTR = IQUEST(92)
  89
  90       IQ(KQSP+LQFI+22) = NBLK
  91       NWRDAI = NWRDAI + MAXREI
  92
  93       IF (JFASTR.EQ.0)  THEN
  94           LQ(L4STAI)   = MCCW1
  95           LQ(L4STAI+1) = MCCW2
  96           LQ(L4STAI+2) = MCCW3
  97           LQ(L4STAI+3) = MCCW4
  98         ENDIF
  99
 100 C--                Short/full dump of record read
 101
 102 #if defined(CERNLIB_QDEBPRI)
 103       IF (LOGLVI.LT.3)             GO TO 51
 104       IF (JFASTR.NE.0)  THEN
 105           IF (NRSKIP.NE.0)         GO TO 51
 106         ENDIF
 107
 108       CALL FZIDUM (LQ(L4STAI),NW4IN)
 109 #endif
 110
 111 C-----------------------------------------------------------
 112 C----              Fast record expected
 113 C-----------------------------------------------------------
 114
 115    51 IF (NFASTI.EQ.0)             GO TO 61
 116       IF (JFASTR.EQ.0)             GO TO 54
 117       NFASTI = NFASTI - 1
 118       IQ(KQSP+LBPARI-5) = NFASTI
 119       IF (NRSKIP.EQ.0)             GO TO 53
 120
 121 C--       skip record
 122       N4SKII = N4SKII - MAXREI
 123       N4RESI = N4RESI - MAXREI
 124       NRSKIP = NRSKIP - 1
 125       GO TO 20
 126
 127 C--       deliver record
 128    53 N4DONI = 0
 129       N4ENDI = MIN (N4RESI,MAXREI)
 130       IFLAGI = 0
 131 #include "zebra/qtrace99.inc"
 132       RETURN
 133
 134 C--                Unexpected steering record
 135
 136    54 CALL FZICHH (0, LQ(L4STAI),0)
 137       IF (IQUEST(1).NE.0)          GO TO 807
 138
 139       N4ENDI = NTLRI
 140       IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
 141       GO TO 808
 142
 143 C-----------------------------------------------------------
 144 C----              Steering record expected
 145 C-----------------------------------------------------------
 146
 147    61 IF (JFASTR.NE.0)             GO TO 71
 148       CALL FZICHH (0, LQ(L4STAI),IFLAGI)
 149       IF (IQUEST(1).NE.0)          GO TO 72
 150       N4ENDI = NTLRI
 151
 152       IF (IFLAGI.LT.0)             GO TO 73
 153
 154       N4DONI = 8
 155       IF (N4ENDI.EQ.0)  N4ENDI=MAXREI
 156
 157    62 IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
 158       IF (JRECI.NE.0)  JRECI = JRECI + 1
 159       IQ(KQSP+LBPARI-7) = JRECI
 160       IQ(KQSP+LBPARI-5) = NFSTI
 161       IFLAGI = 0
 162       GO TO 999
 163
 164 C--                Recover to next steering record
 165
 166    71 IF (IFLAGI.EQ.-1)            GO TO 20
 167       GO TO 803
 168
 169    72 IF (IQUEST(1).EQ.3)          GO TO 802
 170       IF (IFLAGI.EQ.-1)            GO TO 20
 171       GO TO 801
 172
 173 C--                Recovery to this steering record
 174
 175    73 IF (NTLRI.EQ.0)              GO TO 20
 176       N4DONI = NTLRI
 177       GO TO 62
 178
 179 C-----------------------------------------------------------
 180 C-                 ERROR CONDITIONS
 181 C-----------------------------------------------------------
 182
 183
 184 C-    JERROR = 301  Block header faulty
 185   801 JERROR = 301
 186       GO TO 817
 187
 188 C-    JERROR = 302  Block size does not match expectation
 189   802 JERROR = 302
 190       IQUEST(14) = MAXREI
 191       IQUEST(15) = NWRI
 192       NWERR = 2
 193       GO TO 817
 194
 195 C-    JERROR = 303  Unexpected fast record
 196   803 JERROR = 303
 197       GO TO 817
 198
 199 C-    JERROR = 307  Unexpected and faulty steering block
 200   807 JERROR = 307
 201       GO TO 817
 202
 203 C-    JERROR = 308  Unexpected but valid steering block
 204   808 JERROR = 308
 205       IQUEST(14) = NTLRI
 206       IQUEST(15) = LQ(L4STAI+8)
 207       IQUEST(16) = LQ(L4STAI+9)
 208       NWERR  = 3
 209       JRETCD = 5
 210
 211       IQ(KQSP+LBPARI-7) = 0
 212       IQ(KQSP+LBPARI-6) = 0
 213       IQ(KQSP+LBPARI-5) = NFSTI
 214       IQ(KQSP+LBPARI-1) = N4ENDI
 215       GO TO 819
 216
 217   817 JRETCD = 6
 218   818 IQ(KQSP+LBPARI-1) = 0
 219   819 IQ(KQSP+LBPARI-9)= -1
 220   820 IFLAGI = 1
 221       GO TO 999
 222
 223 C--                EoF seen
 224
 225   841 JRETCD = 1
 226       IQ(KQSP+LBPARI-7) = 0
 227       IQ(KQSP+LBPARI-5) = 0
 228       IQ(KQSP+LBPARI-1) = 0
 229       GO TO 820
 230       END
 231 *      ==================================================
 232 #include "zebra/qcardl.inc"
 233 #endif