***
*     s2code.f
***

*+DECK,S2MATE.
*CMZ :  2.05/21 10/06/95  12.15.55  by  Hal Kalechofsky
*CMZ :  2.05/07 13/05/95  13.42.33  by  Hal Kalechofsky
*CMZ :  1.01/00 14/07/94  13.27.24  by  Hal Kalechofsky
*CMZ :  1.00/00 27/02/91  13.54.33  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   09/11/90
      SUBROUTINE S2MATE
C
C *** DEFINITION OF MATERIALS FOR GOLIATH ***
C *** NVE 08-NOV-1990 CERN GENEVA ***
C
C CALLED BY : SXMATE
C ORIGIN    : NICK VAN EIJNDHOVEN
C
C      IMPLICIT NONE
*KEEP,SCXDB.
C --- Common which contains debug flags for the various detectors ---
C IDBUGF(J) = Debug level (0,1,2) for detector "J"
C --- Also PAW control flag (JPAWF) for each detector added       ---
      INTEGER NDBMAX,IDBUGF,JPAWF
      PARAMETER (NDBMAX=15)
      COMMON /SCXDB/IDBUGF(NDBMAX+1),JPAWF(NDBMAX+1)
C
C

C aris
C**> Materials for the magnet.
      CALL GSMATE(200,'Fe $', 55.85,26., 7.87,1.76,17.1,0,0)
      CALL GSMATE(201,'Cu $', 63.54,29., 8.96,1.43,14.8,0,0)
      CALL GSMATE(202,'Al $', 26.98,13., 2.70,8.90,37.2,0,0)
C**> Leave air as material 299, always, and add vacuum as material 298.

CCCCCCCC ASK ARIS ?????????????????????????????? GSMATE instead ??????
C
C   CALL GSTMED(298,'Mag. vac$',98,0,1,20.,0.1,0.1,0.01,0.1,0.1,0,0)
C
C ????????????????????????????????????????????????????????????????

      CALL GSMATE(298,'Mag vac $',1.E-16,1.E-16,1.E-16,1.E16,1.E16,0,0)
      CALL GSMATE(299,'Mag. air$',14.61,7.3,0.001205,30420.,67500.,0,0)

Crep      IF (JPAWF(2) .NE. 1) GO TO 9999
CrepC
Crep      CALL GSMATE(299,'Air$',14.61,7.3,0.001205,30420.,67500.,0,0)
C aris
C
 9999 CONTINUE
      RETURN
      END

*+DECK,S2TMED.
*CMZ :  2.05/09 15/05/95  19.11.07  by  Hal Kalechofsky
*CMZ :  2.05/07 15/05/95  11.37.12  by  Hal Kalechofsky
*CMZ :  1.01/00 14/07/94  13.27.54  by  Hal Kalechofsky
*CMZ :  1.00/00 27/02/91  13.55.48  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   09/11/90
      SUBROUTINE S2TMED
C
C *** DEFINITION OF TRACKING MEDIA FOR GOLIATH ***
C *** NVE 08-NOV-1990 CERN GENEVA ***
C
C CALLED BY : SXTMED
C ORIGIN    : NICK VAN EIJNDHOVEN
C
C      IMPLICIT NONE

*KEEP,SCXDB.
C --- Common which contains debug flags for the various detectors ---
C IDBUGF(J) = Debug level (0,1,2) for detector "J"
C --- Also PAW control flag (JPAWF) for each detector added       ---
      INTEGER NDBMAX,IDBUGF,JPAWF
      PARAMETER (NDBMAX=15)
      COMMON /SCXDB/IDBUGF(NDBMAX+1),JPAWF(NDBMAX+1)
C
C
*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 aris
*KEEP,HITKEEP.
C**> Aris Angelis' Common Block with chamber etc data, various constants,flags,
C**> fake plane hits and counters, limits for random track generation.
      INTEGER MSACS,NSIPL,NMAPL,NTOF
      PARAMETER (MSACS=7)
      PARAMETER (NSIPL=3)
      PARAMETER (NMAPL=3)
      PARAMETER (NTOF=2)
      INTEGER NSIMA,NSIMA1,NSIMAM,NSMMT
      INTEGER IRANIN,IRANUT,NPLACC,NFAKPL,IFLAT,NINFLD
      INTEGER NIOFLD,NSTEPS,NSIPRI,NSISEC,IFORM,NOPADS,
     & NMAPRI,NMASEC,NCHPRI,NCHSEC,
     & NTFPRI,NTFSEC,NTRPRI,NTRSEC,
     & NTRTF1,NTRTF2,NTRTF3,NEVONE,
     & NSCTF1,NSCTF2,NSCTF3,
     & NPINEG,NKANEG,NPBARS,NPIPOS,NKAPOS,NPROTS,NNEUTS,NPROUT,NSCOUT,
     & MPINEG,MKANEG,MPBARS,MPIPOS,MKAPOS,MPROTS,MNEUTS,JEVENT,MYEVNT,
     & NSPHOT,NSPOSI,NSELEC,NSNENO,NSMUPO,NSMUNE,NSPIPO,NSPINE,NSPIZE,
     & NSKAPO,NSKANE,NSKAZE,NSPROT,NSPBAR,NSNEUT,NSECXX,NEVNTS,NSECND
      INTEGER LIMLO,LIMHI,LIMHIX
      REAL DZTAR,BFACT,BETAD,TILTD,TRAD,ZCL,ZCL0,DOUT
      REAL XMAGPL,YMAGPL,ZMAGPL,XSIDPL,YSIDPL,ZSIDPL,
     & XPLANE,YPLANE,ZPLANE,ZEXT12,ZEXT37,
     & XLOLIM,XHILIM,YLOLIM,YHILIM,
     & XTOFPL,YTOFPL,ZTOFPL,BDLX,BDLY,BDLZ,
     & XTOFLO,XTOFHI,YTOFLO,YTOFHI,Z1REF,Z2REF
      REAL DCH12X,DCH12Y,DCH37X,DCH37Y,DTOFX,DTOFY,ZPREF,
     & XFAC12,YFAC12,XFAC37,YFAC37,XFACTF,YFACTF,
     & DIPMIN,DIPMAX,DIPRNG,OPNMIN,OPNMAX,OPNRNG,PINMIN,PINMAX,PINRNG,
     & PPMIN,PPMAX,PRNG,DIPLO,DIPHI,OPNLO,OPNHI,PMOMLO,PMOMHI,
     & Y0LO,Y0HI,X0LO,X0HI,YPLO,YPHI,XPLO,XPHI,TKLPLO,TKLPHI,
     & XMINX,XMINY,XMINZ,YMINX,YMINY,YMINZ,BXMIN,BYMIN,BZMIN,
     & XMAXX,XMAXY,XMAXZ,YMAXX,YMAXY,YMAXZ,BXMAX,BYMAX,BZMAX,
C    & BXMINX,BXMINY,BXMINZ,BYMINX,BYMINY,BYMINZ,BZMINX,BZMINY,BZMINZ,
C    & BXMAXX,BXMAXY,BXMAXZ,BYMAXX,BYMAXY,BYMAXZ,BZMAXX,BZMAXY,BZMAXZ,
     & XINOUT,YINOUT,ZINOUT,TTHICK

      COMMON /MYCOMM/ NSIMA,NSIMA1,NSIMAM,NSMMT,
     & DZTAR,BFACT,BETAD,TILTD,TRAD,ZCL,ZCL0,DOUT,IRANIN,IRANUT,
     & NPLACC,NFAKPL,XMAGPL(1:NMAPL),YMAGPL(1:NMAPL),ZMAGPL(1:NMAPL),
     & XSIDPL(1:NSIPL),YSIDPL(1:NSIPL),ZSIDPL(1:NSIPL),IFLAT,NINFLD,
     & XPLANE(1:MSACS),YPLANE(1:MSACS),ZPLANE(1:MSACS),ZEXT12,ZEXT37,
     & XLOLIM(1:MSACS),XHILIM(1:MSACS),YLOLIM(1:MSACS),YHILIM(1:MSACS),
     & XTOFPL(1:NTOF),YTOFPL(1:NTOF),ZTOFPL(1:NTOF),BDLX,BDLY,BDLZ,
     & XTOFLO(1:NTOF),XTOFHI(1:NTOF),YTOFLO(1:NTOF),YTOFHI(1:NTOF),
     & NIOFLD,NSTEPS,NSIPRI(1:NSIPL),NSISEC(1:NSIPL),IFORM,NOPADS,
     & NMAPRI(1:NMAPL),NMASEC(1:NMAPL),NCHPRI(1:MSACS),NCHSEC(1:MSACS),
     & NTFPRI(1:NTOF),NTFSEC(1:NTOF),NTRPRI(0:MSACS),NTRSEC(0:MSACS),
     & NTRTF1(0:MSACS),NTRTF2(0:MSACS),NTRTF3(0:MSACS),NEVONE,
     & NSCTF1(0:MSACS),NSCTF2(0:MSACS),NSCTF3(0:MSACS),Z1REF,Z2REF,
     & NPINEG,NKANEG,NPBARS,NPIPOS,NKAPOS,NPROTS,NNEUTS,NPROUT,NSCOUT,
     & MPINEG,MKANEG,MPBARS,MPIPOS,MKAPOS,MPROTS,MNEUTS,JEVENT,MYEVNT,
     & NSPHOT,NSPOSI,NSELEC,NSNENO,NSMUPO,NSMUNE,NSPIPO,NSPINE,NSPIZE,
     & NSKAPO,NSKANE,NSKAZE,NSPROT,NSPBAR,NSNEUT,NSECXX,NEVNTS,NSECND,
     & DCH12X,DCH12Y,DCH37X,DCH37Y,DTOFX,DTOFY,ZPREF,
     & XFAC12,YFAC12,XFAC37,YFAC37,XFACTF,YFACTF,LIMLO,LIMHI,LIMHIX,
     & DIPMIN,DIPMAX,DIPRNG,OPNMIN,OPNMAX,OPNRNG,PINMIN,PINMAX,PINRNG,
     & PPMIN,PPMAX,PRNG,DIPLO,DIPHI,OPNLO,OPNHI,PMOMLO,PMOMHI,
     & Y0LO,Y0HI,X0LO,X0HI,YPLO,YPHI,XPLO,XPHI,TKLPLO,TKLPHI,
     & XMINX,XMINY,XMINZ,YMINX,YMINY,YMINZ,BXMIN,BYMIN,BZMIN,
     & XMAXX,XMAXY,XMAXZ,YMAXX,YMAXY,YMAXZ,BXMAX,BYMAX,BZMAX,
C    & BXMINX,BXMINY,BXMINZ,BYMINX,BYMINY,BYMINZ,BZMINX,BZMINY,BZMINZ,
C    & BXMAXX,BXMAXY,BXMAXZ,BYMAXX,BYMAXY,BYMAXZ,BZMAXX,BZMAXY,BZMAXZ,
     & XINOUT(1:12),YINOUT(1:12),ZINOUT(1:12),TTHICK
C aris
C
C aris
C**> Use small enough step size for accurate tracking,
C**> replace the wrong parameter values by NvE.
C**> Retain two sets of tracking media parameters, for field-on and -off.
      IF (SXMAGN.NE.0.) THEN
        CALL GSTMED(200,'Fe plate $',200,0,1,20.,
     &   1.,1.,0.1,0.1,0.1,0,0)
        CALL GSTMED(201,'Cu coil  $',201,0,1,20.,
     &   1.,1.,0.1,0.1,0.1,0,0)
        CALL GSTMED(202,'Al coil  $',202,0,1,20.,
     &   1.,1.,0.1,0.1,0.1,0,0)
        CALL GSTMED(298,'Mag vac $',298,0,1,20.,
     &   0.1,0.1,0.01,0.1,0.1,0,0)
        CALL GSTMED(299,'Mag air $',299,0,1,20.,
     &   0.1,0.1,0.01,0.1,0.1,0,0)
      ELSEIF (SXMAGN.EQ.0.) THEN
        CALL GSTMED(200,'Fe plate $',200,0,0,0.,
     &   1.,1.,0.1,0.1,0.1,0,0)
        CALL GSTMED(201,'Cu coil  $',201,0,0,0.,
     &   1.,1.,0.1,0.1,0.1,0,0)
        CALL GSTMED(202,'Al coil  $',202,0,0,0.,
     &   1.,1.,0.1,0.1,0.1,0,0)
        CALL GSTMED(298,'Mag vac $',298,0,0,0.,
     &   0.1,0.1,0.01,0.1,0.1,0,0)
        CALL GSTMED(299,'Mag air $',299,0,0,0.,
     &   0.1,0.1,0.01,0.1,0.1,0,0)
      ENDIF
Crep      CALL GSTMED(200,'Fe plate $',200,0,0,0.,10.,1.,0.1,0.10,0.10,0,0)
Crep      CALL GSTMED(201,'Cu coil  $',201,0,0,0.,10.,1.,0.1,0.10,0.10,0,0)
Crep      CALL GSTMED(202,'Al coil  $',202,0,0,0.,10.,1.,0.1,0.10,0.10,0,0)
C aris
C
C --- Energy cut-offs in the metal to gain time in tracking ---
      CALL GSTPAR(200,'CUTGAM',0.5)
      CALL GSTPAR(200,'CUTELE',0.5)
      CALL GSTPAR(200,'CUTNEU',0.5)
      CALL GSTPAR(200,'CUTHAD',0.5)
      CALL GSTPAR(201,'CUTGAM',0.5)
      CALL GSTPAR(201,'CUTELE',0.5)
      CALL GSTPAR(201,'CUTNEU',0.5)
      CALL GSTPAR(201,'CUTHAD',0.5)
      CALL GSTPAR(202,'CUTGAM',0.5)
      CALL GSTPAR(202,'CUTELE',0.5)
      CALL GSTPAR(202,'CUTNEU',0.5)
      CALL GSTPAR(202,'CUTHAD',0.5)
C
C aris
C**> Remove code by NvE.
Crep      IF (JPAWF(2) .NE. 1) GO TO 9999
CrepC
Crep      CALL GSTMED(299,'Air plane$',299,1,0,0.,10.,1.,0.1,0.01,0.01,0,0)
C aris
C
 9999 CONTINUE
      RETURN
      END

*+DECK,S2GEOM.
*CMZ :  2.05/07 13/05/95  13.42.33  by  Hal Kalechofsky
*CMZ :  1.06/00 12/09/94  17.05.23  by  Hal Kalechofsky
*CMZ :  1.01/00 14/07/94  16.20.38  by  Hal Kalechofsky
*CMZ :  1.00/00 05/04/91  14.31.41  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   09/11/90
      SUBROUTINE S2GEOM
C
C *** DEFINITION OF THE GEOMETRY OF GOLIATH ***
C *** NVE 08-NOV-1990 CERN GENEVA ***
C
C CALLED BY : SXGEOM
C ORIGIN    : NICK VAN EIJNDHOVEN
C
C      IMPLICIT NONE
*KEEP,SCXDB.
C --- Common which contains debug flags for the various detectors ---
C IDBUGF(J) = Debug level (0,1,2) for detector "J"
C --- Also PAW control flag (JPAWF) for each detector added       ---
      INTEGER NDBMAX,IDBUGF,JPAWF
      PARAMETER (NDBMAX=15)
      COMMON /SCXDB/IDBUGF(NDBMAX+1),JPAWF(NDBMAX+1)
C
*KEEP,SCXGEO.
C --- Common which contains some general geometry parameters ---
      REAL DWA98,DWMAG,DTARG
     $,    DWA98X,DWA98Y,DWA98Z
     $,    DMAGNX,DMAGNY,DMAGNZ
     $,    DTARGX,DTARGY,DTARGZ
     $,    XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG
      COMMON /SCXGEO/ DWA98(3),DWMAG(3),DTARG(3)
     $,               DWA98X,DWA98Y,DWA98Z
     $,               DMAGNX,DMAGNY,DMAGNZ
     $,               DTARGX,DTARGY,DTARGZ
     $,               XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG
C
C aris
*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
C aris
C
      INTEGER I
      REAL X,Y,Z,DY,GAP
      REAL DGFEB(3),DGFCT(3),DGFCB(3)
     $,    DGALC(3),DGCUC(3)
     $,    DGPBO(3),DGPTO(11)
     $,    DGPBN(3),DGPTN(4)
     $,    DPLAN(3)
C
C aris
C**> Fe plates and holes.
      DIMENSION DGPL1(1:3),DGPL2(1:3),DGHOL(1:3)
C aris
C
      DATA DGFEB  /225.0 , 28.5 ,180.0 /
      DATA DGFCT  /  0.0 ,100.0 , 22.5 /
      DATA DGFCB  /  0.0 ,100.0 , 15.0 /
      DATA DGALC  /102.05,164.7 , 22.1 /
      DATA DGCUC  /102.05,164.7 , 14.9 /
      DATA DGPBO  / 39.0 ,-99.9 , 45.0 /
      DATA DGPBN  / 22.0 ,-99.9 , 60.0 /
      DATA DGPTO  /-99.,0.,0.,28.5,45.,16.5,26.57,28.5,45.,16.5,26.57/
C aris
C**> Avoid triangular trapezia.
      DATA DGPTN /60.,0.5,-99.,30./
Crep      DATA DGPTN  / 60.,0.,-99.,30./
C aris
C aris
C**> Half lengths of box representing green Fe plate.
      DATA DGPL1 / 119.5, 97.0,  6.0 /
C**> Half lengths of box representing new Fe plate.
      DATA DGPL2 / 119.5, 97.0,  4.0 /
C**> Half length of side of box representing the hole in the plates.
      DATA PLHOLE / 40. /
C**> Air gap between the two Fe plates.
      DATA AIRGAP / 2. /
C**> Z of centre of green Fe plate relative to magnet centre.
      DATA ZPL1 / -186. /
C aris
C
C *** Define the various elements of GOLIATH ***
C
C --- Adapt pillar height to gap size ---
      GAP=160.
      DGPBO(2)=DGFCT(3)+DGFCB(3)+GAP/2.
      DGPTO(1)=DGPBO(2)
      DGPBN(2)=DGPBO(2)
      DGPTN(3)=DGPBO(2)
C
C --- Fit fake planes into the gap ---
      DPLAN(1)=0.01
      DPLAN(2)=GAP/2.
      DPLAN(3)=(ABS(ZTARG-ZMAG)+DGFEB(3))/2.
C
C --- Lift the magnet by 7.5 cm to get symmetric beam line ---
      DY=7.5
C
C --- The iron top and bottom plates ---
      CALL GSVOLU('GFEB','BOX ',200,DGFEB,3,I)
      X=0.
      Y=DGPBO(2)+DGFEB(2)+DY
      Z=0.
      CALL GSPOS('GFEB',1,'WMAG',X,Y,Z,0,'ONLY')
      Y=-DGPBO(2)-DGFEB(2)+DY
      CALL GSPOS('GFEB',2,'WMAG',X,Y,Z,0,'ONLY')
C
C --- Define rotation matrix for the cylinders and coils ---
      CALL GSROTM(200,90.,0.,180.,90.,90.,90.)
C --- Define rotation matrix for the trapezoids of the old pillars ---
      CALL GSROTM(201,180.,0.,90.,180.,90.,90.)
      CALL GSROTM(202,180.,0.,90.,0.,90.,270.)
C --- Define rotation matrix for the trapezoids of the new pillars ---
      CALL GSROTM(203,0.,0.,90.,90.,90.,180.)
      CALL GSROTM(204,0.,0.,90.,90.,90.,0.)
C
C --- The iron cylinder filling the inside of the top coil ---
      CALL GSVOLU('GFCT','TUBE',200,DGFCT,3,I)
      Y=DGPBO(2)-DGFCT(3)+DY
      CALL GSPOS('GFCT',1,'WMAG',X,Y,Z,200,'ONLY')
C --- The iron cylinder filling the inside of the bottom coil ---
      CALL GSVOLU('GFCB','TUBE',200,DGFCB,3,I)
      Y=-DGPBO(2)+DGFCB(3)+DY
      CALL GSPOS('GFCB',1,'WMAG',X,Y,Z,200,'ONLY')
C --- The aluminium top coil ---
      CALL GSVOLU('GALC','TUBE',202,DGALC,3,I)
      Y=DGPBO(2)-DGALC(3)+DY
      CALL GSPOS('GALC',1,'WMAG',X,Y,Z,200,'ONLY')
C --- The copper bottom coil ---
      CALL GSVOLU('GCUC','TUBE',201,DGCUC,3,I)
      Y=-DGPBO(2)+DGCUC(3)+DY
      CALL GSPOS('GCUC',1,'WMAG',X,Y,Z,200,'ONLY')
C --- The iron support pillars ---
C --- The old pillars at the back ---
      CALL GSVOLU('GPBO','BOX ',200,DGPBO,3,I)
      X=DGFEB(1)-DGPBO(1)
      Y=DY
      Z=-DGFEB(3)+DGPBO(3)
      CALL GSPOS('GPBO',1,'WMAG',X,Y,Z,0,'ONLY')
      CALL GSPOS('GPBO',2,'WMAG',-X,Y,Z,0,'ONLY')
      CALL GSVOLU('GPTO','TRAP',200,DGPTO,11,I)
      X=X-DGPBO(1)-DGPTO(4)
      Y=DY
      Z=-DGFEB(3)+(DGPTO(5)+DGPTO(6))/2.
      CALL GSPOS('GPTO',1,'WMAG',X,Y,Z,201,'ONLY')
      CALL GSPOS('GPTO',2,'WMAG',-X,Y,Z,202,'ONLY')
C --- The new pillars in the front ---
      CALL GSVOLU('GPBN','BOX ',200,DGPBN,3,I)
      X=DGFEB(1)-DGPBN(1)
      Y=DY
      Z=DGFEB(3)-DGPBN(3)
      CALL GSPOS('GPBN',1,'WMAG',X,Y,Z,0,'ONLY')
      CALL GSPOS('GPBN',2,'WMAG',-X,Y,Z,0,'ONLY')
      CALL GSVOLU('GPTN','TRD1',200,DGPTN,4,I)
      X=X-DGPBN(1)-DGPTN(4)
      Y=DY
      CALL GSPOS('GPTN',1,'WMAG',X,Y,Z,203,'ONLY')
      CALL GSPOS('GPTN',2,'WMAG',-X,Y,Z,204,'ONLY')
C aris
C**> Create the boxes making up the two plates, fill with Fe.
      CALL GSVOLU('GPL1','BOX ',200,DGPL1,3,I)
      CALL GSVOLU('GPL2','BOX ',200,DGPL2,3,I)
C**> Create the box making up the hole, fill with air or vacuum as the
C**> case may be and place at the centre of each plate.
      DGHOL(1)=PLHOLE
      DGHOL(2)=PLHOLE
      DGHOL(3)=DGPL1(3)
      IF (ISXVAC.EQ.1) CALL GSVOLU('GHL1','BOX ',298,DGHOL,3,I)
      IF (ISXVAC.EQ.0) CALL GSVOLU('GHL1','BOX ',299,DGHOL,3,I)
      CALL GSPOS('GHL1',1,'GPL1',0.,0.,0.,0,'ONLY')
      DGHOL(3)=DGPL2(3)
      IF (ISXVAC.EQ.1) CALL GSVOLU('GHL2','BOX ',298,DGHOL,3,I)
      IF (ISXVAC.EQ.0) CALL GSVOLU('GHL2','BOX ',299,DGHOL,3,I)
      CALL GSPOS('GHL2',1,'GPL2',0.,0.,0.,0,'ONLY')
C**> Position the two plates at the entrance to the magnet.
      CALL GSPOS('GPL1',1,'WMAG',0.,0.,ZPL1,0,'ONLY')
      ZPL2=ZPL1-DGPL1(3)-DGPL2(3)-AIRGAP
      CALL GSPOS('GPL2',1,'WMAG',0.,0.,ZPL2,0,'ONLY')
C aris
C

CCC ASK ARIS ????????????

      IF (JPAWF(2) .NE. 1) GO TO 9999
C
C --- Define the plane box volume and fill with air ---
      CALL GSVOLU('GPLN','BOX ',299,DPLAN,3,I)
C --- Place the PLANES in WMAG 20cm from the beam, starting at Z target
      X=20.
      Y=0.
      Z=ZTARG-ZMAG+DPLAN(3)
Cbeg
C**> Block internal magnet air planes.
C     CALL GSPOS('GPLN',1,'WMAG',X,Y,Z,0,'ONLY')
C     CALL GSPOS('GPLN',2,'WMAG',-X,Y,Z,0,'ONLY')
Crep      CALL GSPOS('GPLN',1,'WMAG',X,Y,Z,0,'ONLY')
Crep      CALL GSPOS('GPLN',2,'WMAG',-X,Y,Z,0,'ONLY')
Cend
C
Cbeg
C**> Block internal magnet air planes.
CrepC
Crep      IF (JPAWF(2) .NE. 1) GO TO 9999
CrepC
C**> Define the plane box volume and fill with air or vacuum.
C      IF (ISXVAC.EQ.1) CALL GSVOLU('GPLN','BOX ',298,DPLAN,3,I)
C      IF (ISXVAC.EQ.0) CALL GSVOLU('GPLN','BOX ',299,DPLAN,3,I)
CrepC --- Define the plane box volume and fill with air ---
Crep      CALL GSVOLU('GPLN','BOX ',299,DPLAN,3,I)
CC --- Place the PLANES in WMAG 20cm from the beam, starting at Z target
C      X=20.
C      Y=0.
C      Z=ZTARG-ZMAG+DPLAN(3)
Crep      CALL GSPOS('GPLN',1,'WMAG',X,Y,Z,0,'ONLY')
Crep      CALL GSPOS('GPLN',2,'WMAG',-X,Y,Z,0,'ONLY')
Cend
C

CCCCCCCC ASK ARIS ???????????

C --- Set the seen attributes for the drawings ---
 9999 CONTINUE
      CALL GSATT('GFEB','SEEN',-2)
      CALL GSATT('GPBO','SEEN',-2)
      CALL GSATT('GPTO','SEEN',-2)
      CALL GSATT('GPBN','SEEN',-2)
      CALL GSATT('GPTN','SEEN',-2)
      CALL GSATT('GALC','SEEN',-2)
      CALL GSATT('GCUC','SEEN',-2)
      CALL GSATT('GFCT','SEEN',0)
      CALL GSATT('GFCB','SEEN',0)
C aris
C**> Set the "seen" attributes for the drawings.
      CALL GSATT('GPL1','SEEN',-2)
      CALL GSATT('GPL2','SEEN',-2)
      CALL GSATT('GHL1','SEEN',-2)
      CALL GSATT('GHL2','SEEN',-2)
C aris

      RETURN
      END

*+DECK,S2SENS.
*CMZ :  1.01/00 14/07/94  16.23.15  by  Hal Kalechofsky
*CMZ :  1.00/00 09/11/90  11.21.51  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   09/11/90
      SUBROUTINE S2SENS
C
C *** DEFINE (SETS OF) SENSITIVE DETECTOR ELEMENTS FOR GOLIATH ***
C *** NVE 08-NOV-1990 CERN GENEVA ***
C
C CALLED BY : SXSENS
C ORIGIN    : NICK VAN EIJNDHOVEN
C
      IMPLICIT NONE
*KEEP,SCXDB.
C --- Common which contains debug flags for the various detectors ---
C IDBUGF(J) = Debug level (0,1,2) for detector "J"
C --- Also PAW control flag (JPAWF) for each detector added       ---
      INTEGER NDBMAX,IDBUGF,JPAWF
      PARAMETER (NDBMAX=15)
      COMMON /SCXDB/IDBUGF(NDBMAX+1),JPAWF(NDBMAX+1)
C
C
      INTEGER NV,NH,IDET,ISET
      PARAMETER (NV=1,NH=5)
      INTEGER NBITSV(NV),NBITSH(NH)
      CHARACTER*4 NAMESV(NV),NAMESH(NH)
      REAL ORIG(NH),FACT(NH)
C
      DATA NBITSV /NV*8 /
      DATA NBITSH /NH*24/
      DATA ORIG   /1000.,1000.,0.,2.,0./
      DATA FACT   /NH*1000./
C
      IF (JPAWF(2) .NE. 1) GO TO 9999
C
C --- Define the planes for particle flux measurements as sensitive ---
      NAMESV(1)='GPLN'
C
      NAMESH(1)='Y'
      NAMESH(2)='Z'
      NAMESH(3)='PART'
      NAMESH(4)='CHRG'
      NAMESH(5)='P'
C
      CALL GSDET('GPLN','GPLN',1,NAMESV,NBITSV,201,1000,1000,ISET,IDET)
      CALL GSDETH('GPLN','GPLN',NH,NAMESH,NBITSH,ORIG,FACT)
C
 9999 CONTINUE
      RETURN
      END

*+DECK,S2DRAW.
*CMZ :  1.01/00 14/07/94  16.23.39  by  Hal Kalechofsky
*CMZ :  1.00/00 27/02/91  14.01.54  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   09/11/90
      SUBROUTINE S2DRAW
C
C *** DRAWING OF THE GOLIATH LAYOUT ***
C *** NVE 08-NOV-1990 CERN GENEVA ***
C
C CALLED BY : SXDRAW
C ORIGIN    : NICK VAN EIJNDHOVEN
C
      IMPLICIT NONE
C%%%  CALL GDTREE('WMAG',0,011111)
      CALL GDFSPC('WMAG',0,0)
C
      RETURN
      END

*+DECK,S2END.
*CMZ :  1.01/00 14/07/94  16.25.17  by  Hal Kalechofsky
*CMZ :  1.00/00 09/11/90  11.21.51  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   09/11/90
      SUBROUTINE S2END
C
C *** TERMINATION OF THE GOLIATH SIMULATION AT THE END OF A RUN ***
C *** NVE 08-NOV-1990 CERN GENEVA ***
C
C CALLED BY : SXEND
C ORIGIN    : NICK VAN EIJNDHOVEN
C
      IMPLICIT NONE

      PRINT 1000
 1000 FORMAT(1H /1H ,36('*'),' S2END  ',36('*')/
     $ 1H ,20X,'GOLIATH simulation package terminated'/
     $ 1H ,80('*'))
C
      RETURN
      END

*+DECK,S2KEY.
*CMZ :  2.05/36 22/06/95  21.00.54  by  Hal Kalechofsky
*CMZ :  2.05/29 21/06/95  16.50.52  by  Hal Kalechofsky
*CMZ :  2.05/28 16/06/95  16.39.02  by  Hal Kalechofsky
*CMZ :  2.05/22 12/06/95  11.11.47  by  Hal Kalechofsky
*-- Author :
      SUBROUTINE S2KEY

C
C ***********************************************************************
C *                                                                     *
C *                Definition of FFREAD Keys                            *
C *                                                                     *
C ***********************************************************************
C *                                                                     *
C *  CALLED BY     : SXKEY                                              *
C *  CONTACT       :                                                    *
C *                                                                     *
C *  ORIGIN        :
C *  REWRITTEN     :
C *  MODIFICATIONS :                                                    *
C *                                                                     *
C ***********************************************************************

      IMPLICIT NONE
*KEEP,SC2FFK.
C --- Common with the users defined FFKEY cards
      INTEGER INAME1,INAME2,IMIX1
      REAL SNAME1,SNAME2,SMIX2,SMIX3
      COMMON /SC2FFK/INAME1,INAME2,SNAME1,SNAME2,IMIX1,SMIX2,SMIX3

* Here write comments for each card. Transfer the same comments to the
* runcards file.
* In the examples the data cards are EXMP1, EXMP2 and EXMP3.
* The first one has two Integer variables, INAME1 and INAME2 that can
* take the values that the user specifies from the runcards file.
* Similarly the EXMP2 has 2 real variables while the EXMP3 has 3 mixed
* variables
*
* DATA CARD : EXMP1
*             to control the ...........
* INAME1 = 100 ==> ....
* INAME1 = 200 ==> ....
*
* INAME2 = 1000 ==> ...
* INAME2 = 2000 ==> ...
*
*
* DATA CARD : EXMP2
*             to control the ...........
* SNAME1 = 100. ==> ....
* SNAME1 = 200. ==> ....
*
* SNAME2 = 1000. ==> ...
* SNAME2 = 2000. ==> ...
*

C      INAME1 = 100
C      INAME2 = 1000
C      CALL FFKEY('EXMP1',INAME1,       2,'INTEGER')
C
C      SNAME1 = 100.0
C      SNAME2 = 1000.0
C      CALL FFKEY('EXMP2',SNAME1,       2,'REAL')
C
C      IMIX1 = 0
C      SMIX2 = 0.
C      SMIX3 = 0.
C      CALL FFKEY( 'EXMP3',IMIX1,3,'MIXE' )


 9999 CONTINUE
      RETURN
      END