MINICERN/packlib/zebra/dzebra/dzare1.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:00  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 DZARE1  (CHTEXT,CLA,LLA,CHOPT)
  19       SAVE CLATYP
  20 #include "zebra/mqsys.inc"
  21 #include "zebra/qequ.inc"
  22 #include "zebra/mzcn.inc"
  23 #include "zebra/zbcdch.inc"
  24 #include "zebra/zbcdk.inc"
  25 #include "zebra/zstate.inc"
  26 #include "zebra/zunit.inc"
  27 #include "zebra/dzc1.inc"
  28 #include "zebra/questparq.inc"
  29 #include "zebra/storparq.inc"
  30       CHARACTER *(*) CLA,CHOPT,CHTEXT
  31       INTEGER ILANAM(2)
  32
  33       CHARACTER CHROUT*(*),CHSTAK*6,   CLATYP(0:1)*9, CLA8*8, CAKTIV*8
  34       PARAMETER (CHROUT = 'DZARE1')
  35       DATA      CLATYP               /'PERMANENT','TEMPORARY'/
  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
  45       CHSTAK          = CQSTAK(MCQSIQ:)
  46       CQSTAK(MCQSIQ:) = CHROUT
  47
  48       IF (LQSTA(KQT+JQDVSY).EQ.LQEND(KQT+JQDVSY)) THEN
  49           IQUEST(1) = 0
  50                                                            GO TO 999
  51       ENDIF
  52
  53       LSYSB  = LQSYSS(KQT+MSYLAQ)
  54       CALL MZCHLS(NCHEKQ,LSYSB)
  55       IF (IQFOUL.NE.0)  THEN
  56           WRITE(CQINFO,'(''Store = '',2A4)') NQSNAM(1),NQSNAM(2)
  57           CALL DZTEXT(MARE1Q,CHTEXT,0)
  58                                                            GO TO 999
  59       ENDIF
  60
  61
  62       NWTAB  = IQ(KQS+LSYSB+MLAUSQ)
  63       IF(NWTAB.LE.1)                   THEN
  64           WRITE(CQINFO,'(''Store = '',2A4)') NQSNAM(1),NQSNAM(2)
  65           CALL DZTEXT(MARE2Q,CHTEXT,0)
  66                                                            GO TO 999
  67       ENDIF
  68
  69       IF (IFLOPT(MPOSNQ).NE.0)  THEN
  70
  71
  72           CLA8 = CLA
  73           CALL UCTOH (CLA8,ILANAM,4,8)
  74       ELSE
  75
  76
  77           LLINK = LOCF(LLA) - LQSTOR
  78       ENDIF
  79
  80
  81       LENTRY = LSYSB + KQS + MLAUSQ
  82
  83       IFOUND = 0
  84
  85       DO 100 IENTRY = 1,(NWTAB-1)/NLAENQ
  86
  87
  88           IF (IFLOPT(MPOSNQ).NE.0) THEN
  89               IF(CLA.NE.' ')   THEN
  90                   IF (ILANAM(1).NE.IQ(LENTRY+MLAN1Q) .OR.
  91      X                ILANAM(2).NE.IQ(LENTRY+MLAN2Q)  )    GO TO 100
  92               ELSE
  93                   IF(IENTRY.LE.2)                          GO TO 100
  94               ENDIF
  95
  96           ELSE
  97
  98
  99               IF (LLINK.LT.IQ(LENTRY+MLAADQ) .OR.
 100      X            LLINK.GT.IQ(LENTRY+MLALTQ)       )       GO TO 100
 101
 102           ENDIF
 103
 104
 105           LLAAR1 = IQ(LENTRY+MLAADQ)
 106           LLAARL = IQ(LENTRY+MLALTQ)
 107           NLANS  = IQ(LENTRY+MLANSQ)
 108           JTEMP  = JBIT(NLANS,JLATMQ)
 109           NTEMP  = NLATMQ*JTEMP
 110           NLANS  = JBYT(NLANS,JLANSQ,NLANSQ)-NTEMP
 111           IF(JTEMP.EQ.0.OR.
 112      +     (JTEMP.EQ.1.AND.LQ(KQS+LLAAR1+MLACTQ-1).NE.0))          THEN
 113               CAKTIV = '  ACTIVE'
 114           ELSE
 115               CAKTIV = 'INACTIVE'
 116           ENDIF
 117
 118
 119           DO 50 I = NTEMP,NLANS-1
 120               LS  = LQ(KQS+LLAAR1+I)
 121               IF (LS.EQ.0)                                 GO TO 50
 122               CALL MZCHLS(NCHEKQ,LS)
 123               ID     = IQID
 124               IF (JBIT(IQ(KQS+LS),IQDROP).EQ.1)            GO TO 50
 125               IF (IQFOUL.EQ.0) THEN
 126                   LUP    = LQLUP(KQS+LS)
 127                   IF (LUP.EQ.0)                            GO TO 40
 128                   CALL MZCHLS(NCHEKQ,LUP)
 129                   IF (IQFOUL.NE.0) THEN
 130                       WRITE(CQINFO,
 131      X                 '(2A4,''/'',I5,''= '',A4,2I10)')
 132      X                 IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
 133      X                 I+1,ID,LS,LUP
 134                       CALL DZTEXT(MARE3Q,CDUMMQ,0)
 135                   ENDIF
 136    40             LORIG  = LQLORG(KQS+LS)
 137                   IF (LORIG.EQ.0)                          GO TO 50
 138                   IF(LORIG.LT.IQTABV(KQT+13).OR.LORIG.GT.IQTABV(KQT+14))
 139      X                  THEN
 140                       WRITE(CQINFO,'(2A4,''/'',I5,''= '',A4,2I10)')
 141      X                 IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
 142      X                 I+1,ID,LS,LORIG
 143                       CALL DZTEXT(MARE4Q,CDUMMQ,0)
 144                   ELSEIF (LQ(KQS+LORIG).NE.LS) THEN
 145                       WRITE(CQINFO,'(2A4,''/'',I5,''= '',A4,2I10)')
 146      X                 IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),
 147      X                 I+1,ID,LS,LORIG
 148                       CALL DZTEXT(MARE4Q,CDUMMQ,0)
 149                   ENDIF
 150                   IF (IQND.LT.NQDCUT.AND.IFLOPT(MPOSTQ).NE.0)
 151      X             CALL SBIT1 (IQ(KQS+LS),IQCRIT)
 152               ELSE
 153                   WRITE(CQINFO,'(2A4,''/'',I5,''='',I10)')
 154      X             IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),I+1,LS
 155                   CALL DZTEXT(MARE5Q,CDUMMQ,0)
 156               ENDIF
 157    50     CONTINUE
 158
 159           IF (IFLOPT(MPOSQQ).EQ.0) THEN
 160              IF (CHTEXT.NE.CDUMMQ)                                 THEN
 161                  CQMAP(1)      = ' '
 162                  CQMAP(2)      = ' DZAREA -- '
 163                  CQMAP(2)(12:) = CHTEXT
 164                  WRITE(CQMAP(2)(80:),'('' -- Dump of link area '',2A4,
 165      W           '' Options: '',A)')
 166      W           IQ(LENTRY+MLAN1Q),IQ(LENTRY+MLAN2Q),CHOPT
 167                  CALL DZTEXT(0,CDUMMQ,2)
 168              ENDIF
 169
 170              CQMAP(1) = ' '
 171              WRITE(CQMAP(2),
 172 #if !defined(CERNLIB_OCTMAP)
 173      W       '('' This '',A9,'' LINK AREA is at absolute address '',Z8,
 174 #endif
 175 #if defined(CERNLIB_OCTMAP)
 176      W       '('' This '',A9,'' LINK AREA is at absolute address '',O11,
 177 #endif
 178      W       '' with NL/NS ='',I7,''/'',I7,4X,'' and is '',A8)'      )
 179      W        CLATYP(JTEMP),(LLAAR1+LQSTOR)
 180 #if !defined(CERNLIB_WORDMAP)
 181      W       *4
 182 #endif
 183      W        ,LLAARL-LLAAR1-NTEMP,NLANS,CAKTIV
 184              CALL DZTEXT(0,CDUMMQ,2)
 185              CALL DZTEXT(1,CDUMMQ,1)
 186
 187
 188              LBASE  = LLAAR1 + NTEMP - 1
 189              IBASE  = 0
 190              NDW    = LLAARL - LLAAR1  - NTEMP
 191              JDFD   = NDW    + 1
 192
 193              CALL DZDATA(CDUMMQ)
 194
 195              IFOUND = 1
 196              IF (IFLOPT(MPOSNQ).NE.0) THEN
 197                  IF (CLA.NE.' ')                           GO TO 999
 198              ELSE
 199                                                            GO TO 999
 200              ENDIF
 201           ELSE
 202               IQUEST(10) = IENTRY
 203               IQUEST(11) = IQ(LENTRY+MLAN1Q)
 204               IQUEST(12) = IQ(LENTRY+MLAN2Q)
 205               IQUEST(13) = LLAAR1
 206               IQUEST(14) = LLAAR1 + NLANS
 207               IQUEST(15) = LLAARL
 208               IQUEST(16) = NLANS
 209               IQUEST(17) = LLAARL-LLAAR1
 210               IQUEST(18) = JTEMP
 211               IQUEST(19) = LQ(KQS+LLAAR1+MLACTQ-1)
 212                                                            GO TO 999
 213              ENDIF
 214   100     LENTRY = LENTRY + NLAENQ
 215
 216       IF (IFOUND.EQ.0)           THEN
 217           IF (IFLOPT(MPOSQQ).EQ.0) THEN
 218              IF (IFLOPT(MPOSNQ).NE.0) THEN
 219                  WRITE(CQINFO,'(A)') CLA8
 220                  CALL DZTEXT(MARE6Q,CHTEXT,0)
 221              ELSE
 222                  WRITE(CQINFO,'(I8)') LLINK
 223                  CALL DZTEXT(MARE7Q,CHTEXT,0)
 224              ENDIF
 225           ELSE
 226              IQUEST(10) = 0
 227           ENDIF
 228       ENDIF
 229
 230   999 CQSTAK(MCQSIQ:) = CHSTAK
 231       RETURN
 232       END