MINICERN/packlib/zebra/dzebra/dziopd.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:11  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 DZIOPD (IFIRST,ILAST)
  19       SAVE KFOTYP
  20 #include "zebra/mqsys.inc"
  21 #include "zebra/qequ.inc"
  22 #include "zebra/mzioc.inc"
  23 #include "zebra/zbcdk.inc"
  24 #include "zebra/zunit.inc"
  25 #include "zebra/dzc1.inc"
  26 #include "zebra/bkfoparq.inc"
  27
  28       PARAMETER (NENLNQ = 5 )
  29       PARAMETER (NLNGRQ = 10)
  30       PARAMETER (NLISTQ = 6 )
  31       PARAMETER (NLINEQ = 24)
  32
  33       CHARACTER CHROUT*(*),CHSTAK*6,KFOTYP(0:11)*1,CDWORD*31
  34       DOUBLE PRECISION DWORD
  35       INTEGER                IWORD
  36       REAL                         RWORD
  37       EQUIVALENCE     (DWORD,IWORD,RWORD)
  38       PARAMETER (CHROUT = 'DZIOPD')
  39       DATA KFOTYP /'U','B','I','F','D','H','*','S','*','N','*','L'/
  40
  41 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  42 #include "zebra/debugvf2.inc"
  43 #endif
  44
  45
  46
  47
  48
  49
  50
  51       CHSTAK          = CQSTAK(MCQSIQ:)
  52       CQSTAK(MCQSIQ:) = CHROUT
  53
  54       INLINE = NLISTQ
  55       ILINE  = 1
  56       NLINES = MIN((ILAST-IFIRST)/NENLNQ+1,NLNGRQ)
  57       DO 5 I=1,NLINES
  58     5 CQMAP(I) = ' '
  59       CALL ZPAGE(IQPRNT,NLINES+2)
  60       CQLINE      = ' DATA part of bank'
  61       CQLINE(60:) = '--------------------'
  62       IF(IFLOPT(MPOSQQ).EQ.0) CALL DZTEXT(0,CDUMMQ,1)
  63
  64       JDATA  = 0
  65       JFOCUR = 0
  66       NWPRNT = 0
  67
  68
  69    10 ITYPE  = MFO(JFOCUR+1)
  70       IF (ITYPE.EQ.7)                                      GO TO 40
  71       NWSEC = MFO(JFOCUR+2)
  72       IF   (NWSEC)           20, 30, 60
  73
  74
  75    20 NWSEC = ILAST - JDATA
  76                                                            GO TO 60
  77
  78
  79    30 JDATA = JDATA + 1
  80       IWORD = IQ(KQS+LS+JDATA)
  81       NWSEC = IWORD
  82       IF (JDATA.GE.IFIRST) THEN
  83           WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
  84      +     '(I6,'' *'',A1,''('',I13,'')'')')
  85      +     JDATA,KFOTYP(MIN(ITYPE,6)),NWSEC
  86           NWPRNT = NWPRNT + 1
  87       ENDIF
  88                                                            GO TO 50
  89
  90
  91    40 JDATA = JDATA + 1
  92       IWORD = IQ(KQS+LS+JDATA)
  93       ITYPE = MOD (IWORD,16)
  94       NWSEC = IWORD/16
  95       IF (JDATA.GE.IFIRST) THEN
  96           WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
  97      +     '(I6,'' *S('',A1,'','',I11,'')'')')
  98      +     JDATA,KFOTYP(MIN(ITYPE,6)),NWSEC
  99           NWPRNT = NWPRNT + 1
 100       ENDIF
 101
 102    50 IF (JDATA.GE.IFIRST) THEN
 103           IF (       (INLINE.EQ.NLISTQ+(NENLNQ-1)*NLINEQ)
 104      X         .AND. (ILINE.EQ.NLINES)                    )  THEN
 105               IF (IFLOPT(MPOSQQ).NE.0)                     GO TO 999
 106               IF (NWPRNT.GT.NLNGRQ*NENLNQ) CALL DZTEXT(1,CDUMMQ,1)
 107               CALL DZTEXT(0,CDUMMQ,NLINES)
 108               INLINE = NLISTQ
 109               ILINE  = 1
 110               NLINES = MIN((ILAST-JDATA-1)/NENLNQ+1,NLNGRQ)
 111               DO 55 I=1,NLINES
 112    55         CQMAP(I) = ' '
 113           ELSEIF (ILINE.EQ.NLINES) THEN
 114               ILINE  = 1
 115               INLINE = INLINE + NLINEQ
 116           ELSE
 117               ILINE  = ILINE + 1
 118           ENDIF
 119       ENDIF
 120
 121       IF (ITYPE.GE.8) THEN
 122           ITYPE      = 0
 123           NWSEC      = ILAST - JDATA
 124           IQUEST(11) = -ITYPE
 125       ELSEIF (NWSEC.EQ.0) THEN
 126           ITYPE      = 0
 127                                                            GO TO 900
 128       ELSEIF (NWSEC.LT.0) THEN
 129           ITYPE      = 0
 130           NWSEC      = ILAST - JDATA
 131           IQUEST(11) = -ITYPE-32
 132       ENDIF
 133
 134
 135    60 IDBLE  = 0
 136       DO 100 I=MAX(JDATA+1,IFIRST),MIN(JDATA+NWSEC,ILAST)
 137           IWORD = IQ(KQS+LS+I)
 138           IF (IDBLE.EQ.1)           THEN
 139               WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
 140      +                      '(I6,1X,A,'')'')') NWPRNT+IFIRST,CDWORD(16:)
 141               IDBLE  = 0
 142           ELSEIF (ITYPE.EQ.IFOHOQ)  THEN
 143               WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
 144      +                      '(I6,5X,''"'',A12)') NWPRNT+IFIRST,IWORD
 145           ELSEIF (ITYPE.EQ.IFOINQ)  THEN
 146               WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
 147      +                               '(I6,I18)') NWPRNT+IFIRST,IWORD
 148           ELSEIF (ITYPE.EQ.IFOFLQ)  THEN
 149               WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
 150      +                             '(I6,G18.8)') NWPRNT+IFIRST,RWORD
 151           ELSEIF (ITYPE.EQ.IFODOQ)  THEN
 152               CALL UCOPY(Q(KQS+LS+I),DWORD,2)
 153               WRITE(CDWORD,'(D31.24)') DWORD
 154               WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
 155      +                '(I6,1X,''D('',A)') NWPRNT+IFIRST,CDWORD(:15)
 156               IDBLE  = 1
 157           ELSE
 158               WRITE(CQMAP(ILINE)(INLINE+1:INLINE+NLINEQ),
 159      +                        '(I6,'' Z'',Z16)') NWPRNT+IFIRST,IWORD
 160           ENDIF
 161           NWPRNT = NWPRNT + 1
 162
 163           IF (       (INLINE.EQ.NLISTQ+(NENLNQ-1)*NLINEQ)
 164      X         .AND. (ILINE.EQ.NLINES)                    )  THEN
 165               IF (IFLOPT(MPOSQQ).NE.0)                     GO TO 999
 166               IF (NWPRNT.GT.NLNGRQ*NENLNQ) CALL DZTEXT(1,CDUMMQ,1)
 167               CALL DZTEXT(0,CDUMMQ,NLINES)
 168               INLINE = NLISTQ
 169               ILINE  = 1
 170               NLINES = MIN((ILAST-NWPRNT-1)/NENLNQ+1,NLNGRQ)
 171               DO 65 J=1,NLINES
 172    65         CQMAP(J) = ' '
 173           ELSEIF (ILINE.EQ.NLINES) THEN
 174               ILINE  = 1
 175               INLINE = INLINE + NLINEQ
 176           ELSE
 177               ILINE  = ILINE + 1
 178           ENDIF
 179
 180   100 CONTINUE
 181
 182
 183       JDATA = JDATA + NWSEC
 184
 185       IF (JDATA.GE.ILAST)                                  GO TO 900
 186
 187       IF (JDATA.LT.ILAST)   THEN
 188           JFOCUR = JFOCUR + 2
 189           IF (JFOCUR.LT.JFOEND)                            GO TO 10
 190           JFOCUR = JFOREP
 191                                                            GO TO 10
 192       ENDIF
 193
 194
 195   900 IF (IFLOPT(MPOSQQ).NE.0)                             GO TO 999
 196           IF (INLINE.NE.NLISTQ.OR.ILINE.NE.1) THEN
 197               IF (NWPRNT.GT.NLNGRQ*NENLNQ) CALL DZTEXT(1,CDUMMQ,1)
 198               CALL DZTEXT(0,CDUMMQ,NLINES)
 199           ENDIF
 200
 201   999 CQSTAK(MCQSIQ:) = CHSTAK
 202       END