]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/mq/mzlift.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / mq / mzlift.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/18 16:11:37 mclareni
6* Incorporate changes from J.Zoll for version 3.77
7*
8* Revision 1.1.1.1 1996/03/06 10:47:18 mclareni
9* Zebra
10*
11*
12#include "zebra/pilot.h"
13 SUBROUTINE MZLIFT (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO)
14
15C- Lift a bank, user called
16
17#include "zebra/zmach.inc"
18#include "zebra/zstate.inc"
19#include "zebra/zunit.inc"
20#include "zebra/zvfaut.inc"
21#include "zebra/mqsys.inc"
22#include "zebra/eqlqmst.inc"
23#include "zebra/eqlqform.inc"
24#include "zebra/mzcl.inc"
25#include "zebra/mzcn.inc"
26#include "zebra/mzct.inc"
27C-------------- End CDE --------------
28 DIMENSION IXDIV(9), LP(9), LSUPP(9), NAME(9)
29#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
30 DIMENSION NAMESR(2)
31 DATA NAMESR / 4HMZLI, 4HFT /
32#endif
33#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
34 DATA NAMESR / 6HMZLIFT /
35#endif
36#if !defined(CERNLIB_QTRHOLL)
37 CHARACTER NAMESR*8
38 PARAMETER (NAMESR = 'MZLIFT ')
39#endif
40
41#include "zebra/q_jbit.inc"
42#include "zebra/q_jbyt.inc"
43#include "zebra/q_sbyt.inc"
44#include "zebra/q_shiftl.inc"
45#include "zebra/q_locf.inc"
46
47
48#include "zebra/qtrace.inc"
49#if defined(CERNLIB_QDEBUG)
50 IF (IQVSTA.NE.0) CALL ZVAUTX
51#endif
52
53C-- Copy parameters
54
55 IF (JBIAS.NE.63) THEN
56 NQBIA = JBIAS
57 NIO = JBYT (NAME(5),12,4)
58 CALL UCOPY (NAME,NQID,NIO+5)
59 IF (NIO.NE.0) NQIOSV(1)=0
60 ENDIF
61
62 JDV = IXDIV(1)
63 LQSUP = LSUPP(1)
64 IF (NQBIA.GE.2) LQSUP = 0
65 ICHORG = NQIOCH(1)
66 NTOT = NQNL + NQND + 10
67
68 IF (JDV.EQ.-7) GO TO 24
69 IF (JBYT(JDV,27,6).NE.JQSTOR) GO TO 22
70 JQDIVI = JBYT (JDV,1,26)
71 IF (JQDIVI.LT.21) GO TO 23
72 22 CALL MZSDIV (JDV,0)
73 23 CALL MZCHNB (LP)
74 24 CONTINUE
75
76C-- Check bank parameters
77
78#if defined(CERNLIB_QDEBUG)
79 J = JBYT (NQID,IQBITW-7,8)
80 IF (J.EQ.0) GO TO 91
81 IF (J.EQ.255) GO TO 91
82 IF (NTOT.GE.LQSTA(KQT+21)) GO TO 91
83 IF (NQNS.GT.NQNL) GO TO 91
84 IF (NQNS.LT.0) GO TO 91
85 IF (NQNL.GT.64000) GO TO 91
86 IF (NQND.LT.0) GO TO 91
87 IF (NQBIA.GE.3) GO TO 91
88
89 IF (LQSUP.EQ.0) GO TO 25
90 CALL MZCHLS (-7,LQSUP)
91 IF (IQFOUL.NE.0) GO TO 92
92 IF (NQBIA.EQ.1) GO TO 26
93 IF (JBIT(IQ(KQS+LQSUP),IQDROP).NE.0) GO TO 92
94 IF (IQNS+NQBIA.LT.0) GO TO 93
95 GO TO 26
96
97 25 IF (NQBIA.LE.0) GO TO 92
98 26 CONTINUE
99#endif
100
101C---- Find LNEXT, future 'next' bank
102C- LSAME, a bank in the same linear structure
103C- LS, division selecting bank
104C- IDN, numeric ID
105
106 IDN = 1
107 LS = LQSUP
108 LSAME = LQSUP
109 LNEXT = LQSUP
110 IF (NQBIA.GT.0) GO TO 38
111 LNEXT = LQ(KQS+LNEXT+NQBIA)
112 IF (LNEXT.EQ.0) GO TO 36
113 LSAME = LNEXT
114 LS = LNEXT
115#if defined(CERNLIB_QDEBUG)
116 CALL MZCHLS (-7,LNEXT)
117 IF (IQFOUL.NE.0) GO TO 94
118#endif
119 IDN = IQ(KQS+LNEXT-5) + 1
120 GO TO 39
121
122 36 IF (NQBIA.EQ.0) GO TO 37
123 LSAME = 0
124 IDN = -NQBIA
125 GO TO 39
126
127 37 IDN = IQ(KQS+LSAME-5) + 1
128 GO TO 39
129
130 38 IF (LNEXT.NE.0) IDN=IQ(KQS+LNEXT-5)+1
131 39 CONTINUE
132
133C---- Ready I/O characteristic
134
135 IF (ICHORG.LT.0) GO TO 47
136
137C-- Immediate
138
139 IF (ICHORG.LT.8) THEN
140 NQNIO = 0
141 NQIOCH(1) = ISHFTL (ICHORG, 16)
142 GO TO 49
143 ENDIF
144
145C-- Copy characteristic from sister bank
146
147 IF (ICHORG-11) 45, 43, 47
148 43 IF (LSAME.EQ.0) GO TO 45
149#if !defined(CERNLIB_QDEBUG)
150 NQNIO = JBYT (IQ(KQS+LSAME),19,4)
151 IQLN = LSAME - (NQNIO+IQ(KQS+LSAME-3)+1)
152#endif
153#if defined(CERNLIB_QDEBUG)
154 NQNIO = IQNIO
155#endif
156 IF (NQNIO.EQ.0) THEN
157 NQIOCH(1) = LQ(KQS+IQLN)
158 GO TO 49
159 ELSE
160 CALL UCOPY (LQ(KQS+IQLN),NQIOCH,NQNIO+1)
161 NQIOSV(1) = 0
162 GO TO 49
163 ENDIF
164
165C-- Find index to characteristic according to IDH
166
167 45 LID = LQFORM
168 IF (LID.EQ.0) GO TO 95
169 LIOD = LQ(KQSP+LID-2)
170 IF (NQID.LT.0) LID=LQ(KQSP+LID)
171
172C-- Same as last
173
174 IF (NQID.EQ.IQ(KQSP+LID+3)) THEN
175 IXIO = IQ(KQSP+LID+2)
176 ELSE
177
178C-- Search
179
180 N = IQ(KQSP+LID+1)
181 IF (N.EQ.0) GO TO 95
182 J = IUCOMP (NQID,IQ(KQSP+LID+4),N)
183 IF (J.EQ.0) GO TO 95
184
185 LIX = LQ(KQSP+LID-1)
186 IXIO = IQ(KQSP+LIX+J)
187 IQ(KQSP+LID+2) = IXIO
188 IQ(KQSP+LID+3) = NQID
189 ENDIF
190
191 NQNIO = JBYT (IQ(KQSP+LIOD+IXIO+1),7,5) - 1
192 GO TO 48
193
194C-- Parameter is characteristic or index
195
196 47 J = JBYT (ICHORG,1,6)
197 NQNIO = JBYT (ICHORG,7,5) - 1
198 IOTH = JBYT (ICHORG,12,5)
199 IF (J.EQ.1) THEN
200 IF (NQNIO.NE.IOTH) GO TO 96
201 GO TO 49
202 ENDIF
203
204C-- Index
205
206 IF (J.NE.2) GO TO 96
207 IF (IOTH.NE.0) GO TO 96
208 IXIO = JBYT (ICHORG,17,16)
209 IF (IXIO.EQ.0) GO TO 96
210
211 LIOD = LQ(KQSP+LQFORM-2)
212 IF (IXIO.GE.IQ(KQSP+LIOD+1)) GO TO 96
213
214C-- Same characteristic as previously lifted bank
215
216 48 IF (IXIO.EQ.NQIOSV(1)) THEN
217 NQIOCH(1) = NQIOSV(2)
218 GO TO 49
219 ENDIF
220
221C-- Copy characteristic
222
223 NQIOSV(1) = 0
224 IF (NQNIO.GE.16) GO TO 96
225 CALL UCOPY (IQ(KQSP+LIOD+IXIO+1),NQIOCH,NQNIO+1)
226 IOTH = JBYT (NQIOCH(1),12,5)
227 IF (NQNIO.NE.IOTH) GO TO 96
228 NQIOSV(1) = IXIO
229 NQIOSV(2) = NQIOCH(1)
230
231 49 NTOT = NTOT + NQNIO
232
233C------ Select division
234
235 IF (JQDIVI.NE.0) GO TO 59
236 IF (LS.LT.LQSTA(KQT+1)) GO TO 58
237 IF (LS.GE.LQEND(KQT+20)) GO TO 58
238 IF (LS.GE.LQEND(KQT+JQDVLL)) GO TO 54
239 IF (LS.LT.LQEND(KQT+2)) GO TO 57
240 JQDIVI = 3
241 GO TO 55
242
243 54 JQDIVI = JQDVSY
244 55 IF (LS.LT.LQEND(KQT+JQDIVI)) GO TO 61
245 JQDIVI = JQDIVI + 1
246 GO TO 55
247
248 57 JQDIVI = 1
249 IF (LS.LT.LQSTA(KQT+2)) GO TO 61
250 58 JQDIVI = 2
251 GO TO 61
252
253 59 IF (LSAME.EQ.0) GO TO 61
254 IF (LSAME.LT.LQSTA(KQT+JQDIVI)) GO TO 97
255 IF (LSAME.GE.LQEND(KQT+JQDIVI)) GO TO 97
256
257C------ Allocate space
258
259 61 CALL MZRESV
260 NQRESV = NQRESV - NTOT
261 IF (NQRESV.LT.0) GO TO 81
262 IF (JQMODE.NE.0) GO TO 63
263
264C-- Division is mode forward
265
266 NQLN = LQEND(KQT+JQDIVI)
267 LE = NQLN + NTOT
268 LQEND(KQT+JQDIVI) = LE
269 GO TO 65
270
271C-- Division is mode reverse
272
273 63 LE = LQSTA(KQT+JQDIVI)
274 NQLN = LE - NTOT
275 LQSTA(KQT+JQDIVI) = NQLN
276
277C---- Construct bank
278
279 65 NZ = MIN (NZERO,NQND)
280 IF (NZ.EQ.0) NZ=NQND
281 IF (NZ.LT.0) NZ=0
282
283 NST = NQNIO + NQNL
284 NQLS = NQLN + NST + 1
285 CALL VZERO (LQ(KQS+NQLN+NQNIO+1),NQNL+NZ+9)
286
287 NQIOCH(1) = MSBYT (NST+12,NQIOCH(1),1,16)
288 DO 67 J=0,NQNIO
289 67 LQ(KQS+NQLN+J) = NQIOCH(J+1)
290
291 IQ(KQS+NQLS-5) = IDN
292 IQ(KQS+NQLS-4) = NQID
293 IQ(KQS+NQLS-3) = NQNL
294 IQ(KQS+NQLS-2) = NQNS
295 IQ(KQS+NQLS-1) = NQND
296 IQ(KQS+NQLS) = ISHFTL (NQNIO,18)
297
298C------ Set up how to link
299
300 IF (NQBIA-1) 72, 73, 79
301
302C-- JBIAS -ve, insert into tree
303
304 72 LUP = LQSUP
305 KADR = LQSUP + NQBIA
306 LNEXT = LQ(KQS+KADR)
307 IF (NQBIA.NE.0) GO TO 77
308 LUP = LQ(KQS+LUP+1)
309 GO TO 77
310
311C-- JBIAS = +1, add to linear structure
312
313 73 LNEXT = LQSUP
314 IF (LNEXT.NE.0) GO TO 74
315 LUP = 0
316 KADR = LOCF (LSUPP(1)) - LQSTOR
317#if defined(CERNLIB_APOLLO)
318 KADR = RSHFT (IADDR(LSUPP(1)),2) - LQSTOR
319#endif
320 IF (KADR.LT.LQSTA(KQT+1)) GO TO 78
321 IF (KADR.LT.LQSTA(KQT+21)) GO TO 98
322 GO TO 78
323
324 74 LUP = LQ(KQS+LNEXT+1)
325 KADR = LQ(KQS+LNEXT+2)
326
327C---- Link bank into structure
328
329 77 IF (LNEXT.EQ.0) GO TO 78
330 LQ(KQS+NQLS) = LNEXT
331 LQ(KQS+LNEXT+2) = NQLS
332
333 78 LQ(KQS+NQLS+1) = LUP
334 LQ(KQS+NQLS+2) = KADR
335
336 LQ(KQS+KADR) = NQLS
337
338 79 LP(1) = NQLS
339#if defined(CERNLIB_QDEBPRI)
340 IF (NQLOGL.GE.2)
341 + WRITE (IQLOG,9079) JQSTOR,JQDIVI,NQLS,LQSUP,NQBIA,
342 + NQID,NQNL,NQNS,NQND
343 9079 FORMAT (' MZLIFT- Store/Div',2I3,' L/LSUP/JBIAS=',2I9,I6,
344 F' ID,NL,NS,ND= ',A4,2I6,I9)
345#endif
346#include "zebra/qtrace99.inc"
347 RETURN
348
349C---- Garbage collection
350
351 81 LQMST(KQT+1) = LQSUP
352 CALL MZGAR1
353 LQSUP = LQMST(KQT+1)
354 IF (NQBIA.GE.1) GO TO 61
355 KADR = LOCF (LSUPP(1)) - LQSTOR
356#if defined(CERNLIB_APOLLO)
357 KADR = RSHFT (IADDR(LSUPP(1)),2) - LQSTOR
358#endif
359 IF (KADR.LT.LQSTA(KQT+1)) GO TO 83
360 IF (KADR.LT.LQSTA(KQT+21)) GO TO 61
361 83 LSUPP(1) = LQSUP
362 GO TO 61
363
364C---- Error conditions
365
366 98 NQCASE = 8
367 NQFATA = 1
368 IQUEST(18) = KADR
369 GO TO 90
370
371 97 NQCASE = 7
372 NQFATA = 1
373 IQUEST(18) = LSAME
374 GO TO 90
375
376 94 NQCASE = 4
377 NQFATA = 1
378 IQUEST(18) = LNEXT
379 GO TO 90
380
381 96 NQCASE = 1
382 95 NQCASE = NQCASE + 2
383 93 NQCASE = NQCASE + 1
384 92 NQCASE = NQCASE + 1
385 91 NQCASE = NQCASE + 1
386 90 NQFATA = NQFATA + 7
387 IQUEST(11) = LQSUP
388 IQUEST(12) = NQBIA
389 IQUEST(13) = NQID
390 IQUEST(14) = NQNL
391 IQUEST(15) = NQNS
392 IQUEST(16) = NQND
393 IQUEST(17) = ICHORG
394#include "zebra/qtofatal.inc"
395 END
396* ==================================================
397#include "zebra/qcardl.inc"