ECCE @ EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
ugeom.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file ugeom.F
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