]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.2 1996/04/24 17:26:18 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 DZSURV (CHTEXT,IXDIV,LBANK) | |
19 | SAVE NWDES | |
20 | #include "zebra/bankparq.inc" | |
21 | #include "zebra/divparq.inc" | |
22 | #include "zebra/questparq.inc" | |
23 | #include "zebra/mqsys.inc" | |
24 | #include "zebra/qequ.inc" | |
25 | #include "zebra/mzcn.inc" | |
26 | #include "zebra/zbcd.inc" | |
27 | #include "zebra/zbcdk.inc" | |
28 | #include "zebra/zunit.inc" | |
29 | #include "zebra/dzc1.inc" | |
30 | DIMENSION NEWID(10) | |
31 | ||
32 | CHARACTER CHTEXT*(*) | |
33 | ||
34 | CHARACTER CHROUT*(*) | |
35 | PARAMETER (CHROUT = 'DZSURV') | |
36 | ||
37 | #include "zebra/q_jbit.inc" | |
38 | ||
39 | #if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT)) | |
40 | #include "zebra/debugvf2.inc" | |
41 | #endif | |
42 | ||
43 | DATA NWDES / 4 / | |
44 | ||
45 | ||
46 | CQSTAK = CHROUT//'/' | |
47 | IQUEST(1) = 0 | |
48 | ||
49 | CALL MZSDIV (IXDIV,-1) | |
50 | ||
51 | ||
52 | IF (LBANK.EQ.0) GO TO 999 | |
53 | IF (JBIT(IQ(LBANK+KQS),IQDROP).EQ.1) GO TO 999 | |
54 | ||
55 | LSTART = LBANK | |
56 | ||
57 | CALL MZCHLS(NCHEKQ,LSTART) | |
58 | IF (IQFOUL.NE.0) GO TO 91 | |
59 | IDSTR = IQID | |
60 | ||
61 | ||
62 | IF (CHTEXT.NE.CDUMMQ.AND.CHTEXT.NE.'-') THEN | |
63 | CALL ZPAGE(IQPRNT,7) | |
64 | CQMAP(1) = ' ' | |
65 | CQMAP(2) = ' DZSURV --- ' | |
66 | CQMAP(2)(13:99) = CHTEXT | |
67 | WRITE(CQMAP(2)(100:),'('' ST= '',2A4,'' LSTART= '',I8)') | |
68 | X NQPNAM(KQT+1),NQPNAM(KQT+2),LSTART | |
69 | CALL DZTEXT(0,CDUMMQ,2) | |
70 | ENDIF | |
71 | ||
72 | IF (CHTEXT.NE.'-') THEN | |
73 | CALL ZPAGE(IQPRNT,5) | |
74 | CQMAP(1) = ' ' | |
75 | CQMAP(2) = ' NWCUM NW WBK NBK IDENTIFIER(S)' | |
76 | CQMAP(3) = ' ' | |
77 | CALL DZTEXT(0,CDUMMQ,3) | |
78 | ENDIF | |
79 | ||
80 | MAXALL = 0 | |
81 | DO 20 I=1,NDVMXQ | |
82 | IF(I.LE.JQDVLL.OR.I.GE.JQDVSY) | |
83 | I MAXALL = MAXALL + LQEND(KQT+I) - LQSTA(KQT+I) | |
84 | 20 CONTINUE | |
85 | NBCUM = 0 | |
86 | NWCUM = 0 | |
87 | NEWNW = 0 | |
88 | NEWND = 0 | |
89 | NEWNBK = 0 | |
90 | NEWRIN = IQBLAN | |
91 | NEWLOW = 99 | |
92 | NEWUP = 1 | |
93 | NEWNID = 0 | |
94 | NEWID(1) = 0 | |
95 | NEWLEV = 1 | |
96 | LEVELH = 0 | |
97 | LTAB1 = NQOFFT(1) | |
98 | LEND1 = LQEND(LTAB1+1) | |
99 | LWORK = LQWKTB | |
100 | NWORK = NQWKTB | |
101 | NLVMAX = NWORK/NWDES | |
102 | LDESC = LWORK - NWDES | |
103 | LKBCD = IQBLAN | |
104 | LGO = LSTART | |
105 | L = LSTART | |
106 | ||
107 | GO TO 52 | |
108 | 31 NEWLEV = NEWLEV - 1 | |
109 | ||
110 | IF (CHTEXT.NE.'-') CALL DZTEXT(1,CDUMMQ,1) | |
111 | ||
112 | IF (NEWLEV.EQ.1) GO TO 9991 | |
113 | LDESC = LDESC - NWDES | |
114 | 34 IF (LQ(LDESC).EQ.LQ(LDESC+1)) GO TO 31 | |
115 | LQ(LDESC) = LQ(LDESC) + 1 | |
116 | 39 CALL VBLANK (IQUEST(2),3) | |
117 | CALL USET (LQ(LDESC),IQUEST,2,4) | |
118 | IQUEST(1) = IQMINS | |
119 | CALL URIGHT (IQUEST,1,4) | |
120 | CALL UBUNCH (IQUEST,LKBCD,4) | |
121 | NEWNW = 0 | |
122 | NEWND = 0 | |
123 | NEWNBK = 0 | |
124 | NEWRIN = IQBLAN | |
125 | NEWLOW = 99 | |
126 | NEWUP = 1 | |
127 | NEWNID = 0 | |
128 | NEWID(1) = 0 | |
129 | LEVELH = 1 | |
130 | LDESH = LWORK | |
131 | LGO = LSTART | |
132 | GO TO 42 | |
133 | 41 LEVELH = LEVELH + 1 | |
134 | LDESH = LDESH + NWDES | |
135 | 42 JFOLL = LQ(LDESH) | |
136 | LQ(LDESH+2) = LGO | |
137 | LQ(LDESH+3) = LGO | |
138 | LM = LGO | |
139 | GO TO 46 | |
140 | 43 NEWRIN = IQLETT(MPOSRQ) | |
141 | 44 IF (LEVELH.EQ.0) GO TO 71 | |
142 | 45 LM = LQ(LM+KQS) | |
143 | IF (LM.EQ.0) GO TO 47 | |
144 | IF (LM.EQ.LQ(LDESH+3)) GO TO 47 | |
145 | 46 CALL MZCHLS (NCHEKQ,LM) | |
146 | IF (IQFOUL.NE.0) GO TO 91 | |
147 | IF (IQNS-JFOLL.LT.0) GO TO 45 | |
148 | LQ(LDESH+2) = LM | |
149 | K = LM - JFOLL | |
150 | LGO = LQ(K+KQS) | |
151 | ||
152 | IF (LGO.EQ.0) GO TO 45 | |
153 | IF (LEVELH+1.LT.NEWLEV) GO TO 41 | |
154 | L = LGO | |
155 | GO TO 52 | |
156 | 47 LEVELH = LEVELH - 1 | |
157 | IF (LEVELH.EQ.0) GO TO 71 | |
158 | LDESH = LDESH - NWDES | |
159 | JFOLL = LQ(LDESH) | |
160 | LM = LQ(LDESH+2) | |
161 | GO TO 45 | |
162 | 51 K = L | |
163 | L = LQ(K+KQS) | |
164 | IF (L.EQ.0) GO TO 44 | |
165 | IF (L.EQ.LGO) GO TO 43 | |
166 | 52 CALL MZCHLS(NCHEKQ,L) | |
167 | IF (IQFOUL.NE.0) GO TO 91 | |
168 | NEWNBK = NEWNBK + 1 | |
169 | N = NBKOHQ + IQNL + IQND | |
170 | NEWND = MAX(NEWND,N) | |
171 | NEWNW = NEWNW + N | |
172 | IF (NEWNW.GE.MAXALL) GO TO 71 | |
173 | IF (IQID.EQ.NEWID(1)) GO TO 57 | |
174 | IF (NEWNID.EQ.0) GO TO 56 | |
175 | IF (NEWNID.EQ.10) GO TO 57 | |
176 | IF (IUCOMP(IQID,NEWID,NEWNID).NE.0) GO TO 57 | |
177 | 56 NEWNID = NEWNID + 1 | |
178 | NEWID(NEWNID) = IQID | |
179 | 57 IF (IQNS.EQ.0) GO TO 51 | |
180 | N = MIN(NEWLOW-1,IQNS) | |
181 | DO 62 J=1,N | |
182 | IF (LQ(L-J+KQS).NE.0) THEN | |
183 | NEWLOW = J | |
184 | GO TO 64 | |
185 | ENDIF | |
186 | 62 CONTINUE | |
187 | 64 JA = MAX(NEWLOW,NEWUP) + 1 | |
188 | DO 65 J=JA,IQNS | |
189 | IF (LQ(L-J+KQS).NE.0) NEWUP=J | |
190 | 65 CONTINUE | |
191 | ||
192 | GO TO 51 | |
193 | 71 IF (NEWNBK.EQ.0) GO TO 75 | |
194 | NBCUM = NBCUM + NEWNBK | |
195 | NWCUM = NWCUM + NEWNW | |
196 | CALL VBLANK(IQUEST,NEWLEV) | |
197 | IQUEST(NEWLEV) = LKBCD | |
198 | NEWNID = MIN(NEWNID,21-NEWLEV) | |
199 | IF (CHTEXT.NE.'-') THEN | |
200 | WRITE(CQLINE,'(1X,2I7,I6,I5,2(1X,A1),20(1X,A4))') | |
201 | W NWCUM,NEWNW,NEWND,NEWNBK,NEWRIN | |
202 | W, (IQUEST(J),J=1,NEWLEV) | |
203 | W, (NEWID(J), J=1,NEWNID) | |
204 | CALL DZTEXT(0,CDUMMQ,1) | |
205 | ENDIF | |
206 | ||
207 | IF (NWCUM.GT.MAXALL) THEN | |
208 | WRITE(CQINFO,'(I10,''/'',I10)') NWCUM,MAXALL | |
209 | CALL DZTEXT(MSHO1Q,CDUMMQ,0) | |
210 | IQUEST(1) = 1 | |
211 | GO TO 999 | |
212 | ENDIF | |
213 | ||
214 | IF (NEWLOW.GE.64) GO TO 75 | |
215 | IF (NEWLEV.GE.NLVMAX) GO TO 74 | |
216 | NEWLEV = NEWLEV + 1 | |
217 | LDESC = LDESC + NWDES | |
218 | LQ(LDESC) = NEWLOW | |
219 | LQ(LDESC+1) = MAX(NEWLOW,NEWUP) | |
220 | GO TO 39 | |
221 | 74 CALL DZTEXT(MSUR1Q,CDUMMQ,0) | |
222 | 75 IF (NEWLEV.NE.1) GO TO 34 | |
223 | GO TO 9991 | |
224 | 91 IQUEST(1) = LGO | |
225 | IQUEST(2) = K | |
226 | IQUEST(3) = L | |
227 | CALL ZFATAM (CHROUT) | |
228 | ||
229 | ||
230 | 9991 IF (CHTEXT.NE.'-') THEN | |
231 | WRITE(CQMAP,'(1X,/,'' DZSURV --- The structure supported by'', | |
232 | + '' bank '',A4,'' at '',I10,'' in store '',2A4,'' occupies '', | |
233 | + I10,'' words in '',I6,'' banks '')') | |
234 | + IDSTR,LSTART,NQPNAM(KQT+1),NQPNAM(KQT+2),NWCUM,NBCUM | |
235 | CALL DZTEXT(0,CDUMMQ,2) | |
236 | ENDIF | |
237 | IQUEST(11) = IDSTR | |
238 | IQUEST(12) = LSTART | |
239 | IQUEST(13) = NQPNAM(KQT+1) | |
240 | IQUEST(14) = NQPNAM(KQT+2) | |
241 | IQUEST(15) = NWCUM | |
242 | IQUEST(16) = NBCUM | |
243 | 999 RETURN | |
244 | END |