MINICERN/packlib/zebra/dzebra/dzare1.F

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