SUBROUTINE UGEOM implicit none include 'constants.inc' include 'geant.inc' include 'sane.inc' include 'materials.inc' include 'beta_geom.inc' include 'sane_misc.inc' include 'sane_accp.inc' ! C------------ Including beta_geom.inc parameters here - JDM - 05/27/07 ! ! C-- beta_geom.inc Glen Warren 8/03 ! C-- ! C-- details geometry of BETA detector ! ! C Detector geometry ! ! real*4 block_height, block_width ! real*4 cal_height,cal_width ! real*4 cal_depth ! real*4 cer_length integer*4 horzBl,vertBl ! ! parameter( block_height = 4.d0 ) ! parameter( block_width = 4.d0 ) parameter( horzBl = 28 ) parameter( vertBl = 58 ) ! parameter( cal_depth = 40.d0 ) ! parameter( cer_length = 150.d0 ) ! ! parameter( cal_height = vert_blocks*block_height ) ! parameter( cal_width = horz_blocks*block_width ) ! ! real*4 gain_thk ! ! parameter( gain_thk = 1./2.) ! ! real*4 cer_win_thk ! ! parameter( cer_win_thk = 0.0127 ) ! ! real*4 hodo_thk ! ! parameter( hodo_thk = 3.75) ! ! C Detector Setup ! ! real*4 eff_cal_drift ! real*4 cal_drift ! real*4 cer_drift ! real*4 front_width ! real*4 fronthodo_drift ! ! parameter( eff_cal_drift = 335.d0 ) ! used in reconstruction ! parameter( cal_drift = 325.d0 ) ! parameter( cer_drift = 55.d0 ) ! parameter( front_width = 0.3 ) ! parameter( fronthodo_drift = 52.0 ) ! ! ! C ------------ End Parameter's from old beta_geom.inc - JDM - 5/27/07 C C Define user geometry set up C real*4 PAR( 8) real*4 ZLG(5),ALG(5),WLG(5) real*4 ZKap(4),AKap(4),WKap(4) real*4 ZScin(2), AScin(2), WScin(2) real*4 ZLuc(2), ALuc(2), WLuc(2) real*4 ZNH3(3),ANH3(3),WNH3(3),DNH3(3) real*4 ZKelF(3),AKelF(3),WKelF(3) real*4 ZCarb(1),ACarb(1),DCarb(1) real*4 ZLHe(1),ALHe(1),DLHe(1) real*4 x,y real tpar(5) data tpar/0.001, 0.001, 0.01, 0.01, 0.01/ C C Lead glass mixture parameters nucleus charge, atomic wheight, rel. wheight C of the different compounds C DATA ALG/ 207.19, 15.999, 28.086, 39.098, 74.922/ DATA ZLG/ 82.00, 16.00, 14.00, 19.00, 33.00/ DATA WLG/ .475, .270, .193, .058, .004/ C C Scintillator C DATA AScin/1.00794,12.0107/ DATA ZScin/1.,6.0/ DATA WScin/0.0848,0.9152/ C C Lucite C DATA ALuc/1.00794,12.0107/ DATA ZLuc/1.,6.0/ DATA WLuc/0.1435,0.8565/ C C Kapton C DATA ZKap/ 1.000, 6.000, 7.000, 8.000/ DATA AKap/ 1.008, 12.011, 14.007, 15.999/ DATA WKap/ 0.0264, 0.6911, 0.0733, 0.2092/ C C Kel-F: (Poly)ChloroTriFluoroEthylene (Cl F3 C2) C DATA ZKelF/ 6.000, 9.000, 17.000/ DATA AKelF/12.011, 18.998, 35.453/ DATA WKelF/ 0.2063, 0.4893, 0.3044/ c c TF-1 optical parameters. Needed to define Cherenkov light generating vol. c real*4 refrind,wlmn,wlmx,hc,pphmn,pphmx parameter (refrind=1.65) !TF-1 refractive index. parameter (wlmn=280.,wlmx=630.) !PMT XP3462B sensitivity range, [nm]. parameter (hc=1.239842442E-6) !h*c, [GeV*nm]. parameter (pphmn=hc/wlmx,pphmx=hc/wlmn) C C NH3 target. Assume 50% packing uncertainty C real*4 WHyd,WHel,WNit DATA ZNH3/1.000, 2.000, 7.000/ DATA ANH3/1.000, 4.003, 14.000/ DATA DNH3/0.153, 0.145, 0.714/ !! Multiply by pf for lumin NK 03/01/11 c DATA WNH3/0.151, 0.145, 0.704/ ! OR 2/10 ! DATA WNH3/0.153, 0.145, 0.714/ ! does not add up to 1. Where did it come from? C! Read in NH3 densities for varying packing fractions NK 03/31/10 C Carbon target. C DATA ZCARB/ 6.000/ DATA ACARB/12.010/ DATA DCARB/ 2.265/ C Oustide LHe. C DATA ZLHE/ 2.000/ DATA ALHE/4.000/ DATA DLHE/ 0.145/ c Cher. photon min., max. momentums, [GeV/c]. real pph(2) !Cher. photon min & max momentums (GeV/c). real absl(2) !TF-1 absorption length. real qef(2) !PMT quantum eff. real rind(2) !TF-1 refr. index. data pph/pphmn,pphmx/,absl/2*100./,qef/2*1./,rind/2*refrind/ real pph_n2(2) !Cher. photon min & max momentums (GeV/c). real absl_n2(2) !TF-1 absorption length. real qef_n2(2) !PMT quantum eff. real rind_n2(2) !TF-1 refr. index. data pph_n2/pphmn,pphmx/,absl_n2/2*100./,qef_n2/2*1./ , ,rind_n2/2*1.000298/ real*4 fieldmax,tmax_fd,ste_max,dee_max,epsilon,st_min,fieldmax2 integer*4 i_field,i_field2 real*4 cer_back,earm_length,z0 real*4 front_drift,back_drift,guard_angle,guard_horz,wall_horz integer*4 imt,ivol,ilum,jlum real*4 rotmf c LUCITE PARAMETERS c c real*4 inRadL,ouRadL,hightL,phiMinL,phiMaxL real*4 parL(5) parameter (inRadL = 240.0,ouRadL = 243.5, hightL=6.0, , phiMinL = -11.5, phiMaxL = 11.5) C! Read in NH3 densities for varying packing-fractions NK 03/31/10 WNH3(1)=Hyddens WNH3(2)=Heldens WNH3(3)=Nitdens C C! Get pf-scaled densities and atomic numbers for calculating luminosity pfdens(1) = Pckfrc * DNH3(1) pfdens(2) = (1-Pckfrc) * DNH3(2) pfdens(3) = Pckfrc * DNH3(3) pfdens(4) = DLHE(1) pfdens(5) = DLHE(1) pfdens(6) = DCARB(1) cc pfdens(4) = DCARB(1) c atomnum(1) = ACARB(1) atomnum(1) = ANH3(1) atomnum(2) = ANH3(2) atomnum(3) = ANH3(3) atomnum(4) = ALHE(1) atomnum(5) = ALHE(1) atomnum(6) = ACARB(1) cc atomnum(4) = ACARB(1) write(*,*)pfdens,atomnum C Rotation of the coils rotmf = 180. + theta_0 + theta_Bfield write(*,*)'Start UGEOM' C C C Definition of 16 default Geant materials, see manual CONS100-1 C CALL GIDROP CALL GMATE C C Define the default particles C CALL GPART CALL GPIONS C C Defines USER particular materials C CALL GSMIXT(22,'LEAD GLASS$',ALG,ZLG,3.86,5,WLG) CALL GSMIXT(23,'SCINTILLATOR$',AScin,ZScin,1.03,2,WScin) CALL GSMIXT(24,'KAPTON$',AKap,ZKap,1.42,4,WKap) CALL GSMIXT(26,'LUCITE$',ALuc,ZLuc,1.18,2,WLuc) C CALL GSMIXT(27,'NH3$',ANH3,ZNH3,0.5782,3,WNH3) CALL GSMIXT(27,'NH3$',ANH3,ZNH3,Effdens,3,WNH3) CALL GSMIXT(28,'KELF$',AKelF,ZKelF,2.39,3,WKelF) CALL GSMATE(25,'N2 GAS$',14.007,7.0,0.001165,32623.,0.,0,0) CALL GSMATE(29,'He 1K',4.0,2.0,0.145,650.5,0.,0,0) C CALL GSMATE(29,'He 1K',4.0,2.0,Heldens,650.5,0.,0,0) c write(*,*)Effdens,Heldens call init_lucite() call init_tracker() call init_cal() C C Defines USER tracking media parameters which describes the tracking C throughout a material C FIELDMAX = 0. I_FIELD = 0 TMAX_FD = 10. STE_MAX = -1000. DEE_MAX = -0.05 EPSILON = 0.001 ST_MIN = -0.001 write(*,*)"FIELD TYPE IS=",field_type if (field_type.eq.0) then write(*,*) '***** Bypassing field code' I_FIELD2 = 0 FIELDMAX2 = 0. else if (field_type.eq.1) then write(*,*) '***** Using field code' I_FIELD2 = 1 FIELDMAX2 = 50. else write(*,*) target_type,field_type STOP 'BAD FTYP (field_type)' endif C C Define two tracking media, first consists of Air, the second of C either BGO or Lead Glass, depending on the IMAT value. C c igauto = 0 write(*,*)'Define Medium ',igauto CALL GSTMED( NMED_air,'AIR' , 15 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_Pb,'Pb-Shielding' , 13 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_LG,'Pb-Glass' , 22 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_Sc,'Scintillator' , 23 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_Kap,'Kapton' , 24 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_N2,'N2 Gas' , 25 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) c CALL GSTMED( NMED_PLG,'Pb-Glass' , 22 , 0 , I_FIELD, c + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_Gain, 'Lucite Gain Monitor' , 26 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_NH3, 'NH3 + Helium' , 27 , 0 , I_FIELD2, + FIELDMAX2,TMAX_FD,0.1,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_Vac, 'Vacuum' , 16 , 0 , I_FIELD2, + FIELDMAX2,TMAX_FD,1.0,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_Al, 'Aluminum' , 9 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_KelF,'Kel-F' , 28 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) CALL GSTMED( NMED_LHe,'LHe 1K' , 29 , 0 , I_FIELD2, + FIELDMAX2,TMAX_FD,0.1,DEE_MAX, EPSILON, ST_MIN, 0 , 0 + ) CALL GSTMED( NMED_Fe,'Iron' , 10 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) C Initial take on Iron, recheck for accuracy. JDM 7/9/07 CALL GSTMED( NMED_C,'Carbon' , 6 , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) C Initial take on Carbon, recheck for accuracy. JDM 7/27/07 C All the default material defined via GMATE are also defined as C tracking media, even if they are not needed right now. C DO 100 IMT= 1,14 CALL GSTMED( IMT+13,'DUMMY-MEDIUM' , IMT , 0 , I_FIELD, + FIELDMAX,TMAX_FD,STE_MAX,DEE_MAX, EPSILON, ST_MIN, 0 , 0 ) 100 CONTINUE C C C call GSTPAR(NMED_N2,'LOSS',1.) call GSTPAR(NMED_N2,'DRAY',1.) call GSTPAR(NMED_N2,'DCUTE',0.00001) call GSTPAR(NMED_N2,'DCUTM',0.00001) c call SetMedPar(NMED_Luc,tpar) c call SetMedPar(NMED_Fx1,tpar) c call SetMedPar(NMED_Fy1,tpar) c call SetMedPar(NMED_Fy2,tpar) c call gstpar(NMED_Luc,'CUTGAM',0.00001) c call gstpar(NMED_Luc,'CUTELE',0.00001) c call gstpar(NMED_Luc,'CUTNEU',0.00001) c call gstpar(NMED_Luc,'CUTHAD',0.00001) c call gstpar(NMED_Luc,'CUTMUO',0.00001) c$$$ call GSTPAR(NMED_NH3,'LOSS',1) c$$$ call GSTPAR(NMED_NH3,'DRAY',1) c$$$ call GSTPAR(NMED_NH3,'DCUTE',0.02) c$$$ call GSTPAR(NMED_NH3,'DCUTM',0.02) c$$$ call GDRPRT(8,NMED_NH3,1.,90) * call GSTPAR(NMED_Al,'LOSS',1) * call GSTPAR(NMED_Al,'DRAY',1) * call GSTPAR(NMED_Al,'DCUTE',0.02) * call GSTPAR(NMED_Al,'DCUTM',0.02) * call GDRPRT(8,NMED_Al,1.,90) C CALL GSCKOV(NMED_LG,2,pph,absl,qef,rind) CALL GSCKOV(NMED_N2,2,pph_n2,absl_n2,qef_n2,rind_n2) C C Energy loss and cross-sections initialisations, creating LUT banks C CALL GPHYSI write(*,*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' write(*,*) 'DELTA RAY INFO' write(*,*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' call GDRPRT(8,25,150.,9) write(*,*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' C C Define the reference volume ECAL via Geant Store VOLUme routine C cer_back = cer_drift+cer_length * cer_win_thk = 0.0127 earm_length = cal_drift/2.+cal_depth/2. PAR(1) = cal_width/2.*1.2 PAR(2) = cal_height/2.*1.2 PAR(3) = earm_length+50 CALL GSVOLU( 'EARM' , 'BOX ' ,NMED_Air, PAR , 3 , IVOL ) ! vol 1 c c Implement Lucite Hodoscope into detector c call ugeom_lucite(ivol) PAR(1) = cal_width/2. PAR(2) = cal_height/2. PAR(3) = .3 C CALL GSVOLU( 'FESH' , 'BOX ' ,NMED_Fe, PAR , 3 , IVOL ) PAR(1) = cal_width/2. PAR(2) = cal_height/2. PAR(3) = gain_thk CALL GSVOLU( 'GAIN' , 'BOX ' ,NMED_Gain, PAR , 3 , IVOL ) ! vol 3 c vol_gain = IVOL c PAR(1) = cal_width/2. c PAR(2) = cal_height/2. c PAR(3) = cal_depth/2. c CALL GSVOLU( 'ECAL' , 'BOX ' ,NMED_LG, PAR , 3 , IVOL ) c CALL GSPOS('ECAL',1,'EARM',x,y,162.5000,0,'ONLY') c vol_ecal = IVOL call def_calspace(ivol) PAR(1) = cal_width/2.*1.2 PAR(2) = cal_height/2.*1.2 PAR(3) = 2. CALL GSVOLU( 'VETO' , 'BOX ' ,NMED_Sc, PAR , 3 , IVOL ) c vol_veto = ivol PAR(1) = cal_width/2.*cer_drift/cal_drift*1.0 PAR(2) = cal_height/2.*cer_drift/cal_drift*1.0 PAR(3) = cer_win_thk * CALL GSVOLU( 'CFRW' , 'BOX ' ,NMED_Vac, PAR , 3 , IVOL ) CALL GSVOLU( 'CFRW' , 'BOX ' ,NMED_Kap, PAR , 3 , IVOL ) C PAR(1) = cal_width/2.*cer_back/cal_drift*1.0 PAR(2) = cal_height/2.*cer_back/cal_drift*1.0 PAR(3) = cer_win_thk CALL GSVOLU( 'CBKW' , 'BOX ' ,NMED_Kap, PAR , 3 , IVOL ) PAR(1) = cal_width/2.*cer_drift/cal_drift*1.0 PAR(2) = cal_width/2.*cer_back/cal_drift*1.0 PAR(3) = cal_height/2.*cer_drift/cal_drift*1.0 PAR(4) = cal_height/2.*cer_back/cal_drift*1.0 PAR(5) = cer_length/2. * CALL GSVOLU( 'CGAS' , 'TRD2' ,NMED_Vac, PAR , 5 , IVOL ) CALL GSVOLU( 'CGAS' , 'TRD2' ,NMED_N2, PAR , 5 , IVOL ) c vol_cgas = IVOL PAR(1) = 2. PAR(2) = 2. c PAR(3) = 0.05 PAR(3) = 0.395 CALL GSVOLU('CRBN','BOX ', NMED_C,PAR,3,IVOL ) cc thick(4) = 2*PAR(3) thick(6) = 2*PAR(3) PAR(1) = 0. PAR(2) = 1.25 PAR(3) = 1.5 CALL GSROTM(1,90.,SNGL(theta_0),0.,SNGL(theta_0),90.,310.) CALL GSVOLU( 'CELL' , 'TUBE' ,NMED_NH3, PAR , 3 , IVOL ) c CALL GSVOLU( 'CELL' , 'TUBE' ,NMED_Pb, PAR , 3 , IVOL ) thick(1) = 2*PAR(3) thick(2) = 2*PAR(3) thick(3) = 2*PAR(3) PAR(1) = 1.251 PAR(2) = 1.25+0.127 PAR(3) = 1.5 CALL GSVOLU( 'CWAL' , 'TUBE' ,NMED_KelF, PAR , 3 , IVOL ) PAR(1) = 0. PAR(2) = 50.043 PAR(3) = 50.0 CALL GSROTM(2,90.,0.,0.,0.,90.,270.) CALL GSVOLU( 'TCAN' , 'TUBE' ,NMED_Vac, PAR , 3 , IVOL ) PAR(1) = 50. PAR(2) = 50.043 PAR(3) = 50.0 CALL GSVOLU( 'TWIN' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) PAR(1) = 4.000-0.001905 PAR(2) = 4.000+0.001905 PAR(3) = 30 CALL GSVOLU( '4KSH' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) PAR(1) = 2.100-0.00254 PAR(2) = 2.100+0.00254 PAR(3) = 20 CALL GSVOLU( 'TAIL' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) PAR(1) = 0.0 PAR(2) = 2.100+0.00254 PAR(3) = 20 CALL GSVOLU( 'NOSE' , 'TUBE' ,NMED_LHe, PAR , 3 , IVOL ) PAR(1) = 45.000-0.001905 PAR(2) = 45.000+0.001905 PAR(3) = 40 CALL GSVOLU( 'LN2C' , 'TUBE' ,NMED_Al, PAR , 3 , IVOL ) PAR(1) = 0. PAR(2) = 33 C PAR(3) = 22 PAR(3) = 25. ! JDM CALL GSVOLU( 'MAGN' , 'TUBE' ,NMED_Vac, PAR , 3 , IVOL ) c vol_magn = IVOL PAR(1) = 10. PAR(2) = 5./tan(17.0*0.0174533) * PAR(3) = 10./tan(48.5*0.0174533) PAR(3) = 5. PAR(4) = 25. PAR(5) = 65. CALL GSVOLU( 'BRA1' , 'TUBS', NMED_Al, PAR, 5 , IVOL) PAR(4) = 115. PAR(5) = 155. CALL GSVOLU( 'BRA2' , 'TUBS', NMED_Al, PAR, 5 , IVOL) PAR(4) = 205. PAR(5) = 245. CALL GSVOLU( 'BRA3' , 'TUBS', NMED_Al, PAR, 5 , IVOL) PAR(4) = 295. PAR(5) = 335. CALL GSVOLU( 'BRA4' , 'TUBS', NMED_Al, PAR, 5 , IVOL) C C PAR(1) = 5. C PAR(2) = 10. C PAR(3) = 5./tan(17.0*0.0174533) C PAR(4) = (5+2.*PAR(1))*tan(48.5*0.0174533) C PAR(5) = PAR(4) + PAR(3) - PAR(2) PAR(1) = 8.4 PAR(2) = 10. PAR(3) = 18. C PAR(3) = 8.846*tan(73*.0174533) PAR(4) = 29. C PAR(4) = 18.3*tan(48.5*.0174533) PAR(5) = 37. C PAR(5) = 18.3/tan(17*.0174533) CALL GSROTM(3,90.,90.,90.,0.,180.,0.) CALL GSROTM(4,90.,rotmf,0.,rotmf,90.,270.+rotmf) CALL GSVOLU( 'MAG2' , 'CONE', NMED_Al, PAR, 5 , IVOL) front_drift = cer_drift-5. back_drift = cer_back guard_angle = atan(cal_width/cal_drift/2.0)/d2r guard_horz = cal_width/2.*(cer_drift+cer_length/2.)/cal_drift+0.7 wall_horz = cal_width/2.*cer_drift/cal_drift+10 PAR(2) = cal_width*front_drift/cal_drift+5 PAR(1) = 10. PAR(3) = 1 CALL GSVOLU('WAL2','BOX ',NMED_Pb,PAR,3,IVOL) PAR(1) = 0. PAR(2) = 4. PAR(3) = 1. CALL GSVOLU('PLUG','TUBE',NMED_Pb,PAR,3,IVOL) PAR(1) = cal_width*front_drift/cal_drift PAR(2) = cal_width*back_drift/cal_drift PAR(3) = 1. PAR(4) = (back_drift-front_drift)/2. CALL GSVOLU('GARD','TRD1',NMED_Pb,PAR,4,IVOL) CALL GSROTM(5,90.,90.,90.-guard_angle,180.,guard_angle,0.) CALL GSROTM(6,90.,90.,90.+guard_angle,180.,guard_angle,180.) C C Adding Front Tracking Hodoscope - JDM 5/22/07 - Three planes of C bars C call ugeom_tracker(ivol) c***************** call ugeom_cal(ivol) C C Position volumes C z0 = -earm_length C Position (general)target related volumes CALL GSPOS('NOSE',1,'TCAN',0.,0.,TargVrtzOff , 0,'MANY') CALL GSPOS('TAIL',1,'NOSE',0.,0.,TargVrtzOff , 0,'MANY') CALL GSPOS('CWAL',1,'NOSE',0.,0.,TargVrtzOff , 1,'ONLY') CALL GSPOS('LN2C',1,'TCAN',0.,0.,0. , 0,'ONLY') CALL GSPOS('4KSH',1,'TCAN',0.,0.,0. , 0,'ONLY') CALL GSPOS('BRA1',1,'MAGN',0.,0.,0. , 0,'ONLY') CALL GSPOS('BRA2',1,'MAGN',0.,0.,0. , 0,'ONLY') CALL GSPOS('BRA3',1,'MAGN',0.,0.,0. , 0,'ONLY') CALL GSPOS('BRA4',1,'MAGN',0.,0.,0. , 0,'ONLY') C z was 10, -10 for MAG2 C C CALL GSPOS('MAG2',1,'TCAN',+17.28,0.,0., 4,'MANY') C CALL GSPOS('MAG2',2,'TCAN',-17.28,0.,0., 4,'MANY') CALL GSPOS('MAG2',1,'MAGN',0.,0.,+17.28, 0,'MANY') CALL GSPOS('MAG2',2,'MAGN',0.,0.,-17.28, 3,'MANY') CALL GSPOS('MAGN',1,'TCAN',0.,0.,0., 4,' MANY') c$$$ CALL GSPOS('PLUG',1,'MAGN',0.,0.,-14., 0,'ONLY') c write(*,*)'ta-dow',lumin,thick,dens,atomnum!,beam_current !,z c > ,N_A,Q_E CALL GSPOS('TCAN',1,'EARM',0.,0.,z0, 2,' ONLY') CALL GSPOS('TWIN',1,'TCAN',0.,0.,0., 0,'ONLY') C Position Detectors x = 0. y = 0. CALL GSPOS('CGAS',1,'EARM',x,y,z0+cer_drift+cer_length/2.,0,'ONLY' + ) CALL GSPOS('CFRW',1,'CGAS',x,y,-cer_length/2., 0,'ONLY') CALL GSPOS('CBKW',1,'CGAS',x,y,+cer_length/2., 0,'ONLY') C CALL GSPOS('FESH',1,'EARM',x,y,z0+cal_drift-5,0,'ONLY') ! Iron Shield test, JDM CALL GSPOS('GAIN',1,'EARM',x,y,z0+cal_drift-gain_thk*2., 0,'ONLY') CALL GSPOS('VETO',1,'EARM',x,y,z0+cal_drift+2.*cal_depth/2.+30.,0, + 'ONLY') C Postion Detector Shielding x = wall_horz * CALL GSPOS('WAL2',1,'EARM',x,y,z0+cer_drift-2.5, 0,'ONLY') x = -guard_horz * CALL GSPOS('GARD',1,'EARM',x,y,z0+cer_drift+cer_length/2-4.5, 6,' C ONLY') C C Divide calorimeter into blocks C c CALL GSDVN( 'ECOL' , 'ECAL' , horzBl , 1) c CALL GSDVN( 'BLOC' , 'ECOL' , vertBl , 2) call divi_lucite() call divi_tracker() call divi_cal() CCC Add on outside LHe NK 03/16/11 CALL GSROTM(1,90.,SNGL(theta_0),0.,SNGL(theta_0),90.,310.) PAR(1) = 0. PAR(2) = 1.25+0.127 PAR(3) = 0.25 CALL GSVOLU( 'OLHE' , 'TUBE' ,NMED_LHe, PAR , 3 , IVOL ) thick(4) = 2*PAR(3) thick(5) = 2*PAR(3) if (target_type.EQ.0) then ! define polarized target write(*,*) '***** Configuring Polarized Target' CALL GSPOS('CELL',1,'NOSE',0.,0.,TargVrtzOff , 1,'ONLY') CALL GSPOS('OLHE',1,'NOSE',0.,0.,+1.75+TargVrtzOff , 1,'ONLY') CALL GSPOS('OLHE',2,'NOSE',0.,0.,-1.75+TargVrtzOff , 1,'ONLY') cc do ilum=1,3 do ilum=1,5 lumin(ilum) = thick(ilum)*pfdens(ilum)*beam_current > /atomnum(ilum)*N_A/Q_E*1000. !per nbarn c lumin(ilum) = pfdens(ilum) c > /atomnum(ilum) !per nbarn write(*,*)pfdens(ilum),atomnum(ilum) enddo elseif (target_type.EQ.1) then ! define standard carbon target write(*,*) '***** Configuring Carbon Target' CALL GSPOS('CRBN',1,'TCAN',0.,0.,TargVrtzOff+CdiscOff,1,'ONLY') c cc do ilum=1,1 cc do ilum=4,4 do ilum=6,6 lumin(ilum) = thick(ilum)*pfdens(ilum)*beam_current > /atomnum(ilum)*N_A/Q_E*1000. !per nbarn enddo else write(*,*) target_type,field_type STOP 'BAD TTYP (target_type)' endif write(*,*)'Luminosity=',lumin CALL GGCLOS C write(*,*)'DONE UGEOM' END Subroutine SetMedPar(medium,tpar) integer medium real tpar(5) call gstpar(medium,'CUTGAM',tpar(1)) call gstpar(medium,'CUTELE',tpar(2)) call gstpar(medium,'CUTNEU',tpar(3)) call gstpar(medium,'CUTHAD',tpar(4)) call gstpar(medium,'CUTMUO',tpar(5)) c call gstpar(medium,'ILOSS',1) call GSTPAR(medium,'DCUTE',0.00001) call GSTPAR(medium,'DCUTM',0.00001) call GSTPAR(medium,'DRAY',1.) call gstpar(medium,'BIRK1',1.) call gstpar(medium,'BIRK2',0.013) call gstpar(medium,'BIRK3',9.6E-6) call gstpar(medium,'GHCOR1',1.0) end