]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 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 |