]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/tq/tzinit.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 / tq / tzinit.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.3 1996/04/24 17:27:35 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:14:53 mclareni
10* Incorporate changes from J.Zoll for version 3.77
11*
12* Revision 1.1.1.1 1996/03/06 10:47:27 mclareni
13* Zebra
14*
15*
16#include "zebra/pilot.h"
17 SUBROUTINE TZINIT (LUNP,IXDIV)
18
19C-- Master routine for title input
20
21#include "zebra/zmach.inc"
22#include "zebra/zstate.inc"
23#include "zebra/zunit.inc"
24#include "zebra/mqsys.inc"
25#include "zebra/eqlqt.inc"
26#include "zebra/mzcwk.inc"
27#include "zebra/tzuc.inc"
28#include "zebra/tzc1.inc"
29C-------------- END CDE -----------------
30 COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT,DUMMY(36)
31 CHARACTER COL(LGL)*1
32 EQUIVALENCE (COL(1), LINE(1:1))
33 CHARACTER CHWORK*8
34#if defined(CERNLIB_EQUHOLCH)
35 INTEGER IWORK(2)
36 EQUIVALENCE (CHWORK,IWORK)
37#endif
38
39 DIMENSION LUNP(1)
40 DIMENSION IFLAGS(5)
41 EQUIVALENCE (IFLAGS(1),IFLLOG)
42
43 PARAMETER (NCC = 7)
44 CHARACTER CCTEXT(NCC)*6
45
46#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
47 DIMENSION NAMESR(2)
48 DATA NAMESR / 4HTZIN, 4HIT /
49#endif
50#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
51 DATA NAMESR / 6HTZINIT /
52#endif
53#if !defined(CERNLIB_QTRHOLL)
54 CHARACTER NAMESR*8
55 PARAMETER (NAMESR = 'TZINIT ')
56#endif
57 DATA CCTEXT / 'LOG ', 'PR*INT', 'US*ER ', 'KI*LL '
58 +, 'ANY*WA', 'DO ', 'FIN*IS' /
59
60#include "zebra/q_sbyt.inc"
61
62
63#include "zebra/qtraceq.inc"
64
65C-- decide division
66
67 CALL MZSDIV (IXDIV,7)
68 L = LQT(KQT+1)
69 IF (L.NE.0) JQDIVI = MZFDIV (-7, L)
70 IF (JQDIVI.EQ.0) JQDIVI = 2
71 JSTOR = JQSTOR
72 IXTITL = MSBYT (JQSTOR,JQDIVI,27,4)
73
74C-- invert the order of the title banks,
75C- so that the new ones can be created at the beginning
76
77 IF (L.NE.0) CALL ZTOPSY (IXTITL,L)
78
79 CALL VZERO (NPARA,23)
80 CALL VZERO (NREADY,12)
81 IF (NQLOGL.GE.-1) IFLLOG = 1
82 BLANK = ' '
83
84C-- get the input unit
85
86 LUNTQ = LUNP(1)
87 IF (LUNTQ.LT.0) LUNTQ = IQTTIN
88 IF (LUNTQ.EQ.0) LUNTQ = IQREAD
89#if defined(CERNLIB_QPRINT)
90 IF (IFLLOG.NE.0) THEN
91 JDV = JQDIVI
92 IF (JDV.EQ.JQDVSY) JDV = 24
93 WRITE (IQLOG,9000) LUNTQ,JQSTOR,JDV
94 ENDIF
95 9000 FORMAT (1X/' TZINIT. Read title banks from LUNTQ = ',I3/
96 F10X,'for store',I3,' into division',I3/1X)
97#endif
98
99C---- Look for next control line
100
101 12 IF (NREADY.NE.0) GO TO 14
102
103#include "zebra/tzread1.inc"
104
105 14 NREADY = 0
106 IF (NCHORG.EQ.0) GO TO 12
107 IF (LINE(1:2).EQ.'*.') GO TO 12
108 IF (LINE(1:4).EQ.'*CMZ') GO TO 12
109
110 NCHLN = NCHORG
111 J = INDEX (LINE(1:NCHLN),' #.')
112 IF (J.NE.0) NCHLN = LNBLNK (LINE(1:J))
113 IF (NCHLN.EQ.0) GO TO 12
114
115 IF (COL(1).NE.'*') GO TO 91
116 IF (IFLLOG.NE.0) WRITE (IQLOG,9012) LINE(1:NCHORG)
117 9012 FORMAT (' > ',A)
118
119 IF (LINE(1:2).EQ.'*-') GO TO 12
120
121 NHEAD = MIN (NCHORG,80)
122 LHEAD(1:NHEAD) = LINE(1:NHEAD)
123 CALL CLTOU (LINE(1:NCHLN))
124 IGNORE = 0
125
126C---- Analyse control line
127
128 JA = ICNEXT (LINE,1,NCHLN) + 1
129 JE = NESLAT - 1
130 NN = NDSLAT
131
132 IF (NN.LT.3) GO TO 92
133 JCC = ICNTH (LINE(2:NN),CCTEXT,NCC)
134
135C- log print user kill anyw do finis
136C- 1 2 3 4 5 6 7
137
138 IF (JCC.EQ.0) GO TO 92
139 IF (JCC.EQ.NCC) GO TO 78
140
141 JA = ICNEXT (LINE,JE+1,NCHLN)
142 JE = NESLAT - 1
143 NN = NDSLAT
144 IF (JCC.EQ.NCC-1) GO TO 21
145
146C-- *LOG, *PRINT, *USER, *KILL, *ANYWAY (OFF)
147
148 IF (NN.EQ.0) THEN
149 IFLAGS(JCC) = 1
150 IF (JCC.EQ.2) IFLLOG = 1
151 GO TO 12
152 ENDIF
153
154 IF (NN.NE.3) GO TO 92
155 CHWORK = LINE(JA:JA+2)
156 IF (CHWORK(1:3).NE.'OFF') GO TO 92
157 IFLAGS(JCC) = 0
158 IF (JCC.EQ.1) IFLPRI = 0
159 GO TO 12
160
161C-------- Analyse *DO idh idn -opt x --------
162
163 21 IF (NN.EQ.0) GO TO 92
164 NN = MIN(NN,4)
165 CHWORK = ' '
166 CHWORK(1:NN) = LINE(JA:JA+NN-1)
167 CALL VZERO (NAME,5)
168 CALL VZERO (IFLEXA,16)
169#if defined(CERNLIB_EQUHOLCH)
170 NAME(1) = IWORK(1)
171#endif
172#if !defined(CERNLIB_EQUHOLCH)
173 CALL UCTOH (CHWORK,NAME,4,4)
174#endif
175 IDNUM = -1
176
177 24 JA = ICNEXT (LINE,JE+1,NCHLN)
178 IF (JA.GT.NCHLN) GO TO 61
179 JE = NESLAT - 1
180 NN = NDSLAT
181
182 IF (COL(JA).NE.'-') THEN
183 IF (IDNUM.GE.0) GO TO 92
184 IDNUM = ICDECI (LINE,JA,JE)
185 IF (IDNUM.LT.0) GO TO 92
186 IF (NGSLAT.NE.0) GO TO 92
187 GO TO 24
188 ENDIF
189
190 IDNUM = MAX (IDNUM,0)
191 IF (NN.EQ.1) GO TO 92
192
193 JA = JA + 1
194 JOPT = INDEX ('FISENUCA',COL(JA))
195 IF (JOPT.EQ.0) GO TO 92
196
197 JA = JA + 1
198 NN = NN - 2
199 GO TO (31, 34, 36, 37, 39, 41, 44, 47), JOPT
200C- F I S E N U C A
201C- 1 2 3 4 5 6 7 8
202
203C-- option -F(format), Fortran FORMAT
204
205 31 IF (COL(JA).NE.'(') GO TO 92
206 IF (COL(JE).NE.')') GO TO 92
207 JFMTC1 = JA
208 JFMTC2 = JE
209 GO TO 24
210
211C-- option -Ii or -If ... or -I(text), I/O characteristic
212
213 34 JOPT = INDEX ('(BIFD', COL(JA))
214C- 12345
215 IF (JOPT.EQ.0) GO TO 92
216 IF (JOPT.NE.1) THEN
217 IF (NN.NE.1) GO TO 92
218 NAME(5) = JOPT - 1
219 GO TO 24
220 ENDIF
221
222 JE = ICFIND (')', LINE,JA,NCHLN)
223 IF (NGSLAT.EQ.0) GO TO 92
224
225 CALL MZIOBK (NAME,20, LINE(JA+1:JE-1))
226 GO TO 24
227
228C-- option -S[n], true size of the bank
229
230 36 IFLSIZ = 1
231 IF (NN.EQ.0) GO TO 24
232 GO TO 39
233
234C-- option -E[n], exact number of data words
235
236 37 IFLEXA = 1
237 IF (NN.EQ.0) GO TO 24
238
239C-- option -Nn, bank size
240
241 39 N = ICDECI (LINE,JA,JE)
242 IF (NGSLAT.NE.0) GO TO 92
243 IF (N.LE.0) GO TO 92
244 IF (NAME(4).NE.0) THEN
245 IF (NAME(4).NE.N) GO TO 94
246 ENDIF
247 NAME(4) = N
248 GO TO 24
249
250C-- option -U[n], call TZUSER
251
252 41 IFLTZU = 1
253 IF (NN.EQ.0) GO TO 24
254 IVALUS = ICDECI (LINE,JA,JE)
255 IF (NGSLAT.NE.0) GO TO 92
256 GO TO 24
257
258C-- option -C[a][/e], column usage
259
260 44 JCOLA = 1
261 IF (COL(JA).EQ.'/') GO TO 45
262 JCOLA = ICDECI (LINE,JA,JE)
263 IF (JCOLA.LE.0) GO TO 92
264 IF (JCOLA.GE.LGL-3) GO TO 92
265 IF (NGSLAT.EQ.0) GO TO 24
266 JA = NESLAT
267 IF (COL(JA).NE.'/') GO TO 92
268 45 JCOLE = ICDECI (LINE,JA+1,JE)
269 IF (NGSLAT.NE.0) GO TO 92
270 JCOLE = MIN (JCOLE,LGL)
271 IF (JCOLE.LT.JCOLA+2) GO TO 92
272 GO TO 24
273
274C-- option -A[n][C][W]
275
276 47 CALL TZACW (LINE(JA-1:JE))
277 IF (NCHPW.GE.0) GO TO 24
278 NCHPW = 0
279 GO TO 92
280
281C-------- Read data of next title bank --------
282
283 61 IDNUM = MAX (IDNUM,0)
284 IF (NAME(4).NE.0) GO TO 63
285
286C-- read the data through the scratch area
287
288 IF (JFMTC1.NE.0) GO TO 93
289 LPUTA = LQWKFZ
290 LPUTE = LPUTA + NQWKTT
291 GO TO 66
292
293C-- pre-lift the bank for filling
294
295 63 IFLPRE = 7
296 CALL MZLIFT (IXTITL,LOLD,LQT(KQT+1),1,NAME,-1)
297 LPUTA = KQS + LOLD + 9
298 LPUTE = LPUTA + NAME(4)
299 IF (JFMTC1.EQ.0) GO TO 66
300
301C-- Read data en block with Fortran FORMAT
302
303 NWOCC = NAME(4)
304#include "zebra/tzread2.inc"
305 GO TO 68
306
307C-- Read data in free-field format
308
309 66 CALL TZFREE
310 IF (NFAULT.NE.0) THEN
311 NFATAL = NFATAL + NFAULT
312 IF (IFLPRE.EQ.0) GO TO 77
313 LNEW = -1
314 GO TO 69
315 ENDIF
316 NWOCC = LPUTX - LPUTA
317
318C-- lift the bank and copy the data
319
320 IF (IFLPRE.EQ.0) THEN
321 NAME(4) = NWOCC
322 CALL MZLIFT (IXTITL,LOLD,LQT(KQT+1),1,NAME,-1)
323 CALL UCOPY (LQ(LPUTA),IQ(KQS+LOLD+1),NAME(4))
324 ENDIF
325
326C-- handle 'exact' or 'size'
327
328 IF (IFLEXA.NE.0) THEN
329 IF (NWOCC.NE.NAME(4)) GO TO 97
330 ENDIF
331
332 IF (IFLSIZ.EQ.0) GO TO 68
333 N = NAME(4) - NWOCC
334 IF (N.NE.0) CALL VZERO (IQ(KQS+LOLD+1+NWOCC),N)
335 NWOCC = NAME(4)
336
337C-- calling TZUSER
338
339 68 IQ(KQS+LOLD-5) = IDNUM
340 IF (IFLTZU+IFLUSE.EQ.0) GO TO 71
341 NPARA = IVALUS
342
343 LNEW = 0
344 CALL TZUSER (LQT(KQT+1))
345 IF (LNEW.LT.-1) GO TO 98
346 IF (LNEW.EQ.0) GO TO 71
347 NWOCC = NAME(4)
348 69 CALL MZDROP (IXTITL, LQT(KQT+1), '.')
349 IF (LNEW.EQ.-1) GO TO 77
350
351C-- possibly reduce the bank
352
353 71 N = NAME(4) - NWOCC
354 IF (N.GT.0) THEN
355 L = LQT(KQT+1)
356 CALL MZPUSH (IXTITL,L,0,-N,'I')
357 ENDIF
358
359 77 IF (NREADY.GE.0) GO TO 12
360
361C------- Finished
362
363 78 L = LQT(KQT+1)
364 CALL ZTOPSY (IXTITL,L)
365 IQUEST(1) = NFATAL
366 IF (NFATAL.NE.0) THEN
367 IF (IFLANY.EQ.0) CALL ZFATAM ('TZINIT fails.')
368 ENDIF
369#include "zebra/qtrace99.inc"
370 RETURN
371
372C---- Error handling
373
374C-- unheaded data line
375 91 IF (IGNORE.NE.0) GO TO 12
376 WRITE (IQLOG,9091) LINE(1:NCHORG)
377 9091 FORMAT (' !!i> ',A)
378 IF (IFLKIL.GT.0) NFATAL = NFATAL + 1
379 GO TO 12
380
381C-- faulty control line *xxx
382 92 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
383 WRITE (IQLOG,9092) BLANK(1:JA)
384 9092 FORMAT (' !!f ',A,'^-> !!! fault')
385 IGNORE = 7
386 NFATAL = NFATAL + 1
387 GO TO 12
388
389C-- faults with *DO
390 93 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
391 WRITE (IQLOG,9093)
392 9093 FORMAT (' !!f fault : -F(...) requires -Nn')
393 IGNORE = 7
394 NFATAL = NFATAL + 1
395 GO TO 12
396
397 94 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
398 WRITE (IQLOG,9094)
399 9094 FORMAT (' !!f fault : contradictory bank sizes')
400 IGNORE = 7
401 NFATAL = NFATAL + 1
402 GO TO 12
403
404C-- premature EoF
405 96 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
406 WRITE (IQLOG,9096)
407 9096 FORMAT (' !!f fault : premature EoF')
408 NFATAL = NFATAL + 1
409 GO TO 78
410
411C-- exact fault
412 97 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
413 WRITE (IQLOG,9097) NAME(4),NWOCC
414 9097 FORMAT (' !!f fault : # of words expected / read=',2I6)
415 NFATAL = NFATAL + 1
416 GO TO 77
417
418C-- user kill
419 98 IF (IFLLOG.EQ.0) WRITE (IQLOG,9012) LHEAD(1:NHEAD)
420 WRITE (IQLOG,9098)
421 9098 FORMAT (' !!f fault : kill requested by TZUSER')
422 NFATAL = NFATAL + 1
423 GO TO 77
424 END
425* ==================================================
426#include "zebra/qcardl.inc"