This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / jz91 / jzin.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.3  1996/04/24 17:26:30  mclareni
6 * Extend the include file cleanup to dzebra, rz and tq, and also add
7 * dependencies in some cases.
8 *
9 * Revision 1.2  1996/04/18 16:11:05  mclareni
10 * Incorporate changes from J.Zoll for version 3.77
11 *
12 * Revision 1.1.1.1  1996/03/06 10:47:17  mclareni
13 * Zebra
14 *
15 *
16 #include "zebra/pilot.h"
17       SUBROUTINE JZIN (CHPA1,IPA2,IPA3,IPA4)
18
19 C-    Processor down transfer
20
21 C-     CHPA1  processor ID in A4
22 C-      IPA2  = 0  no further down transfer
23 C-            = 1 yes further down transfer
24 C-      IPA3  NAN = number of processor constants
25 C-      IPA4  extra features
26 C-   IPA4(2)  NCR = number of conditions to be recorded
27 C-   IPA4(3)  NLS = number of wsp links to be saved
28 C-   IPA4(4)  NDS = number of wsp data words to be saved
29
30 #include "zebra/zstate.inc"
31 #include "zebra/zunit.inc"
32 #include "zebra/zvfaut.inc"
33 #include "zebra/mqsys.inc"
34 #include "zebra/jzuc.inc"
35 #include "zebra/jzc.inc"
36 C--------------    END CDE                             -----------------  ------
37       DIMENSION    IPA2(7),IPA3(7),IPA4(7)
38       CHARACTER    CHPA1*4
39 #if defined(CERNLIB_A4)
40       CHARACTER    CHIAM*4
41 #endif
42 #if defined(CERNLIB_A8)
43       CHARACTER    CHIAM*8
44 #endif
45 #if defined(CERNLIB_EQUHOLCH)
46       EQUIVALENCE (CHIAM, IAMID)
47 #endif
48
49       DIMENSION    MMJZFO(5)
50       PARAMETER   (MXREOD = 2097152)
51 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
52       DIMENSION    NAMESR(2)
53       DATA  NAMESR / 4HJZIN, 4H     /
54 #endif
55 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
56       DATA  NAMESR / 6HJZIN   /
57 #endif
58 #if !defined(CERNLIB_QTRHOLL)
59       CHARACTER    NAMESR*8
60       PARAMETER   (NAMESR = 'JZIN    ')
61 #endif
62       DATA  MMJZFO / 4HJZFO, 0, 0, 1, 2 /
63
64 #include "zebra/q_jbit.inc"
65
66 #include "zebra/qtraceq.inc"
67 #include "zebra/qstorjz.inc"
68 #if defined(CERNLIB_QDEBUG)
69       IF (IQVSTA.NE.0)       CALL ZVAUTX
70 #endif
71
72       CHIAM  = CHPA1
73 #if !defined(CERNLIB_EQUHOLCH)
74       CALL UCTOH (CHIAM, IAMID,4,4)
75 #endif
76       IAFLDW = IPA2(1)
77       MINIT  = 7
78       IF (LQSV.EQ.0)               GO TO 21
79
80 C----              Remember present state
81
82       IQ(KQS+LQJZ+2*JQLEV+2) = NQLINK
83       IQ(KQS+LQJZ+2*JQLEV+3) = LQSTA(KQT+1)
84
85       N = IQ(KQS+LQSV+3)
86       IF (N.NE.0) CALL UCOPY (LQ(KQS+NQREF+1),LQ(KQS+LQSV-N-3),N)
87       N = IQ(KQS+LQSV+4)
88       IF (N.NE.0)  THEN
89           L = LQAN + IQ(KQS+LQAN)
90           CALL UCOPY (LQ(KQS+NQLINK+1),IQ(KQS+L+1),N)
91         ENDIF
92
93 #if defined(CERNLIB_JZTIME)
94 #include "zebra/jztimin.inc"
95 #endif
96
97 C----              Find SV bank
98
99    21 L = LQ(KQS+LQJZ-4)
100       IF (L.EQ.0)                  GO TO 24
101       J = IUCOMP (IAMID,IQ(KQS+L+2),IQ(KQS+L+1))
102       IF (J.EQ.0)                  GO TO 24
103       LQSV = LQ(KQS+L-J)
104       GO TO 25
105
106    24 LQSV   = LZFIND (IXSTJZ,LQ(KQS+LQJZ-3), IAMID,1)
107       IF (LQSV.EQ.0)               GO TO 81
108    25 IQ(KQS+LQSV+2) = IQ(KQS+LQSV+2) + 1
109       LCD  = LQSV + JQNACC
110       LQAN = LCD + IQ(KQS+LCD) + 1
111
112 C--                Copy flags
113
114 #if defined(CERNLIB_QDEBUG)
115       CALL VZERO (JQFLAG,JQMFLW)
116       L = LQAN + IQ(KQS+LQAN) + 1 + IQ(KQS+LQSV+4)
117       N = IQ(KQS+L)
118       IF (N.NE.0)  CALL UCOPY (IQ(KQS+L+1),JQFLAG,N)
119
120       IF (JBIT(JQLLEV,9).NE.0)  WRITE (IQLOG,9024) JQLEV,NQME(1),
121      +                          IQ(KQS+LQSV+1),IQ(KQS+LQSV+2)
122
123  9024 FORMAT (/' =======  JZIN   level',I2,', "',A4,' down to "',A4,
124      FI8,'th entry')
125 #endif
126
127       JQEALL = JQEALL + 1
128       IF (JQEALL.EQ.0)             GO TO 71
129
130 C----              Step level
131
132    31 NQME(1) = IQ(KQS+LQSV+1)
133       JQLEV   = JQLEV + 1
134       IF (JQLEV.GT.JQMLEV)         GO TO 91
135       J     = LQJZ - JQLEV - 6
136       LQDW  = LQ(KQS+J)
137       LQUP  = LQ(KQS+J+1)
138       J     = J - JQMLEV
139       LQ(KQS+J) = LQSV
140       IQUEST(1) = MINIT
141       IF (IAFLDW.NE.0)             GO TO 37
142       LQDW = 0
143 #include "zebra/qtrace99.inc"
144       RETURN
145
146 C--                Clear the down call bank
147
148    37 IF (JQLEV.EQ.JQMLEV)         GO TO 92
149       CALL VZERO (LQ(KQS+LQDW-JQCBNL),JQCBNL)
150       CALL VZERO (IQ(KQS+LQDW+1),     JQCBND)
151       IQ(KQS+LQDW) = MSBYT (0, IQ(KQS+LQDW),1,18)
152       GO TO 999
153
154 C----              Re-order SV structure every now and then
155
156    71 JQREOD = MIN (4*JQREOD,MXREOD)
157       JQEALL = -JQREOD
158       IF (JQREOD.GE.MXREOD)        GO TO 31
159       L = LQ(KQS+LQJZ-3)
160       CALL ZTOPSY (IXSTJZ,L)
161       CALL ZSORTI (IXSTJZ,L,2)
162       CALL ZTOPSY (IXSTJZ,L)
163       NPR  = NZBANK (IXSTJZ,L)
164       INC  = 10
165
166       LFO = LQ(KQS+LQJZ-4)
167       IF (LFO.EQ.0)                GO TO 72
168       IF (NPR.LE.IQ(KQS+LFO-1))       GO TO 74
169       CALL MZDROP (IXSTJZ,IQ(KQS+LFO), '.')
170       INC = 4
171
172    72 MMJZFO(2) = NPR + INC
173       MMJZFO(4) = MMJZFO(2) + 1
174       CALL MZLIFT (IXDVJZ,LFO,LQJZ,-4,MMJZFO,0)
175       JQREOD = 512
176       JQEALL = -JQREOD
177
178    74 IQ(KQS+LFO+1) = NPR
179       J = 0
180       L = LQJZ - 3
181    75 L = LQ(KQS+L)
182       IF (L.EQ.0)                  GO TO 31
183       J = J + 1
184       LQ(KQS+LFO-J)   = L
185       IQ(KQS+LFO+J+1) = IQ(KQS+L+1)
186       GO TO 75
187
188 C----              Processor not yet initialized
189
190    81 IANAN = IPA3(1)
191       IANCR = 10
192       IANLSV = 0
193       IANDSV = 0
194
195       N = IPA4(1)
196       IF (N.GE.0)  THEN
197           N =  MIN (N,3)
198           CALL UCOPY (IPA4(2),IANCR,N)
199         ENDIF
200       CALL JZLIFT
201       MINIT = IQUEST(1)
202       LQSV  = IQUEST(2)
203
204       LFO = LQ(KQS+LQJZ-4)
205       IF (LFO.EQ.0)                GO TO 25
206       NFO = IQ(KQS+LFO+1) + 1
207       IF (NFO.GE.IQ(KQS+LFO-1))       GO TO 25
208       LQ(KQS+LFO-NFO)   = LQSV
209       IQ(KQS+LFO+NFO+1) = IAMID
210       IQ(KQS+LFO+1)     = NFO
211       GO TO 25
212
213 C----              JQMLEV exeeded
214
215    92 NQCASE = 1
216    91 NQCASE = NQCASE + 1
217       NQFATA = 3
218       IQUEST(11) = IAMID
219       IQUEST(12) = IAFLDW
220       IQUEST(13) = JQLEV
221 #include "zebra/qtofatal.inc"
222       END
223 *      ==================================================
224 #include "zebra/qcardl.inc"