MINICERN/packlib/zebra/dzebra/dzveri.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:20  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 DZVERI (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/zunit.inc"
  26 #include "zebra/dzc1.inc"
  27 #include "zebra/bankparq.inc"
  28 #include "zebra/divparq.inc"
  29 #include "zebra/questparq.inc"
  30 #include "zebra/storparq.inc"
  31
  32       PARAMETER (KINUSQ=2**(IDVUSQ-1),KINSYQ=2**(IDVSYQ-1))
  33
  34       CHARACTER*(*) CHOPT,CHTEXT
  35       CHARACTER CHROUT*(*)
  36       PARAMETER (CHROUT = 'DZVERI')
  37
  38 #include "zebra/q_jbit.inc"
  39 #include "zebra/q_jbyt.inc"
  40
  41 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  42 #include "zebra/debugvf2.inc"
  43 #endif
  44
  45       CQSTAK = CHROUT//'/'
  46       IQUEST(1) = 0
  47
  48       CALL MZSDIV (IXDIV,-1)
  49
  50       CALL DZOPT(CHOPT)
  51
  52
  53
  54       ICHAIN = 1
  55       ISTRUC = 0
  56
  57       IF (IFLOPT(MPOSSQ).NE.0.AND.IFLOPT(MPOSCQ).EQ.0) THEN
  58           ICHAIN = 0
  59       ENDIF
  60       IF (IFLOPT(MPOSLQ).NE.0)          THEN
  61           ICHAIN = 1
  62           ISTRUC = 1
  63       ENDIF
  64
  65       IF (IFLOPT(MPOSSQ).EQ.0)                             GO TO 1000
  66
  67
  68       DO 100 IFENCE=-NQFEND+1,0
  69           IF(LQ(KQS+IFENCE).NE.IQNIL)      THEN
  70               WRITE (CQINFO,'(I5,1X,Z16)') IFENCE,LQ(KQS+IFENCE)
  71               CALL DZTEXT(MSNA1Q,CDUMMQ,0)
  72                                                            GO TO 998
  73           ENDIF
  74   100 CONTINUE
  75
  76
  77       IF ((LQ(KQS+LQSTA(KQT+21)+1).NE.IQNIL) .OR.
  78      X    (LQ(KQS+LQSTA(KQT+21)+2).NE.IQNIL)      ) THEN
  79           WRITE (CQINFO,'(Z16,1X,Z16)')
  80      X    LQ(KQS+LQSTA(KQT+21)+1),LQ(KQS+LQSTA(KQT+21)+2)
  81           CALL DZTEXT(MSNA2Q,CDUMMQ,0)
  82                                                            GO TO 998
  83       ENDIF
  84
  85       IF(NQSTRU.GT.NQREF)              THEN
  86           WRITE (CQINFO,'(I8,''>'',I8)') NQSTRU,NQREF
  87           CALL DZTEXT(MSNA3Q,CDUMMQ,0)
  88                                                            GO TO 998
  89       ENDIF
  90
  91       IF(NQREF.GT.NQLINK)              THEN
  92           WRITE (CQINFO,'(I8,''>'',I8)') NQREF,NQLINK
  93           CALL DZTEXT(MSNA4Q,CDUMMQ,0)
  94                                                            GO TO 998
  95       ENDIF
  96
  97       IF(LQSTA(KQT+2)-LQEND(KQT+1).LT.NQMINR)      THEN
  98           WRITE (CQINFO,'(I8,''-'',I8,''<'',I8)')
  99      X     LQSTA(KQT+2),LQEND(KQT+1),NQMINR
 100           CALL DZTEXT(MSNA5Q,CDUMMQ,0)
 101                                                            GO TO 998
 102       ENDIF
 103
 104       IF(NQMINR.GT.LQ2END)             THEN
 105           WRITE (CQINFO,'(I8,''>'',I8)') NQMINR,LQ2END
 106           CALL DZTEXT(MSNA6Q,CDUMMQ,0)
 107                                                            GO TO 998
 108       ENDIF
 109
 110       IF(LQ2END.GT.LQSTA(KQT+21))      THEN
 111           WRITE (CQINFO,'(I8,''>'',I8)') LQ2END,LQSTA(KQT+21)
 112           CALL DZTEXT(MSNA7Q,CDUMMQ,0)
 113                                                            GO TO 998
 114       ENDIF
 115
 116
 117
 118       LPREV = NQLINK
 119       DO 300 JDIVI=1,NDVMXQ
 120           IF(JDIVI.GT.JQDVLL.AND.JDIVI.LT.JQDVSY)          GO TO 300
 121
 122           CALL UHTOC (IQDN1(KQT+JDIVI),4,CQDIV(1:4),4)
 123           CALL UHTOC (IQDN2(KQT+JDIVI),4,CQDIV(5:8),4)
 124           CQINFO = CQDIV//'/'
 125
 126           IF(LQSTA(KQT+JDIVI).GT.LQEND(KQT+JDIVI))       THEN
 127               WRITE (CQINFO(10:),'(I8,''>'',I8)')
 128      X         LQSTA(KQT+JDIVI),LQEND(KQT+JDIVI)
 129               CALL DZTEXT(MVER1Q,CDUMMQ,0)
 130                                                            GO TO 998
 131           ENDIF
 132
 133           IF(LQSTA(KQT+JDIVI).LT.LPREV            )       THEN
 134               WRITE (CQINFO(10:),'(I8,''<'',I8)') LQSTA(KQT+JDIVI),LPREV
 135               CALL DZTEXT(MVER2Q,CDUMMQ,0)
 136                                                            GO TO 998
 137           ENDIF
 138
 139           IF((LQEND(KQT+JDIVI)-LQSTA(KQT+JDIVI)).GT.
 140      X        NQDMAX(KQT+JDIVI)                       )    THEN
 141               WRITE (CQINFO(10:),'(I8,''>'',I8)')
 142      X        (LQEND(KQT+JDIVI)-LQSTA(KQT+JDIVI)),NQDMAX(KQT+JDIVI)
 143               CALL DZTEXT(MVER3Q,CDUMMQ,0)
 144                                                            GO TO 998
 145           ENDIF
 146
 147           IF(IQMODE(KQT+JDIVI).NE.IDVFWQ .AND.
 148      X       IQMODE(KQT+JDIVI).NE.IDVBWQ     )            THEN
 149               WRITE (CQINFO(10:),'(I10)') IQMODE(KQT+JDIVI)
 150               CALL DZTEXT(MVER4Q,CDUMMQ,0)
 151                                                            GO TO 998
 152           ENDIF
 153
 154           MKIND = IQKIND(KQT+JDIVI)
 155
 156           DO 200 I=1,NDVMXQ
 157               IF(I.NE.JDIVI.AND.JBIT(MKIND,I).EQ.1)       THEN
 158               WRITE (CQINFO(10:),'(I2,'',        /'',I2)') JDIVI,I
 159               CALL UHTOC (IQDN1(KQT+JDIVI),4,CQINFO(13:16),4)
 160               CALL UHTOC (IQDN2(KQT+JDIVI),4,CQINFO(17:20),4)
 161               CALL DZTEXT(MVER5Q,CDUMMQ,0)
 162                                                            GO TO 998
 163           ENDIF
 164   200     CONTINUE
 165
 166           MKIND = JBYT(MKIND,JDVUSQ,JDVSYQ-NDVIDQ)
 167           IF(JDIVI.LE.JQDVLL)                               THEN
 168               IF(MKIND.NE.KINUSQ)                              THEN
 169               WRITE (CQINFO(10:),'(4I5)') JDIVI,JQDVLL,JQDVSY,MKIND
 170               CALL DZTEXT(MVER6Q,CDUMMQ,0)
 171                                                            GO TO 998
 172               ENDIF
 173           ELSEIF(JDIVI.EQ.JQDVSY)                           THEN
 174               IF(MKIND.NE.KINSYQ)                              THEN
 175               WRITE (CQINFO(10:),'(4I5)') JDIVI,JQDVLL,JQDVSY,MKIND
 176               CALL DZTEXT(MVER7Q,CDUMMQ,0)
 177                                                            GO TO 998
 178               ENDIF
 179           ELSE
 180               IF(MKIND.EQ.KINUSQ.OR.MKIND.EQ.KINSYQ)           THEN
 181               WRITE (CQINFO(10:),'(4I5)') JDIVI,JQDVLL,JQDVSY,MKIND
 182               CALL DZTEXT(MVER8Q,CDUMMQ,0)
 183                                                            GO TO 998
 184               ENDIF
 185           ENDIF
 186           LPREV = LQEND(KQT+JDIVI)
 187   300 CONTINUE
 188
 189
 190
 191  1000 IF (ICHAIN.EQ.0)                                     GO TO 1999
 192
 193       IF (ISTRUC.NE.0) THEN
 194
 195
 196           NDZRSV = 0
 197           CALL DZBKUP(0)
 198           IF (IQUEST(1).NE.0)                              GO TO 998
 199
 200       ENDIF
 201
 202
 203       CALL UCOPY(IFLOPT,IQUEST(71),26)
 204       CALL VZERO(IFLOPT,26)
 205       IFLOPT(MPOSNQ) = 1
 206       IFLOPT(MPOSQQ) = 1
 207       CALL DZARE1('DZVERI  L option',' ',0,'NQ')
 208       CALL UCOPY(IQUEST(71),IFLOPT,26)
 209
 210
 211       IF (JBYT(IXDIV,1,JSTIDQ-1).EQ.0)  THEN
 212           JJDIV = MZIXCO(IXDIV+21,IXDIV+22,0,0)
 213           JJDIV = MZDVAC(JJDIV)
 214       ELSE
 215           JJDIV  = MZDVAC (IXDIV)
 216       ENDIF
 217
 218       DO 1700 JDIVI = 1,NDVMXQ
 219           IF (JDIVI.GT.JQDVLL.AND.JDIVI.LT.JQDVSY)         GO TO 1700
 220
 221           IF (JBIT(JJDIV,JDIVI).EQ.0)                      GO TO 1700
 222
 223           CALL UHTOC (IQDN1(KQT+JDIVI),4,CQDIV(1:4),4)
 224           CALL UHTOC (IQDN2(KQT+JDIVI),4,CQDIV(5:8),4)
 225           CQINFO = CQDIV//'/'
 226
 227
 228           JQDIVI = JDIVI
 229           CALL DZBKXR(0)
 230           IF (IQUEST(1).NE.0)                              GO TO 998
 231
 232
 233           LN = LQSTA(KQT+JDIVI)
 234  1300     IF (LN.LT.LQEND(KQT+JDIVI))       THEN
 235               CALL MZCHLN(NCHEKQ,LN)
 236               IF (IQFOUL.NE.0)   THEN
 237                   WRITE(CQINFO(10:),'(3I10)') JDIVI,LN,IQFOUL
 238                   CALL DZTEXT(MVER9Q,CDUMMQ,0)
 239                                                            GO TO 998
 240               ENDIF
 241               LN = IQNX
 242               LS = IQLS
 243               NL = IQNL
 244               IF (IQND.LT.0)                               GO TO 1300
 245               IF (JBIT(IQ(KQS+LS),IQDROP).EQ.1)            GO TO 1300
 246
 247
 248               IF (ISTRUC.EQ.1)                 THEN
 249                   LB = IQLS-IQNS+KQS
 250                   LE = IQLS     +KQS
 251                   DO 1400 L=LB,LE
 252                       IF (LQ(L).EQ.0)                      GO TO 1400
 253                       CALL MZCHLS(NCHEKQ,LQ(L))
 254                       IF (IQFOUL.NE.0) THEN
 255                           CALL DZBKDV(LQ(L))
 256                           IF (IQUEST(1).NE.0)              GO TO 998
 257                           WRITE(CQINFO(10:),
 258      X                      '(I8,'','',A,''/'',I8,'','',I4)')
 259      X                       L-KQS,CQDIV,LQ(L),IQFOUL
 260                                                            GO TO 998
 261                       ENDIF
 262  1400             CONTINUE
 263                   CALL DZBKUP(LS)
 264                   IF (IQUEST(1).NE.0)                      GO TO 998
 265                   CALL DZBKXR(LS)
 266                   IF (IQUEST(1).NE.0)                      GO TO 998
 267               ENDIF
 268
 269                                                            GO TO 1300
 270           ENDIF
 271  1700 CONTINUE
 272
 273  1999 IF (CHTEXT.NE.CDUMMQ)                 THEN
 274           CQMAP(1)          = ' '
 275           CQMAP(2)          = ' DZVERI --- '
 276           CQMAP(2)(13:99)   = CHTEXT
 277           CQMAP(2)(101:110) = 'OPTIONS : '
 278           CQMAP(2)(111:120) = CHOPT
 279           CQMAP(2)(126:)    = 'OK'
 280           CALL DZTEXT(0,CDUMMQ,2)
 281       ENDIF
 282                                                            GO TO 999
 283
 284
 285   998 IF (CHTEXT.NE.CDUMMQ)                 THEN
 286           CQMAP(1)          = ' '
 287           CQMAP(2)          = ' DZVERI --- '
 288           CQMAP(2)(13:99)   = CHTEXT
 289           CQMAP(2)(101:110) = 'OPTIONS : '
 290           CQMAP(2)(111:115) = CHOPT
 291           CQMAP(2)(117:)    = '??PROBLEMS ? '
 292           CALL DZTEXT(0,CDUMMQ,2)
 293       ENDIF
 294       IQUEST(1)=1
 295
 296
 297       NQFATA = 2
 298       IQUEST(11) = JQSTOR
 299       IQUEST(12) = JDIVI
 300       IF(ICHAIN.NE.0)      THEN
 301           IQUEST(13) = LN
 302           IQUEST(14) = IQLS
 303           IQUEST(15) = IQNL
 304           IQUEST(16) = IQNS
 305           IQUEST(17) = IQND
 306           NQFATA = 17
 307           IF(ISTRUC.EQ.1)                            THEN
 308               NQFATA = 21
 309               IF(L.GE.LQSTA(KQT+JDIVI).AND.L.LT.LQEND(KQT+JDIVI)) THEN
 310                   IQUEST(18) = L
 311                   IQUEST(19) = LQ(L)
 312               ELSE
 313                   IQUEST(18) = 0
 314                   IQUEST(19) = 0
 315               ENDIF
 316               IQUEST(20) = LQLUP(KQS+LS)
 317               IQUEST(21) = LQLORG(KQS+LS)
 318           ENDIF
 319       ENDIF
 320
 321
 322       IF(IFLOPT(MPOSFQ).NE.0) CALL ZFATAM(CHROUT)
 323
 324
 325   999 RETURN
 326       END