***
*	s8code.f
***
*

*+DECK,S8MATE.
*CMZ :  1.09/00 18/10/94  11.34.56  by  Galina Shabratova (JINR)
*CMZ :  1.01/00 14/07/94  17.09.17  by  Hal Kalechofsky
*CMZ :  1.00/00 04/05/92  11.05.56  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   08/04/92
      SUBROUTINE S8MATE
C
C *** DEFINITION OF AVAILABLE TOF MATERIALS ***
C *** NVE 08-APR-1992 CERN GENEVA ***
C
C CALLED BY : SXMATE
C ORIGIN    : NICK VAN EIJNDHOVEN
C
C
      IMPLICIT NONE
      REAL AP(2),ZP(2),WP(2),AG(3),ZG(3),WG(3)
      REAL ABRA(2),ZBRA(2),WBRA(2),ASTE(6),ZSTE(6),WSTE(6)
      REAL ACAB(3),ZCAB(3),WCAB(3),AWIR(3),ZWIR(3),WWIR(3)
      REAL APHOT(5),ZPHOT(5),WPHO(5),AG10(5),ZG10(5),WG10(5)
      REAL ATEX(4),ZTEX(4),WTEX(4)
      REAL DP,DG,DENTEX
      REAL DG10, DENBRA, DENSTE
      REAL DENCAB, DENWIR, DENPHO
C --- Steal
      DATA ASTE/55.847, 58.71, 51.996, 28.0855, 24.305, 12.011/
      DATA ZSTE/26., 28., 24., 14., 12., 6./
      DATA WSTE/0.652, .21, .11, .015, .007, .006/
C --- Brass
      DATA ABRA/63.546, 65.38/
      DATA ZBRA/29., 30./, WBRA/0.6,0.4/
C --- Cabel
      DATA ACAB/63.546,14., 14.610/
      DATA ZCAB/29., 8., 7.3/
      DATA WCAB/.9412, .0558, .0031/
C --- Wire
      DATA AWIR/63.546, 14., 14.61/
      DATA ZWIR/29., 8., 7.3/
      DATA WWIR/0.9749, .0241, .001/
C --- Photomiltiplyer
      DATA APHOT/58.71, 95.94, 55.85, 21.6, 14.61/
C
      DATA ZPHOT/28., 42., 26., 10.8, 7.3/
      DATA WPHO/.0641, .0334, .0452, .3715, .4858/
C ---  G10 electronic plate
      DATA AG10 / 28.09,16.00,12.01,1.01,35.457 /
      DATA ZG10 / 14.00,8.00,6.00,1.00,17.00 /
      DATA WG10 / 0.204,0.432364,0.109091,0.218182,0.036364 /
      DATA DG10 / 1.7 /
      DATA DENBRA/8.4/, DENSTE/7.97/
      DATA DENCAB/.3589/,DENWIR/1.027/,DENPHO/.7867/
C --- Polystyrene scintillator (CH) ---
      DATA AP /12.,1./,ZP /6.,1./,WP /1.,1./,DP /1.032/
C --- The plexiglass (C5H8O2) ---
     $,AG /12.0,1.0,16.0/,ZG /6.0,1.0,8.0/,WG /5.0,8.0,2.0/,DG /1.18/
C --- Textolite --> Phenothioxin --> (C6H4SOC6H4)
      DATA ATEX /32.,16.,12.,1./, ZTEX /16.,8.,6.,1./, WTEX /.16,.08,
     $.72,.04/,DENTEX /1.226/
      CALL GSMIXT(801,'Polystyrene$',AP,ZP,DP,-2,WP)
      CALL GSMATE(802,'Al$', 26.98,13., 2.700, 8.90,37.20,0.,0)
      CALL GSMIXT(803,'Plexiglass$',AG,ZG,DG,-3,WG)
      CALL GSMIXT(804,'Brass$',ABRA,ZBRA,DENBRA,2,WBRA)
      CALL GSMIXT(805,'Steal$',ASTE,ZSTE,DENSTE,6,WSTE)
      CALL GSMIXT(806,'Cabel$',ACAB,ZCAB,DENCAB,3,WCAB)
      CALL GSMIXT(807,'Wire$',AWIR,ZWIR,DENWIR,3,WWIR)
      CALL GSMIXT(808,'Textolite$',ATEX,ZTEX,DENTEX,4,WTEX)
      CALL GSMIXT(809,'Photomult$',APHOT,ZPHOT,DENPHO,5,WPHO)
      CALL GSMIXT(810,'G10$  ',AG10,ZG10,DG10,5,WG10)
      CALL GSMATE(899,'Air$',14.61,7.3,0.001205,30420.,67500.,0,0)
C
      RETURN
      END

*+DECK,S8TMED.
*CMZ :  1.09/00 18/10/94  11.42.14  by  Galina Shabratova (JINR)
*CMZ :  1.01/00 14/07/94  17.09.53  by  Hal Kalechofsky
*CMZ :  1.00/00 04/05/92  11.25.27  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   08/04/92
      SUBROUTINE S8TMED
C
C *** DEFINITION OF TRACKING PARAMETERS FOR THE TOF ***
C *** NVE 08-APR-1992 CERN GENEVA ***
C
C CALLED BY : SXTMED
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
      CALL GSTMED(801,'Scint.$',801,1,0,0.,10.,0.1,0.1,0.1,0.1,0,0)
      CALL GSTMED(802,'Al pl.$',802,0,0,0.,10.,0.1,0.1,0.01,0.01,0,0)
      CALL GSTMED(803,'Glass $',803,0,0,0.,10.,0.1,0.1,0.02,0.02,0,0)
      CALL GSTMED(804,'Brass $',804,0,0,0.,10.,0.1,0.1,0.01,0.01,0,0)
      CALL GSTMED(805,'Steal $',805,0,0,0.,10.,0.1,0.1,0.01,0.01,0,0)
      CALL GSTMED(806,'Cabel $',806,0,0,0.,10.,0.1,0.1,0.01,0.01,0,0)
      CALL GSTMED(807,'Wire  $',807,0,0,0.,10.,0.1,0.1,0.01,0.01,0,0)
      CALL GSTMED(808,'Textol$',808,0,0,0.,10.,0.1,0.1,0.01,0.01,0,0)
      CALL GSTMED(809,'Photom$',809,0,0,0.,10.,0.1,0.1,0.01,0.01,0,0)
      CALL GSTMED(810,'G10   $',810,0,0,0.,10.,0.1,0.1,0.01,0.01,0,0)
      CALL GSTMED(899,'Air   $',899,0,0,0.,10.,0.1,0.1,0.1,0.1,0,0)
C
C --- Energy cut-offs in the Al, Glass and scint. ---
      CALL GSTPAR(801,'CUTGAM',1.E-3)
      CALL GSTPAR(801,'CUTELE',1.E-3)
      CALL GSTPAR(801,'CUTNEU',1.E-3)
      CALL GSTPAR(801,'CUTHAD',1.E-3)
      CALL GSTPAR(802,'CUTGAM',1.E-5)
      CALL GSTPAR(802,'CUTELE',1.E-5)
      CALL GSTPAR(802,'CUTNEU',1.E-5)
      CALL GSTPAR(802,'CUTHAD',1.E-5)
      CALL GSTPAR(803,'CUTGAM',1.E-5)
      CALL GSTPAR(803,'CUTELE',1.E-5)
      CALL GSTPAR(803,'CUTNEU',1.E-5)
      CALL GSTPAR(803,'CUTHAD',1.E-5)
      CALL GSTPAR(804,'CUTGAM',1.E-5)
      CALL GSTPAR(804,'CUTELE',1.E-5)
      CALL GSTPAR(804,'CUTNEU',1.E-5)
      CALL GSTPAR(804,'CUTHAD',1.E-5)
      CALL GSTPAR(805,'CUTGAM',1.E-5)
      CALL GSTPAR(805,'CUTELE',1.E-5)
      CALL GSTPAR(805,'CUTNEU',1.E-5)
      CALL GSTPAR(805,'CUTHAD',1.E-5)
      CALL GSTPAR(806,'CUTGAM',1.E-5)
      CALL GSTPAR(806,'CUTELE',1.E-5)
      CALL GSTPAR(806,'CUTNEU',1.E-5)
      CALL GSTPAR(806,'CUTHAD',1.E-5)
      CALL GSTPAR(807,'CUTGAM',1.E-5)
      CALL GSTPAR(807,'CUTELE',1.E-5)
      CALL GSTPAR(807,'CUTNEU',1.E-5)
      CALL GSTPAR(807,'CUTHAD',1.E-5)
      CALL GSTPAR(808,'CUTGAM',1.E-5)
      CALL GSTPAR(808,'CUTELE',1.E-5)
      CALL GSTPAR(808,'CUTNEU',1.E-5)
      CALL GSTPAR(808,'CUTHAD',1.E-5)
      CALL GSTPAR(809,'CUTGAM',1.E-5)
      CALL GSTPAR(809,'CUTELE',1.E-5)
      CALL GSTPAR(809,'CUTNEU',1.E-5)
      CALL GSTPAR(809,'CUTHAD',1.E-5)
      CALL GSTPAR(810,'CUTGAM',1.E-5)
      CALL GSTPAR(810,'CUTELE',1.E-5)
      CALL GSTPAR(810,'CUTNEU',1.E-5)
      CALL GSTPAR(810,'CUTHAD',1.E-5)
C
      RETURN
      END

*+DECK,S8GEOM.
*CMZ :  1.09/00 18/10/94  12.37.23  by  Galina Shabratova (JINR)
*CMZ :  1.01/00 14/07/94  17.10.37  by  Hal Kalechofsky
*CMZ :  1.00/00 04/05/92  11.04.54  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   08/04/92
      SUBROUTINE S8GEOM
C
C *** DEFINITION OF THE GEOMETRY OF THE TOF ***
C *** NVE 08-APR-1992 CERN GENEVA ***
C
C CALLED BY : SXGEOM
C ORIGIN    : NICK VAN EIJNDHOVEN
C
C      IMPLICIT NONE
*KEEP,GCONST.
      COMMON/GCONST/PI,TWOPI ,PIBY2,DEGRAD,RADDEG,CLIGHT ,BIG,EMASS
      COMMON/GCONSX/EMMU,PMASS,AVO
C
*KEEP,SCXIO.
C --- Common which contains the units for the various I/O streams ---
      INTEGER LUNIN,LUNZEB,LUNRAW,LUNPAW,LUNDRW,LUNRDB,LUNMAG,LUNINP
      INTEGER NKEYS,JRECO,INTERGWA98
      COMMON /SCXIO/ LUNIN,LUNZEB,LUNRAW,LUNPAW,LUNDRW,LUNRDB,LUNMAG
     $,              LUNINP,NKEYS,JRECO,INTERGWA98
      CHARACTER*4 KEYS
      COMMON /SCXIO2/ KEYS(4)
C
*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



*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
*KEEP,SC8GEO.
C --- Common which contains TOF geometry info in the WA98 frame ---
      INTEGER NSTR,NLINE
      REAL XC,YC,ZC
      PARAMETER (NSTR=24,NLINE=5)
      COMMON /SC8POS/ XC,YC,ZC
C
C
C     Difinition of the whole volume of TOF
      REAL DFPLA(3),DFBAND(3)
      REAL DFBLLG(3),DFBLSM(3)
      REAL YBLOCK(4),ZBLOCK(4)
      REAL XBAND(4), ZBAND(4)
      CHARACTER*4 NAMLAG(16), NAMSML(16)
      COMMON /Y0POS/Y0POS(2),IROT(2),IROTSI(4)
      INTEGER IROT, IROTSI
      REAL Y0POS,DIST,ANG,ANGROT
      DATA NAMLAG/'FBLL','FELL','FSEL','FSTL',
     +            'FSCL','FPSL','FMSL','FPML',
     +            'FCAL','FWRL','FPNL','FGPL',
     +            'FSAL','FEPL','FBSL','FASL'/
      DATA NAMSML/'FBLS','FELS','FSES','FSTS',
     +            'FSCS','FPSS','FMSS','FPMS',
     +            'FCAS','FWRS','FPNS','FGPS',
     +            'FSAS','FEPS','FBSS','FASS'/
      IROT(1) = 801
      IROT(2) = 0
      IROTSI(1) = 802
      IROTSI(2) = 0
      IROTSI(3) = 0
      IROTSI(4) = 802
      CALL GSROTM (801, 90.,  0., 90.,270.,  0.,  0.)
      CALL GSROTM (802,  0.,  0., 90., 90., 90.,  0.)
      CALL GSROTM (803, 90.,  0.,  0.,  0., 90., 90.)
      Y0POS(1)=38.
      Y0POS(2)=84.2
      DFPLA(1)=198.
      DFPLA(2)=110.
      DFPLA(3)=10.
      CALL GSVOLU('FPLA','BOX ',899,DFPLA,3,I)
C      Devide into NLINE lines along X - axis
C      NLINE = 5
      CALL GSDVN('FLIN','FPLA',NLINE,1)
C      Define the volume of the fortification band
      DFBAND(1)=1.
      DFBAND(2)=124.
      DFBAND(3)=0.15
C
      XBAND(1)=-28.6
      XBAND(2)=-28.6
      XBAND(3)= 28.6
      XBAND(4)= 28.6
C
      ZBAND(1)=-4.85
      ZBAND(2)= 5.15
      ZBAND(3)=-4.85
      ZBAND(4)= 5.15
C
      CALL GSVOLU('FBAN','BOX ',808,DFBAND,3,I)
      DO 1 JBA=1,4
      CALL GSPOS('FBAN',JBA,'FLIN',XBAND(JBA),0.,ZBAND(JBA),0,'ONLY')
   1  CONTINUE
C     Difinition of the block's wolume with scintillators and electronics
C     (large --> 'FBLL' and small --> 'FBLS'
      DFBLLG(1)=39.6
      DFBLLG(2)=39.8
      DFBLLG(3)=5.
      CALL GSVOLU('FBLL','BOX ',899,DFBLLG,3,I)
      DFBLSM(1)=39.6
      DFBLSM(2)=38.
      DFBLSM(3)= 5.
      CALL GSVOLU('FBLS','BOX ',899,DFBLSM,3,I)
      YBLOCK(1)=-70.2
      YBLOCK(2)=-22.2
      YBLOCK(3)= 25.8
      YBLOCK(4)= 72.0
      ZBLOCK(1)=-5.
      ZBLOCK(2)= 5.
      ZBLOCK(3)=-5.
      ZBLOCK(4)= 5.
      DO 2 IBL=1,3
      CALL GSPOS('FBLL',IBL,'FLIN',0.,YBLOCK(IBL),ZBLOCK(IBL),0,'ONLY')
  2   CONTINUE
      CALL GSPOS('FBLS',1,'FLIN',0.,YBLOCK(4),ZBLOCK(4),0,'ONLY')
C      Call the routine for filling the block volume
      CALL S8FLBL(NAMLAG,1)
      CALL S8FLBL(NAMSML,2)
C
C --- Place the TOF in WA98 with front edge 16.8 m from the target ---
C --- and inner edge at 10 degrees ---
C --- and rotate at 19 degree.
      ANG=DEGRAD*10.
      DIST=1680.
      ANGROT = 19.
      XC=XTARG-DFPLA(1)-DIST*TAN(ANG)
      YC=YTARG
      ZC=ZTARG+DFPLA(3)+DIST
      CALL GSROTM(800,90.-ANGROT,0.,90.,90.,-ANGROT,0.)
      CALL GSPOS('FPLA',1,'WA98',XC,YC,ZC,800,'ONLY')
C
 9999 CONTINUE
C
C --- Set the seen attributes for the drawings ---
      CALL GSATT('FPLA','SEEN',-2)
C
      RETURN
      END

*+DECK,S8SENS.
*CMZ :  1.09/00  1/11/94  12.13.07  by  Galina Shabratova (JINR)
*CMZ :  1.01/00 14/07/94  17.11.52  by  Hal Kalechofsky
*CMZ :  1.00/00 07/08/92  09.57.42  by  Nick van Eijndhoven (RUU/CERN)
*-- Author :    Nick van Eijndhoven (CERN)   08/04/92
      SUBROUTINE S8SENS
C
C *** DEFINE (SETS OF) SENSITIVE DETECTOR ELEMENTS FOR THE TOF ***
C *** NVE 08-APR-1992 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
      PARAMETER (NV=6,NH=3)
C
      CHARACTER*4 NAMSVL(NV),NAMSVS(NV),NAMESH(NH)
      INTEGER NBITSV(NV),NBITSH(NH),ISET,IDET
      REAL ORIG(NH),FACT(NH)
C
      DATA NBITSV /NV*8 /
      DATA NBITSH /24,24,32/
      DATA ORIG   /0.,0.,0./
      DATA FACT   /1000.,1000.,1000./
C
C --- Define the scintillator plane for Large shields as sensitive ---
      NAMSVL(1)='FPLA'
      NAMSVL(2)='FLIN'
      NAMSVL(3)='FBLL'
      NAMSVL(4)='FSEL'
      NAMSVL(5)='FSTL'
      NAMSVL(6)='FSCL'
C
C --- Define the scintillator plane for Small shields as sensitive ---
      NAMSVS(1)='FPLA'
      NAMSVS(2)='FLIN'
      NAMSVS(3)='FBLS'
      NAMSVS(4)='FSES'
      NAMSVS(5)='FSTS'
      NAMSVS(6)='FSCS'
C
      NAMESH(1)='PART'
      NAMESH(2)='P'
      NAMESH(3)='TOF'
C
      CALL GSDET('FPLA','FSCL',NV,NAMSVL,NBITSV,801,1000,1000,ISET,IDET)
      CALL GSDETH('FPLA','FSCL',NH,NAMESH,NBITSH,ORIG,FACT)
      CALL GSDET('FPLA','FSCS',NV,NAMSVL,NBITSV,802,1000,1000,ISET,IDET)
      CALL GSDETH('FPLA','FSCS',NH,NAMESH,NBITSH,ORIG,FACT)
C
 9999 CONTINUE
      RETURN
      END

*+DECK,S8DRAW.
*CMZ :  1.09/00 08/04/92  23.36.10  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   08/04/92
      SUBROUTINE S8DRAW
C
C *** DRAWING OF THE TOF LAYOUT ***
C *** NVE 08-APR-1992 CERN GENEVA ***
C
C CALLED BY : SXDRAW
C ORIGIN    : NICK VAN EIJNDHOVEN
C
C%%%  CALL GDTREE('FPLA',0,011111)
      CALL GDFSPC('FPLA',0,0)
C
      RETURN
      END

*+DECK,S8STEP.
*CMZ :  1.09/00  2/11/94  21.21.38  by  Galina Shabratova (JINR)
*CMZ :  1.01/00 14/07/94  17.12.41  by  Hal Kalechofsky
*CMZ :  1.00/00 04/05/92  10.38.22  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   08/04/92
      SUBROUTINE S8STEP
C
C *** RECORDING OF TOF HITS AFTER EACH TRACKING STEP ***
C *** NVE 08-APR-1992 CERN GENEVA ***
C
C CALLED BY : SXSTEP
C ORIGIN    : NICK VAN EIJNDHOVEN
C
C      IMPLICIT NONE
*KEEP,GCSETS.
      COMMON/GCSETS/IHSET,IHDET,ISET,IDET,IDTYPE,NVNAME,NUMBV(20)
C
*KEEP,GCTRAK.
      PARAMETER (MAXMEC=30)
      COMMON/GCTRAK/VECT(7),GETOT,GEKIN,VOUT(7),NMEC,LMEC(MAXMEC)
     +     ,NAMEC(MAXMEC),NSTEP ,MAXNST,DESTEP,DESTEL,SAFETY,SLENG
     +     ,STEP  ,SNEXT ,SFIELD,TOFG  ,GEKRAT,UPWGHT,IGNEXT,INWVOL
     +     ,ISTOP ,IGAUTO,IEKBIN, ILOSL, IMULL,INGOTO,NLDOWN,NLEVIN
     +     ,NLVSAV,ISTORY
      CHARACTER*4 NAMEC
      PARAMETER (MAXME1=30)
      COMMON/GCTPOL/POLAR(3), NAMEC1(MAXME1)
C
*KEEP,GCKINE.
      COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
     +     ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
      CHARACTER*4 NAPART
C
*KEEP,GCTMED.
      COMMON/GCTMED/NUMED,NATMED(5),ISVOL,IFIELD,FIELDM,TMAXFD,STEMAX
     +     ,DEEMAX,EPSIL,STMIN,CFIELD,CMULS,IUPD,ISTPAR,NUMOLD
      COMMON/GCTLIT/THRIND,PMIN,DP,DNDL,JMIN,ITCKOV,IMCKOV,NPCKOV
C
*KEEP,GCONST.
      COMMON/GCONST/PI,TWOPI ,PIBY2,DEGRAD,RADDEG,CLIGHT ,BIG,EMASS
      COMMON/GCONSX/EMMU,PMASS,AVO
C

*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,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
*KEEP,SCXEVT.
C --- Common which contains standard event parameters ---
      INTEGER JSXRUN,JSXEVT
      INTEGER ATAR,APROJ,ZTAR,ZPROJ,NPARTOT,NGPART,NPRTC,NSPCT
      REAL BIMP,ELAB,EVTGLOBAL(10)
      COMMON /SCXEVT/ JSXRUN,JSXEVT,ATAR,APROJ,ZTAR,ZPROJ,
     &  NPARTOT,NGPART,NPRTC,NSPCT,BIMP,ELAB,EVTGLOBAL
C EVTGLOBAL contains the global event information for the current event.
C This includes energy information from MIRAC and ZDC, multiplicities, etc.,
C if the relevant detectors are turned on in the simulation.
C EVTGLOBAL(1) = Transverse energy in Mirac.
C EVTGLOBAL(2) = Electromagnetic energy sum.
C EVTGLOBAL(3) = Hadronic energy sum.
C EVTGLOBAL(4) = Total ZDC energy.
C
*KEEP,SC8GEO.
C --- Common which contains TOF geometry info in the WA98 frame ---
      INTEGER NSTR,NLINE
      REAL XC,YC,ZC
      PARAMETER (NSTR=24,NLINE=5)
      COMMON /SC8POS/ XC,YC,ZC
C
*KEEP,SC8PAW.
C --- Common which contains the NTUPLE info for detector number 8 ---
      INTEGER NVRS1
      REAL VALS1
      PARAMETER (NVRS1=16)
      CHARACTER*6 VARS1
      COMMON /SC8PAW/ VALS1(NVRS1)
      COMMON /SC8PW2/ VARS1(NVRS1)
C
C
      REAL HITS(3)
C
C --- Only consider sensitive detector elements ---
      IF (ISVOL .EQ. 0) GO TO 9999
C
C --- Only register particle at entrance to prevent double counting ---
      IF (NMEC .NE. 0) GO TO 9999
C
C --- Only record charged particles ---
      IF (ABS(CHARGE) .LE. 0.) GO TO 9999
C
C --- Particle in TOF ==> store hit info and update Ntuple ---
C
      IF (IDTYPE .NE. 801) GO TO 5
      JPLANE=NUMBV(1)
      JSTRIP=NUMBV(3)
      IF (ISET.EQ.2) JSTRIP = 4
C --- Revert X-coordinate to get proper PAW display ---
      NLI = NUMBV(2)
      NCEL = NUMBV(5)
      JCELL=120 - ((NLI-1)*24+NCEL) + 1
      GO TO 6
  5   CONTINUE
      IF (IDTYPE .NE. 802) GO TO 9999
      JPLANE=NUMBV(1)
      JSTRIP = 4
C --- Revert X-coordinate to get proper PAW display ---
      NLI = NUMBV(2)
      NCEL = NUMBV(5)
      JCELL=120-((NLI-1)*24+NCEL) + 1
 6    CONTINUE
C
C --- Get Pt and rapidity ---
      PT=-10.
      RAP=-10.
C
C --- Take momentum and energy at the primary vertex to eliminate ---
C --- the effect of the magnetic field and to simulate the ---
C --- track reconstruction ---
      PX=PVERT(1)
      PY=PVERT(2)
      PZ=PVERT(3)
      P=SQRT(PX**2+PY**2+PZ**2)
      E=SQRT(P**2+AMASS**2)
C
C --- Pt and Rapidity only make sense for primary charged particles ---
      IF (ISTAK .NE. 0) GO TO 10
C
      PT=SQRT(PX**2+PY**2)
      E1=E+PZ
      E2=E-PZ
      ERAT=-999.
      IF (ABS(E2) .GT. 0.) ERAT=E1/E2
      IF (ERAT .GT. 0.) RAP=0.5*LOG(ERAT)
C
C --- Simulate measurements by smearing values via Gaussian ---
 10   CONTINUE
      DP=3.38E-3*P**2
      T=TOFG*1.E9
      DT=0.05
      CALL NORMCO(PM,TM,P,T,DP,DT,0.)
C
C --- Determine the particle mass from measured observables ---
C --- Skip secondaries with track length close to zero ---
      IF (ABS(SLENG) .LE. 1.E-3) GO TO 20
      ARG=900.*(TM/SLENG)**2-1.
      ARG=ABS(ARG)
      RMASS=PM*SQRT(ARG)
C
      IF (JPAWF(8) .GE. 1) THEN
       VALS1( 1)=FLOAT(JSXEVT)
       VALS1( 2)=FLOAT(JPLANE)
       VALS1( 3)=FLOAT(JSTRIP)
       VALS1( 4)=FLOAT(JCELL)
       VALS1( 5)=FLOAT(ITRA)
       VALS1( 6)=P
       VALS1( 7)=PT
       VALS1( 8)=E
       VALS1( 9)=RAP
       VALS1(10)=FLOAT(IPART)
       VALS1(11)=GEKIN
       VALS1(12)=T
       VALS1(13)=SLENG
       VALS1(14)=PM
       VALS1(15)=TM
       VALS1(16)=RMASS
       CALL HFN(1,VALS1)
      ENDIF
C
 20   CONTINUE
      IF (IDBUGF(8) .EQ. 0) GO TO 9999
C
C --- And record the hit in case of debug selection ---
      HITS(1)=FLOAT(IPART)
      HITS(2)=P
      HITS(3)=T
      CALL GSAHIT(ISET,IDET,ITRA,NUMBV,HITS,IHIT)
C
 9999 CONTINUE
      RETURN
      END

*+DECK,S8DIGI.
*CMZ :  2.05/35 22/06/95  15.26.18  by  Hal Kalechofsky
*CMZ :  1.01/00 14/07/94  17.13.03  by  Hal Kalechofsky
*CMZ :  1.00/00 08/04/92  23.36.10  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   08/04/92
      SUBROUTINE S8DIGI
C
C *** DIGITISATION FOR THE TOF SIMULATION ***
C *** NVE 08-APR-1992 CERN GENEVA ***
C
C CALLED BY : SXDIGI
C ORIGIN    : NICK VAN EIJNDHOVEN
C
      IMPLICIT NONE

      RETURN
      END

*+DECK,S8EVE.
*CMZ :  2.05/30 21/06/95  18.05.29  by  Hal Kalechofsky
*CMZ :  1.01/00 14/07/94  17.13.21  by  Hal Kalechofsky
*CMZ :  1.00/00 08/04/92  23.36.10  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   08/04/92
      SUBROUTINE S8EVE
C
C *** TERMINATION OF THE TOF SIMULATION AFTER EACH EVENT ***
C *** NVE 08-APR-1992 CERN GENEVA ***
C
C CALLED BY : SXEVE
C ORIGIN    : NICK VAN EIJNDHOVEN
C
C
C !!!!!!!!!!!!!!!!!!!!!!! could you please rename this routine to
C !!!!!!!!!!!!!!!!!!!!!!! S8EVTEND
C !!!!!!!!!!!!!!!!!!!!!!! and erase the dummy s8evtend !!!!!!!!!!!!!!!!
C let me know ...... Yiota Foka

      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 --- Print hit info from the TOF in case of debug ---
      IF (IDBUGF(8) .GE. 1) CALL GPHITS('FPLA','****')
C
 9999 CONTINUE
      RETURN
      END

*+DECK,S8END.
*CMZ :  1.01/00 14/07/94  17.13.37  by  Hal Kalechofsky
*CMZ :  1.00/00 08/04/92  23.36.10  by  Nick van Eijndhoven (CERN)
*-- Author :    Nick van Eijndhoven (CERN)   08/04/92
      SUBROUTINE S8END
C
C *** TERMINATION OF THE TOF SIMULATION AT THE END OF A RUN ***
C *** NVE 08-APR-1992 CERN GENEVA ***
C
C CALLED BY : SXEND
C ORIGIN    : NICK VAN EIJNDHOVEN
C
      IMPLICIT NONE

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

*+DECK, S8FLBL.
*CMZ :  2.05/32 22/06/95  13.54.52  by  Hal Kalechofsky
*CMZ :  2.05/30 21/06/95  18.05.29  by  Hal Kalechofsky
*CMZ :  1.09/00 06/11/94  20.09.27  by  Hal Kalechofsky
*-- Author :
*-- Author :    Galina Shabratova (JINR)   12/09/94
      SUBROUTINE S8FLBL(TOFNAM,IC)
*
*     Filling the block volume by daughter volumes
*     occupied by scintilators and slectronics
*
*KEEP,SC8GEO.
C --- Common which contains TOF geometry info in the WA98 frame ---
      INTEGER NSTR,NLINE
      REAL XC,YC,ZC
      PARAMETER (NSTR=24,NLINE=5)
      COMMON /SC8POS/ XC,YC,ZC

*KEEP,GCONSP.
      COMMON /Y0POS/Y0POS(2),IROT(2),IROTSI(4)
      REAL DFSENS(3),DFSCIN(3),DFMSHL(3)
      REAL DFPM(3), DFPLES(3),DFPLEE(3)
      INTEGER IROT,IROTSI,IROTCW(48)
      REAL DFCABS(3),DFWIRS(3),XCABWS(3)
      REAL YMSH(2),YCAB(2)
C
      REAL DFELEC(3),DFPILL(3)
      REAL XPILL(4),YPILL(4),XSCR(8),YSCR(8)
      REAL DFANGS(3),DFELPL(3),DFSCR(3),DFASS(3)
      REAL XANGSI(4),ZANGSI(4),DFASI
      REAL XCABW(48),YCABW(48),ANGCW(48),DFASSI(48)
      REAL ANYCW(48),ANZCW(48),ANXCW(48)
      CHARACTER*4 TOFNAM(16)
      INTEGER IC,I,I1,I2,I3,I4
      INTEGER JPM,JCAB,JCAB1,JYC
      REAL YPLE,XXP,XX,DEL,YL,ZZ
      REAL TGTHE,THET,XPOS,THEZET
      ZZ = 5.05
C     Define the volume occupied by sensetive part of
C     detector --> TOFNAM(3)
      DFSENS(1) = 39.6
      DFSENS(2) = 39.8
      DFSENS(3) = 1.6
      IF (IC.EQ.2) DFSENS(2) = 38.
      CALL GSVOLU(TOFNAM(3),'BOX ',899,DFSENS,3,I)
      CALL GSPOS(TOFNAM(3),1,TOFNAM(1),0.,0.,-1.8,0,'ONLY')
C     Devide horizontaly sensetive volume into NSTR strips --> TOFNAM(4)
C     NSTR = 24
      CALL GSDVN(TOFNAM(4),TOFNAM(3),NSTR,1)
C     Define the scintilator volume --> TOFNAM(5)
      DFSCIN(1) = 1.6
      DFSCIN(2) = 24.0
      DFSCIN(3) = 1.15
      IF(IC.EQ.2) DFSCIN(2) = 22.2
      CALL GSVOLU(TOFNAM(5),'BOX ',801,DFSCIN,3,I)
C     Define the voluem of PM magnetic shield --> TOFNAM(7)
      DFMSHL(1) = 1.62
      DFMSHL(2) = 6.25
      DFMSHL(3) = 1.42
      CALL GSVOLU(TOFNAM(7),'BOX ',805,DFMSHL,3,I)
C     Define the volume of PM --> TOFNAM(8)
      DFPM(1) = 1.6
      DFPM(2) = 5.25
      DFPM(3) = 1.4
      CALL GSVOLU(TOFNAM(8),'BOX ',809,DFPM,3,I)
      CALL GSPOS (TOFNAM(5),1,TOFNAM(4),0.,0.,0.05,0,'ONLY')
C     Define the volume of a plex plate volume TOFNAM(6)
      DFPLES(1) = 1.65
      DFPLES(2) = 20.8
      DFPLES(3) = 0.2
      IF (IC.EQ.2) DFPLES(2) = 19.
      CALL GSVOLU(TOFNAM(6),'BOX ',803,DFPLES,3,I)
      CALL GSPOS(TOFNAM(6),1,TOFNAM(4),0.,0.,1.4,0,'ONLY')
C --- Input photomultiplier into magnetic shield volume
      DEL = DFMSHL(2) - DFPM(2)
      CALL GSPOS (TOFNAM(8),1,TOFNAM(7),0.,DEL,0.,0,'ONLY')
      YMSH(1) = -(DFSCIN(2)+DFPM(2)-DEL)
      YMSH(2) = -YMSH(1)
      DO 5 JPM = 1,2
       CALL GSPOS(TOFNAM(7),JPM,TOFNAM(4),0.,YMSH(JPM),0.05,IROT(JPM),
     +            'ONLY')
  5   CONTINUE
C --- Define the cable volume for sensetive part --> TOFNAM(9)
      DFCABS(1) = 0.
      DFCABS(2) = .15
      DFCABS(3) = 1.9
      CALL GSVOLU (TOFNAM(9),'TUBE',806,DFCABS,0,I)
C --- Define the wire volume for sensetive part --> TOFNAM(10)
      DFWIRS(1) = 0.
      DFWIRS(2) = 0.075
      DFWIRS(3) = 1.9
      YCAB(1) = -(YMSH(2)+DFPM(2)+DFCABS(3)+DEL)
      YCAB(2) = -YCAB(1)
      XCABWS(1) = -1.
      XCABWS(2) = 0.
      XCABWS(3) = 1.
      CALL GSVOLU (TOFNAM(10),'TUBE',807,DFWIRS,0,I)
      DO 6 JCAB = 1,2
       JCAB1 = (JCAB-1)*2 + 1
       CALL GSPOSP(TOFNAM(9),JCAB1,TOFNAM(4),XCABWS(1),YCAB(JCAB),
     +             0.05,803,'ONLY',DFCABS,3)
       CALL GSPOSP(TOFNAM(9),JCAB1+1,TOFNAM(4),XCABWS(2),YCAB(JCAB),
     +             0.05,803,'ONLY',DFCABS,3)
       CALL GSPOSP(TOFNAM(10),JCAB,TOFNAM(4),XCABWS(3),YCAB(JCAB),
     +             0.05,803,'ONLY',DFWIRS,3)
  6   CONTINUE
      YCAB(1) = YCAB(1)-(DFCABS(3)-DFCABS(2))
      YCAB(2) = -YCAB(1)
      DFCABS(3) = .7
      DFWIRS(3) = .7375
      DO 7 JCAB = 3,4
       JCAB1 = (JCAB-1)*2 + 1
       JYC = JCAB - 2
       CALL GSPOSP(TOFNAM(9),JCAB1,TOFNAM(4),XCABWS(1),YCAB(JYC),
     +             0.825,0,'ONLY',DFCABS,3)
       CALL GSPOSP(TOFNAM(9),JCAB1+1,TOFNAM(4),XCABWS(2),YCAB(JYC),
     +             0.825,0,'ONLY',DFCABS,3)
       CALL GSPOSP(TOFNAM(10),JCAB,TOFNAM(4),XCABWS(3),YCAB(JYC),
     +             0.8625,0,'ONLY',DFWIRS,3)
  7   CONTINUE
C --- Define the volume occupied by electronics --> TOFNAM(2)
      DFELEC(1) = 39.6
      DFELEC(2) = 39.8
      DFELEC(3) =  2.6
      IF (IC.EQ.2) DFELEC(2) = 38.
      CALL GSVOLU (TOFNAM(2),'BOX ',899,DFELEC,3,I)
      CALL GSPOS (TOFNAM(2),1,TOFNAM(1),0.,0., 2.4, 0, 'ONLY')
      DFPLEE(1)=39.6
      DFPLEE(2)=11.5
      DFPLEE(3)= 0.5
      CALL GSVOLU(TOFNAM(11),'BOX ',803,DFPLEE,3,I)
      YPLE = 28.3
      IF (IC.EQ.2) YPLE = 26.5
      CALL GSPOS (TOFNAM(11),1,TOFNAM(2),0.,-YPLE,-2.1,0,'ONLY')
      CALL GSPOS (TOFNAM(11),2,TOFNAM(2),0., YPLE,-2.1,0,'ONLY')
C --- Define the volume of grass pillar - TOFNAM(12)
      DFPILL(1) = 0.
      DFPILL(2) = .4
      DFPILL(3) =2.25
      XPILL(1) = -16.
      XPILL(2) =  16.
      XPILL(3) = -16.
      XPILL(4) =  16.
      YPILL(1) = -23.
      YPILL(2) = -23.
      YPILL(3) =  23.
      YPILL(4) =  23.
      CALL GSVOLU (TOFNAM(12),'TUBE',804,DFPILL,3,I)
      DO 804 I = 1,4
       CALL GSPOS(TOFNAM(12),I,TOFNAM(2),XPILL(I),YPILL(I),-.15,0,
     +            'ONLY')
 804  CONTINUE
C --- Define the volume of steal angle side - TOFNAM(13)
      DFANGS(1) = 1.
      DFANGS(2) = 25.
      DFANGS(3) = .15
      XANGSI(1) = -16.85
      XANGSI(2) = -16.
      XANGSI(3) =  16.
      XANGSI(4) =  16.85
      ZANGSI(1) = 1.25
      ZANGSI(2) = 2.25
      ZANGSI(3) = 2.25
      ZANGSI(4) = 1.25
      CALL GSVOLU (TOFNAM(13),'BOX ',805,DFANGS,3,I)
      DO 805 I =1,4
       CALL GSPOS(TOFNAM(13),I,TOFNAM(2),XANGSI(I),0.,ZANGSI(I),
     +            IROTSI(I),'ONLY')
 805  CONTINUE
C --- Define the volume ocupied by electronics plate - TOFNAM(14)
      DFELPL(1) = 17.
      DFELPL(2) = 10.
      DFELPL(3) = .15
      CALL GSVOLU (TOFNAM(14),'BOX ',810,DFELPL,3,I)
      CALL GSPOS (TOFNAM(14),1,TOFNAM(2),0.,0.,2.45,0,'ONLY')
C --- Define the volume of brass screw - TOFNAM(15)
      DFSCR(1) = 0.
      DFSCR(2) = .35
      DFSCR(3) = 1.5
      CALL GSVOLU (TOFNAM(15),'TUBE',804,DFSCR,3,I)
      DO 811 I =1,4
       YSCR(I) = -(DFELEC(2)-10.)
       I2 = I + 4
       YSCR(I2) = -YSCR(I)
 811  CONTINUE
       XSCR(1) = -(DFELEC(1) - 10.)
       XSCR(2) = XSCR(1) + 3.6
       XSCR(3) = -XSCR(2)
       XSCR(4) = -XSCR(1)
      DO 812 I = 1,4
      XSCR(I+4) = XSCR(I)
 812  CONTINUE
      DO 813 I = 1,8
       CALL GSPOS(TOFNAM(15),I,TOFNAM(2),XSCR(I),YSCR(I), -1.1,
     +            0,'ONLY')
 813  CONTINUE
C --- Define the associate volume for cabel and wire --> TOFNAM(16)
      DFASS(1) = .325
      DFASS(2) = (YCAB(2) - DFELPL(2))/2.
      DFASS(3) = .15
      CALL GSVOLU (TOFNAM(16),'BOX ',806,DFASS,0,I)
      YL = DFASS(2)
      DO 816 I=1,12
       XXS = 1.65 + (I-1)*3.3
       XXP = 0.7083+(I-1)*1.41667
       XX = XXS - XXP
       TGTHE = XX/(2*DFASS(2))
       XPOS = XXP+XX/2.
       THET = ATAN(TGTHE)
       DFASI = SQRT(XX*XX+ZZ*ZZ+4*YL*YL)/2
       DFAST = SQRT(XX*XX+4*YL*YL)
       SNTHE = DFAST/(2*DFASI)
       THEZET =  ASIN(SNTHE)*RADDEG
       I1 = 12 - I + 1
       ANGCW(I1) = (PI - THET)*RADDEG
       YCABW(I1) = -(DFASS(2) + 10.)
       XCABW(I1) = -XPOS
       DFASSI(I1) = DFASI
       ANYCW(I1) = 180. - THEZET
       ANZCW(I1) = THEZET
       ANXCW(I1) = 180. - THEZET
       I2 = I + 12
       ANGCW(I2) = THET*RADDEG
       YCABW(I2) = -(DFASS(2)+10.)
       XCABW(I2) = XPOS
       DFASSI(I2) = DFASI
       ANYCW(I2) = 180. - THEZET
       ANZCW(I2) = THEZET
       ANXCW(I2) = THEZET
       I3 = 24 - I + 13
       ANGCW(I3) = ANGCW(I1)
       YCABW(I3) = DFASS(2) + 10.
       XCABW(I3) = XPOS
       DFASSI(I3) = DFASI
       ANYCW(I3) = 180. - THEZET
       ANZCW(I3) = THEZET
       ANXCW(I3) = THEZET
       I4 = I + 36
       ANGCW(I4) = ANGCW(I2)
       YCABW(I4) = DFASS(2) + 10.
       XCABW(I4) = - XPOS
       DFASSI(I4) = DFASI
       ANYCW(I4) = 180. - THEZET
       ANZCW(I4) = THEZET
       ANXCW(I4) = 180. - THEZET
 816  CONTINUE
      DO 817 I =1,48
       DFASS(2) = DFASSI(I)
       IROTCW(I) = 800 + I + 3
       IF (IC.EQ.2) IROTCW(I) = 800 + I + 51
       CALL GSROTM(IROTCW(I),ANXCW(I),ANGCW(I),ANYCW(I),
     +             90.+ANGCW(I),ANZCW(I),ANGCW(I))
       CALL GSPOSP(TOFNAM(16),I,TOFNAM(2),XCABW(I),YCABW(I),-0.075,
     +             IROTCW(I),'ONLY',DFASS,3)
 817  CONTINUE
      RETURN
      END



*+DECK,S8KEY.
*CMZ :  2.05/36 22/06/95  21.00.54  by  Hal Kalechofsky
*CMZ :  2.05/30 21/06/95  18.05.29  by  Hal Kalechofsky
*CMZ :  2.05/29 21/06/95  17.29.15  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 S8KEY

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,SC8FFK.
C --- Common with the users defined FFKEY cards
      INTEGER INAME1,INAME2,IMIX1
      REAL SNAME1,SNAME2,SMIX2,SMIX3
      COMMON /SC8FFK/INAME1,INAME2,SNAME1,SNAME2,IMIX1,SMIX2,SMIX3
C

* 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
