MINICERN/packlib/zebra/fq/fzidat.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:10:30  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:12  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13 #if defined(CERNLIB_FZDACC)
  14       SUBROUTINE FZIDAT (LUNP,IXDIVP,LSUPP,JBIASP)
  15
  16 C-    Find and read the Direct Access Table
  17
  18 #include "zebra/zunit.inc"
  19 #include "zebra/mqsys.inc"
  20 #include "zebra/eqlqf.inc"
  21 #include "zebra/fzci.inc"
  22 C--------------    End CDE                             --------------
  23       DIMENSION    LUNP(9),IXDIVP(9),LSUPP(9),JBIASP(9)
  24       DIMENSION    MDSADR(4)
  25       CHARACTER    CHOPT*2
  26 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  27       DIMENSION    NAMESR(2)
  28       DATA  NAMESR / 4HFZID, 4HAT   /
  29 #endif
  30 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  31       DATA  NAMESR / 6HFZIDAT /
  32 #endif
  33 #if !defined(CERNLIB_QTRHOLL)
  34       CHARACTER    NAMESR*8
  35       PARAMETER   (NAMESR = 'FZIDAT  ')
  36 #endif
  37
  38 #include "zebra/q_jbit.inc"
  39
  40 #include "zebra/qtrace.inc"
  41
  42       LUNNI = LUNP(1)
  43       CALL FZLOC (LUNNI,1)
  44 #if defined(CERNLIB_QDEBPRI)
  45       IF (LOGLVI.GE.2)  WRITE (IQLOG,9002) LUNI
  46  9002 FORMAT (' FZIDAT-  called for LUN=',I4)
  47 #endif
  48
  49       IFLUPD = 7
  50       IFLNOR = 0
  51       LBPARI = LQFI + INCBPI
  52       NWPREC = IQ(KQSP+LBPARI+1)
  53
  54 C----              Read the first logical record
  55
  56       CHOPT = 'SF'
  57       ITER  = 0
  58       MDSADR(1) = 1
  59       MDSADR(2) = 0
  60
  61    24 CALL FZINXT (LUNI,MDSADR(1),MDSADR(2))
  62
  63    26 NUH = 2
  64       CALL FZIN (LUNI, IXDIVP, LSUPP, JBIASP, CHOPT, NUH, MDSADR)
  65       MDSADR(NUH+1) = 0
  66       MDSADR(NUH+2) = 0
  67
  68 C--       ITER = 0  read first LR of the file, is it DAT forward ref.?
  69 C-               1  read the last LR of the file, is it Zebra EoF ?
  70 C-               2  hunt for DAT record
  71 C-               3  select DAT record
  72 C-               4  read the data of the DAT record
  73
  74       IF (ITER.EQ.4)               GO TO 67
  75       IF (ITER.EQ.3)               GO TO 64
  76       IF (ITER.EQ.2)               GO TO 54
  77       IF (ITER.EQ.1)               GO TO 44
  78
  79 C--       look at the first record
  80       IF (IQUEST(1).GE.4)          GO TO 802
  81       IF (IQUEST(1).NE.0)          GO TO 34
  82       IF (IPILI(3) .NE.2)          GO TO 34
  83       IF (MDSADR(1).NE.0)          GO TO 61
  84
  85 #if defined(CERNLIB_QDEBPRI)
  86       IF (LOGLVI.GE.0)  WRITE (IQLOG,9032) LUNI
  87  9032 FORMAT (' FZIDAT.  LUN=',I4,' DaT forward ref. record not filled')
  88 #endif
  89       GO TO 41
  90
  91    34 IFLUPD = 0
  92 #if defined(CERNLIB_QDEBPRI)
  93       IF (LOGLVI.GE.0)  WRITE (IQLOG,9034) LUNI
  94  9034 FORMAT (' FZIDAT.  LUN=',I4,
  95      F' does not start with DaT forward ref. record')
  96 #endif
  97
  98 C------            Get the last logical record
  99
 100    41 ITER  = 1
 101 #if defined(CERNLIB_QDEBPRI)
 102       IF (LOGLVI.GE.0)  WRITE (IQLOG,9041)
 103  9041 FORMAT (19X,'try direct read of last record')
 104 #endif
 105 #if defined(CERNLIB_FZDACCL)
 106       IF (IACMOI.EQ.2)  THEN
 107           CALL CFSIZE (IADOPI, MEDIUI,NWPREC,JRECLL,ISTAT)
 108           GO TO 42
 109         ENDIF
 110 #endif
 111       CALL FFSIZE (LUNI,NWPREC,JRECLL,ISTAT)
 112
 113    42 IF (ISTAT.NE.0)  JRECLL = 0
 114       IF (JRECLL.LE.0)             GO TO 51
 115       MDSADR(1) = JRECLL
 116       MDSADR(2) = 0
 117       GO TO 24
 118
 119 C--       look at the last logical record
 120    44 IF (IQUEST(1).GE.4)          GO TO 51
 121       IF (IQUEST(1).LT.0)          GO TO 51
 122       IF (IQUEST(1).NE.3)          GO TO 26
 123       IF (MDSADR(1).NE.0)          GO TO 62
 124
 125 #if defined(CERNLIB_QDEBPRI)
 126       IF (LOGLVI.GE.0)  WRITE (IQLOG,9046) LUNI
 127  9046 FORMAT (' FZIDAT.  LUN=',I4,' Zebra EoF does not point to DaT')
 128 #endif
 129       IF (MDSADR(2).EQ.0)          GO TO 801
 130
 131 C------            Hunt for the DAT bank or Zebra EoF
 132
 133    51 ITER   = 2
 134       CHOPT  = 'SH'
 135       JRECLL = MAX (JRECLL-25,1)
 136       LDSADR = -1
 137       NFTOL  = 4
 138       IF (JRECLL.GE.11)  NFTOL  = 12
 139       MDSADR(1) = JRECLL
 140       MDSADR(2) = 0
 141 #if defined(CERNLIB_QDEBPRI)
 142       IF (LOGLVI.GE.0)  WRITE (IQLOG,9051) LUNI,JRECLL
 143  9051 FORMAT (' FZIDAT.  LUN=',I4,' cannot get DaT adr from Zebra EoF'
 144      F/19X,'hunt for it starting at record',I9)
 145 #endif
 146       GO TO 24
 147
 148    54 IF (IQUEST(1).EQ.0)          GO TO 65
 149       IF (IQUEST(1).EQ.3)          GO TO 55
 150       IF (IQUEST(1).GE.4)          GO TO 57
 151       IF (IQUEST(1).LT.0)  THEN
 152           NFTOL = NFTOL - 1
 153           IF (NFTOL.LT.0)          GO TO 801
 154         ELSE
 155           LDSADR = -1
 156         ENDIF
 157       GO TO 26
 158
 159    55 IF (MDSADR(1).NE.0)          GO TO 62
 160       LDSADR = MDSADR(2)
 161       GO TO 26
 162
 163    57 IF (JRECLL.LE.1)             GO TO 801
 164       IF (LDSADR.EQ.0)             GO TO 801
 165       JRECLL = 0
 166       GO TO 51
 167
 168 C------            Read the DAT bank
 169
 170    61 IFLUPD = 0
 171       IFLNOR = -2
 172    62 ITER   = 3
 173       GO TO 24
 174
 175    64 IF (IQUEST(1).NE.0)          GO TO 801
 176       IF (IPILI(3).NE.1)           GO TO 801
 177    65 IQ(KQSP+LQFI+34) = IQUEST(5)
 178       IQ(KQSP+LQFI+35) = IQUEST(6)
 179       CHOPT = 'A '
 180       ITER  = 4
 181       GO TO 26
 182
 183    67 IF (IQUEST(1).NE.0)          GO TO 801
 184       IF (IQUEST(13).EQ.0)         GO TO 801
 185
 186 C--       update the DAT forward reference record
 187       IF (IFLUPD.EQ.0)             GO TO 71
 188       IF (JBIT(MSTATI,12).EQ.0)    GO TO 71
 189       IQ(KQSP+LQFI+2) = 0
 190       CALL FZUDAT (LUNP,1)
 191
 192    71 IQ(KQSP+LQFI+2) = 2
 193 #if defined(CERNLIB_QDEBPRI)
 194       IF (LOGLVI+IFLNOR.GE.0)  WRITE (IQLOG,9072) LUNI
 195  9072 FORMAT (' FZIDAT.  LUN=',I4,' rewind')
 196 #endif
 197       CALL FZENDI (LUNP,'IQ')
 198 #include "zebra/qtrace99.inc"
 199       RETURN
 200
 201 C----              Errors
 202
 203   801 IQUEST(1) = -1
 204 #if defined(CERNLIB_QDEBPRI)
 205       IF (LOGLVI.GE.-2)  WRITE (IQLOG,9098) LUNI
 206  9098 FORMAT (' FZIDAT.  LUN=',I4,' DaT not found !!!')
 207 #endif
 208       GO TO 71
 209
 210   802 IQUEST(1) = -2
 211 #if defined(CERNLIB_QDEBPRI)
 212       IF (LOGLVI.GE.-2)  WRITE (IQLOG,9099) LUNI
 213  9099 FORMAT (' FZIDAT.  LUN=',I4,' file is empty !!!')
 214 #endif
 215       GO TO 999
 216       END
 217 *      ==================================================
 218 #include "zebra/qcardl.inc"
 219 #endif