***
*     gugeom10.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
C ---> Vectors
      real VMOTH(3)/4000.,2000.,4000./
      real pTFPN(3)/24.5,100.,16./
      real pEMCL(3)/30.,100.,45./
      real VSCTS(3)/0.75,21.7,0.75/     ! vector of TOF-short (BOX)
      real VSCTL(3)/0.75,31.9,0.75/     ! vector of TOF-long  (BOX)
      real VEMCL(3)/30.,100.,25./       ! vector of EMcal (BOX)
      real VHCMB(3)/24.,95.,1.0/        ! 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
      integer cable_mate, pbglass_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
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 ---> Cable
      real AC(4)/63.54,12.01,1.01,35.45/  ! Cu,C,H,Cl
      real ZC(4)/29.00,6.00,1.00,17.00/
      real WC(4)/0.393,1.214,2.117,0.311/ ! 39.3% Cu 31.1% C2H3Cl 29.6% C2H4
      real DC/1.936/
C
C ---> Integer number of medium
      integer tof_med, lucite_med, glass_med, mumetal_med
      integer cable_med, pbglass_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 IXTF, ITOF, JTOF, IXPM, IYPM, KOSU
      real XTOF, YTOF, ZTOF
      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
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)
C
c      cable_mate=cable_mate+4
c      CALL GSMIXT(cable_mate,'Cable$',AC,ZC,DC,-4,WC)
C
      pbglass_mate=800
      CALL GSMATE(pbglass_mate,'S pb-glass',116.162,47.045,4.010,
     +            0.252E01,0.384E02,ubuf,nwbuf)

***
*
*             Define tracking medium
*
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..        define 0 or 1
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
cak..
cak.. Automatic calculation takes plase in case the input value is negative
cak..
cak.. COMMON/GCTRAK/
cak.. IGAUTO : Automatic computation of DEEMAX,STMIN,TMAXFD,STEMAX
cak..          Flag set to 0 tracking parameters are given by the user
cak..                      1 tracking parameters are calculated by GEANT
*
      IGAUTO = 0
*
      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)
*
C
      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      cable_med=tof_med+4
c      CALL GSTMED(cable_med,'Cable $',cable_mate,0,IFIELD,FIELDM,
c     +            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
      pbglass_med=800
      CALL GSTMED(pbglass_med,'Pb-glass $',pbglass_mate,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)
C
      CALL GSVOLU('VTF1','BOX ',1,pTFPN,3,IVOLU)
      CALL GSATT('VTF1','SEEN',0)
      CALL GSVOLU('VTF2','BOX ',1,pTFPN,3,IVOLU)
      CALL GSATT('VTF2','SEEN',0)
      CALL GSVOLU('VCAL','BOX ',1,pEMCL,3,IVOLU)
      CALL GSATT('VCAL','SEEN',0)
C
      CALL GSVOLU('SCTS','BOX ',tof_med,VSCTS,3,IVOLU)
      CALL GSATT('SCTS','SEEN',1)
      CALL GSATT('SCTS','COLO',2)
      CALL GSVOLU('SCTL','BOX ',tof_med,VSCTL,3,IVOLU)
      CALL GSATT('SCTL','SEEN',1)
      CALL GSATT('SCTL','COLO',2)
C
      CALL GSVOLU('HCMB','BOX ',3,VHCMB,3,IVOLU)
      CALL GSATT('HCMB','SEEN',1)
      CALL GSATT('HCMB','COLO',1)
      CALL GSVOLU('CRBN','BOX ',3,VCRBN,3,IVOLU)
      CALL GSATT('CRBN','SEEN',1)
      CALL GSATT('CRBN','COLO',1)
      CALL GSVOLU('ALM1','BOX ',4,VALM1,3,IVOLU)
      CALL GSATT('ALM1','SEEN',1)
      CALL GSATT('ALM1','COLO',6)
      CALL GSVOLU('ALM2','BOX ',4,VALM2,3,IVOLU)
      CALL GSATT('ALM2','SEEN',1)
      CALL GSATT('ALM2','COLO',6)
c      CALL GSVOLU('ALM3','BOX ',4,VALM3,3,IVOLU)
C
      CALL GSVOLU('PMT ','TUBE',glass_med,VPMTS,3,IVOLU)
      CALL GSATT('PMT ','SEEN',1)
      CALL GSATT('PMT ','COLO',4)
      CALL GSVOLU('MMTL','TUBE',mumetal_med,VMMTL,3,IVOLU)
      CALL GSATT('MMTL','SEEN',1)
      CALL GSATT('MMTL','COLO',4)
C
      CALL GSVOLU('EMCL','BOX ',pbglass_med,VEMCL,3,IVOLU)
      CALL GSATT('EMCL','SEEN',1)
      CALL GSATT('EMCL','COLO',2)
**
*
*             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('VTF1',1,'MOTH',498.,0.,0.,2,'ONLY')
      CALL GSPOS('VTF2',1,'MOTH',498.,0.,0.,2,'ONLY')
      CALL GSPOS('VCAL',1,'MOTH',560.,0.,0.,2,'ONLY')
*
      CALL GSPOS('HCMB',1,'VTF1',0.,0., 0.,1,'ONLY')
      CALL GSPOS('CRBN',1,'VTF1',0.,0., 1.15,1,'ONLY')
      CALL GSPOS('CRBN',2,'VTF1',0.,0.,-1.15,1,'ONLY')
      CALL GSPOS('ALM1',1,'VTF2',0., 95.65,0.75,1,'ONLY')
      CALL GSPOS('ALM1',2,'VTF2',0.,-95.65,0.75,1,'ONLY')
      CALL GSPOS('ALM2',1,'VTF2',1.5, 97.7,11.6,1,'ONLY')
      CALL GSPOS('ALM2',2,'VTF2',1.5,-97.7,11.6,1,'ONLY')
*
      CALL GSPOS('EMCL',1,'VCAL',0.,0.,-20.,1,'ONLY')
*
      do IXTF = 1,16
         XTOF = (IXTF-1)*3.0-(24.0-0.75)+DXMMT(1)
         YTOF1= 69.7
         YTOF2= 11.65
         YTOF3= -56.6
         ZTOF = 2.1
         ITOF = IXTF
         JTOF = IXTF + 32
         CALL GSPOS('SCTS',ITOF,'VTF1',XTOF,YTOF1,ZTOF,1,'ONLY')
         CALL GSPOS('SCTL',ITOF,'VTF1',XTOF,YTOF2,ZTOF,1,'ONLY')
         CALL GSPOS('SCTL',JTOF,'VTF1',XTOF,YTOF3,ZTOF,1,'ONLY')
         XTOF = 0.- XTOF
         YTOF1= 0.- YTOF1
         YTOF2= 0.- YTOF2
         YTOF3= 0.- YTOF3
         ZTOF = 2.1
         ITOF = IXTF + 16
         JTOF = IXTF + 48
         CALL GSPOS('SCTS',ITOF,'VTF1',XTOF,YTOF1,ZTOF,1,'ONLY')
         CALL GSPOS('SCTL',ITOF,'VTF1',XTOF,YTOF2,ZTOF,1,'ONLY')
         CALL GSPOS('SCTL',JTOF,'VTF1',XTOF,YTOF3,ZTOF,1,'ONLY')
      enddo
*
      do IXPM = 1, 16
         XMET = (IXPM-1)*3.0-(24.0-0.75)+DXMMT(1)
         YMET = YMMTL(1)
         ZMET = 6.6
         XPMT = XMET
         YPMT = YMET
         ZPMT = ZMET + 1.2
         KOSU = IXPM
         CALL GSPOS('MMTL',KOSU,'VTF1',XMET,YMET,ZMET,1,'ONLY')
         CALL GSPOS('PMT ',KOSU,'VTF1',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,'VTF1',XMET,YMET,ZMET,1,'ONLY')
         CALL GSPOS('PMT ',KOSU,'VTF1',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 = 4.2
            XPMT = XMET
            YPMT = YMET - 1.2*((-1.)**IYPM)
            ZPMT = ZMET
            KOSU = IXPM + 32*(IYPM-1)
            CALL GSPOS('MMTL',KOSU,'VTF1',XMET,YMET,ZMET,3,'ONLY')
            CALL GSPOS('PMT ',KOSU,'VTF1',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,'VTF1',XMET,YMET,ZMET,3,'ONLY')
            CALL GSPOS('PMT ',KOSU,'VTF1',XPMT,YPMT,ZPMT,3,'ONLY')
 10      continue
 100  continue
      CALL GGCLOS
      RETURN
      END
*
*