MINICERN/packlib/zebra/dzebra/dzchst.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:06  mclareni
   6 * Extend the include file cleanup to dzebra, rz and tq, and also add
   7 * dependencies in some cases.
   8 *
   9 * Revision 1.1.1.1  1996/03/06 10:47:06  mclareni
  10 * Zebra
  11 *
  12 *
  13 *-----------------------------------------------------------
  14 #include "zebra/pilot.h"
  15 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  16 #include "zebra/debugvf1.inc"
  17 #endif
  18       SUBROUTINE DZCHST (CHTEXT,IXDIV,LBANK,CHOPT,ISUM)
  19       SAVE CHPART
  20 #include "zebra/bankparq.inc"
  21 #include "zebra/questparq.inc"
  22 #include "zebra/storparq.inc"
  23 #include "zebra/mqsys.inc"
  24 #include "zebra/qequ.inc"
  25 #include "zebra/mzcn.inc"
  26 #include "zebra/zbcdch.inc"
  27 #include "zebra/zbcdk.inc"
  28 #include "zebra/zunit.inc"
  29 #include "zebra/dzc1.inc"
  30       CHARACTER *(*) CHOPT,CHTEXT,CHPART(3)*6
  31
  32       CHARACTER CHROUT*(*)
  33       PARAMETER (CHROUT = 'DZCHST')
  34
  35       PARAMETER ( NPDENQ =  3 )
  36       PARAMETER ( MPDCUQ =  1 )
  37       PARAMETER ( MPDNCQ =  2 )
  38       PARAMETER ( MPDNSQ =  3 )
  39
  40 *       32 BIT MACHINES
  41 #if defined(CERNLIB_B32)
  42       PARAMETER ( NBITS  =  8 )
  43 *       36 BIT MACHINE
  44 #endif
  45 #if defined(CERNLIB_B36)
  46       PARAMETER ( NBITS  =  9 )
  47 *       60 BIT MACHINE
  48 #endif
  49 #if defined(CERNLIB_B60)
  50       PARAMETER ( NBITS  = 15 )
  51 *       64 BIT MACHINE
  52 #endif
  53 #if defined(CERNLIB_B64)
  54       PARAMETER ( NBITS  = 16 )
  55 #endif
  56
  57       PARAMETER ( NLSUMQ = 6 )
  58       INTEGER ISUM(*),ISMOLD(NLSUMQ)
  59
  60       DATA CHPART /'DATA','LINK','SYSTEM'/
  61
  62 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  63 #include "zebra/debugvf2.inc"
  64 #endif
  65
  66       CQSTAK = CHROUT//'/'
  67       IQUEST(1) = 0
  68
  69       CALL DZOPT(CHOPT)
  70
  71       IF (IFLOPT(MPOSVQ).NE.0)  THEN
  72           DO 10 I=1,NLSUMQ
  73   10      ISMOLD(I) = ISUM(I)
  74       ENDIF
  75
  76       CALL MZSDIV(IXDIV,-1)
  77
  78
  79       LWORK  = NQOFFS(1) + LQEND(1)  - NPDENQ - 1
  80       LWORKE = NQOFFS(1) + LQSTA(2)  - NPDENQ
  81
  82
  83       LCUR   = LBANK
  84       LEVEL  = 0
  85
  86
  87       MAXALL = 0
  88       NTBANK = 0
  89       DO 20 I=1,NDVMXQ
  90           IF(I.LE.JQDVLL.OR.I.GE.JQDVSY)
  91      I    MAXALL = MAXALL + LQEND(KQT+I) - LQSTA(KQT+I)
  92    20 CONTINUE
  93
  94
  95
  96       CALL VZERO(IQUEST(71),12)
  97
  98
  99   100 CALL MZCHLS (NCHEKQ,LCUR)
 100       IF (IQFOUL.NE.0) THEN
 101           CALL DZBKDV(LCUR)
 102           IF (IQUEST(1).NE.0)                              GO TO 999
 103           WRITE(CQINFO,'(A,''/'',I8)') CQDIV,LCUR
 104           CALL DZTEXT(MSHP1Q,CDUMMQ,0)
 105           IQUEST(1) = 1
 106                                                            GO TO 999
 107       ENDIF
 108
 109       CALL DZCHV1 (LCUR+1+NOFLIQ+KQS,LCUR+IQND+NOFLIQ+KQS,70,0)
 110       IF (IQUEST(1).NE.0)                                  GO TO 999
 111       CALL DZCHV1 (LCUR-IQNL+KQS,LCUR+2+KQS,74,0)
 112       IF (IQUEST(1).NE.0)                                  GO TO 999
 113       CALL DZCHV1 (LCUR+3+KQS,LCUR+NOFLIQ+KQS,78,0)
 114       IF (IQUEST(1).NE.0)                                  GO TO 999
 115       CALL DZCHV1 (LCUR-IQNL-1+KQS,LCUR-IQNL-1+KQS,78,0)
 116       IF (IQUEST(1).NE.0)                                  GO TO 999
 117
 118       NTBANK = NTBANK + NL + ND + NBKOHQ
 119       IF (NTBANK.GE.MAXALL) THEN
 120           WRITE(CQINFO,'(I10,''/'',I10)') MAXALL,NTBANK
 121           CALL DZTEXT(MSHO1Q,CDUMMQ,0)
 122           IQUEST(1) = 1
 123                                                            GO TO 999
 124       ENDIF
 125
 126
 127       LEVEL  = LEVEL+1
 128       LWORK  = LWORK + NPDENQ
 129       IF (LWORK.GE.LWORKE)             THEN
 130           WRITE(CQINFO,'(I10)') LEVEL
 131           CALL DZTEXT(MSHO2Q,CDUMMQ,0)
 132           IQUEST(1) = 1
 133                                                            GO TO 999
 134       ENDIF
 135
 136
 137       IF (IFLOPT(MPOSDQ).EQ.0)   IQNS = 0
 138
 139       LQ(LWORK+MPDCUQ) = LCUR
 140       LQ(LWORK+MPDNCQ) = IQNS
 141       LQ(LWORK+MPDNSQ) = IQNS
 142
 143
 144   200 IF (LQ(LWORK+MPDNCQ).LE.0)  THEN
 145           IF (LEVEL.GT.1.OR.IFLOPT(MPOSLQ).NE.0) THEN
 146               LCUR = LQ(KQS + LQ(LWORK+MPDCUQ))
 147               LEVEL  = LEVEL - 1
 148               LWORK  = LWORK - NPDENQ
 149               IF (LCUR.NE.LNULL)  THEN
 150                                                            GO TO 100
 151               ELSE
 152                   IF (LEVEL.GT.0) THEN
 153                                                            GO TO 200
 154                   ELSE
 155                                                            GO TO 300
 156                   ENDIF
 157               ENDIF
 158           ELSE
 159               LEVEL = LEVEL-1
 160               LWORK  = LWORK - NPDENQ
 161               IF (LEVEL.GT.0) THEN
 162                                                            GO TO 200
 163               ELSE
 164                                                            GO TO 300
 165               ENDIF
 166           ENDIF
 167       ENDIF
 168
 169
 170       LQ(LWORK+MPDNCQ) = LQ(LWORK+MPDNCQ) - 1
 171       LCUR = LQ(KQS+LQ(LWORK+MPDCUQ)
 172      X             -LQ(LWORK+MPDNSQ)+LQ(LWORK+MPDNCQ))
 173
 174       IF (LCUR.EQ.LNULL)                                   GO TO 200
 175                                                            GO TO 100
 176
 177
 178
 179   300 DO 320 I=1,NLSUMQ/2
 180           II = (I-1)*2
 181
 182           JCARRY = 0
 183           IBIT   = 1
 184           DO 310 JF=70+I*4-3,70+I*4
 185               IQUEST (JF) = IQUEST(JF) + JCARRY
 186               JCARRY = IQUEST(JF)/2**NBITS
 187               IQUEST (JF) = IQUEST(JF) - JCARRY*(2**NBITS)
 188               CALL SBYT(IQUEST(JF),ISUM(II+1),IBIT,NBITS)
 189   310     IBIT   = IBIT + NBITS
 190           ISUM(II+2) = JCARRY
 191   320 CONTINUE
 192
 193       IF (IFLOPT(MPOSVQ).NE.0) THEN
 194           DO 400 I=1,NLSUMQ/2
 195               II = (I-1)*2 + 1
 196               IF (     (ISUM(II)  .NE.ISMOLD(II)  )
 197      I            .OR. (ISUM(II+1).NE.ISMOLD(II+1)) ) THEN
 198                   IQUEST(10+I) = 1
 199                   IQUEST(1)    = 1
 200               ELSE
 201                   IQUEST(10+I) = 0
 202               ENDIF
 203   400     CONTINUE
 204       ENDIF
 205
 206       IF (CHTEXT.NE.CDUMMQ)     THEN
 207           CQMAP(1)        = ' '
 208           CQMAP(2)(1:10)  = ' * '//CHROUT//' '
 209           CQMAP(2)(11:29) = CHTEXT
 210           CQMAP(2)(30:41) = ' / OPTION : '
 211           CQMAP(2)(42:47) = CHOPT
 212           DO 500 I=1,NLSUMQ/2
 213               II = (I-1)*2 + 1
 214               IF (IFLOPT(MPOSVQ).NE.0) THEN
 215                   IF (IQUEST(10+I).NE.0)   THEN
 216                       CQMAP(2)(118:130) = '??PROBLEMS? '
 217                   ELSE
 218                       CQMAP(2)(118:130) = '   OK'
 219                   ENDIF
 220                   WRITE(CQMAP(2)(48:117),
 221      W             '(''OLD='',Z4,1X,Z16,4X,''NEW='',Z4,1X,Z16,T63,A)')
 222      W             ISMOLD(II+1),ISMOLD(II),ISUM(II+1),ISUM(II),CHPART(I)
 223               ELSE
 224
 225                   WRITE(CQMAP(2)(48:),'(''NEW='',Z4,1X,Z16,T63,A)')
 226      W             ISUM(II+1),ISUM(II),CHPART(I)
 227               ENDIF
 228               CALL DZTEXT(0,CDUMMQ,2)
 229               CQMAP(2) = ' '
 230   500     CONTINUE
 231       ENDIF
 232
 233   999 RETURN
 234       END