MINICERN/packlib/zebra/dzebra/dzshpr.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:14  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 DZSHPR (LBANK,ILINK1,ILINK2,IDATA1,IDATA2)
  19 #include "zebra/mqsys.inc"
  20 #include "zebra/qequ.inc"
  21 #include "zebra/mzcn.inc"
  22 #include "zebra/zbcdk.inc"
  23 #include "zebra/zunit.inc"
  24 #include "zebra/dzc1.inc"
  25 #include "zebra/bankparq.inc"
  26 #include "zebra/divparq.inc"
  27 #include "zebra/questparq.inc"
  28 #include "zebra/storparq.inc"
  29
  30       CHARACTER CHROUT*(*),CHSTAK*6
  31       PARAMETER (CHROUT = 'DZSHPR')
  32
  33 #include "zebra/q_jbyt.inc"
  34
  35 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  36 #include "zebra/debugvf2.inc"
  37 #endif
  38
  39
  40       CHSTAK          = CQSTAK(MCQSIQ:)
  41       CQSTAK(MCQSIQ:) = CHROUT
  42
  43
  44       CALL MZCHLS (NCHEKQ,LBANK)
  45       IF (IQFOUL.NE.0) THEN
  46           CALL DZBKDV(LBANK)
  47           IF (IQUEST(1).NE.0)                              GO TO 999
  48           WRITE(CQINFO,'(A,''/'',I8)') CQDIV,LBANK
  49           CALL DZTEXT(MSHP1Q,CDUMMQ,0)
  50                                                            GO TO 999
  51       ENDIF
  52
  53
  54       CALL DZBKDV(IQLS)
  55       IF (IQUEST(1).NE.0)                                  GO TO 999
  56
  57
  58       CALL DZBKXR(0)
  59       IF (IQUEST(1).NE.0)                                  GO TO 999
  60
  61       LN = IQLN
  62       LS = IQLS
  63       NL = IQNL
  64       NS = IQNS
  65       ND = IQND
  66       IO = JBYT (LQ(KQS+IQLN+MBKIOQ),JBKIOQ,NBKIOQ)
  67
  68       CALL DZBKHD
  69       IF (IQUEST(1).NE.0)                                  GO TO 999
  70
  71
  72       IF (ILINK1.GT.ILINK2.OR.NL.EQ.0)                     GO TO 100
  73
  74       IL1 = ILINK1
  75       IL2 = ILINK2
  76
  77
  78       IF (IL1.LE.0.OR.IL1.GT.NL) IL1=1
  79       IF (IL2.LE.0.OR.IL2.GT.NL) IL2=NL
  80
  81       IF (IFLOPT(MPOSDQ).NE.0)       THEN
  82
  83
  84
  85           IBEGIN = MIN(NL,IL2)
  86           IF (IL1.LE.NS) THEN
  87               IBASE = NS
  88           ELSE
  89               IBASE = IL1-1
  90           ENDIF
  91
  92           NDW    = IBEGIN-IBASE
  93           JDFD   = NDW + 1
  94
  95           IF (NDW.GT.0)                                             THEN
  96               IF (NDW.GT.NQWKTB)         THEN
  97                   LBASE  = LS-IBEGIN-1
  98                   CALL DZDATA('REFERENCE links -- to be inverted --')
  99               ELSE
 100                   CALL UCOPIV (LQ(KQS+LS-IBEGIN),LQ(LQWKTB),NDW)
 101                   LBASE  = LQWKTB - 1 - KQS
 102                   CALL DZDATA('REFERENCE links')
 103               ENDIF
 104           ENDIF
 105
 106
 107
 108           IBEGIN = MIN(NS,IL2)
 109           IBASE  = IL1-1
 110
 111           NDW    = IBEGIN-IBASE
 112           JDFD   = NDW + 1
 113
 114           IF (NDW.GT.0)                                             THEN
 115               IF (NDW.GE.NQWKTB)          THEN
 116                   LBASE  = LS-IBEGIN-1
 117                   CALL DZDATA('STRUCTURAL links -- to be inverted --')
 118               ELSE
 119                   CALL UCOPIV (LQ(KQS+LS-IBEGIN),LQ(LQWKTB),NDW)
 120                   LBASE  = LQWKTB - 1 - KQS
 121                   CALL DZDATA('STRUCTURAL links')
 122               ENDIF
 123           ENDIF
 124
 125       ELSE
 126
 127
 128           CALL ZPAGE(IQPRNT,MIN((IL2-IL1-1)/10+2,5))
 129           CQLINE = ' --------  LINK part of bank  --------'
 130           CALL DZTEXT(0,CDUMMQ,1)
 131           DO 50 I=IL1,IL2,10
 132               WRITE (CQLINE,'(1X,I7,'' /'',10I12)')
 133      +        I,(LQ(KQS+LS-J),J=I,MIN(IL2,I+9))
 134               CALL DZTEXT(0,CDUMMQ,1)
 135    50     CONTINUE
 136
 137       ENDIF
 138
 139
 140   100 IF (ND.EQ.0.OR.IDATA2.LT.IDATA1)                     GO TO 999
 141
 142       ID1 = IDATA1
 143       ID2 = IDATA2
 144
 145
 146       IF (ID1.LE.0.OR.ID1.GT.ND) ID1=1
 147       IF (ID2.LE.0.OR.ID2.GT.ND) ID2=ND
 148
 149       CALL DZIOPR(ID1,ID2)
 150
 151   999 CQSTAK(MCQSIQ:) = CHSTAK
 152       RETURN
 153       END