MINICERN/packlib/zebra/dzebra/dzsnap.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:15  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:07  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 DZSNAP (CHTEXT,IXDIV,CHOPT)
  19 #include "zebra/mqsys.inc"
  20 #include "zebra/qequ.inc"
  21 #include "zebra/mzcn.inc"
  22 #include "zebra/zbcdch.inc"
  23 #include "zebra/zbcdk.inc"
  24 #include "zebra/zmach.inc"
  25 #include "zebra/zstate.inc"
  26 #include "zebra/zunit.inc"
  27 #include "zebra/dzc1.inc"
  28 #include "zebra/bankparq.inc"
  29 #include "zebra/divparq.inc"
  30 #include "zebra/questparq.inc"
  31 #include "zebra/storparq.inc"
  32       CHARACTER *(*) CHTEXT,CHOPT
  33
  34       CHARACTER CHROUT*(*)
  35       PARAMETER (CHROUT = 'DZSNAP')
  36
  37 #include "zebra/q_jbit.inc"
  38 #include "zebra/q_jbyt.inc"
  39
  40 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  41 #include "zebra/debugvf2.inc"
  42 #endif
  43
  44       CQSTAK = CHROUT//'/'
  45       IQUEST(1) = 0
  46       IF (CHTEXT.NE.CDUMMQ)                                THEN
  47           CQMAP(1)          = ' '
  48           CQMAP(2)(1:12)    = ' DZSNAP --- '
  49           CQMAP(2)(13:100)  = CHTEXT
  50           CQMAP(2)(101:110) = 'OPTIONS : '
  51           CQMAP(2)(111:130) = CHOPT
  52           CALL DZTEXT(0,CDUMMQ,2)
  53       ENDIF
  54
  55       CALL DZOPT(CHOPT)
  56
  57
  58       CALL MZSDIV(IXDIV,0)
  59
  60       CQMAP(1) = ' '
  61       CQMAP(2) = '   NAME       LQSTOR NQSTRU  NQREF NQLINK '//
  62      X           'LQMINR LQ2END JQDVLL JQDVSY NQFEND  LOW-1  LOW-N '//
  63      X           'HIGH-1 HIGH-N SYST-1 SYST-N    END'
  64 #if defined(CERNLIB_OCTMAP)
  65       WRITE(CQMAP(3),'(2X,2A4,''('',O8,'')'',15I7)')
  66 #endif
  67 #if !defined(CERNLIB_OCTMAP)
  68       WRITE(CQMAP(3),'(2X,2A4,''('',Z8,'')'',15I7)')
  69 #endif
  70      W  NQSNAM(1)     , NQSNAM(2) ,
  71 *  Map  addresses expressed in machine words
  72 #if defined(CERNLIB_WORDMAP)
  73      W  LQSTOR+1 ,
  74 *  Map addresses expressed in bytes
  75 #endif
  76 #if !defined(CERNLIB_WORDMAP)
  77      W  (LQSTOR+1)*4 ,
  78 #endif
  79      W  NQSTRU , NQREF    , NQLINK , NQMINR        ,
  80      W  LQ2END , JQDVLL   , JQDVSY , NQFEND        ,
  81      W  LQSTA (KQT+MDVLWQ),LQEND (KQT+MDVLWQ)-1    ,
  82      W  LQSTA (KQT+MDVHGQ),LQEND (KQT+MDVHGQ)-1    ,
  83      W  LQSTA (KQT+JQDVSY),LQEND (KQT+JQDVSY)-1    ,
  84      W  LQSTA (KQT+NDVMXQ+1)-1
  85
  86       CALL DZTEXT(0,CDUMMQ,3)
  87
  88
  89
  90       DO 100 IFENCE=-NQFEND+1,0
  91           IF(LQ(KQS+IFENCE).NE.IQNIL)      THEN
  92               WRITE (CQINFO,'(I5,1X,Z16)') IFENCE,LQ(KQS+IFENCE)
  93               CALL DZTEXT(MSNA1Q,CDUMMQ,0)
  94               IF (IFLOPT(MPOSSQ).NE.0)                     GO TO 998
  95           ENDIF
  96   100 CONTINUE
  97
  98
  99       IF ((LQ(KQS+LQSTA(KQT+21)+1).NE.IQNIL) .OR.
 100      X    (LQ(KQS+LQSTA(KQT+21)+2).NE.IQNIL)      ) THEN
 101           WRITE (CQINFO,'(Z16,1X,Z16)')
 102      X    LQ(KQS+LQSTA(KQT+21)+1),LQ(KQS+LQSTA(KQT+21)+2)
 103           CALL DZTEXT(MSNA2Q,CDUMMQ,0)
 104           IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
 105       ENDIF
 106
 107       IF(NQSTRU.GT.NQREF)              THEN
 108           WRITE (CQINFO,'(I8,''>'',I8)') NQSTRU,NQREF
 109           CALL DZTEXT(MSNA3Q,CDUMMQ,0)
 110           IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
 111       ENDIF
 112
 113       IF(NQREF.GT.NQLINK)              THEN
 114           WRITE (CQINFO,'(I8,''>'',I8)') NQREF,NQLINK
 115           CALL DZTEXT(MSNA4Q,CDUMMQ,0)
 116           IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
 117       ENDIF
 118
 119       IF(LQSTA(KQT+2)-LQEND(KQT+1).LT.NQMINR)      THEN
 120           WRITE (CQINFO,'(I8,''-'',I8,''<'',I8)')
 121      X     LQSTA(KQT+2),LQEND(KQT+1),NQMINR
 122           CALL DZTEXT(MSNA5Q,CDUMMQ,0)
 123           IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
 124       ENDIF
 125
 126       IF(NQMINR.GT.LQ2END)             THEN
 127           WRITE (CQINFO,'(I8,''>'',I8)') NQMINR,LQ2END
 128           CALL DZTEXT(MSNA6Q,CDUMMQ,0)
 129           IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
 130       ENDIF
 131
 132       IF(LQ2END.GT.LQSTA(KQT+21))      THEN
 133           WRITE (CQINFO,'(I8,''>'',I8)') LQ2END,LQSTA(KQT+21)
 134           CALL DZTEXT(MSNA7Q,CDUMMQ,0)
 135           IF (IFLOPT(MPOSSQ).NE.0)                         GO TO 998
 136       ENDIF
 137
 138
 139       IF (IFLOPT(MPOSTQ).NE.0)         THEN
 140           IFLOPT(MPOSCQ) = 1
 141           CALL UCOPY(IFLOPT,IQUEST(71),26)
 142           CALL VZERO(IFLOPT,26)
 143           IFLOPT(MPOSNQ) = 1
 144           IFLOPT(MPOSQQ) = 1
 145           IFLOPT(MPOSTQ) = 1
 146           CALL DZARE1('DZSNAP  L option',' ',0,'NQT')
 147           CALL UCOPY(IQUEST(71),IFLOPT,26)
 148       ENDIF
 149       IF (IFLOPT(MPOSLQ).NE.0) THEN
 150           CALL UCOPY(IFLOPT,IQUEST(71),26)
 151           CALL VZERO(IFLOPT,26)
 152           IFLOPT(MPOSNQ) = 1
 153           CALL DZARE1('DZSNAP  L option',' ',0,'N')
 154           CALL UCOPY(IQUEST(71),IFLOPT,26)
 155       ENDIF
 156       IF (IFLOPT(MPOSWQ).NE.0)               THEN
 157           CQMAP(1) = ' '
 158 #if !defined(CERNLIB_OCTMAP)
 159           WRITE(CQMAP(2),'(''  WORKING SPACE   ADR(LQ(0)) = '',Z8)')
 160 #endif
 161 #if defined(CERNLIB_OCTMAP)
 162           WRITE(CQMAP(2),'(''  WORKING SPACE   ADR(LQ(0)) = '',O8)')
 163 *  Map  addresses expressed in machine words
 164 #endif
 165 #if defined(CERNLIB_WORDMAP)
 166      W      LQSTOR+1
 167 *  Map addresses expressed in bytes
 168 #endif
 169 #if !defined(CERNLIB_WORDMAP)
 170      W      (LQSTOR+1)*4
 171 #endif
 172           CALL DZTEXT(0,CDUMMQ,2)
 173           LBASE  = 0
 174           IBASE  = 0
 175           JDFD   = NQLINK + 1
 176           NDW    = LQSTA(KQT+1) - 1
 177           IF (IFLOPT(MPOSTQ).NE.0) THEN
 178               NDW = MIN(NDW,NQWCUT+NQLINK)
 179           ELSE
 180               NDW = MIN(NDW,NQLINK)
 181           ENDIF
 182           CALL DZDATA(CDUMMQ)
 183       ENDIF
 184
 185
 186       IF (JBYT(IXDIV,1,JSTIDQ-1).EQ.0)  THEN
 187           JJDIV = MZIXCO(IXDIV+21,IXDIV+22,0,0)
 188           JJDIV = MZDVAC(JJDIV)
 189       ELSE
 190           JJDIV  = MZDVAC (IXDIV)
 191       ENDIF
 192
 193       IF (IFLOPT(MPOSEQ)+IFLOPT(MPOSFQ)+IFLOPT(MPOSMQ).EQ.0) GO TO 999
 194
 195
 196
 197       NDZRSV = 0
 198       CALL DZBKUP(0)
 199       IF (IQUEST(1).NE.0)                                  GO TO 999
 200
 201       DO 1000 JDIVI = 1,NDVMXQ
 202           IF ( JDIVI.GT.JQDVLL.AND.JDIVI.LT.JQDVSY)        GO TO 1000
 203           IF (JBIT(JJDIV,JDIVI).EQ.0)                      GO TO 1000
 204           WRITE(CQMAP,'(1X,/,
 205      W       '' DZSNAP.   -----  Store nb.'',I2,'' = '',2A4,
 206      W       '' Division nb.'',I2,'' = '',2A4,20X,20(''-''),/)')
 207      W      JQSTOR,NQSNAM(1),  NQSNAM(2),
 208      W      JDIVI,IQDN1(KQT+JDIVI),IQDN2(KQT+JDIVI)
 209           CALL DZTEXT(0,CDUMMQ,3)
 210           LN     = LQSTA(KQT+JDIVI)
 211           LSTOP  = LQEND(KQT+JDIVI)
 212           IF(LN.EQ.LSTOP)                  THEN
 213               CQLINE = '          -- Division contains no banks --'
 214               CALL DZTEXT(0,CDUMMQ,1)
 215                                                            GO TO 1000
 216           ENDIF
 217
 218
 219
 220           JQDIVI = JDIVI
 221           CALL DZBKXR(0)
 222           IF (IQUEST(1).NE.0)                              GO TO 999
 223
 224   300     IF(LN.LT.LSTOP)                  THEN
 225               CALL DZMAP
 226               IF (IQUEST(1).NE.0)                          GO TO 400
 227               LN  = LX
 228                                                            GO TO 300
 229           ENDIF
 230
 231                                                            GO TO 1000
 232   400     WRITE(CQINFO,'(I8)') LN
 233           CALL DZTEXT(MSNA8Q,CDUMMQ,0)
 234           LBKCL= LN
 235           IFLOPT(MPOSWQ) = -1
 236   500     LBK = LN
 237   600     LBK = LBK + 1
 238           IF (LBK.GE.LSTOP)                THEN
 239               LN     = LSTOP
 240               LBASE  = LBKCL-1
 241               IBASE  = LBASE
 242               NDW    = MIN(LN - LBKCL,NQWCUT)
 243               JDFD   = 1
 244               CALL DZDATA(CDUMMQ)
 245                                                            GO TO 1000
 246           ENDIF
 247           CALL MZCHLN (NCHEKQ,LBK)
 248           IF (IQFOUL.NE.0)                                 GO TO 600
 249           LN     = LBK
 250           LBK    = IQNX
 251           IF (LBK.GE.LSTOP)                THEN
 252               LN     = LSTOP
 253               LBASE  = LBKCL-1
 254               IBASE  = LBASE
 255               NDW    = MIN(LN - LBKCL,NQWCUT)
 256               JDFD   = 1
 257               CALL DZDATA(CDUMMQ)
 258                                                            GO TO 1000
 259           ENDIF
 260           CALL MZCHLN (NCHEKQ,LBK)
 261           IF (IQFOUL.NE.0)                                 GO TO 500
 262   700     CONTINUE
 263               LBASE  = LBKCL-1
 264               IBASE  = LBASE
 265               NDW    = MIN(LN - LBKCL,NQWCUT)
 266               JDFD   = 1
 267               CALL DZDATA(CDUMMQ)
 268           WRITE(CQMAP,'(1X,/,'' RECOVER AT ADR'',I8)')   LN
 269           CALL DZTEXT(0,CDUMMQ,2)
 270           IQUEST(1) = 0
 271                                                            GO TO 300
 272
 273  1000 CONTINUE
 274
 275                                                            GO TO 999
 276
 277   998 IQUEST(1) = 1
 278
 279   999 RETURN
 280       END