MINICERN/packlib/zebra/dzebra/dzchbk.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:06  mclareni
   6 * Zebra
   7 *
   8 *
   9 *-----------------------------------------------------------
  10 #include "zebra/pilot.h"
  11 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  12 #include "zebra/debugvf1.inc"
  13 #endif
  14       SUBROUTINE DZCHBK (CHTEXT,IXDIV,LBANK,CHOPT,ISUM)
  15       SAVE CHPART
  16 #include "zebra/mqsys.inc"
  17 #include "zebra/mzcn.inc"
  18 #include "zebra/zbcdch.inc"
  19 #include "zebra/zbcdk.inc"
  20 #include "zebra/zunit.inc"
  21 #include "zebra/dzc1.inc"
  22       CHARACTER *(*) CHOPT,CHTEXT,CHPART(4)*6
  23       PARAMETER ( NLSUMQ = 8 )
  24       INTEGER ISUM(*),ISMOLD(NLSUMQ)
  25 #include "zebra/bankparq.inc"
  26 #include "zebra/storparq.inc"
  27       PARAMETER ( MDATAQ = 1 )
  28       PARAMETER ( MLINKQ = 3 )
  29       PARAMETER ( MSYSTQ = 5 )
  30       PARAMETER ( MBANKQ = 7 )
  31
  32       CHARACTER CHROUT*(*)
  33       PARAMETER (CHROUT = 'DZCHBK')
  34
  35       DATA CHPART /'DATA','LINK','SYSTEM','GLOBAL'/
  36 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  37 #include "zebra/debugvf2.inc"
  38 #endif
  39
  40       CQSTAK = CHROUT//'/'
  41       IQUEST(1) = 0
  42
  43       CALL DZOPT(CHOPT)
  44
  45       IOPTV  = IFLOPT(MPOSVQ)
  46
  47       CALL MZSDIV(IXDIV,-1)
  48       CALL MZCHLS(-7,LBANK)
  49
  50       IF (IOPTV.NE.0)  THEN
  51           DO 100 I=1,NLSUMQ
  52   100     ISMOLD(I) = ISUM(I)
  53       ENDIF
  54
  55       CALL DZCHV1 (LBANK+1+NOFLIQ+KQS,LBANK+IQND+NOFLIQ+KQS,0,
  56      X             ISUM(MDATAQ)                    )
  57       IF (IQUEST(1).NE.0)                                  GO TO 999
  58       CALL DZCHV1 (LBANK-IQNL+KQS,LBANK-1+KQS,0,ISUM(MLINKQ))
  59       IF (IQUEST(1).NE.0)                                  GO TO 999
  60       CALL DZCHV1 (LBANK+KQS,LBANK+NOFLIQ+KQS,0,ISUM(MSYSTQ))
  61       IF (IQUEST(1).NE.0)                                  GO TO 999
  62       CALL DZCHV1 (LBANK-IQNL-NBKHDQ+KQS,LBANK+IQND+NOFLIQ+KQS,0,
  63      X             ISUM(MBANKQ)                    )
  64       IF (IQUEST(1).NE.0)                                  GO TO 999
  65
  66       IF (IOPTV.NE.0) THEN
  67           DO 200 I=1,NLSUMQ/2
  68               II = (I-1)*2 + 1
  69               IF (     (ISUM(II)  .NE.ISMOLD(II)  )
  70      I            .OR. (ISUM(II+1).NE.ISMOLD(II+1)) ) THEN
  71                   IQUEST(10+I) = 1
  72                   IQUEST(1)    = 1
  73               ELSE
  74                   IQUEST(10+I) = 0
  75               ENDIF
  76   200     CONTINUE
  77       ENDIF
  78
  79       IF (CHTEXT.NE.CDUMMQ)     THEN
  80           CQMAP(1)        = ' '
  81           CQMAP(2)(1:10)  = ' * '//CHROUT//' '
  82           CQMAP(2)(11:29) = CHTEXT
  83           CQMAP(2)(30:41) = ' / OPTION : '
  84           CQMAP(2)(42:47) = CHOPT
  85           DO 300 I=1,NLSUMQ/2
  86               II = (I-1)*2 + 1
  87               IF (IOPTV.NE.0)   THEN
  88                   IF (IQUEST(10+I).NE.0)   THEN
  89                       CQMAP(2)(118:130) = '??PROBLEMS? '
  90                   ELSE
  91                       CQMAP(2)(118:130) = '   OK'
  92                   ENDIF
  93                   WRITE(CQMAP(2)(48:117),
  94      W             '(''OLD='',Z4,1X,Z16,4X,''NEW='',Z4,1X,Z16,T63,A)')
  95      W             ISMOLD(II+1),ISMOLD(II),ISUM(II+1),ISUM(II),CHPART(I)
  96               ELSE
  97
  98                   WRITE(CQMAP(2)(48:),'(''NEW='',Z4,1X,Z16,T63,A)')
  99      W             ISUM(II+1),ISUM(II),CHPART(I)
 100               ENDIF
 101               CALL DZTEXT(0,CDUMMQ,2)
 102               CQMAP(2) = ' '
 103   300     CONTINUE
 104       ENDIF
 105
 106   999 RETURN
 107       END