MINICERN/packlib/zebra/mqv/zverif.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 ZVERIF (IXSTP,IFRETN,TEXTID)
  11
  12 C-    Verify integrity of store IXVSTO
  13 C-        IXVSTO = -1 : verify all stores
  14 C-                 -2 : verify stores selected in the ZVAUTO mask
  15
  16 #include "zebra/zmach.inc"
  17 #include "zebra/zstate.inc"
  18 #include "zebra/zunit.inc"
  19 #include "zebra/mqsys.inc"
  20 #include "zebra/mzcn.inc"
  21 #include "zebra/zvfaut.inc"
  22 #include "zebra/zvfwkc.inc"
  23 C--------------    END CDE                             --------------
  24       CHARACTER    TEXTID*(*)
  25 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  26       DIMENSION    NAMESR(2)
  27       DATA  NAMESR / 4HZVER, 4HFY   /
  28 #endif
  29 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  30       DATA  NAMESR / 6HZVERIF /
  31 #endif
  32 #if !defined(CERNLIB_QTRHOLL)
  33       CHARACTER    NAMESR*8
  34       PARAMETER   (NAMESR = 'ZVERIF  ')
  35 #endif
  36
  37 #include "zebra/q_jbit.inc"
  38
  39 #include "zebra/qtraceq.inc"
  40
  41       TEXTHD = TEXTID
  42       CHWARN = ' !!!!     '
  43       CALL VZERO (IFLHD,8)
  44       JVMODE = -1
  45
  46 C--                Check the process parameters
  47
  48       CALL ZVDO1
  49
  50 C----              Select the store to be verified
  51
  52       IXVSTO = IXSTP
  53       IF (IXVSTO.LT.0)             GO TO 12
  54       NLOOP  = 0
  55       CALL MZSDIV (IXVSTO,0)
  56       JDVINI = JQDIVI
  57       JST    = JQSTOR
  58       GO TO 19
  59
  60    12 NLOOP  = 7
  61       JDVINI = 0
  62       JST    = 0
  63       IF (IXVSTO.EQ.-1)            GO TO 19
  64
  65       IF (IXVSTO.NE.-2)    CALL ZFATAM ('not a valid store index.')
  66
  67       NLOOP = -7
  68       JST   = -1
  69       GO TO 17
  70
  71    16 IF (NLOOP.EQ.0)              GO TO 71
  72       JST = JQSTOR
  73    17 JST = JST + 1
  74       IF (JST.GT.NQSTOR)           GO TO 71
  75       IF (NLOOP.GE.0)              GO TO 19
  76       IF (JBIT(MASKST,JST+1).EQ.0) GO TO 17
  77
  78    19 IXVSTO = 0
  79       CALL SBYT (JST,IXVSTO,27,4)
  80       IF (NQALLO(JST+1).LT.0)      GO TO 16
  81
  82 C------            Do the next store
  83
  84       CALL MZSDIV (IXVSTO,-1)
  85
  86       CALL VZERO (JVMODE,7)
  87       IF (NQLOGL.GE.2)  CALL ZVFPRI
  88
  89 C--                Check the store parameters
  90
  91       CALL ZVDO2
  92
  93       LSTOLO = LQSTA(KQT+1)
  94       LSTOHI = LQEND(KQT+20)
  95
  96 C--                If check of single division
  97
  98       JQDIVI = JDVINI
  99       IF (JDVINI.NE.0)             GO TO 22
 100
 101 C----              Check all link areas
 102
 103       JVMODE = 1
 104       L = LQSYSS(KQT+1)
 105       IF (L.NE.0)  THEN
 106           IQ(KQS+L+3) = IQ(KQS+L+2) + NQLINK
 107           CALL ZVDOLA (IQ(KQS+L+1))
 108         ENDIF
 109
 110 C------            Check all divisions
 111
 112       JQDIVI = 0
 113    21 IF (JQDIVI.EQ.20)            GO TO 16
 114       IF (JDVINI.NE.0)             GO TO 71
 115       IF (JQDIVI.EQ.JQDVLL)  THEN
 116           JQDIVI = JQDVSY
 117         ELSE
 118           JQDIVI = JQDIVI + 1
 119         ENDIF
 120
 121 C----              Do next division
 122
 123    22 JVMODE = 2
 124       LDIVLO = LQSTA(KQT+JQDIVI)
 125       LDIVHI = LQEND(KQT+JQDIVI)
 126       MASKTO = IQRCU(KQT+JQDIVI)
 127       IF (LDIVLO.GE.LDIVHI)        GO TO 21
 128
 129       NAMEPR(1) = IQDN1(KQT+JQDIVI)
 130       NAMEPR(2) = IQDN2(KQT+JQDIVI)
 131       IFLDV = 0
 132       LBKNX = LDIVLO
 133       IFLBK = 7
 134
 135 C--                Next bank
 136
 137    24 IF (LBKNX.GE.LDIVHI)         GO TO 21
 138
 139       CALL MZCHLN (-7,LBKNX)
 140       IF (IQFOUL.NE.0)             GO TO 41
 141
 142       LBKNX = IQNX
 143       IF (IQND.LT.0)               GO TO 24
 144
 145       LBKLN = IQLN
 146       LBKLS = IQLS
 147       IBKXX = JBIT(IQ(KQS+LBKLS),IQDROP)
 148       IDBK(1)  = IQ(KQS+IQLS-4)
 149       IDBK(2)  = IQ(KQS+IQLS-5)
 150       NBKNN(1) = IQNIO
 151       NBKNN(2) = IQNL
 152       NBKNN(3) = IQNS
 153       NBKNN(4) = IQND
 154
 155       IFLBK = 0
 156       CALL ZVDOBK
 157       IF (LBKNX.LE.LDIVHI)         GO TO 24
 158
 159       NFATAL = NFATAL + 1
 160       CALL ZVFPRI
 161       N = LDIVHI - LBKNX
 162       WRITE (IQLOG,9027) CHWARN,N
 163  9027 FORMAT (A,'Bank overshoots the division end by',I7,' words')
 164       GO TO 21
 165
 166 C----     bank chaining clobbered
 167
 168    41 NFATAL = NFATAL + 1
 169       CALL ZVFPRI
 170       WRITE (IQLOG,9041) CHWARN,LBKNX
 171  9041 FORMAT (A,'Bank chaining clobbered at adr',I10)
 172
 173       L = LBKNX
 174    44 L = L + 1
 175       IF (L.GE.LDIVHI)             GO TO 47
 176
 177       CALL MZCHLN (-7,L)
 178       IF (IQFOUL.NE.0)             GO TO 44
 179       LR = L
 180
 181    46 CALL MZCHLN (-7,IQNX)
 182       IF (IQFOUL.NE.0)             GO TO 44
 183       IF (IQND.LT.0)               GO TO 46
 184       L = LR
 185
 186    47 WRITE (IQLOG,9047) L
 187  9047 FORMAT (10X,'recover at adr',I10)
 188
 189       LBKNX = L
 190       GO TO 24
 191
 192 C------            Finished
 193
 194    71 IQUEST(1) = NFATAL
 195       IF (NFATAL+NWARN.EQ.0)       GO TO 999
 196
 197       WRITE (IQLOG,9071) CHWARN, NFATAL,NWARN
 198  9071 FORMAT (A,'ZVERIF found',I5,' fatal and',I5,' warning conditions')
 199
 200       IF (NFATAL.EQ.0)             GO TO 999
 201       IF (JDVINI.NE.0)  THEN
 202           IF (IFRETN.NE.0)         GO TO 999
 203         ENDIF
 204
 205       CALL SBYT (LFAILS,IXVSTO,27,4)
 206       CALL MZSDIV (IXVSTO,-1)
 207       JQDIVI = LFAILD
 208       IQVSTA = 0
 209       CALL ZFATAM ('trouble in ZVERIF.')
 210 #include "zebra/qtrace99.inc"
 211       RETURN
 212       END
 213 *      ==================================================
 214 #include "zebra/qcardl.inc"