]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/dzebra/dzchst.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 / dzebra / dzchst.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/24 17:26:06 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:06 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 DZCHST (CHTEXT,IXDIV,LBANK,CHOPT,ISUM)
19 SAVE CHPART
20#include "zebra/bankparq.inc"
21#include "zebra/questparq.inc"
22#include "zebra/storparq.inc"
23#include "zebra/mqsys.inc"
24#include "zebra/qequ.inc"
25#include "zebra/mzcn.inc"
26#include "zebra/zbcdch.inc"
27#include "zebra/zbcdk.inc"
28#include "zebra/zunit.inc"
29#include "zebra/dzc1.inc"
30 CHARACTER *(*) CHOPT,CHTEXT,CHPART(3)*6
31
32 CHARACTER CHROUT*(*)
33 PARAMETER (CHROUT = 'DZCHST')
34
35 PARAMETER ( NPDENQ = 3 )
36 PARAMETER ( MPDCUQ = 1 )
37 PARAMETER ( MPDNCQ = 2 )
38 PARAMETER ( MPDNSQ = 3 )
39
40* 32 BIT MACHINES
41#if defined(CERNLIB_B32)
42 PARAMETER ( NBITS = 8 )
43* 36 BIT MACHINE
44#endif
45#if defined(CERNLIB_B36)
46 PARAMETER ( NBITS = 9 )
47* 60 BIT MACHINE
48#endif
49#if defined(CERNLIB_B60)
50 PARAMETER ( NBITS = 15 )
51* 64 BIT MACHINE
52#endif
53#if defined(CERNLIB_B64)
54 PARAMETER ( NBITS = 16 )
55#endif
56
57 PARAMETER ( NLSUMQ = 6 )
58 INTEGER ISUM(*),ISMOLD(NLSUMQ)
59
60 DATA CHPART /'DATA','LINK','SYSTEM'/
61
62#if (defined(CERNLIB_DEBUGON))&&(defined(CERNLIB_VFORT))
63#include "zebra/debugvf2.inc"
64#endif
65
66 CQSTAK = CHROUT//'/'
67 IQUEST(1) = 0
68
69 CALL DZOPT(CHOPT)
70
71 IF (IFLOPT(MPOSVQ).NE.0) THEN
72 DO 10 I=1,NLSUMQ
73 10 ISMOLD(I) = ISUM(I)
74 ENDIF
75
76 CALL MZSDIV(IXDIV,-1)
77
78
79 LWORK = NQOFFS(1) + LQEND(1) - NPDENQ - 1
80 LWORKE = NQOFFS(1) + LQSTA(2) - NPDENQ
81
82
83 LCUR = LBANK
84 LEVEL = 0
85
86
87 MAXALL = 0
88 NTBANK = 0
89 DO 20 I=1,NDVMXQ
90 IF(I.LE.JQDVLL.OR.I.GE.JQDVSY)
91 I MAXALL = MAXALL + LQEND(KQT+I) - LQSTA(KQT+I)
92 20 CONTINUE
93
94
95
96 CALL VZERO(IQUEST(71),12)
97
98
99 100 CALL MZCHLS (NCHEKQ,LCUR)
100 IF (IQFOUL.NE.0) THEN
101 CALL DZBKDV(LCUR)
102 IF (IQUEST(1).NE.0) GO TO 999
103 WRITE(CQINFO,'(A,''/'',I8)') CQDIV,LCUR
104 CALL DZTEXT(MSHP1Q,CDUMMQ,0)
105 IQUEST(1) = 1
106 GO TO 999
107 ENDIF
108
109 CALL DZCHV1 (LCUR+1+NOFLIQ+KQS,LCUR+IQND+NOFLIQ+KQS,70,0)
110 IF (IQUEST(1).NE.0) GO TO 999
111 CALL DZCHV1 (LCUR-IQNL+KQS,LCUR+2+KQS,74,0)
112 IF (IQUEST(1).NE.0) GO TO 999
113 CALL DZCHV1 (LCUR+3+KQS,LCUR+NOFLIQ+KQS,78,0)
114 IF (IQUEST(1).NE.0) GO TO 999
115 CALL DZCHV1 (LCUR-IQNL-1+KQS,LCUR-IQNL-1+KQS,78,0)
116 IF (IQUEST(1).NE.0) GO TO 999
117
118 NTBANK = NTBANK + NL + ND + NBKOHQ
119 IF (NTBANK.GE.MAXALL) THEN
120 WRITE(CQINFO,'(I10,''/'',I10)') MAXALL,NTBANK
121 CALL DZTEXT(MSHO1Q,CDUMMQ,0)
122 IQUEST(1) = 1
123 GO TO 999
124 ENDIF
125
126
127 LEVEL = LEVEL+1
128 LWORK = LWORK + NPDENQ
129 IF (LWORK.GE.LWORKE) THEN
130 WRITE(CQINFO,'(I10)') LEVEL
131 CALL DZTEXT(MSHO2Q,CDUMMQ,0)
132 IQUEST(1) = 1
133 GO TO 999
134 ENDIF
135
136
137 IF (IFLOPT(MPOSDQ).EQ.0) IQNS = 0
138
139 LQ(LWORK+MPDCUQ) = LCUR
140 LQ(LWORK+MPDNCQ) = IQNS
141 LQ(LWORK+MPDNSQ) = IQNS
142
143
144 200 IF (LQ(LWORK+MPDNCQ).LE.0) THEN
145 IF (LEVEL.GT.1.OR.IFLOPT(MPOSLQ).NE.0) THEN
146 LCUR = LQ(KQS + LQ(LWORK+MPDCUQ))
147 LEVEL = LEVEL - 1
148 LWORK = LWORK - NPDENQ
149 IF (LCUR.NE.LNULL) THEN
150 GO TO 100
151 ELSE
152 IF (LEVEL.GT.0) THEN
153 GO TO 200
154 ELSE
155 GO TO 300
156 ENDIF
157 ENDIF
158 ELSE
159 LEVEL = LEVEL-1
160 LWORK = LWORK - NPDENQ
161 IF (LEVEL.GT.0) THEN
162 GO TO 200
163 ELSE
164 GO TO 300
165 ENDIF
166 ENDIF
167 ENDIF
168
169
170 LQ(LWORK+MPDNCQ) = LQ(LWORK+MPDNCQ) - 1
171 LCUR = LQ(KQS+LQ(LWORK+MPDCUQ)
172 X -LQ(LWORK+MPDNSQ)+LQ(LWORK+MPDNCQ))
173
174 IF (LCUR.EQ.LNULL) GO TO 200
175 GO TO 100
176
177
178
179 300 DO 320 I=1,NLSUMQ/2
180 II = (I-1)*2
181
182 JCARRY = 0
183 IBIT = 1
184 DO 310 JF=70+I*4-3,70+I*4
185 IQUEST (JF) = IQUEST(JF) + JCARRY
186 JCARRY = IQUEST(JF)/2**NBITS
187 IQUEST (JF) = IQUEST(JF) - JCARRY*(2**NBITS)
188 CALL SBYT(IQUEST(JF),ISUM(II+1),IBIT,NBITS)
189 310 IBIT = IBIT + NBITS
190 ISUM(II+2) = JCARRY
191 320 CONTINUE
192
193 IF (IFLOPT(MPOSVQ).NE.0) THEN
194 DO 400 I=1,NLSUMQ/2
195 II = (I-1)*2 + 1
196 IF ( (ISUM(II) .NE.ISMOLD(II) )
197 I .OR. (ISUM(II+1).NE.ISMOLD(II+1)) ) THEN
198 IQUEST(10+I) = 1
199 IQUEST(1) = 1
200 ELSE
201 IQUEST(10+I) = 0
202 ENDIF
203 400 CONTINUE
204 ENDIF
205
206 IF (CHTEXT.NE.CDUMMQ) THEN
207 CQMAP(1) = ' '
208 CQMAP(2)(1:10) = ' * '//CHROUT//' '
209 CQMAP(2)(11:29) = CHTEXT
210 CQMAP(2)(30:41) = ' / OPTION : '
211 CQMAP(2)(42:47) = CHOPT
212 DO 500 I=1,NLSUMQ/2
213 II = (I-1)*2 + 1
214 IF (IFLOPT(MPOSVQ).NE.0) THEN
215 IF (IQUEST(10+I).NE.0) THEN
216 CQMAP(2)(118:130) = '??PROBLEMS? '
217 ELSE
218 CQMAP(2)(118:130) = ' OK'
219 ENDIF
220 WRITE(CQMAP(2)(48:117),
221 W '(''OLD='',Z4,1X,Z16,4X,''NEW='',Z4,1X,Z16,T63,A)')
222 W ISMOLD(II+1),ISMOLD(II),ISUM(II+1),ISUM(II),CHPART(I)
223 ELSE
224
225 WRITE(CQMAP(2)(48:),'(''NEW='',Z4,1X,Z16,T63,A)')
226 W ISUM(II+1),ISUM(II),CHPART(I)
227 ENDIF
228 CALL DZTEXT(0,CDUMMQ,2)
229 CQMAP(2) = ' '
230 500 CONTINUE
231 ENDIF
232
233 999 RETURN
234 END