***
*     sxcode.f
***
*


*+DECK,SXINIT.
*CMZ :          10/01/96  11.52.37  by  nishimu
*CMZ :  2.06/45 24/10/95  16.52.05  by  H. Kalechofsky/Y. Foka
*CMZ :  2.06/44 24/10/95  16.12.12  by  H. Kalechofsky/Y. Foka
*CMZ :  2.06/41 06/10/95  18.28.23  by  Hal Kalechofsky
*CMZ :  2.06/36 02/10/95  15.19.10  by  H. Kalechofsky/Y. Foka
*CMZ :  2.06/35 02/10/95  13.29.13  by  Hal Kalechofsky
*CMZ :  2.06/33 26/09/95  00.43.07  by  H. Kalechofsky/Y. Foka
*-- Author :

*CMZ :          25/09/95  17.31.38  by  H. Kalechofsky/Y. Foka
*-- Author :
      SUBROUTINE SXINIT

C
C **********************************************************************
C *                                                                    *
C *                    Run Initialisation                              *
C *                                                                    *
C **********************************************************************
C *                                                                    *
C *  CALLED BY     : GWA98                                             *
C *  ORIGIN        : NICK VAN EIJNDHOVEN                               *
C *  CONTACT       : HAL KALECHOFSKY, YIOTA FOKA                       *
C *  MODIFICATIONS : HAL KALECHOFSKY                                   *
C *  HJK 14-MAR-1995 CERN GENEVA                                       *
C *                                                                    *
C *  REMARKS       :                                                   *
C *  1)  WA98 event format and file handling changed.                  *
C *                                                                    *
C **********************************************************************
C

      IMPLICIT NONE

* --- Prevent loader problems on UNIX systems ---

      EXTERNAL GARNDM,GRANOR
      EXTERNAL GUPHAD,GUHADR,GUKINE,GUSTEP,GUDIGI,GUOUT,GUFLD

+CDE,GCLIST.
+CDE,GCCUTS.
+CDE,GCKINE.
+CDE,GCFLAG.
+CDE,GCTRAK.
+CDE,SCXIO.
+CDE,SCXDB.
+CDE,SCXFF.
+CDE,SCXPAW.
+CDE,HITKEEP.
+CDE,SCXRAW.

      INTEGER IHDVEN(10),ISTAT
      INTEGER IT,ID,LEN,IER,LRECL,I,ITIMQQ,IDATQQ,IWORD,J
      REAL RHDVEN(5),GATMIN,GATMAX

+CDE,DATEQQ.
+CDE,TIMEQQ.

* --- Set Maximum allowed time for unix machines

      CALL TIMEST(100000.0)

*
* --- Initialisation of the GEANT package
*
      write(6,*) '%SN: Call GINIT !! from SXINIT'
      CALL GINIT

* --- Set the number of significant characters for FFREAD keys to 5 ---

      CALL FFSET('SIZE',5)

* --- Define GWA98 specific FFREAD cards ---

      CALL SXKEY

* --- Read all FFREAD data cards ---

CHK We comment this out for now.
CHK      OPEN(25,FILE='RUNCARD.DEF',STATUS='OLD')
      CALL GFFGO
CHK      CLOSE(25)

* --- Change maximum allowed number of steps per track.

      MAXNST=MAXNSTEP

* --- Set flags according to FFREAD selection ---

      IFDRAT=0
      DO 10 I=1,NSXDET+1
      J=ISXDET(I)
      IF ((J .GT. 0) .AND. (J .LE. NSXDET)) JDETF(J)=1
      J=ISXDB1(I)
      IF ((J .GT. 0) .AND. (J .LE. NSXDET).AND.(IDBUGF(J) .EQ. 0))
     $ IDBUGF(J)=1
      IF ((J .EQ. -1) .AND. (IDBUGF(NSXDET+1) .EQ. 0))
     $ IDBUGF(NSXDET+1)=1
      J=ISXDB2(I)
      IF ((J .GT. 0) .AND. (J .LE. NSXDET)) IDBUGF(J)=2
      IF (J .EQ. -1) IDBUGF(NSXDET+1)=2
      J=ISXTRA(I)
      IF ((J .GT. 0) .AND. (J .LE. NSXDET)) JTRAF(J)=1
      IF (J .EQ. -1) JTRAF(NSXDET+1)=1
      J=ISXDRG(I)
      IF ((J .GT. 0) .AND. (J .LE. NSXDET)) JDRGF(J)=1
      IF (J .EQ. -1) JDRGF(NSXDET+1)=1
      J=ISXDRT(I)
      IF ((J .GT. 0) .AND. (J .LE. NSXDET)) JDRTF(J)=1
      IF (J .EQ. -1) JDRTF(NSXDET+1)=1
      IF (J .NE. 0) IFDRAT=1
      J=ISXOUT(I)
      IF ((J .GT. 0) .AND. (J .LE. NSXDET)) JOUTF(J)=1
      J=ISXPW1(I)
      IF ((J .GT. 0) .AND. (J .LE. NSXDET) .AND. (JPAWF(J) .EQ. 0))
     $ JPAWF(J)=1
      IF ((J .EQ. -1) .AND. (JPAWF(NSXDET+1) .EQ. 0))
     $ JPAWF(NSXDET+1)=1
      J=ISXPW2(I)
      IF ((J .GT. 0) .AND. (J .LE. NSXDET)) JPAWF(J)=2
      IF (J .EQ. -1) JPAWF(NSXDET+1)=2
 10   CONTINUE

      DO 100 I=1,NPLANS
      J=ISXPLN(I)
      IF ((J .GT. 0) .AND. (J .LE. NPLANS)) JPLNF(J)=1
 100  CONTINUE

* --- Initialise all I/O units according to FFREAD selections ---

      LUNINP=ISXLUN(1)
      LUNZEB=ISXLUN(2)
      LUNRAW=ISXLUN(3)
      LUNPAW=ISXLUN(4)
      LUNDRW=ISXLUN(5)
      LUNRDB=ISXLUN(6)
      LUNMAG=ISXLUN(7)
      LUNIN=ISXLUN(8)
* --- Find the atomic number of the target.

      IMXTAR=0
      IF (ISXTAR.EQ.101) IMXTAR=6
      IF (ISXTAR.EQ.102) IMXTAR=16
      IF (ISXTAR.EQ.103) IMXTAR=13
      IF (ISXTAR.EQ.104) IMXTAR=79
      IF (ISXTAR.EQ.105) IMXTAR=47
      IF (ISXTAR.EQ.106) IMXTAR=29
      IF (ISXTAR.EQ.107) IMXTAR=82
      IF (ISXTAR.EQ.198) IMXTAR=999

* --- Pass run and first event number from external file to GEANT ---
* --- Also automatically select correct target material ---

      IF ((LUNIN .GT. 0) .AND. (IKINE .EQ. 3)) THEN
       CALL SXRVH(LUNIN,IHDVEN,RHDVEN)
       CALL SXRVH(-LUNIN,IHDVEN,RHDVEN)
       IDRUN=ABS(IHDVEN(3))
       IDEVT=IHDVEN(4)
       IF (IHDVEN(9) .EQ.  6) ISXTAR=101
       IF (IHDVEN(9) .EQ. 16) ISXTAR=102
       IF (IHDVEN(9) .EQ. 13) ISXTAR=103
       IF (IHDVEN(9) .EQ. 79) ISXTAR=104
       IF (IHDVEN(9) .EQ. 47) ISXTAR=105
       IF (IHDVEN(9) .EQ. 29) ISXTAR=106
       IF (IHDVEN(9) .EQ. 82) ISXTAR=107
      ENDIF

* --- Set track charge drawing flags according to FFREAD selection ---

      IWORD=ISXDCH
      JDCHM=IWORD/100
      IWORD=MOD(IWORD,100)
      JDCHN=IWORD/10
      JDCHP=MOD(IWORD,10)

* --- Initialise total event counter ---

      NSXEVT=0

* --- Set GEANT time of flight cut-off to maximum gate encountered ---

      CALL SXMIMA(GATMIN,GATMAX,NSXDET,SXGATE)
      TOFMAX=GATMAX

* --- Denote version of used package ---

      PRINT 1000,IDRUN
 1000 FORMAT (1H /1H ,80('*')/
     $ 1H ,12X,'Welcome to the WA98 simulation for Run ',I7/
     $ 1H ,12X,46('-')/1H ,
+CDE,QFTITLE,N=63.
     $ )

* --- Inform if interactive version is running.
      IF (INTERGWA98.EQ.1) THEN
       PRINT *, 'This program is running interactive GWA98'
      ENDIF

* --- Also compilation and current date and time and FFREAD sel. ---

      CALL DATIME(ID,IT)
      PRINT 1001,IDATQQ,ITIMQQ,ID,IT
     $, IDBUGF(NSXDET+1),JTRAF(NSXDET+1),JDRGF(NSXDET+1)
     $, JDRTF(NSXDET+1),JPAWF(NSXDET+1),ISXTIM,ISXINP
      PRINT 1009,(I,I=1,NSXDET),(JDETF(J),J=1,NSXDET)
     $, (IDBUGF(J),J=1,NSXDET),(JTRAF(J),J=1,NSXDET)
     $, (JDRGF(J),J=1,NSXDET),(JDRTF(J),J=1,NSXDET)
     $, (JOUTF(J),J=1,NSXDET),(JPAWF(J),J=1,NSXDET)
        PRINT 1010,LUNZEB,LUNRAW,LUNPAW,LUNDRW,ISXWKS,LUNRDB,ISXTAR
     $  ,ISXVAC,ISXTUB,ISXBG1,ISXBG2,SXMAGN,ISXMAP
 1001 FORMAT(' Package compiled at date : ',I6,' time : ',I4.4/
     $ ' Current ........... date : ',I6,' time : ',I4.4/
     $ ' Selected debug          level for steerings : ',I3/
     $ ' Selected tracking print level for steerings : ',I3/
     $ ' Selected geometry draw  level for steerings : ',I3/
     $ ' Selected track    draw  level for steerings : ',I3/
     $ ' Selected PAW            level for steerings : ',I3/
     $ ' Subroutine timing (0=off   1=on)   : ',I3/
     $ ' SXINP used for event input         : ',I2)
 1009  FORMAT(' Detector numbers  : ',15(I2,1X)/
     $ ' SXDET selections  : ',15(I2,1X)/
     $ ' SXDBx selections  : ',15(I2,1X)/
     $ ' SXTRA selections  : ',15(I2,1X)/
     $ ' SXDRG selections  : ',15(I2,1X)/
     $ ' SXDRT selections  : ',15(I2,1X)/
     $ ' SXOUT selections  : ',15(I2,1X)/
     $ ' SXPWx selections  : ',15(I2,1X) )
 1010  FORMAT(' Output units are : '/
     $ ' ZEBRA output unit : ',I3/
     $ ' RAW   output unit : ',I3/
     $ ' PAW   output unit : ',I3/
     $ ' DRAW  output unit : ',I3,' with workstation type : ',I4/
     $ ' RDB   output unit : ',I3/
     $ ' Selected target   : ',I3,' vac. sel. : ',I1,' SXTUB : ',I1/
     $ ' Helium bag 1      : ',I2,' Helium bag 2 :',I2/
     $ ' Max. field in T   : ',G12.5,' neg. ==> default field'/
     $ ' SXMAP selection   : ',I1)
      PRINT 1002
 1002 FORMAT(1H ,80('*')/1H /1H )

*
* --- Input Zebra File
*
CHK Well, back to dark ages for the open statements.
CHK If you want to know why, just ask me!

      IF (LUNINP. GT. 0) THEN
       LRECL = 3600
       IF (ISXINP.EQ.3) THEN
+SELF,IF=VAX,VMSALPHA.
       OPEN(LUNINP,FORM='UNFORMATTED',
     +      ACCESS='DIRECT',RECORDTYPE='FIXED',
     +      STATUS='OLD',RECL=900,BLOCKSIZE=LRECL,READONLY)
+SELF,IF=-VAX,IF=-VMSALPHA.
       OPEN(LUNINP,FILE='param_inp.fz',FORM='UNFORMATTED',
     +      ACCESS='DIRECT',
     +      STATUS='OLD',RECL=LRECL)
+SELF.
       ELSEIF (ISXINP.EQ.4) THEN
+SELF,IF=VAX,VMSALPHA.
       OPEN(LUNINP,FORM='UNFORMATTED',
     +      ACCESS='DIRECT',RECORDTYPE='FIXED',
     +      STATUS='OLD',RECL=900,BLOCKSIZE=LRECL,READONLY)
+SELF,IF=-VAX,IF=-VMSALPHA.
       OPEN(LUNINP,FILE='rqmd_inp.fz',FORM='UNFORMATTED',
     +      ACCESS='DIRECT',
     +      STATUS='OLD',RECL=LRECL)
+SELF.
       ELSEIF (ISXINP.EQ.5) THEN
+SELF,IF=VAX,VMSALPHA.
       OPEN(LUNINP,FORM='UNFORMATTED',
     +      ACCESS='DIRECT',RECORDTYPE='FIXED',
     +      STATUS='OLD',RECL=900,BLOCKSIZE=LRECL,READONLY)
+SELF,IF=-VAX,IF=-VMSALPHA.
       OPEN(LUNINP,FILE='venus_inp.fz',FORM='UNFORMATTED',
     +      ACCESS='DIRECT',
     +      STATUS='OLD',RECL=LRECL)
+SELF.
       ELSEIF (ISXINP.EQ.6) THEN
+SELF,IF=VAX,VMSALPHA.
       OPEN(LUNINP,FORM='UNFORMATTED',
     +      ACCESS='DIRECT',RECORDTYPE='FIXED',
     +      STATUS='OLD',RECL=900,BLOCKSIZE=LRECL,READONLY)
+SELF,IF=-VAX,IF=-VMSALPHA.
       OPEN(LUNINP,FILE='frit_inp.fz',FORM='UNFORMATTED',
     +      ACCESS='DIRECT',
     +      STATUS='OLD',RECL=LRECL)
+SELF.
       ENDIF
       CALL FZFILE(LUNINP,LRECL/4,'DI')
      ENDIF

*
* --- Output
*

* --- Open output file for raw data output and initialize event buffer.

      IF (LUNRAW.GT.0) THEN
       CALL ANUFOPEN(LUNRAW,'gwa98.raw',2048,'ND',ISTAT)
       IF (ISTAT.NE.0) STOP 'SXINIT: Cannot open raw output file'
       CALL SXWINIT(LUNRAW,MAXEVSIZ)
      ENDIF

* --- Open output file/tape for ZEBRA output stream ---

      IF (LUNZEB .GT. 0) CALL GOPEN(LUNZEB,'FXO',3840,IER)

*
* --- Open Files for PAW NTUPLE
*

      IF (LUNPAW .LE. 0) GO TO 11

      CALL HROPEN(LUNPAW,'GWA98','gwa98.hbk','N',1024,IER)
      CALL RZQUOT(100000)
      IF (IER .NE. 0) PRINT 1003,IER
 1003 FORMAT(' *SXINIT* ERROR IN HROPEN : IER = ',I3)

* --- Setup PAW directory structure on output file ---

      IF (JPAWF( 1) .GE. 1) CALL HMDIR('PLANES',' ')
      IF (JPAWF( 2) .GE. 1) CALL HMDIR('GOL',' ')
      IF (JPAWF( 3) .GE. 1) CALL HMDIR('MSAC',' ')
      write(6,*) '%SN: Call HMDIR !! from SXINIT'
      IF (JPAWF( 4) .GE. 1) CALL HMDIR('JTOF',' ')
      IF (JPAWF( 5) .GE. 1) CALL HMDIR('LGC',' ')
      IF (JPAWF( 6) .GE. 1) CALL HMDIR('PMD',' ')
      IF (JPAWF( 7) .GE. 1) CALL HMDIR('MIRAC',' ')
      IF (JPAWF( 8) .GE. 1) CALL HMDIR('TOF',' ')
      IF (JPAWF( 9) .GE. 1) CALL HMDIR('ZDC',' ')
      IF (JPAWF(10) .GE. 1) CALL HMDIR('SDD',' ')
      IF (JPAWF(11) .GE. 1) CALL HMDIR('PBA',' ')
      IF (JPAWF(12) .GE. 1) CALL HMDIR('CPV',' ')
      IF (JPAWF(13) .GE. 1) CALL HMDIR('SPMD',' ')
      IF (JPAWF(14) .GE. 1) CALL HMDIR('TRG',' ')
      IF (JPAWF(15) .GE. 1) CALL HMDIR('PDC',' ')
      IF (JPAWF(NSXDET+1) .GE. 1) CALL HMDIR('STEER',' ')

* --- Setup PAW directory structure in memory ---

      CALL HCDIR('//PAWC',' ')
      IF (JPAWF( 1) .GE. 1) CALL HMDIR('PLANES',' ')
      IF (JPAWF( 2) .GE. 1) CALL HMDIR('GOL',' ')
      IF (JPAWF( 3) .GE. 1) CALL HMDIR('MSAC',' ')
      write(6,*) '%SN: Call HMDIR memory!! from SXINIT'
      IF (JPAWF( 4) .GE. 1) CALL HMDIR('JTOF',' ')
      IF (JPAWF( 5) .GE. 1) CALL HMDIR('LGC',' ')
      IF (JPAWF( 6) .GE. 1) CALL HMDIR('PMD',' ')
      IF (JPAWF( 7) .GE. 1) CALL HMDIR('MIRAC',' ')
      IF (JPAWF( 8) .GE. 1) CALL HMDIR('TOF',' ')
      IF (JPAWF( 9) .GE. 1) CALL HMDIR('ZDC',' ')
      IF (JPAWF(10) .GE. 1) CALL HMDIR('SDD',' ')
      IF (JPAWF(11) .GE. 1) CALL HMDIR('PBA',' ')
      IF (JPAWF(12) .GE. 1) CALL HMDIR('CPV',' ')
      IF (JPAWF(13) .GE. 1) CALL HMDIR('SPMD',' ')
      IF (JPAWF(14) .GE. 1) CALL HMDIR('TRG',' ')
      IF (JPAWF(15) .GE. 1) CALL HMDIR('PDC',' ')
      IF (JPAWF(NSXDET+1) .GE. 1) CALL HMDIR('STEER',' ')

 11   CONTINUE

*
* --- Open File for Drawings
*
      IF (LUNDRW .GT. 0) THEN

* -----  Open metafile for drawings

         OPEN(LUNDRW,FILE='gwa98.plt',STATUS='UNKNOWN')
         REWIND LUNDRW

* ------ Initialise HIGZ and HPLOT packages for drawing
CHK This interactive flag seems to be needed for drawing.
+SELF, IF=-INTERACTIVE.
         CALL HPLINT(0)
         CALL IGMETA(-LUNDRW,ISXWKS)
+SELF, IF=INTERACTIVE.
         CALL IGMETA(LUNDRW,ISXWKS)
+SELF.
         CALL HOUTPU(6)
         CALL HERMES(6)

      ENDIF

*
* --- Select Info to Print Geant Banks
*

      CALL GLOOK('PART',LPRIN,NPRIN,I)
      IFPART=0
      IF (I .NE. 0) IFPART=1
      CALL GLOOK('VOLU',LPRIN,NPRIN,I)
      IFVOLU=0
      IF (I .NE. 0) IFVOLU=1
      CALL GLOOK('MATE',LPRIN,NPRIN,I)
      IFMATE=0
      IF (I .NE. 0) IFMATE=1
      CALL GLOOK('TMED',LPRIN,NPRIN,I)
      IFTMED=0
      IF (I .NE. 0) IFTMED=1
      CALL GLOOK('VERT',LPRIN,NPRIN,I)
      IFVERT=0
      IF (I .NE. 0) IFVERT=1
      CALL GLOOK('KINE',LPRIN,NPRIN,I)
      IFKINE=0
      IF (I .NE. 0) IFKINE=1
      CALL GLOOK('SETS',LPRIN,NPRIN,I)
      IFSETS=0
      IF (I .NE. 0) IFSETS=1
      CALL GLOOK('HITS',LPRIN,NPRIN,I)
      IFHITS=0
      IF (I .NE. 0) IFHITS=1
      CALL GLOOK('DIGI',LPRIN,NPRIN,I)
      IFDIGI=0
      IF (I .NE. 0) IFDIGI=1
      CALL GLOOK('SECS',LPRIN,NPRIN,I)
      IFSECS=0
      IF (I .NE. 0) IFSECS=1

C --- Selected plot information ---

      CALL GLOOK('XSEC',LPLOT,NPLOT,I)
      IFXSEC=0
      IF (I .NE. 0) IFXSEC=1
      CALL GLOOK('LOSS',LPLOT,NPLOT,I)
      IFLOSS=0
      IF (I .NE. 0) IFLOSS=1

*
* --- Print Debug Info
*

      IF (IDBUGF(NDBMAX+1) .GT. 0)
     $ PRINT 2000,IFPART,IFVOLU,IFMATE,IFTMED,IFVERT,IFKINE,IFSETS
     $,           IFHITS,IFDIGI,IFSECS,IFXSEC,IFLOSS
     $,           JDCHM,JDCHN,JDCHP
 2000 FORMAT(' *SXINIT* Printout and plot selections : '/
     $ ' IFPART = ',I1,' IFVOLU = ',I1,' IFMATE = ',I1,' IFTMED = ',I1/
     $ ' IFVERT = ',I1,' IFKINE = ',I1,' IFSETS = ',I1,' IFHITS = ',I1/
     $ ' IFDIGI = ',I1,' IFSECS = ',I1,' IFXSEC = ',I1,' IFLOSS = ',I1/
     $ ' JDCHM  = ',I1,' JDCHN  = ',I1,' JDCHP  = ',I1)

*
* --- Select Geant Data Structures to be written for each event
* --- according to SAVE card
*

* --- Initialisation of NKEYS and the output record number ---

      NKEYS=0
      JRECO=0

      CALL GLOOK('KINE',LSAVE,NSAVE,I)
      IF (I .NE. 0) NKEYS=NKEYS+1
      IF (I .NE. 0) KEYS(NKEYS)='KINE'
      CALL GLOOK('JXYZ',LSAVE,NSAVE,I)
      IF (I .NE. 0) NKEYS=NKEYS+1
      IF (I .NE. 0) KEYS(NKEYS)='JXYZ'
      CALL GLOOK('HITS',LSAVE,NSAVE,I)
      IF (I .NE. 0) NKEYS=NKEYS+1
      IF (I .NE. 0) KEYS(NKEYS)='HITS'
      CALL GLOOK('DIGI',LSAVE,NSAVE,I)
      IF (I .NE. 0) NKEYS=NKEYS+1
      IF (I .NE. 0) KEYS(NKEYS)='DIGI'

*
* --- Set up GEANT data structures
*
      CALL GZINIT

*
* --- Initialise WA98 data structures
*

      CALL SXZINIT
*
* --- Initialise the GEANT drawing package
*
      IF (LUNDRW .GT. 0) CALL GDINIT
*
* --- Define Standard Geant Particle Properties
*
      write(6,*) '%SN: Call GPART !! from SXINIT'
      CALL GPART
*
* --- Define Users Particles
*
      CALL SXPART
*
* --- Print particle properties according to data card PRIN
*
      IF (IFPART .NE. 0) CALL GPPART(0)
*
* --- Initialise secondary particle statistics according to PRIN
*
      IF (IFSECS .NE. 0) CALL SXPSTA(1)
*
* --- Load the magnetic field map in case it is selected.
*
       IF (SXMAGN.NE.0.0) THEN
        IF (ISXMAP.EQ.0) THEN
         PRINT *, ' SXINIT: Reading of field map data ...'
         CALL S2FLREAD(0)
        ELSEIF (ISXMAP.EQ.1) THEN
         PRINT *, ' SXINIT: Constant filed of 8 Kg is used '
        ENDIF
       ELSEIF (SXMAGN.EQ.0.0) THEN
        PRINT *, ' SXINIT: Magnetic field is turned off'
       ENDIF

*
* --- Initialisation of the various detector packages
*

* --- Detector number 1 ---
      IF (JDETF(1) .NE. 0) THEN
       IF (JPAWF(1) .GE. 1) CALL HCDIR('//PAWC/PLANES',' ')
       CALL S1INIT
      ENDIF
* --- Detector number 2 ---
      IF (JDETF(2) .NE. 0) THEN
       IF (JPAWF(2) .GE. 1) CALL HCDIR('//PAWC/GOL',' ')
       CALL S2INIT
      ENDIF
* --- Detector number 3 ---
      IF (JDETF(3) .NE. 0) THEN
       IF (JPAWF(3) .GE. 1) CALL HCDIR('//PAWC/MSAC',' ')
       CALL S3INIT
      ENDIF
* --- Detector number 4 ---
      IF (JDETF(4) .NE. 0) THEN
       IF (JPAWF(4) .GE. 1) CALL HCDIR('//PAWC/JTOF',' ')
       CALL S4INIT
      ENDIF
* --- Detector number 5 ---
      IF (JDETF(5) .NE. 0) THEN
       IF (JPAWF(5) .GE. 1) CALL HCDIR('//PAWC/LGC',' ')
       CALL S5INIT
      ENDIF
* --- Detector number 6 ---
      IF (JDETF(6) .NE. 0) THEN
       IF (JPAWF(6) .GE. 1) CALL HCDIR('//PAWC/PMD',' ')
       CALL S6INIT
      ENDIF
* --- Detector number 7 ---
      IF (JDETF(7) .NE. 0) THEN
       IF (JPAWF(7) .GE. 1) CALL HCDIR('//PAWC/MIRAC',' ')
       CALL S7INIT
      ENDIF
* --- Detector number 8 ---
      IF (JDETF(8) .NE. 0) THEN
       IF (JPAWF(8) .GE. 1) CALL HCDIR('//PAWC/TOF',' ')
       CALL S8INIT
      ENDIF
* --- Detector number 9 ---
      IF (JDETF(9) .NE. 0) THEN
       IF (JPAWF(9) .GE. 1) CALL HCDIR('//PAWC/ZDC',' ')
       CALL S9INIT
      ENDIF
* --- Detector number 10 ---
      IF (JDETF(10) .NE. 0) THEN
       IF (JPAWF(10) .GE. 1) CALL HCDIR('//PAWC/SDD',' ')
       CALL SAINIT
      ENDIF
* --- Detector number 11 ---
      IF (JDETF(11) .NE. 0) THEN
       IF (JPAWF(11) .GE. 1) CALL HCDIR('//PAWC/PBA',' ')
       CALL SBINIT
      ENDIF
* --- Detector number 12 ---
      IF (JDETF(12) .NE. 0) THEN
       IF (JPAWF(12) .GE. 1) CALL HCDIR('//PAWC/CPV',' ')
       CALL SCINIT
      ENDIF
* --- Detector number 13 ---
      IF (JDETF(13) .NE. 0) THEN
       IF (JPAWF(13) .GE. 1) CALL HCDIR('//PAWC/SPMD',' ')
       CALL SDINIT
      ENDIF
* --- Detector number 14 ---
      IF (JDETF(14) .NE. 0) THEN
       IF (JPAWF(14) .GE. 1) CALL HCDIR('//PAWC/TRG',' ')
       CALL SEINIT
      ENDIF
* --- Detector number 15 ---
      IF (JDETF(15) .NE. 0) THEN
       IF (JPAWF(15) .GE. 1) CALL HCDIR('//PAWC/PDC',' ')
C       CALL SFINIT
      ENDIF

* --- User entry for testing ---
      CALL HCDIR('//PAWC',' ')
      CALL SUINIT

*
* --- Define Material
*
      CALL SXMATE
*
* --- Define Tracking Media
*
      CALL SXTMED
*
* --- Define Detector Setup
*
      CALL SXGEOM
*
* --- Define (sets of) sensitive detector elements
*
      CALL SXSENS
*
* --- Save the detector structure in the ZEBRA banks
*
      CALL GGCLOS
*
* --- Draw the detectors as selected by the SXDRW data card
*
      IF (LUNDRW .GT. 0) CALL SXDRAW
*
* --- Initialise the physics package
*
      CALL GPHYSI
*
* --- Write out the RZ Database in case selected
*
      IF (LUNRDB .GT. 0) CALL GRFILE(LUNRDB,'gwa98.rdb','ONX')
*
* --- Write initialisation data to output file/tape
*
      IF (LUNZEB .GT. 0) THEN
         IER=0
         CALL GLOOK('INIT',LSAVE,NSAVE,I)
         IF (I .NE. 0) CALL GSAVE(LUNZEB,'INIT',-1,JRECO,IER)
         IF (IER .NE. 0) PRINT 4000,IER,JRECO
 4000    FORMAT(' *SXINIT* GSAVE IER = ',I3,' FOR RECORD IDENT = ',I5)
      ENDIF
*
* --- Initialise and  Book the Steering ntuples
*
      IF (JPAWF(NSXDET+1) .GE. 1) THEN
       CALL HCDIR('//PAWC/STEER',' ')
       VARS1(1)='RUN'
       VARS1(2)='EVENT'
       VARS1(3)='BIMP'
       VARS1(4)='NPART'
       VARS1(5)='ETMIR'
       VARS1(6)='ENZDC'
       LEN=100*NVRS1
       CALL HBOOKN(1,'STEER NTUPLE',NVRS1,'//GWA98/STEER',LEN,VARS1)
      ENDIF
 9999 CONTINUE

      RETURN
      END



*+DECK,SXMATE.
*CMZ :  2.05/32 22/06/95  13.13.48  by  Hal Kalechofsky
*CMZ :  2.05/30 22/06/95  09.31.57  by  Hal Kalechofsky
*CMZ :  2.05/21 12/06/95  09.32.05  by  Hal Kalechofsky
*CMZ :  2.05/17 06/06/95  09.38.36  by  Hal Kalechofsky
*CMZ :  2.05/08 15/05/95  17.29.12  by  Hal Kalechofsky
*CMZ :  2.05/07 15/05/95  12.04.46  by  Hal Kalechofsky
*CMZ :  2.00/00 16/03/95  17.57.03  by  Hal Kalechofsky
*CMZ :  1.01/00 14/07/94  17.47.22  by  Hal Kalechofsky
*CMZ :  1.00/00 26/01/94  08.55.37  by  Nick van Eijndhoven (RUU/CERN)
*-- Author :    Nick van Eijndhoven (CERN)   04/09/90
      SUBROUTINE SXMATE

C
C **********************************************************************
C *                                                                    *
C *               Definiton of Material                                *
C *                                                                    *
C **********************************************************************
C *                                                                    *
C *  CALLED BY     : SXINIT                                            *
C *  ORIGIN        : NICK VAN EIJNDHOVEN                               *
C *  CONTACT       : HAL KALECHOFSKY, YIOTA FOKA                       *
C *  YF,HK 04-MAY-1995 CERN GENEVA                                     *
C *                                                                    *
C **********************************************************************
C

      IMPLICIT NONE
*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
C
* aris

      REAL AM(3),ZM(3),WM(3),DM
      REAL AK(3),ZK(3),WK(3),DK

* --- Mylar for membrane at base of pyramid. (C5H4O2)

      DATA AM /12.,1.,16./, ZM /6.,1.,8./,
     & WM /5.,4.,2./, DM /1.39/

* --- Kevlar for membrane at base of pyramid. (C14H10N2)

      DATA AK /12.,1.,14./, ZK /6.,1.,7./,
     & WK /14.,10.,2./, DK /1.45/
* aris

* --- He Bag

      REAL AHE(1),ZHE(1),WHE(1),DHE(1)
     &,         APOL(2),ZPOL(2),WPOL(2),DPOL(1)

* --- Materials for the Helium-Bag

      DATA AHE /4.0/
      DATA ZHE /2.0/
      DATA WHE /1./
      DATA DHE /0.000178/

* --- Define the Polyethylen-mixture (CH2)

      DATA APOL /12., 1./
      DATA ZPOL / 6., 1./
      DATA WPOL / 1., 2./
      DATA DPOL / 0.94/

*
* ----------------------------------------------------------------
*

* --- Materials for the steerings

      CALL GSMATE( 1,'Vacuum  $',1.E-16,1.E-16,1.E-16,1.E16,1.E16,0,0)
      CALL GSMATE( 2,'Air     $',14.61,7.3,0.001205,30420.,67500.,0,0)
      CALL GSMATE( 3,'C fibre $',12.01,6. ,2.265   ,18.80,49.90  ,0,0)
      CALL GSMATE( 4,'Al      $',26.98,13.,2.700   , 8.90,37.20  ,0,0)
      CALL GSMIXT( 5,'Mylar $',AM,ZM,DM,-3,WM)
      CALL GSMIXT( 6,'Kevlar$',AK,ZK,DK,-3,WK)
      CALL GSMATE( 7,'Helium  $',20.18,2.0,0.0001785,99151.,9999.,0,0)

* --- Define He Bag Material

      CALL GSMIXT( 8,'HELIUM $',AHE,ZHE,DHE,-1,WHE)
      CALL GSMIXT( 9,'PET$',APOL,ZPOL,DPOL,-2,WPOL)

* --- Materials in the magnetic field.

      CALL GSMATE(93,'Mag C   $',12.01,6. ,2.265 ,18.80,49.90  ,0,0)
      CALL GSMATE(94,'Mag Al  $',26.98,13.,2.700 , 8.90,37.20  ,0,0)
      CALL GSMATE(97,'Mag He  $',20.18,2.0,0.0001785,99151.,9999.,0,0)
      CALL GSMATE(98,'Mag vac $',1.E-16,1.E-16,1.E-16,1.E16,1.E16,0,0)
      CALL GSMATE(99,'Mag air $',14.61,7.3,0.001205,30420.,67500.,0,0)

* --- Materials for the target.

      CALL GSMATE(101,'C  $', 12.01, 6., 2.265,18.80,49.90,0.,0)
      CALL GSMATE(102,'S  $', 32.06,16., 2.070, 9.42,9999.,0.,0)
      CALL GSMATE(103,'Al $', 26.98,13., 2.700, 8.90,37.20,0.,0)
      CALL GSMATE(104,'Au $',196.97,79.,19.320, 0.33,9999.,0.,0)
      CALL GSMATE(105,'Ag $',107.87,47.,10.490, 0.86,9999.,0.,0)
      CALL GSMATE(106,'Cu $', 63.54,29., 8.960, 1.43,14.80,0.,0)
      CALL GSMATE(107,'Pb $',207.19,82.,11.350, 0.56,18.50,0.,0)
      CALL GSMATE(198,'Mag vac $',1.E-16,1.E-16,1.E-16,1.E16,1.E16,0,0)
      CALL GSMATE(199,'Air$',14.61,7.3,0.001205,30420.,67500.,0,0)

*
* --- Define the Material for all the Detectors
*

* --- Detector number 1 ---
      IF (JDETF(1) .NE. 0) THEN
       CALL S1MATE
      ENDIF
* --- Detector number 2 ---
      IF (JDETF(2) .NE. 0) THEN
       CALL S2MATE
      ENDIF
* --- Detector number 3 ---
      IF (JDETF(3) .NE. 0) THEN
       CALL S3MATE
      ENDIF
* --- Detector number 4 ---
      IF (JDETF(4) .NE. 0) THEN
       CALL S4MATE
      ENDIF
* --- Detector number 5 ---
      IF (JDETF(5) .NE. 0) THEN
       CALL S5MATE
      ENDIF
* --- Detector number 6 ---
      IF (JDETF(6) .NE. 0) THEN
       CALL S6MATE
      ENDIF
* --- Detector number 7 ---
      IF (JDETF(7) .NE. 0) THEN
       CALL S7MATE
      ENDIF
* --- Detector number 8 ---
      IF (JDETF(8) .NE. 0) THEN
       CALL S8MATE
      ENDIF
* --- Detector number 9 ---
      IF (JDETF(9) .NE. 0) THEN
       CALL S9MATE
      ENDIF
* --- Detector number 10 ---
      IF (JDETF(10) .NE. 0) THEN
       CALL SAMATE
      ENDIF
* --- Detector number 11 ---
      IF (JDETF(11) .NE. 0) THEN
       CALL SBMATE
      ENDIF
* --- Detector number 12 ---
      IF (JDETF(12) .NE. 0) THEN
       CALL SCMATE
      ENDIF
* --- Detector number 13 ---
      IF (JDETF(13) .NE. 0) THEN
       CALL SDMATE
      ENDIF
* --- Detector number 14 ---
      IF (JDETF(14) .NE. 0) THEN
       CALL SEMATE
      ENDIF
* --- Detector number 15 ---
      IF (JDETF(15) .NE. 0) THEN
C       CALL SFMATE
      ENDIF


* --- User entry for testing ---
      CALL SUMATE

*
* --- Print material parameters according to data card PRIN ---
*
      IF (IFMATE .NE. 0) CALL GPMATE(0)

 9999 CONTINUE
      RETURN
      END



*+DECK,SXTMED.
*CMZ :  2.05/32 22/06/95  13.14.30  by  Hal Kalechofsky
*CMZ :  2.05/30 22/06/95  09.31.57  by  Hal Kalechofsky
*CMZ :  2.05/21 12/06/95  09.32.05  by  Hal Kalechofsky
*CMZ :  2.05/17 06/06/95  09.38.36  by  Hal Kalechofsky
*CMZ :  2.05/08 15/05/95  18.08.40  by  Hal Kalechofsky
*CMZ :  2.05/07 15/05/95  11.45.25  by  Hal Kalechofsky
*CMZ :  2.00/00 16/03/95  17.57.03  by  Hal Kalechofsky
*CMZ :  1.01/00 14/07/94  17.48.30  by  Hal Kalechofsky
*CMZ :  1.00/00 26/01/94  08.56.39  by  Nick van Eijndhoven (RUU/CERN)
*-- Author :    Nick van Eijndhoven (CERN)   04/09/90
      SUBROUTINE SXTMED

C
C **********************************************************************
C *                                                                    *
C *               Definiton of Tracking Media                          *
C *                                                                    *
C **********************************************************************
C *                                                                    *
C *  CALLED BY     : SXINIT                                            *
C *  ORIGIN        : NICK VAN EIJNDHOVE                                *
C *  CONTACT       : ARIS ANGELIS, HAL KALECHOFSKY, YIOTA FOKA         *
C *  YF,HK 04-MAY-1995 CERN GENEVA                                     *
C *                                                                    *
C **********************************************************************
C

      IMPLICIT NONE
*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
C
*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
*
* --------------------------------------------------------------------
*

* --- Use small enough step size for accurate tracking in WA98, WMAG
* --- and other volumes, replace the wrong parameter values by NvE.

      CALL GSTMED( 1,'Vacuum  $', 1,0,0,0.,0.1,0.1,0.01,0.1,0.1,0,0)
      CALL GSTMED( 2,'Air     $', 2,0,0,0.,0.1,0.1,0.01,0.1,0.1,0,0)
      CALL GSTMED( 3,'C fibre $', 3,0,0,0.,0.1,0.1,0.01,0.01,0.01,0,0)
      CALL GSTMED( 4,'Al      $', 4,0,0,0.,0.1,0.1,0.01,0.01,0.01,0,0)
      CALL GSTMED( 5,'Mylar   $', 5,0,0,0.,0.1,0.1,0.01,0.01,0.01,0,0)
      CALL GSTMED( 6,'Kevlar  $', 6,0,0,0.,0.1,0.1,0.01,0.01,0.01,0,0)
      CALL GSTMED( 7,'He      $', 7,0,0,0.,0.1,0.1,0.01,0.1,0.1,0,0)

* --- Tracking Parameters for the Helium-Bag

      CALL GSTMED( 8,'HELIUM  $',8,0,0,0.,10.,1.,0.1,0.1,10.,0,0)
      CALL GSTMED( 9,'PET     $',9,0,0,0.,10.,0.1,0.1,0.01,0.01,0,0)

* --- Decouple field tracking and vacuum tube from request of magnet geometry,
* --- but retain two sets of tracking media parameters, for field-on and -off.
* --- In case of field-on also apply energy cuts in beam pipe walls etc inside
* --- the magnetic volume to prevent spirals of low energetic secondaries.

      IF (SXMAGN.NE.0.) THEN
        CALL GSTMED(93,'Mag C   $',93,0,1,20.,
     &   0.1,0.1,0.01,0.01,0.01,0,0)
        CALL GSTMED(94,'Mag Al  $',94,0,1,20.,
     &   0.1,0.1,0.01,0.01,0.01,0,0)
        CALL GSTMED(97,'Mag He  $',97,0,1,20.,0.1,0.1,0.01,0.1,0.1,0,0)
        CALL GSTMED(98,'Mag vac $',98,0,1,20.,0.1,0.1,0.01,0.1,0.1,0,0)
        CALL GSTMED(99,'Mag air $',99,0,1,20.,0.1,0.1,0.01,0.1,0.1,0,0)
        CALL GSTPAR(93,'CUTELE',0.1)
        CALL GSTPAR(93,'CUTHAD',0.1)
        CALL GSTPAR(94,'CUTELE',0.1)
        CALL GSTPAR(94,'CUTHAD',0.1)
      ELSEIF (SXMAGN.EQ.0.) THEN
        CALL GSTMED(93,'Mag C   $',93,0,0,0.,
     &   0.1,0.1,0.01,0.01,0.01,0,0)
        CALL GSTMED(94,'Mag Al  $',94,0,0,0.,
     &   0.1,0.1,0.01,0.01,0.01,0,0)
        CALL GSTMED(97,'Mag He  $',97,0,0,0.,
     &   0.1,0.1,0.01,0.1,0.1,0,0)
        CALL GSTMED(98,'Mag vac $',98,0,0,0.,
     &   0.1,0.1,0.01,0.1,0.1,0,0)
        CALL GSTMED(99,'Mag air $',99,0,0,0.,
     &   0.1,0.1,0.01,0.1,0.1,0,0)
      ENDIF

* --- Target Tracking Media
* --- Use small enough step size for accurate tracking in the target material,
* --- replace the wrong parameter values by NvE (use mag parameter values).

      CALL GSTMED(101,'C  $',101,0,1,20.,0.1,1.E-4,0.01,1.E-4,1.E-4,0,0)
      CALL GSTMED(102,'S  $',102,0,1,20.,0.1,1.E-4,0.01,1.E-4,1.E-4,0,0)
      CALL GSTMED(103,'Al $',103,0,1,20.,0.1,1.E-4,0.01,1.E-4,1.E-4,0,0)
      CALL GSTMED(104,'Au $',104,0,1,20.,0.1,1.E-4,0.01,1.E-4,1.E-4,0,0)
      CALL GSTMED(105,'Ag $',105,0,1,20.,0.1,1.E-4,0.01,1.E-4,1.E-4,0,0)
      CALL GSTMED(106,'Cu $',106,0,1,20.,0.1,1.E-4,0.01,1.E-4,1.E-4,0,0)
      CALL GSTMED(107,'Pb $',107,0,1,20.,0.1,1.E-4,0.01,1.E-4,1.E-4,0,0)

*
* --- Define Tracking Parameters for all the Detectors
*

* --- Detector number 1 ---
      IF (JDETF(1) .NE. 0) THEN
       CALL S1TMED
      ENDIF
* --- Detector number 2 ---
      IF (JDETF(2) .NE. 0) THEN
       CALL S2TMED
      ENDIF
* --- Detector number 3 ---
      IF (JDETF(3) .NE. 0) THEN
       CALL S3TMED
      ENDIF
* --- Detector number 4 ---
      IF (JDETF(4) .NE. 0) THEN
       CALL S4TMED
      ENDIF
* --- Detector number 5 ---
      IF (JDETF(5) .NE. 0) THEN
       CALL S5TMED
      ENDIF
* --- Detector number 6 ---
      IF (JDETF(6) .NE. 0) THEN
       CALL S6TMED
      ENDIF
* --- Detector number 7 ---
      IF (JDETF(7) .NE. 0) THEN
       CALL S7TMED
      ENDIF
* --- Detector number 8 ---
      IF (JDETF(8) .NE. 0) THEN
       CALL S8TMED
      ENDIF
* --- Detector number 9 ---
      IF (JDETF(9) .NE. 0) THEN
       CALL S9TMED
      ENDIF
* --- Detector number 10 ---
      IF (JDETF(10) .NE. 0) THEN
       CALL SATMED
      ENDIF
* --- Detector number 11 ---
      IF (JDETF(11) .NE. 0) THEN
       CALL SBTMED
      ENDIF
* --- Detector number 12 ---
      IF (JDETF(12) .NE. 0) THEN
       CALL SCTMED
      ENDIF
* --- Detector number 13 ---
      IF (JDETF(13) .NE. 0) THEN
       CALL SDTMED
      ENDIF
* --- Detector number 14 ---
      IF (JDETF(14) .NE. 0) THEN
       CALL SETMED
      ENDIF
* --- Detector number 15 ---
      IF (JDETF(15) .NE. 0) THEN
C       CALL SFTMED
      ENDIF

* --- User entry for testing ---
      CALL SUTMED

*
* --- Print tracking medium parameters according to data card PRIN ---
*
      IF (IFTMED .NE. 0) CALL GPTMED(0)

 9999 CONTINUE
      RETURN
      END



*+DECK,SXGEOM.
*CMZ :  2.05/32 22/06/95  13.18.46  by  Hal Kalechofsky
*CMZ :  2.05/30 22/06/95  09.31.57  by  Hal Kalechofsky
*CMZ :  2.05/24 13/06/95  15.18.50  by  Hal Kalechofsky
*CMZ :  2.05/23 13/06/95  11.24.57  by  Hal Kalechofsky
*CMZ :  2.05/21 12/06/95  10.21.44  by  Hal Kalechofsky
*-- Author :
      SUBROUTINE SXGEOM

C
C **********************************************************************
C *                                                                    *
C *               Definiton of Experimental Setup                      *
C *                                                                    *
C **********************************************************************
C *                                                                    *
C *  CALLED BY     : SXINIT                                            *
C *  ORIGIN        : NICK VAN EIJNDHOVE                                *
C *  CONTACT       : ARIS ANGELIS, HAL KALECHOFSKY, YIOTA FOKA         *
C *  YF,HK 04-MAY-1995 CERN GENEVA                                     *
C *                                                                    *
C **********************************************************************
C

      IMPLICIT NONE
*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
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,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
      INTEGER I
      REAL ZT

*
* -------------------------------------------------------------------------
*
       print *,' !!!!!!!!!!!!!  N E W GEOMETRY'
*
* --- Define Dimensions of Volumes
*

* --- Mother Volume WA98

      DWA98X = 2000.
      DWA98Y = 650.
      DWA98Z = 3500.

* --- Magnet

      DMAGNX = DWA98X-0.1
      DMAGNY = DWA98Y-0.1
      DMAGNZ = 1450.

* --- Target

      DTARGX=1.5
      DTARGY=1.5
      IF (ISXTAR .EQ. 101) DTARGZ=4.135E-2
      IF (ISXTAR .EQ. 102) DTARGZ=4.952E-2
      IF (ISXTAR .EQ. 103) DTARGZ=2.500E-2
      IF (ISXTAR .EQ. 104) DTARGZ=6.450E-3
      IF (ISXTAR .EQ. 105) DTARGZ=9.550E-3
      IF (ISXTAR .EQ. 106) DTARGZ=1.120E-2
      IF (ISXTAR .EQ. 107) DTARGZ=9.550E-3
      IF (ISXTAR .EQ. 198) DTARGZ=1.000E-3

C**> Option to modify Pb target (half)thickness (cm) here.

C     IF (ISXTAR.EQ.107) DTARGZ=8.550E-3 ! 0.1% Interaction length (for p).
C     IF (ISXTAR.EQ.107) DTARGZ=42.75E-3 ! 0.5% Interaction length (for p).
C     IF (ISXTAR.EQ.107) DTARGZ=85.50E-3 ! 1.0% Interaction length (for p).

C**> Pb targets mounted for September 1994 proton (=pion) run.

      IF (ISXTAR.EQ.107) DTARGZ=0.02133/2.  ! Thin target on target wheel.
C     IF (ISXTAR.EQ.107) DTARGZ=0.04433/2.  ! Thick target on target wheel.
C     IF (ISXTAR.EQ.107) DTARGZ=0.25  ! (Very) thick target for field-off runs.
C**> Pb targets mounted for September 1994 Pb run.
C   ?
C   ?
C     IF (ISXTAR.EQ.107) DTARGZ=?.? ! Secondary target for field-off runs.


* --- Mother Volume

      DWA98(1)=DWA98X
      DWA98(2)=DWA98Y
      DWA98(3)=DWA98Z

C     DWA98(1)=650.
C     DWA98(3)=2000.

* --- Magnet

      DWMAG(1)=DMAGNX
      DWMAG(2)=DMAGNY
      DWMAG(3)=DMAGNZ

C     DWMAG(3)=400.

* --- Target

      DTARG(1)=DTARGX
      DTARG(2)=DTARGY
      DTARG(3)=DTARGZ

*
* --- Define the WA98 Setup, select with SXVAC to fill with air or vacuum
*

      IF (ISXVAC .EQ. 0) CALL GSVOLU('WA98','BOX ',2,DWA98,3,I)
      IF (ISXVAC .EQ. 1) CALL GSVOLU('WA98','BOX ',1,DWA98,3,I)

*
* --- Define the Magnetic Area, select with SXVAC to fill with air or vacuum
* --- (Mag)Vacuum or (Mag)Air according to selections.
*
      IF (ISXVAC.EQ.0) THEN
        IF (SXMAGN.NE.0.) THEN
          CALL GSVOLU('WMAG','BOX ',99,DWMAG,3,I)
        ELSE
          CALL GSVOLU('WMAG','BOX ',2,DWMAG,3,I)
        ENDIF
      ELSEIF (ISXVAC.EQ.1) THEN
        IF (SXMAGN.NE.0.) THEN
          CALL GSVOLU('WMAG','BOX ',98,DWMAG,3,I)
        ELSE
          CALL GSVOLU('WMAG','BOX ',1,DWMAG,3,I)
        ENDIF
      ENDIF

* --- Define the TARGET box volume and fill with selected material ---

      CALL GSVOLU('XTAR','BOX ',ISXTAR,DTARG,3,I)

*
* --- Position Volumes
*

* --- Define Coordinates according to different origin

      IF (ISXCOOR.EQ.0) THEN
*         relative position of center of target to center of magnet
          DZTAR = 328.

*         Target
          XTARG=0.
          YTARG=0.
          ZTARG=-DWA98(3)+DMAGNZ

*         Magnet
          XMAG=XTARG
          YMAG=YTARG
          ZMAG=ZTARG+DZTAR

          ZT=ZTARG-ZMAG

* --- Position WMAG in WA98

          CALL GSPOS('WMAG',1,'WA98',XMAG,YMAG,ZMAG,0,'ONLY')

* --- Place target in magnetic volume at position (XTARG,YTARG,ZT) ---

          CALL GSPOS('XTAR',1,'WMAG',XTARG,YTARG,ZT,0,'ONLY')

* --- Set drawing attributes of WA98 and WMAG surrounding volumes to unseen

          CALL GSATT('WA98','SEEN',0)
          CALL GSATT('WMAG','SEEN',0)
      ENDIF

*
* --- New Coordinate System
*

C      IF (ISXCOOR.EQ.1) THEN
*         relative position of center of target to center of magnet
C          DZTAR = 328.
C
C*         Magnet
CC          XMAG=0.
C          YMAG=0.
C          ZMAG=0.
C
C*         Target
C          XTARG=0.
C          YTARG=0.
C          ZTARG=-DZTAR.
C
C* --- Position WMAG in WA98
C
C          CALL GSPOS('WMAG',1,'WA98',XMAG,YMAG,ZMAG,0,'ONLY')
C
C* --- Place target in magnetic volume at position (XTARG,YTARG,ZTARG) ---
C
C          CALL GSPOS('XTAR',1,'WMAG',XTARG,YTARG,ZTARG,0,'ONLY')
C
C* --- Set drawing attributes of WA98 and WMAG surrounding volumes to unseen
C
C          CALL GSATT('WA98','SEEN',0)
C          CALL GSATT('WMAG','SEEN',0)
C      ENDIF

      IF (IDBUGF(1) .GT. 0) PRINT 1000,XTARG,YTARG,ZTARG
 1000 FORMAT(' *S1GEOM* Target position in WA98 : ',3(G12.5,1X))


*
* --- Define Geometry for He Bag
*

      IF (ISXBG1 .EQ. 1 .OR. ISXBG2 .EQ. 1) THEN
         CALL SXHEBAG
      ENDIF

*
* --- Vacuum Chamber
*

      IF (ISXTUB .NE. 0) THEN
       CALL SXTUBE
      ENDIF

*
* --- Define Geometry of all the Detectors
*

* --- Detector number 1 ---
      IF (JDETF(1) .NE. 0) THEN
       CALL S1GEOM
      ENDIF
* --- Detector number 2 ---
      IF (JDETF(2) .NE. 0) THEN
       CALL S2GEOM
      ENDIF
* --- Detector number 3 ---
      IF (JDETF(3) .NE. 0) THEN
       CALL S3GEOM
      ENDIF
* --- Detector number 4 ---
      IF (JDETF(4) .NE. 0) THEN
       CALL S4GEOM
      ENDIF
* --- Detector number 5 ---
      IF (JDETF(5) .NE. 0) THEN
       CALL S5GEOM
      ENDIF
* --- Detector number 6 ---
      IF (JDETF(6) .NE. 0) THEN
       CALL S6GEOM
      ENDIF
* --- Detector number 7 ---
      IF (JDETF(7) .NE. 0) THEN
       CALL S7GEOM
      ENDIF
* --- Detector number 8 ---
      IF (JDETF(8) .NE. 0) THEN
       CALL S8GEOM
      ENDIF
* --- Detector number 9 ---
      IF (JDETF(9) .NE. 0) THEN
       CALL S9GEOM
      ENDIF
* --- Detector number 10 ---
      IF (JDETF(10) .NE. 0) THEN
       CALL SAGEOM
      ENDIF
* --- Detector number 11 ---
      IF (JDETF(11) .NE. 0) THEN
       CALL SBGEOM
      ENDIF
* --- Detector number 12 ---
      IF (JDETF(12) .NE. 0) THEN
       CALL SCGEOM
      ENDIF
* --- Detector number 13 ---
      IF (JDETF(13) .NE. 0) THEN
       CALL SDGEOM
      ENDIF
* --- Detector number 14 ---
      IF (JDETF(14) .NE. 0) THEN
       CALL SEGEOM
      ENDIF
* --- Detector number 15 ---
      IF (JDETF(15) .NE. 0) THEN
C       CALL SFGEOM
      ENDIF

* --- User entry for testing ---
      CALL SUGEOM
*
* --- Print volume parameters according to data card PRIN ---
*
      IF (IFVOLU .NE. 0) CALL GPVOLU(0)
      IF (IFVOLU .NE. 0) CALL GPROTM(0)

 9999 CONTINUE
      RETURN
      END



*+DECK,SXSENS.
*CMZ :  2.05/32 22/06/95  13.13.48  by  Hal Kalechofsky
*CMZ :  2.05/30 22/06/95  09.31.57  by  Hal Kalechofsky
*CMZ :  2.05/17 06/06/95  09.38.36  by  Hal Kalechofsky
*CMZ :  2.05/07 14/05/95  10.13.15  by  Hal Kalechofsky
*CMZ :  2.00/00 16/03/95  17.57.03  by  Hal Kalechofsky
*CMZ :  1.01/00 14/07/94  17.50.49  by  Hal Kalechofsky
*CMZ :  1.00/00 26/01/94  08.58.32  by  Nick van Eijndhoven (RUU/CERN)
*-- Author :    Nick van Eijndhoven (CERN)   04/09/90
      SUBROUTINE SXSENS

C
C **********************************************************************
C *                                                                    *
C *            Definiton of Sensitive Areas of Detectors               *
C *                                                                    *
C **********************************************************************
C *                                                                    *
C *  CALLED BY     : SXINIT                                            *
C *  ORIGIN        : NICK VAN EIJNDHOVE                                *
C *  CONTACT       : HAL KALECHOFSKY, YIOTA FOKA                       *
C *  NVE 04-SEP-1990 CERN GENEVA                                       *
C *                                                                    *
C **********************************************************************
C

      IMPLICIT NONE
*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
C
*
* -----------------------------------------------------------------------
*

*
* --- Define sensitive Detectors
*

* --- Detector number 1 ---
      IF (JDETF(1) .NE. 0) THEN
       CALL S1SENS
      ENDIF
* --- Detector number 2 ---
      IF (JDETF(2) .NE. 0) THEN
       CALL S2SENS
      ENDIF
* --- Detector number 3 ---
      IF (JDETF(3) .NE. 0) THEN
       CALL S3SENS
      ENDIF
* --- Detector number 4 ---
      IF (JDETF(4) .NE. 0) THEN
       CALL S4SENS
      ENDIF
* --- Detector number 5 ---
      IF (JDETF(5) .NE. 0) THEN
       CALL S5SENS
      ENDIF
* --- Detector number 6 ---
      IF (JDETF(6) .NE. 0) THEN
       CALL S6SENS
      ENDIF
* --- Detector number 7 ---
      IF (JDETF(7) .NE. 0) THEN
       CALL S7SENS
      ENDIF
* --- Detector number 8 ---
      IF (JDETF(8) .NE. 0) THEN
       CALL S8SENS
      ENDIF
* --- Detector number 9 ---
      IF (JDETF(9) .NE. 0) THEN
       CALL S9SENS
      ENDIF
* --- Detector number 10 ---
      IF (JDETF(10) .NE. 0) THEN
       CALL SASENS
      ENDIF
* --- Detector number 11 ---
      IF (JDETF(11) .NE. 0) THEN
       CALL SBSENS
      ENDIF
* --- Detector number 12 ---
      IF (JDETF(12) .NE. 0) THEN
       CALL SCSENS
      ENDIF
* --- Detector number 13 ---
      IF (JDETF(13) .NE. 0) THEN
       CALL SDSENS
      ENDIF
* --- Detector number 14 ---
      IF (JDETF(14) .NE. 0) THEN
       CALL SESENS
      ENDIF
* --- Detector number 15 ---
      IF (JDETF(15) .NE. 0) THEN
C       CALL SFSENS
      ENDIF

* --- User entry for testing ---
      CALL SUSENS
*
* --- Print sensitive (sets of) detectors according to data card PRIN ---
*
      IF (IFSETS .NE. 0) CALL GPSETS('****','****')

 9999 CONTINUE
      RETURN
      END



*+DECK,SXDRAW.
*CMZ :          10/01/96  11.54.56  by  nishimu
*CMZ :  2.05/32 22/06/95  13.13.48  by  Hal Kalechofsky
*CMZ :  2.05/24 13/06/95  12.56.01  by  Hal Kalechofsky
*CMZ :  2.05/07 14/05/95  10.13.15  by  Hal Kalechofsky
*CMZ :  2.00/00 16/03/95  17.57.04  by  Hal Kalechofsky
*CMZ :  1.05/00 01/09/94  19.21.55  by  Hal Kalechofsky
*CMZ :  1.01/00 14/07/94  17.51.48  by  Hal Kalechofsky
*CMZ :  1.00/00 26/01/94  08.59.41  by  Nick van Eijndhoven (RUU/CERN)
*-- Author :    Nick van Eijndhoven (CERN)   04/09/90
      SUBROUTINE SXDRAW

C
C **********************************************************************
C *                                                                    *
C *                 Draw the Layout of Detectors                       *
C *                                                                    *
C **********************************************************************
C *                                                                    *
C *  CALLED BY     : SXINIT                                            *
C *  ORIGIN        : NICK VAN EIJNDHOVE                                *
C *  CONTACT       : HAL KALECHOFSKY, YIOTA FOKA                       *
C *  NVE 04-SEP-1990 CERN GENEVA                                       *
C *                                                                    *
C **********************************************************************
C

      IMPLICIT NONE
*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
C
*
* ---------------------------------------------------------------------
*

*
* --- Steerings ---
*
      IF (JDRGF(NSXDET+1) .EQ. 0) GO TO 10

*
* --- Draw the tree structure as seen in the general drawings ---
*
C     CALL GDTREE('WA98',0,001111)

*
* --- Draw the total setup in different views ---
*

* --- Cut view along X-axis ---

      CALL ICLRWK(0,0)
      CALL GDHEAD(001111,'Total setup side cut view$',0.5)
      CALL GDRAWC('WA98',1,0.,11.,10.,0.0055,0.0055)
      CALL GDAXIS(0.,-1600.,-1600.,300.)
      CALL GDSCAL(10.,1.)
      CALL GDMAN(18.,6.)

* --- Cut view along Y-axis ---

      CALL ICLRWK(0,0)
      CALL GDHEAD(001111,'Total setup top cut view$',0.5)
      CALL GDRAWC('WA98',2,0.,11.,10.,0.0055,0.0055)
      CALL GDAXIS(-1600.,0.,-1600.,300.)
      CALL GDSCAL(10.,1.)
      CALL GDMAN(18.,6.)

* --- Side view ---

      CALL ICLRWK(0,0)
      CALL GDHEAD(001111,'Total setup side view$',0.5)
      CALL GDRAW('WA98',90.,180.,0.,11.,10.,0.0055,0.0055)
      CALL GDAXIS(0.,-1600.,-1600.,300.)
      CALL GDSCAL(10.,1.)
      CALL GDMAN(18.,6.)

* --- Top view ---

      CALL ICLRWK(0,0)
      CALL GDHEAD(001111,'Total setup top view$',0.5)
      CALL GDRAW('WA98',90.,90.,0.,11.,10.,0.0055,0.0055)
      CALL GDAXIS(-1600.,0.,-1600.,300.)
      CALL GDSCAL(10.,1.)
      CALL GDMAN(18.,6.)

* --- Perspective view 1 ---

      CALL ICLRWK(0,0)
      CALL GDHEAD(001111,'Total setup perspective view$',0.5)
      CALL GDRAW('WA98',135.,135.,0.,10.,8.5,0.007,0.007)
      CALL GDAXIS(-1000.,-1000.,100.,400.)
      CALL GDSCAL(10.,1.)
      CALL GDMAN(2.,2.)

* --- Perspective view 2 ---

      CALL ICLRWK(0,0)
      CALL GDHEAD(001111,'Total setup perspective view$',0.5)
      CALL GDRAW('WA98',45.,135.,0.,10.,8.5,0.007,0.007)
      CALL GDAXIS(-1000.,-1000.,-900.,400.)
      CALL GDSCAL(10.,1.)
      CALL GDMAN(18.,2.)

 10   CONTINUE

*
* --- Event Drawing
*
      write(6,*) '%SN: Event drawing!'

      IF (IFDRAT .EQ. 0) GO TO 11

* --- Top view for event drawing ---

      CALL GDOPEN(1)
      CALL GDHEAD(001111,'Event drawing top view$',0.5)
      CALL GDRAW('WA98',90.,90.,0.,11.,10.,0.0055,0.0055)
      CALL GDAXIS(-1600.,0.,-1600.,300.)
      CALL GDSCAL(10.,1.)
      CALL GDCLOS

* --- Side view for event drawing ---

      CALL GDOPEN(2)
      CALL GDHEAD(001111,'Event drawing side view$',0.5)
      CALL GDRAW('WA98',90.,180.,0.,11.,10.,0.0055,0.0055)
      CALL GDAXIS(0.,-1600.,-1600.,300.)
      CALL GDSCAL(10.,1.)
      CALL GDCLOS

* --- Perspective view 1 for event drawing ---

      CALL GDOPEN(3)
      CALL GDHEAD(001111,'Event drawing perspective view$',0.5)
      CALL GDRAW('WA98',135.,135.,0.,10.,8.5,0.007,0.007)
      CALL GDAXIS(-1000.,-1000.,100.,350.)
      CALL GDCLOS

* --- Perspective view 2 for event drawing ---

      CALL GDOPEN(4)
      CALL GDHEAD(001111,'Event drawing perspective view$',0.5)
      CALL GDRAW('WA98',45.,135.,0.,10.,8.5,0.007,0.007)
      CALL GDAXIS(-950.,-1000.,-850.,350.)
      CALL GDCLOS

 11   CONTINUE

*
* --- Drawing detectors
*
      write(6,*) '%SN: Drawing detectors'

* --- Detector number 1 ---
      IF (JDRGF(1) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL S1DRAW
      ENDIF
* --- Detector number 2 ---
      IF (JDRGF(2) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL S2DRAW
      ENDIF
* --- Detector number 3 ---
      IF (JDRGF(3) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL S3DRAW
      ENDIF
* --- Detector number 4 ---
      IF (JDRGF(4) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL S4DRAW
      ENDIF
* --- Detector number 5 ---
      IF (JDRGF(5) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL S5DRAW
      ENDIF
* --- Detector number 6 ---
      IF (JDRGF(6) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL S6DRAW
      ENDIF
* --- Detector number 7 ---
      IF (JDRGF(7) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL S7DRAW
      ENDIF
* --- Detector number 8 ---
      IF (JDRGF(8) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL S8DRAW
      ENDIF
* --- Detector number 9 ---
      IF (JDRGF(9) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL S9DRAW
      ENDIF
* --- Detector number 10 ---
      IF (JDRGF(10) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL SADRAW
      ENDIF
* --- Detector number 11 ---
      IF (JDRGF(11) .NE. 0) THEN
       CALL ICLRWK(0,0)
       CALL SBDRAW
      ENDIF

* --- User entry for testing ---
      CALL ICLRWK(0,0)
      CALL SUDRAW

 9999 CONTINUE
      RETURN
      END

