MINICERN/packlib/zebra/fq/fziphr.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:10:41  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:15  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE FZIPHR
  14
  15 C-    Read next physical record in sequential mode
  16 C-    Service routine to FZIN, called only via FZIREC
  17
  18 C-    Input :      IFLAGI = 0  normal read
  19 C-                         -1  recover to next steering block
  20 C-                         -2  start
  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/zunit.inc"
  30 #include "zebra/mqsys.inc"
  31 #include "zebra/eqlqf.inc"
  32 #include "zebra/fzci.inc"
  33 #include "fzhci.inc"
  34 C--------------    End CDE                             --------------
  35
  36 *      Declaratives, DIMENSION etc.
  37 #include "fziphrd1.inc"
  38 * Ignoring t=pass
  39
  40 #include "fzstamp.inc"
  41 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  42       DIMENSION    NAMESR(2)
  43       DATA  NAMESR / 4HFZIP, 4HHR   /
  44 #endif
  45 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  46       DATA  NAMESR / 6HFZIPHR /
  47 #endif
  48 #if !defined(CERNLIB_QTRHOLL)
  49       CHARACTER    NAMESR*8
  50       PARAMETER   (NAMESR = 'FZIPHR  ')
  51 #endif
  52
  53 *      Declaratives, DATA
  54 #include "fziphrd2.inc"
  55 * Ignoring t=pass
  56
  57
  58 #include "zebra/qtrace.inc"
  59
  60 C----              DECIDE START ADR AND LENGTH FOR READ
  61
  62       NWMREC = IQ(KQSP+LBPARI+1)
  63       NFASTI = IQ(KQSP+LBPARI-5)
  64       N4SKIP = MIN (N4SKII,N4RESI)
  65       NRSKIP = 0
  66       IF (N4SKIP.GE.MAXREI)  THEN
  67           IF (NFASTI.NE.0)  NRSKIP = MIN (NFASTI, N4SKIP / MAXREI)
  68         ENDIF
  69
  70    20 NW4IN  = MAXREI
  71       NWMIN  = NWMREC
  72
  73       IQ(KQSP+LBPARI-6) = NFASTI
  74
  75       LIN = L4STAI
  76 #if !defined(CERNLIB_QREADFULL)
  77       IF (NRSKIP.GE.2)  THEN
  78           NW4IN  = 90
  79           NWMIN  = NW4IN
  80         ENDIF
  81 #endif
  82 #if defined(CERNLIB_FQNEEDPK)
  83       IF (IUPAKI.NE.0)             GO TO 31
  84
  85 C--       Exchange Data Format needing to be unpacked
  86
  87       LIN = LIN + IQ(KQSP+LBPARI+3)
  88 #endif
  89 #if (!defined(CERNLIB_QREADFULL))&&(defined(CERNLIB_FQNEEDPK))
  90       IF (NW4IN.EQ.MAXREI)         GO TO 31
  91 #include "fznwmach.inc"
  92 * Ignoring t=pass
  93 #endif
  94
  95 C----              READ ONE PHYSICAL RECORD
  96
  97    31 IQ(KQSP+LQFI+33) = IQ(KQSP+LQFI+33) + 1
  98       NBLK = IQ(KQSP+LQFI+22) + 1
  99 #if defined(CERNLIB_QDEBPRI)
 100       IF (LOGLVI.GE.3)
 101      +      WRITE (IQLOG,9031) NBLK,NW4IN,NWMIN,NFASTI,NRSKIP
 102  9031 FORMAT (1X/' FZIPHR-  Reading Block',I7,
 103      F', NW32,NWmach,NRfast,NRskip=',4I6)
 104
 105 #endif
 106 #if defined(CERNLIB_FZLIBC)
 107       IF (IACMOI.EQ.2)  THEN
 108           NWR = NWMREC
 109           CALL CFGET (IADOPI, MEDIUI, NWMREC, NWR, LQ(LIN), ISW)
 110           IF (ISW.EQ.-1)           GO TO 841
 111           IF (ISW.NE.0)            GO TO 843
 112           IF (NWR.EQ.NWMREC)  NW4IN = MAXREI
 113           GO TO 39
 114         ENDIF
 115
 116 #endif
 117 #if defined(CERNLIB_FZCHANNEL)
 118       IF (IACMOI.EQ.3)  THEN
 119           CALL JUMPST (IADOPI)
 120           ICODE     = 0
 121           IQUEST(1) = LUNI
 122           IQUEST(2) = NWMREC
 123           IQUEST(3) = ISTENI
 124           IQUEST(4) = 0
 125           IQUEST(5) = MEDIUI - 4
 126           IQUEST(6) = NWMREC
 127           CALL JUMPX2 (LQ(LIN),ICODE)
 128           ISW = IQUEST(1)
 129           IF (ISW.LT.0)            GO TO 841
 130           IF (ISW.NE.0)            GO TO 843
 131           NWR = IQUEST(2)
 132           IF (NWR.EQ.NWMREC)  NW4IN = MAXREI
 133           GO TO 39
 134         ENDIF
 135
 136 #endif
 137 #if defined(CERNLIB_FZFORTRAN)
 138 #include "fziphr32.inc"
 139    36 NWR = NWMIN
 140       CALL XINBF (LUNI,LQ(LIN),NWR)
 141       IF (NWR.EQ.0)                GO TO 841
 142       ISW = -NWR
 143       IF (NWR.LT.0)                GO TO 843
 144       NWR = MIN (NWR,NWMIN)
 145 #endif
 146    39 IQ(KQSP+LQFI+22) = NBLK
 147       NWRDAI = NWRDAI + MAXREI
 148       NW4USE = NW4IN
 149
 150 C----              UNPACK / BYTE-SWOP
 151
 152 #if defined(CERNLIB_FQNEEDCV)
 153       IF (IUPAKI.NE.0)             GO TO 47
 154       IF (NRSKIP.NE.0)   NW4USE = 8
 155       IF (IFLAGI.EQ.-1)  NW4USE = 8
 156
 157 #endif
 158 #if defined(CERNLIB_FQNEEDCV)
 159 #include "fziphr42.inc"
 160 #endif
 161
 162 C--                Short/full dump of record read
 163
 164    47 CONTINUE
 165 #if defined(CERNLIB_QDEBPRI)
 166       IF (LOGLVI.GE.3)  CALL FZIDUM (LQ(L4STAI),NW4USE)
 167 #endif
 168
 169 C-----------------------------------------------------------
 170 C----              FAST RECORD EXPECTED
 171 C-----------------------------------------------------------
 172
 173       IF (NFASTI.EQ.0)             GO TO 61
 174       IF (LQ(L4STAI).EQ.MCCW1)     GO TO 54
 175    52 NFASTI = NFASTI - 1
 176       IQ(KQSP+LBPARI-5) = NFASTI
 177       IF (NRSKIP.EQ.0)             GO TO 53
 178
 179 C--       skip record
 180       N4SKII = N4SKII - MAXREI
 181       N4RESI = N4RESI - MAXREI
 182       NRSKIP = NRSKIP - 1
 183       GO TO 20
 184
 185 C--       deliver record
 186    53 N4DONI = 0
 187       N4ENDI = MIN (N4RESI,MAXREI)
 188       IFLAGI = 0
 189 #include "zebra/qtrace99.inc"
 190       RETURN
 191
 192 C----              Unexpected steering record
 193
 194    54 CALL FZICHH (0, LQ(L4STAI),1)
 195       IF (IQUEST(1).EQ.0)          GO TO 52
 196 #if defined(CERNLIB_FQNEEDCV)
 197 C--       Unpack all words read
 198       IF (NW4USE.LT.NW4IN) THEN
 199           NW4USE = NW4IN
 200           GO TO 42
 201         ENDIF
 202 #endif
 203
 204       IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
 205       N4ENDI = NTLRI
 206       IF (JMODI.EQ.4)              GO TO 809
 207       IF (NW4IN.EQ.MAXREI)         GO TO 808
 208
 209 C--         recover start/end-of-run in partially read record
 210
 211       IF (JMODI.EQ.0)              GO TO 806
 212       IF (JMODI.GT.2)              GO TO 806
 213       IF (NTLRI+3.GT.NW4IN)        GO TO 805
 214
 215       LRCUR = L4STAI + NTLRI + 1
 216       LRLG  = LQ(LRCUR-1)
 217       LRTP  = LQ(LRCUR)
 218       IF (LRLG.LT.1)               GO TO 806
 219       IF (LRLG.GT.401)             GO TO 806
 220       IF (LRTP.NE.1)               GO TO 806
 221       IF (LQ(LRCUR+1).LT.0)        GO TO 806
 222       LRLG  = MIN (LRLG, NW4IN-NTLRI-2)
 223       NUSED = NTLRI + LRLG + 2
 224       LQ(LRCUR-1) = LRLG
 225       LRCUR = LRCUR + LRLG + 1
 226       LQ(LRCUR)   = MAXREI - NUSED - 1
 227       LQ(LRCUR+1) = 5
 228       NFSTI  = 0
 229       GO TO 807
 230
 231 C-----------------------------------------------------------
 232 C----              STEERING RECORD EXPECTED
 233 C-----------------------------------------------------------
 234
 235    61 CALL FZICHH (0, LQ(L4STAI),IFLAGI)
 236       IF (IQUEST(1).NE.0)          GO TO 71
 237       N4ENDI = NTLRI
 238
 239       IF (IFLAGI.LT.0)             GO TO 73
 240
 241       JREX = IQ(KQSP+LBPARI-7)
 242       IF   (JREX.NE.0)  THEN
 243           IF (JRECI.NE.0)    THEN
 244               IF (JRECI.NE.JREX)   GO TO 804
 245             ENDIF
 246         ENDIF
 247
 248       N4DONI = 8
 249       IF (N4ENDI.EQ.0)  N4ENDI= MAXREI
 250
 251    62 IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
 252       IF (JRECI.NE.0)   JRECI = JRECI + 1
 253       IQ(KQSP+LBPARI-7) = JRECI
 254       IQ(KQSP+LBPARI-5) = NFSTI
 255       IFLAGI = 0
 256       GO TO 999
 257
 258 C----              Recover to next steering record
 259
 260    71 IF (IQUEST(1).EQ.3)          GO TO 802
 261       IF (IFLAGI.EQ.-1)            GO TO 20
 262       GO TO 801
 263
 264 C--                Recovery to this steering record
 265
 266    73 IF (NTLRI.EQ.0)              GO TO 20
 267 #if defined(CERNLIB_FQNEEDCV)
 268       IF (NW4USE.LT.NW4IN) THEN
 269           NW4USE = NW4IN
 270           GO TO 42
 271         ENDIF
 272 #endif
 273       N4DONI = NTLRI
 274       GO TO 62
 275
 276 C-----------------------------------------------------------
 277 C-                 ERROR CONDITIONS
 278 C-----------------------------------------------------------
 279
 280
 281 C-    JERROR = 201  Block header faulty
 282   801 JERROR = 201
 283       GO TO 817
 284
 285 C-    JERROR = 202  Block size does not match expectation
 286   802 JERROR = 202
 287       IQUEST(14) = MAXREI
 288       IQUEST(15) = NWRI
 289       NWERR = 2
 290       GO TO 817
 291
 292 C-    JERROR = 204  Break in block sequence number
 293   804 JERROR = 204
 294       JRETCD = 5
 295       IQUEST(14) = JREX
 296       IQUEST(15) = JRECI
 297       NWERR  = 2
 298       GO TO 811
 299
 300 C-    JERROR = 205  Fast burst stopped by unusable start/end-of-run
 301   805 JERROR = -1
 302
 303 C-    JERROR = 206  Fast burst stopped by unusable steering block
 304   806 JERROR = JERROR - 1
 305       N4ENDI = 0
 306
 307 C-    JERROR = 207  Fast burst stopped by usable start/end-of-run
 308 C-                             in unusable steering block
 309   807 JERROR = JERROR - 1
 310
 311 C-    JERROR = 208  Fast burst stopped by usable steering block
 312   808 JERROR = 208 + JERROR
 313       IQUEST(14) = NTLRI
 314       IQUEST(15) = LQ(L4STAI+8)
 315       IQUEST(16) = LQ(L4STAI+9)
 316       NWERR  = 3
 317       JRETCD = 5
 318       GO TO 811
 319
 320 C-    JERROR = 209  Emergency stop block
 321   809 JERROR = 209
 322       JRETCD = 8
 323       N4ENDI = 0
 324
 325   811 IQ(KQSP+LBPARI-7) = 0
 326       IQ(KQSP+LBPARI-6) = 0
 327       IQ(KQSP+LBPARI-5) = NFSTI
 328       IQ(KQSP+LBPARI-1) = N4ENDI
 329       GO TO 819
 330
 331   817 JRETCD = 6
 332   818 IQ(KQSP+LBPARI-1) = 0
 333   819 IQ(KQSP+LBPARI-9)= -1
 334   820 IFLAGI = 1
 335       GO TO 999
 336
 337 C--                EoF seen
 338
 339   841 JRETCD = 1
 340       IQ(KQSP+LBPARI-7) = 0
 341       IQ(KQSP+LBPARI-5) = 0
 342       IQ(KQSP+LBPARI-1) = 0
 343       GO TO 820
 344
 345 C--                Read error
 346
 347   843 JRETCD = 7
 348       JERROR = 215
 349       NWERR  = 1
 350       IQUEST(14) = ISW
 351       GO TO 818
 352       END
 353 *      ==================================================
 354 #include "zebra/qcardl.inc"