Return to ugeom.f CVS log

Up to [HallC] / sane_geant_mc / SRC

Change min energy cut for block
Read in target position from input file
Added tracker and hodo info

      SUBROUTINE UGEOM

      implicit none
      
      include 'constants.inc'
      include 'geant.inc'
      include 'sane.inc'
      include 'materials.inc'
      include 'beta_geom.inc'
      include 'sane_misc.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) 
      real*4 ZKelF(3),AKelF(3),WKelF(3)
      real*4 x,y
      real*4 densHyd,densHel,densNit
      real tpar(5)
      data tpar/0.001, 0.001, 0.01, 0.01, 0.01/


c$$$      densHyd = Hyddens
c$$$      densHel = Heldens
c$$$      densNit = Nitdens

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/
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     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
      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
c$$$      WHyd=Hyddens
c$$$      WHel=Heldens
c$$$      WNit=Nitdens
c$$$      WNH3(1)=WHyd
c$$$      WNH3(2)=WHel
c$$$      WNH3(3)=WNit
      WNH3(1)=Hyddens
      WNH3(2)=Heldens
      WNH3(3)=Nitdens
C
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)
C      CALL GSMATE(29,'He 1K',4.0,2.0,0.145,650.5,0.,0,0)
      CALL GSMATE(29,'He 1K',4.0,2.0,Heldens,650.5,0.,0,0)
      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.
      PAR(3) = 0.05
      CALL GSVOLU('CRBN','BOX ', NMED_C,PAR,3,IVOL )

      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 )

      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 target related volumes

      if (target_type.EQ.0) then    ! define polarized target
        write(*,*) '***** Configuring Polarized Target'
        CALL GSPOS('NOSE',1,'TCAN',0.,0.,TargVrtzOff  , 0,'MANY')
        CALL GSPOS('TAIL',1,'NOSE',0.,0.,TargVrtzOff  , 0,'MANY')
        CALL GSPOS('CELL',1,'NOSE',0.,0.,TargVrtzOff  , 1,'ONLY')
        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')


*        CALL GSPOS('PLUG',1,'MAGN',0.,0.,-14.,               0,'ONLY')
      elseif (target_type.EQ.1) then          ! define standard carbon target
        write(*,*) '***** Configuring Carbon Target'
        CALL GSPOS('CRBN',1,'TCAN',0.,0.,TargVrtzOff+0.3,1,    'ONLY')
      else
        write(*,*) target_type,field_type
        STOP 'BAD TTYP (target_type)'
      endif
      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()
     
      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