***
*     gugeom05.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)/0.75,21.7,0.75/     ! vector of TOF-short (BOX)
      real VTOFL(3)/0.75,31.9,0.75/     ! vector of TOF-long  (BOX)
      real VEMCL(3)/30.,100.,40./       ! vector of EMcal (BOX)
      real VCASE(3)/24.,95.,1.3/        ! vector of TOF-frame (BOX)
      real VCABN(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)
      real VALM3(3)/0.,0.,0./           ! vector of TOF-frame-Aluminium3 (BOX)
      real VMETA(3)/1.04,1.09,2.1/      ! vector of u-metal (TUBE)
      real VPMTS(3)/0.,0.95,3.3/        ! vector of PMT (TUBE)
C
      REAL FIELDM,TMAXFD,DMAXMS,DEEMAX,EPSIL,STMIN,UBUF(3)
C
      real YMETAL(6)/92.20,86.40,50.10,41.45,26.80,18.15/  ! Y-axis of metal
      real DXMETA(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
*
      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,'Aluminium $',9,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
     +            DEEMAX,EPSIL,STMIN,UBUF,3)
      CALL GSTMED(5,' Metal $',10,0,IFIELD,FIELDM,TMAXFD,DMAXMS,
     +            DEEMAX,EPSIL,STMIN,UBUF,3)
      CALL GSTMED(6,'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('VTF1','BOX ',1,VCASE,3,IVOLU)
      CALL GSVOLU('VTF2','BOX ',1,VCASE,3,IVOLU)
      CALL GSVOLU('TOFS','BOX ',2,VTOFS,3,IVOLU)
      CALL GSVOLU('TOFL','BOX ',2,VTOFL,3,IVOLU)
      CALL GSVOLU('CABN','BOX ',3,VCABN,3,IVOLU)
      CALL GSVOLU('ALM1','BOX ',4,VALM1,3,IVOLU)
      CALL GSVOLU('ALM2','BOX ',4,VALM2,3,IVOLU)
      CALL GSVOLU('ALM3','BOX ',4,VALM3,3,IVOLU)
      CALL GSVOLU('META','TUBE',5,VMETA,3,IVOLU)
      CALL GSVOLU('PMT ','TUBE',6,VPMTS,3,IVOLU)
      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('VTF1',1,'MOTH',498.,0.,0.,2,'ONLY')
      CALL GSPOS('VTF2',1,'MOTH',498.,0.,0.,2,'ONLY')
      CALL GSPOS('EMCL',1,'MOTH',550.,0.,0.,2,'ONLY')
*
      CALL GSPOS('CABN',1,'VTF1',0.,0., 1.15,1,'ONLY')
      CALL GSPOS('CABN',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')
*
      do IXTF = 1,16
         XTOF = (IXTF-1)*3.0-(24.0-0.75)+DXMETA(1)
         YTOF1= 69.7
         YTOF2= 11.65
         YTOF3= -56.6
         ZTOF = 2.1
         ITOF = IXTF
         JTOF = IXTF + 32
         CALL GSPOS('TOFS',ITOF,'VTF1',XTOF,YTOF1,ZTOF,1,'ONLY')
         CALL GSPOS('TOFL',ITOF,'VTF1',XTOF,YTOF2,ZTOF,1,'ONLY')
         CALL GSPOS('TOFL',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('TOFS',ITOF,'VTF1',XTOF,YTOF1,ZTOF,1,'ONLY')
         CALL GSPOS('TOFL',ITOF,'VTF1',XTOF,YTOF2,ZTOF,1,'ONLY')
         CALL GSPOS('TOFL',JTOF,'VTF1',XTOF,YTOF3,ZTOF,1,'ONLY')
      enddo
*
      do IXPM = 1, 16
         XMET = (IXPM-1)*3.0-(24.0-0.75)+DXMETA(1)
         YMET = YMETAL(1)
         ZMET = 6.6
         XPMT = XMET
         YPMT = YMET
         ZPMT = ZMET + 1.2
         KOSU = IXPM
         CALL GSPOS('META',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('META',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)+DXMETA(IYPM)
            YMET = YMETAL(IYPM)
            ZMET = 4.2
            XPMT = XMET
            YPMT = YMET - 1.2*((-1.)**IYPM)
            ZPMT = ZMET
            KOSU = IXPM + 32*(IYPM-1)
            CALL GSPOS('META',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('META',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
*
*