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 * *** Define user geometry set up
5 *
6 #include "calor.inc"
7 #include "geant321/gcbank.inc"
8 *
9  dimension par(3)
10 
11  dimension aair(2),zair(2),wair(2)
12  dimension aco2(2),zco2(2),wco2(2)
13  dimension ah2o(2),zh2o(2),wh2o(2)
14  dimension ag10(4),zg10(4),wg10(4)
15  dimension asci(2),zsci(2),wsci(2)
16  dimension acsi(2),zcsi(2),wcsi(2)
17 *
18  CHARACTER*4 volnam
19  CHARACTER*20 matnam
20 *
21 * *** Air compound parameters
22  DATA aair/14.01, 16.00/
23  DATA zair/ 7. , 8. /
24  DATA wair/ 0.7 , 0.3 /
25 *
26 * *** CO2 compound parameters
27  DATA aco2/12.01, 16.00/
28  DATA zco2/ 6. , 8. /
29  DATA wco2/ 1. , 2. /
30 *
31 * *** Water compound parameters
32  DATA ah2o/ 1.01, 16.00/
33  DATA zh2o/ 1. , 8. /
34  DATA wh2o/ 2. , 1. /
35 *
36 * *** G10 compound parameters
37  DATA ag10/ 1.01, 12.00, 16.00, 28.00/
38  DATA zg10/ 1. , 6. , 8. , 14. /
39  DATA wg10/ 3. , 3. , 2. , 1. /
40 *
41 * *** Scintillator compound parameters
42  DATA asci/12.01, 1.01/
43  DATA zsci/ 6. , 1. /
44  DATA wsci/ 9. , 10. /
45 *
46 * *** CsI compound parameters
47  DATA acsi/ 126.90, 132.90/
48  DATA zcsi/ 53. , 55. /
49  DATA wcsi/ 1. , 1. /
50 *
51 * *** Defines USER perticular materials
52  CALL gsmixt( 1,'Air' , aair ,zair, 1.29e-3, 2 , wair)
53  CALL gsmixt( 2,'CO2 gas' , aco2 ,zco2, 27.0e-3,-2 , wco2)
54  CALL gsmate( 3,'H2 Liquid', 1.008, 1., 0.0708 , 865., 790., 0,0)
55  CALL gsmixt( 4,'Water' , ah2o ,zh2o, 1.0 ,-2 , wh2o)
56  CALL gsmate( 5,'Liquid Ar', 39.95, 18., 1.39 , 14.0, 84.0, 0,0)
57  CALL gsmate( 6,'Aluminium', 26.98, 13., 2.7 , 8.9, 37.2, 0,0)
58  CALL gsmate( 7,'Iron ', 55.85, 26., 7.87 , 1.76, 17.1, 0,0)
59  CALL gsmate( 8,'Lead ',207.19, 82., 11.35 , 0.56, 18.5, 0,0)
60  CALL gsmate( 9,'Uranium ',238.03, 92., 18.95 , 0.32, 12. , 0,0)
61  CALL gsmate(10,'Silicon ', 28.09, 14., 2.33 , 9.36, 45.5, 0,0)
62  CALL gsmate(11,'Tungsten ',183.85, 74., 19.30 , 0.35, 9.6, 0,0)
63  CALL gsmixt(12,'NemaG10' , ag10 ,zg10, 1.7 ,-4 , wg10)
64  CALL gsmate(13,'Copper ', 63.55, 29., 8.96 , 1.43, 15.0, 0,0)
65  CALL gsmixt(14,'Scintilla', asci ,zsci, 1.032 ,-2 , wsci)
66  CALL gsmate(15,'Gold ',196.97, 79., 19.32 , 0.33, 9.6, 0,0)
67  CALL gsmixt(16,'CsI ', acsi ,zcsi, 4.534 ,-2 , wcsi)
68 *
69 * *** overwrite the computed radlength of some mixture
70  jma = lq(jmate-14)
71  q(jma+9) = 42.549
72 *
73 *
74 * *** Defines USER tracking media parameters
75  ifield = 0
76  IF (field.GT.0.) ifield = 3
77  fieldm = 10*field
78  tmaxfd = 10.0
79  stemax = 1000.
80  IF (stepmax.gt.0.) stemax = stepmax
81  deemax = 0.20
82  epsil = 0.001
83  stmin = 0.010
84 *
85  do k=1,nbabsor
86  CALL gstmed( k,'absorber',materabs(k), 0 ,ifield,fieldm,tmaxfd,
87  * stemax,deemax,epsil,stmin, 0 , 0 )
88  enddo
89 *
90 * *** set specific bcute/dcute (if any)
91  do k=1,4*nbabsor,4
92  itm = prodcut(k) + 0.01
93  if(itm.ge.1) then
94  call gstpar(itm,'BCUTE' ,prodcut(k+1))
95  call gstpar(itm,'BCUTM' ,prodcut(k+1))
96  call gstpar(itm,'DCUTE' ,prodcut(k+2))
97  call gstpar(itm,'DCUTM' ,prodcut(k+2))
98  call gstpar(itm,'PPCUTM',prodcut(k+3))
99  endif
100  enddo
101 *
102  nudef = nbabsor+1
103  CALL gstmed( nudef,'default' , 1 , 0 ,ifield,fieldm,tmaxfd,
104  * stemax,deemax,epsil,stmin, 0 , 0 )
105 *
106 *
107 * *** calor dimensions
108  thlayer = 0.
109  do k=1,nbabsor
110  thlayer = thlayer + thickabs(k)
111  enddo
112  calorx = nblayer*thlayer
113  worldx = 1.2*calorx
114  worldyz = 1.2*caloryz
115 *
116 * *** world
117  par(1) = worldx /2.
118  par(2) = worldyz/2.
119  par(3) = worldyz/2.
120  CALL gsvolu('worl','BOX ',nudef,par,3,ivol)
121 *
122 * *** calorimeter
123  par(1) = calorx /2.
124  par(2) = caloryz/2.
125  par(3) = caloryz/2.
126  CALL gsvolu('calo','BOX ',nudef,par,3,ivol)
127  CALL gspos('calo',1,'worl',0.,0.,0.,0,'ONLY')
128 *
129 * *** layers
130  CALL gsdvn('layr','calo',nblayer,1)
131 *
132 * *** absorbers
133  volnam = 'abs'
134  xfront = -0.5*thlayer
135  do k=1,nbabsor
136  par(1) = thickabs(k)/2.
137  par(2) = caloryz/2.
138  par(3) = caloryz/2.
139  volnam(4:4) = char(ichar('0')+k)
140  CALL gsvolu(volnam,'BOX ',k,par,3,ivol)
141  xcenter = xfront + 0.5*thickabs(k)
142  CALL gspos(volnam,1,'layr',xcenter,0.,0.,0,'ONLY')
143  xfront = xfront + thickabs(k)
144  enddo
145 *
146 * *** Close geometry banks. (mandatory system routine)
147  CALL ggclos
148 *
149 * *** print geometry
150  print 749
151  print 751,nblayer
152  do k=1,nbabsor
153  call gfmate(materabs(k),matnam,dua,duz,dud,dur,dui,udu,idu)
154  print 752,matnam,thickabs(k)
155  enddo
156  print 749
157 *
158  749 FORMAT(/ ,60(1h-),/)
159  751 FORMAT(1x,'The calorimeter is ',i2,' layers of:')
160  752 FORMAT(5x,a10,': ',f8.4,' cm')
161 *
162 * *** dessin
163  CALL gsatt('*' ,'SEEN',1)
164  CALL gsatt('layr','SEEN',0)
165 *
166  DO ix = 1,3
167  CALL gdopen(ix)
168  scale = 18./max(worldx,worldyz)
169  paxis = 0.
170  saxis = 1.
171  CALL gdrawc('worl',ix,0.,10.,9.3,scale,scale)
172 CCC CALL GDAXIS (PAXIS,PAXIS,PAXIS,SAXIS)
173  CALL gdscal(10. , 0.3)
174  CALL gdclos
175  END DO
176 *
177  END
Generated on Sat May 25 2013 14:32:19 for Geant4 by   doxygen 1.8.4