***
*     gugeom07.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./
      real VTOFS(3)/25.,91.45,0.75/     ! vector of TOF (BOX)
      real VEMCL(3)/30.,100.,40./       ! vector of EMcal (BOX)
      real VCASE(3)/24.,95.,1.3/        ! vector of TOF-frame (BOX)
      real VCRBN(3)/24.,95.,0.15/       ! vector of TOF-frame-Carbon (BOX)
      real VALM1(3)/24.3,0.65,2.05/     ! vector of TOF-frame-Aluminium1 (BOX)
      real VALM2(3)/23.5,0.8,3.1/       ! vector of TOF-frame-Aluminium2 (BOX)
C     real VALM3(3)/0.,0.,0./           ! vector of TOF-frame-Aluminium3 (BOX)
      real VPMTS(3)/0.,0.95,3.3/        ! vector of PMT (TUBE)
      real VMMTL(3)/1.04,1.09,2.1/      ! vector of u-metal (TUBE)
C
      REAL FIELDM,TMAXFD,DMAXMS,DEEMAX,EPSIL,STMIN,UBUF(3)
C
C ---> Integer number of material
      integer tof_mate, lucite_mate, glass_mate, mumetal_mate
C
C ---> Plastic (lucite) for cover plates (C5H8O2) ---
      real AP(3) /12.,1.,16./
      real ZP(3) /6.,1.,8./
      real WP(3) /5.,8.,2./
      real DP /1.18/
C ---> Borosilicate glass (PMT glass) [Pyrex]
      real AG(4)/16.0,28.086,10.81,22.99/ ! O,Si,B,Na
      real ZG(4)/8.,14.,5.,11./
      real WG(4)/2.01,0.8,.24,.1/  ! 80% SiO2 12% B2O3 5% Na2O
      real DG/2.23/
C
C ---> Integer number of medium
      integer tof_med, lucite_med, glass_med, mumetal_med
C
C ---> Parameter of position
      real YMMTL(6)/92.20,86.40,50.10,41.45,26.80,18.15/  ! Y-axis of metal
      real DXMMT(6)/0.,1.5,0.,0.,1.5,1.5/                 ! DX of metal
C
      integer IXPM, IYPM, KOSU
      real XMET, YMET, ZMET
      real XPMT, YPMT, 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
csn..
csn..
csn.. Defines mixture or compound IMATE as composed by NMATE
csn.. materials defined via the arrays A,Z and WMAT.
csn.. Mixtures of compounds can also be defined.
csn..
csn..    GSMIXT(IMATE,NAMATE,A,Z,DENS,NLMAT,WMAT*)
csn..
csn.. IMATE: material number
csn.. NAMATE: mixture name
csn.. A: array of atomic weights
csn.. Z: array of atomic numbers
csn.. DENS: density in g/cm*3
csn.. NLMAT: number of elements in the mixture
csn..        >0 WMAT: the proportion by weights
csn..        <0 WMAT: the proportion by number of atoms
csn..
*
c      CALL GSMATE(101,'Scintillator $',6.670,3.60,1.18,
c     +     34.4,70.8,UBUF,3)    ! define Scintillating material for TOF
C
C ---> define material for TOF
C
      tof_mate=700
      call GSMATE(tof_mate,'BC404 $',6.221,3.373,1.032,
     +            0.424E02,0.820E02,ubuf,nwbuf)
C
c      lucite_mate=tof_mate+1
c      CALL GSMIXT(lucite_mate,'Lucite    $',AP,ZP,DP,-3,WP)
C
      glass_mate=tof_mate+2
      CALL GSMIXT(glass_mate,'Borosilicate$',AG,ZG,DG,-4,WG)
C
      mumetal_mate=tof_mate+3
      CALL GSMATE(mumetal_mate,'Fe    $',55.85,26., 7.87,
     +            1.76,17.1,ubuf,nwbuf)

***
*
*             Define tracking medium
*
      IFIELD=0    !no magnetic field
      FIELDM=0.   !maximum field value(Kilogauss)
      TMAXFD=45.0 !maximum angle due to field permitted in one step(in degree)
      DMAXMS=0.50 !maximum displacement for multiple scattering in one step(cm)
      DEEMAX=0.05 !maximum fractional energy loss in one step
      EPSIL =0.01 !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)
C
c      CALL GSTMED(2,'Scintillator $',101,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
c     +            DEEMAX,EPSIL,STMIN,UBUF,3)
C
      tof_med=700
      CALL GSTMED(tof_med,'Scintillator $',tof_mate,0,IFIELD,FIELDM,
     +            TMAXFD,DMAXMS,DEEMAX,EPSIL,STMIN,UBUF,3)
C
c      lucite_med=tof_med+1
c      CALL GSTMED(lucite_med,'Light Guide $',mumetal_mate,0,IFIELD,FIELDM,
c     +            TMAXFD,DMAXMS,DEEMAX,EPSIL,STMIN,UBUF,3)
C
      glass_med=tof_med+2
      CALL GSTMED(glass_med,'PMT glass $',glass_mate,0,IFIELD,FIELDM,
     +            TMAXFD,DMAXMS,DEEMAX,EPSIL,STMIN,UBUF,3)
C
      mumetal_med=tof_med+3
      CALL GSTMED(mumetal_med,'Mu-metal $',mumetal_mate,0,IFIELD,FIELDM,
     +            TMAXFD,DMAXMS,DEEMAX,EPSIL,STMIN,UBUF,3)
C
C     carbon_med=
      CALL GSTMED(3,'Carbon $',6,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
     +            DEEMAX,EPSIL,STMIN,UBUF,3)
C
C     alumi_med=
      CALL GSTMED(4,'Aluminium $',9,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
     +            DEEMAX,EPSIL,STMIN,UBUF,3)
C
c      CALL GSTMED(5,'PMT $',15,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
c     +            DEEMAX,EPSIL,STMIN,UBUF,3)
c      CALL GSTMED(6,'Mu-metal $',10,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
c     +            DEEMAX,EPSIL,STMIN,UBUF,3)
C
      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)
C
      CALL GSVOLU('TOFS','BOX ',tof_med,VTOFS,3,IVOLU)
C
      CALL GSVOLU('CRBN','BOX ',3,VCRBN,3,IVOLU)
      CALL GSVOLU('ALM1','BOX ',4,VALM1,3,IVOLU)
      CALL GSVOLU('ALM2','BOX ',4,VALM2,3,IVOLU)
c      CALL GSVOLU('ALM3','BOX ',4,VALM3,3,IVOLU)
C
      CALL GSVOLU('PMT ','TUBE',glass_med,VPMTS,3,IVOLU)
      CALL GSVOLU('MMTL','TUBE',mumetal_med,VMMTL,3,IVOLU)
C
      CALL GSVOLU('EMCL','BOX ',11,VEMCL,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('CRBN',1,'CASE',0.,0., 1.15,1,'ONLY')
      CALL GSPOS('CRBN',2,'CASE',0.,0.,-1.15,1,'ONLY')
      CALL GSPOS('ALM1',1,'CASE',0., 95.65,0.75,1,'ONLY')
      CALL GSPOS('ALM1',2,'CASE',0.,-95.65,0.75,1,'ONLY')
      CALL GSPOS('ALM2',1,'CASE',1.5, 97.7,11.6,1,'ONLY')
      CALL GSPOS('ALM2',2,'CASE',1.5,-97.7,11.6,1,'ONLY')
      CALL GSPOS('TOFS',1,'CASE',0.,0.,2.1,1,'ONLY')
      CALL GSPOS('EMCL',1,'MOTH',550.,0.,0.,2,'ONLY')
*
      do IXPM = 1, 16
         XMET = (IXPM-1)*3.0-(24.0-0.75)+DXMMT(1)
         YMET = YMMTL(1)
         ZMET = 3.2
         XPMT = XMET
         YPMT = YMET
         ZPMT = ZMET + 1.2
         KOSU = IXPM
         CALL GSPOS('MMTL',KOSU,'TOFS',XMET,YMET,ZMET,1,'ONLY')
         CALL GSPOS('PMT ',KOSU,'TOFS',XPMT,YPMT,ZPMT,1,'ONLY')
         XMET = 0.- XMET
         YMET = 0.- YMET
         ZMET = ZMET
         XPMT = XMET
         YPMT = YMET
         ZPMT = ZMET + 1.2
         KOSU = IXPM + 16
         CALL GSPOS('MMTL',KOSU,'TOFS',XMET,YMET,ZMET,1,'ONLY')
         CALL GSPOS('PMT ',KOSU,'TOFS',XPMT,YPMT,ZPMT,1,'ONLY')
      enddo
*
      do 100 IYPM = 2,6
         do 10 IXPM = 1,16
            XMET = (IXPM-1)*3.0-(24.0-0.75)+DXMMT(IYPM)
            YMET = YMMTL(IYPM)
            ZMET = 2.0
            XPMT = XMET
            YPMT = YMET - 1.2*((-1.)**IYPM)
            ZPMT = ZMET
            KOSU = IXPM + 32*(IYPM-1)
            CALL GSPOS('MMTL',KOSU,'TOFS',XMET,YMET,ZMET,3,'ONLY')
            CALL GSPOS('PMT ',KOSU,'TOFS',XPMT,YPMT,ZPMT,3,'ONLY')
            XMET = 0.- XMET
            YMET = 0.- YMET
            ZMET = ZMET
            XPMT = 0.- XPMT
            YPMT = 0.- YPMT
            ZPMT = ZPMT
            KOSU = IXPM + 16 + 32*(IYPM-1)
            CALL GSPOS('MMTL',KOSU,'TOFS',XMET,YMET,ZMET,3,'ONLY')
            CALL GSPOS('PMT ',KOSU,'TOFS',XPMT,YPMT,ZPMT,3,'ONLY')
 10      continue
 100  continue
      CALL GGCLOS
      RETURN
      END
*
*