MINICERN/packlib/zebra/dzebra/dzshow.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:13  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 DZSHOW
  19      X (CHTEXT,IXSTOR,LBANK,CHOPT,ILINK1,ILINK2,IDATA1,IDATA2)
  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
  31
  32       PARAMETER ( NPDENQ =  3 )
  33       PARAMETER ( MPDCUQ =  1 )
  34       PARAMETER ( MPDNCQ =  2 )
  35       PARAMETER ( MPDNSQ =  3 )
  36
  37       CHARACTER CHROUT*(*)
  38       PARAMETER (CHROUT = 'DZSHOW')
  39
  40 #include "zebra/q_jbit.inc"
  41
  42 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  43 #include "zebra/debugvf2.inc"
  44 #endif
  45
  46       CQSTAK = CHROUT//'/'
  47       IQUEST(1) = 0
  48
  49       IF (CHTEXT.NE.CDUMMQ)                                    THEN
  50           CQMAP(1)          = ' '
  51           CQMAP(2)(1:12)    = ' DZSHOW --- '
  52           CQMAP(2)(13:100)  = CHTEXT
  53           CQMAP(2)(101:110) = 'OPTIONS : '
  54           CQMAP(2)(111:130) = CHOPT
  55           CALL DZTEXT(0,CDUMMQ,2)
  56       ENDIF
  57
  58       CALL DZOPT(CHOPT)
  59
  60       CALL MZSDIV(IXSTOR,-1)
  61
  62
  63       IF (LBANK.EQ.0)                                      GO TO 999
  64       IF (JBIT(IQ(LBANK+KQS),IQDROP).EQ.1)                 GO TO 999
  65
  66
  67       CALL DZBKUP(0)
  68       IF (IQUEST(1).NE.0)                                  GO TO 999
  69
  70
  71       LWORK  = NQOFFS(1) + LQEND(1)  - NPDENQ - 1
  72       LWORKE = NQOFFS(1) + LQSTA(2)  - NPDENQ
  73
  74
  75       LCUR   = LBANK
  76       LEVEL  = 0
  77       LEVELO = -1
  78
  79
  80       MAXALL = 0
  81       NTBANK = 0
  82       DO 20 I=1,NDVMXQ
  83           IF(I.LE.JQDVLL.OR.I.GE.JQDVSY)
  84      I    MAXALL = MAXALL + LQEND(KQT+I) - LQSTA(KQT+I)
  85    20 CONTINUE
  86
  87
  88
  89 100   IF ( LEVEL.NE.LEVELO )  THEN
  90
  91
  92           IF(IFLOPT(MPOSVQ).NE.0) THEN
  93               CQMAP(1) = ' '
  94               WRITE(CQMAP(2),'('' DZSHOW  +++++ LEVEL '',I5,1X,
  95      W        10(''+''),T50,''Store  '',2A4,'' at absolute address '',
  96 #if defined(CERNLIB_OCTMAP)
  97      W        O12,T100,10(''+'') )')
  98 #endif
  99 #if !defined(CERNLIB_OCTMAP)
 100      W        Z8,T100,10(''+'') )')
 101 #endif
 102      W        LEVEL,NQSNAM(1),NQSNAM(2),
 103 *  Map  addresses expressed in machine words
 104 #if defined(CERNLIB_WORDMAP)
 105      W        LQSTOR+1
 106 *  Map addresses expressed in bytes
 107 #endif
 108 #if !defined(CERNLIB_WORDMAP)
 109      W        (LQSTOR+1)*4
 110 #endif
 111               CQMAP(3) = ' '
 112               CALL DZTEXT(0,CDUMMQ,3)
 113           ENDIF
 114
 115           LEVELO = LEVEL
 116
 117       ENDIF
 118
 119
 120       CALL DZSHPR (LCUR,ILINK1,ILINK2,IDATA1,IDATA2)
 121       IF (IQUEST(1).NE.0)                                  GO TO 999
 122
 123       NTBANK = NTBANK + NL + ND + NBKOHQ
 124       IF (NTBANK.GE.MAXALL) THEN
 125           WRITE(CQINFO,'(I10,''/'',I10)') MAXALL,NTBANK
 126           CALL DZTEXT(MSHO1Q,CDUMMQ,0)
 127                                                            GO TO 999
 128       ENDIF
 129
 130
 131       LEVEL  = LEVEL+1
 132       LWORK  = LWORK + NPDENQ
 133       IF (LWORK.GE.LWORKE)             THEN
 134           WRITE(CQINFO,'(I10)') LEVEL
 135           CALL DZTEXT(MSHO2Q,CDUMMQ,0)
 136                                                            GO TO 999
 137       ENDIF
 138
 139
 140       IF (IFLOPT(MPOSVQ).EQ.0)   NS=0
 141
 142       LQ(LWORK+MPDCUQ) = LCUR
 143       LQ(LWORK+MPDNCQ) = NS
 144       LQ(LWORK+MPDNSQ) = NS
 145
 146
 147 200   IF (LQ(LWORK+MPDNCQ).LE.0)  THEN
 148           IF (LEVEL.GT.1.OR.IFLOPT(MPOSLQ).NE.0) THEN
 149               LCUR = LQ(KQS + LQ(LWORK+MPDCUQ))
 150               LEVEL  = LEVEL - 1
 151               LWORK  = LWORK - NPDENQ
 152               IF (LCUR.NE.LNULL)  THEN
 153                                                            GO TO 100
 154               ELSE
 155                   IF (LEVEL.GT.0) THEN
 156                                                            GO TO 200
 157                   ELSE
 158                                                            GO TO 999
 159                   ENDIF
 160               ENDIF
 161           ELSE
 162               LEVEL = LEVEL-1
 163               LWORK  = LWORK - NPDENQ
 164               IF (LEVEL.GT.0) THEN
 165                                                            GO TO 200
 166               ELSE
 167                                                            GO TO 999
 168               ENDIF
 169           ENDIF
 170       ENDIF
 171
 172
 173       LQ(LWORK+MPDNCQ) = LQ(LWORK+MPDNCQ) - 1
 174       LCUR = LQ(KQS+LQ(LWORK+MPDCUQ)
 175      X             -LQ(LWORK+MPDNSQ)+LQ(LWORK+MPDNCQ))
 176
 177       IF (LCUR.EQ.LNULL)                                   GO TO 200
 178                                                            GO TO 100
 179
 180   999 RETURN
 181       END