***
*     gugeom03.f
***
*
      SUBROUTINE UGEOM
*
***********************************************************************
*                                                                     *
*             User routine to define geometry of detector             *
*                                                                     *
***********************************************************************
C
      COMMON/GCVOLU/NLEVEL,NAMES(15),NUMBER(15),
     +LVOLUM(15),LINDEX(15),INFROM,NLEVMX,NLDEV(15),LINMX(15),
     +GTRAN(3,15),GRMAT(10,15),GONLY(15),GLX(3)
      CHARACTER*4 NAMES
C
      INTEGER IVOLU,IFIELD
C
      REAL VMOTH(3)/4000.,2000.,4000./,
     +     VTOFS(3)/25.,91.45,0.75/,     ! vector of TOF (BOX)
     +     VEMCL(3)/30.,100.,40./,       ! vector of EMcal (BOX)
     +     VCASE(3)/24.,95.,1.3/,        ! vector of TOF-frame (BOX)
     +     VCABN(3)/24.,95.,0.15/,       ! vector of TOF-frame-Carbon (BOX)
     +     VMETA(3)/1.04,1.09,2.1/,      ! vector of u-metal (TUBE)
     +     VPMTS(3)/0.,0.95,3.3/         ! vector of PMT (TUBE)
C
      REAL FIELDM,TMAXFD,DMAXMS,DEEMAX,EPSIL,STMIN,UBUF(3)
C
      integer IMET, KOSU
      real XMET, YMET, ZPMT
*     ----------------------------------------------------------
***
*
*             Define material
*
csn.. Stores the constants for the material IMATE in the data
csn.. structire JMATE
csn..
csn.. GSMATE(IMATE,CHNAMA,A,Z,DENS,RADL,ABSL,UBUF,NWBUF)
csn..
csn.. IMATE: material number
csn.. CHNAMA: material name
csn.. A: atomic weight
csn.. Z: atomic number
csn.. DENS: density in g/cm*3
csn.. RADL: radiation length in cm
csn.. ABSL: absorption length in cm (ignored)
csn.. UBUF: array of NWBUF additional user parameters
csn.. NWBUF: number of user words in UBUF
*
      CALL GSMATE(101,'Scintillator $',6.670,3.60,1.18,
     +     34.4,70.8,UBUF,3)    ! define Scintillating material for TOF
***
*
*             Define tracking medium
*
      IFIELD=0   !no magnetic field
      FIELDM=0.  !maximum field value(Kilogauss)
      TMAXFD=5.00!maximum angle due to field permitted in one step(in degree)
      DMAXMS=0.1 !maximum displacement for multiple scattering in one step(cm)
      DEEMAX=0.1 !maximum fractional energy loss in one step
      EPSIL=0.1  !tracking precision(cm)
      STMIN=1.0  !minimum step due to energy loss or multiple scattering(cm)
*
csn.. assoiates a set of tracking parameters to a material, defining a
csn.. so-called tracking medium. The routine stores the parameters of the
csn.. tracking medium ITMED in the data structure JTMED.
csn..
csn.. GSTMED(ITMED,NATMED,NMAT,ISVOL,IFIELD,FIELDM,TMAXFD,STEMAX,
csn..        DEEMAX,EPSIL,STMIN,UBUF,NWBUF)
csn..
csn.. ITMED: tracking medium number
csn.. NATMED: tracking medium name
csn.. NMAT: material number corresponding to ITMED
csn.. ISVOL: sensitivity flag (<=0 not a sensitive volume)
csn.. IFIELD: magnetic field flag
csn.. 0=no magnetic, 1=strongly inhomogeneous,2=inhomogeneous, 3=uniform)
csn.. FIELDM: maximum fiedl value in Kilogauss
csn.. TMAXFD: max angu deviation due to the mag. field permitted in one step
csn.. STEMAX: maximum step permitted (cm)
csn.. DEFMAX: maximum fractional energy loss in one step (0<DEFMAX<=1)
csn.. EPSIL: boundary crossing precision (cm)
csn.. STMIN: minimum value for the maximum step imposed by energy loss,etc (cm)
csn.. UBUF: array of NWBUF additional user parameters
csn.. NWBUF: number of additional user parameters
*
      CALL GSTMED(1,'Air $',15,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
     +            DEEMAX,EPSIL,STMIN,UBUF,3)
      CALL GSTMED(2,'Scintillator $',101,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
     +            DEEMAX,EPSIL,STMIN,UBUF,3)
      CALL GSTMED(3,'Carbon $',6,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
     +            DEEMAX,EPSIL,STMIN,UBUF,3)
      CALL GSTMED(4,' Metal $',10,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
     +            DEEMAX,EPSIL,STMIN,UBUF,3)
      CALL GSTMED(5,'PMT $',16,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
     +            DEEMAX,EPSIL,STMIN,UBUF,3)
      CALL GSTMED(11,'Lead $',13,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
     +            DEEMAX,EPSIL,STMIN,UBUF,3)
***
*
*             Define relation between axis
*
csn.. Stores rotaion matrix IROT in the data structure JROTM.
csn..
csn.. CSROTM(IROT,THETA1,PHI1,THETA2,PHI2,THETA3,PHI3)
csn..
csn.. IROT: number of the rotation matrix
csn.. THETA1(2/3): polar angle for the exis x(y/z)
csn.. PHI1(2/3): azimuthal angle for axis x(y/z)
*
      CALL GSROTM(1,90.,0.,90.,90.,0.,0.)
      CALL GSROTM(2,180.,0.,90.,90.,90.,0.)
      CALL GSROTM(3,90.,0.,180.,90.,90.,90.)
**
*
*             Define volumes
*
csn.. Defines a volume with a given name/shape/tracking medium num/shape param
csn..
csn.. GSVOLU(CHNAME,CHSHAP,NMED,PAR,NPAR,IVOLU*)
csn..
csn.. CHNAME: char*4 volume name,  it must be unique
csn.. CHSHAP: char*4 name of one of GEANT shape
csn.. NMED: int tracking medium number for the volume.
csn.. PAR: array containing the shape parameters
csn.. NPAR: number of parameters.
csn.. IVOLU: internal volume number.
*
      CALL GSVOLU('MOTH','BOX ',1,VMOTH,3,IVOLU)
      CALL GSVOLU('CASE','BOX ',1,VCASE,3,IVOLU)
      CALL GSVOLU('CABN','BOX ',3,VCABN,3,IVOLU)
      CALL GSVOLU('TOFS','BOX ',2,VTOFS,3,IVOLU)
      CALL GSVOLU('EMCL','BOX ',11,VEMCL,3,IVOLU)
      CALL GSVOLU('META','TUBE',4,VMETA,3,IVOLU)
      CALL GSVOLU('PMT ','TUBE',5,VPMTS,3,IVOLU)

**
*
*             Position volumes
*
csn.. Places a copy of a volume previously defined by a call to GSVOLU
csn.. inside its mother volume CHMOTH.
csn..
csn.. GSPOS(CHNAME,NR,CHMOTH,X,Y,Z,IROT,CHONLY)
csn..
csn.. CHNAME: char*4 name of the volume being positioned
csn.. NR: copy number of the volume CHNAME being positioned
csn.. X/Y/Z: x/y/z position of the volume int the mother reference system
csn.. IROT: rotation matrix number describing the orientation of the vol
csn..       relative to the coordinate system of the mother
csn.. CHONLY: char*4 flag to indicate whether a point found to be in this
csn..         volume may also be in other volumes which are... (ONLY/MANY)
*
      CALL GSPOS('CASE',1,'MOTH',498.,0.,0.,2,'ONLY')
      CALL GSPOS('CABN',1,'CASE',0.,0.,1.15,1,'ONLY')
      CALL GSPOS('CABN',2,'CASE',0.,0.,-1.15,1,'ONLY')
      CALL GSPOS('TOFS',1,'CASE',0.,0.,2.1,1,'ONLY')
      CALL GSPOS('EMCL',1,'MOTH',550.,0.,0.,2,'ONLY')
      do IMET = 0, 15
         XMET = IMET*3.0-(24.0-0.75)
         YMET = 92.5
         ZPMT = 1.2
         KOSU = IMET + 1
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,3.2,2,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
         XMET = 0.- XMET
         YMET = 0.- YMET
         KOSU = IMET + 17
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,3.2,2,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
      enddo
      do IMET = 0,15
         XMET = IMET*3.0-(24.0-0.75)+1.5
         YMET = 86.45
         ZPMT = -1.2
         KOSU = IMET + 33
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,2.,3,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
         XMET = 0.- XMET
         YMET = 0.- YMET
         ZPMT = 0.- ZPMT
         KOSU = IMET + 49
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,2.,3,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
*
         XMET = IMET*3.0-(24.0-0.75)
         YMET = 50.15
         ZPMT = +1.2
         KOSU = IMET + 65
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,2.,3,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
         XMET = 0.- XMET
         YMET = 0.- YMET
         ZPMT = 0.- ZPMT
         KOSU = IMET + 81
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,2.,3,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
*
         XMET = IMET*3.0-(24.0-0.75)
         YMET = 41.50
         ZPMT = -1.2
         KOSU = IMET + 97
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,2.,3,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
         XMET = 0.- XMET
         YMET = 0.- YMET
         ZPMT = 0.- ZPMT
         KOSU = IMET + 113
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,2.,3,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
*
         XMET = IMET*3.0-(24.0-0.75)+1.5
         YMET = 26.90
         ZPMT = +1.2
         KOSU = IMET + 129
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,2.,3,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
         XMET = 0.- XMET
         YMET = 0.- YMET
         ZPMT = 0.- ZPMT
         KOSU = IMET + 145
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,2.,3,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
*
         XMET = IMET*3.0-(24.0-0.75)+1.5
         YMET = 18.25
         ZPMT = -1.2
         KOSU = IMET + 161
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,2.,3,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
         XMET = 0.- XMET
         YMET = 0.- YMET
         ZPMT = 0.- ZPMT
         KOSU = IMET + 177
         CALL GSPOS('META',KOSU,'TOFS',XMET,YMET,2.,3,'ONLY')
         CALL GSPOS('PMT ',KOSU,'META',0.,0.,ZPMT,1,'ONLY')
      enddo
      CALL GGCLOS
      RETURN
      END
*
*
