]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/geocad/gdexca.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Some function moved to AliZDC
[u/mrichter/AliRoot.git] / GEANT321 / geocad / gdexca.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:20:46 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/03 13/09/94 18.53.20 by S.Ravndal
11*-- Author :
12 SUBROUTINE GDEXCA(NAME,NBINS)
13C.
14C. ******************************************************************
15C. * *
16C. * Based on GDRAW, calculates parameters of each volume *
17C. * Areas marked JV + NH *
18C. * *
19C. * Called by GTXSET *
20C. * *
21C. * Authors : R.Brun, A.McPherson, P.Zanarini, ********* *
22C. * J.Salt, S.Giani , J. Vuoskoski, N. Hoimyr *
23C. ******************************************************************
24C.
25C JV
26#include "geant321/gcsetf.inc"
27C
28#include "geant321/gcbank.inc"
29#include "geant321/gcvolu.inc"
30#include "geant321/gcunit.inc"
31#include "geant321/gcdraw.inc"
32#include "geant321/gconst.inc"
33#include "geant321/gcnum.inc"
34#include "geant321/gcdlin.inc"
35#include "geant321/gcmutr.inc"
36*JS
37#include "geant321/gcgobj.inc"
38C+SEQ,CGHPAR.
39#include "geant321/gchiln.inc"
40#include "geant321/gcspee.inc"
41*JS
42*
43*
44C this by jv
45 DIMENSION PARMJV(9), POSJV(3)
46C if volume is divided jdvinf(level) is 1
47 DIMENSION JDVINF(0:15)
48 CHARACTER*4 JVVOLU,JVVOLD, NAME,NAMEE2
49 CHARACTER*10 VOLNAM
50 DIMENSION X(3),ATT(10)
51 DIMENSION LVOLS(15),LINDX(15),LNAMES(15)
52 DIMENSION GPAR(50,15)
53* INTEGER START, OLDOLD, PASS
54C
55 IF(JCADNT.EQ.0) THEN
56 CALL MZBOOK(IXSTOR,JCADNT,JCADNT,1,'CADI',1,1,0,2,-1)
57 CALL MZBOOK(IXSTOR,JBUF1,
58 + JCADNT,-1,'CAD1',0,0,NVOLUM,2,-1)
59 ENDIF
60 DO 10 JV=1,NVOLUM
61 IQ(JBUF1+JV)=0
62 10 CONTINUE
63 JDVINF(0)=0
64 JLEVEL=0
65 MYSEEN=1
66 JVVOLU='----'
67C
68C Set IOBJ to VOLUME
69C
70 IOBJ=1
71C
72C Save /GCVOLU/ if necessary
73C
74 IFCVOL=0
75 IF (NLEVEL.NE.0) THEN
76 CALL GSCVOL
77 IFCVOL=1
78 ENDIF
79 IF (NLEVEL.LT.0) NLEVEL=IABS(NLEVEL)
80C
81C Start of general code
82C
83 CALL GLOOK(NAME,IQ(JVOLUM+1),NVOLUM,IVO)
84 IF(IVO.LE.0)GO TO 210
85C
86C Theta, phi and psi angles are normalized in [0-360[ range
87C
88*
89 JVO=LQ(JVOLUM-IVO)
90C
91C Initialize JIN to switch correctly CALL GFPARA/GFIPAR
92C
93 JIN=0
94C
95 LEVSEE=1000
96C
97 IF (IDRNUM.NE.0) GO TO 30
98C
99C Initialize for new geometry structure
100C
101 IF (JGPAR.EQ.0) CALL GMEDIN
102 CALL GLMOTH(NAME,1,NLEV,LVOLS,LINDX)
103 DO 20 J=1, NLEV
104 LNAMES(J)=IQ(JVOLUM+LVOLS(J))
105 20 CONTINUE
106 NLEV=NLEV+1
107 CALL UCTOH(NAME,LNAMES(NLEV),4,4)
108 LINDX(NLEV)=1
109 CALL GLVOLU(NLEV, LNAMES, LINDX, IER)
110C
111 NLVTOP=NLEVEL
112C
113 30 CONTINUE
114C
115 NLMIN=NLEVEL
116 NLMAX=NLEVEL
117C
118 IF (IDRNUM.NE.0) GO TO 70
119C
120 CALL GFPARA(NAME,1,1,NPAR,NATT,GPAR(1,NLEVEL),ATT)
121C
122 IF (NPAR.LE.0) GO TO 220
123C
124 DO 60 LLL=1,NLEVEL
125 DO 50 I=1,3
126 GTRAN(I,LLL)=0.0
127 X(I)=0.0
128 DO 40 J=1,3
129 K=(I-1)*3+J
130 GRMAT(K,LLL)=0.0
131 40 CONTINUE
132 K=I*4-3
133 GRMAT(K,LLL)=1.0
134 50 CONTINUE
135 GRMAT(10,LLL)=0.0
136 60 CONTINUE
137C
138C Ready for general case code
139C
140 70 CONTINUE
141*SG
142* Taking volume name and shape from Zebra Structure
143*
144 IVOLNA=IQ(JVOLUM+IVO)
145 ISHAPE=Q(JVO+2)
146*SG
147C
148 IF (IDRNUM.NE.0) GO TO 80
149C
150 IF (NLEVEL.EQ.NLVTOP) GO TO 90
151C
152 80 CONTINUE
153C
154 IF (IDRNUM.NE.0.AND.JIN.EQ.0) THEN
155 CALL UHTOC(NAMES(NLEVEL),4,NAMEE2,4)
156 CALL GFPARA(NAMEE2,NUMBER(NLEVEL),1,NPAR,
157 + NATT,GPAR(1,NLEVEL),ATT)
158 ELSE
159 NPAR=Q(JVO+5)
160 NATT=Q(JVO+6)
161 JATT=JVO+7+NPAR
162 CALL UCOPY(Q(JATT),ATT,NATT)
163 ENDIF
164C
165 90 CONTINUE
166C
167 WORK=ATT(1)
168 SEEN=ATT(2)
169
170*
171 LINSTY=ATT(3)
172 LINWID=ATT(4)
173 LINCOL=ATT(5)
174 LINFIL=ATT(6)
175 CALL MVBITS(LINCOL,0,4,LINATT,7)
176 CALL MVBITS(LINWID,0,3,LINATT,11)
177 CALL MVBITS(LINSTY,0,3,LINATT,14)
178 CALL MVBITS(LINFIL,0,3,LINATT,17)
179*
180***SG
181*
182* New logic scanning the geometrical tree:
183* A volume can set bounds OR be compared with bounds;
184* this can happen only IF a relationship mother-daughters exists.
185*
186* Optimization for Hidden Volume Removal:
187* POS and DIV cases are considered at the same time.
188*
189* IF(START.EQ.1)THEN
190*
191* IF(NLEVEL.GT.OLDOLD)THEN
192* IF(PASS.NE.0)THEN
193* S1=0
194* S2=0
195* S3=0
196* SS1=0
197* SS2=0
198* SS3=0
199* SRAGMX=0
200* SRAGMN=0
201* PASS=0
202* IF(SEEN.EQ.0.OR.SEEN.EQ.-1)PASS=1
203* OLDOLD=NLEVEL
204* ENDIF
205*
206* ELSE IF(NLEVEL.LE.OLDOLD)THEN
207* S1=0
208* S2=0
209* S3=0
210* SS1=0
211* SS2=0
212* SS3=0
213* SRAGMX=0
214* SRAGMN=0
215* PASS=0
216* IF(SEEN.EQ.0.OR.SEEN.EQ.-1)PASS=1
217* OLDOLD=NLEVEL
218* ENDIF
219* ENDIF
220*
221* IF(OLDOLD.EQ.0.AND.(SEEN.EQ.1.OR.SEEN.EQ.-2))THEN
222* START=1
223* PASS=0
224* OLDOLD=NLEVEL
225* ENDIF
226C
227C WORK attribute enabled ?
228C
229 IF(WORK.LE.0.)GO TO 200
230C
231C SEEN attribute processing
232C
233 IF (SEEN.LT.50.) GO TO 100
234 ISEENL=SEEN/10.+0.5
235 SEEN=ISEENL-10
236 100 CONTINUE
237C
238 IF(NLEVEL.LE.LEVSEE)LEVSEE=1000
239 IF(SEEN.EQ.-1.)GO TO 200
240 IF (NLEVEL.GT.LEVSEE) GO TO 200
241 IF(SEEN.EQ.0.)GO TO 150
242 IF (SEEN.EQ.-2.) LEVSEE=NLEVEL
243C
244* Standard Mode: Output to SET
245*
246C-----------------------JV----Mod NH---------------------------
247C Get positioning variables
248C
249 IF(NLEVEL.LT.JLEVEL)THEN
250 CALL GSATT(JVVOLU,'SEEN',MYSEEN)
251 Q(JBUF1+MYIVO)=0
252 ENDIF
253 JVO=LQ(JVOLUM-IVO)
254 NIN=Q(JVO+3)
255 IF(NIN.LT.0) THEN
256 JDVINF(NLEVEL)=1
257 ELSE
258 JDVINF(NLEVEL)=0
259 ENDIF
260C
261C if division
262 IF (JDVINF(NLEVEL-1).EQ.1) THEN
263C
264 IF (IQ(JBUF1+IVO).LT.NBINS) THEN
265 DO 110 JV=1, 9
266 PARMJV(JV)=GRMAT(JV,NLEVEL)
267 110 CONTINUE
268C
269 DO 120 JV=1, 3
270 POSJV(JV)=GTRAN(JV,NLEVEL)
271 120 CONTINUE
272C
273C Appends new name VOLNAM to each volume, with index.
274C
275 IQ(JBUF1+IVO)=IQ(JBUF1+IVO)+1
276 WRITE(VOLNAM(1:5),10200)IVOLNA
277 WRITE(VOLNAM(6:10),'(I4.0)')IQ(JBUF1+IVO)
278C
279C Call SHAPE to SET routines
280C
281C Updates SET block sequence number:
282 N1=N1+1
283 CALL GETSHP(ISHAPE,GPAR(1,NLEVEL))
284C
285C Position the volumes
286C
287 N1=N1+1
288 CALL GPOSI(PARMJV,POSJV,VOLNAM,LINCOL)
289C
290 ELSE
291 JVVOLD=JVVOLU
292 CALL UHTOC(IVOLNA,4,JVVOLU,4)
293 IF(JVVOLD.NE.JVVOLU)MYSEEN=ATT(2)
294 CALL GSATT(JVVOLU,'SEEN',-1)
295 JLEVEL=NLEVEL
296 MYIVO=IVO
297 GOTO 200
298 ENDIF
299C
300C normal volumes
301 ELSE
302 DO 130 JV=1, 9
303 PARMJV(JV)=GRMAT(JV,NLEVEL)
304 130 CONTINUE
305C
306 DO 140 JV=1, 3
307 POSJV(JV)=GTRAN(JV,NLEVEL)
308 140 CONTINUE
309C
310C Appends new name VOLNAM to each volume, with index.
311C
312 IQ(JBUF1+IVO)=IQ(JBUF1+IVO)+1
313 WRITE(VOLNAM(1:5),10200)IVOLNA
314 WRITE(VOLNAM(6:10),'(I4.0)')IQ(JBUF1+IVO)
315C
316C Call SHAPE to SET routines
317C
318C Updates SET block sequence number:
319 N1=N1+1
320 CALL GETSHP(ISHAPE,GPAR(1,NLEVEL))
321C
322C Position the volumes
323C
324 N1=N1+1
325 CALL GPOSI(PARMJV,POSJV,VOLNAM,LINCOL)
326 ENDIF
327C------------------------------------------------------------------------
328C Output of material list
329C
330 IF (IQ(JBUF1+IVO).EQ.1) THEN
331 NTRMED=Q(JVO+4)
332 CALL GPTSET (IVOLNA, NTRMED)
333 ENDIF
334C------------------------------END JV------------------------------------
335C
336*JS
337*
338* Logic has been modified >>>>>
339*
340*
341*JS
342 IF(SEEN.EQ.-2.)GO TO 200
343C
344 150 CONTINUE
345C
346*** IF (IDRNUM.NE.0) GO TO 999
347C
348C Skip User shapes (not yet implemented)
349C
350** ISEARC=Q(JVO+1)
351C
352C Now go down the tree
353C
354 NIN=Q(JVO+3)
355 IF(NIN.EQ.0) GO TO 200
356 IF(NIN.LT.0) GO TO 170
357C
358C Contents placed by GSPOS
359C
360 IN=0
361 IF(NLMAX.GT.NLEVEL) IN=LINDEX(NLEVEL+1)
362 IN=IN+1
363 IF(IN.GT.NIN.AND.NLEVEL.EQ.NLMIN) GO TO 230
364*
365 IF(IN.GT.NIN) GO TO 190
366*
367 CALL GMEPOS(JVO,IN,X,0)
368*
369 NPAR=IQ(JGPAR+NLEVEL)
370 DO 160 I=1,NPAR
371 GPAR(I,NLEVEL)=Q(LQ(JGPAR-NLEVEL)+I)
372 160 CONTINUE
373*
374 IVO=LVOLUM(NLEVEL)
375 JVO=LQ(JVOLUM-IVO)
376 NLMAX=NLEVEL
377 GO TO 70
378C
379 170 CONTINUE
380C
381C Contents by division
382C
383 IN=0
384 IF(NLMAX.GT.NLEVEL) IN=LINDEX(NLEVEL+1)
385 IN=IN+1
386 CALL GMEDIV(JVO,IN,X,0)
387*
388 IF (IN.EQ.0) GO TO 190
389*
390 NPAR=IQ(JGPAR+NLEVEL)
391 DO 180 I=1,NPAR
392 GPAR(I,NLEVEL)=Q(LQ(JGPAR-NLEVEL)+I)
393 180 CONTINUE
394*
395 IF (IN.EQ.0) GO TO 190
396*
397 IVO=LVOLUM(NLEVEL)
398 JVO=LQ(JVOLUM-IVO)
399 NLMAX=NLEVEL
400 GO TO 70
401C
402 190 CONTINUE
403 NLMAX=NLEVEL
404 200 CONTINUE
405 NLEVEL=NLEVEL-1
406 IF(NLEVEL.LT.NLMIN) GO TO 230
407 IVO=LVOLUM(NLEVEL)
408 JVO=LQ(JVOLUM-IVO)
409 GO TO 150
410C
411 210 WRITE(CHMAIL,10000)NAME
412 CALL GMAIL(0,0)
413 GO TO 230
414C
415 220 CONTINUE
416C
417C TOP OF THE TREE HAS PARAMETERS SET BY GSPOSP.
418C BUT GDRAW DOES NOT HAVE ACCESS TO THE IN BANK
419C WHICH PLACED IT IN ITS MOTHER.
420C
421 WRITE(CHMAIL,10100) NAME
422 CALL GMAIL(0,0)
423C
424 230 CONTINUE
425*
426***SG
427*
428*JS
429 IF(KCGST.EQ.-9)THEN
430 KSHIFT=0
431 IF(JCG.NE.0)CALL MZDROP(IXSTOR,JCG,' ')
432 IF(JCGOBJ.NE.0)CALL MZDROP(IXSTOR,JCGOBJ,' ')
433 CALL GDCGRS
434 IF(JCGCOL.NE.0)CALL MZDROP(IXSTOR,JCGCOL,' ')
435 LARECG(1)=0
436 CALL MZGARB(IXSTOR+1,0)
437 NCLAS2=0
438 NCLAS3=0
439 ENDIF
440 ICUT=0
441 IF (IFCVOL.EQ.1) THEN
442 CALL GFCVOL
443 ELSE
444 NLEVEL=0
445 ENDIF
446C
447C Restore permanent value of color and return
448C
449 CALL GDCOL(0)
450 IOBJ=0
451C
45210000 FORMAT(' *** GDEXCA *** : Volume ',A4,' does not exist')
45310100 FORMAT(' *** GDEXCA *** : Top of tree ',A4,' parameters defined',
454 + ' by GSPOSP - info not available to GDEXCA.')
45510200 FORMAT(A4,'_')
456 END