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