sane_geant_mc/SRC/ugeom.f - annotate

Return to ugeom.f CVS log

Up to [HallC] / sane_geant_mc / SRC

1 jones 1.1 SUBROUTINE UGEOM 2 3 implicit none 4 5 include 'constants.inc' 6 include 'geant.inc' 7 include 'sane.inc' 8 include 'materials.inc' 9 include 'beta_geom.inc' 10 include 'sane_misc.inc' 11 12 ! C------------ Including beta_geom.inc parameters here - JDM - 05/27/07 13 ! 14 ! C-- beta_geom.inc Glen Warren 8/03 15 ! C-- 16 ! C-- details geometry of BETA detector 17 ! 18 ! C Detector geometry 19 ! 20 ! real4 block_height, block_width 21 ! real4 cal_height,cal_width 22 jones 1.1 ! real4 cal_depth 23 ! real4 cer_length 24 integer4 horzBl,vertBl 25 ! 26 ! parameter( block_height = 4.d0 ) 27 ! parameter( block_width = 4.d0 ) 28 parameter( horzBl = 28 ) 29 parameter( vertBl = 58 ) 30 ! parameter( cal_depth = 40.d0 ) 31 ! parameter( cer_length = 150.d0 ) 32 ! 33 ! parameter( cal_height = vert_blocksblock_height ) 34 ! parameter( cal_width = horz_blocksblock_width ) 35 ! 36 ! real4 gain_thk 37 ! 38 ! parameter( gain_thk = 1./2.) 39 ! 40 ! real4 cer_win_thk 41 ! 42 ! parameter( cer_win_thk = 0.0127 ) 43 jones 1.1 ! 44 ! real4 hodo_thk 45 ! 46 ! parameter( hodo_thk = 3.75) 47 ! 48 ! C Detector Setup 49 ! 50 ! real4 eff_cal_drift 51 ! real4 cal_drift 52 ! real4 cer_drift 53 ! real4 front_width 54 ! real4 fronthodo_drift 55 ! 56 ! parameter( eff_cal_drift = 335.d0 ) ! used in reconstruction 57 ! parameter( cal_drift = 325.d0 ) 58 ! parameter( cer_drift = 55.d0 ) 59 ! parameter( front_width = 0.3 ) 60 ! parameter( fronthodo_drift = 52.0 ) 61 ! 62 ! 63 ! C ------------ End Parameter's from old beta_geom.inc - JDM - 5/27/07 64 jones 1.1 65 66 C 67 C Define user geometry set up 68 C 69 70 real4 PAR( 8) 71 real4 ZLG(5),ALG(5),WLG(5) 72 real4 ZKap(4),AKap(4),WKap(4) 73 real4 ZScin(2), AScin(2), WScin(2) 74 real4 ZLuc(2), ALuc(2), WLuc(2) 75 real4 ZNH3(3),ANH3(3),WNH3(3) 76 real4 ZKelF(3),AKelF(3),WKelF(3) 77 real4 x,y 78 real4 densHyd,densHel,densNit 79 real tpar(5) 80 data tpar/0.001, 0.001, 0.01, 0.01, 0.01/ 81 82 83 c$$$ densHyd = Hyddens 84 c$$$ densHel = Heldens 85 jones 1.1 c$$$ densNit = Nitdens 86 87 C 88 C Lead glass mixture parameters nucleus charge, atomic wheight, rel. wheight 89 C of the different compounds 90 C 91 DATA ALG/ 207.19, 15.999, 28.086, 39.098, 74.922/ 92 DATA ZLG/ 82.00, 16.00, 14.00, 19.00, 33.00/ 93 DATA WLG/ .475, .270, .193, .058, .004/ 94 C 95 C Scintillator 96 C 97 DATA AScin/1.00794,12.0107/ 98 DATA ZScin/1.,6.0/ 99 DATA WScin/0.0848,0.9152/ 100 C 101 C Lucite 102 C 103 DATA ALuc/1.00794,12.0107/ 104 DATA ZLuc/1.,6.0/ 105 DATA WLuc/0.1435,0.8565/ 106 jones 1.1 C 107 C Kapton 108 C 109 DATA ZKap/ 1.000, 6.000, 7.000, 8.000/ 110 DATA AKap/ 1.008, 12.011, 14.007, 15.999/ 111 DATA WKap/ 0.0264, 0.6911, 0.0733, 0.2092/ 112 C 113 C Kel-F: (Poly)ChloroTriFluoroEthylene (Cl F3 C2) 114 C 115 DATA ZKelF/ 6.000, 9.000, 17.000/ 116 DATA AKelF/12.011, 18.998, 35.453/ 117 DATA WKelF/ 0.2063, 0.4893, 0.3044/ 118 c 119 c TF-1 optical parameters. Needed to define Cherenkov light generating vol. 120 c 121 122 real4 refrind,wlmn,wlmx,hc,pphmn,pphmx 123 parameter (refrind=1.65) !TF-1 refractive index. 124 parameter (wlmn=280.,wlmx=630.) !PMT XP3462B sensitivity range, [nm]. 125 parameter (hc=1.239842442E-6) !hc, [GeVnm]. 126 parameter (pphmn=hc/wlmx,pphmx=hc/wlmn) 127 jones 1.1 128 C 129 C NH3 target. Assume 50% packing uncertainty 130 C 131 real4 WHyd,WHel,WNit 132 133 DATA ZNH3/1.000, 2.000, 7.000/ 134 DATA ANH3/1.000, 4.003, 14.000/ 135 c DATA WNH3/0.151, 0.145, 0.704/ ! OR 2/10 136 ! DATA WNH3/0.153, 0.145, 0.714/ ! does not add up to 1. Where did it come from? 137 C! Read in NH3 densities for varying packing fractions NK 03/31/10 138 139 c Cher. photon min., max. momentums, [GeV/c]. 140 141 real pph(2) !Cher. photon min & max momentums (GeV/c). 142 real absl(2) !TF-1 absorption length. 143 real qef(2) !PMT quantum eff. 144 real rind(2) !TF-1 refr. index. 145 data pph/pphmn,pphmx/,absl/2100./,qef/21./,rind/2refrind/ 146 147 real pph_n2(2) !Cher. photon min & max momentums (GeV/c). 148 jones 1.1 real absl_n2(2) !TF-1 absorption length. 149 real qef_n2(2) !PMT quantum eff. 150 real rind_n2(2) !TF-1 refr. index. 151 data pph_n2/pphmn,pphmx/,absl_n2/2100./,qef_n2/21./ 152 , ,rind_n2/21.000298/ 153 154 real4 fieldmax,tmax_fd,ste_max,dee_max,epsilon,st_min,fieldmax2 155 integer4 i_field,i_field2 156 157 real4 cer_back,earm_length,z0 158 real4 front_drift,back_drift,guard_angle,guard_horz,wall_horz 159 integer4 imt,ivol 160 real4 rotmf 161 c LUCITE PARAMETERS 162 c 163 c 164 real4 inRadL,ouRadL,hightL,phiMinL,phiMaxL 165 166 real4 parL(5) 167 168 parameter (inRadL = 240.0,ouRadL = 243.5, hightL=6.0, 169 jones 1.1 , phiMinL = -11.5, phiMaxL = 11.5) 170
171 jones 1.3 C! Read in NH3 densities for varying packing-fractions NK 03/31/10 172 c$$$ WHyd=Hyddens 173 c$$$ WHel=Heldens 174 c$$$ WNit=Nitdens 175 c$$$ WNH3(1)=WHyd 176 c$$$ WNH3(2)=WHel 177 c$$$ WNH3(3)=WNit 178 WNH3(1)=Hyddens 179 WNH3(2)=Heldens 180 WNH3(3)=Nitdens
181 jones 1.1 C 182 C Rotation of the coils 183 rotmf = 180. + theta_0 + theta_Bfield 184 write(,)'Start UGEOM' 185 186 C 187 C 188 C Definition of 16 default Geant materials, see manual CONS100-1 189 C 190 CALL GIDROP 191 CALL GMATE 192 C 193 C Define the default particles 194 C 195 CALL GPART 196 CALL GPIONS 197 C 198 C Defines USER particular materials 199 C 200 201 CALL GSMIXT(22,'LEAD GLASS$',ALG,ZLG,3.86,5,WLG) 202 jones 1.1 CALL GSMIXT(23,'SCINTILLATOR$',AScin,ZScin,1.03,2,WScin) 203 CALL GSMIXT(24,'KAPTON$',AKap,ZKap,1.42,4,WKap) 204 CALL GSMIXT(26,'LUCITE$',ALuc,ZLuc,1.18,2,WLuc)
205 jones 1.2 C CALL GSMIXT(27,'NH3$',ANH3,ZNH3,0.5782,3,WNH3) 206 CALL GSMIXT(27,'NH3$',ANH3,ZNH3,Effdens,3,WNH3)
207 jones 1.1 CALL GSMIXT(28,'KELF$',AKelF,ZKelF,2.39,3,WKelF) 208 209 CALL GSMATE(25,'N2 GAS$',14.007,7.0,0.001165,32623.,0.,0,0)
210 jones 1.2 C CALL GSMATE(29,'He 1K',4.0,2.0,0.145,650.5,0.,0,0) 211 CALL GSMATE(29,'He 1K',4.0,2.0,Heldens,650.5,0.,0,0)
212 jones 1.1 call init_lucite() 213 call init_tracker() 214 call init_cal() 215 C 216 C Defines USER tracking media parameters which describes the tracking 217 C throughout a material 218 C 219 FIELDMAX = 0. 220 I_FIELD = 0 221 TMAX_FD = 10. 222 STE_MAX = -1000. 223 DEE_MAX = -0.05 224 EPSILON = 0.001 225 ST_MIN = -0.001 226 227 write(,)"FIELD TYPE IS=",field_type 228 if (field_type.eq.0) then 229 write(,) '***** Bypassing field code' 230 I_FIELD2 = 0 231 FIELDMAX2 = 0. 232 else if (field_type.eq.1) then 233 jones 1.1 write(,) '***** Using field code' 234 I_FIELD2 = 1 235 FIELDMAX2 = 50. 236 else 237 write(,) target_type,field_type 238 STOP 'BAD FTYP (field_type)' 239 endif 240 C 241 C Define two tracking media, first consists of Air, the second of 242 C either BGO or Lead Glass, depending on the IMAT value. 243 C 244 c igauto = 0 245 write(,)'Define Medium ',igauto 246 247 248 CALL GSTMED( NMED_air,'AIR' , 15 , 0 , I_FIELD, 249 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 250 CALL GSTMED( NMED_Pb,'Pb-Shielding' , 13 , 0 , I_FIELD, 251 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 252 CALL GSTMED( NMED_LG,'Pb-Glass' , 22 , 0 , I_FIELD, 253 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 254 jones 1.1 CALL GSTMED( NMED_Sc,'Scintillator' , 23 , 0 , I_FIELD, 255 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 256 CALL GSTMED( NMED_Kap,'Kapton' , 24 , 0 , I_FIELD, 257 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 258 CALL GSTMED( NMED_N2,'N2 Gas' , 25 , 0 , I_FIELD, 259 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 260 c CALL GSTMED( NMED_PLG,'Pb-Glass' , 22 , 0 , I_FIELD, 261 c + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 262 CALL GSTMED( NMED_Gain, 'Lucite Gain Monitor' , 26 , 0 , I_FIELD, 263 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 264 CALL GSTMED( NMED_NH3, 'NH3 + Helium' , 27 , 0 , I_FIELD2, 265 + FIELDMAX2,TMAX_FD,0.1,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 266 CALL GSTMED( NMED_Vac, 'Vacuum' , 16 , 0 , I_FIELD2, 267 + FIELDMAX2,TMAX_FD,1.0,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 268 CALL GSTMED( NMED_Al, 'Aluminum' , 9 , 0 , I_FIELD, 269 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 270 CALL GSTMED( NMED_KelF,'Kel-F' , 28 , 0 , I_FIELD, 271 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 272 CALL GSTMED( NMED_LHe,'LHe 1K' , 29 , 0 , I_FIELD2, 273 + FIELDMAX2,TMAX_FD,0.1,DEE_MAX, EPSILON, ST_MIN, 0 , 0 274 + ) 275 jones 1.1 276 277 278 CALL GSTMED( NMED_Fe,'Iron' , 10 , 0 , I_FIELD, 279 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 280 C Initial take on Iron, recheck for accuracy. JDM 7/9/07 281 CALL GSTMED( NMED_C,'Carbon' , 6 , 0 , I_FIELD, 282 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 283 C Initial take on Carbon, recheck for accuracy. JDM 7/27/07 284 285 286 C All the default material defined via GMATE are also defined as 287 C tracking media, even if they are not needed right now. 288 C 289 DO 100 IMT= 1,14 290 CALL GSTMED( IMT+13,'DUMMY-MEDIUM' , IMT , 0 , I_FIELD, 291 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 292 100 CONTINUE 293 C 294 C 295 C 296 jones 1.1 call GSTPAR(NMED_N2,'LOSS',1.) 297 call GSTPAR(NMED_N2,'DRAY',1.) 298 call GSTPAR(NMED_N2,'DCUTE',0.00001) 299 call GSTPAR(NMED_N2,'DCUTM',0.00001) 300 c call SetMedPar(NMED_Luc,tpar) 301 c call SetMedPar(NMED_Fx1,tpar) 302 c call SetMedPar(NMED_Fy1,tpar) 303 c call SetMedPar(NMED_Fy2,tpar) 304 305 c call gstpar(NMED_Luc,'CUTGAM',0.00001) 306 c call gstpar(NMED_Luc,'CUTELE',0.00001) 307 c call gstpar(NMED_Luc,'CUTNEU',0.00001) 308 c call gstpar(NMED_Luc,'CUTHAD',0.00001) 309 c call gstpar(NMED_Luc,'CUTMUO',0.00001) 310
311 jones 1.3 c$$$ call GSTPAR(NMED_NH3,'LOSS',1) 312 c$$$ call GSTPAR(NMED_NH3,'DRAY',1) 313 c$$$ call GSTPAR(NMED_NH3,'DCUTE',0.02) 314 c$$$ call GSTPAR(NMED_NH3,'DCUTM',0.02) 315 c$$$ call GDRPRT(8,NMED_NH3,1.,90)
316 jones 1.1 317 * call GSTPAR(NMED_Al,'LOSS',1) 318 * call GSTPAR(NMED_Al,'DRAY',1) 319 * call GSTPAR(NMED_Al,'DCUTE',0.02) 320 * call GSTPAR(NMED_Al,'DCUTM',0.02) 321 * call GDRPRT(8,NMED_Al,1.,90) 322 323 C 324 CALL GSCKOV(NMED_LG,2,pph,absl,qef,rind) 325 CALL GSCKOV(NMED_N2,2,pph_n2,absl_n2,qef_n2,rind_n2) 326 327 C 328 C Energy loss and cross-sections initialisations, creating LUT banks 329 C 330 CALL GPHYSI 331 write(,) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' 332 write(,) 'DELTA RAY INFO' 333 write(,) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' 334 call GDRPRT(8,25,150.,9) 335 write(,) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' 336 C 337 jones 1.1 C Define the reference volume ECAL via Geant Store VOLUme routine 338 C 339 340 341 cer_back = cer_drift+cer_length 342 * cer_win_thk = 0.0127 343 344 earm_length = cal_drift/2.+cal_depth/2. 345 346 PAR(1) = cal_width/2.1.2 347 PAR(2) = cal_height/2.1.2 348 PAR(3) = earm_length+50 349 CALL GSVOLU( 'EARM' , 'BOX ' ,NMED_Air, PAR , 3 , IVOL ) ! vol 1 350 351 c 352 c Implement Lucite Hodoscope into detector 353 c 354 call ugeom_lucite(ivol) 355 356 357 358 jones 1.1 359 PAR(1) = cal_width/2. 360 PAR(2) = cal_height/2. 361 PAR(3) = .3 362 C CALL GSVOLU( 'FESH' , 'BOX ' ,NMED_Fe, PAR , 3 , IVOL ) 363 364 PAR(1) = cal_width/2. 365 PAR(2) = cal_height/2. 366 PAR(3) = gain_thk 367 CALL GSVOLU( 'GAIN' , 'BOX ' ,NMED_Gain, PAR , 3 , IVOL ) ! vol 3 368 c vol_gain = IVOL 369 370 c PAR(1) = cal_width/2. 371 c PAR(2) = cal_height/2. 372 c PAR(3) = cal_depth/2. 373 c CALL GSVOLU( 'ECAL' , 'BOX ' ,NMED_LG, PAR , 3 , IVOL ) 374 c CALL GSPOS('ECAL',1,'EARM',x,y,162.5000,0,'ONLY') 375 c vol_ecal = IVOL 376 call def_calspace(ivol) 377 378 PAR(1) = cal_width/2.1.2 379 jones 1.1 PAR(2) = cal_height/2.1.2 380 PAR(3) = 2. 381 CALL GSVOLU( 'VETO' , 'BOX ' ,NMED_Sc, PAR , 3 , IVOL ) 382 c vol_veto = ivol 383 384 PAR(1) = cal_width/2.cer_drift/cal_drift1.0 385 PAR(2) = cal_height/2.cer_drift/cal_drift1.0 386 PAR(3) = cer_win_thk 387 * CALL GSVOLU( 'CFRW' , 'BOX ' ,NMED_Vac, PAR , 3 , IVOL ) 388 CALL GSVOLU( 'CFRW' , 'BOX ' ,NMED_Kap, PAR , 3 , IVOL ) 389 C 390 PAR(1) = cal_width/2.cer_back/cal_drift1.0 391 PAR(2) = cal_height/2.cer_back/cal_drift1.0 392 PAR(3) = cer_win_thk 393 CALL GSVOLU( 'CBKW' , 'BOX ' ,NMED_Kap, PAR , 3 , IVOL ) 394 395 PAR(1) = cal_width/2.cer_drift/cal_drift1.0 396 PAR(2) = cal_width/2.cer_back/cal_drift1.0 397 PAR(3) = cal_height/2.cer_drift/cal_drift1.0 398 PAR(4) = cal_height/2.cer_back/cal_drift1.0 399 PAR(5) = cer_length/2. 400 jones 1.1 * CALL GSVOLU( 'CGAS' , 'TRD2' ,NMED_Vac, PAR , 5 , IVOL ) 401 CALL GSVOLU( 'CGAS' , 'TRD2' ,NMED_N2, PAR , 5 , IVOL ) 402 c vol_cgas = IVOL 403 404 PAR(1) = 2. 405 PAR(2) = 2. 406 PAR(3) = 0.05 407 CALL GSVOLU('CRBN','BOX ', NMED_C,PAR,3,IVOL ) 408 409 PAR(1) = 0. 410 PAR(2) = 1.25 411 PAR(3) = 1.5 412 CALL GSROTM(1,90.,SNGL(theta_0),0.,SNGL(theta_0),90.,310.) 413 CALL GSVOLU( 'CELL' , 'TUBE' ,NMED_NH3, PAR , 3 , IVOL )
414 jones 1.3 c CALL GSVOLU( 'CELL' , 'TUBE' ,NMED_Pb, PAR , 3 , IVOL )
415 jones 1.1
416 jones 1.3 PAR(1) = 1.251 417 PAR(2) = 1.25+0.127
418 jones 1.1 PAR(3) = 1.5 419 CALL GSVOLU( 'CWAL' , 'TUBE' ,NMED_KelF, PAR , 3 , IVOL ) 420 421 PAR(1) = 0. 422 PAR(2) = 50.043 423 PAR(3) = 50.0 424 CALL GSROTM(2,90.,0.,0.,0.,90.,270.) 425 CALL GSVOLU( 'TCAN' , 'TUBE' ,NMED_Vac, PAR , 3 , IVOL ) 426 427 PAR(1) = 50. 428 PAR(2) = 50.043 429 PAR(3) = 50.0 430 CALL GSVOLU( 'TWIN' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) 431 432 PAR(1) = 4.000-0.001905 433 PAR(2) = 4.000+0.001905 434 PAR(3) = 30 435 CALL GSVOLU( '4KSH' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) 436 437 PAR(1) = 2.100-0.00254 438 PAR(2) = 2.100+0.00254 439 jones 1.1 PAR(3) = 20 440 CALL GSVOLU( 'TAIL' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) 441 442 PAR(1) = 0.0 443 PAR(2) = 2.100+0.00254 444 PAR(3) = 20 445 CALL GSVOLU( 'NOSE' , 'TUBE' ,NMED_LHe, PAR , 3 , IVOL ) 446 447 PAR(1) = 45.000-0.001905 448 PAR(2) = 45.000+0.001905 449 PAR(3) = 40 450 CALL GSVOLU( 'LN2C' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) 451 452 PAR(1) = 0. 453 PAR(2) = 33 454 C PAR(3) = 22 455 PAR(3) = 25. ! JDM 456 CALL GSVOLU( 'MAGN' , 'TUBE' ,NMED_Vac, PAR , 3 , IVOL ) 457 c vol_magn = IVOL 458 459 PAR(1) = 10. 460 jones 1.1 PAR(2) = 5./tan(17.00.0174533) 461 PAR(3) = 10./tan(48.50.0174533) 462 PAR(3) = 5. 463 PAR(4) = 25. 464 PAR(5) = 65. 465 CALL GSVOLU( 'BRA1' , 'TUBS', NMED_Al, PAR, 5 , IVOL) 466 PAR(4) = 115. 467 PAR(5) = 155. 468 CALL GSVOLU( 'BRA2' , 'TUBS', NMED_Al, PAR, 5 , IVOL) 469 PAR(4) = 205. 470 PAR(5) = 245. 471 CALL GSVOLU( 'BRA3' , 'TUBS', NMED_Al, PAR, 5 , IVOL) 472 PAR(4) = 295. 473 PAR(5) = 335. 474 CALL GSVOLU( 'BRA4' , 'TUBS', NMED_Al, PAR, 5 , IVOL) 475 C 476 C PAR(1) = 5. 477 C PAR(2) = 10. 478 C PAR(3) = 5./tan(17.00.0174533) 479 C PAR(4) = (5+2.PAR(1))tan(48.50.0174533) 480 C PAR(5) = PAR(4) + PAR(3) - PAR(2) 481 jones 1.1 482 483 PAR(1) = 8.4 484 PAR(2) = 10. 485 PAR(3) = 18. 486 C PAR(3) = 8.846tan(73.0174533) 487 PAR(4) = 29. 488 C PAR(4) = 18.3tan(48.5.0174533) 489 PAR(5) = 37. 490 C PAR(5) = 18.3/tan(17.0174533) 491 CALL GSROTM(3,90.,90.,90.,0.,180.,0.) 492 CALL GSROTM(4,90.,rotmf,0.,rotmf,90.,270.+rotmf) 493 CALL GSVOLU( 'MAG2' , 'CONE', NMED_Al, PAR, 5 , IVOL) 494 495 496 497 498 front_drift = cer_drift-5. 499 back_drift = cer_back 500 guard_angle = atan(cal_width/cal_drift/2.0)/d2r 501 guard_horz = cal_width/2.(cer_drift+cer_length/2.)/cal_drift+0.7 502 jones 1.1 wall_horz = cal_width/2.cer_drift/cal_drift+10 503 504 PAR(2) = cal_widthfront_drift/cal_drift+5 505 PAR(1) = 10. 506 PAR(3) = 1 507 CALL GSVOLU('WAL2','BOX ',NMED_Pb,PAR,3,IVOL) 508 509 PAR(1) = 0. 510 PAR(2) = 4. 511 PAR(3) = 1. 512 CALL GSVOLU('PLUG','TUBE',NMED_Pb,PAR,3,IVOL) 513 514 PAR(1) = cal_widthfront_drift/cal_drift 515 PAR(2) = cal_widthback_drift/cal_drift 516 PAR(3) = 1. 517 PAR(4) = (back_drift-front_drift)/2. 518 CALL GSVOLU('GARD','TRD1',NMED_Pb,PAR,4,IVOL) 519 520 521 CALL GSROTM(5,90.,90.,90.-guard_angle,180.,guard_angle,0.) 522 CALL GSROTM(6,90.,90.,90.+guard_angle,180.,guard_angle,180.) 523 jones 1.1 524 C 525 C Adding Front Tracking Hodoscope - JDM 5/22/07 - Three planes of 526 C bars 527 C 528 call ugeom_tracker(ivol) 529 530 c**************** 531 call ugeom_cal(ivol) 532 533 534 C 535 C Position volumes 536 C 537 538 z0 = -earm_length 539 540 C Position target related volumes 541 542 if (target_type.EQ.0) then ! define polarized target 543 write(,) '***** Configuring Polarized Target'
544 jones 1.3 CALL GSPOS('NOSE',1,'TCAN',0.,0.,TargVrtzOff , 0,'MANY') 545 CALL GSPOS('TAIL',1,'NOSE',0.,0.,TargVrtzOff , 0,'MANY') 546 CALL GSPOS('CELL',1,'NOSE',0.,0.,TargVrtzOff , 1,'ONLY') 547 CALL GSPOS('CWAL',1,'NOSE',0.,0.,TargVrtzOff , 1,'ONLY')
548 jones 1.1 CALL GSPOS('LN2C',1,'TCAN',0.,0.,0. , 0,'ONLY') 549 CALL GSPOS('4KSH',1,'TCAN',0.,0.,0. , 0,'ONLY') 550 CALL GSPOS('BRA1',1,'MAGN',0.,0.,0. , 0,'ONLY') 551 CALL GSPOS('BRA2',1,'MAGN',0.,0.,0. , 0,'ONLY') 552 CALL GSPOS('BRA3',1,'MAGN',0.,0.,0. , 0,'ONLY') 553 CALL GSPOS('BRA4',1,'MAGN',0.,0.,0. , 0,'ONLY') 554 C z was 10, -10 for MAG2 555 C 556 C CALL GSPOS('MAG2',1,'TCAN',+17.28,0.,0., 4,'MANY') 557 C CALL GSPOS('MAG2',2,'TCAN',-17.28,0.,0., 4,'MANY') 558 559 560 CALL GSPOS('MAG2',1,'MAGN',0.,0.,+17.28, 0,'MANY') 561 CALL GSPOS('MAG2',2,'MAGN',0.,0.,-17.28, 3,'MANY') 562 CALL GSPOS('MAGN',1,'TCAN',0.,0.,0., 4,' MANY') 563 564 565 * CALL GSPOS('PLUG',1,'MAGN',0.,0.,-14., 0,'ONLY') 566 elseif (target_type.EQ.1) then ! define standard carbon target 567 write(,) '***** Configuring Carbon Target'
568 jones 1.3 CALL GSPOS('CRBN',1,'TCAN',0.,0.,TargVrtzOff+0.3,1, 'ONLY')
569 jones 1.1 else 570 write(,) target_type,field_type 571 STOP 'BAD TTYP (target_type)' 572 endif 573 CALL GSPOS('TCAN',1,'EARM',0.,0.,z0, 2,' ONLY') 574 CALL GSPOS('TWIN',1,'TCAN',0.,0.,0., 0,'ONLY') 575 576 C Position Detectors 577 578 x = 0. 579 y = 0. 580 CALL GSPOS('CGAS',1,'EARM',x,y,z0+cer_drift+cer_length/2.,0,'ONLY' 581 + ) 582 CALL GSPOS('CFRW',1,'CGAS',x,y,-cer_length/2., 0,'ONLY') 583 CALL GSPOS('CBKW',1,'CGAS',x,y,+cer_length/2., 0,'ONLY') 584 585 C CALL GSPOS('FESH',1,'EARM',x,y,z0+cal_drift-5,0,'ONLY') ! Iron Shield test, JDM 586 CALL GSPOS('GAIN',1,'EARM',x,y,z0+cal_drift-gain_thk2., 0,'ONLY') 587 CALL GSPOS('VETO',1,'EARM',x,y,z0+cal_drift+2.cal_depth/2.+30.,0, 588 + 'ONLY') 589 590 jones 1.1 591 C Postion Detector Shielding 592 593 x = wall_horz 594 * CALL GSPOS('WAL2',1,'EARM',x,y,z0+cer_drift-2.5, 0,'ONLY') 595 596 x = -guard_horz 597 * CALL GSPOS('GARD',1,'EARM',x,y,z0+cer_drift+cer_length/2-4.5, 6,' 598 C ONLY') 599 600 C 601 C Divide calorimeter into blocks 602 C 603 c CALL GSDVN( 'ECOL' , 'ECAL' , horzBl , 1) 604 c CALL GSDVN( 'BLOC' , 'ECOL' , vertBl , 2) 605 606 call divi_lucite() 607 call divi_tracker() 608 call divi_cal() 609 610 CALL GGCLOS 611 jones 1.1 C 612 write(,)'DONE UGEOM' 613 END 614 615 Subroutine SetMedPar(medium,tpar) 616 integer medium 617 real tpar(5) 618 call gstpar(medium,'CUTGAM',tpar(1)) 619 call gstpar(medium,'CUTELE',tpar(2)) 620 call gstpar(medium,'CUTNEU',tpar(3)) 621 call gstpar(medium,'CUTHAD',tpar(4)) 622 call gstpar(medium,'CUTMUO',tpar(5)) 623 c call gstpar(medium,'ILOSS',1) 624 call GSTPAR(medium,'DCUTE',0.00001) 625 call GSTPAR(medium,'DCUTM',0.00001) 626 call GSTPAR(medium,'DRAY',1.) 627 628 call gstpar(medium,'BIRK1',1.) 629 call gstpar(medium,'BIRK2',0.013) 630 call gstpar(medium,'BIRK3',9.6E-6) 631 call gstpar(medium,'GHCOR1',1.0) 632 jones 1.1 end

Analyzer/Replay: Mark Jones, Documents: Stephen Wood