*CMZ :          12/07/95  01.40.48  by  Kazuyoshi Kurita
*CMZ :  2.03/00 18/03/93  12.28.34  by  S.R.Tonse
*-- Author :
*-- Author :
c     ======================
c     File Name :    TOF.FOR
c     ======================
c
c
c     Description :
c     =============
c
c     This subroutine defines the geometry of PHENIX - TOF wall.
c     Here we consider both the Hadron and electron sector.
c
c
c     Author:-   Tapan Nayak
c     (with help from Brian Cole)
c
c     Creation Date: 16-Sep-1992
c     ==========================
c
c     Revisions:-
c     =========
c     Date    Name            Description
c     ----    ----            -----------
c    5/21/95  K.Kurita	     Totally revised for the latest design
c
c	Structure of TOF;
c	=================
c			TFPN			     TFRL
c		  	  |
c	-------------------------------------
c	|	 	  |                 |
c     ALFR		CLMN              HCMB
c                         |		    |
c                   -------------         CRBN
c                   |           |
c                 SLTS        SLTL
c		    |           |
c          ------------------   -------------
c          |     |     |    |   |     |     |
c        PMAS  SCTS  LGPR LGSx PMAS SCTL  LGPR
c                               |
c		---------------------------------
c               |       |       |       |       |
c              PMT    MMTL    BASE    SCKT    etc...
c
c
c     The following parameters are used in the PHNX.par routine.
c     $tof_par
c     $end
c================================================================
c
c============================
      subroutine TOF(FULL,NH)
c============================
      implicit none
*KEEP,GCFLAG.
      COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN
     +        ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2)
      COMMON/GCFLAX/BATCH, NOLOG
      LOGICAL BATCH, NOLOG
C
      INTEGER       IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN
     +        ,IEOTRI,IEVENT,ISWIT,IFINIT,NEVENT,NRNDM
C
*KEEP,GCLIST.
      COMMON/GCLIST/NHSTA,NGET ,NSAVE,NSETS,NPRIN,NGEOM,NVIEW,NPLOT
     +       ,NSTAT,LHSTA(20),LGET (20),LSAVE(20),LSETS(20),LPRIN(20)
     +             ,LGEOM(20),LVIEW(20),LPLOT(20),LSTAT(20)
C
      INTEGER       NHSTA,NGET ,NSAVE,NSETS,NPRIN,NGEOM,NVIEW,NPLOT
     + ,NSTAT,LHSTA,LGET ,LSAVE,LSETS,LPRIN,LGEOM,LVIEW,LPLOT,LSTAT
C
*KEEP,GCONST.
      REAL          PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS
      REAL          EMMU,PMASS,AVO
C
      COMMON/GCONST/PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS
      COMMON/GCONSX/EMMU,PMASS,AVO
C
*KEEP,GUGEOM.
      integer irot, irotnull
      common/gugeompar/irot, irotnull
c
c   The following are used in GSDETH
c   Hit parameters will be position, energy, and energy loss in the detector
c   and path length in detector
c
      character*4 namesh(11) /'POSX','POSY','POSZ','DELE','TOFL','P_ID',
     1                        'P_PX','P_PY','P_PZ','PLEN','ETOT'/
      integer*4 nbitsh(11) /11*32/
c
c     default setting of offsets and gains
c
      REAL ORIG(11) /1000.0,1000.0,1000.0,3*0.,3*50.,2*0./  !offset
      REAL FACT(11) /3*100.,1.E7,100.,1.,3*1000.,100.,2000./   !gain
c
c
c   The above gains give
c              - 0.1 keV energy deposition resolution
c              - 10  picosec resolution on time of flight
c              - 0.1 mm position resolution
c              - 1.0 MeV/c momentum resolution
c              - 0.1 mm path length resolution
c              - 0.5 MeV energy resolution
c
c
c     logical reference volumes  (mother volumes for detector sub-systems)
c     flaring of volumes is accomplished with the use of POLYCONES
c
c mjl enlarge mother volume to contain centrail muon id outside the hall
c
c mjl real par_m(3) /750.,750.,1000./     ! Mother volume (exp. hall)
      real par_m(3) /1000.,1100.,1100./   ! Mother volume (exp. hall)
CJPS  real dim_vert(3) /5.0,20.0,31.9/    ! VERT volume (shrunk to allow nosecone)
      real dim_vert(3) /4.5,20.0,40.0/    ! VERT volume (conflicts with nosecone)
CJPS  real pos_vert(3) /0.0,0.0,0.0/      ! VERT position
      real pos_vert(3) /0.0,0.0,-8.0/     ! VERT position
      real dim_lpdu(3) /5.0,26.0,0.5/     ! LPDU volume
      real pos_lpdu(3) /0.0,0.0,+60.0/    ! LPDU position
      real dim_lpdd(3) /5.0,26.0,0.5/     ! LPDD volume
      real pos_lpdd(3) /0.0,0.0,-60.0/    ! LPDD position
      real dim_spdu(3) /5.0,12.5,0.5/     ! SPDU volume
      real pos_spdu(3) /0.0,0.0,+160.0/   ! SPDU position
      real dim_spdd(3) /5.0,12.5,0.5/     ! SPDL volume
      real pos_spdd(3) /0.0,0.0,-160.0/   ! SPDL position
c
c     INNR polycone: from 20 to 100 cm
c          (should be 5 cm away from yoke front face)
c          NOTE: The INNR and any INR detectors are incompatible with
c                using the muon nose cone.
c
      integer innr_npoly
      parameter (innr_npoly = 21)
      real innr_poly (innr_npoly)
     A         / 0.0, 360.0, 6.0,   ! PHI1, PHI2, # ZPLANES
     1         -62.3, 100., 100.,   ! first Z plane (low Z half)
     2         -55.0, 80.0, 100.,   ! second Z plane (low Z half)
     3         -54.9, 20.0, 100.,   ! third Z plane (low Z half)
     4         +54.9, 20.0, 100.,   ! fourth Z plane (high Z half)
     5         +55.0, 80.0, 100.,   ! fifth Z plane (high Z half)
     6         +62.3, 100., 100./   ! sixth Z plane (high Z half)
c
c     INTR polycone: from 100 to 250 cm
c     Y. Akiba and CFM corrections for new central magnet yoke design
c                  (should be 2 cm away from the yoke front face)
c
      integer intr_npoly
      parameter (intr_npoly = 15)
      real intr_poly (intr_npoly)
     A         / 0.0, 360.0, 4.0,   ! PHI1, PHI2, # ZPLANES
     1         -120., 250., 250.,   ! first Z plane (low Z half)
     2         -65.3, 100., 250.,   ! second Z plane (low Z half)
     3         +65.3, 100., 250.,   ! third Z plane (high Z half)
     4         +120., 250., 250./   ! fourth Z plane (high Z half)
c
c     CERK polycone: from 250 to 410 cm (with hodoscope array)
c
      integer cerk_npoly
      parameter (cerk_npoly = 33)
      real cerk_poly (cerk_npoly)
     A         / 0.0, 360.0, 10.0,  ! PHI1, PHI2, # ZPLANES
     1         -300.00, 250., 410., ! first Z plane (low Z half)
     2         -170.01, 250., 410., ! second Z plane (low Z half)
     3         -170.00, 260., 410., ! third Z plane (low Z half)
     4         -150.00, 260., 410., ! fourth Z plane (low Z half)
     5         -140.00, 250., 410., ! fifth Z plane (low Z half)
     6         +140.00, 250., 410., ! sixth Z plane (high Z half)
     7         +150.00, 260., 410., ! seventh Z plane (high Z half)
     8         +170.00, 260., 410., ! eight Z plane (high Z half)
     9         +170.01, 250., 410., ! ninth Z plane (high Z half)
     A         +300.00, 250., 410./ ! tenth Z plane (high Z half)
c
c   October 7, 1994:  TRAD is no longer in use (C.F. MAGUIRE)
c
c     real dim_trad(3) /410.0,490.0,300.0/      ! TRAD volume
c     real pos_trad(3) /0.0, 0.0,0.0/  ! TRAD position
c
c   October 7, 1994:  TOF IS NOT WORKING IN PISA SINCE OCTOBER 1992 !!
c
c
      real dim_tofl(3) /490.0,510.0,300.0/      ! TOFL volume
      real pos_tofl(3) /0.0, 0.0,0.0/  ! TOFL position
c
c     EMCL polycone: from 510 to 700 cm
c     EMCL polycone: from 410 to 700 cm   cfm: June 10, 1993
c
      integer emcl_npoly
      parameter (emcl_npoly = 15)
      real emcl_poly (emcl_npoly)
     A         / 0.0, 360.0, 4.0,   ! PHI1, PHI2, # ZPLANES
     1         -587., 700., 700.,   ! first Z plane (low Z half, 50 deg)
     2         -344., 410., 700.,   ! second Z plane (low Z half, 50 deg)
     3         +344., 410., 700.,   ! third Z plane (high Z half, 50 deg)
     4         +587., 700., 700./   ! fourth Z plane (high Z half, 50 deg)
C
*KEEP,GUPHNX.
*-- Author :
*-- Author :
C     File GUPHNX.INC
C
C     C. F. Maguire           April 7, 1992
C      Revised for passive volume options April 21, 1992
C
C     This file should contain all variables of general interest
C     for the PHNX version of GEANT (Data card definition, flags, ...
C
      INTEGER*4   LUN_INIT /10/     ! lun for init data
      INTEGER*4   LUN_DINP /70/     ! lun for input data
      INTEGER*4   LUN_DOUT /71/     ! lun for output data
      INTEGER*4   LUN_DMCI /72/     ! lun for MC data
      INTEGER*4   NIN_KEYS    ! input data structure(s)
      INTEGER*4   IN_KEYS(10)
      CHARACTER*4 CIN_KEYS(10)
      EQUIVALENCE   ( CIN_KEYS(1), IN_KEYS(1) )
      INTEGER*4   NOUT_KEYS      ! output data structure(s)
      INTEGER*4   OUT_KEYS(10)
      CHARACTER*4 COUT_KEYS(10)
      EQUIVALENCE   ( COUT_KEYS(1), OUT_KEYS(1) )
      INTEGER*4   NSTE_KEYS      ! steer path of PISA
      INTEGER*4   STE_KEYS(10)
      CHARACTER*4 CSTE_KEYS(10)
      EQUIVALENCE   ( CSTE_KEYS(1), STE_KEYS(1) )
      CHARACTER*80   CINIT_FILE,       ! file for initialisation data
     1         CDINP_FILE, CDOUT_FILE,  ! files for in/output data
     &         CDMCI_FILE,     !file for MC data
     1         CHBK_FILE,              ! hbook output file
     1         CPAR_FILE               ! phnx.par file name
      INTEGER*4   PHNX_DVOL   ! number of PHNX detector components
      PARAMETER     ( PHNX_DVOL = 12)
      INTEGER*4       IVOL(PHNX_DVOL)
      CHARACTER*4     CVOL(PHNX_DVOL)
     1                  /'VER','BBC','INR','ITR','CRK','TRD',
     1                   'TOF','EMC','PBG','MUM','MUN','MUW'/
      EQUIVALENCE   ( IVOL(1), CVOL(1) )
      INTEGER*4   P_VOLU(PHNX_DVOL)       ! pointer SET -> CVOL
      INTEGER*4   IVOLU_OPT(10,PHNX_DVOL)
      CHARACTER*4 CVOLU_OPT(10,PHNX_DVOL)
      REAL*4       RVOLU_OPT(10,PHNX_DVOL)
      EQUIVALENCE (IVOLU_OPT(1,1), CVOLU_OPT(1,1), RVOLU_OPT(1,1))
C
C        switch to control response of specific volume
c        NOTE: These are relics from the FOPI program and should be revised.
C        1        geometry
C        2        hit structure
C        3        tracking option
C        4        digitization
C        5-10     user parameter
C
      INTEGER*4   PHNX_PVOL   ! number of PHNX passive volumes
      PARAMETER     ( PHNX_PVOL = 10)
      INTEGER*4       IPVOL2(PHNX_PVOL)
c
c     Passive volume names (will probably have more for PHENIX)
c
      CHARACTER*4     CPVOL2(PHNX_PVOL)
     1                  /'MAGF','emt0', 'PIPE','HBAG','TARG','emt1',
     1                  'emt2','emt3','emt4','emt5'/
      EQUIVALENCE (IPVOL2(1), CPVOL2(1))
      INTEGER*4       IPVOL(PHNX_PVOL)
      CHARACTER*4 CPVOL(PHNX_PVOL)
      EQUIVALENCE (IPVOL(1), CPVOL(1))
      INTEGER*4   IPVOLU_OPT(10,PHNX_PVOL)
      CHARACTER*4 CPVOLU_OPT(10,PHNX_PVOL)
      REAL*4       RPVOLU_OPT(10,PHNX_PVOL)
      EQUIVALENCE (IPVOLU_OPT(1,1), CPVOLU_OPT(1,1), RPVOLU_OPT(1,1))
      REAL*4      RMAG1_BCEN, RMAG2_BCEN    ! magnetic fields
      INTEGER*4   DO_KINE, DO_JXYZ, DO_HITS, DO_TRAK, DO_DIGI
      INTEGER*4   IU_INI_PAR
c
      COMMON /GUPHNX/
     1    NIN_KEYS, IN_KEYS, NOUT_KEYS, OUT_KEYS, NSTE_KEYS, STE_KEYS,
     1    CINIT_FILE, CDINP_FILE, CDOUT_FILE, CDMCI_FILE,
     1    IVOLU_OPT, P_VOLU, IPVOL,
     1    RMAG1_BCEN, RMAG2_BCEN,
     1    DO_KINE, DO_JXYZ, DO_HITS, DO_TRAK, DO_DIGI,
     1    IU_INI_PAR, IPVOLU_OPT,
     1    CHBK_FILE, CPAR_FILE
C
C
*KEEP,FFLINK.
*-- Author :
c     ======================
c     File Name : FFLINK.INC
c     ======================
c
c     Description :
c     =============
c
c     This subroutine contains the TOF include statements.
c
c     Author:-   Tapan Nayak
c     (based on CFM proposition for TOF ZEBRA banks May 7, 1992
c
c
c     Creation Date: 16-Sep-1992
c     ==========================
c
c     Revisions:-
c     =========
c     Date    Name            Description
c     ----    ----            -----------
c
c
c
c
c
c
c     =========================
c     Start of the include file
c     =========================
      integer*4    lFF_Cal             ! Pointer to the FCAL bank
      integer*4    lFF_link
      integer*4    lFF_lref
      integer*4    lFF_last
      integer*4    lFF_PARA
      integer*4    lFF_PARU
      common       /FFLINK/
     #             lFF_link,           ! start of structural links
     #             lFF_PARA,           !parameter bank's links
     #             lFF_PARU,
     #             lFF_Cal,            ! Calibrated data
     #             lFF_lref,           ! start of reference links
     #             lFF_last            ! last link ptr.
c
c   Slat information
c
      integer      mFF_pmts            ! number of PMTs per slat
      parameter    (mFF_pmts = 2)
c
c     scintillator parameters
c
      real         scint_vlight           ! light velocity in cm/ns
      parameter    (scint_vlight = 14.0)  ! GSI measured value
      real         scint_lambda           ! light attenuation factor (cm)
      parameter    (scint_lambda=0.0125)  ! GSI number
c
c----> Structure of the parameter back     bank ID : EPRA
c
      integer        ofea_TOFL_rpos
      integer        ofea_TFHP_phi_1
      integer        ofea_TFHP_phi_2
      integer        ofea_TFHP_dimen_1
      integer        ofea_TFHP_dimen_2
      integer        ofea_TFHP_dimen_3
      integer        ofea_TFHP_nslat
      integer        ofea_TFHP_isegm
      integer        ofea_TFEP_phi_1
      integer        ofea_TFEP_phi_2
      integer        ofea_TFEP_phi_3
      integer        ofea_TFEP_phi_4
      integer        ofea_TFEP_dimen_1
      integer        ofea_TFEP_dimen_2
      integer        ofea_TFEP_dimen_3
      integer        ofea_TFEP_nslat
      integer        ofea_TFEP_isegm
      integer        ofea_color_tof
      integer        ofea_med_tof
c
      parameter     (ofea_TOFL_rpos   = 0)
      parameter     (ofea_TFHP_phi_1  = 1)
      parameter     (ofea_TFHP_phi_2  = 2)
      parameter     (ofea_TFHP_dimen_1= 3)
      parameter     (ofea_TFHP_dimen_2= 4)
      parameter     (ofea_TFHP_dimen_3= 5)
      parameter     (ofea_TFHP_nslat  = 6)
      parameter     (ofea_TFHP_isegm  = 7)
      parameter     (ofea_TFEP_phi_1  = 8)
      parameter     (ofea_TFEP_phi_2  = 9)
      parameter     (ofea_TFEP_phi_3  =10)
      parameter     (ofea_TFEP_phi_4  =11)
      parameter     (ofea_TFEP_dimen_1=12)
      parameter     (ofea_TFEP_dimen_2=13)
      parameter     (ofea_TFEP_dimen_3=14)
      parameter     (ofea_TFEP_nslat  =15)
      parameter     (ofea_TFEP_isegm  =16)
      parameter     (ofea_color_tof   =17)
      parameter     (ofea_med_tof     =18)
c
c----> Structure of the user parameter back     bank ID : EPRU
c
      integer       ofea_TFHS_dimen_1
      integer       ofea_TFHS_dimen_2
      integer       ofea_TFHS_dimen_3
      integer       ofea_TFHS_length
      integer       ofea_mFF_HADdets
      integer       ofea_TFES_dimen_1
      integer       ofea_TFES_dimen_2
      integer       ofea_TFES_dimen_3
      integer       ofea_TFES_length
      integer       ofea_mFF_ELEdets
      integer       ofea_mFF_ALLdets
c
      parameter    (ofea_TFHS_dimen_1= 0)
      parameter    (ofea_TFHS_dimen_2= 1)
      parameter    (ofea_TFHS_dimen_3= 2)
      parameter    (ofea_TFHS_length = 3)
      parameter    (ofea_mFF_HADdets = 4)
      parameter    (ofea_TFES_dimen_1= 5)
      parameter    (ofea_TFES_dimen_2= 6)
      parameter    (ofea_TFES_dimen_3= 7)
      parameter    (ofea_TFES_length = 8)
      parameter    (ofea_mFF_ELEdets = 9)
      parameter    (ofea_mFF_ALLdets =10)
c
c ---------------------------------------------------------------------------
c --- structure of the calibrated data bank       bank ID: FCAL
c
c       lFF_Cal
c       |
c       V
c       V
c       0 MUL, (islat, tof1, tof2, de1, de2, tof, demean), ...
c                       slat number, PMT1_tof, PMT2_tof, PMT1_de, PMT2_de,
c                               true tof, true energy loss
c
      integer*4   mFF_CAL
      integer     oFFc_sector
      integer     oFFc_ipanel
      integer     oFFc_ipslat
      integer     oFFc_islat
      integer     oFFc_tof1
      integer     oFFc_tof2
      integer     oFFc_de1
      integer     oFFc_de2
      integer     oFFc_tof
      integer     oFFc_demean
      integer     oFFc_partid
c
c --- oFFsets
c
      PARAMETER ( mFF_Cal     =11)  ! Size of 1 entry in calibrated data bank
      PARAMETER ( oFFc_sector = 0)  ! Sector : HAD (1TFHP) or ELE (TFEP)
      PARAMETER ( oFFc_ipanel = 1)  ! Panel number
      PARAMETER ( oFFc_ipslat = 2)  ! Slat number in the panel
      PARAMETER ( oFFc_islat  = 3)  ! Slat number
      PARAMETER ( oFFc_de1    = 4)  ! Offset PMT1 dele entry
      PARAMETER ( oFFc_de2    = 5)  ! Offset PMT2 dele entry
      PARAMETER ( oFFc_tof1   = 6)  ! Offset PMT1 tof entry
      PARAMETER ( oFFc_tof2   = 7)  ! Offset PMT2 tof entry
      PARAMETER ( oFFc_tof    = 8)  ! Offset calculated TOF
      PARAMETER ( oFFc_demean = 9)  ! Offset calculated DELE
      PARAMETER ( oFFc_partid =10)  ! Offset particle ID of hit
C --- end of FFLINK.inc --------------------------------------------------
C
*KEND.
c
c    NEED to access zebra to write parameters to FZOUT file
c
*KEEP,FSTORE.
*-- Author :
C
C --- fstore.inc -------------------------------------------------------
C
C Parameters and Declarations for the FOPI ZEBRA Store (FSTORE)
C
C Store size:
C
      integer  pf_store_size
      integer  pf_store_fence
      integer  pf_store_div12
      parameter   (pf_store_size =  400000)
      parameter   (pf_store_fence   =      10)
      parameter   (pf_store_div12   =    1000)
C
C Division sizes for
C
C PDiv for Parameters (quasi static data)
C RDiv for Run data (Wiped per Run)
C EDiv for Event data (Wiped per Event)
C
CTON  INTEGER  pf_pdiv_size
CTON  INTEGER  pf_pdiv_max
      INTEGER  pf_rdiv_size
      INTEGER  pf_rdiv_max
      INTEGER  pf_ediv_size
      INTEGER  pf_ediv_max
CTON  parameter   (pf_pdiv_size  =   50000)
CTON  parameter   (pf_pdiv_max   =  100000)
      parameter   (pf_rdiv_size  =   5000)
      parameter   (pf_rdiv_max   =  20000)
      parameter   (pf_ediv_size  =  200000)
      parameter   (pf_ediv_max   =  400000)
        INTEGER*4 mFence_F, m_FSTORE
        PARAMETER ( mFence_F = pf_store_fence )
        PARAMETER ( m_FSTORE  = pf_store_size )
C
C
C
      integer*4   ixdiv_Fp
      integer*4   ixdiv_Fr
      integer*4   ixdiv_Fe
      integer*4   lqFence_F(pf_store_fence)
      integer*4   lq_F(pf_store_size)
      integer*4   iq_F(pf_store_size)
      REAL*4       q_F(pf_store_size)
      integer*4   lqf_fence, lqf
      integer*4   iqF(pf_store_size)
      REAL*4       qF(pf_store_size)
      COMMON /FSTORE/
     #   ixdiv_fp,
     #   ixdiv_fr,
     #   ixdiv_fe,
     #   lqf_fence(pf_store_fence), lqf(pf_store_size)
      equivalence (qf(1),iqf(1),lqf(9))
        EQUIVALENCE ( lqf(1), lq_F(1) )
        EQUIVALENCE ( iqf(1), iq_F(1) )
        EQUIVALENCE (  qf(1),  q_F(1) )
        EQUIVALENCE ( lqf_fence(1), lqFence_F(1) )
C
C --- end of fstore.inc --------------------------------------------------
C
*KEND.
      real         dphi
      real         phi
      real         phi_low
      real         TOFL_rpos
      real         TFHP_phi_1
      real         TFHP_phi_2
      real         TFHP_dimen(3)
      real         TFEP_phi_1
      real         TFEP_phi_2
      real         TFEP_phi_3
      real         TFEP_phi_4
      real         TFEP_dimen(3)
      real         TFHS_length
      real         TFES_length
      real         TFHS_dimen(3)
      real         TFES_dimen(3)
      real         z_panel
      integer      nw
      integer      nuHADpar
      parameter    (nuHADpar = 13)
      integer      nuELEpar
      parameter    (nuELEpar = 14)
      real         uHADpar(nuHADpar)
      real         uELEpar(nuELEpar)
      integer*4    mFF_HADdets
      integer*4    mFF_ELEdets
      integer*4    mFF_ALLdets
      integer      TFHP_nslat
      integer      TFHP_isegm
      integer      TFEP_nslat
      integer      TFEP_isegm
      integer      color_tof
      integer      idtype
      integer      iofA, IOFU, IPOINT
      integer      iset
      integer      idet
      integer      isegment
      integer      ival
      integer      ivolu
      integer      iphi
      integer      iaxis
      integer      irot_tof
      integer      itheta
      integer      ip
      integer      med_tof
      integer      nr
      integer*4    nh           ! set before call in gugeom
      integer      ndiv
      integer      nv
      integer      npar
      integer      nmed
      integer      nbitsv(2)
      integer      nwpa
      integer      nwsa
      integer      tof_para_nd
      integer      tof_paru_nd
      character*20 chform
      character*4  full         ! set before call in gugeom
      character*4  namesv(2)
      character*50 par_file
      character*4  set_id

c
c     Initialize default values for Namelist
c
c	Now only TFHP is implemented as a wall consisting of  8 panels
c	  16-NOV-1994 KK
c
      data         TOFL_rpos      / 506.29 /
      data         TFHP_phi_1     /  22.5 / ! half openning angle of two arms
      data         TFHP_phi_2     /  11.25 /! phi offset start from 0 or dphi/2
      data         TFHP_dimen     /  96.84, 0.75, 195.4 /
      data         TFHP_nslat     / 256 /
      data         TFHP_isegm     /   2 /   ! how many gap sectors from the top
      data         TFEP_phi_1     / 112.5/  ! TFEP parameter not used now NOV94
      data         TFEP_phi_2     / 202.5/
      data         TFEP_phi_3     / -22.5/
      data         TFEP_phi_4     /  67.5/
      data         TFEP_dimen     /  0.5, 65.0, 90. /
      data         TFEP_nslat     / 128  /
      data         TFEP_isegm     /   2  /
      data         color_tof      /   4  /
      data         med_tof        /   2  /
      namelist     /tof_par/
     $             TOFL_rpos,
     $             TFHP_phi_1,
     $             TFHP_phi_2,
     $             TFHP_dimen,
     $             TFHP_nslat,
     $             TFHP_isegm,
     $             TFEP_phi_1,
     $             TFEP_phi_2,
     $             TFEP_phi_3,
     $             TFEP_phi_4,
     $             TFEP_dimen,
     $             TFEP_nslat,
     $             TFEP_isegm,
     $             color_tof,
     $             med_tof

c working parameters
      character*4  v_m_name
      character*4  v_i_name
	real gpos(3)
        real pos_panel(3)
        real scintz(3) ! z position of scintillators in CLMN. Short one is 1
        real send_gap/2.654/,lend_gap/5.486/,btwn_gap/4.445/
c
c	vecrots starting with p were meant for psudo volume
c
c
	real	pTFPN_dim(3)/7.87,96.9,24.5/
	real 	pHCMB_dim(3)/1.27,96.3,24.3/
	real	CRBN_dim(3)/0.15875,93.98,24.13/
	real	pSLTS_dim(3)/1.5,5.0,24.0/
	real	pSLTL_dim(3)/1.5,5.0,34.0/
	real	pCLMN_dim(3)/1.5,5.0,93.98/
      	real 	SCTL_dim(3)/0.7505,0.7505,31.885/
      	real	SCTS_dim(3)/0.7505,0.7505,21.695/
      	real	LGPR_dim(4)/0.,2.064,0.7505,1.032/
	real	LGST_dim(3)/0.7505,1.407,0.7505/
	real	LGS1_dim(3)/0.7505,0.6565,0.7505/
	real	LGS2_dim(4)/0.,1.0615,0.7505,0.5307/
	real	pPMAS_dim(3)/1.5,4.675,2.5/
	real 	PMT_dim(3)/0.8,0.95,3.2/
	real	MMTL_dim(3)/1.04,1.09,2.1/
	real 	BASE_dim(3)/1.27,2.2225,0.1524/
	real	SCKT_dim(3)/0.4,0.9,0.3/
	real	pALFR_dim(3)
	real	RAIL_dim
	real	WRSP_dim
	real	PLBR_dim
	real	ALFR_dim
        real    Slat_halfwidth/0.76327/
        real    Panel_halfwidth/24.42464/
	integer glass_med/2/,lucite_med/2/,mumetal_med/2/,tof_med/2/
        integer iclmn
	integer ipnl,npnl/8/
c
      INTEGER NMAT,ISVOL,IFIELD,NWBUF
C
      REAL FIELDM,TMAXFD,DMAXMS,DEEMAX,EPSIL,STMIN,
     1  UBUF(10)

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/

      integer tof_mate,mumetal_mate,glass_mate,mumetal_mate

C
c
c     Read geometery file segment from:   PHNX.PAR file
c
      par_file = 'phnx.par'
      open (unit=15,file=par_file,status='OLD',err=997)
      read (15,nml=tof_par,err=999)
      close(unit=15)
c
c     Zebra Bank :
c
      chform = '6F 2I 7F 4I'
      call MZFORM('PARA',chform,iofA)         ! book characteristics
c
c     Write parameters to a zebra bank.
c     Later they will go to output file.
c     tof_para_nd is the # of data words.
c     iof is the IO format word.
c
      tof_para_nd = 19
      call MZBOOK(
     $     ixdiv_fr,
     $     lFF_PARA,
     $     lFF_PARA,
     $     1,
     $     'PARA',
     $     0,
     $     0,
     $     TOF_PARA_ND,
     $     iofA,
     $     0)
c
c     Copy raw geometry parameters into 'EPRA' bank.
c     Fill the bank
c
      IPOINT = LFF_PARA + 1
      qf( IPOINT  + ofea_TOFL_rpos   )  =   TOFL_rpos
      qf( IPOINT  + ofea_TFHP_phi_1  )  =   TFHP_phi_1
      qf( IPOINT  + ofea_TFHP_phi_2  )  =   TFHP_phi_2
      qf( IPOINT  + ofea_TFHP_dimen_1)  =   TFHP_dimen(1)
      qf( IPOINT  + ofea_TFHP_dimen_2)  =   TFHP_dimen(2)
      qf( IPOINT  + ofea_TFHP_dimen_3)  =   TFHP_dimen(3)
      iqf( IPOINT  + ofea_TFHP_nslat  )  =   TFHP_nslat
      iqf( IPOINT  + ofea_TFHP_isegm  )  =   TFHP_isegm
      qf( IPOINT  + ofea_TFEP_phi_1  )  =   TFEP_phi_1
      qf( IPOINT  + ofea_TFEP_phi_2  )  =   TFEP_phi_2
      qf( IPOINT  + ofea_TFEP_phi_3  )  =   TFEP_phi_3
      qf( IPOINT  + ofea_TFEP_phi_4  )  =   TFEP_phi_4
      qf( IPOINT  + ofea_TFEP_dimen_1)  =   TFEP_dimen(1)
      qf( IPOINT  + ofea_TFEP_dimen_2)  =   TFEP_dimen(2)
      qf( IPOINT  + ofea_TFEP_dimen_3)  =   TFEP_dimen(3)
      iqf( IPOINT  + ofea_TFEP_nslat  )  =   TFEP_nslat
      iqf( IPOINT  + ofea_TFEP_isegm  )  =   TFEP_isegm
      iqf( IPOINT  + ofea_color_tof   )  =   color_tof
      iqf( IPOINT  + ofea_med_tof     )  =   med_tof
c
c     End of EPRA bank filling.
c
c     Only book volumes if input parameters request it
      if (CVOLU_OPT(1,7) .ne. 'FULL' .and.
     $       CVOLU_OPT(1,7) .ne. 'VOLS')then
         write(*,'(1x,a)')' TOF : No volumes defined '
         goto 9999
      endif
ckk
ckk
ckk
c
c ---> define material for TOF
c
      tof_mate=700
      call gsmate(tof_mate,'BC404 $',6.221,3.373,1.032,
     1              0.424E02,0.820E02,ubuf,nwbuf)
c
      lucite_mate=tof_mate+1
      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,0,0)
c
c ---> define tracking media for TOF
c
c	glass_med,lucite_med,mumetal_med,tof_med
      isvol = 1   ! sensitive
      ifield = 0  ! no magnetic field
      fieldm = 0.0   ! max field
      tmaxfd = 45.0  ! maximum angle due to field (one step) in degrees
      dmaxms = 0.50  ! max disp. due to mulsct. in one step (cm)
      deemax = 0.05  ! max fractional energy loss in one step
      epsil = 0.01   ! tracking precision (cm)
      stmin = 0.1 ! min step due to e loss or mulsct. (cm)
      ubuf(1) = 0.   ! tracking stop switch
*
     tof_med=700
      call gstmed(tof_med,'TOF SCINT $',tof_mate,isvol,ifield,fieldm,tmaxfd,
     1            dmaxms,deemax,epsil,stmin,ubuf,nwbuf)
*
      isvol=0
      lucite_med=tof_med+1
      call gstmed(Lucite_med,'TOF Light Guide$',lucite_mate,isvol,ifield,
     1	fieldm,tmaxfd,dmaxms,deemax,epsil,stmin,ubuf,nwbuf)
*
      glass_med=tof_med+2
      call gstmed(glass_med,'TOF PMT glass$',glass_mate,isvol,ifield,
     1	fieldm,tmaxfd,dmaxms,deemax,epsil,stmin,ubuf,nwbuf)
*
      mumetal_med=tof_med+3
      call gstmed(mumetal_med,'TOF Mu metal$',mumetal_mate,isvol,ifield,
     1	fieldm,tmaxfd,dmaxms,deemax,epsil,stmin,ubuf,nwbuf)

c
c---> Create PHENIX-TOF pseudo volums (May '95)
c	(fill them with air)
c
      v_i_name = 'TFPN'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',6,pTFPN_dim,npar,ivolu)
      call GSATT(v_i_name,'SEEN',0)

      v_i_name = 'HCMB'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',6,pHCMB_dim,npar,ivolu)
      call GSATT(v_i_name,'SEEN',0)
	
      v_i_name = 'PMAS'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',6,pPMAS_dim,npar,ivolu)
      call GSATT(v_i_name,'SEEN',0)

      v_i_name = 'CLMN'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',6,pCLMN_dim,npar,ivolu)
      call GSATT(v_i_name,'SEEN',0)
c
      v_i_name = 'SLTS'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',6,pSLTS_dim,npar,ivolu)
      call GSATT(v_i_name,'SEEN',0)
c
      v_i_name = 'SLTL'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',6,pSLTL_dim,npar,ivolu)
      call GSATT(v_i_name,'SEEN',0)
c
c---> Create real volumes ( carbon= med# 17)
c
      v_i_name = 'CRBN'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',17,CRBN_dim,npar,ivolu) ! carbon
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',1)
c
      v_i_name = 'PMT '
      npar     = 3
      call GSVOLU(v_i_name,'TUBE',glass_med,PMT_dim,npar,ivolu) ! glass
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',1)
c
      v_i_name = 'MMTL'
      npar     = 3
      call GSVOLU(v_i_name,'TUBE',mumetal_med,MMTL_dim,npar,ivolu) ! mu-metal
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',1)
c
      v_i_name = 'BASE'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',24,BASE_dim,npar,ivolu) ! G10 plate
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',1)
c
      v_i_name = 'SCKT'
      npar     = 3
      call GSVOLU(v_i_name,'TUBE',Lucite_med,SCKT_dim,npar,ivolu) ! lucite
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',1)
c
      v_i_name = 'SCTS'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',tof_med,SCTS_dim,npar,ivolu) ! scinti.
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',4)
c
      v_i_name = 'SCTL'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',tof_med,SCTL_dim,npar,ivolu) ! scinti.
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',4)
c
      v_i_name = 'LGPR'
      npar     = 4
      call GSVOLU(v_i_name,'TRD1',lucite_med,LGPR_dim,npar,ivolu) ! scinti.
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',1)
c
      v_i_name = 'LGST'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',lucite_med,LGST_dim,npar,ivolu) ! scinti.
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',1)
c

      v_i_name = 'LGS2'
      npar     = 4
      call GSVOLU(v_i_name,'TRD1',lucite_med,LGS2_dim,npar,ivolu) ! scinti.
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',1)
c
      v_i_name = 'LGS1'
      npar     = 3
      call GSVOLU(v_i_name,'BOX ',lucite_med,LGS1_dim,npar,ivolu) ! scinti.
      call GSATT(v_i_name,'SEEN',1)
      call GSATT(v_i_name,'COLO',1)
c
c---> Definition of rotation matrix
c
      irot_tof  = irot+1                  ! start of rotation matrix index
      irot=irot+10                        ! reserve 10 rotation matrix
      call GSROTM(irot_tof,90.,0.,90.,90.,0.,0.) ! no rotation
      call GSROTM(irot_tof+1,90.,90.,90.,180.,0.,0.) ! +90 deg around z-axis
      call GSROTM(irot_tof+2,90.,270.,135.,0.,45.,0.) ! -90z x -45x
      call GSROTM(irot_tof+3,90.,90.,90.,0.,180.,0.) ! +90z x +180x
      call GSROTM(irot_tof+4,0.,0.,90.,0.,90.,-90.) ! x->z y->x z->-y
      call GSROTM(irot_tof+5,0.,0.,90.,0.,90.,90.) ! x->z y->x z->y
      call GSROTM(irot_tof+6,90.,180.,90.,270.,0.,0.) ! +180z
c
c---> Positioning media into mother volumes
c
      v_m_name  =  'PMAS'	! mother volum
c     ========================================
c PMT: PMT itself
c MMTL: Mu-metal shield
c BASE: PMT base G10 board
c SCKT: PMT socket joint to BASE

      v_m_name  =  'SLTS'	! mother volum
c     ========================================
      v_i_name  =  'SCTS'	! daughter volume
      nr        =  0            ! Copy number
      gpos(1)=0.0
      gpos(2)=SCTS_dim(2)-pSLTS_dim(2) ! bottom of the pseudo volume
      gpos(3)=0.0
      call GSPOS('SCTS',nr,'SLTS',gpos(1),gpos(2),gpos(3),
     &          irot_tof,'ONLY')
c  LGPR: prism shape light guide 	
      nr=1
      gpos(1)=0.0
      gpos(2)=LGPR_dim(2)-pSLTS_dim(2) ! bottom of the pseudo volume
      gpos(3)=-1.*(SCTS_dim(3)+LGPR_dim(4))
      call GSPOS('LGPR',nr,'SLTS',gpos(1),gpos(2),gpos(3),
     &            irot_tof+1,'ONLY')
c LGST: 90deg light guide (substitute at this moment)
      nr=1
      gpos(1)=0.0
      gpos(2)=LGST_dim(2)-pSLTS_dim(2) ! bottom of psudo volume
      gpos(3)=SCTS_dim(3)+LGST_dim(3)
      call GSPOS('LGST',nr,'SLTS',gpos(1),gpos(2),gpos(3),
     &            irot_tof,'ONLY')
c LGS1: 90deg light guide
c      nr=1
c      gpos(1)=0.0
c      gpos(2)=LGS1_dim(2)+SCTS_dim(2)*2.-pSLTS_dim(2) ! right above SCTS
c      gpos(3)=SCTS_dim(3)+LGS1_dim(3)
c      call GSPOS('LGS1',nr,'SLTS',gpos(1),gpos(2),gpos(3),
c     &            irot_tof,'ONLY')
c LGS2: 90deg light guide
c      nr=1
c      gpos(1)=0.0
c      gpos(2)=LGS2_dim(2)*sqrt(2.)-LGS2_dim(4)/sqrt(2.)
c     &     -pSLTS_dim(2)                               ! right below LGS1
c      gpos(3)=SCTS_dim(3)+LGS2_dim(4)/sqrt(2.)
c      call GSPOS('LGS2',nr,'SLTS',gpos(1),gpos(2),gpos(3),
c     &            irot_tof+2,'ONLY')

      v_m_name  =  'SLTL'	! mother volum
c     ========================================
      v_i_name  =  'SCTL'	! daughter volume
      nr        =  0            ! Copy number
      gpos(1)=0.0
      gpos(2)=SCTL_dim(2)-pSLTL_dim(2) ! bottom of the pseudo volume
      gpos(3)=0.0
      call GSPOS('SCTL',nr,'SLTL',gpos(1),gpos(2),gpos(3),
     &          irot_tof,'ONLY')
c  LGPR: prism shape light guide 	
      nr=1
      gpos(1)=0.0
      gpos(2)=LGPR_dim(2)-pSLTL_dim(2) ! bottom of the pseudo volume
      gpos(3)=-1.*(SCTL_dim(3)+LGPR_dim(4))
      call GSPOS('LGPR',nr,'SLTL',gpos(1),gpos(2),gpos(3),
     &            irot_tof+1,'ONLY')
c  LGPR: prism shape light guide the other side	
      nr=2
      gpos(1)=0.0
      gpos(2)=LGPR_dim(2)-pSLTL_dim(2) ! bottom of the pseudo volume
      gpos(3)=SCTL_dim(3)+LGPR_dim(4)
      call GSPOS('LGPR',nr,'SLTL',gpos(1),gpos(2),gpos(3),
     &            irot_tof+3,'ONLY')

      v_m_name  =  'CLMN'	! mother volum
c     ========================================
      v_i_name  =  'SLTS'	! daughter volume
      gpos(1)=0.0
      gpos(2)=0.0                      ! mother and daughter have same height
c
      scintz(1)=pCLMN_dim(3)-(send_gap+SCTS_dim(3)) ! short from positive z
      scintz(2)=scintz(1)-(SCTS_dim(3)+btwn_gap+SCTL_dim(3)) ! long
      scintz(3)=scintz(2)-(SCTL_dim(3)+btwn_gap+SCTL_dim(3)) ! long
c
      gpos(3)=scintz(1)
      nr=1
      call GSPOS('SLTS',nr,'CLMN',gpos(1),gpos(2),gpos(3),
     &            irot_tof,'ONLY')
      gpos(3)=scintz(2)
      nr=1
      call GSPOS('SLTL',nr,'CLMN',gpos(1),gpos(2),gpos(3),
     &            irot_tof,'ONLY')
      gpos(3)=scintz(3)
      nr=2
      call GSPOS('SLTL',nr,'CLMN',gpos(1),gpos(2),gpos(3),
     &            irot_tof,'ONLY')

      v_m_name  =  'HCMB'	! mother volum
c     ========================================
      v_i_name  =  'CRBN'	! daughter volume

c  CRBN-> HCMB: prism shape light guide 	
      nr=1
      gpos(1)=pHCMB_dim(1)-CRBN_dim(1)
      gpos(2)=0.0
      gpos(3)=0.0
      call GSPOS('CRBN',nr,'HCMB',gpos(1),gpos(2),gpos(3),
     &            irot_tof,'ONLY')
      nr=2
      gpos(1)=-1.*gpos(1)
      call GSPOS('CRBN',nr,'HCMB',gpos(1),gpos(2),gpos(3),
     &            irot_tof,'ONLY')

      v_m_name  =  'TFPN'	! mother volum
c     ========================================
      v_i_name  =  'HCMB'	! daughter volume

c  HCMB-> TFPN: Honey Comb to the panel 	
c
      nr=1
      gpos(1)=pHCMB_dim(1)-pTFPN_dim(1)
      gpos(2)=0.0
      gpos(3)=0.0
      call GSPOS('HCMB',nr,'TFPN',gpos(1),gpos(2),gpos(3),
     &            irot_tof,'ONLY')

      v_m_name  =  'TFPN'	! mother volum
c     ========================================
      v_i_name  =  'CLMN'	! daughter volume
      nr=1
      do iclmn=1,32
        gpos(1)= pHCMB_dim(1)*2.+pCLMN_dim(2)-pTFPN_dim(1)
        gpos(2)=0.0
        gpos(3)=(float(iclmn-16)*2-1)*slat_halfwidth
        if(mod(iclmn,2).eq.1)then
          call GSPOS('CLMN',nr,'TFPN',gpos(1),gpos(2),gpos(3),
     &            irot_tof+4,'ONLY')
        else
          call GSPOS('CLMN',nr,'TFPN',gpos(1),gpos(2),gpos(3),
     &            irot_tof+5,'ONLY')
        endif
        nr=nr+1
      enddo
c
c ===> placing TOF panels into EMCL
c
      v_m_name  =  'EMCL'	! mother volum TOFL-->EMCL 22-NOV-94
      v_i_name  =  'TFPN'
      nr        =  0                    ! Copy number
      do ipnl = 1,npnl
         nr = nr + 1
         pos_panel(1) = -1.*(TOFL_rpos + pTFPN_dim(1)
     &			- pHCMB_dim(1) - slat_halfwidth)
         pos_panel(2) = 0.0
         pos_panel(3) = Panel_halfwidth*float((1-npnl + 2*(ipnl-1)))
         call GSPOS(v_i_name,nr,v_m_name,pos_panel(1),
     &           pos_panel(2),pos_panel(3),irot_tof+6,'ONLY')
       enddo
c
c     END volume definitions
c
c     Get slat dimensions :
c     For hadron sector
c
      TFHS_dimen(1) = TFHP_dimen(1)
      TFHS_dimen(2) = TFHP_dimen(2)
      TFHS_dimen(3) = TFHP_dimen(3)/TFHP_nslat
      TFHS_length   = TFHS_dimen(2)
      mFF_HADdets    = mFF_pmts*(TFHP_nslat*6)
      mFF_ELEdets    = mFF_pmts*(TFEP_nslat*20)
      mFF_ALLdets    = mFF_HADdets
c
c     Only book detectors if input parameters request it
      if (CVOLU_OPT(1,7) .ne. 'FULL')then
         write(*,'(1x,a)')
     &   ' TOF : Volumes defined but no detectors'
         goto 9999
      endif
c
c     Put TFPN in set 'TOF '
c
      set_id    = 'TOF '        ! put it in a SET
      idtype    = 0
      nwpa      = 200           ! for now
      nwsa      = 200           ! for now
      call GSDETV(set_id,'SCTL',idtype,nwpa,nwsa,iset,idet)
      call GSDETV(set_id,'SCTS',idtype,nwpa,nwsa,iset,idet)
      call GSDETH(set_id,'SCTL',nh,namesh,
     $     nbitsh,orig,fact)
      call GSDETH(set_id,'SCTS',nh,namesh,
     $     nbitsh,orig,fact)
c
c     End of detector geometrys set up
c
c     Zebra Bank :  For storing User parameters
c
      chform = '4F 1I 4F 2I'
      call MZFORM('PARU',chform,iofu)         ! book characteristics
c
c     Write parameters to a zebra bank.
c     Later they will go to output file.
c     tof_paru_nd is the # of data words.
c     iof is the IO format word.
c
      tof_paru_nd = 11
      call MZBOOK(
     $     ixdiv_fr,
     $     lFF_PARU,
     $     lFF_PARU,
     $     1,
     $     'PARU',
     $     0,
     $     0,
     $     TOF_PARU_ND,
     $     iofu,
     $     0)
c
c     Copy raw geometry parameters into 'EPRU' bank.
c     Fill the bank
c
      IPOINT = LFF_PARU + 1
      qf( IPOINT  + ofea_TFHS_dimen_1)  =   TFHS_dimen(1)
      qf( IPOINT  + ofea_TFHS_dimen_2)  =   TFHS_dimen(2)
      qf( IPOINT  + ofea_TFHS_dimen_3)  =   TFHS_dimen(3)
      qf( IPOINT  + ofea_TFHS_length )  =   TFHS_length
      iqf( IPOINT  + ofea_mFF_HADdets )  =   mFF_HADdets
c
      qf( IPOINT  + ofea_TFES_dimen_1)  =   TFES_dimen(1)
      qf( IPOINT  + ofea_TFES_dimen_2)  =   TFES_dimen(2)
      qf( IPOINT  + ofea_TFES_dimen_3)  =   TFES_dimen(3)
      qf( IPOINT  + ofea_TFES_length )  =   TFES_length
      iqf( IPOINT  + ofea_mFF_ELEdets )  =   mFF_ELEdets
      iqf( IPOINT  + ofea_mFF_ALLdets )  =   mFF_ALLdets
c
c
c
 9999 continue
      return
 997  write(*,'(a)')'*** Unable to open phnx.par ***'
      stop '  Cannot find main geometry file'
 999  write(*,'(a)')'*** Read error in tof_par segment of phnx.par ***'
      stop '  Namelist mis-match in tof_par segment of phnx.par ?'
      end