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 C! Read in NH3 densities for varying packing fractions NK 03/31/10 172 WHyd=Hyddens 173 WHel=Heldens 174 WNit=Nitdens 175 WNH3(1)=WHyd 176 WNH3(2)=WHel 177 WNH3(3)=WNit 178 C 179 C Rotation of the coils 180 rotmf = 180. + theta_0 + theta_Bfield 181 write(,)'Start UGEOM' 182 183 C 184 C 185 C Definition of 16 default Geant materials, see manual CONS100-1 186 C 187 CALL GIDROP 188 CALL GMATE 189 C 190 jones 1.1 C Define the default particles 191 C 192 CALL GPART 193 CALL GPIONS 194 C 195 C Defines USER particular materials 196 C 197 198 CALL GSMIXT(22,'LEAD GLASS$',ALG,ZLG,3.86,5,WLG) 199 CALL GSMIXT(23,'SCINTILLATOR$',AScin,ZScin,1.03,2,WScin) 200 CALL GSMIXT(24,'KAPTON$',AKap,ZKap,1.42,4,WKap) 201 CALL GSMIXT(26,'LUCITE$',ALuc,ZLuc,1.18,2,WLuc)
202 jones 1.2 C CALL GSMIXT(27,'NH3$',ANH3,ZNH3,0.5782,3,WNH3) 203 CALL GSMIXT(27,'NH3$',ANH3,ZNH3,Effdens,3,WNH3)
204 jones 1.1 CALL GSMIXT(28,'KELF$',AKelF,ZKelF,2.39,3,WKelF) 205 206 CALL GSMATE(25,'N2 GAS$',14.007,7.0,0.001165,32623.,0.,0,0)
207 jones 1.2 C CALL GSMATE(29,'He 1K',4.0,2.0,0.145,650.5,0.,0,0) 208 CALL GSMATE(29,'He 1K',4.0,2.0,Heldens,650.5,0.,0,0)
209 jones 1.1 call init_lucite() 210 call init_tracker() 211 call init_cal() 212 C 213 C Defines USER tracking media parameters which describes the tracking 214 C throughout a material 215 C 216 FIELDMAX = 0. 217 I_FIELD = 0 218 TMAX_FD = 10. 219 STE_MAX = -1000. 220 DEE_MAX = -0.05 221 EPSILON = 0.001 222 ST_MIN = -0.001 223 224 write(,)"FIELD TYPE IS=",field_type 225 if (field_type.eq.0) then 226 write(,) '***** Bypassing field code' 227 I_FIELD2 = 0 228 FIELDMAX2 = 0. 229 else if (field_type.eq.1) then 230 jones 1.1 write(,) '***** Using field code' 231 I_FIELD2 = 1 232 FIELDMAX2 = 50. 233 else 234 write(,) target_type,field_type 235 STOP 'BAD FTYP (field_type)' 236 endif 237 C 238 C Define two tracking media, first consists of Air, the second of 239 C either BGO or Lead Glass, depending on the IMAT value. 240 C 241 c igauto = 0 242 write(,)'Define Medium ',igauto 243 244 245 CALL GSTMED( NMED_air,'AIR' , 15 , 0 , I_FIELD, 246 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 247 CALL GSTMED( NMED_Pb,'Pb-Shielding' , 13 , 0 , I_FIELD, 248 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 249 CALL GSTMED( NMED_LG,'Pb-Glass' , 22 , 0 , I_FIELD, 250 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 251 jones 1.1 CALL GSTMED( NMED_Sc,'Scintillator' , 23 , 0 , I_FIELD, 252 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 253 CALL GSTMED( NMED_Kap,'Kapton' , 24 , 0 , I_FIELD, 254 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 255 CALL GSTMED( NMED_N2,'N2 Gas' , 25 , 0 , I_FIELD, 256 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 257 c CALL GSTMED( NMED_PLG,'Pb-Glass' , 22 , 0 , I_FIELD, 258 c + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 259 CALL GSTMED( NMED_Gain, 'Lucite Gain Monitor' , 26 , 0 , I_FIELD, 260 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 261 CALL GSTMED( NMED_NH3, 'NH3 + Helium' , 27 , 0 , I_FIELD2, 262 + FIELDMAX2,TMAX_FD,0.1,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 263 CALL GSTMED( NMED_Vac, 'Vacuum' , 16 , 0 , I_FIELD2, 264 + FIELDMAX2,TMAX_FD,1.0,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 265 CALL GSTMED( NMED_Al, 'Aluminum' , 9 , 0 , I_FIELD, 266 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 267 CALL GSTMED( NMED_KelF,'Kel-F' , 28 , 0 , I_FIELD, 268 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 269 CALL GSTMED( NMED_LHe,'LHe 1K' , 29 , 0 , I_FIELD2, 270 + FIELDMAX2,TMAX_FD,0.1,DEE_MAX, EPSILON, ST_MIN, 0 , 0 271 + ) 272 jones 1.1 273 274 275 CALL GSTMED( NMED_Fe,'Iron' , 10 , 0 , I_FIELD, 276 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 277 C Initial take on Iron, recheck for accuracy. JDM 7/9/07 278 CALL GSTMED( NMED_C,'Carbon' , 6 , 0 , I_FIELD, 279 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 280 C Initial take on Carbon, recheck for accuracy. JDM 7/27/07 281 282 283 C All the default material defined via GMATE are also defined as 284 C tracking media, even if they are not needed right now. 285 C 286 DO 100 IMT= 1,14 287 CALL GSTMED( IMT+13,'DUMMY-MEDIUM' , IMT , 0 , I_FIELD, 288 + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 289 100 CONTINUE 290 C 291 C 292 C 293 jones 1.1 call GSTPAR(NMED_N2,'LOSS',1.) 294 call GSTPAR(NMED_N2,'DRAY',1.) 295 call GSTPAR(NMED_N2,'DCUTE',0.00001) 296 call GSTPAR(NMED_N2,'DCUTM',0.00001) 297 c call SetMedPar(NMED_Luc,tpar) 298 c call SetMedPar(NMED_Fx1,tpar) 299 c call SetMedPar(NMED_Fy1,tpar) 300 c call SetMedPar(NMED_Fy2,tpar) 301 302 c call gstpar(NMED_Luc,'CUTGAM',0.00001) 303 c call gstpar(NMED_Luc,'CUTELE',0.00001) 304 c call gstpar(NMED_Luc,'CUTNEU',0.00001) 305 c call gstpar(NMED_Luc,'CUTHAD',0.00001) 306 c call gstpar(NMED_Luc,'CUTMUO',0.00001) 307 308 * call GSTPAR(NMED_NH3,'LOSS',1) 309 * call GSTPAR(NMED_NH3,'DRAY',1) 310 * call GSTPAR(NMED_NH3,'DCUTE',0.02) 311 * call GSTPAR(NMED_NH3,'DCUTM',0.02) 312 * call GDRPRT(8,NMED_NH3,1.,90) 313 314 jones 1.1 * call GSTPAR(NMED_Al,'LOSS',1) 315 * call GSTPAR(NMED_Al,'DRAY',1) 316 * call GSTPAR(NMED_Al,'DCUTE',0.02) 317 * call GSTPAR(NMED_Al,'DCUTM',0.02) 318 * call GDRPRT(8,NMED_Al,1.,90) 319 320 C 321 CALL GSCKOV(NMED_LG,2,pph,absl,qef,rind) 322 CALL GSCKOV(NMED_N2,2,pph_n2,absl_n2,qef_n2,rind_n2) 323 324 C 325 C Energy loss and cross-sections initialisations, creating LUT banks 326 C 327 CALL GPHYSI 328 write(,) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' 329 write(,) 'DELTA RAY INFO' 330 write(,) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' 331 call GDRPRT(8,25,150.,9) 332 write(,) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' 333 C 334 C Define the reference volume ECAL via Geant Store VOLUme routine 335 jones 1.1 C 336 337 338 cer_back = cer_drift+cer_length 339 * cer_win_thk = 0.0127 340 341 earm_length = cal_drift/2.+cal_depth/2. 342 343 PAR(1) = cal_width/2.1.2 344 PAR(2) = cal_height/2.1.2 345 PAR(3) = earm_length+50 346 CALL GSVOLU( 'EARM' , 'BOX ' ,NMED_Air, PAR , 3 , IVOL ) ! vol 1 347 348 c 349 c Implement Lucite Hodoscope into detector 350 c 351 call ugeom_lucite(ivol) 352 353 354 355 356 jones 1.1 PAR(1) = cal_width/2. 357 PAR(2) = cal_height/2. 358 PAR(3) = .3 359 C CALL GSVOLU( 'FESH' , 'BOX ' ,NMED_Fe, PAR , 3 , IVOL ) 360 361 PAR(1) = cal_width/2. 362 PAR(2) = cal_height/2. 363 PAR(3) = gain_thk 364 CALL GSVOLU( 'GAIN' , 'BOX ' ,NMED_Gain, PAR , 3 , IVOL ) ! vol 3 365 c vol_gain = IVOL 366 367 c PAR(1) = cal_width/2. 368 c PAR(2) = cal_height/2. 369 c PAR(3) = cal_depth/2. 370 c CALL GSVOLU( 'ECAL' , 'BOX ' ,NMED_LG, PAR , 3 , IVOL ) 371 c CALL GSPOS('ECAL',1,'EARM',x,y,162.5000,0,'ONLY') 372 c vol_ecal = IVOL 373 call def_calspace(ivol) 374 375 PAR(1) = cal_width/2.1.2 376 PAR(2) = cal_height/2.1.2 377 jones 1.1 PAR(3) = 2. 378 CALL GSVOLU( 'VETO' , 'BOX ' ,NMED_Sc, PAR , 3 , IVOL ) 379 c vol_veto = ivol 380 381 PAR(1) = cal_width/2.cer_drift/cal_drift1.0 382 PAR(2) = cal_height/2.cer_drift/cal_drift1.0 383 PAR(3) = cer_win_thk 384 * CALL GSVOLU( 'CFRW' , 'BOX ' ,NMED_Vac, PAR , 3 , IVOL ) 385 CALL GSVOLU( 'CFRW' , 'BOX ' ,NMED_Kap, PAR , 3 , IVOL ) 386 C 387 PAR(1) = cal_width/2.cer_back/cal_drift1.0 388 PAR(2) = cal_height/2.cer_back/cal_drift1.0 389 PAR(3) = cer_win_thk 390 CALL GSVOLU( 'CBKW' , 'BOX ' ,NMED_Kap, PAR , 3 , IVOL ) 391 392 PAR(1) = cal_width/2.cer_drift/cal_drift1.0 393 PAR(2) = cal_width/2.cer_back/cal_drift1.0 394 PAR(3) = cal_height/2.cer_drift/cal_drift1.0 395 PAR(4) = cal_height/2.cer_back/cal_drift1.0 396 PAR(5) = cer_length/2. 397 * CALL GSVOLU( 'CGAS' , 'TRD2' ,NMED_Vac, PAR , 5 , IVOL ) 398 jones 1.1 CALL GSVOLU( 'CGAS' , 'TRD2' ,NMED_N2, PAR , 5 , IVOL ) 399 c vol_cgas = IVOL 400 401 PAR(1) = 2. 402 PAR(2) = 2. 403 PAR(3) = 0.05 404 CALL GSVOLU('CRBN','BOX ', NMED_C,PAR,3,IVOL ) 405 406 PAR(1) = 0. 407 PAR(2) = 1.25 408 PAR(3) = 1.5 409 CALL GSROTM(1,90.,SNGL(theta_0),0.,SNGL(theta_0),90.,310.) 410 CALL GSVOLU( 'CELL' , 'TUBE' ,NMED_NH3, PAR , 3 , IVOL ) 411 412 PAR(1) = 1.25 413 PAR(2) = 1.25+0.0127 414 PAR(3) = 1.5 415 CALL GSVOLU( 'CWAL' , 'TUBE' ,NMED_KelF, PAR , 3 , IVOL ) 416 417 PAR(1) = 0. 418 PAR(2) = 50.043 419 jones 1.1 PAR(3) = 50.0 420 CALL GSROTM(2,90.,0.,0.,0.,90.,270.) 421 CALL GSVOLU( 'TCAN' , 'TUBE' ,NMED_Vac, PAR , 3 , IVOL ) 422 423 PAR(1) = 50. 424 PAR(2) = 50.043 425 PAR(3) = 50.0 426 CALL GSVOLU( 'TWIN' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) 427 428 PAR(1) = 4.000-0.001905 429 PAR(2) = 4.000+0.001905 430 PAR(3) = 30 431 CALL GSVOLU( '4KSH' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) 432 433 PAR(1) = 2.100-0.00254 434 PAR(2) = 2.100+0.00254 435 PAR(3) = 20 436 CALL GSVOLU( 'TAIL' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) 437 438 PAR(1) = 0.0 439 PAR(2) = 2.100+0.00254 440 jones 1.1 PAR(3) = 20 441 CALL GSVOLU( 'NOSE' , 'TUBE' ,NMED_LHe, PAR , 3 , IVOL ) 442 443 PAR(1) = 45.000-0.001905 444 PAR(2) = 45.000+0.001905 445 PAR(3) = 40 446 CALL GSVOLU( 'LN2C' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) 447 448 PAR(1) = 0. 449 PAR(2) = 33 450 C PAR(3) = 22 451 PAR(3) = 25. ! JDM 452 CALL GSVOLU( 'MAGN' , 'TUBE' ,NMED_Vac, PAR , 3 , IVOL ) 453 c vol_magn = IVOL 454 455 PAR(1) = 10. 456 PAR(2) = 5./tan(17.00.0174533) 457 PAR(3) = 10./tan(48.50.0174533) 458 PAR(3) = 5. 459 PAR(4) = 25. 460 PAR(5) = 65. 461 jones 1.1 CALL GSVOLU( 'BRA1' , 'TUBS', NMED_Al, PAR, 5 , IVOL) 462 PAR(4) = 115. 463 PAR(5) = 155. 464 CALL GSVOLU( 'BRA2' , 'TUBS', NMED_Al, PAR, 5 , IVOL) 465 PAR(4) = 205. 466 PAR(5) = 245. 467 CALL GSVOLU( 'BRA3' , 'TUBS', NMED_Al, PAR, 5 , IVOL) 468 PAR(4) = 295. 469 PAR(5) = 335. 470 CALL GSVOLU( 'BRA4' , 'TUBS', NMED_Al, PAR, 5 , IVOL) 471 C 472 C PAR(1) = 5. 473 C PAR(2) = 10. 474 C PAR(3) = 5./tan(17.00.0174533) 475 C PAR(4) = (5+2.PAR(1))tan(48.50.0174533) 476 C PAR(5) = PAR(4) + PAR(3) - PAR(2) 477 478 479 PAR(1) = 8.4 480 PAR(2) = 10. 481 PAR(3) = 18. 482 jones 1.1 C PAR(3) = 8.846tan(73.0174533) 483 PAR(4) = 29. 484 C PAR(4) = 18.3tan(48.5.0174533) 485 PAR(5) = 37. 486 C PAR(5) = 18.3/tan(17.0174533) 487 CALL GSROTM(3,90.,90.,90.,0.,180.,0.) 488 CALL GSROTM(4,90.,rotmf,0.,rotmf,90.,270.+rotmf) 489 CALL GSVOLU( 'MAG2' , 'CONE', NMED_Al, PAR, 5 , IVOL) 490 491 492 493 494 front_drift = cer_drift-5. 495 back_drift = cer_back 496 guard_angle = atan(cal_width/cal_drift/2.0)/d2r 497 guard_horz = cal_width/2.(cer_drift+cer_length/2.)/cal_drift+0.7 498 wall_horz = cal_width/2.cer_drift/cal_drift+10 499 500 PAR(2) = cal_widthfront_drift/cal_drift+5 501 PAR(1) = 10. 502 PAR(3) = 1 503 jones 1.1 CALL GSVOLU('WAL2','BOX ',NMED_Pb,PAR,3,IVOL) 504 505 PAR(1) = 0. 506 PAR(2) = 4. 507 PAR(3) = 1. 508 CALL GSVOLU('PLUG','TUBE',NMED_Pb,PAR,3,IVOL) 509 510 PAR(1) = cal_widthfront_drift/cal_drift 511 PAR(2) = cal_widthback_drift/cal_drift 512 PAR(3) = 1. 513 PAR(4) = (back_drift-front_drift)/2. 514 CALL GSVOLU('GARD','TRD1',NMED_Pb,PAR,4,IVOL) 515 516 517 CALL GSROTM(5,90.,90.,90.-guard_angle,180.,guard_angle,0.) 518 CALL GSROTM(6,90.,90.,90.+guard_angle,180.,guard_angle,180.) 519 520 C 521 C Adding Front Tracking Hodoscope - JDM 5/22/07 - Three planes of 522 C bars 523 C 524 jones 1.1 call ugeom_tracker(ivol) 525 526 c**************** 527 call ugeom_cal(ivol) 528 529 530 C 531 C Position volumes 532 C 533 534 z0 = -earm_length 535 536 C Position target related volumes 537 538 if (target_type.EQ.0) then ! define polarized target 539 write(,) '***** Configuring Polarized Target' 540 CALL GSPOS('NOSE',1,'TCAN',0.,0.,0. , 0,'ONLY') 541 CALL GSPOS('TAIL',1,'NOSE',0.,0.,0. , 0,'ONLY') 542 CALL GSPOS('CELL',1,'NOSE',0.,0.,0. , 1,'ONLY') 543 CALL GSPOS('CWAL',1,'NOSE',0.,0.,0. , 1,'ONLY') 544 CALL GSPOS('LN2C',1,'TCAN',0.,0.,0. , 0,'ONLY') 545 jones 1.1 CALL GSPOS('4KSH',1,'TCAN',0.,0.,0. , 0,'ONLY') 546 CALL GSPOS('BRA1',1,'MAGN',0.,0.,0. , 0,'ONLY') 547 CALL GSPOS('BRA2',1,'MAGN',0.,0.,0. , 0,'ONLY') 548 CALL GSPOS('BRA3',1,'MAGN',0.,0.,0. , 0,'ONLY') 549 CALL GSPOS('BRA4',1,'MAGN',0.,0.,0. , 0,'ONLY') 550 C z was 10, -10 for MAG2 551 C 552 C CALL GSPOS('MAG2',1,'TCAN',+17.28,0.,0., 4,'MANY') 553 C CALL GSPOS('MAG2',2,'TCAN',-17.28,0.,0., 4,'MANY') 554 555 556 CALL GSPOS('MAG2',1,'MAGN',0.,0.,+17.28, 0,'MANY') 557 CALL GSPOS('MAG2',2,'MAGN',0.,0.,-17.28, 3,'MANY') 558 CALL GSPOS('MAGN',1,'TCAN',0.,0.,0., 4,' MANY') 559 560 561 * CALL GSPOS('PLUG',1,'MAGN',0.,0.,-14., 0,'ONLY') 562 elseif (target_type.EQ.1) then ! define standard carbon target 563 write(,) '***** Configuring Carbon Target' 564 CALL GSPOS('CRBN',1,'TCAN',0.,0.,0.,1, 'ONLY') 565 else 566 jones 1.1 write(,) target_type,field_type 567 STOP 'BAD TTYP (target_type)' 568 endif 569 CALL GSPOS('TCAN',1,'EARM',0.,0.,z0, 2,' ONLY') 570 CALL GSPOS('TWIN',1,'TCAN',0.,0.,0., 0,'ONLY') 571 572 C Position Detectors 573 574 x = 0. 575 y = 0. 576 CALL GSPOS('CGAS',1,'EARM',x,y,z0+cer_drift+cer_length/2.,0,'ONLY' 577 + ) 578 CALL GSPOS('CFRW',1,'CGAS',x,y,-cer_length/2., 0,'ONLY') 579 CALL GSPOS('CBKW',1,'CGAS',x,y,+cer_length/2., 0,'ONLY') 580 581 C CALL GSPOS('FESH',1,'EARM',x,y,z0+cal_drift-5,0,'ONLY') ! Iron Shield test, JDM 582 CALL GSPOS('GAIN',1,'EARM',x,y,z0+cal_drift-gain_thk2., 0,'ONLY') 583 CALL GSPOS('VETO',1,'EARM',x,y,z0+cal_drift+2.cal_depth/2.+30.,0, 584 + 'ONLY') 585 586 587 jones 1.1 C Postion Detector Shielding 588 589 x = wall_horz 590 * CALL GSPOS('WAL2',1,'EARM',x,y,z0+cer_drift-2.5, 0,'ONLY') 591 592 x = -guard_horz 593 * CALL GSPOS('GARD',1,'EARM',x,y,z0+cer_drift+cer_length/2-4.5, 6,' 594 C ONLY') 595 596 C 597 C Divide calorimeter into blocks 598 C 599 c CALL GSDVN( 'ECOL' , 'ECAL' , horzBl , 1) 600 c CALL GSDVN( 'BLOC' , 'ECOL' , vertBl , 2) 601 602 call divi_lucite() 603 call divi_tracker() 604 call divi_cal() 605 606 CALL GGCLOS 607 C 608 jones 1.1 write(,)'DONE UGEOM' 609 END 610 611 Subroutine SetMedPar(medium,tpar) 612 integer medium 613 real tpar(5) 614 call gstpar(medium,'CUTGAM',tpar(1)) 615 call gstpar(medium,'CUTELE',tpar(2)) 616 call gstpar(medium,'CUTNEU',tpar(3)) 617 call gstpar(medium,'CUTHAD',tpar(4)) 618 call gstpar(medium,'CUTMUO',tpar(5)) 619 c call gstpar(medium,'ILOSS',1) 620 call GSTPAR(medium,'DCUTE',0.00001) 621 call GSTPAR(medium,'DCUTM',0.00001) 622 call GSTPAR(medium,'DRAY',1.) 623 624 call gstpar(medium,'BIRK1',1.) 625 call gstpar(medium,'BIRK2',0.013) 626 call gstpar(medium,'BIRK3',9.6E-6) 627 call gstpar(medium,'GHCOR1',1.0) 628 end

Analyzer/Replay: Mark Jones, Documents: Stephen Wood