MINICERN/packlib/zebra/dzebra/dzbkxr.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:04  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 DZBKXR(LBANK)
  19       SAVE NDVXRF
  20 #include "zebra/bankparq.inc"
  21 #include "zebra/divparq.inc"
  22 #include "zebra/questparq.inc"
  23 #include "zebra/mqsys.inc"
  24 #include "zebra/qequ.inc"
  25 #include "zebra/mzcn.inc"
  26 #include "zebra/dzc1.inc"
  27
  28       CHARACTER CHROUT*(*),CHSTAK*6
  29       PARAMETER (CHROUT = 'DZBKXR')
  30
  31 #include "zebra/q_jbit.inc"
  32 #include "zebra/q_jbyt.inc"
  33
  34 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  35 #include "zebra/debugvf2.inc"
  36 #endif
  37
  38
  39       CHSTAK          = CQSTAK(MCQSIQ:)
  40       CQSTAK(MCQSIQ:) = CHROUT
  41
  42       IF (LBANK.EQ.0) THEN
  43
  44
  45
  46           IXREF  = IQRTO(KQT+JQDIVI)
  47           DO 110 I=1,NDVMXQ
  48               IF (JBIT(IXREF,I).NE.0) THEN
  49                   IQUEST(30+I) = 1
  50               ELSE
  51                   IQUEST(30+I) = 0
  52               ENDIF
  53   110     CONTINUE
  54           IF (JBIT(IXREF,JDVUSQ).EQ.1) THEN
  55               DO 120 I=1,JQDVLL
  56   120         IQUEST(30+I) = 1
  57           ENDIF
  58           IF (JBYT(IXREF,JDVLGQ,2).NE.0) THEN
  59               DO 130 I=JQDVSY+1,NDVMXQ
  60   130         IQUEST(30+I) = 1
  61           ENDIF
  62           IF (JBIT(IXREF,JDVSYQ).EQ.1) IQUEST(30+JQDVSY) = 1
  63           IQUEST(30+JQDIVI) = 1
  64           NDVXRF = 0
  65           DO 140 I=1,NDVMXQ
  66               IF (I.GT.JQDVLL.AND.I.LT.JQDVSY)             GO TO 140
  67               IF (IQUEST(30+I).EQ.1) THEN
  68                   NDVXRF = NDVXRF + 1
  69                   IQUEST(30+NDVXRF) = I
  70               ENDIF
  71   140     CONTINUE
  72
  73                                                            GO TO 999
  74       ELSE
  75
  76
  77           LB = LBANK-NL+KQS
  78           LE = LBANK   +KQS
  79           DO 220 L=LB,LE
  80               IF (LQ(L).EQ.0)                              GO TO 220
  81               DO 210 I=1,NDVXRF
  82                   IDVXRF = IQUEST(30+I)
  83                   IF (LQ(L).GE.LQSTA(KQT+IDVXRF).AND.
  84      X                LQ(L).LT.LQEND(KQT+IDVXRF)    )      GO TO 220
  85   210         CONTINUE
  86               CALL DZBKDV(LBANK)
  87               IF (IQUEST(1).NE.0)                          GO TO 999
  88               CQINFO = CQDIV//'/'
  89               CALL DZBKDV(LQ(L))
  90               IF (IQUEST(1).NE.0)                          GO TO 999
  91               WRITE(CQINFO(10:),'(I8,'','',A,''/'',I8)')
  92      X        LBANK,CQDIV,LQ(L)
  93               CALL DZTEXT(MBKX1Q,CDUMMQ,0)
  94               IQUEST(1) = 1
  95                                                            GO TO 999
  96   220     CONTINUE
  97
  98
  99           LUP = LQLUP(KQS+LBANK)
 100
 101           IF (LUP.NE.0) THEN
 102               DO 310 I=1,NDVXRF
 103                   IDVXRF = IQUEST(30+I)
 104                   IF (LUP.GE.LQSTA(KQT+IDVXRF).AND.
 105      X                LUP.LT.LQEND(KQT+IDVXRF)     )       GO TO 400
 106   310         CONTINUE
 107               CALL DZBKDV(LBANK)
 108               IF (IQUEST(1).NE.0)                          GO TO 999
 109               CQINFO = CQDIV//'/'
 110               CALL DZBKDV(LUP)
 111               IF (IQUEST(1).NE.0)                          GO TO 999
 112               WRITE(CQINFO(10:),'(I8,'','',A,''/'',I8)')
 113      X        LBANK,CQDIV,LUP
 114               CALL DZTEXT(MBKX2Q,CDUMMQ,0)
 115               IQUEST(1) = 1
 116                                                            GO TO 999
 117           ENDIF
 118
 119
 120   400     LSUP = LQLORG(KQS+LBANK)
 121
 122           IF (LSUP.EQ.0.AND.LUP.EQ.0)                      GO TO 999
 123           IF (LSUP.GE.LQSTA(KQT+1).AND.
 124      X        LSUP.LE.LQSTA(KQT+NDVMXQ+1)) THEN
 125
 126
 127               DO 410 I=1,NDVXRF
 128                   IDVXRF = IQUEST(30+I)
 129                   IF (LSUP.GE.LQSTA(KQT+IDVXRF).AND.
 130      X                LSUP.LT.LQEND(KQT+IDVXRF)     )      GO TO 999
 131   410         CONTINUE
 132
 133               CALL DZBKDV(LBANK)
 134               IF (IQUEST(1).NE.0)                          GO TO 999
 135               CQINFO = CQDIV//'/'
 136               CALL DZBKDV(LSUP)
 137               IF (IQUEST(1).NE.0)                          GO TO 999
 138               WRITE(CQINFO(10:),'(I8,'','',A,''/'',I8)')
 139      X        LBANK,CQDIV,LSUP
 140               CALL DZTEXT(MBKX3Q,CDUMMQ,0)
 141               IQUEST(1) = 1
 142                                                            GO TO 999
 143           ENDIF
 144       ENDIF
 145
 146   999 CQSTAK(MCQSIQ:) = CHSTAK
 147       RETURN
 148       END