MINICERN/packlib/zebra/mqv/zvdola.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:13:26  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:13  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE ZVDOLA (MDESV)
  14
  15 C-    Subsidiary to ZVERIF, check all link areas
  16
  17 #include "zebra/zstate.inc"
  18 #include "zebra/zunit.inc"
  19 #include "zebra/mqsys.inc"
  20 #include "zebra/mzcn.inc"
  21 #include "zebra/zvfwkc.inc"
  22 C--------------    End CDE                             --------------
  23       DIMENSION    MDESV(99)
  24
  25 #include "zebra/q_jbit.inc"
  26 #include "zebra/q_jbyt.inc"
  27
  28
  29       JDESMX = MDESV(1) - 4
  30       JDESLA = -4
  31       IF (MDESV(2).GE.MDESV(3))   JDESLA =1
  32
  33 C------            Next link area
  34
  35    17 JDESLA = JDESLA + 5
  36       IF (JDESLA.GE.JDESMX)        RETURN
  37       IF (JDESLA.EQ.6)             GO TO 17
  38       LOCAR  = MDESV(JDESLA+1)
  39       LOCARE = MDESV(JDESLA+2)
  40       MODAR  = MDESV(JDESLA+3)
  41       LATMP  = JBIT(MODAR,31)
  42       LOCARR = LOCAR + JBYT (MODAR,1,15)
  43       NAMEPR(1) = MDESV(JDESLA+4)
  44       NAMEPR(2) = MDESV(JDESLA+5)
  45
  46       IFLLA = 0
  47 #if defined(CERNLIB_QDEVZE)
  48       IF (NQDEVZ.GE.11)  THEN
  49           CALL ZVFPRI
  50           WRITE (IQLOG,9818) JDESLA,LOCAR,LOCARR,LOCARE,LATMP
  51         ENDIF
  52  9818 FORMAT (10X,'Area at',I5,' LA,LR,LE,temp=',3I10,I2)
  53 #endif
  54       LIX = LOCAR
  55       IF (LATMP.EQ.0)              GO TO 21
  56
  57 C--       temporary link area
  58
  59       LIX = LIX + 2
  60       JDMUST = LQ(KQS+LOCAR+1)
  61       IF (JDMUST.EQ.JDESLA)        GO TO 18
  62       NFATAL = NFATAL + 1
  63       CALL ZVFPRI
  64       WRITE (IQLOG,9018) CHWARN,JDMUST,JDESLA
  65  9018 FORMAT (A,'Word 2 destroyed, is= ',Z8,'x, should be= ',Z8)
  66
  67    18 IF (LQ(KQS+LOCAR).EQ.0)         GO TO 17
  68
  69 C----              Check all links
  70
  71    21 LIX  = LIX - 1
  72       JLNK = 0
  73
  74 C--                Next link
  75
  76    22 LIX = LIX + 1
  77       IF (LIX.EQ.LOCARE)           GO TO 17
  78       JLNK = JLNK + 1
  79       LINK = LQ(KQS+LIX)
  80       IF (LINK.EQ.0)               GO TO 22
  81 #if defined(CERNLIB_QDEVZE)
  82       IF (NQDEVZ.GE.11)  WRITE (IQLOG,9823) LINK,LIX
  83  9823 FORMAT (16X,'Link =',I9,' from LIX =',I9)
  84 #endif
  85       IF (LINK.LT.LSTOLO)          GO TO 37
  86       IF (LINK.GE.LSTOHI)          GO TO 37
  87
  88       JDV = MZFDIV (-7,LINK)
  89       IF (JDV.EQ.0)                GO TO 31
  90       IF (LIX.GE.LOCARR)           GO TO 22
  91
  92 C--                Check structural link
  93
  94       CALL MZCHLS (-7,LINK)
  95       IF (IQFOUL.EQ.0)             GO TO 22
  96
  97       NFATAL = NFATAL + 1
  98       CALL ZVFPRI
  99       WRITE (IQLOG,9027) CHWARN,JLNK,LINK
 100  9027 FORMAT (A,'Structural link number',I6,' of value',I10,
 101      F' does not point to a bank')
 102       GO TO 22
 103
 104 C--                Link points into a reserve area
 105
 106    31 NFATAL = NFATAL + 1
 107       CALL ZVFPRI
 108       WRITE (IQLOG,9031) CHWARN,JLNK,LINK
 109  9031 FORMAT (A,'Link number',I6,' of value',I10,
 110      F' does not point into a division')
 111       GO TO 22
 112
 113 C--                Link points outside the bank region
 114
 115    37 IF (NQOPTS(1).GE.2)          GO TO 22
 116       CALL ZVFPRI
 117       WRITE (IQLOG,9037) CHWARN,JLNK,LINK
 118  9037 FORMAT (A,'Link number',I6,' of value',I10,
 119      F' does not point into the bank region')
 120
 121       IF (NQOPTS(1).EQ.0)  THEN
 122           NFATAL = NFATAL + 1
 123         ELSE
 124           NWARN = NWARN + 1
 125         ENDIF
 126       GO TO 22
 127       END
 128 *      ==================================================
 129 #include "zebra/qcardl.inc"