MINICERN/packlib/zebra/dzebra/dzchvc.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:07  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 DZCHVC (CHTEXT,IXSTOR,LBEGIN,LEND,CHOPT,ISUM)
  19 #include "zebra/mqsys.inc"
  20 #include "zebra/zbcdch.inc"
  21 #include "zebra/zbcdk.inc"
  22 #include "zebra/zunit.inc"
  23 #include "zebra/dzc1.inc"
  24 #include "zebra/storparq.inc"
  25       CHARACTER *(*) CHOPT,CHTEXT
  26       PARAMETER ( NLSUMQ = 2 )
  27       INTEGER ISUM(*),ISMOLD(NLSUMQ)
  28
  29       CHARACTER CHROUT*(*)
  30       PARAMETER (CHROUT = 'DZCHVC')
  31
  32 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  33 #include "zebra/debugvf2.inc"
  34 #endif
  35
  36       CQSTAK = CHROUT//'/'
  37       IQUEST(1) = 0
  38
  39       CALL DZOPT(CHOPT)
  40
  41       CALL MZSDIV(IXSTOR,-1)
  42
  43       IF (IFLOPT(MPOSVQ).NE.0)   THEN
  44           ISMOLD(1) = ISUM(1)
  45           ISMOLD(2) = ISUM(2)
  46       ENDIF
  47
  48
  49       CALL DZCHV1(LBEGIN+KQS,LEND+KQS,0,ISUM)
  50       IF(IQUEST(1).NE.0)                                   GO TO 999
  51
  52
  53       IF (IFLOPT(MPOSVQ).NE.0)                               THEN
  54           IF ((ISUM(1).NE.ISMOLD(1)).OR.(ISUM(2).NE.ISMOLD(2)))  THEN
  55               IQUEST(1) = 1
  56           ENDIF
  57       ENDIF
  58
  59       IF (CHTEXT.NE.CDUMMQ)     THEN
  60           CQMAP(1)        = ' '
  61           CQMAP(2)(1:10)  = ' * '//CHROUT//' '
  62           CQMAP(2)(11:29) = CHTEXT
  63           CQMAP(2)(30:41) = ' / OPTION : '
  64           CQMAP(2)(42:47) = CHOPT
  65           IF (IFLOPT(MPOSVQ).NE.0)   THEN
  66               IF (IQUEST(1).NE.0)   THEN
  67                   CQMAP(2)(118:130) = '??PROBLEMS? '
  68               ELSE
  69                   CQMAP(2)(118:130) = '   OK'
  70               ENDIF
  71               WRITE(CQMAP(2)(48:117),
  72      W         '(''OLD='',Z4,1X,Z16,4X,''NEW='',Z4,1X,Z16)')
  73      W         ISMOLD(2),ISMOLD(1),ISUM(2),ISUM(1)
  74           ELSE
  75               WRITE(CQLINE(48:),'(''NEW='',Z4,1X,Z16)') ISUM(2),ISUM(1)
  76           ENDIF
  77           CALL DZTEXT(0,CDUMMQ,2)
  78           CQMAP(2) = ' '
  79       ENDIF
  80
  81   999 RETURN
  82       END