]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/giopa/gfin.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] / GEANT321 / giopa / gfin.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:21:16 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.20 by S.Giani
11*-- Author :
12 SUBROUTINE GFIN(LUN,CHOBJ,NKEYS,IDVERS,CHOPT,IER)
13C.
14C. ******************************************************************
15C. * *
16C. * Routine to read GEANT object(s) fromin the FZ file *
17C. * The data structures from disk are read in memory *
18C. * *
19C. * LUN Logical unit *
20C. * *
21C. * CHOBJ The type of data structure to be read: *
22C. * MATE material *
23C. * TMED tracking medium *
24C. * VOLU volumes *
25C. * ROTM rotation matrix *
26C. * SETS detector set *
27C. * PART particle *
28C. * SCAN geometry *
29C. * INIT read all above *
30C. * KINE this keyword will trigger the read of *
31C. * KINE and VERT unless the flag 'S' is set *
32C. * DIGI digitisation *
33C. * DRAW drawing *
34C. * HEAD event header *
35C. * HITS hits *
36C. * RUNG run *
37C. * STAK particle temporary stack *
38C. * STAT volume statistic *
39C. * VERT vertex *
40C. * JXYZ track points *
41C. * TRIG this keyword will trigger the read of *
42C. * DIGI, HEAD, HITS, KINE, VERT abd JXYZ *
43C. * unless the 'S' flag is set *
44C. * *
45C. * NKEYS number of keys in vector CHOBJ *
46C. * *
47C. * IDVERS version of the data structure to be read in *
48C. * *
49C. * CHOPT List of options *
50C. * 'I' read only initialisation data *
51C. * structures *
52C. * 'K' read only KINE and TRIG data *
53C. * structures *
54C. * 'T' read only DIGI, HEAD, HITS, KINE, *
55C. * VERT and JXYZ data structures *
56C. * even if other keys are specified in CHOBJ *
57C. * *
58C. * 'S' interpret KINE to mean only *
59C. * KINE and TRIG and INIT to mean *
60C. * nothing *
61C. * 'Q' quiet option, no message is *
62C. * printed *
63C. * *
64C. * IER error flag. <0 ZEBRA error flag as returned in *
65C. * IQUEST(1) *
66C. * 0 read completed successfully *
67C. * >0 if only IER structures read in *
68C. * *
69C. * The FZ data base has been created via GOPEN/GFOUT *
70C. * *
71C. * *
72C. * Example. *
73C. * *
74C. * CALL GOPEN(1,'I',1024,IER) *
75C. * CALL GFIN (1,'VOLU',1,0,' ',IER) *
76C. * CALL GFIN (1,'MATE',1,0,' ',IER) *
77C. * CALL GFIN (1,'TMED',1,0,' ',IER) *
78C. * CALL GFIN (1,'ROTM',1,0,' ',IER) *
79C. * CALL GFIN (1,'PART',1,0,' ',IER) *
80C. * CALL GFIN (1,'SCAN',1,0,' ',IER) *
81C. * CALL GFIN (1,'SETS',1,0,' ',IER) *
82C. * *
83C. * ==>Called by : <USER> ,GOPEN *
84C. * Author F.Carminati ******* *
85C. * *
86C. ******************************************************************
87C.
88#include "geant321/gcbank.inc"
89#include "geant321/gcflag.inc"
90#include "geant321/gconsp.inc"
91#include "geant321/gcnum.inc"
92#include "geant321/gccuts.inc"
93#include "geant321/gcscal.inc"
94#include "geant321/gcdraw.inc"
95#include "geant321/gcvolu.inc"
96#include "geant321/gcunit.inc"
97#include "geant321/gctime.inc"
98* COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART
99* + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX
100* + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT
101 COMMON/QUEST/IQUEST(100)
102 PARAMETER (NLINIT=9,NLKINE=2,NLTRIG=6,NMKEY=22)
103 DIMENSION JNAMES(20),LINIT(NLINIT),LKINE(NLKINE)
104 DIMENSION LTRIG(NLTRIG),IXD(NMKEY)
105 DIMENSION LINK(NMKEY),IVERSI(NMKEY),LDIV(2),IRESUL(NMKEY)
106 DIMENSION IDOLD(8), IDNEW(8), VEROLD(8), VERNEW(8)
107 DIMENSION IUHEAD(2),ITRAN(23)
108 EQUIVALENCE (JNAMES(1),JDIGI)
109 CHARACTER*4 KNAMES(NMKEY),CHOBJ(*)
110 CHARACTER*(*) CHOPT
111 DATA KNAMES/'DIGI','DRAW','HEAD','HITS','KINE','MATE','PART',
112 + 'ROTM','RUNG','SETS','STAK','STAT','TMED','NULL','VERT',
113 + 'VOLU','JXYZ','NULL','NULL','NULL','SCAN','NULL'/
114 DATA ITRAN/7,6,13,16,8,10,2,9,8*0,3,15,5,17,4,1,21/
115 DATA IXD/2,1,2,2,2,8*1,2,2,1,2,3*0,1,0/
116 DATA LINIT/2,6,7,8,9,10,13,16,21/
117 DATA LKINE/5,15/
118 DATA LTRIG/1,3,4,5,15,17/
119 DATA IDNEW / 8*0 /
120 DATA VERNEW / 8*0. /
121C.
122C. ------------------------------------------------------------------
123C.
124 IQUEST(1)=0
125 LDIV(1) =IXCONS
126 LDIV(2) =IXDIV
127 KVOL=JVOLUM
128 IER=0
129*
130 IOPTI=INDEX(CHOPT,'i')+INDEX(CHOPT,'I')
131 IOPTT=INDEX(CHOPT,'t')+INDEX(CHOPT,'T')
132 IOPTK=INDEX(CHOPT,'k')+INDEX(CHOPT,'K')
133 IOPTS=INDEX(CHOPT,'s')+INDEX(CHOPT,'S')
134 IOPTQ=INDEX(CHOPT,'q')+INDEX(CHOPT,'Q')
135*
136* Save old JRUNG dates and versions
137 IF(JRUNG.GT.0) THEN
138 DO 10 J=1,8
139 IDOLD(J) = IQ(JRUNG+10+J)
140 VEROLD(J) = Q(JRUNG+20+J)
141 10 CONTINUE
142 ENDIF
143*
144 NLINK=0
145 DO 100 JKEY=1,NKEYS
146 IF(IOPTS.EQ.0) THEN
147 IF(CHOBJ(JKEY).EQ.'INIT') THEN
148 DO 30 J=1, NLINIT
149 DO 20 MLINK=1,NLINK
150 IF(LINK(MLINK).EQ.LINIT(J)) GO TO 30
151 20 CONTINUE
152 NLINK=NLINK+1
153 LINK(NLINK)=LINIT(J)
154 30 CONTINUE
155 GO TO 100
156 ELSEIF(CHOBJ(JKEY).EQ.'TRIG') THEN
157 DO 50 J=1, NLTRIG
158 DO 40 MLINK=1,NLINK
159 IF(LINK(MLINK).EQ.LTRIG(J)) GO TO 50
160 40 CONTINUE
161 NLINK=NLINK+1
162 LINK(NLINK)=LTRIG(J)
163 50 CONTINUE
164 GO TO 100
165 ELSEIF(CHOBJ(JKEY).EQ.'KINE') THEN
166 DO 70 J=1, NLKINE
167 DO 60 MLINK=1,NLINK
168 IF(LINK(MLINK).EQ.LKINE(J)) GO TO 70
169 60 CONTINUE
170 NLINK=NLINK+1
171 LINK(NLINK)=LKINE(J)
172 70 CONTINUE
173 GO TO 100
174 ENDIF
175 ENDIF
176 DO 90 J=1,NMKEY
177 IF(CHOBJ(JKEY).EQ.KNAMES(J)) THEN
178 DO 80 MLINK=1,NLINK
179 IF(LINK(MLINK).EQ.J) GO TO 100
180 80 CONTINUE
181 NLINK=NLINK+1
182 LINK(NLINK)=J
183 GO TO 100
184 ENDIF
185 90 CONTINUE
186 WRITE(CHMAIL,10300) CHOBJ(JKEY)
187 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
188 100 CONTINUE
189*
190 IF(IOPTI.GT.0) THEN
191 DO 120 J=1, NLINK
192 DO 110 K=1, NLINIT
193 IF(LINK(J).EQ.LINIT(K)) GO TO 120
194 110 CONTINUE
195 WRITE(CHMAIL,10000) KNAMES(LINK(J))
196 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
197 LINK(J)=0
198 120 CONTINUE
199 ELSEIF(IOPTK.GT.0) THEN
200 DO 140 J=1, NLINK
201 DO 130 K=1, NLKINE
202 IF(LINK(J).EQ.LKINE(K)) GO TO 140
203 130 CONTINUE
204 WRITE(CHMAIL,10100) KNAMES(LINK(J))
205 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
206 LINK(J)=0
207 140 CONTINUE
208 ELSEIF(IOPTT.GT.0) THEN
209 DO 160 J=1, NLINK
210 DO 150 K=1, NLTRIG
211 IF(LINK(J).EQ.LTRIG(K)) GO TO 160
212 150 CONTINUE
213 WRITE(CHMAIL,10200) KNAMES(LINK(J))
214 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
215 LINK(J)=0
216 160 CONTINUE
217 ENDIF
218 IOFF=0
219 DO 170 J=1, NLINK
220 IF(LINK(J).EQ.0) THEN
221 IOFF=IOFF-1
222 ELSE
223 LINK(J+IOFF)=LINK(J)
224 ENDIF
225 170 CONTINUE
226 NLINK=NLINK+IOFF
227 NPOS=0
228 DO 171 JL=1,NLINK
229 IF(LINK(JL).EQ.9.OR.LINK(JL).EQ.3) THEN
230 NPOS=JL
231 GOTO 172
232 ENDIF
233 171 CONTINUE
234 172 CONTINUE
235*
236 IF(NLINK.LE.0) THEN
237 WRITE(CHMAIL,10400)
238 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
239 IER=-1
240 GOTO 999
241 ENDIF
242*
243 IF(IOPTI+IOPTK+IOPTT.EQ.0) THEN
244*
245* We have to choose which event header to read, JRUNG or JHEAD
246* If the banks list contains banks depending from both headers,
247* the result is unpredictable. Error message to be inserted later.
248 DO 168 J=1, NLINK
249 DO 161 L=1, NLINIT
250 IF(LINK(J).EQ.LINIT(L)) THEN
251 IOPTI=-1
252 GOTO 169
253 ENDIF
254 161 CONTINUE
255 DO 162 L=1, NLKINE
256 IF(LINK(J).EQ.LKINE(L)) THEN
257 IOPTK=-1
258 GOTO 169
259 ENDIF
260 162 CONTINUE
261 DO 163 L=1, NLTRIG
262 IF(LINK(J).EQ.LTRIG(L)) THEN
263 IOPTT=-1
264 GOTO 169
265 ENDIF
266 163 CONTINUE
267 168 CONTINUE
268 169 CONTINUE
269 ENDIF
270*
271 DO 180 J=1, NLINK
272 IVERSI(J)=0
273 IRESUL(J)=0
274 180 CONTINUE
275*
276* Go for next start of event data structure
277 190 IF(IOPTI.NE.0) THEN
278 IF(JRUNG.NE.0)CALL MZDROP(IXCONS,JRUNG,' ')
279 NUH=2
280 CALL FZIN(LUN,IXCONS,JRUNG,1,'E',NUH,IUHEAD)
281 IF(IQUEST(1).GE.2) THEN
282 IER = -IQUEST(1)
283 GO TO 240
284 ENDIF
285 IF(NPOS.NE.0) THEN
286 IVERSI(NPOS)=IUHEAD(1)
287 IRESUL(NPOS)=1
288 ENDIF
289 ELSEIF(IOPTT+IOPTK.NE.0) THEN
290 IF(JHEAD.NE.0)CALL MZDROP(IXDIV,JHEAD,' ')
291 NUH=2
292 CALL FZIN(LUN,IXDIV,JHEAD,1,'E',NUH,IUHEAD)
293 IF(IQUEST(1).GE.2) THEN
294 IER = -IQUEST(1)
295 GO TO 240
296 ENDIF
297 IF(NPOS.NE.0) THEN
298 IVERSI(NPOS)=IUHEAD(1)
299 IRESUL(NPOS)=1
300 ENDIF
301 ENDIF
302*
303 IVERIN = IUHEAD(1)
304 IF(IDVERS.NE.0.AND.IDVERS.NE.IVERIN) THEN
305 DO 200 I=1,NLINK
306 LINK(I)=-ABS(LINK(I))
307 200 CONTINUE
308 GOTO 190
309 ELSE
310 IF (IDVERS .EQ. 0) IDVERS = IVERIN
311 DO 210 I=1,NLINK
312 LINK(I)= ABS(LINK(I))
313 210 CONTINUE
314 ENDIF
315 NK = IUHEAD(2)
316 IF(NK.GT.10) THEN
317 WRITE(CHMAIL,11100) NK
318 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
319 IER=-1
320 GO TO 999
321 ENDIF
322 DO 230 IK=1,NK
323C
324C Read next header
325C
326 NUH=2
327 CALL FZIN(LUN,0,0,0,'S',NUH,IUHEAD)
328 IF(IQUEST(1).GT.2)GO TO 320
329 IKEY=ITRAN(IUHEAD(1))
330 DO 220 I=1,NLINK
331 NKEY=LINK(I)
332 IF(IKEY.EQ.NKEY)THEN
333 IDIV=LDIV(IXD(NKEY))
334 IF(NKEY.LE.20)THEN
335 IF(JNAMES(NKEY).NE.0)THEN
336 CALL MZDROP(IDIV,JNAMES(NKEY),'L')
337 JNAMES(NKEY)=0
338 ENDIF
339 CALL FZIN(LUN,IDIV,JNAMES(NKEY),1,'A',NUH,IUHEAD)
340 ELSE
341 NKL=NKEY-20
342 IF(ISLINK(NKL).NE.0)THEN
343 CALL MZDROP(IDIV,ISLINK(NKL),'L')
344 ISLINK(NKL)=0
345 ENDIF
346 CALL FZIN(LUN,IDIV,ISLINK(NKL),1,'A',NUH,IUHEAD)
347 ENDIF
348 IF(IQUEST(1).LE.2.AND.IQUEST(1).GE.0) THEN
349 IVERSI(I)=IVERIN
350 IRESUL(I)=1
351 GOTO 230
352 ELSE
353 GOTO 320
354 ENDIF
355 ENDIF
356 220 CONTINUE
357 230 CONTINUE
358*
359 240 NIN=0
360 DO 250 I=1,NLINK
361 IF(IRESUL(I).EQ.1) THEN
362 WRITE(CHMAIL,10500) KNAMES(LINK(I)), IVERSI(I)
363 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
364 NIN=NIN+1
365 ELSEIF(LINK(I).GT.0) THEN
366 WRITE(CHMAIL,10600) KNAMES(LINK(I))
367 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
368 ELSEIF(LINK(I).LT.0) THEN
369 WRITE(CHMAIL,10700) KNAMES(-LINK(I)), IDVERS
370 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
371 ENDIF
372 250 CONTINUE
373*
374 IF(NIN.EQ.0) THEN
375 WRITE(CHMAIL,10800)
376 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
377 IF(IER.GE.0) IER=-1
378 GOTO 999
379 ELSEIF(NIN.LT.NLINK) THEN
380 IER=NIN
381 ENDIF
382*
383 IF(KVOL.NE.JVOLUM)THEN
384 NVOLUM=IQ(JVOLUM-1)
385 CALL MZGARB(IXCONS,0)
386 CALL GGDVLP
387 CALL GGNLEV
388 ENDIF
389*
390 IF(JVOLUM.GT.0) THEN
391 NLEVEL=0
392 NVOLUM=0
393 DO 260 J=1, IQ(JVOLUM-2)
394 IF(LQ(JVOLUM-J).EQ.0) GOTO 270
395 NVOLUM=NVOLUM+1
396 260 CONTINUE
397 270 CONTINUE
398 ENDIF
399*
400 IF(JTMED.NE.0 )THEN
401 CALL UCOPY(Q(JTMED+1),CUTGAM,10)
402 NTMED=IQ(JTMED-2)
403 ENDIF
404*
405 IF(JPART.NE.0 ) NPART = IQ(JPART-2)
406 IF(JVERTX.NE.0) NVERTX = IQ(JVERTX+1)
407 IF(JKINE.NE.0) NTRACK = IQ(JKINE+1)
408 IF(JMATE.NE.0 ) NMATE = IQ(JMATE-2)
409 IF(JROTM.NE.0 ) NROTM = IQ(JROTM-2)
410 IF(JDRAW.GT.0 ) THEN
411 NKVIEW = IQ(JDRAW-2)
412 ELSE
413 NKVIEW = 0
414C
415C Book JDRAW structure for view banks
416C
417 CALL MZBOOK(IXCONS,JDRAW,JDRAW,1,'DRAW',0,0,0,3,0)
418 ENDIF
419
420C
421 IF(JHEAD.GT.0)THEN
422 IDRUN=IQ(JHEAD+1)
423 IDEVT=IQ(JHEAD+2)
424 ENDIF
425 IF(JRUNG.GT.0) THEN
426*
427* Here we deal with version numbers If JRUNG has been read in,
428* then save the version numbers of the new JRUNG and restore
429* the current version number for KINE, HITS and DIGI
430 DO 300 J=1, NLINK
431 IF(IVERSI(J).GT.0) THEN
432 NKEY = ABS(LINK(J))
433 IF(KNAMES(NKEY).EQ.'RUNG') THEN
434 DO 280 I=1,8
435 IDNEW(I) = IQ(JRUNG+10+I)
436 VERNEW(I) = Q(JRUNG+20+I)
437 280 CONTINUE
438*
439* And we put back the old version numbers because,
440* in principle, KINE, HITS and DIGI have not be read in
441 DO 290 I=3,8
442 IQ(JRUNG+10+I) = IDOLD(I)
443 Q(JRUNG+20+I) = VEROLD(I)
444 290 CONTINUE
445 ENDIF
446 ENDIF
447 300 CONTINUE
448*
449* And here we do it again for KINE, HITS and DIGI
450 DO 310 J=1, NLINK
451 IF(IVERSI(J).GT.0) THEN
452 NKEY = ABS(LINK(J))
453 IF(KNAMES(NKEY).EQ.'KINE') THEN
454 IF(IDNEW(3).GT.0) THEN
455 IQ(JRUNG+13) = IDNEW(3)
456 IQ(JRUNG+14) = IDNEW(4)
457 Q(JRUNG+23) = VERNEW(3)
458 Q(JRUNG+24) = VERNEW(4)
459 ENDIF
460 ELSEIF(KNAMES(NKEY).EQ.'HITS') THEN
461 IF(IDNEW(5).GT.0) THEN
462 IQ(JRUNG+15) = IDNEW(5)
463 IQ(JRUNG+16) = IDNEW(6)
464 Q(JRUNG+25) = VERNEW(5)
465 Q(JRUNG+26) = VERNEW(6)
466 ENDIF
467 ELSEIF(KNAMES(NKEY).EQ.'DIGI') THEN
468 IF(IDNEW(7).GT.0) THEN
469 IQ(JRUNG+17) = IDNEW(7)
470 IQ(JRUNG+18) = IDNEW(8)
471 Q(JRUNG+27) = VERNEW(7)
472 Q(JRUNG+28) = VERNEW(8)
473 ENDIF
474 ELSEIF(KNAMES(NKEY).EQ.'MATE'.OR. KNAMES(NKEY) .EQ.'TMED'
475 + ) THEN
476 IF(VERNEW(1).NE.0) THEN
477* We know which version number we are reading
478 IF(VERNEW(1).LT.GVERSN) THEN
479 WRITE(CHMAIL,10900) KNAMES(NKEY),VERNEW(1),
480 + GVERSN
481 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
482 WRITE(CHMAIL,11000)
483 IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
484 ENDIF
485 ENDIF
486 ENDIF
487 ENDIF
488 310 CONTINUE
489 ENDIF
490 320 CONTINUE
491*
49210000 FORMAT(' *** GFIN *** Key ',A4,' ignored for initialization')
49310100 FORMAT(' *** GFIN *** Key ',A4,' ignored for kinematics')
49410200 FORMAT(' *** GFIN *** Key ',A4,' ignored for trigger')
49510300 FORMAT(' *** GFIN *** Unknown key ',A4)
49610400 FORMAT(' *** GFIN *** No valid key given')
49710500 FORMAT(' *** GFIN *** Data structure ',A4,' version ',I10,
498 + ' successfully read in ')
49910600 FORMAT(' *** GFIN *** Data structure ',A4,' was not found')
50010700 FORMAT(' *** GFIN *** Data structure ',A4,' version ',I10,
501 + ' was not found')
50210800 FORMAT(' *** GFIN *** Nothing found to read !')
50310900 FORMAT(' *** GFIN *** ',A4,' data structure ',
504 + 'version ',F6.4,' current version is ',F6.4)
50511000 FORMAT(' Please call subroutine GPHYSI before ',
506 + 'tracking')
50711100 FORMAT(' *** GFIN *** Illegal number of links ',I10)
508 999 END