]>
Commit | Line | Data |
---|---|---|
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 GFOUT(LUN,CHOBJ,NKEYS,IDVERS,CHOPT,IER) | |
13 | C. | |
14 | C. ****************************************************************** | |
15 | C. * * | |
16 | C. * Routine to write GEANT object(s) into the FZ file * | |
17 | C. * The data structures in memory are written on disk * | |
18 | C. * * | |
19 | C. * LUN Logical unit * | |
20 | C. * * | |
21 | C. * CHOBJ The type of data structure to be written: * | |
22 | C. * MATE material * | |
23 | C. * TMED tracking medium * | |
24 | C. * VOLU volumes * | |
25 | C. * ROTM rotation matrix * | |
26 | C. * SETS detector set * | |
27 | C. * PART particle * | |
28 | C. * SCAN geometry * | |
29 | C. * INIT all above * | |
30 | C. * KINE this keyword will trigger the write of * | |
31 | C. * KINE and VERT unless the flag 'S' is set * | |
32 | C. * DIGI digitisation * | |
33 | C. * DRAW drawing * | |
34 | C. * HEAD event header * | |
35 | C. * HITS hits * | |
36 | C. * RUNG run * | |
37 | C. * STAK particle temporary stack * | |
38 | C. * STAT volume statistic * | |
39 | C. * VERT vertex * | |
40 | C. * JXYZ track points * | |
41 | C. * TRIG this keyword will trigger the write of * | |
42 | C. * DIGI, HEAD, HITS, KINE, VERT abd JXYZ * | |
43 | C. * unless the 'S' flag is set * | |
44 | C. * * | |
45 | C. * NKEYS number of keys in vector CHOBJ * | |
46 | C. * * | |
47 | C. * IDVERS version of the data structure to be written out * | |
48 | C. * * | |
49 | C. * CHOPT List of options * | |
50 | C. * 'I' write only initialisation data * | |
51 | C. * structures * | |
52 | C. * 'K' write only KINE and TRIG data * | |
53 | C. * structures * | |
54 | C. * 'T' write only DIGI, HEAD, HITS, KINE, * | |
55 | C. * VERT and JXYZ data structures * | |
56 | C. * even if other keys are specified in CHOBJ * | |
57 | C. * * | |
58 | C. * 'S' interpret KINE to mean only * | |
59 | C. * KINE and TRIG and INIT to mean * | |
60 | C. * nothing * | |
61 | C. * 'Q' quiet option, no message is * | |
62 | C. * printed * | |
63 | C. * * | |
64 | C. * IER error flag. <0 ZEBRA error flag as returned in * | |
65 | C. * IQUEST(1) * | |
66 | C. * 0 read completed successfully * | |
67 | C. * >0 if only IER structures read in * | |
68 | C. * * | |
69 | C. * The FZ data base can be read in via GOPEN/GFIN * | |
70 | C. * * | |
71 | C. * * | |
72 | C. * Example. * | |
73 | C. * * | |
74 | C. * CALL GOPEN(1,'O',1024,IER) * | |
75 | C. * CALL GFOUT (1,'VOLU',1,0,' ',IER) * | |
76 | C. * CALL GFOUT (1,'MATE',1,0,' ',IER) * | |
77 | C. * CALL GFOUT (1,'TMED',1,0,' ',IER) * | |
78 | C. * CALL GFOUT (1,'ROTM',1,0,' ',IER) * | |
79 | C. * CALL GFOUT (1,'PART',1,0,' ',IER) * | |
80 | C. * CALL GFOUT (1,'SCAN',1,0,' ',IER) * | |
81 | C. * CALL GFOUT (1,'SETS',1,0,' ',IER) * | |
82 | C. * * | |
83 | C. * ==>Called by : <USER> ,GOPEN * | |
84 | C. * Author F.Carminati ******* * | |
85 | C. * * | |
86 | C. ****************************************************************** | |
87 | C. | |
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 IUHEAD(2),ITRAN(23),JTRAN(23) | |
107 | EQUIVALENCE (JNAMES(1),JDIGI) | |
108 | CHARACTER*4 KNAMES(NMKEY),CHOBJ(*) | |
109 | CHARACTER*(*) CHOPT | |
110 | DATA KNAMES/'DIGI','DRAW','HEAD','HITS','KINE','MATE','PART', | |
111 | + 'ROTM','RUNG','SETS','STAK','STAT','TMED','NULL','VERT', | |
112 | + 'VOLU','JXYZ','NULL','NULL','NULL','SCAN','NULL'/ | |
113 | DATA ITRAN/7,6,13,16,8,10,2,9,8*0,3,15,5,17,4,1,21/ | |
114 | DATA JTRAN/22,7,17,21,19,2,1,5,8,6,2*0,3,0,18,4,20,3*0,23,2*0/ | |
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 | C. | |
120 | C. ------------------------------------------------------------------ | |
121 | C. | |
122 | IQUEST(1)=0 | |
123 | IER=0 | |
124 | LDIV(1) =IXCONS | |
125 | LDIV(2) =IXDIV | |
126 | * | |
127 | IOPTI=INDEX(CHOPT,'i')+INDEX(CHOPT,'I') | |
128 | IOPTT=INDEX(CHOPT,'t')+INDEX(CHOPT,'T') | |
129 | IOPTK=INDEX(CHOPT,'k')+INDEX(CHOPT,'K') | |
130 | IOPTS=INDEX(CHOPT,'s')+INDEX(CHOPT,'S') | |
131 | IOPTQ=INDEX(CHOPT,'q')+INDEX(CHOPT,'Q') | |
132 | * | |
133 | NLINK=0 | |
134 | DO 90 JKEY=1,NKEYS | |
135 | IF(IOPTS.EQ.0) THEN | |
136 | IF(CHOBJ(JKEY).EQ.'INIT') THEN | |
137 | DO 20 J=1, NLINIT | |
138 | DO 10 MLINK=1,NLINK | |
139 | IF(LINK(MLINK).EQ.LINIT(J)) GO TO 20 | |
140 | 10 CONTINUE | |
141 | NLINK=NLINK+1 | |
142 | LINK(NLINK)=LINIT(J) | |
143 | 20 CONTINUE | |
144 | GO TO 90 | |
145 | ELSEIF(CHOBJ(JKEY).EQ.'TRIG') THEN | |
146 | DO 40 J=1, NLTRIG | |
147 | DO 30 MLINK=1,NLINK | |
148 | IF(LINK(MLINK).EQ.LTRIG(J)) GO TO 40 | |
149 | 30 CONTINUE | |
150 | NLINK=NLINK+1 | |
151 | LINK(NLINK)=LTRIG(J) | |
152 | 40 CONTINUE | |
153 | GO TO 90 | |
154 | ELSEIF(CHOBJ(JKEY).EQ.'KINE') THEN | |
155 | DO 60 J=1, NLKINE | |
156 | DO 50 MLINK=1,NLINK | |
157 | IF(LINK(MLINK).EQ.LKINE(J)) GO TO 60 | |
158 | 50 CONTINUE | |
159 | NLINK=NLINK+1 | |
160 | LINK(NLINK)=LKINE(J) | |
161 | 60 CONTINUE | |
162 | GO TO 90 | |
163 | ENDIF | |
164 | ENDIF | |
165 | DO 80 J=1,NMKEY | |
166 | IF(CHOBJ(JKEY).EQ.KNAMES(J)) THEN | |
167 | DO 70 MLINK=1,NLINK | |
168 | IF(LINK(MLINK).EQ.J) GO TO 90 | |
169 | 70 CONTINUE | |
170 | NLINK=NLINK+1 | |
171 | LINK(NLINK)=J | |
172 | GO TO 90 | |
173 | ENDIF | |
174 | 80 CONTINUE | |
175 | WRITE(CHMAIL,10300) CHOBJ(JKEY) | |
176 | IF(IOPTQ.EQ.0) CALL GMAIL(0,0) | |
177 | 90 CONTINUE | |
178 | * | |
179 | IF(IOPTI.GT.0) THEN | |
180 | DO 110 J=1, NLINK | |
181 | DO 100 K=1, NLINIT | |
182 | IF(LINK(J).EQ.LINIT(K)) GO TO 110 | |
183 | 100 CONTINUE | |
184 | WRITE(CHMAIL,10000) KNAMES(LINK(J)) | |
185 | IF(IOPTQ.EQ.0) CALL GMAIL(0,0) | |
186 | LINK(J)=0 | |
187 | 110 CONTINUE | |
188 | ELSEIF(IOPTK.GT.0) THEN | |
189 | DO 130 J=1, NLINK | |
190 | DO 120 K=1, NLKINE | |
191 | IF(LINK(J).EQ.LKINE(K)) GO TO 130 | |
192 | 120 CONTINUE | |
193 | WRITE(CHMAIL,10100) KNAMES(LINK(J)) | |
194 | IF(IOPTQ.EQ.0) CALL GMAIL(0,0) | |
195 | LINK(J)=0 | |
196 | 130 CONTINUE | |
197 | ELSEIF(IOPTT.GT.0) THEN | |
198 | DO 150 J=1, NLINK | |
199 | DO 140 K=1, NLTRIG | |
200 | IF(LINK(J).EQ.LTRIG(K)) GO TO 150 | |
201 | 140 CONTINUE | |
202 | WRITE(CHMAIL,10200) KNAMES(LINK(J)) | |
203 | IF(IOPTQ.EQ.0) CALL GMAIL(0,0) | |
204 | LINK(J)=0 | |
205 | 150 CONTINUE | |
206 | ENDIF | |
207 | * | |
208 | IOFF=0 | |
209 | DO 160 J=1, NLINK | |
210 | IF(LINK(J).EQ.0) THEN | |
211 | IOFF=IOFF-1 | |
212 | ELSE | |
213 | LINK(J+IOFF)=LINK(J) | |
214 | ENDIF | |
215 | 160 CONTINUE | |
216 | NLINK=NLINK+IOFF | |
217 | IF(IOPTI+IOPTK+IOPTT.EQ.0) THEN | |
218 | * | |
219 | * We have to choose which event header to write, JRUNG or JHEAD | |
220 | * If the banks list contains banks which depends on both headers, | |
221 | * the result is unpredictable. Error message to be inserted later. | |
222 | DO 168 J=1, NLINK | |
223 | DO 161 L=1, NLINIT | |
224 | IF(LINK(J).EQ.LINIT(L)) THEN | |
225 | IOPTI=-1 | |
226 | GOTO 169 | |
227 | ENDIF | |
228 | 161 CONTINUE | |
229 | DO 162 L=1, NLKINE | |
230 | IF(LINK(J).EQ.LKINE(L)) THEN | |
231 | IOPTK=-1 | |
232 | GOTO 169 | |
233 | ENDIF | |
234 | 162 CONTINUE | |
235 | DO 163 L=1, NLTRIG | |
236 | IF(LINK(J).EQ.LTRIG(L)) THEN | |
237 | IOPTT=-1 | |
238 | GOTO 169 | |
239 | ENDIF | |
240 | 163 CONTINUE | |
241 | 168 CONTINUE | |
242 | 169 CONTINUE | |
243 | ENDIF | |
244 | * | |
245 | IF(NLINK.LE.0) THEN | |
246 | WRITE(CHMAIL,10400) | |
247 | IF(IOPTQ.EQ.0) CALL GMAIL(0,0) | |
248 | IER=-1 | |
249 | GOTO 999 | |
250 | ENDIF | |
251 | * | |
252 | NWOUT=0 | |
253 | IOFW =0 | |
254 | DO 170 J=1,NLINK | |
255 | IVERSI(J)=0 | |
256 | IRESUL(J)=0 | |
257 | NKEY=LINK(J) | |
258 | IF(NKEY.EQ.3.OR.NKEY.EQ.9) THEN | |
259 | IOFW=1 | |
260 | NPOS=J | |
261 | ENDIF | |
262 | LINK(J)=-ABS(LINK(J)) | |
263 | IF(NKEY.LE.20)THEN | |
264 | IF(JNAMES(NKEY).NE.0) THEN | |
265 | LINK(J)=ABS(LINK(J)) | |
266 | NWOUT=NWOUT+1 | |
267 | ENDIF | |
268 | ELSE | |
269 | NKL=NKEY-20 | |
270 | IF(ISLINK(NKL).NE.0) THEN | |
271 | LINK(J)=ABS(LINK(J)) | |
272 | NWOUT=NWOUT+1 | |
273 | ENDIF | |
274 | ENDIF | |
275 | 170 CONTINUE | |
276 | * | |
277 | * Write next start of event data structure | |
278 | IUHEAD(1)=IDVERS | |
279 | IUHEAD(2)=NWOUT-IOFW | |
280 | NUH=2 | |
281 | IF(IOPTI.NE.0) THEN | |
282 | CALL FZOUT(LUN,IXCONS,JRUNG,1,'L',2,NUH,IUHEAD) | |
283 | ELSEIF(IOPTT+IOPTK.NE.0) THEN | |
284 | CALL FZOUT(LUN,IXDIV,JHEAD,1,'L',2,NUH,IUHEAD) | |
285 | ENDIF | |
286 | IF(IQUEST(1).EQ.0) THEN | |
287 | IVERSI(NPOS)=IDVERS | |
288 | IRESUL(NPOS)=1 | |
289 | ELSE | |
290 | WRITE(CHMAIL,10500) KNAMES(LINK(NPOS)) | |
291 | ENDIF | |
292 | * | |
293 | DO 180 IK=1,NLINK | |
294 | * | |
295 | * Write selected data structures | |
296 | NKEY=LINK(IK) | |
297 | IF(NKEY.GT.0) THEN | |
298 | IF(NKEY.EQ.9) THEN | |
299 | GOTO 180 | |
300 | ELSEIF(NKEY.EQ.3) THEN | |
301 | GOTO 180 | |
302 | ELSEIF(NKEY.EQ.1) THEN | |
303 | CALL GRLEAS(JDIGI) | |
304 | ELSEIF(NKEY.EQ.4) THEN | |
305 | CALL GRLEAS(JHITS) | |
306 | ENDIF | |
307 | IDIV=LDIV(IXD(NKEY)) | |
308 | JKEY=JTRAN(NKEY) | |
309 | IF(NKEY.LE.20)THEN | |
310 | CALL FZOUT(LUN,IDIV,JNAMES(NKEY),0,'L',2,1,JKEY) | |
311 | ELSE | |
312 | NKL=NKEY-20 | |
313 | CALL FZOUT(LUN,IDIV,ISLINK(NKL),0,'L',2,1,JKEY) | |
314 | ENDIF | |
315 | IF(IQUEST(1).EQ.0) THEN | |
316 | IVERSI(IK)=IDVERS | |
317 | IRESUL(IK)=1 | |
318 | ELSE | |
319 | WRITE(CHMAIL,10500) KNAMES(NKEY) | |
320 | ENDIF | |
321 | ENDIF | |
322 | 180 CONTINUE | |
323 | * | |
324 | NOUT=0 | |
325 | DO 190 I=1,NLINK | |
326 | IF(IRESUL(I).EQ.1) THEN | |
327 | WRITE(CHMAIL,10600) KNAMES(ABS(LINK(I))),IVERSI(I) | |
328 | IF(IOPTQ.EQ.0) CALL GMAIL(0,0) | |
329 | NOUT=NOUT+1 | |
330 | ELSE | |
331 | WRITE(CHMAIL,10700) KNAMES(ABS(LINK(I))) | |
332 | IF(IOPTQ.EQ.0) CALL GMAIL(0,0) | |
333 | ENDIF | |
334 | 190 CONTINUE | |
335 | * | |
336 | IF(NOUT.LE.0) THEN | |
337 | WRITE(CHMAIL,10800) | |
338 | IF(IOPTQ.EQ.0) CALL GMAIL(0,0) | |
339 | IER=-1 | |
340 | ELSEIF(NOUT.LT.NLINK) THEN | |
341 | IER=NOUT | |
342 | ENDIF | |
343 | * | |
344 | 10000 FORMAT(' *** GFOUT *** Key ',A4,' ignored for initialization') | |
345 | 10100 FORMAT(' *** GFOUT *** Key ',A4,' ignored for kinematics') | |
346 | 10200 FORMAT(' *** GFOUT *** Key ',A4,' ignored for trigger') | |
347 | 10300 FORMAT(' *** GFOUT *** Unknown key ',A4) | |
348 | 10400 FORMAT(' *** GFOUT *** No valid key given') | |
349 | 10500 FORMAT(' *** GFOUT *** Problems writing data structure ',A4) | |
350 | 10600 FORMAT(' *** GFOUT *** Data structure ',A4,' version ',I10, | |
351 | + ' successfully written out') | |
352 | 10700 FORMAT(' *** GFOUT *** Data structure ',A4,' not found') | |
353 | 10800 FORMAT(' *** GFOUT *** Nothing written out !') | |
354 | 999 END |