Mostly minor style modifications to be ready for cloning with EMCAL
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / jz91 / jzinit.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/18 16:11:06 mclareni
6* Incorporate changes from J.Zoll for version 3.77
7*
8* Revision 1.1.1.1 1996/03/06 10:47:16 mclareni
9* Zebra
10*
11*
12#include "zebra/pilot.h"
13 SUBROUTINE JZINIT (IXPARA,CHPA1,CHPA2,IPA3,IPA4,IPA5,IPA6)
14
15C- Initialize JZ91 package
16
17
18#include "zebra/zstate.inc"
19#include "zebra/zunit.inc"
20#include "zebra/mqsys.inc"
21#include "zebra/eqlqt.inc"
22#include "zebra/jzuc.inc"
23#include "zebra/jzc.inc"
24C-------------- END CDE ----------------- ------
25 DIMENSION IPA3(7),IPA4(7),IPA5(7),IPA6(7)
26 CHARACTER CHPA1*(*), CHPA2*(*)
27#if defined(CERNLIB_A4)
28 CHARACTER CHIAM*4
29#endif
30#if defined(CERNLIB_A8)
31 CHARACTER CHIAM*8
32#endif
33#if defined(CERNLIB_EQUHOLCH)
34 EQUIVALENCE (CHIAM, NQME(1))
35#endif
36
37 DIMENSION INIT(4), MEXTR(4)
38 EQUIVALENCE (INIT(1),JQTIME), (NACCE,NQME(6))
39 DIMENSION MMJZ91(5), MMCALL(5)
40#if defined(CERNLIB_QDEBUG)
41 DIMENSION MMFL(5)
42#endif
43#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
44 DIMENSION NAMESR(2)
45 DATA NAMESR / 4HJZIN, 4HIT /
46#endif
47#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
48 DATA NAMESR / 6HJZINIT /
49#endif
50#if !defined(CERNLIB_QTRHOLL)
51 CHARACTER NAMESR*8
52 PARAMETER (NAMESR = 'JZINIT ')
53#endif
54#if defined(CERNLIB_QDEBUG)
55
56 DATA MEND /4HEND /
57 DATA MMFL /4HJZFL, 0, 0, -7, 2 /
58#endif
59 DATA MMJZ91 /4HJZ91, -7, -7, -7, 2 /
60 DATA MMCALL /4HJZCA, -7, 0, -7, 0 /
61
62 DATA MJQAN/4HJZAN/, MJQFL/4HJZFL/
63
64#include "zebra/q_shiftl.inc"
65
66#include "zebra/qtraceq.inc"
67
68 IF (JQLEV.NE.-1) CALL ZFATAM ('re-init of JZ91.')
69 CALL VZERO (JQTIME,16)
70
71 CALL MZSDIV (IXPARA,-7)
72 JQSTJZ = JQSTOR
73 IXSTJZ = ISHFTL(JQSTJZ,26)
74
75 JQMLEV = IPA3(1)
76 JQCBNL = IPA4(1)
77 JQCBND = IPA5(1)
78
79 CALL UOPTC (CHPA2,'TQE',IQUEST)
80 JQTIME = IQUEST(1)
81 JQLLEV = 2
82 IF (IQUEST(2).NE.0) JQLLEV = 0
83 IF (IQUEST(3).NE.0) JQLLEV = 1
84
85 CHIAM = CHPA1
86#if !defined(CERNLIB_EQUHOLCH)
87 CALL UCTOH (CHIAM, NQME(1),4,4)
88#endif
89 NQME(2) = 10
90 NQME(3) = 10
91
92 N = IPA6(1)
93 IF (N.GE.0) THEN
94 N = MIN (N,5)
95 CALL UCOPY (IPA6(2),NQME(2),N)
96 ENDIF
97
98 IF (JQLLEV.GE.2) WRITE (IQLOG,9001) JQSTJZ,INIT
99 9001 FORMAT (/' JZINIT. JZ91 in store',I2,
100 F', IFTIME,MAXLEV,NL,ND =',7I6)
101
102 MMCALL(2) = JQCBNL
103 MMCALL(4) = JQCBND
104 JQNACC = 9 + NACCE
105 MEXTR(1) = 3
106 MEXTR(2) = NQME(3)
107 MEXTR(3) = NQME(4)
108 MEXTR(4) = NQME(5)
109
110C-- Lift division JZ91
111
112 NWINT = 1000
113 NWMAX = LQSTA(KQT+21) / 2
114 CALL MZDIV (IXSTJZ,IXDVJZ,'JZ91',NWINT,NWMAX,'ML')
115 CALL MZLINK (IXSTJZ,'JZ91',LQJZ,LQUP,LQAN)
116
117C---- Lift main bank
118
119 MMJZ91(2) = 2*JQMLEV + 6
120 MMJZ91(3) = JQMLEV + 5
121 MMJZ91(4) = 2*JQMLEV + 2
122 CALL MZLIFT (IXDVJZ,L,LQJZ,1,MMJZ91,0)
123 IQ(KQS+LQJZ+1) = NACCE
124
125C---- Lift the call banks
126
127 DO 24 J=1,JQMLEV
128 CALL MZLIFT (IXDVJZ,L,LQJZ,-J-5,MMCALL,0)
129 24 CONTINUE
130
131C---- Collect all JQAN titles
132
133 CALL TZINQ (IXSTJZ,IXDVTT,LQAN,1)
134 IF (LQAN.EQ.0) GO TO 49
135 CALL MZXREF (IXDVJZ,IXDVTT,'A')
136 GO TO 33
137
138 32 LQAN = LQ(KQS+LQAN)
139 33 IF (LQAN.EQ.0) GO TO 39
140 IF (IQ(KQS+LQAN-4).NE.MJQAN) GO TO 32
141
142 L = LZFIND (IXSTJZ,LQ(KQS+LQJZ-1), IQ(KQS+LQAN+1),1)
143 IF (L.NE.0) GO TO 34
144 L = LQAN
145 LQAN = LQ(KQS+LQAN)
146 CALL ZSHUNT (IXSTJZ,L,LQJZ,-1,0)
147 GO TO 33
148
149 34 CALL MZDROP (IXSTJZ,LQAN, '.')
150 GO TO 32
151
152 39 CALL ZTOPSY (IXSTJZ,LQ(KQS+LQJZ-1))
153
154C---- Digest all JQFL titles
155
156 LQAN = LQT(KQT+1)
157 GO TO 43
158
159 42 LQAN = LQ(KQS+LQAN)
160 43 IF (LQAN.EQ.0) GO TO 49
161 IF (IQ(KQS+LQAN-4).NE.MJQFL) GO TO 42
162
163#if defined(CERNLIB_QDEBUG)
164 JNEXT = 1
165 JMAX = IQ(KQS+LQAN-1)
166
167 44 IF (JNEXT.GT.JMAX) GO TO 47
168 JID = JNEXT
169 JEND = IUFIND (MEND,IQ(KQS+LQAN+1),JID+1,JMAX)
170 JNEXT = JEND + 1
171 ID = IQ(KQS+LQAN+JID)
172 IF (LZFIND(IXSTJZ,LQ(KQS+LQJZ-2),ID,1).NE.0) GO TO 44
173
174 IF (JID .NE.1) GO TO 45
175 IF (JEND.LE.JMAX) GO TO 45
176 L = LQAN
177 LQAN = LQ(KQS+LQAN)
178 CALL ZSHUNT (IXSTJZ,L, LQJZ,-2,0)
179 GO TO 33
180
181 45 MMFL(4) = MIN (JEND-JID,JQMFLW+1)
182 CALL MZLIFT (IXDVTT,L,LQJZ,-2,MMFL,-1)
183 CALL UCOPY (IQ(KQS+LQAN+JID),IQ(KQS+L+1),MMFL(4))
184 GO TO 44
185
186#endif
187 47 CALL MZDROP (IXSTJZ,LQAN, '.')
188 GO TO 42
189
190 49 CONTINUE
191
192C---- Lift the root level
193
194#if defined(CERNLIB_JZTIME)
195#include "zebra/jztimed.inc"
196#endif
197
198 JQREOD = 512
199 JQEALL = -JQREOD
200
201 CALL JZIN (CHIAM,1,NQME(2),MEXTR)
202
203#include "zebra/qtrace99.inc"
204 RETURN
205 END
206* ==================================================
207#include "zebra/qcardl.inc"