*** * gugeom.f *** * SUBROUTINE UGEOM * *********************************************************************** * * * User routine to define geometry of detector * * * *********************************************************************** * 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 * ---------------------------------------------------------- JDETF( 1) = 0 JDETF( 2) = 0 JDETF( 3) = 0 JDETF( 4) = 1 JDETF( 5) = 0 JDETF( 6) = 0 JDETF( 7) = 0 JDETF( 8) = 0 JDETF( 9) = 0 JDETF(10) = 0 JDETF(11) = 0 JDETF(12) = 0 JDETF(13) = 0 JDETF(14) = 0 JDETF(15) = 0 * * --- Define Material * CALL SXMATE * * --- Define Tracking Media * CALL SXTMED * * --- Define Detector Setup * CALL SXGEOM CALL GGCLOS * RETURN END *+DECK,SXKEY. *CMZ : 2.06/33 26/09/95 00.43.07 by H. Kalechofsky/Y. Foka *-- Author : *CMZ : 01/08/95 13.49.53 by Hal Kalechofsky *-- Author : SUBROUTINE SXKEY C C *********************************************************************** C * * C * Definition of FFREAD Keys * C * * C *********************************************************************** C * * C * CALLED BY : SXINIT * C * ORIGIN : NICK VAN EIJNDHOVEN * C * CONTACT : HAL KALECHOFSKY, YIOTA FOKA * C * MODIFICATIONS : HAL KALECHOFSKY - MAY,1994 * C * HJK 08-MAR-1995 CERN GENEVA * C * * C * REMARKS : * C * 1) Added FFKEY variable SXCHM * C * for MSAC cluster and satellite simulations. * C * Author : HAL KALECHOFSKY - MARCH,1995 * C * 2) Changed meaning of SXMAG and SXMAP. * C * Author : HAL KALECHOFSKY - MARCH,1995 * C * * C *********************************************************************** C * * C * NSXDET = number of detectors in the setup * C * NPLANS = number of fake planes * C * NLUNS = number of logical units * C * initialised in common SCXFF * * * Definition of additional FFKEY CARDS * * CARD : SXMAX * MAXNSTEP = maximum allowed number of steps. Inisialised at the default * Geant value MAXNST=10000, in common GCTRAK.C * C *********************************************************************** c IMPLICIT NONE *KEEP,GCTRAK. INTEGER MAXMEC,MAXME1 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,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,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 INTEGER I C C ---------------------------------------------------------------------- C * * Definition of FFKEY Cards * CALL FFKEY('SXEVT',ISXEVT, 1,'INTEGER') CALL FFKEY('SXDET',ISXDET,NSXDET+1,'INTEGER') CALL FFKEY('SXGAT',SXGATE, NSXDET, 'REAL') CALL FFKEY('SXDB1',ISXDB1,NSXDET+1,'INTEGER') CALL FFKEY('SXDB2',ISXDB2,NSXDET+1,'INTEGER') CALL FFKEY('SXTRA',ISXTRA,NSXDET+1,'INTEGER') CALL FFKEY('SXDRG',ISXDRG,NSXDET+1,'INTEGER') CALL FFKEY('SXDRT',ISXDRT,NSXDET+1,'INTEGER') CALL FFKEY('SXDCH',ISXDCH, 1,'INTEGER') CALL FFKEY('SXOUT',ISXOUT,NSXDET+1,'INTEGER') CALL FFKEY('SXLUN',ISXLUN, NLUNS,'INTEGER') CALL FFKEY('SXWKS',ISXWKS, 1,'INTEGER') CALL FFKEY('SXPW1',ISXPW1,NSXDET+1,'INTEGER') CALL FFKEY('SXPW2',ISXPW2,NSXDET+1,'INTEGER') C**> This routine should be in the cradle for Nplans=15 to take effect! CALL FFKEY('SXPLN',ISXPLN, NPLANS,'INTEGER') CALL FFKEY('SXTAR',ISXTAR, 1,'INTEGER') CALL FFKEY('SXMAG',SXMAGN, 1, 'REAL') CALL FFKEY('SXMAP',ISXMAP, 1,'INTEGER') CALL FFKEY('SXVAC',ISXVAC, 1,'INTEGER') CALL FFKEY('SXTUB',ISXTUB, 1,'INTEGER') CALL FFKEY('SXBG1',ISXBG1, 1,'INTEGER') CALL FFKEY('SXBG2',ISXBG2, 1,'INTEGER') CALL FFKEY('SXTIM',ISXTIM, 1,'INTEGER') CALL FFKEY('SXCHM',ISXCHM,NSXDET+1,'INTEGER') CALL FFKEY('SXMAX',MAXNSTEP, 1,'INTEGER' ) CALL FFKEY('SXINP',ISXINP, 1,'INTEGER') CALL FFKEY('SXDIN',ISXDIN, 1,'INTEGER') CALL FFKEY('SXCOO',ISXCOOR, 1,'INTEGER') * * Initialise all keys and flags * ISXEVT=1 DO 10 I=1,NSXDET+1 ISXDET(I)=0 ISXDB1(I)=0 ISXDB2(I)=0 ISXTRA(I)=0 ISXDRG(I)=0 ISXDRT(I)=0 ISXOUT(I)=0 ISXPW1(I)=0 ISXPW2(I)=0 IDBUGF(I)=0 JDETF(I)=0 JTRAF(I)=0 JDRGF(I)=0 JDRTF(I)=0 JOUTF(I)=0 IF (I .GT. NSXDET) GO TO 10 SXGATE(I)=-999. 10 CONTINUE DO 20 I=1,NLUNS ISXLUN(I)=0 20 CONTINUE DO 30 I=1,NPLANS ISXPLN(I)=0 JPLNF(I)=0 30 CONTINUE ISXDCH=111 ISXWKS=0 ISXTAR=107 SXMAGN=0.0 ISXMAP=0 ISXVAC=0 ISXTUB=0 ISXBG1=0 ISXBG2=0 ISXTIM=0 ISXINP=0 ISXCOOR=0 ISXDIN=0 MAXNSTEP=MAXNST * * FFKEY Cards for each detector * * --- Detector number 1 --- c CALL S1KEY * --- Detector number 2 --- c CALL S2KEY * --- Detector number 3 --- c CALL S3KEY * --- Detector number 4 --- CALL S4KEY * --- Detector number 5 --- c CALL S5KEY * --- Detector number 6 --- CALL S6KEY * --- Detector number 7 --- c CALL S7KEY * --- Detector number 8 --- c CALL S8KEY * --- Detector number 9 --- c CALL S9KEY * --- Detector number 10 --- c CALL SAKEY * --- Detector number 11 --- c CALL SBKEY * --- Detector number 12 --- c CALL SCKEY * --- Detector number 13 --- c CALL SDKEY * --- Detector number 14 --- c CALL SEKEY * --- Detector number 15 --- C CALL SFKEY * --- User entry for testing --- c CALL SUKEY 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 c CALL S1MATE ENDIF * --- Detector number 2 --- IF (JDETF(2) .NE. 0) THEN c CALL S2MATE ENDIF * --- Detector number 3 --- IF (JDETF(3) .NE. 0) THEN c CALL S3MATE ENDIF * --- Detector number 4 --- IF (JDETF(4) .NE. 0) THEN CALL S4MATE ENDIF * --- Detector number 5 --- IF (JDETF(5) .NE. 0) THEN c CALL S5MATE ENDIF * --- Detector number 6 --- IF (JDETF(6) .NE. 0) THEN CALL S6MATE ENDIF * --- Detector number 7 --- IF (JDETF(7) .NE. 0) THEN c CALL S7MATE ENDIF * --- Detector number 8 --- IF (JDETF(8) .NE. 0) THEN c CALL S8MATE ENDIF * --- Detector number 9 --- IF (JDETF(9) .NE. 0) THEN c CALL S9MATE ENDIF * --- Detector number 10 --- IF (JDETF(10) .NE. 0) THEN c CALL SAMATE ENDIF * --- Detector number 11 --- IF (JDETF(11) .NE. 0) THEN c CALL SBMATE ENDIF * --- Detector number 12 --- IF (JDETF(12) .NE. 0) THEN c CALL SCMATE ENDIF * --- Detector number 13 --- IF (JDETF(13) .NE. 0) THEN c CALL SDMATE ENDIF * --- Detector number 14 --- IF (JDETF(14) .NE. 0) THEN c 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 c CALL S1TMED ENDIF * --- Detector number 2 --- IF (JDETF(2) .NE. 0) THEN c CALL S2TMED ENDIF * --- Detector number 3 --- IF (JDETF(3) .NE. 0) THEN c CALL S3TMED ENDIF * --- Detector number 4 --- IF (JDETF(4) .NE. 0) THEN CALL S4TMED ENDIF * --- Detector number 5 --- IF (JDETF(5) .NE. 0) THEN c CALL S5TMED ENDIF * --- Detector number 6 --- IF (JDETF(6) .NE. 0) THEN CALL S6TMED ENDIF * --- Detector number 7 --- IF (JDETF(7) .NE. 0) THEN c CALL S7TMED ENDIF * --- Detector number 8 --- IF (JDETF(8) .NE. 0) THEN c CALL S8TMED ENDIF * --- Detector number 9 --- IF (JDETF(9) .NE. 0) THEN c CALL S9TMED ENDIF * --- Detector number 10 --- IF (JDETF(10) .NE. 0) THEN c CALL SATMED ENDIF * --- Detector number 11 --- IF (JDETF(11) .NE. 0) THEN c CALL SBTMED ENDIF * --- Detector number 12 --- IF (JDETF(12) .NE. 0) THEN c CALL SCTMED ENDIF * --- Detector number 13 --- IF (JDETF(13) .NE. 0) THEN c CALL SDTMED ENDIF * --- Detector number 14 --- IF (JDETF(14) .NE. 0) THEN c 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 CCCC==>PMD psudo volume REAL XP,YP,ZP,ZSP,ZPP,ZFP,ZDIST REAL DPMD(3),DPHOL(3) DATA DPMD /350.,215.,12.50 / DATA DPHOL / 53.9,58.9,12.50 / * * ------------------------------------------------------------------------- * 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 C C *** Define the PMD box volume and fill with air *** IF (ISXVAC .EQ. 0) CALL GSVOLU('PMD ','BOX ',2,DPMD,3,I) IF (ISXVAC .EQ. 1) CALL GSVOLU('PMD ','BOX ',1,DPMD,3,I) C --- Place the PMD in WA98 with front edge 21.50m from target --- ZDIST = 2150. XP=XTARG YP=YTARG ZP=ZTARG+DPMD(3)+ZDIST CALL GSPOS('PMD ',1,'WA98',XP,YP,ZP,0,'ONLY') C C --- Make the central hole in the PMD and fill with vacuum --- IF (ISXVAC .EQ. 0) CALL GSVOLU('PHOL','BOX ',2,DPHOL,3,I) IF (ISXVAC .EQ. 1) CALL GSVOLU('PHOL','BOX ',1,DPHOL,3,I) CALL GSPOS('PHOL',1,'PMD ',0.,0.,0.,0,'ONLY') C C --- Set the seen attributes for the drawings --- CALL GSATT('PMD ','SEEN',1) CALL GSATT('PHOL','SEEN',-2) C * * --- 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 c CALL SXHEBAG ENDIF * * --- Vacuum Chamber * IF (ISXTUB .NE. 0) THEN c CALL SXTUBE ENDIF * * --- Define Geometry of all the Detectors * * --- Detector number 1 --- IF (JDETF(1) .NE. 0) THEN c CALL S1GEOM ENDIF * --- Detector number 2 --- IF (JDETF(2) .NE. 0) THEN c CALL S2GEOM ENDIF * --- Detector number 3 --- IF (JDETF(3) .NE. 0) THEN c CALL S3GEOM ENDIF * --- Detector number 4 --- IF (JDETF(4) .NE. 0) THEN CALL S4GEOM ENDIF * --- Detector number 5 --- IF (JDETF(5) .NE. 0) THEN c CALL S5GEOM ENDIF * --- Detector number 6 --- IF (JDETF(6) .NE. 0) THEN CALL S6GEOM ENDIF * --- Detector number 7 --- IF (JDETF(7) .NE. 0) THEN c CALL S7GEOM ENDIF * --- Detector number 8 --- IF (JDETF(8) .NE. 0) THEN c CALL S8GEOM ENDIF * --- Detector number 9 --- IF (JDETF(9) .NE. 0) THEN c CALL S9GEOM ENDIF * --- Detector number 10 --- IF (JDETF(10) .NE. 0) THEN c CALL SAGEOM ENDIF * --- Detector number 11 --- IF (JDETF(11) .NE. 0) THEN c CALL SBGEOM ENDIF * --- Detector number 12 --- IF (JDETF(12) .NE. 0) THEN c CALL SCGEOM ENDIF * --- Detector number 13 --- IF (JDETF(13) .NE. 0) THEN c CALL SDGEOM ENDIF * --- Detector number 14 --- IF (JDETF(14) .NE. 0) THEN c 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 c CALL S1SENS ENDIF * --- Detector number 2 --- IF (JDETF(2) .NE. 0) THEN c CALL S2SENS ENDIF * --- Detector number 3 --- IF (JDETF(3) .NE. 0) THEN c CALL S3SENS ENDIF * --- Detector number 4 --- IF (JDETF(4) .NE. 0) THEN CALL S4SENS ENDIF * --- Detector number 5 --- IF (JDETF(5) .NE. 0) THEN c CALL S5SENS ENDIF * --- Detector number 6 --- IF (JDETF(6) .NE. 0) THEN CALL S6SENS ENDIF * --- Detector number 7 --- IF (JDETF(7) .NE. 0) THEN c CALL S7SENS ENDIF * --- Detector number 8 --- IF (JDETF(8) .NE. 0) THEN c CALL S8SENS ENDIF * --- Detector number 9 --- IF (JDETF(9) .NE. 0) THEN c CALL S9SENS ENDIF * --- Detector number 10 --- IF (JDETF(10) .NE. 0) THEN c CALL SASENS ENDIF * --- Detector number 11 --- IF (JDETF(11) .NE. 0) THEN c CALL SBSENS ENDIF * --- Detector number 12 --- IF (JDETF(12) .NE. 0) THEN c CALL SCSENS ENDIF * --- Detector number 13 --- IF (JDETF(13) .NE. 0) THEN c CALL SDSENS ENDIF * --- Detector number 14 --- IF (JDETF(14) .NE. 0) THEN c 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) c CALL S1DRAW ENDIF * --- Detector number 2 --- IF (JDRGF(2) .NE. 0) THEN CALL ICLRWK(0,0) c CALL S2DRAW ENDIF * --- Detector number 3 --- IF (JDRGF(3) .NE. 0) THEN CALL ICLRWK(0,0) c 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) c CALL S5DRAW ENDIF * --- Detector number 6 --- IF (JDRGF(6) .NE. 0) THEN CALL ICLRWK(0,0) c CALL S6DRAW ENDIF * --- Detector number 7 --- IF (JDRGF(7) .NE. 0) THEN CALL ICLRWK(0,0) c CALL S7DRAW ENDIF * --- Detector number 8 --- IF (JDRGF(8) .NE. 0) THEN CALL ICLRWK(0,0) c CALL S8DRAW ENDIF * --- Detector number 9 --- IF (JDRGF(9) .NE. 0) THEN CALL ICLRWK(0,0) c CALL S9DRAW ENDIF * --- Detector number 10 --- IF (JDRGF(10) .NE. 0) THEN CALL ICLRWK(0,0) c CALL SADRAW ENDIF * --- Detector number 11 --- IF (JDRGF(11) .NE. 0) THEN CALL ICLRWK(0,0) c CALL SBDRAW ENDIF * --- User entry for testing --- CALL ICLRWK(0,0) CALL SUDRAW 9999 CONTINUE RETURN END