MINICERN/packlib/zebra/fq/fziphd.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:15  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13 #if defined(CERNLIB_FZDACC)
  14       SUBROUTINE FZIPHD
  15
  16 C-    Read next physical record in direct-access 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 C-                         -2  start
  22
  23 C-                 N4SKII      is used for rapid skip of fast blocks
  24
  25 C-    Output :     IFLAGI = 0  all is well
  26 C-                             otherwise : ready for re-start
  27
  28 #include "zebra/zbcd.inc"
  29 #include "zebra/zmach.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 "fziphrd1.inc"
  39 * Ignoring t=pass
  40
  41 #include "fzstamp.inc"
  42 #include "fzdaeof.inc"
  43 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  44       DIMENSION    NAMESR(2)
  45       DATA  NAMESR / 4HFZIP, 4HHD   /
  46 #endif
  47 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  48       DATA  NAMESR / 6HFZIPHD /
  49 #endif
  50 #if !defined(CERNLIB_QTRHOLL)
  51       CHARACTER    NAMESR*8
  52       PARAMETER   (NAMESR = 'FZIPHD  ')
  53 #endif
  54
  55 *      Declaratives, DATA
  56 #include "fziphrd2.inc"
  57
  58
  59 #include "zebra/qtrace.inc"
  60
  61       NWMREC = IQ(KQSP+LBPARI+1)
  62       NRSKIP = 0
  63
  64       JRECGO = IQ(KQSP+LQFI+33)
  65       JRECLL = JRECGO
  66       IF (JRECGO.GE.0)             GO TO 22
  67
  68 C--                Random access
  69
  70       JRECNO = IQ(KQSP+LQFI+31)
  71       NFASTI = 0
  72       GO TO 27
  73
  74 C--                Sequential access
  75
  76    22 NFASTI = IQ(KQSP+LBPARI-5)
  77       JRECNO = JRECGO + 1
  78       N4SKIP = MIN (N4SKII,N4RESI)
  79       IF (JRECGO.EQ.0)  JRECLL = -7
  80
  81       IF (N4SKIP.GE.MAXREI)  THEN
  82         IF (NFASTI.GT.0)  THEN
  83             NRSKIP = MIN (NFASTI, N4SKIP / MAXREI)
  84             JRECNO = JRECNO + NRSKIP
  85             NFASTI = NFASTI - NRSKIP
  86           ENDIF
  87         ENDIF
  88
  89       IQ(KQSP+LBPARI-6) = NFASTI
  90
  91    27 LIN = L4STAI
  92 #if defined(CERNLIB_FQNEEDPK)
  93       IF (IUPAKI.NE.0)             GO TO 31
  94
  95 C--       Exchange Data Format needing to be unpacked
  96
  97       LIN = LIN + IQ(KQSP+LBPARI+3)
  98 #endif
  99
 100 C----              READ ONE PHYSICAL RECORD
 101
 102    31 NBLK = IQ(KQSP+LQFI+22) + 1
 103       IQ(KQSP+LQFI+33) = JRECNO
 104 #if defined(CERNLIB_QDEBPRI)
 105       IF (LOGLVI.GE.3)
 106      +      WRITE (IQLOG,9031) JRECNO,MAXREI,NWMREC,NFASTI,NRSKIP
 107  9031 FORMAT (1X/' FZIPHD-  Reading Block #',I7,
 108      F', NW32,NWmach,NRfast,NRskip=',4I6)
 109 #endif
 110 #if defined(CERNLIB_FZDACCL)
 111       IF (IACMOI.EQ.2)  THEN
 112           IF (JRECNO.NE.JRECLL+1)  THEN
 113               CALL CFSEEK (IADOPI, MEDIUI, NWMREC, JRECNO-1, ISW)
 114               IF (ISW.NE.0)        GO TO 847
 115             ENDIF
 116
 117           NWR = NWMREC
 118           CALL CFGET (IADOPI, MEDIUI, NWMREC, NWR, LQ(LIN), ISW)
 119           IF (ISW.NE.0)            GO TO 842
 120           JRECLL = JRECNO
 121           GO TO 39
 122         ENDIF
 123
 124 #endif
 125 #if defined(CERNLIB_FZDACCH)
 126       IF (IACMOI.EQ.3)  THEN
 127           CALL JUMPST (IADOPI)
 128           ICODE     = 0
 129           IQUEST(1) = LUNI
 130           IQUEST(2) = NWMREC
 131           IQUEST(3) = ISTENI
 132           IQUEST(4) = JRECNO
 133           IQUEST(5) = MEDIUI - 4
 134           IQUEST(6) = NWMREC
 135           CALL JUMPX2 (LQ(LIN),ICODE)
 136           ISW = IQUEST(1)
 137           IF (ISW.LT.0)            GO TO 841
 138           IF (ISW.NE.0)            GO TO 843
 139           NWR = IQUEST(2)
 140           GO TO 39
 141         ENDIF
 142
 143 #endif
 144 #if defined(CERNLIB_FZDACCF)
 145 #include "fziphd37.inc"
 146 #endif
 147    39 IQ(KQSP+LQFI+22) = NBLK
 148       NWRDAI = NWRDAI + MAXREI
 149       NW4USE = MAXREI
 150
 151 C----              UNPACK / BYTE-SWOP
 152
 153 #if defined(CERNLIB_FQNEEDCV)
 154       IF (IUPAKI.NE.0)             GO TO 47
 155
 156 #endif
 157 #if defined(CERNLIB_FQNEEDCV)
 158 #include "fziphd42.inc"
 159 #endif
 160
 161 C--                Short/full dump of record read
 162
 163    47 CONTINUE
 164 #if defined(CERNLIB_QDEBPRI)
 165       IF (LOGLVI.GE.3)  CALL FZIDUM (LQ(L4STAI),NW4USE)
 166 #endif
 167
 168 C-----------------------------------------------------------
 169 C----              FAST RECORD EXPECTED
 170 C-----------------------------------------------------------
 171
 172       IF (NFASTI.LT.0)             GO TO 84
 173       IF (NFASTI.EQ.0)             GO TO 61
 174       IF (LQ(L4STAI).EQ.MCCW1)     GO TO 57
 175    52 NFASTI = NFASTI - 1
 176       IQ(KQSP+LBPARI-5) = NFASTI
 177       IF (NRSKIP.NE.0)  THEN
 178 C--       skip records
 179           N4SKII = N4SKII - MAXREI*NRSKIP
 180           N4RESI = N4RESI - MAXREI*NRSKIP
 181         ENDIF
 182
 183 C--       deliver record
 184       N4DONI = 0
 185       N4ENDI = MIN (N4RESI,MAXREI)
 186
 187       IFLAGI = 0
 188 #include "zebra/qtrace99.inc"
 189       RETURN
 190
 191 C----              Unexpected steering record
 192
 193    57 CALL FZICHH (0, LQ(L4STAI),1)
 194       IF (IQUEST(1).EQ.0)          GO TO 52
 195       GO TO 81
 196
 197 C-----------------------------------------------------------
 198 C----              STEERING RECORD EXPECTED
 199 C-----------------------------------------------------------
 200
 201    61 CALL FZICHH (0, LQ(L4STAI),IFLAGI)
 202       IF (IQUEST(1).NE.0)          GO TO 71
 203       IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
 204       N4DONI = 8
 205
 206 C--       random access
 207       IF (JRECGO.LT.0)  THEN
 208           N4ENDI = IQ(KQSP+LQFI+32)
 209           IF (N4ENDI.EQ.0)  N4ENDI = NTLRI
 210           IF (JRECI.NE.0)   JRECI  = JRECI + 1
 211           GO TO 67
 212         ENDIF
 213
 214 C--                Sequental access
 215
 216       N4ENDI = NTLRI
 217       IF (N4ENDI.EQ.0)  N4ENDI= MAXREI
 218
 219       IF (IFLAGI.EQ.-1)            GO TO 73
 220
 221 C--       skip records
 222       IF (NRSKIP.NE.0)  THEN
 223           N4SKIP = N4SKIP - MAXREI*NRSKIP
 224           N4RESI = N4RESI - MAXREI*NRSKIP
 225         ENDIF
 226
 227       JREX = IQ(KQSP+LBPARI-7)
 228       IF   (JRECI.NE.0)  THEN
 229           IF (JREX.NE.0)    THEN
 230               IF (JREX.NE.JRECI)   GO TO 804
 231             ENDIF
 232           JRECI = JRECI + 1
 233         ENDIF
 234
 235    67 IQ(KQSP+LBPARI-7) = JRECI
 236       IQ(KQSP+LBPARI-5) = NFSTI
 237       IFLAGI = 0
 238       GO TO 999
 239
 240 C----              Recover to next steering record
 241
 242    71 IF (IQUEST(1).EQ.3)          GO TO 802
 243       IF (IQUEST(1).EQ.4)          GO TO 841
 244       IF (IFLAGI.NE.-1)            GO TO 82
 245    72 JRECNO = JRECNO + 1
 246       GO TO 27
 247
 248 C--                Recovery to this steering record
 249
 250    73 IF (NTLRI.EQ.0)              GO TO 72
 251       N4DONI = NTLRI
 252       GO TO 67
 253
 254 C-----------------------------------------------------------
 255 C----              Check skipping passed over a steering record
 256 C-----------------------------------------------------------
 257
 258    81 IF (NRSKIP.EQ.0)             GO TO 87
 259       GO TO 83
 260
 261    82 IF (NRSKIP.EQ.0)             GO TO 801
 262    83 JRECE  = JRECNO
 263       JRECNO = JRECGO + 1
 264       NFASTI = -1
 265       GO TO 27
 266
 267    84 CALL FZICHH (0, LQ(L4STAI),-1)
 268       IF (IQUEST(1).EQ.0)          GO TO 87
 269       IF (JRECNO.EQ.JRECE)         GO TO 801
 270       JRECNO = JRECNO + 1
 271       GO TO 27
 272
 273    87 N4ENDI = NTLRI
 274       IF (JMODI.EQ.4)              GO TO 809
 275       IQ(KQSP+LQFI+23) = IQ(KQSP+LQFI+23) + 1
 276       GO TO 808
 277
 278 C-----------------------------------------------------------
 279 C----              ERROR CONDITIONS
 280 C-----------------------------------------------------------
 281
 282 C-    JERROR = 501  Block header faulty
 283   801 JERROR = 501
 284       GO TO 817
 285
 286 C-    JERROR = 502  Block size does not match expectation
 287   802 JERROR = 502
 288       IQUEST(14) = MAXREI
 289       IQUEST(15) = NWRI
 290       NWERR = 2
 291       GO TO 817
 292
 293 C-    JERROR = 504  Break in block sequence number
 294   804 JERROR = 504
 295       JRETCD = 5
 296       IQUEST(14) = JREX
 297       IQUEST(15) = JRECI
 298       NWERR  = 2
 299       GO TO 811
 300
 301 C-    JERROR = 508  Fast burst stopped by usable steering block
 302   808 JERROR = 508
 303       IQUEST(14) = NTLRI
 304       IQUEST(15) = LQ(L4STAI+8)
 305       IQUEST(16) = LQ(L4STAI+9)
 306       NWERR  = 3
 307       JRETCD = 5
 308       GO TO 811
 309
 310 C-    JERROR = 509  Emergency stop block
 311   809 JERROR = 509
 312       JRETCD = 8
 313       N4ENDI = 0
 314
 315   811 IQ(KQSP+LBPARI-7) = 0
 316       IQ(KQSP+LBPARI-6) = 0
 317       IQ(KQSP+LBPARI-5) = NFSTI
 318       IQ(KQSP+LBPARI-1) = N4ENDI
 319       GO TO 819
 320
 321   817 JRETCD = 6
 322   818 IQ(KQSP+LBPARI-1) = 0
 323   819 IQ(KQSP+LBPARI-9)= -1
 324   820 IFLAGI = 1
 325       GO TO 999
 326
 327 C--                EoF seen
 328
 329   840 IF (ISW.EQ.-1)               GO TO 841
 330 *      Extra EOF test
 331 #include "fzdaeofx.inc"
 332 * Ignoring t=pass
 333       IF (ISW.NE.IOSEOF)           GO TO 843
 334   841 JRETCD = 1
 335       IQ(KQSP+LBPARI-7) = 0
 336       IQ(KQSP+LBPARI-5) = 0
 337       IQ(KQSP+LBPARI-1) = 0
 338       GO TO 820
 339
 340 C--                Read error
 341
 342 #if defined(CERNLIB_FZDACCL)
 343   842 IF (ISW.EQ.-1)               GO TO 841
 344 #endif
 345   843 JRETCD = 7
 346 C-    JERROR = 515  Read error
 347       JERROR = 515
 348       NWERR  = 1
 349       IQUEST(14) = ISW
 350       GO TO 818
 351
 352 C--                Seek error
 353
 354 #if defined(CERNLIB_FZDACCL)
 355   847 JRETCD = 7
 356 C-    JERROR = 514  Seek error
 357       JERROR = 514
 358       NWERR  = 1
 359       IQUEST(14) = ISW
 360       GO TO 818
 361 #endif
 362       END
 363 *      ==================================================
 364 #include "zebra/qcardl.inc"
 365 #endif