Geant4  9.6.p02
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
ugeom.F
Go to the documentation of this file.
1 
2  SUBROUTINE ugeom
3 *
4 #include "geomate.inc"
5 *
6  dimension awat(2),zwat(2),wwat(2)
7  dimension aair(2),zair(2),wair(2)
8  dimension pall(3),pvol(3)
9 C
10 C COMPOUND/MIXTURE PARAMETERS
11 C
12  DATA awat/1.01,16.00/
13  DATA zwat/1.,8./
14  DATA wwat/2.,1./
15  DATA aair/14.01,16.00/
16  DATA zair/7.,8./
17  DATA wair/0.7,0.3/
18 C
19 C DEFINE MATERIALS
20 C
21  CALL gsmate(21,'BERYLLIUM',9.010,4.,1.848,35.30,0.,0,0)
22  CALL gsmate(22,'ALUMINIUM',26.98,13.,2.70,8.900,0.,0,0)
23  CALL gsmate(23,'SILICON',28.09,14.,2.33,9.36,45.49,0,0)
24  CALL gsmate(24,'LIQUID ARGON',39.95,18.,1.4,14.,83.71,0,0)
25  CALL gsmate(25,'IRON',55.85,26.,7.87,1.760,0.,0,0)
26  CALL gsmate(26,'COPPER',63.54,29.,8.96,1.430,0.,0,0)
27  CALL gsmate(27,'GOLD',196.967,79.,19.32,0.33,0.,0,0)
28  CALL gsmate(28,'LEAD',207.190,82.,11.35,0.560,0.,0,0)
29  CALL gsmate(31,'XenonGas',131.29,54.,5.858e-3,1447.8,0.,0,0)
30  CALL gsmate(32,'Tungsten',183.85,74.,19.30,0.35,0.,0,0)
31 C
32  CALL gsmixt(29,'WATER',awat,zwat,1.00,-2,wwat)
33  CALL gsmixt(30,'AIR',aair,zair,1.205e-3,+2,wair)
34 C
35 C DEFINE MEDIA
36 C
37  ifield=0
38  if (fieldw.ne.0.) ifield=3
39  fieldm=10*fieldw
40 *
41  tmaxfd=10.
42  stemax=1.e+10
43  deemax=0.20
44  epsil=0.0001
45  stmin=0.0010
46 C
47  CALL gstmed(99,'WORLD',matwld,0,ifield,
48  * fieldm,tmaxfd,stemax,deemax,epsil,stmin,0,0)
49 C
50 
51  ifield=0
52  if (fielda.ne.0.) ifield=3
53  fieldm=10*fielda
54 *
55  deemax=deem
56  stmin =stmi
57  stemax=stma
58  CALL gstmed(1,'ABSORBER',matabs,0,ifield,
59  * fieldm,tmaxfd,stemax,deemax,epsil,stmin,0,0)
60 C
61 C
62 C DEFINE VOLUMES (WORLD+ABSORBER)
63 *
64  if(xworld*yzworl.le.0.) then
65  xworld=1.5*xabsor
66  yzworl=1.2*yzabso
67  endif
68 *
69  pall(1)=0.5*xworld
70  pall(2)=0.5*yzworl
71  pall(3)=0.5*yzworl
72  CALL gsvolu('worl','BOX ',99,pall,3,ivol)
73 C
74  pvol(1)=0.5*xabsor
75  pvol(2)=0.5*yzabso
76  pvol(3)=0.5*yzabso
77  CALL gsvolu('abso','BOX ', 1,pvol,3,ivol)
78 C
79 C BUILD GEOMETRY
80 C
81  CALL gspos('abso',1,'worl',xposab,0.,0.,0,'ONLY')
82 *
83  x1abso = xposab - 0.5*xabsor
84  x2abso = xposab + 0.5*xabsor
85 *
86 * *** Close geometry banks. (mandatory system routine)
87  CALL ggclos
88 *
89 *
90 * *** dessin
91  CALL gsatt('*','SEEN',1)
92 *
93  DO ix = 1,3
94  CALL gdopen(ix)
95  scale = 18./max(xworld,yzworl)
96  paxis = 0.
97  saxis = 0.1*max(xworld,yzworl)
98  CALL gdrawc('worl',ix,0.,10.,9.3,scale,scale)
99 CCC CALL GDAXIS (PAXIS,PAXIS,PAXIS,SAXIS)
100  CALL gdscal(10., 0.3)
101  CALL gdclos
102  END DO
103 *
104  END