***
*     s4code.f
***
*

*+DECK,S4KEY.
*CMZ :          29/11/95  00.18.41  by  ssato
*CMZ :  2.05/36 22/06/95  21.00.54  by  Hal Kalechofsky
*CMZ :  2.05/29 21/06/95  17.16.56  by  Hal Kalechofsky
*CMZ :  2.05/22 12/06/95  11.11.47  by  Hal Kalechofsky
*-- Author :
      SUBROUTINE S4KEY

C
C ***********************************************************************
C *                                                                     *
C *                Definition of FFREAD Keys for Second Arm (jTOF)      *
C *                                                                     *
C ***********************************************************************
C *                                                                     *
C *  CALLED BY     : SXKEY                                              *
C *  CONTACT       :                                                    *
C *                                                                     *
C *  ORIGIN        :
C *  REWRITTEN     :
C *  MODIFICATIONS :                                                    *
C *                                                                     *
C ***********************************************************************

      IMPLICIT NONE
*KEEP,SC4FFK.
C --- Common with the users defined FFKEY cards
      REAL THEARM,TLTTOF,TLTPAD,TLTSTR,
     1     DPAD1,DPAD2,DSTR1,DSTR2,DJTOF
      REAL JGEOM(5)
      COMMON /SC4FFK/ THEARM,TLTTOF,TLTPAD,TLTSTR,
     1                DPAD1,DPAD2,DSTR1,DSTR2,DJTOF
      EQUIVALENCE(JGEOM(1),DPAD1)
*KEND.
C Defined in SC4FFK THEARM /9.4 /   ! Theta_Arm in degree
C Defined in SC4FFK TLTTOF  /5.2 /  ! Tilted Angle of TOF in deg
C Defined in SC4FFK TLTPAD  /5.2 /  ! Tilted Angle of PAD in deg
C Defined in SC4FFK TLTSTR  /-0.8/  ! Tilted Angle of STT in deg
C Defined in SC4FFK DPAD1  /380./   ! Distance between Edge of PAD1 and magnet
C Defined in SC4FFK DPAD2  /480./   ! Distance between Edge of PAD2 and magnet
C Defined in SC4FFK DSTR1  /630./   ! Distance between Edge of STR1 and magnet
C Defined in SC4FFK DSTR2  /780./   ! Distance between Edge of STR2 and magnet
C Defined in SC4FFK DJTOF   /1400./ ! Distance between Edge of jTOF and magnet

      THEARM = 9.4
      TLTTOF = 5.2
      TLTPAD = 5.2
      TLTSTR = -0.8
      JGEOM(1) = 380.
      JGEOM(2) = 480.
      JGEOM(3) = 630.
      JGEOM(4) = 780.
      JGEOM(5) = 1400.

      CALL FFKEY('JTHAR',THEARM,1,'REAL' )
      CALL FFKEY('JTLTF',TLTTOF,1,'REAL' )
      CALL FFKEY('JTLPD',TLTPAD,1,'REAL' )
      CALL FFKEY('JTLST',TLTSTR,1,'REAL' )
      CALL FFKEY('JGEOM',JGEOM ,5,'REAL' )

 9999 CONTINUE
      RETURN
      END

*CMZ :          26/11/95  16.52.51  by  miake
*CMZ :  2.05/29 21/06/95  17.16.56  by  Hal Kalechofsky
*CMZ :  2.05/22 12/06/95  11.11.47  by  Hal Kalechofsky
*-- Author :
      SUBROUTINE S4MATE

C
C ***********************************************************************
C *                                                                     *
C *       Definition of Material for Second Arm  Code                   *
C *                                                                     *
C ***********************************************************************
C *                                                                     *
C *  CALLED BY     : SXMATE                                             *
C *  CONTACT       : Univ. of Tsukuba                                   *
C *                                                                     *
C *  ORIGIN        :
C *  REWRITTEN     :                                                    *
C *  MODIFICATIONS :                                                    *
C *                                                                     *
C ***********************************************************************
C
*123456789*123456789*123456789*123456789*123456789*123456789*123456789*

      IMPLICIT NONE

      REAL AM(3),ZM(3),WM(3),DM               ! Mylar (C5H4O2)
      DATA AM /12.,1.,16./, ZM /6.,1.,8./, WM /5.,4.,2./, DM /1.39/

      REAL APOL(2),ZPOL(2),WPOL(2),DPOL(1)    ! Poly-Ethylen (CH2)
      DATA APOL /12., 1./, ZPOL / 6., 1./, WPOL / 1., 2./, DPOL / 0.94/

* Gasses
      CALL GSMATE(471,'Vacuum  $',1.E-16,1.E-16,1.E-16,1.E16,1.E16,0,0)
      CALL GSMATE(472,'Air     $',14.61,7.3,0.001205,30420.,67500.,0,0)
      CALL GSMATE(473,'He-Gas  $',4.0,2.0,0.1785E-3,5.298E+5,9999.,0,0)
      CALL GSMATE(474,'Ar-Gas  $',39.35,18.,1.782E-3,2.00E+4,9999.,0,0)
* SOLIDS
      CALL GSMATE(481,'CARBONE $',12.01,6. ,2.265   ,18.80,49.90  ,0,0)
      CALL GSMIXT(482,'MYLAR   $',AM,ZM,DM,-3,WM)
      CALL GSMIXT(483,'POLYETHY$',APOL,ZPOL,DPOL,-2,WPOL)
      CALL GSMATE(484,'G10     $',20.0,10.0,1.700,19.40,999.,0,0)
* SPECIFIC
c      CALL GSMATE(400,'SCINT.  $',8.670,3.60,1.18,34.4,70.8,0,0)
      CALL GSMATE(400,'BC404   $',6.221,3.373,1.032,42.4,82.0,0,0)
      CALL GSMATE(401,'CONCRETE$',20.0,10.0,2.5,10.7,40.0,0,0)
      CALL GSMATE(402,'FE PLATE$',55.85,26.,7.87,1.76,17.1,0,0)
      CALL GSMATE(403,'AL BLOCK$',26.98,13.,2.7,8.90,39.4,0,0)
      CALL GSMATE(404,'SI BLOCK$',28.0855,14.0,2.33,9.36,45.49,0,0)

      RETURN
      END


*CMZ :          29/11/95  00.53.21  by  ssato
*CMZ :  2.05/29 21/06/95  17.16.56  by  Hal Kalechofsky
*CMZ :  2.05/22 12/06/95  11.11.47  by  Hal Kalechofsky
*-- Author :
      SUBROUTINE S4TMED

C
C ***********************************************************************
C *                                                                     *
C *           Definition of Media  for Second Arm  Code                 *
C *                                                                     *
C ***********************************************************************
C *                                                                     *
C *  CALLED BY     : SXTMED                                             *
C *  CONTACT       :                                                    *
C *                                                                     *
C *  ORIGIN        :
C *  REWRITTEN     :                                                    *
C *  MODIFICATIONS :                                                    *
C *                                                                     *
C ***********************************************************************
C

      IMPLICIT NONE

c      CALL GSTMED(400,'SCINTI $',400,0,0,0.,1.,0.1,0.1,0.2,0.1,0,0)
      CALL GSTMED(400,'BC404  $',400,0,0,0.,1.,0.1,0.1,0.2,0.1,0,0)
      CALL GSTMED(401,'CONCBL $',401,0,0,0.,1.,0.1,0.1,0.2,0.1,0,0)
      CALL GSTMED(402,'FEBLCK $',402,0,0,0.,1.,0.1,0.1,0.2,0.1,0,0)
      CALL GSTMED(403,'ALBLCK $',403,0,0,0.,1.,0.1,0.1,0.2,0.1,0,0)
      CALL GSTMED(404,'SILICON$',404,0,0,0.,1.,0.1,0.1,0.2,0.1,0,0)
C
      CALL GSTMED(471,'Vaccum  $',471,0,0,0.,0.1,0.1,0.01,0.1,0.1,0,0)
      CALL GSTMED(472,'Air     $',472,0,0,0.,0.1,0.1,0.01,0.1,0.1,0,0)
      CALL GSTMED(473,'He-Gas  $',473,0,0,0.,0.1,0.1,0.01,0.1,0.1,0,0)
      CALL GSTMED(474,'Ar-Gas  $',474,0,0,0.,0.1,0.1,0.01,0.1,0.1,0,0)
C
      CALL GSTMED(481,'CARBONE $',481,0,0,0.,1.,0.1,0.1,0.2,0.1,0,0)
      CALL GSTMED(482,'MYLAR   $',482,0,0,0.,1.,0.1,0.1,0.2,0.1,0,0)
      CALL GSTMED(483,'POLYETHY$',483,0,0,0.,1.,0.1,0.1,0.2,0.1,0,0)
      CALL GSTMED(484,'G10     $',484,0,0,0.,1.,0.1,0.1,0.2,0.1,0,0)

C
      CALL GPTMED(0)

      RETURN
      END



*CMZ :          29/11/95  00.11.35  by  ssato
*CMZ :  2.05/29 21/06/95  17.16.56  by  Hal Kalechofsky
*CMZ :  2.05/22 12/06/95  11.11.47  by  Hal Kalechofsky
*-- Author :
      SUBROUTINE S4GEOM
C
C ***********************************************************************
C *                                                                     *
C *           Definition of  Second Arm (jTOF) Geometry                 *
C *                                                                     *
C ***********************************************************************
C *                                                                     *
C *  CALLED BY     : SXGEOM                                             *
C *  CONTACT       :                                                    *
C *                                                                     *
C *  ORIGIN        :
C *  REWRITTEN     :
C *  MODIFICATIONS :
C *                                                                     *
C ***********************************************************************
C
      IMPLICIT NONE
* ------------------------------------------------------------------------
* See page 16, 17 of Yasuo's NoteBook for detailed information on Geometry
* ------------------------------------------------------------------------
*KEEP,SCXFF.
C --- Common which contains FFREAD stuff for the GWA98 package ---
C --- as well as the total processed event counter ---
      INTEGER NSXDET,NLUNS,NPLANS
      REAL SXGATE,SXMAGN
      INTEGER ISXDET,ISXDB1,ISXDB2,JDETF,ISXTRA,JTRAF,ISXDRG,JDRGF
     $,       ISXDRT,JDRTF,IFDRAT,ISXDCH,JDCHM,JDCHN,JDCHP,ISXLUN
     $,       ISXOUT,JOUTF,ISXPW1,ISXPW2,IMXTAR,ISXTAR,ISXTIM
     $,       ISXPLN,JPLNF,ISXWKS,ISXMAP,ISXVAC,ISXTUB,NSXEVT,ISXBG1
     $,       ISXBG2,IFPART,IFVOLU,IFMATE,IFTMED,IFVERT,IFKINE,IFSETS
     $,       IFHITS,IFDIGI,IFSECS,IFXSEC,IFLOSS,ISXEVT,ISXCHM
     $,       MAXNSTEP
     $,       ISXINP,ISXDIN,ISXCOOR

      PARAMETER (NSXDET=15,NLUNS=8,NPLANS=15)

      COMMON /SCXFF/ ISXDET(NSXDET+1),ISXDB1(NSXDET+1)
     $,              ISXDB2(NSXDET+1),JDETF(NSXDET+1)
     $,              ISXTRA(NSXDET+1),JTRAF(NSXDET+1)
     $,              ISXDRG(NSXDET+1),JDRGF(NSXDET+1)
     $,              ISXDRT(NSXDET+1),JDRTF(NSXDET+1),IFDRAT
     $,              ISXDCH,JDCHM,JDCHN,JDCHP
     $,              ISXLUN(NLUNS),ISXOUT(NSXDET+1),JOUTF(NSXDET+1)
     $,              ISXPW1(NSXDET+1),ISXPW2(NSXDET+1),IMXTAR
     $,              ISXTAR,ISXTIM,SXGATE(NSXDET)
     $,              ISXPLN(NPLANS),JPLNF(NPLANS)
     $,              ISXWKS,SXMAGN,ISXMAP,ISXVAC,ISXTUB,NSXEVT,ISXBG1
     $,              ISXBG2,IFPART,IFVOLU,IFMATE,IFTMED,IFVERT,IFKINE
     $,              IFSETS,IFHITS,IFDIGI,IFSECS
     $,              IFXSEC,IFLOSS
     $,              ISXEVT,ISXCHM
     $,              MAXNSTEP
     $,              ISXINP,ISXDIN,ISXCOOR
C
*KEEP,SC4FFK.
C --- Common with the users defined FFKEY cards
      REAL THEARM,TLTTOF,TLTPAD,TLTSTR,
     1     DPAD1,DPAD2,DSTR1,DSTR2,DJTOF
      REAL JGEOM(5)
      COMMON /SC4FFK/ THEARM,TLTTOF,TLTPAD,TLTSTR,
     1                DPAD1,DPAD2,DSTR1,DSTR2,DJTOF
      EQUIVALENCE(JGEOM(1),DPAD1)
*KEND.
C Defined in SC4FFK THEARM /9.4 /   ! Theta_Arm in degree
C Defined in SC4FFK TLTTOF  /5.2 /  ! Tilted Angle of TOF in deg
C Defined in SC4FFK TLTPAD  /5.2 /  ! Tilted Angle of PAD in deg
C Defined in SC4FFK TLTSTR  /-0.8/  ! Tilted Angle of STT in deg
C Defined in SC4FFK DPAD1  /380./   ! Distance between Edge of PAD1 and magnet
C Defined in SC4FFK DPAD2  /480./   ! Distance between Edge of PAD2 and magnet
C Defined in SC4FFK DSTR1  /630./   ! Distance between Edge of STR1 and magnet
C Defined in SC4FFK DSTR2  /780./   ! Distance between Edge of STR2 and magnet
C Defined in SC4FFK DJTOF   /1400./ ! Distance between Edge of jTOF and magnet

      REAL CONV
      REAL VJTOF(3),VCNB(3),VFEB(3),VALB(3)
      REAL VPDC(3),VPDW(3),VPDA(3)
      REAL VSTC(3),VSTW(3),VSTA(3)
      REAL CENTRX,CENTRZ,D,S,TARM,TTLT
      REAL XJTOF,ZJTOF,XPAD1,ZPAD1,XPAD2,ZPAD2,XSTR1,ZSTR1,XSTR2,ZSTR2
      INTEGER IVOLU

* jTOF
      DATA VJTOF/ 125., 100., 1.0 /          ! Scint.+Board
      DATA VCNB/ 40., 80., 40. /             ! Concrete Block
      DATA VFEB/ 75., 1. , 50. /             ! Iron Plate
      DATA VALB/ 114.3, 22.86, 31.75 /       ! Electronics

* Pad Chamber
      DATA VPDC /70.0,56.5,0.5/              ! G10 frame   1cm thick
      DATA VPDW /60.0,42.5,0.5/              ! Window of the frame
      DATA VPDA /60.0,42.5,0.0041/           ! Wire        0.0082 cm thick

* Streamer Tube
      DATA VSTC /73.65,68.75,0.3/            ! Aluminum Frame
      DATA VSTW /69.65,63.75,0.3/            ! Window of the frame
      DATA VSTA /69.65,63.75,0.25/           ! Plastic Tube

      DATA CONV   /0.017453/    ! Stupid conversion factor Pi/180
*------------------------------------------------------------------------
* Statement Function to Calculate center of chamber
*     D ; distance of chamber edge from the center of magnet
*     S ; widthe of the chamber/2
*     TARM ; Angle of Second Arm Axis
*     TTLT ; Tilted Angle of Chamber to the Second Arm Axis
      CENTRX(D,S,TARM,TTLT)=D*SIN(TARM*CONV)+S*COS((TARM+TTLT)*CONV)
      CENTRZ(D,S,TARM,TTLT)=D*COS(TARM*CONV)
     1                     +S*SIN((TARM+TTLT)*CONV)
* Please Note these volumes are placed on 'WMAG'
*------------------------------------------------------------------------

      CALL GSROTM(450, 90.+TLTTOF, 0., 90., 90., TLTTOF, 0.) ! For jTOF
      CALL GSROTM(451, 90.+TLTPAD, 0., 90., 90., TLTPAD, 0.) ! For PAD
      CALL GSROTM(452, 90.+TLTSTR, 0., 90., 90., TLTSTR, 0.) ! For ST Chamber

      CALL GSVOLU('JTOF','BOX ',400,VJTOF,3,IVOLU)    ! jTOF Scintillator
      CALL GSDVN ('JTPN','JTOF',5,1)                  ! 5 panels
      CALL GSVOLU('JCNB','BOX ',401,VCNB ,3,IVOLU)    ! Concrete Block
      CALL GSVOLU('JFEB','BOX ',402,VFEB ,3,IVOLU)    ! Iron plate
      CALL GSVOLU('JELC','BOX ',403,VALB ,3,IVOLU)    ! Electronics
C
      CALL GSVOLU('JPAD','BOX ',404,VPDC ,3,IVOLU)    ! Pad Chamber
c      CALL GSVOLU('JPDW','BOX ',472,VPDW ,3,IVOLU)    ! Window of Pad Ch.
      CALL GSVOLU('JPDA','BOX ',402,VPDA ,3,IVOLU)    ! Wire of Pad Ch.
C
      CALL GSVOLU('JSTR','BOX ',403,VSTC ,3,IVOLU)    ! Streamer Tube
c      CALL GSVOLU('JSTW','BOX ',472,VSTW ,3,IVOLU)    ! Window of St.Tube
      CALL GSVOLU('JSTA','BOX ',400,VSTA ,3,IVOLU)    ! Plastic of St.Tube
C
      IF(ISXVAC .EQ. 0)THEN
         CALL GSVOLU('JPDW','BOX ',472,VPDW ,3,IVOLU) ! Window of Pad Ch.
         CALL GSVOLU('JSTW','BOX ',472,VSTW ,3,IVOLU) ! Window of St.Tube
      ELSEIF(ISXVAC .EQ. 1)THEN
         CALL GSVOLU('JPDW','BOX ',471,VPDW ,3,IVOLU) ! Window of Pad Ch.
         CALL GSVOLU('JSTW','BOX ',471,VSTW ,3,IVOLU) ! Window of St.Tube
      ENDIF
C
      XJTOF = CENTRX(DJTOF,VJTOF(1),THEARM,TLTTOF)
      ZJTOF = CENTRZ(DJTOF,VJTOF(1),THEARM,TLTTOF)
      XPAD1 = CENTRX(DPAD1,VPDW(1),THEARM,TLTPAD)
      ZPAD1 = CENTRZ(DPAD1,VPDW(1),THEARM,TLTPAD)
      XPAD2 = CENTRX(DPAD2,VPDW(1),THEARM,TLTPAD)
      ZPAD2 = CENTRZ(DPAD2,VPDW(1),THEARM,TLTPAD)
      XSTR1 = CENTRX(DSTR1,VSTW(1),THEARM,TLTSTR)
      ZSTR1 = CENTRZ(DSTR1,VSTW(1),THEARM,TLTSTR)
      XSTR2 = CENTRX(DSTR2,VSTW(1),THEARM,TLTSTR)
      ZSTR2 = CENTRZ(DSTR2,VSTW(1),THEARM,TLTSTR)

      CALL GSPOS('JTOF',1,'WMAG', XJTOF, 0., ZJTOF, 450, 'ONLY')
      CALL GSPOS('JCNB',1,'WMAG', 341.8, -286., ZJTOF, 450, 'ONLY')
      CALL GSPOS('JFEB',1,'WMAG', 375.7, -210.7, ZJTOF, 450, 'ONLY')
      CALL GSPOS('JELC',1,'WMAG', 359.5, -156.0, ZJTOF, 450, 'ONLY')
	
      CALL GSPOS('JPAD',1,'WMAG', XPAD1, 0., ZPAD1, 451, 'ONLY')
      CALL GSPOS('JPDW',1,'JPAD',    0., 0.,    0.,   0, 'ONLY')
      CALL GSPOS('JPDA',1,'JPDW',    0., 0.,    0.,   0, 'ONLY')

      CALL GSPOS('JPAD',2,'WMAG', XPAD2, 0., ZPAD2, 451, 'ONLY')
      CALL GSPOS('JPDW',2,'JPAD',    0., 0.,    0.,   0, 'ONLY')
      CALL GSPOS('JPDA',2,'JPDW',    0., 0.,    0.,   0, 'ONLY')

      CALL GSPOS('JSTR',1,'WMAG', XSTR1, 0., ZSTR1, 452, 'ONLY')
      CALL GSPOS('JSTW',1,'JSTR',    0., 0.,    0.,   0, 'ONLY')
      CALL GSPOS('JSTA',1,'JSTW',    0., 0.,    0.,   0, 'ONLY')

      CALL GSPOS('JSTR',2,'WMAG', XSTR2, 0., ZSTR2, 452, 'ONLY')
      CALL GSPOS('JSTW',2,'JSTR',    0., 0.,    0.,   0, 'ONLY')
      CALL GSPOS('JSTA',2,'JSTW',    0., 0.,    0.,   0, 'ONLY')

      RETURN
      END


*CMZ :          26/11/95  16.52.51  by  miake
*CMZ :  2.05/29 21/06/95  17.16.56  by  Hal Kalechofsky
*CMZ :  2.05/22 12/06/95  11.11.47  by  Hal Kalechofsky
*-- Author :
      SUBROUTINE S4SENS
C
C ***********************************************************************
C *                                                                     *
C *           Definition of Sensitive Elements for Second Arm           *
C *                                                                     *
C ***********************************************************************
C *                                                                     *
C *  CALLED BY     : SXSENS                                             *
C *  CONTACT       :                                                    *
C *                                                                     *
C *  ORIGIN        :
C *  REWRITTEN     :
C *  MODIFICATIONS :
C *                                                                     *
C ***********************************************************************
C

      IMPLICIT NONE


      RETURN
      END




*CMZ :          26/11/95  16.52.51  by  miake
*CMZ :  2.05/29 21/06/95  17.16.56  by  Hal Kalechofsky
*CMZ :  2.05/22 12/06/95  11.11.47  by  Hal Kalechofsky
*-- Author :
      SUBROUTINE S4DRAW
C
C ***********************************************************************
C *                                                                     *
C *                       Drawing Second Arm                            *
C *                                                                     *
C ***********************************************************************
C *                                                                     *
C *  CALLED BY     : SXDRAW                                             *
C *  CONTACT       :                                                    *
C *                                                                     *
C *  ORIGIN        :
C *  REWRITTEN     :
C *  MODIFICATIONS :
C *                                                                     *
C ***********************************************************************
C
      IMPLICIT NONE


      RETURN
      END


*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
*CMZ :          11/08/95  23.46.16  by  Hal Kalechofsky
