MINICERN/packlib/zebra/dzebra/dzmap.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:12  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:07  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 DZMAP
  22 #include "zebra/bankparq.inc"
  23 #include "zebra/divparq.inc"
  24 #include "zebra/storparq.inc"
  25 #include "zebra/mqsys.inc"
  26 #include "zebra/qequ.inc"
  27 #include "zebra/mzcn.inc"
  28 #include "zebra/zbcd.inc"
  29 #include "zebra/zbcdk.inc"
  30 #include "zebra/zunit.inc"
  31 #include "zebra/dzc1.inc"
  32
  33
  34       PARAMETER ( NLMAPQ = 7 )
  35       PARAMETER ( ISIDEQ = 6 )
  36       PARAMETER ( ILINKQ = 15)
  37       PARAMETER ( NLINKQ = 14)
  38       PARAMETER ( IMAD1Q = 1 , IMAD2Q= 8)
  39       PARAMETER ( IMTG1Q = 9 , IMTG2Q= 9)
  40       PARAMETER ( IMID1Q = 10, IMID2Q= 13)
  41
  42       CHARACTER CHROUT*(*),CHSTAK*6
  43       PARAMETER (CHROUT = 'DZMAP' )
  44
  45 #include "zebra/q_jbit.inc"
  46
  47 #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
  48 #include "zebra/debugvf2.inc"
  49 #endif
  50
  51
  52       CHSTAK          = CQSTAK(MCQSIQ:)
  53       CQSTAK(MCQSIQ:) = CHROUT
  54
  55       IDOPT  = IFLOPT(MPOSDQ)
  56
  57
  58       IF (LN.GT.0)      THEN
  59           CALL MZCHLN(NCHEKQ,LN)
  60           IF (IQFOUL.NE.0)                                 GO TO 998
  61       ELSE
  62           CALL MZCHLS(NCHEKQ,LS)
  63           IF (IQFOUL.NE.0)                                 GO TO 998
  64       ENDIF
  65
  66       IF (IQND.LT.0) THEN
  67           IF (IFLOPT(MPOSHQ).NE.0) THEN
  68
  69 #if !defined(CERNLIB_OCTMAP)
  70               WRITE(CQLINE,
  71      W         '(1X,''(*HO*'',1X,I8,''('',Z8,
  72      W          '') -- HOLE of '',I8,'' words'')') IQLN,(IQLN+LQSTOR)
  73 #else
  74               WRITE(CQLINE,
  75      W         '(1X,''(*HO*'',1X,I8,''('',O8,
  76      W          '') -- HOLE of '',I8,'' words'')') IQLN,(IQLN+LQSTOR)
  77 #endif
  78 *              MAP addresses are in BYTES
  79 #if !defined(CERNLIB_WORDMAP)
  80      W                                                               *4
  81 #endif
  82      W          ,-IQND
  83
  84               CALL DZTEXT(0,CDUMMQ,1)
  85           ENDIF
  86           LX = IQNX
  87                                                            GO TO 999
  88       ELSE
  89           LS = IQLS
  90           NL = IQNL
  91           NS = IQNS
  92           ND = IQND
  93           LX = IQNX
  94       ENDIF
  95
  96       IF (IFLOPT(MPOSKQ).EQ.0)         THEN
  97           JDROP  = JBIT(IQ(KQS+IQLS),IQDROP)
  98       ELSE
  99           JDROP  = 0
 100       ENDIF
 101       MARKD  = 0
 102       IF (JDROP.EQ.0)                  THEN
 103           IF(IFLOPT(MPOSDQ).NE.0)          THEN
 104               MARKD = JRSBYT(0,IQ(KQS+LS),IQMARK,1)
 105               IFLOPT(MPOSDQ) = 0
 106           ENDIF
 107           IF(IFLOPT(MPOSCQ).NE.0)          THEN
 108               MARKD = JRSBYT(0,IQ(KQS+LS),IQCRIT,1) + MARKD
 109           ENDIF
 110           IF (MARKD+IFLOPT(MPOSFQ).NE.0)       THEN
 111               IFLOPT(MPOSDQ) = 1
 112               CALL DZSHPR(LS,0,0,0,0)
 113                                                            GO TO 999
 114           ENDIF
 115           IF (MARKD+IFLOPT(MPOSEQ).NE.0)       THEN
 116               IFLOPT(MPOSDQ) = 1
 117               CALL DZSHPR(LS,0,0,0,-1)
 118                                                            GO TO 999
 119           ENDIF
 120       ENDIF
 121
 122       CALL DZBKHD
 123       IF (IQUEST(1).NE.0)                                  GO TO 998
 124
 125
 126       IF (NL.EQ.0)                                         GO TO 999
 127
 128
 129       CQLINE = '      . LINKS'
 130       LAST   = LS - NL
 131       L      = LAST
 132
 133       DO 43 J=1,NL
 134           IF (LQ(L+KQS).NE.0)                              GO TO 44
 135    43 L = L+1
 136    44 NP= LS - L
 137
 138       IF (NP.EQ.0)                                         GO TO 999
 139
 140       IF (NP.GT.NLMAPQ)                 THEN
 141           CQLINE(ISIDEQ+1:ISIDEQ+1) = '+'
 142           NP    = NLMAPQ
 143       ENDIF
 144
 145       IF (JDROP.NE.0) CQLINE(ISIDEQ:ISIDEQ+1) = '**'
 146
 147       L = LS + KQS
 148       DO 50  J=1,NP
 149           I       = (J-1)*NLINKQ + ILINKQ
 150           LINK    = LQ (L-J)
 151           WRITE(CQLINE(I+IMAD1Q:I+IMAD2Q),'(I8)') LINK
 152           IF (LINK.EQ.LNULL)                               GO TO 50
 153           CALL MZCHLS(NCHEKQ,LINK)
 154           WRITE(CQLINE(I+IMID1Q:I+IMID2Q),'(A4)') IQID
 155
 156           IF (IQFOUL.EQ.0)                 THEN
 157               IF (JBIT(IQ(KQS+LINK),IQDROP).NE.0)   THEN
 158                   CQLINE(I+IMTG1Q:I+IMTG2Q) = '('
 159                   IF (JDROP.EQ.0) CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
 160                   IF (IQND.LT.0)  CQLINE(I+IMID1Q:I+IMID2Q) = '*HO*'
 161               ELSE
 162                   IF (JDROP.NE.0.AND.J.LE.NS.AND.J.GT.1)        THEN
 163                       CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
 164                   ENDIF
 165               ENDIF
 166           ELSEIF (IQFOUL.GT.0)             THEN
 167               IF (J.LE.NS)                     THEN
 168                   CQLINE(I+IMID1Q:I+IMID2Q) = '****'
 169                   CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
 170               ELSE
 171                   CQLINE(I+IMID1Q:I+IMID2Q) = '-'
 172               ENDIF
 173           ELSE
 174               CQLINE(I+IMID1Q:I+IMID2Q) = '****'
 175               CQLINE(ISIDEQ+1:ISIDEQ+1) = 'F'
 176           ENDIF
 177
 178    50 CONTINUE
 179
 180
 181       CALL DZTEXT(0,CDUMMQ,1)
 182
 183                                                            GO TO 999
 184
 185   998 IQUEST(1) = 1
 186
 187   999 IFLOPT(MPOSDQ) = IDOPT
 188       CQSTAK(MCQSIQ:) = CHSTAK
 189       END