MINICERN/packlib/zebra/fq/fzidia.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:13  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10       SUBROUTINE FZIDIA
  11
  12 C-    Diagnostic handling routine for FZIN and FZCOPY
  13
  14 C-    The error return code JRETCD is now set :
  15
  16 C-    -4  all segments to be skipped : FZIMTB
  17 C-    -3  trying to read beyond EoD
  18 C-    -2  normal start/end of run : FZIFFN, FZIFFX
  19 C-    -1  normal EoF : FZIFFN, FZIREC
  20 C-     1  unexpected EoF :  FZIFFN, FZIPHR, FZIPHA
  21 C-     2  unexpected start/end of run : FZIFFN
  22 C-     3  not enough memory : FZIMTB
  23 C-     4  Bad User Handling : FZIN, FZIFFX, FZIMTB
  24 C-     5  Bad Data : FZIFFN, FZIFFX, FZIPHR, FZIPHA, FZIASC, FZIREL
  25 C-     6  Bad Construction : FZIFFN, .FFX, .REC, .PHR, .PHM, .PHA
  26 C-     7  Read Error : FZIFFN, FZIPHR, FZIASC
  27 C-     8  Emergency Stop
  28
  29 C-    The old scheme was :
  30
  31 C-     1  unexpected EoF :  FZIFFN, FZIPHR, FZIPHA
  32 C- -4     also : all segments to be skipped in FZIMTB
  33 C-  5            bad data in FZIREL
  34 C- -1  2  normal EoF : FZIFFN, FZIREC
  35 C-  4     also : user error handling the segment table in FZIMTB
  36 C-  2  3  unexpected start/end of run : FZIFFN
  37 C-  3     also : not enough memory in FZIMTB
  38 C- -2  4  normal start/end of run : FZIFFN, FZIFFX
  39 C-     5  Bad Data : FZIFFN, FZIFFX, FZIPHR, FZIPHA, FZIASC
  40 C-     6  Bad Construction : FZIFFN, .FFX, .REC, .PHR, .PHM, .PHA
  41 C-     7  Read Error : FZIFFN, FZIPHR, FZIASC
  42 C-  4  8  user routine / memory not connected : FZIFFX
  43 C-  8  -  Emergency Stop
  44
  45 #include "zebra/zunit.inc"
  46 #include "zebra/mqsys.inc"
  47 #include "zebra/eqlqf.inc"
  48 #include "zebra/fzci.inc"
  49 C--------------    End CDE                             --------------
  50       EQUIVALENCE (LRTYP,IDI(2))
  51       CHARACTER    ERRMSG*16
  52       CHARACTER    TEXT*4
  53 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  54       DIMENSION    NAMESR(2)
  55       DATA  NAMESR / 4HFZID, 4HIA   /
  56 #endif
  57 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  58       DATA  NAMESR / 6HFZIDIA /
  59 #endif
  60 #if !defined(CERNLIB_QTRHOLL)
  61       CHARACTER    NAMESR*8
  62       PARAMETER   (NAMESR = 'FZIDIA  ')
  63 #endif
  64
  65 #include "zebra/q_jbit.inc"
  66
  67 #include "zebra/qtrace.inc"
  68
  69       IF (JRETCD.GE.0)             GO TO 40
  70
  71 C-----------------------------------------------------
  72 C-                 Normal end-of-file / end-of-run
  73 C-----------------------------------------------------
  74
  75       J = -JRETCD
  76       GO TO ( 24, 31, 21), J
  77
  78 C--                Reading beyond end-of-data
  79
  80    21 CONTINUE
  81 #if defined(CERNLIB_QPRINT)
  82       IF (LOGLVI.GE.-2)  WRITE (IQLOG,9021) LUNI
  83  9021 FORMAT (1X/' FZIDIA.  LUN=',I4,'  Attempt to read beyond E-o-D')
  84 #endif
  85       IF (IACTVI.EQ.7)       CALL ZFATAM ('FZIDIA - reading beyond EOD')
  86       IACTVI = 7
  87       GO TO 27
  88
  89 C--                Normal EOF
  90
  91    24 N = IQ(KQSP+LQFI+11) + 1
  92       IQ(KQSP+LQFI+11) = N
  93       IACTVI = MAX (IACTVI,4) + 1
  94       IF (JBIT(MSTATI,13).EQ.0)  IACTVI=6
  95 #if defined(CERNLIB_QPRINT)
  96       IF (LOGLVI.LT.0)             GO TO 27
  97       TEXT = 'File'
  98       IF (IACTVI.EQ.6)  TEXT='Data'
  99       WRITE (IQLOG,9024) LUNI,N,TEXT
 100  9024 FORMAT (1X/' FZIN.    LUN=',I4,' System EOF #',I4,
 101      F' seen as End-of-',A)
 102 #endif
 103    27 LRTYP     = 0
 104       IQUEST(1) = IACTVI - 1
 105       GO TO 91
 106
 107 C----              Normal S/E-OF-RUN
 108
 109    31 JRUNCR = LQ(LUHEAI)
 110       IF (JRUNCR.GT.0)             GO TO 34
 111
 112 C--                End of run
 113
 114       IACTVI = MIN (4, MAX(IACTVI,2)+1)
 115       IF (JRUNCR.EQ.-1)  IACTVI = 4
 116       JRUNCR = IQ(KQSP+LQFI+29)
 117       IQUEST(1)  = IACTVI - 1
 118       IQUEST(11) = JRUNCR
 119       IQ(KQSP+LQFI+16-IACTVI) = IQ(KQSP+LQFI+16-IACTVI) + 1
 120 #if defined(CERNLIB_QPRINT)
 121       IF (LOGLVI.LT.0)             GO TO 91
 122       IF (IACTVI.EQ.3)  THEN
 123           WRITE (IQLOG,9031) LUNI,JRUNCR
 124         ELSE
 125           WRITE (IQLOG,9032) LUNI
 126         ENDIF
 127  9031 FORMAT (1X/' FZIN.    LUN=',I4,' End of Run ',I8)
 128  9032 FORMAT (   ' FZIN.    LUN=',I4,' Zebra EoF')
 129 #endif
 130       GO TO 91
 131
 132 C--                Start of run
 133
 134    34 IQ(KQSP+LQFI+14) = IQ(KQSP+LQFI+14) + 1
 135       IQ(KQSP+LQFI+29) = JRUNCR
 136       IQUEST(1)  = 1
 137       IQUEST(11) = JRUNCR
 138       IACTVI = 1
 139 #if defined(CERNLIB_QPRINT)
 140       IF (LOGLVI.GE.0)  WRITE (IQLOG,9034) LUNI,JRUNCR
 141  9034 FORMAT (1X/' FZIN.    LUN=',I4,' Start of Run ',I6)
 142 #endif
 143       GO TO 91
 144
 145 C-----------------------------------------------------
 146 C-                 Other error conditions
 147 C-----------------------------------------------------
 148
 149    40 GO TO ( 41, 44, 64, 61, 71, 74, 77, 67), JRETCD
 150
 151 C--                Unexpected end-of-file
 152
 153    41 IQ(KQSP+LQFI+30) = 1
 154 #if defined(CERNLIB_QPRINT)
 155       IF (LOGLVI.GE.-2)  WRITE (IQLOG,9041) LUNI
 156  9041 FORMAT (1X/' FZIDIA.  LUN=',I4,'  Unexpected EoF')
 157 #endif
 158       GO TO 71
 159
 160 C------            Unexpected start/end of run
 161
 162    44 IQ(KQSP+LQFI+30) = 2
 163 #if defined(CERNLIB_QPRINT)
 164       IF (LOGLVI.GE.-2)  WRITE (IQLOG,9044) LUNI
 165  9044 FORMAT (1X/' FZIDIA.  LUN=',I4,'  Unexpected Start/End-of-Run.')
 166 #endif
 167       GO TO 71
 168
 169 C----              User error
 170
 171    61 IQUEST(11)= -1
 172       ERRMSG = 'BAD CALLING'
 173       GO TO 81
 174
 175 C----              NOT ENOUGH SPACE
 176
 177    64 IQUEST(11)= -2
 178       ERRMSG = 'NOT ENOUGH SPACE'
 179       GO TO 80
 180
 181 C----              EMERGENCY STOP
 182
 183    67 IQUEST(11)= -3
 184       ERRMSG = 'EMERGENCY STOP'
 185       GO TO 80
 186
 187 C----              BAD DATA
 188
 189    71 IQUEST(11)= -3
 190       ERRMSG = 'BAD DATA'
 191       GO TO 80
 192
 193 C----              BAD CONSTRUCTION
 194
 195    74 IQUEST(11)= -4
 196       ERRMSG = 'BAD CONSTRUCTION'
 197       GO TO 80
 198
 199 C----              READ ERROR
 200
 201    77 IQUEST(11)= -5
 202       ERRMSG = 'READ ERROR'
 203
 204 C------            Print error message
 205
 206    80 IQ(KQSP+LQFI+18) = IQ(KQSP+LQFI+18) + 1
 207    81 IQUEST(1) = IQUEST(11)
 208       IQUEST(3) = IQ(KQSP+LQFI+22)
 209       IQUEST(12)= JERROR
 210       IQUEST(13)= LRTYP
 211       LRTYP = 0
 212       LAST  = IQ(KQSP+LQFI+26)
 213       IF (LAST.LT.0)       IQUEST(1)=MIN(-6,LAST-1)
 214 #if defined(CERNLIB_QPRINT)
 215       IF (LOGLVI.GE.-2)
 216      +  WRITE (IQLOG,9081,ERR=82) LUNI,ERRMSG
 217      +,                    IQUEST(1),NRECAI,IQUEST(3)
 218      +,                    (IQUEST(J+10),J=1,NWERR+3)
 219    82 CONTINUE
 220
 221  9081 FORMAT (1X/' FZIDIA.  LUN=',I4,1X,A/
 222      F 10X,'IQUEST(1/2/3)=',I4,2I8/
 223      F 10X,'IQUEST(11-) = ',3I4,2I9,
 224 #endif
 225 #if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
 226      F 2O23)
 227 #endif
 228 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
 229      F 2Z17)
 230 #endif
 231       IF (LAST.LT.-50)
 232      +         CALL ZFATAM ('FZIDIA - too many consecutive errors.')
 233
 234    91 CONTINUE
 235 #include "zebra/qtrace99.inc"
 236       RETURN
 237       END
 238 *      ==================================================
 239 #include "zebra/qcardl.inc"