SUBROUTINE MARS1402(INPNAM,OUTNAM,HBKNAM) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! MARS LICENSING AGREEMENT ! ! ! ! Must not be removed from any MARS software and documentation! ! !-------------------------------------------------------------------------------! ! ! ! The MARS code system is copyrighted by: ! ! Universities Research Association, Inc. (URA)/ Fermilab (URA/ Fermilab). ! ! Copyright (C) 1994,1995,1996,1997,1998,1999,2000,2001,2002 Universities ! ! Research Association. All rights reserved. ! ! ! ! The MARS code is being distributed by Nikolai Mokhov of the Beam Physics ! ! Department of Beams Division at Fermilab. The code is distributed free of ! ! charge to non-commercial users. A re-distribution of the code is not ! ! permitted. Some limitations may apply. ! ! ! ! Each individual who wants to run the code has to register via mokhov@fnal.gov ! ! It is recommended to apply for a personal license if he/she wants an access ! ! to updated versions of the code for various platforms. To apply for a license,! ! please copy or download the User's agreement from the official MARS Web site ! ! http://www-ap.fnal.gov/~mokhov/MARS ! ! insert it into an editor and print it with your institution's letterhead. ! ! Sign and date it, and fax it back to Nikolai Mokhov at 630-840-6039. ! ! ! ! All materials mentioning use of MARS must display the following ! ! reference: ! ! ! ! N.V. Mokhov, "The MARS Code System User's Guide", Fermilab-FN-628 (1995). ! ! N.V. Mokhov, S.I. Striganov, A. Van Ginneken, S.G. Mashnik, A.J. Sierk and ! ! J. Ranft, "MARS Code Developments", Fermilab-Conf-98/379 (1998). ! ! N.V. Mokhov, "MARS Code Developments, Benchmarking and Applications", ! ! Fermilab-Conf-00/066 (2000). ! ! N.V. Mokhov and O.E. Krivosheev, "MARS Code Status", ! ! Fermilab-Conf-00/181 (2000). ! ! ! ! Neither the name of URA/Fermilab nor the names of its contributors may be ! ! used to endorse or promote products derived from this software without ! ! specific prior written permission. ! ! ! ! THIS SOFTWARE IS PROVIDED BY URA/FERMILAB AND CONTRIBUTORS ``AS IS'' AND ANY ! ! EXPRESS OR IMPLIED WARRANTIES, INCLUDING,BUT NOT LIMITED TO, THE IMPLIED ! ! WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE ! ! DISCLAIMED. IN NO EVENT SHALL URA/FERMILAB OR CONTRIBUTORS BE LIABLE FOR ANY ! ! DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES ! ! (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; ! ! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ! ! ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ! ! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ! ! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ! ! ! The views and conclusions contained in the software and documentation are ! ! those of the authors and should not be interpreted as representing official ! ! policies, either expressed or implied, of Universities Research Association / ! ! Fermilab. ! ! ! ! Forward any questions to Nikolai Mokhov at mokhov@fnal.gov ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ****************************************************************** * MARS14 * * m1402.f SOURCE FILE * * * * 1. MAIN & USERS - m1402.f * * 2. BLOCK DATA - m14bldt.f,m14bnab.f * * 3. C-SUBROUTINES - m14cstuff.c,m14gui.c,m14mc.c * * 4. INPUT AND OUTPUT - m14in1.f,m14in2.f,m14out.f * * 5. MARSON - m14mareg.f * * 6. TRANSPORT (h,ems) - m14tr.f,m14trems.f * * 7. TRANSPORT (n) - m14trneu.f,m14trneu-mcnp.f * * 8. FIELD AND SYNCH - m14field.f * * 9. DE/DX - m14dedx.f * * 10. GEOMETRY - m14region.f,m14exg.f * * 11. EVENT GENERATOR - m14eve.f,m14evepi.f,m14evtgen.f* * 12. ELASTIC - m14elast.f * * 13. X-SECTIONS - m14xsec.f * * 14. MORE PHYSICS - m14ph.f * * 15. CEM95(98) - m14cem.f * * 16. NEUTRINO - m14neutrino.f * * 17. DEUTERONS - m14deutron.f * * 18. RADIATION - m14rad.f,m14omega.f * * 19. HBOOK BOOKING/FILLING - m14hist.f, m14tuple.f * * 20. UTILITIES, FFREAD - m14util1.f,m14util2.f * * 21. DUMP,MTUPLE,SRCTERM - m14tuple.f,m14srcterm.f * ****************************************************************** C C***************************************************************** C........................................................ C MARS14(02) MAIN PROGRAM C AND C USER-SUPPLIED SUBROUTINES C MIXTUR,BEG1,REG1,REG3,REGTAG,FIELD,LEAK,ALIGN,SAGIT,RFCAVT,EDGEUS, C VFAN,MHSETU,MFILL,WRTSUR,TAGGING,BLPROCESS C C DOUBLE PRECISION VERSION C C Weggel's SOLENOID C THICK COMPOSITE SHIELDING EQUALIZED WITH APERTURE C DETAILS AT DUMP SPOT C C MAIN, MIXTUR, REG1, FIELD, SUFI, VFAN, LEAK, WRTSUR C C FS-2-2: Hg (100mrad)+Beam(67mrad) C C Version: 14-FEB-2001 C REVISION: 13-JUN-2002 C----------- C PARTICLE ID: * 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 * p n pi+ pi- K+ K- mu+ mu- g e- e+ ap pi0 d t He3 He4 num nuam nue nuae C----------- C AT E0: STAR DENSITY, FLUENCE, ENERGY DEPOSITION AND PARTICLE SPECTRA C IN NOB SPECIAL REGIONS C HBOOK: FLUENCE IN (CM), ENERGY DEPOSITION IN (GEV/G/CM3) C C EVERYTHING IS NORMALIZED PER 1 INCIDENT PARTICLE C C VOLUMETRIC: C HISTOGRAM ID = NUMH1+NSG+3*(ICL-1)+100*(IHTYP-1)+1000*(NRE-1) C ID=3, 1003, 2003: Star density (stars/cm3) at p > 0.3 GeV/c C ID=9, 1009, 2009: Residual Dose (Rem/hr) at (30days/1day) at AINT C ID=210, 1210, 2210: Total energy deposition (GeV/g) C C NSURF>0: SURFACE CROSSING ESTIMATOR (UP TO 100 SURFACES): C SURFACE: C ENERGY SPECTRA: ID = NUMH1+NSG+3*(ICL-1)+100*(IHTYP-1)+1000*(NSUR-1) C X-Y ISOFLUENCE: ID = ID1+1000*(NSUR-1) C ID1=411(n), 412(h+/-), 413(gamma), 414(e+mu) C X-Y ISODOSE: ID = ID1+1000*(NSUR-1) C ID1=415 - ENERGY DEPOSITION (mW/g) at AINT (p/s) C ID1=416 - DOSE EQUIVALENT FTD (mSv/hr) at AINT (p/s) C ID1=417 - DOSE EQUIVALENT DIRECT (mSv/hr) at AINT (p/s) C NEUTRINO ENERGY SPECTRA: ID = ID1+1000*(NSUR-1) C ID1=418(numu), 419(anumu), 420(nue), 421(anue) C C NUMH1=1 (DEFAULT) C C IHTYP=5 SPECTRA, FLUENCE AND DOSE EQUIVALENT C IHTYP=6 TIME SPECTRA IN (TMIN-TMAX) INTERVAL (sec) C HISTOGRAMS ARE UNIFORM IN 80 BINS (in nsec!) C C!!! IMPORTANT !!! C UP TO 100 CYLINDRICAL (ALONG Z-AXIS) OR X-Y (PERPENDICULAR TO C Z-AXIS) SURFACES C!!! IMPORTANT !!! C C PARTICLE SPECTRA HISTOGRAMMING IN NEBIN=80 BINS: 75 LOG + 5 LIN C NEUTRONS: 28 (1.E-12 - 0.0145) + 52 (0.0145 - E0) GEV C OTHERS: 80 (5.E-4 - E0) GEV C C IF(E0<0.0145 GEV) THEN C NEBIN=28 LOG BINS: C NEUTRONS: 28 (1.E-12 - 0.0145) GEV C OTHERS: 28 (5.E-4 - 0.0145) GEV C C NHSPE=0 - dN/dE, DIVIDED BY DEL=DELTA(E) IN (1/CM2/GEV) C E*dN/dE, FOR L.E. NEUTRONS IN (1/CM2) C NHSPE=1 - E*dN/dE, FOR ALL PARTICLES IN (1/CM2) C C ALL HISTOGRAMS DIVIDED BY VOLUME, SURFACE AREA, OR/AND DELTA_E ! C C DELVOL = 2*PI*R*(RMA-RMI)*(ZMA-ZMI)/NZBIN/NRBIN = DVOL*R C C ND >0: LOCAL ESTIMATION IN ND DETECTORS FOR L.E.NEUTRONS C C IPHOTO=0 - SAMPLED PHOTOREACTIONS C IPHOTO=1 - FORCED PHOTOREACTIONS C C EXCLUSIVE CASCADE-EXCITON MODEL CEM95(98) USED AT ICEM=1 C C CALL RM48IN(IJKLIN,NTOTIN,NTOT2N) initializes the generator from C one 64-bit integer IJLKIN (Default: 54217137; shift example: C 64217136), and number counts NTOTIN,NTOT2N C (for initializing, set N1=N2=0, but to restart a previously C generated sequence, use values output by RM48UT) C CALL RM48UT(IJKLIN,NTOTIN,NTOT2N) outputs the value of the original C seed and the two number counts, to be used for restarting by C initializing to IJKLIN and skipping C NTOT2N*100000000+NTOTIN numbers. C C*** EVENT GENERATOR AT IEVT > 0 ************************ C CALL EVTGEN(IEVT,ITDNDY,ITDNDX,NEVBIN) C C IEVT=IM (MATERIAL INDEX) C C ITDNDY: 1 - NO DN/DY CALCULATIONS (DEFAULT) C 2 - DN/DY CALCULATIONS C 3 - DN/DMT CALCULATIONS C C ITDNDX: 1 - NO DN/DE OR DN/DX CALCULATIONS C 2 - DN/DE CALCULATIONS (DEFAULT) C 3 - DN/DX CALCULATIONS C 4 - DN/DX CALCULATIONS (DPMJET LIKE) C C NEVBIN - THE NUMBER OF ENERGY BINS AT ITDNDX=2 (DEFAULT: 50) C******************************************************** C........................................................ IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) CHARACTER*(*) INPNAM,OUTNAM,HBKNAM LOGICAL IND EXTERNAL BLOCK1,BLOCK2,MASNSG,SIBNAB,BLGAMM,MAT_DEDX,MALYSHEV EXTERNAL CAMERON,CAMER70,BD1,BD2,BNUDOZ,BARPOA,BD2M INCLUDE 'biount.inc' COMMON & /BLINT1/IBEAM,IO,IEDEP,NTIME,NDET,NOB,NHSPE,NF,NFZ,NTPL,NDM & ,ILEN,NSURF,NTOFF,IDPSUR(12) : /BLSEED/IJKLIN,NTOTIN,NTOT2N : /LOGIND/IND(20) : /HIST/NI,NSTOP,NUPRI,NHIPR : /BVOBL/IDOS,NVOBL,NPOINT,NPACT & /BIPK/EFLU,EEGHM,IPAR,KPHA,IXCL,INUFR,ISOURCE,IDNDX & /BLCTRL/IVIS,IEVT CCH REAL H,EDGLBM COMMON & /BHBOO3/EDGLBL(5),EDGLBM(3,5),IDGLED(5),NEGLED,NHBK PARAMETER (LUNHIST=40) PARAMETER (NH=4000000) COMMON/PAWC/H(NH) CCH PARAMETER (ITDNDY=2) PARAMETER (ITDNDX=2) PARAMETER (NEVBIN=50) C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C C I/O UNITS: C NRCLOS= 1 READ&CLOSE: GEOM.INP (GREAD) C NRCLOS= 1 READ&CLOSE: *.NDT (FREADN) C NRCLOS= 1 READ&CLOSE: MARACT.INP (MARACT) C NRCLOS= 1 WRITE&CLOSE: DUMP (DUMP) C NRCLOS= 1 WRITE&CLOSE: GEOM.DAT (MAIN,GEOMTS) C NWANS= 2 WRITE: ANSYS.ED (SERVN) C NWNEUN= 3 WRITE: NEUTRINO (DECAY,DECMUN) C UNIT= 4 READ: DIP MAP (SUFI) C UNIT= 6 WRITE: SCREEN (INTERMEDIATE) C UNIT= 7 READ: DTU.EVE (BEG1) C NWMJL= 12 WRITE: EDMJL.GRA (SERVN) C NWPSI= 13 WRITE: PSINEU.GRA (SERVN,NEUOUT) C NWPSI= 14 WRITE: LENEUTRONS (BEGINN,MARSON) C NREAD= 15 READ: MARS.INP (BEGINN) C NWR= 16 WRITE: MARS.OUT (BEGINN,SERVN,NEUOUT,MUOUT) C NWEGH= 17 WRITE: MUON.EGH (RAYMU) C NWEGH= 18 WRITE: TRACK.PLOT (REGION) C NWEGH= 19 WRITE: VERTEX.PLOT(RAYN,RAYMU,EMTRAC,CLENMA,THRESH) C NWEGH= 20 WRITE: MUON.PLOT (RAYMU) C UNIT= 30 WRITE: fort.30 SIGNALS C UNIT= 36 WRITE: fort.36 VFAN VOLUMES AND FIELD MAP TEST PRINTOUT C LUNHIST=40 WRITE: mars.hbook HBOOK C UNIT= 65 WRITE: MTUPLE STANDARD GEOMETRY OUTPUT AT IND(1)=T C UNIT= 66 WRITE: MTUPLE-NON NON-STANDARD GEOMETRY OUTPUT C WRITE: surfdet.test INITIALIZATION PRINTOUT FOR SURFACE DETECTORS C UNIT= 79 WRITE: FIRST 30000 SYNCHROTRON PHOTONS GENERATED C UNIT=81-90 WRITE: fort.81 - fort.90 RESERVED FOR SURFACE DETECTOR FILES INCLUDE 'azwmat.inc' INCLUDE 'blreg1.inc' INCLUDE 'cmasnsg.inc' INCLUDE 'tally1.inc' INCLUDE 'tally2.inc' COMMON : /BLZTAG/ZORIG,PHIT,XHIT,YHIT,ZHIT,JHIT & /BEAM/SIXX,SIYY,SITX,SITY,DLBNCH, & XINI,YINI,ZINI,DXIN,DYIN,DZIN,WINIT,EFF : /BG/E0,ELEAK(3),ELGA,ELEN,ELEAMU,ENEUNO,ALIO(3),BLEAK(3,2) & /BDNDP/DNDP(8,200,7),THETA(8),DELTAP DIMENSION YIE(8) COMMON/LEAKPI/WLEAK1,WLEAK2,CLARM1,CLARM2,CLARM3,CLARM4, &BBZZ1,RAPER1,BBZZ2,RAPER2 WLEAK1=0.D0 WLEAK2=0.D0 CLARM1=0.D0 CLARM2=0.D0 CLARM3=0.D0 CLARM4=0.D0 C!!!!!!!!!!!!!!!!!!!!!!!!!!!! BBZZ1 =20.00D0 ! B0 BBZZ2 =0.050D0 ! K (cm^-1) RAPER1=7.5D0 RAPER2=30.D0 C!!!!!!!!!!!!!!!!!!!!!!!!!!!! OPEN (UNIT=42,FILE='DNDP', STATUS='UNKNOWN') C+++++++++++++++++++++++++++++++++++++++++++++++++++++++ OPEN (UNIT=NREAD,FILE=INPNAM,STATUS='OLD') OPEN (UNIT=NWR, FILE=OUTNAM,STATUS='UNKNOWN') CALL BEGINN IF (IVIS.NE.0) THEN CALL HLIMIT(NH) CALL STTCL(IVIS,INPNAM) ELSE IF(IEVT.GT.0) THEN CALL EVTGEN(IEVT,ITDNDY,ITDNDX,NEVBIN) ELSE CALL INITNT() CALL INITEMS( 'EMS.TEST' ) *** CALL INITEMS( '' ) C+++ TARGETS +++ XHIT=0.D0 ! PI+ YHIT=0.D0 ! PI- THETA(1)=0.01D0 THETA(2)=0.02D0 THETA(3)=0.05D0 THETA(4)=0.1D0 THETA(5)=0.2D0 THETA(6)=0.5D0 THETA(7)=1.5707963D0 THETA(8)=3.1415927D0 P0=SQRT(E0*(E0+2.D0*PM(1))) DELTAP=P0/200.D0 DO L1=1,7 DO L2=1,200 DO L3=1,8 DNDP(L3,L2,L1)=0.D0 END DO END DO END DO C+++++++++++++++ IF(NOB.GT.0.OR.NSURF.GT.0.OR.NHBK.GT.0) THEN CALL HLIMIT(NH) CALL HROPEN (LUNHIST,'HBOOK',HBKNAM,'N',1024,ISTAT) CALL MHISET CALL HIDOPT(0,'STAT') END IF CALL MARSON C+++ TARGETS +++ WLEAK1=WLEAK1/NI WLEAK2=WLEAK2/NI WRITE(42,150)BBZZ1,BBZZ2,RAPER1,RAPER2,WLEAK1,WLEAK2 150 FORMAT('# BZ1(T) = ',F5.1,' K(cm^-1) = ',F6.3, &' RAPER1(CM) = ',F5.1,' RAPER2(CM) = ',F5.1/ &'# Momentum cut: 0.05 < p < 0.8 GeV/c'/ &'# Yield: pi+/K+/mu+, pi-/K-/mu- =',3X,2F9.4/) CLARM1=CLARM1/NI CLARM2=CLARM2/NI CLARM3=CLARM3/NI CLARM4=CLARM4/NI WRITE(42,151)CLARM1,CLARM2,CLARM3,CLARM4 151 FORMAT( &'# 200 MeV cut: pi+ + K+, p- + K- =',3X,2F9.4/ &'# 200 MeV cut: mu+, mu- = ',3X,2F9.4/) DO L1=1,7 P1=-DELTAP*0.5D0 CALL VZEROD(YIE,8) WRITE(42,102)AT(1),ZMAX,DXIN,DYIN,SIXX,SIYY,P0,L1,THETA 102 FORMAT('# Tilted Jet in FS-2 Solenoid, January 2001'/ & '# Target A =',F7.2,' L (cm) = ',F10.2/ & '# DXIN, DYIN = ',2F8.5/ & '# Proton beam SIXX, SIYY (CM) = ',2F8.3/ & '# P0(GEV/C)= ',F8.2,' JJ= ',I2/ & '# dN/dp (1/GeV/c per 1 incident p)'/ & '# P(GeV/c) TH(rad)< ',8(1PE12.4)/'#') DO L2=1,200 P1=P1+DELTAP DO L3=1,8 IF(L3.EQ.1) THEN W1=DNDP(L3,L2,L1)/NI ELSE W1=DNDP(L3,L2,L1)/NI+DNDP(L3-1,L2,L1) END IF IF(W1.EQ.0.D0) W1=1.D-31 YIE(L3)=YIE(L3)+W1 DNDP(L3,L2,L1)=W1 END DO DO L3=1,8 DNDP(L3,L2,L1)=DNDP(L3,L2,L1)/DELTAP END DO WRITE(42,103)P1,(DNDP(L3,L2,L1),L3=1,8) 103 FORMAT(1X,F10.4,9X,8(1PE12.4)) END DO WRITE(42,104)YIE 104 FORMAT('#'/'# TOTAL = ',10X,8(1PE12.4)//) END DO C+++++++++++++++ CALL SERVN IF(NOB.GT.0.OR.NSURF.GT.0.OR.NHBK.GT.0) THEN CALL HCDIR ('//HBOOK',' ') CALL HROUT (0,ICYCLE, ' ') CALL HREND ('HBOOK') CLOSE (UNIT=LUNHIST) END IF CALL MTUPLE CALL RM48UT(IJKLIN,NTOTIN,NTOT2N) !!! CALL SHOWDUMP() END IF END C------------------------------------------------------------ SUBROUTINE MIXTUR(I,MIX,AMIX,ZMIX,WMIX) C........................................... C DEFINES THE COMPOSITION OF THE COMPOUND C INPUT: I - MATERIAL INDEX C OUTPUT: C MIX - NUMBER OF COMPONENTS (2<= M <= 20) IN MATERIAL 'I' C AMIX,ZMIX - ATOMIC MASSES AND NUMBERS OF COMPONENTS C WMIX - WEIGHT FRACTIONS C AMOL=SUM(P_k*A_k), WHERE P_k IS THE NUMBER OF k-ATOMS C WMIX_k = P_k*A_k/AMOL C C REVISION: 13-JUN-2002 C........................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) DIMENSION AMIX(*),ZMIX(*),WMIX(*) IF(I.EQ.3.OR.I.EQ.15.OR.I.EQ.16) THEN CCC=== MIX1: RESISTIVE MAGNET 0.9 CU + 0.1 WATER (old bitter)=== C=== MIX1: JHF HOLLOW CONDUCTOR INSULATED WITH MgO === C 0.19 Water + 0.25 MgO + 0.56 Cu + 9% void MIX=4 AMIX(1)=1.00794D0 AMIX(2)=15.9994D0 AMIX(3)=24.3050D0 AMIX(4)=63.5460D0 ZMIX(1)=1.D0 ZMIX(2)=8.D0 ZMIX(3)=12.D0 ZMIX(4)=29.D0 AMOL=2.D0*AMIX(1)+AMIX(2) WMIX(1)=0.19D0*2.D0*AMIX(1)/AMOL WO1=0.19D0*AMIX(2)/AMOL AMOL=AMIX(2)+AMIX(3) WMIX(2)=WO1+0.25D0*AMIX(2)/AMOL WMIX(3)=0.25D0*AMIX(3)/AMOL WMIX(4)=0.56D0 HCNST=WMIX(1) ELSE IF(I.EQ.4) THEN C=== MIX2: 0.5 CERAMIC (Al2O3) + 0.5 WATER === MIX=3 AMIX(1)=1.00794D0 AMIX(2)=15.9994D0 AMIX(3)=26.981539D0 ZMIX(1)=1.D0 ZMIX(2)=8.D0 ZMIX(3)=13.D0 AMOL=2.D0*AMIX(1)+AMIX(2) WMIX(1)=0.5D0*2.D0*AMIX(1)/AMOL WMIX(2)=0.5D0*AMIX(2)/AMOL AMOL=3.D0*AMIX(2)+2.D0*AMIX(3) WMIX(2)=0.5D0*3.D0*AMIX(2)/AMOL + WMIX(2) WMIX(3)=0.5D0*2.D0*AMIX(3)/AMOL HCNST=WMIX(1) ELSE IF(I.EQ.5.OR.I.EQ.17.OR.I.EQ.18.OR.I.EQ.19) THEN CCC=== MIX3: 0.7 WC + 0.3 WATER === (original) C=== MIX3: 0.8 WC + 0.2 WATER === MIX=4 AMIX(1)=1.00794D0 AMIX(2)=15.9994D0 AMIX(3)=183.840D0 AMIX(4)=12.0110D0 ZMIX(1)=1.D0 ZMIX(2)=8.D0 ZMIX(3)=74.D0 ZMIX(4)=6.D0 AMOL=2.D0*AMIX(1)+AMIX(2) WMIX(1)=0.2D0*2.D0*AMIX(1)/AMOL WMIX(2)=0.2D0*AMIX(2)/AMOL AMOL=AMIX(3)+AMIX(4) WMIX(3)=0.8D0*AMIX(3)/AMOL WMIX(4)=0.8D0*AMIX(4)/AMOL HCNST=WMIX(1) ELSE IF(I.EQ.6) THEN C=== MIX4: 0.7 H402C5 (MYLAR) + 0.3 AL === MIX=4 AMIX(1)=1.00794D0 AMIX(2)=15.9994D0 AMIX(3)=12.0110D0 AMIX(4)=26.981539D0 ZMIX(1)=1.D0 ZMIX(2)=8.D0 ZMIX(3)=6.D0 ZMIX(4)=13.D0 AMOL=4.D0*AMIX(1)+2.D0*AMIX(2)+5.D0*AMIX(3) WMIX(1)=0.7D0*4.D0*AMIX(1)/AMOL WMIX(2)=0.7D0*2.D0*AMIX(2)/AMOL WMIX(3)=0.7D0*5.D0*AMIX(3)/AMOL WMIX(4)=0.3D0 HCNST=WMIX(1) ELSE IF(I.EQ.7) THEN C=== MIX5: 0.33 STST + 0.21 CU + 0.1 SCC + 0.2 HE + 0.16 G10 (GFRP) === MIX=14 *** HE *** AMIX(1)=4.002602D0 ZMIX(1)=2.D0 *** CU *** AMIX(2)=63.5460D0 ZMIX(2)=29.D0 *** G10 *** AMIX(3)=1.00794D0 AMIX(4)=12.011D0 AMIX(5)=15.9994D0 AMIX(6)=28.0855D0 AMIX(7)=35.4527D0 ZMIX(3)= 1.D0 ZMIX(4)= 6.D0 ZMIX(5)= 8.D0 ZMIX(6)=14.D0 ZMIX(7)=17.D0 W3=0.066D0 W4=0.268D0 W5=0.417D0 W6=0.220D0 W7=0.029D0 *** STST *** AMIX(8) =51.9961D0 AMIX(9) =54.93805D0 AMIX(10)=55.8450D0 AMIX(11)=58.6934D0 ZMIX(8) =24.D0 ZMIX(9) =25.D0 ZMIX(10)=26.D0 ZMIX(11)=28.D0 W8 =0.190D0 W9 =0.010D0 W10=0.700D0 W11=0.100D0 *** SCC = 0.23 Nb3Sn + 0.69 CuSn + 0.065 Ta + 0.015 Void *** * -> 0.24 Nb3Sn + 0.70 CuSn + 0.06 Ta *** AMIX(12)= 92.90638D0 AMIX(13)=118.710D0 AMIX(14)=180.9479D0 ZMIX(12)=41.D0 ZMIX(13)=50.D0 ZMIX(14)=73.D0 AMOL=3.D0*AMIX(12)+AMIX(13) W12 =0.23D0*3.D0*AMIX(12)/AMOL W13 =0.23D0*AMIX(13)/AMOL AMOL=AMIX(2)+AMIX(13) WCU =0.69D0*AMIX(2)/AMOL WSN =0.69D0*AMIX(13)/AMOL WTA =0.06D0 *** MIX5: 0.33 STST + 0.21 CU + 0.1 SCC + 0.2 HE + 0.16 G10 (GFRP) *** WMIX(1)=0.2D0 ! He WMIX(2)=0.21D0+WCU*0.1D0 ! Cu WMIX(3)=0.16D0*W3 ! H WMIX(4)=0.16D0*W4 ! C WMIX(5)=0.16D0*W5 ! O WMIX(6)=0.16D0*W6 ! Si WMIX(7)=0.16D0*W7 ! Cl WMIX(8) =0.33D0*W8 ! Cr WMIX(9) =0.33D0*W9 ! Mn WMIX(10)=0.33D0*W10 ! Fe WMIX(11)=0.33D0*W11 ! Ni WMIX(12)=0.10D0*W12 ! Nb WMIX(13)=0.10D0*(W13+WSN) ! Sn WMIX(14)=0.10D0*WTA ! Ta HCNST=WMIX(3) ELSE IF(I.EQ.8) THEN C=== MIX6: 0.5 * (0.7 H402C5 (MYLAR) + 0.3 AL) + 0.5 FE === MIX=5 AMIX(1)=1.00794D0 AMIX(2)=15.9994D0 AMIX(3)=12.0110D0 AMIX(4)=26.981539D0 AMIX(5)=55.8450D0 ZMIX(1)=1.D0 ZMIX(2)=8.D0 ZMIX(3)=6.D0 ZMIX(4)=13.D0 ZMIX(5)=26.D0 AMOL=4.D0*AMIX(1)+2.D0*AMIX(2)+5.D0*AMIX(3) WMIX(1)=0.5D0*0.7D0*4.D0*AMIX(1)/AMOL WMIX(2)=0.5D0*0.7D0*2.D0*AMIX(2)/AMOL WMIX(3)=0.5D0*0.7D0*5.D0*AMIX(3)/AMOL WMIX(4)=0.5D0*0.3D0 WMIX(5)=0.5D0 HCNST=WMIX(1) ELSE IF(I.EQ.14) THEN C=== MIX7: 0.64 Fe + 0.36 Co === MIX=2 AMIX(1)=55.8450D0 AMIX(2)=58.9332D0 ZMIX(1)=26.D0 ZMIX(2)=27.D0 WMIX(1)=0.64D0 WMIX(2)=0.36D0 ELSE IF(I.EQ.20.OR.I.EQ.26) THEN C=== MIX8: 0.7 Cu + 0.3 Water === MIX=3 AMIX(1)=1.00794D0 AMIX(2)=15.9994D0 AMIX(3)=63.5460D0 ZMIX(1)=1.D0 ZMIX(2)=8.D0 ZMIX(3)=29.D0 AMOL=2.D0*AMIX(1)+AMIX(2) WMIX(1)=0.3D0*2.D0*AMIX(1)/AMOL WMIX(2)=0.3D0*AMIX(2)/AMOL WMIX(3)=0.7D0 HCNST=WMIX(1) END IF RETURN END C------------------------------------------------------------ SUBROUTINE BEG1(JJ,W,E,X,Y,Z,DCX,DCY,DCZ,TOFF,INTA,NREG1) C........................................... C RE-DEFINES EACH OR ANY OF THE 12 PARAMETERS C OF INITIAL SOURCE PARTICLES C C ARRANGE A POINT-LIKE INTERACTION IF INTA=1 C C ONE CAN DEFINE NREG1 - THE SOURCE REGION NUMBER C (TYPICALLY FOR NEUTRINO SCORING) C C PARTICLE TAGGING IN 'MTAGG' SOURCE ZONES OF 'ETGG' ENERGY C INTERVALS FOR 'NTAGG' DETECTOR ZONES C DEFAULTS: NUMTAG=6, MTAGG=0, INTAG=1, IETAG=4 C C REVISION: 01-JUN-2001 C C........................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) LOGICAL IND INCLUDE 'azwmat.inc' INCLUDE 'biount.inc' INCLUDE 'blreg1.inc' INCLUDE 'cmasnsg.inc' * INCLUDE 'tally2.inc' COMMON/MATINT/IM : /LOGIND/IND(20) : /BLZTAG/ZORIG,PHIT,XHIT,YHIT,ZHIT,JHIT : /BG/E0,ELEAK(3),ELGA,ELEN,ELEAMU,ENEUNO,ALIO(3),BLEAK(3,2) : /BLTOFF/TOFMIN,TOFMAX,TOFSHF : /SELEC2/CS,SS,CH,SH : /HIST/NI,NSTOP,NUPRI,NHIPR * PARAMETER (CLIGHT=29979245800.D0) * PARAMETER (PI=3.141592653589793227D+00) C- - - - - - - - - - - - - - - - - - - - - - - - - - - - C+++ INSERT YOUR SOURCE TERM HERE +++ C READ()...,W1,... C W=W*W1 C++++++++++++++++++++++++++++++++++++ RETURN END C------------------------------------------------------------ SUBROUTINE REG1(X,Y,Z,N,NIM) C........................................... C USER NON-STANDARD GEOMETRY MODULE REG1 C C FINDS A ZONE NUMBER "N" AND FILLS MATIND(N) FOR C A GIVEN POINT IN A NON-STANDARD SECTOR C N = NFZPEX + M, C WHERE M IS LOCAL NON-STANDARD ZONE NUMBER DEFINED BY USER C "M" NEED NOT TO BE A NON-GAP SEQUENCE C M_MAX - MAXIMUM LOCAL NON-STANDARD ZONE NUMBER DEFINED BY USER !!! C C INPUT: C X, Y, Z C NFZPEX - TOTAL NUMBER OF ZONES IN STANDARD+EXTENDED GEOMETRY C OUTPUT: C N - ZONE NUMBER, NFZPEX < N <= NCELMX <= NTALLY (=50001) !!! C N < 0 DEFINES NUMBERED BLACKHOLE (LEAKAGE OUT OF THE SYSTEM) C IN NON-STANDARD SECTOR C NIM - GEOMETRICAL SUB-SUBREGION NUMBER, 0 < NIM < 1.E6 C NCELMX - MAXIMUM ZONE NUMBER, NCELMX = NFZPEX + M_MAX <= NTALLY C MATIND(N) = MAT C C FS-2-2: Hg (100mrad)+Beam(67mrad) C C Version: 14-FEB-2001 C REVISION: 13-JUN-2002 C C........................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) INCLUDE 'blreg1.inc' INCLUDE 'tally1.inc' COMMON & /BEAM/SIXX,SIYY,SITX,SITY,DLBNCH, & XINI,YINI,ZINI,DXIN,DYIN,DZIN,WINIT,EFF & /LEAKPI/WLEAK1,WLEAK2,CLARM1,CLARM2,CLARM3,CLARM4, & BBZZ1,RAPER1,BBZZ2,RAPER2 SAVE NENTER DATA NENTER/0/ C=== Put actual max local non-standard zone number here !!! * PARAMETER (M_MAX=0) PARAMETER (M_MAX=341) C+++ Don't touch !!! +++++++++++++++++ PARAMETER (M_MAX1=M_MAX+1) CHARACTER*8 VNAME,VNAMEBUF DIMENSION IMUN(1:M_MAX1) ! buffer material indices DATA IMUN(M_MAX1)/0/,INCREM/1/ DATA VNAMEBUF/'NO_NAME '/ C+++++++++++++++++++++++++++++++++++++ C=== Uncomment and define all material indecies (1 to M_MAX) for non-standard zones here !!! C DATA (IMUN(I),I=1,M_MAX)// DATA (IMUN(I),I=1,M_MAX)/ & 0, 1, 0, 0, 0, 2, 0, 2,18, 8,17,12,14, 0, 2, 8,12,14, 0,12, ! 20 &13, 0, 8, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, ! 40 & 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, ! 60 & 7, 7, 7, 8,22,12,19, 0, 8, 8, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, ! 80 & 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, ! 100 & 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8,22,12,19, 0, 8, 8, 7, 7, 7, ! 120 & 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, ! 140 & 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8,22,12, ! 160 &19, 0, 8, 8, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, ! 180 & 7, 7, 7, 7, 8,22,12, 0, 0, 2,20, 0, 8,25, 8,27,12, 0, 0, 8, ! 200 &25, 8,27,12, 0, 0, 8,25, 8,27,12, 0, 0, 8,25, 8,27,12, 0, 0, ! 220 & 8,25, 8,27,12, 0,17,13,23, 0,23,14,14, 0,23,14,14, 0, 0,24, ! 240 & 0, 0,23, 0,14,14, 0, 8,25, 8,27,12, 0, 0, 8,25, 8,27,12, 0, ! 260 &26, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ! 280 & 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ! 300 &18, 0, 0,28,6*29, ! 310 & 8,25, 8,27, ! 311-314 SC14 & 8,25, 8,27, ! 315-318 SC15 & 8,25, 8,27, ! 319-322 SC16 & 8,25, 8,27, ! 323-326 SC17 & 8,25, 8,27, ! 327-330 SC18 & 5*20,6*26/ ! 331-335, 336-341 C 1 2 3 4 5 6 7 8 9 10 CMATR 'HG' 'STST' 'MIX1' 'MIX2' 'MIX3' 'MIX4' 'MIX5' 'MIX6' 'G10' 'CU' C 11 12 13 14 15 16 17 18 19 20 C 'HE' 'AIR' 'YOKE' 'MIX7' 'MIX1' 'MIX1' 'MIX3' 'MIX3' 'MIX3' 'MIX8' C 21 22 23 24 25 26 27 28 29 C CONC STST HG HG SCON MIX8 AL HG BE PARAMETER (THSS1 = 1.D0) *** PARAMETER (DW1 = 30.D0) PARAMETER (PI=3.141592653589793227D+00) PARAMETER (NF1=20) COMMON/BSCPHI/PHI(20),CPHI(20) PARAMETER (ZSPECIA0= 20.D0) *** PARAMETER (ZSPECIA1= 700.D0) PARAMETER (ZSPECIA1= 610.3D0) PARAMETER (ZSPECIA2=1862.D0) PARAMETER (TANBEAM=0.067100435D0) ! =TAN(0.067D0), Beam tilt angle PARAMETER (TANJET =0.10033467D0) ! =TAN(0.1D0), Jet tilt angle PARAMETER (DLZTAR=5.D0) *** PARAMETER (ZTAR1=-30.D0) ! "Target" start (cm) *** PARAMETER (ZTAR2= 0.D0) ! "Target" end (cm) PARAMETER (ZCENT=-15.D0) ! "Target" center (cm) PARAMETER (RHOLEB= 0.75D0) ! Beam hole PARAMETER (BETHICK=0.2D0) ! Be-window thickness PARAMETER (BEDELTR=3.0D0) ! Be-window Delta_R PARAMETER (DELZ14=300.D0) ! SC14-SC18 C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - M=0 VNAME=VNAMEBUF IF(NENTER.EQ.0) THEN PHI(1) = 5.D0 PHI(2) = 15.D0 PHI(3) = 45.D0 PHI(4) = 75.D0 PHI(5) = 85.D0 PHI(6) = 95.D0 PHI(7) =105.D0 PHI(8) =135.D0 PHI(9) =165.D0 PHI(10)=175.D0 PHI(11)=185.D0 PHI(12)=195.D0 PHI(13)=225.D0 PHI(14)=255.D0 PHI(15)=265.D0 PHI(16)=275.D0 PHI(17)=285.D0 PHI(18)=315.D0 PHI(19)=345.D0 PHI(20)=355.D0 DO I=1,NF1 FI=PI*PHI(I)/180.D0 CPHI(I)=1.D0 IF(PHI(I).GT.1.D-4) CPHI(I)=COS(FI) IF(PHI(I).GT.180.D0) CPHI(I)=-2.D0-CPHI(I) END DO CALL REG3 NCELMX = NFZPEX+M_MAX NENTER=1 IF(M_MAX.EQ.0) INCREM=-1 IF(M_MAX.GT.0) THEN INUG=1 WRITE(*,*)'There are non-standard zones M_MAX= ',M_MAX DO L=1,M_MAX,INCREM MATIND(NFZPEX+L)=IMUN(L) VOLNM (NFZPEX+L)=VNAMEBUF END DO NVTEST=1 CALL VFAN(NVTEST,V) ELSE INUG=0 WRITE(*,*)'There are no non-standard zones in this run !' RETURN END IF END IF C=================================================================== C+++ INSERT YOUR NON-STANDARD ZONE NUMBER FINDING ALGORITHM HERE +++ RSQ=X*X+Y*Y R=SQRT(RSQ) *** IF(R.GE.60.D0) GO TO 300 ABY=ABS(Y) R1=SCR(2) ! Jet target radius RHOLEJ=R1 ! Jet hole radius R2=RAPER1 *** R3=RAPER2 BBZZ5=((RAPER2/RAPER1)**2-1.D0)/ZSPECIA2 RAP50= -R2*SQRT(1.D0+BBZZ5*50.D0) *** X1=X-(Z-ZCENT)*DXIN/DZIN X1=X+(Z-ZCENT)*TANJET RJET=SQRT(X1*X1+Y*Y) X1=X+(Z-ZCENT)*TANBEAM RBEAM=SQRT(X1*X1+Y*Y) IF(Z.LT.-135.D0) THEN IF(R.LT.75.D0) THEN IF(RBEAM.LT.RHOLEB) THEN M=22 ! beam vac 1 ELSE IF(RJET.LT.RHOLEJ) THEN M=229 ! jet 23 ELSE M=21 ! yoke, 13 IF(Y.LT.0.D0) M=228 ! yoke, 13 END IF ELSE M=20 ! air, 12 END IF GO TO 300 ELSE IF(Z.GE.-135.D0.AND.Z.LT.-125.D0) THEN IF(R.GE.63.58D0.AND.R.LT.133.2) THEN M=16 ! mix6, 8 ELSE IF(R.LT.50.51D0) THEN IF(RJET.LT.RHOLEJ) THEN M=231 ! jet 23 ELSE IF(RBEAM.LT.RHOLEB) THEN M=230 ! beam vac 2 ELSE M=232 ! mix7, 14 IF(Y.LT.0.D0) M=233 ! mix7, 14 END IF END IF GO TO 300 ELSE IF(Z.GE.-125.D0.AND.Z.LT.-79.D0) THEN IF(R.LT.50.51D0) THEN IF(RJET.LT.RHOLEJ) THEN M=231 ! jet 23 ELSE IF(RBEAM.LT.RHOLEB) THEN M=230 ! beam vac 2 ELSE M=232 ! mix7, 14 IF(Y.LT.0.D0) M=233 ! mix7, 14 END IF END IF GO TO 300 ELSE IF(Z.GE.-79.D0.AND.Z.LT.-71.2D0) THEN IF(R.LT.50.51D0) THEN IF(RJET.LT.RHOLEJ) THEN M=235 ! jet 23 ELSE IF(RBEAM.LT.RHOLEB) THEN M=234 ! beam vac 2 ELSE M=236 ! mix7, 14 IF(Y.LT.0.D0) M=237 ! mix7, 14 END IF IF(R.GT.17.3D0) THEN M=17 ! air, 12 END IF END IF GO TO 300 ELSE IF(Z.GE.-71.2D0.AND.Z.LT.-45.D0) THEN IF(R.LT.R2) THEN IF(RJET.LT.RHOLEJ) THEN M=243 ! jet 23 ELSE IF(RBEAM.LT.RHOLEB) THEN M=244 ! beam vac 2 ELSE M=245 ! mix7, 14 IF(Y.LT.0.D0) M=246 ! mix7, 14 END IF END IF GO TO 300 ELSE IF(Z.GE.-45.D0.AND.Z.LT.0.D0) THEN IF(R.LT.R2) THEN IF(RJET.LT.R1) THEN M0=262 M=M0+INT((Z+45.D0)/DLZTAR) ! jet, 1, 0.0 < RJET < 0.1 cm IF(RJET.GE.0.1D0.AND.RJET.LT.0.3D0) THEN M=M+13 ! jet, 1, 0.1 < RJET < 0.3 cm ELSE IF(RJET.GE.0.3D0) THEN M=M+26 ! jet, 1, 0.3 < RJET < 0.5 cm END IF ELSE M=3 ! vac IF(Y.LT.0.D0) M=4 ! vac END IF END IF GO TO 300 ELSE IF(Z.GE.0.D0.AND.Z.LE.ZSPECIA0) THEN RAP =R2*SQRT(1.D0+BBZZ5*Z) IF(R.LT.RAP) THEN IF(RJET.LT.R1) THEN M0=262 M=M0+INT((Z+45.D0)/DLZTAR) ! jet, 1, 0.0 < RJET < 0.1 cm IF(RJET.GE.0.1D0.AND.RJET.LT.0.3D0) THEN M=M+13 ! jet, 1, 0.1 < RJET < 0.3 cm ELSE IF(RJET.GE.0.3D0) THEN M=M+26 ! jet, 1, 0.3 < RJET < 0.5 cm END IF ELSE M=238 ! vac IF(Y.LT.0.D0) M=239 ! vac END IF ELSE RSS1 =RAP +THSS1 IF(R.GE.RAP.AND.R.LT.RSS1) M=15 ! STST END IF GO TO 300 ELSE IF(Z.GE.ZSPECIA0.AND.Z.LT.135.7D0) THEN ! 20 - 135.7 cm IF(R.GT.17.3D0.AND.R.LT.50.51D0) THEN M=227 ! mix3, 17 IF(Z.LT.(ZSPECIA0+7.D0)) M=12 ! air GO TO 300 END IF RAP =R2*SQRT(1.D0+BBZZ5*Z) IF(R.LT.RAP) THEN IF(RJET.LT.R1) THEN M=240 ! jet, 24 ELSE M=241 ! vac IF(Y.LT.0.D0) M=242 ! vac END IF ELSE RSS1 =RAP +THSS1 IF(R.LT.RSS1) THEN M=8 ! SS ELSE IF(R.GE.RSS1.AND.R.LT.17.3D0) THEN M=11 ! mix3, 17 END IF C=== TOWARDS HG POOL === IF(ABY.LT.4.0D0.AND.Z.GT.50.D0) THEN XCONE=RAP50-(Z-50.D0)*TANJET IF(X.LT.-(RAP-THSS1).AND.X.GT.XCONE) THEN M=302 ! vac END IF IF(RJET.LT.R1) THEN M=240 ! jet, 24 END IF END IF END IF ELSE IF(Z.GE.135.7D0.AND.Z.LT.ZSPECIA1) THEN ! 135.7 - 610.3 cm RAP =R2*SQRT(1.D0+BBZZ5*Z) IF(R.LT.RAP) THEN M=7 ! Vac C=== BE-WINDOW === IF(Z.GE.(ZSPECIA1-BETHICK)) THEN M11=1+INT(R/BEDELTR) IF(M11.GT.6) M11=6 M=304+M11 ! Be, im=29 (305-310) END IF ELSE RSS1 =RAP +THSS1 *** RSW =RSS1 +DW1 RSW0=72.56D0 *** RSW1=60.08D0 RSW2=36.56D0 IF(R.LT.RSW2) THEN IF(R.LT.RSS1) THEN M=8 ! SS ELSE M=9 ! mix3, 18 END IF C=== TOWARDS HG POOL + POOL === IF(ABY.LT.4.0D0.AND.Z.LT.550.D0) THEN XCONE=RAP50-(Z-50.D0)*TANJET IF(X.LT.-(RAP-THSS1).AND.X.GT.XCONE) THEN IF(X.GT.-25.D0) THEN M=303 ! vac IF(RJET.LT.R1) THEN M=240 ! jet, 24 END IF ELSE M=304 ! Hg, im=28 END IF END IF END IF ELSE IF(Z.LT.606.5D0) THEN RSW=RSW2+(RSW0-RSW2)*(606.5D0-Z)/(606.5D0-135.7D0) IF(R.LT.RSW) THEN M=301 ! mix3, 18 GO TO 300 END IF END IF C=== PHI-BINNING FOR DELRSC ============ CC = 1.D0 IF ( R .GT. 1.D-7 ) THEN CC = X/R IF ( Y .LT. 0.0D0 ) THEN CC=-2.D0-CC ELSE IF ( Y .EQ. 0.0D0 ) THEN IF( CC .LT. 0.D0 ) THEN CC=-2.D0-CC ENDIF ENDIF ENDIF DO IF1 = 1, NF1 IF ( CC .GT. CPHI(IF1) ) GO TO 14 END DO IF1=NF1+1 IF(PHI(1) .NE. 0.D0) IF1=1 14 IF(PHI(1) .EQ. 0.D0) IF1=IF1-1 NABY=0 IF(X.LT.0.D0.AND.R.GT.10.D0) THEN IF(ABY.LT.1.D-40) ABY=1.D-40 IF((ABS(X)/ABY).GT.1.D0) THEN NABY=1 ! phi < 45 deg for dump at x < 0 END IF END IF C======================================= C=== SC3 === IF(Z.LT.245.6D0) THEN IF(Z.LT.145.7D0.AND.R.GT.56.95D0.AND. & R.LT.133.2D0) THEN M=10 ! mix6, 8 ELSE IF(R.GT.72.56D0) THEN IF(R.LT.77.56D0) THEN M=23 ! mix6, 8 ELSE IF(R.GE.77.56D0.AND.R.LT.98.75D0) THEN NR=1 IF(R.GT.79.56D0) NR=2 M=23+IF1+20*(NR-1) ! SC coil, mix5, 7, m=24-63 ELSE IF(R.GE.98.75D0.AND.R.LT.103.75D0) THEN M=64 ! mix6, 8 ELSE IF(R.GE.103.75D0.AND.R.LT.106.75D0) THEN M=65 ! stst2, 22 ELSE M=66 ! air, 12 END IF ELSE IF(NABY.EQ.1) THEN M=67 ! dump, mix3, 19 ELSE M=68 ! vac END IF END IF C=== SC4 === ELSE IF(Z.GE.245.6D0.AND.Z.LT.410.6D0) THEN IF(Z.LT.255.6D0.AND.R.GT.72.56D0.AND. & R.LT.106.75D0) THEN M=69 ! mix6, 8 ELSE IF(R.GT.72.56D0) THEN IF(R.LT.77.56D0) THEN M=70 ! mix6, 8 ELSE IF(R.GE.77.56D0.AND.R.LT.88.29D0) THEN NR=1 IF(R.GT.79.56D0) NR=2 M=70+IF1+20*(NR-1) ! SC coil, mix5, 7, m=71-110 ELSE IF(R.GE.88.29D0.AND.R.LT.93.29D0) THEN M=111 ! mix6, 8 ELSE IF(R.GE.93.29D0.AND.R.LT.96.29D0) THEN M=112 ! stst2, 22 ELSE M=113 ! air, 12 END IF ELSE IF(NABY.EQ.1) THEN M=114 ! dump, mix3, 19 ELSE M=115 ! vac END IF END IF C=== SC5 === ELSE IF(Z.GE.410.6D0.AND.Z.LT.606.5D0) THEN IF(Z.LT.420.6D0.AND.R.GT.72.56D0.AND. & R.LT.92.12D0) THEN M=116 ! mix6, 8 ELSE IF(R.GT.72.56D0) THEN IF(R.LT.77.56D0) THEN M=117 ! mix6, 8 ELSE IF(R.GE.77.56D0.AND.R.LT.84.12D0) THEN NR=1 IF(R.GT.79.56D0) NR=2 M=117+IF1+20*(NR-1) ! SC coil, mix5, 7, m=118-157 ELSE IF(R.GE.84.12D0.AND.R.LT.89.12D0) THEN M=158 ! mix6, 8 ELSE IF(R.GE.89.12D0.AND.R.LT.92.12D0) THEN M=159 ! stst2, 22 ELSE M=160 ! air, 12 END IF ELSE IF(NABY.EQ.1) THEN M=161 ! dump, mix3, 19 ELSE M=162 ! vac END IF C=== SC6-1 === IF(Z.GT.600.D0) THEN RS1 =38.D0 !!! RS5 =49.D0 !!! *** IF(R.GT.RS1.AND.R.LT.RS5) THEN IF(R.LT.RS5) THEN RS2 =41.56D0 !!! RS3 =46.69D0 !!! RS4 =48.D0 !!! IF(R.LT.RS2) THEN M=164 ! mix6, 8 ELSE IF(R.GE.RS2.AND.R.LT.RS3) THEN M=164+IF1 ! SC coil, mix5, 7, m=165-184 ELSE IF(R.GE.RS3.AND.R.LT.RS4) THEN M=185 ! mix6, 8 ELSE IF(R.GE.RS4.AND.R.LT.RS5) THEN M=186 ! stst2, 22 END IF END IF END IF END IF C=== SC6-2 === ELSE RS1 =38.D0 !!! RS2 =41.56D0 !!! RS3 =46.69D0 !!! RS4 =48.D0 !!! RS5 =49.D0 !!! IF(R.GT.RS5.AND.R.LT.92.12D0) THEN M=163 ! mix6, 8 ELSE IF(R.GT.36.56D0) THEN IF(R.LT.RS2) THEN M=164 ! mix6, 8 ELSE IF(R.GE.RS2.AND.R.LT.RS3) THEN M=164+IF1 ! SC coil, mix5, 7, m=165-184 ELSE IF(R.GE.RS3.AND.R.LT.RS4) THEN M=185 ! mix6, 8 ELSE IF(R.GE.RS4.AND.R.LT.RS5) THEN M=186 ! stst2, 22 ELSE M=187 ! air, 12 END IF ELSE M=188 ! vac END IF END IF END IF END IF ELSE IF(Z.GE.ZSPECIA1) THEN ! > 610.3 cm RS1 =39.D0 !!! RS2 =42.22D0 !!! RS4 =47.D0 !!! RS5 =48.D0 !!! IF(Z.LT.ZSPECIA2) THEN RAP =R2*SQRT(1.D0+BBZZ5*Z) ELSE RAP=RAPER2 END IF RSS1 =RAP +THSS1 IF(R.LT.RAP) THEN M=189 ! Vac ELSE IF(R.LT.RSS1) THEN M=190 ! SS ELSE C=== SC7 === IF(Z.LT.900.D0) THEN IF(R.LT.RS1) THEN M=191 ! mix8, 20 ELSE RS3 =45.09D0 IF(R.LT.RS2) THEN M=193 ! mix6, 8 ELSE IF(R.GE.RS2.AND.R.LT.RS3) THEN M=194 ! SC coil, scon, im=25 IF(Z.LT.627.5D0) M=192 ! vac ELSE IF(R.GE.RS3.AND.R.LT.RS4) THEN M=195 ! mix6, 8 ELSE IF(R.GE.RS4.AND.R.LT.RS5) THEN M=196 ! Al, im=27 ELSE M=197 ! air, 12 END IF END IF C=== SC8 === ELSE IF(Z.GE.900.D0.AND.Z.LT.1080.D0) THEN IF(R.LT.RS1) THEN M=331 ! mix8, 20 ELSE RS3 =44.49D0 IF(R.LT.RS2) THEN M=200 ! mix6, 8 ELSE IF(R.GE.RS2.AND.R.LT.RS3) THEN M=201 ! SC coil, scon, im=25 IF(Z.LT.905.D0) M=199 ! vac ELSE IF(R.GE.RS3.AND.R.LT.RS4) THEN M=202 ! mix6, 8 ELSE IF(R.GE.RS4.AND.R.LT.RS5) THEN M=203 ! Al, im=27 ELSE M=204 ! air, 12 END IF END IF C=== SC9 === ELSE IF(Z.GE.1080.D0.AND.Z.LT.1260.D0) THEN IF(R.LT.RS1) THEN M=332 ! mix8, 20 ELSE RS3 =44.15D0 IF(R.LT.RS2) THEN M=207 ! mix6, 8 ELSE IF(R.GE.RS2.AND.R.LT.RS3) THEN M=208 ! SC coil, scon, im=25 IF(Z.LT.1085.D0) M=206 ! vac ELSE IF(R.GE.RS3.AND.R.LT.RS4) THEN M=209 ! mix6, 8 ELSE IF(R.GE.RS4.AND.R.LT.RS5) THEN M=210 ! Al, im=27 ELSE M=211 ! air, 12 END IF END IF C=== SC10 === ELSE IF(Z.GE.1260.D0.AND.Z.LT.1440.D0) THEN IF(R.LT.RS1) THEN M=333 ! mix8, 20 ELSE RS3 =43.89D0 IF(R.LT.RS2) THEN M=214 ! mix6, 8 ELSE IF(R.GE.RS2.AND.R.LT.RS3) THEN M=215 ! SC coil, scon, im=25 IF(Z.LT.1265.D0) M=213 ! vac ELSE IF(R.GE.RS3.AND.R.LT.RS4) THEN M=216 ! mix6, 8 ELSE IF(R.GE.RS4.AND.R.LT.RS5) THEN M=217 ! Al, im=27 ELSE M=218 ! air, 12 END IF END IF C=== SC11 === ELSE IF(Z.GE.1440.D0.AND.Z.LT.1620.D0) THEN IF(R.LT.RS1) THEN M=334 ! mix8, 20 ELSE RS3 =43.70D0 IF(R.LT.RS2) THEN M=221 ! mix6, 8 ELSE IF(R.GE.RS2.AND.R.LT.RS3) THEN M=222 ! SC coil, scon, im=25 IF(Z.LT.1445.D0) M=220 ! vac ELSE IF(R.GE.RS3.AND.R.LT.RS4) THEN M=223 ! mix6, 8 ELSE IF(R.GE.RS4.AND.R.LT.RS5) THEN M=224 ! Al, im=27 ELSE M=225 ! air, 12 END IF END IF C=== SC12 === ELSE IF(Z.GE.1620.D0.AND.Z.LT.1862.D0) THEN IF(R.LT.RS1) THEN M=335 ! mix8, 20 ELSE RS3 =43.54D0 IF(R.LT.RS2) THEN M=248 ! mix6, 8 ELSE IF(R.GE.RS2.AND.R.LT.RS3) THEN M=249 ! SC coil, scon, im=25 IF(Z.LT.1625.D0) M=247 ! vac ELSE IF(R.GE.RS3.AND.R.LT.RS4) THEN M=250 ! mix6, 8 ELSE IF(R.GE.RS4.AND.R.LT.RS5) THEN M=251 ! Al, im=27 ELSE M=252 ! air, 12 END IF END IF C=== SC13, 1862 < Z < 2100 cm ELSE IF(Z.GE.1862.D0.AND.Z.LT.2100.D0) THEN IF(R.LT.RS1) THEN M=336 ! mix8, 26 ELSE RS3 =43.54D0 IF(R.LT.RS2) THEN M=255 ! mix6, 8 ELSE IF(R.GE.RS2.AND.R.LT.RS3) THEN M=256 ! SC coil, scon, im=25 IF(Z.LT.1867.D0) M=254 ! vac ELSE IF(R.GE.RS3.AND.R.LT.RS4) THEN M=257 ! mix6, 8 ELSE IF(R.GE.RS4.AND.R.LT.RS5) THEN M=258 ! Al, im=27 ELSE M=259 ! air, 12 END IF END IF C=== SC14, 2100 < Z < 3600 cm ELSE RS3 =43.54D0 Z1=Z-2100.D0 NZ1=1+INT(Z1/DELZ14) IF(NZ1.LT.1) NZ1=1 IF(NZ1.GT.5) NZ1=5 * Z14=5.D0+DELZ14*(NZ1-1) IF(R.LT.RS1) THEN M=337+(NZ1-1) ! mix8, 26 ELSE IF(R.LT.RS2) THEN M=311+4*(NZ1-1) ! mix6, 8 ELSE IF(R.GE.RS2.AND.R.LT.RS3) THEN M=312+4*(NZ1-1) ! SC coil, scon, im=25 ELSE IF(R.GE.RS3.AND.R.LT.RS4) THEN M=313+4*(NZ1-1) ! mix6, 8 ELSE IF(R.GE.RS4.AND.R.LT.RS5) THEN M=314+4*(NZ1-1) ! Al, im=27 ELSE M=259 ! air, 12 END IF END IF END IF END IF END IF 300 CONTINUE C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * *** Example 1: * IF(X...,Y...,Z...) THEN * M=1 ! Non-standard zone No. 1, add appropriate IM to IMUN * VNAME='Target ' * ELSE IF(X...,Y...,Z...) THEN * M=2 ! Non-standard zone No. 2, add appropriate IM to IMUN * VNAME='Can-5 ' * ELSE * M=-1 ! Non-standard blackhole No. -1, don't worry about IM * END IF * * Don't forget to define M_MAX as a parameter above ! * PARAMETER (M_MAX=2) * DATA (IMUN(I),I=1,M_MAX)/3,2/ ********************** * *** Example 2: * WRO=X*X+Y*Y * IF(WRO.GE.SR2(3).AND.WRO.LT.SR2(4)) THEN * DO M=1,10 * IF(Z.LT.SCZ(M+1)) GO TO 1 * END DO * M=10 * 1 CONTINUE * END IF * * Don't forget to define M_MAX as a parameter above ! * PARAMETER (M_MAX=10) * DATA (IMUN(I),I=1,M_MAX)/10*1/ ********************** * *** Example 3: * IF(Y.GT.0.D0.OR.X.LT.0.D0) RETURN ! Back to standard geometry * IF(Z.LT.19.D0.OR.Z.GT.69.D0) RETURN ! Back to standard geometry * M=1 * * Don't forget to define M_MAX as a parameter above ! * PARAMETER (M_MAX=1) * DATA (IMUN(I),I=1,M_MAX)/3/ ********************** C=================================================================== IF(M.GT.0) THEN N = NFZPEX+M VOLNM (N)=VNAME ELSE IF(M.LT.0) THEN ! Non-standard blackhole N = M END IF RETURN END C------------------------------------------------------------ SUBROUTINE REG3 C...................................................... C RE-DEFINES MATERIAL INDICES FOR STANDARD SECTOR C ONLY FOR STANDARD REGIONS DEFINED IN MARS.INP (NOT IN REG1 !!!) C FOR N <= NFZP = MZ*MR*NF C C REVISION: 05-OCT-1999 C...................................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) INCLUDE 'tally1.inc' *** Examle ************** * * MATIND(15)=2 * DO L=25,44 * MATIND(L)=5 * END DO * ... ************************* RETURN END C------------------------------------------------------- SUBROUTINE REGTAG(NB,N,W,P,X,Y,Z,JJ) C...................................................... C GLOBAL TAGGING OF THE PRIMARY HITS C C Tilted/shifted GA Target in a 20 T Solenoid C Tagged pion secondary entrances to the target C (see MAIN, REG1, REGTAG, LEAK and FIELD) C C REVISION: 16-NOV-2000 C...................................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) * INCLUDE 'blreg1.inc' * COMMON * & /BLZTAG/ZORIG,PHIT,XHIT,YHIT,ZHIT,JHIT C- - - - - - - - - - - - - - - - - - - - * M =N -NFZPEX * IF(M .LE.2) RETURN * MB=NB-NFZPEX * IF(MB.LE.2) RETURN * IF(JJ.LT.3.OR.JJ.GT.4) RETURN * IF(P.LT.0.05D0.OR.P.GT.0.8D0) RETURN * * L1=0 * IF(MB.EQ.4.OR.MB.EQ.6.OR.MB.EQ.8.OR.MB.EQ.10) L1=1 * L2=0 * IF(M.EQ.3.OR.M.EQ.5.OR.M.EQ.7.OR.M.EQ.9) L2=1 * IF(L1.EQ.1.AND.L2.EQ.1) THEN * IF(JJ.EQ.3) XHIT=XHIT+W * IF(JJ.EQ.4) YHIT=YHIT+W * END IF RETURN END C------------------------------------------------------- SUBROUTINE FIELD(N,X,Y,Z,BX,BY,BZ,BBB) C.................................................... C FINDS COMPONENTS OF THE MAGNETIC FIELD FOR A GIVEN POINT C DEFINED BY A REGION NUMBER "N" OR BY ITS COORDINATES "X,Y,Z" C C "N" and "X,Y,Z" CAN BE USED ALTERNATIVELY: C Use "N" if there is no field variation in that region ! C Use "X,Y,Z" if there is a field variation in that region ! C C INPUT: N - REGION NUMBER (> 0 !!!) C OR C X,Y,Z - COORDINATES C C FIELD MAPS C QUADS GRADIENTS IN T/CM C G>0 FOR FOC QUADS, G<0 FOR DEFOC QUADS C C OUTPUT: BX,BY,BZ,BBB IN TESLA C C DON'T FORGET TO CALCULATE BBB=SQRT(BX*BX+BY*BY+BZ*BZ) AFTERALL !!! C C FS-2-2: Hg (100mrad)+Beam(67mrad) C C Version: 11-FEB-2001 C REVISION: 13-JUN-2001 C.................................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) COMMON/BBBMAP/BBZ(199,44),BBR(199,44),ZMIMAP,ZSTEP,RMIMAP,RSTEP, & ZBOUND,RBOUND,NZMAP,NRMAP COMMON/LEAKPI/WLEAK1,WLEAK2,CLARM1,CLARM2,CLARM3,CLARM4, &BBZZ1,RAPER1,BBZZ2,RAPER2 C- - - - - - - - - - - - - - - - - - - - BX=0.D0 BY=0.D0 BZ=0.D0 BBB=0.D0 IF(Z.LT.ZMIMAP) RETURN R2=X*X+Y*Y R=SQRT(R2) IF(R.GT.RBOUND) RETURN ZSPECIA2=1862.D0 *** BBZZ5=((RAPER2/RAPER1)**2-1.D0)/ZSPECIA2 IF(Z.LE.ZSPECIA2) THEN Z1=Z BZ=FINT2D(BBZ,NZMAP,NRMAP,ZMIMAP,ZSTEP,RMIMAP,RSTEP,Z1,R) IF(R.GT.1.D-3) THEN BR=FINT2D(BBR,NZMAP,NRMAP,ZMIMAP,ZSTEP,RMIMAP,RSTEP,Z1,R) BX=BR*X/R BY=BR*Y/R END IF ELSE IF(R.LT.42.D0) THEN BZ=1.25D0 END IF END IF BBB=SQRT(BX*BX+BY*BY+BZ*BZ) RETURN END C---------------------------------------------------- SUBROUTINE SUFI C................................................................ C READS MAGNETIC FIELD MAP C C FS-2 Hg-target C Bob Weggel's map of 02/05/01 C C SOLBW.MAP: R(cm) Z(cm) BR(T) BZ(T) C Delta_R=3 cm, NR=44 (0 < r < 129 cm) C Delta_Z=10 cm, NZ=199 (-140 < z < 1840 cm) C C FS-2-2: Hg (100mrad)+Beam(67mrad) C C Version: 11-FEB-2001 C REVISION: 13-JUN-2002 C................................................................ IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) COMMON/BBBMAP/BBZ(199,44),BBR(199,44),ZMIMAP,ZSTEP,RMIMAP,RSTEP, & ZBOUND,RBOUND,NZMAP,NRMAP * DIMENSION ZTE(5),RTE(5) * DATA ZTE/-80.D0,-30.D0,-15.D0,1100.D0,1113.D0/ * DATA RTE/0.D0,6.D0,30.D0,5.D0,41.D0/ OPEN (UNIT= 4,FILE='SOLBW.MAP',STATUS='OLD') ZMIMAP = -140.D0 ZMAMAP = 1840.D0 NZMAP = 199 ZSTEP = (ZMAMAP-ZMIMAP)/(NZMAP-1) ! 10 cm ZBOUND = ZMAMAP RMIMAP = 0.0D0 RMAMAP = 129.0D0 NRMAP = 44 RSTEP = (RMAMAP-RMIMAP)/(NRMAP-1) ! 3 cm RBOUND = RMAMAP * WRITE(*,*)' ZMIMAP,ZBOUND,ZSTEP,RMIMAP,RBOUND,RSTEP,NZMAP,NRMAP= ' * & ,ZMIMAP,ZBOUND,ZSTEP,RMIMAP,RBOUND,RSTEP,NZMAP,NRMAP DO LR=1,NRMAP DO LZ=1,NZMAP READ(4,*)R,Z,BR,BZ BBZ(LZ,LR)=BZ BBR(LZ,LR)=BR END DO END DO *C=== TEST === * DO LR=1,5 * DO LZ=1,5 * Z=ZTE(LZ) * R=RTE(LR) * BZ=FINT2D(BBZ,NZMAP,NRMAP,ZMIMAP,ZSTEP,RMIMAP,RSTEP,Z,R) * BR=FINT2D(BBR,NZMAP,NRMAP,ZMIMAP,ZSTEP,RMIMAP,RSTEP,Z,R) * WRITE(*,*)' R,Z,BR,BZ=',R,Z,BR,BZ * END DO * END DO CLOSE (UNIT= 4) RETURN END C---------------------------------------------------- SUBROUTINE LEAK(N,K,JJ,W,E,X,Y,Z,DCX,DCY,DCZ,TOFF) C........................................... C PARTICLES LEAKAGE SPECIAL SCORING C JJ= 1 2 3 4 5 6 7 8 9 10 11 12 C P N PI+ PI- K+ K- MU+ MU- GAM E- E+ AP C C FS-2-2: Hg (100mrad)+Beam(67mrad) C C Version: 11-FEB-2001 C REVISION: 13-JUN-2002 C........................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) INCLUDE 'blreg1.inc' INCLUDE 'cmasnsg.inc' COMMON : /HIST/NI,NSTOP,NUPRI,NHIPR : /BLZTAG/ZORIG,PHIT,XHIT,YHIT,ZHIT,JHIT & /BDNDP/DNDP(8,200,7),THETA(8),DELTAP COMMON/LEAKPI/WLEAK1,WLEAK2,CLARM1,CLARM2,CLARM3,CLARM4, &BBZZ1,RAPER1,BBZZ2,RAPER2 PARAMETER (ECUT1=0.025D0) ! Hg PARAMETER (ECUT2=0.225D0) ! Hg *** PARAMETER (ECUT1=0.032D0) ! C *** PARAMETER (ECUT2=0.232D0) ! C PARAMETER (CLIGHT=29979245800.D0) C- - - - - - - - - - - - - - - - - - - - DATA DZ0/0.001D0/ IF(Z.LT.ZMAX) RETURN IF(SQRT(X*X+Y*Y).GE.RAPER2) RETURN CC IF(P.LT.PMI.OR.P.GT.PMA) RETURN JT=JJ JM=JJ IF(JJ.EQ.12) THEN JT=7 JM=1 END IF IF(JM.LE.8) THEN P=SQRT(E*(E+2.D0*PM(JM))) ELSE P=E END IF PX=P*DCX PY=P*DCY PZ=P*DCZ IF(JJ.GT.11) GO TO 2 IF(DCZ.LE.DZ0) GO TO 2 C=== WRITE LEAK FILES === CTOFF=CLIGHT*TOFF ET=E+PM(JJ) *** GEV --> MEV *** * PXMEV=PX*1.D3 * PYMEV=PY*1.D3 * PZMEV=PZ*1.D3 * ETMEV=ET*1.D3 ******************* * IF(JJ.EQ.3) JPLO=2 * IF(JJ.EQ.4) JPLO=3 * IF(JJ.EQ.7) JPLO=4 * IF(JJ.EQ.8) JPLO=5 * PT=SQRT(PX*PX+PY*PY) * PTMEV=PT*1.D3 !!! IF(JJ.EQ.3.OR.JJ.EQ.4) THEN !!! WRITE(8,102)NI,JJ,X,Y,ZMAX,PX,PY,PZ,ET,CTOFF,W !!! 102 FORMAT(I8,I3,3F11.3,4F12.6,F12.3,1PE12.4) * WRITE(8,102)NI,JPLO,Y,PYMEV,X,PXMEV,CTOFF,ETMEV,PZMEV,PTMEV, * & ZMAX,K77,W * 102 FORMAT(I8,I3,4F10.3,E14.6,3F12.3,F10.3,I3,E12.4) CC 102 FORMAT(I8,I3,4F10.4,E14.6,3F12.4,E12.4) * WRITE(9,101)NI,JJ,K,W,X,Y,Z,PX,PY,PZ * 101 FORMAT(I8,2I3,E10.3,3F9.4,3F10.6) !!! ELSE IF(JJ.EQ.7.OR.JJ.EQ.8) THEN !!! WRITE(8,102)NI,JJ,X,Y,ZMAX,PX,PY,PZ,ET,CTOFF,W * WRITE(8,102)NI,JPLO,Y,PYMEV,X,PXMEV,CTOFF,ETMEV,PZMEV,PTMEV, * & ZMAX,K77,W * WRITE(9,101)NI,JJ,K,W,X,Y,Z,PX,PY,PZ !!! END IF C============================================== C=== PI+K === IF(P.GT.0.05D0.AND.P.LT.0.8D0) THEN * RLAR=PT/(2.997925D-3*BBZZ1) * T1=NSG5(JJ)*RLAR/PT * XC=X+PY*T1 * YC=Y-PX*T1 * RC=SQRT(XC*XC+YC*YC) * IF((RLAR+RC).LT.RAPER1) THEN *** IF(PT.LT.0.225D0) THEN IF(E.GT.ECUT1.AND.E.LT.ECUT2) THEN IF(JJ.EQ.3.OR.JJ.EQ.5) CLARM1=CLARM1+W IF(JJ.EQ.4.OR.JJ.EQ.6) CLARM2=CLARM2+W END IF * SCAL=SQRT(BBZZ2/BBZZ1) * PT=PT*SCAL * RC=RC/SCAL * RLAR=PT/(2.997925D-3*BBZZ2) * IF((RLAR+RC).LT.RAPER2) THEN * IF(JJ.EQ.3.OR.JJ.EQ.5) CLARM3=CLARM3+W * IF(JJ.EQ.4.OR.JJ.EQ.6) CLARM4=CLARM4+W * END IF * IF(JJ.EQ.3.OR.JJ.EQ.5) WLEAK1=WLEAK1+W * IF(JJ.EQ.4.OR.JJ.EQ.6) WLEAK2=WLEAK2+W IF(JJ.EQ.3.OR.JJ.EQ.5.OR.JJ.EQ.7) WLEAK1=WLEAK1+W IF(JJ.EQ.4.OR.JJ.EQ.6.OR.JJ.EQ.8) WLEAK2=WLEAK2+W END IF C=== MUONS === *** IF(P.GT.0.1D0.AND.P.LT.0.6D0) THEN IF(E.GT.ECUT1.AND.E.LT.ECUT2) THEN IF(JJ.EQ.7) CLARM3=CLARM3+W IF(JJ.EQ.8) CLARM4=CLARM4+W END IF 2 IF(JJ.GE.7.AND.JJ.LE.11) RETURN LP=1+INT(P/DELTAP) IF(LP.GT.200) LP=200 SID=SQRT(DCX*DCX+DCY*DCY) T1=ATANM(SID,DCZ) DO LT=1,8 IF(T1.LE.THETA(LT)) GO TO 1 END DO LT=8 1 DNDP(LT,LP,JT)=DNDP(LT,LP,JT)+W c PT=P*SQRT(DCX*DCX+DCY*DCY) c PL=P*DCZ c WRITE(41,101)NI,JJ,W,PL,PT c 101 FORMAT(I7,I3,3E13.5) RETURN END C----------------------------------------------- SUBROUTINE ALIGN(VECT,VOUT,NIB,NIM,IFLAG) C................................................ C USED ONLY IF IND(14)=T C C FICTITIOUS SCATTERING: C DISCRETE AT BOUNDARIES BETWEEN REGIONS WITH SPECIAL NUMBERS NIB AND NIM C NIB - PRIOR CROSSING, NIM - AFTER CROSSING C VECT,VOUT: X,Y,Z,DCX,DCY,DCZ,P C C VECT(1)-VECT(6) CAN BE RE-DEFINED TO VOUT(1)-VOUT(6), C NORMALLY AT IND(4)=T C IF SO, VOUT(1)-VOUT(6) MUST BE FILLED AND IFLAG=1 MUST BE RAISED C----- C CREATED: 1994 BY N.MOKHOV C LAST CHANGE: 11-DEC-2001 BY NVM C----- C................................................ IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) DIMENSION VECT(7),VOUT(7) C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CC 1 DO L=1,6 CC VOUT(L)=VECT(L) CC END DO RETURN END C---------------------------------------------------- SUBROUTINE SAGIT(CHARGE,STEP,VECT,VOUT,NREG,IFLAG) C....................................................... C USED ONLY IF IND(14)=T C C FICTITIOUS SCATTERING: C ON STEP IN REGION NUMBER NREG C VECT,VOUT: X,Y,Z,DCX,DCY,DCZ,P C C VECT(1)-VECT(6) CAN BE RE-DEFINED TO VOUT(1)-VOUT(6), C NORMALLY AT IND(4)=T C IF SO, VOUT(1)-VOUT(6) MUST BE FILLED AND IFLAG=1 MUST BE RAISED C C----- C CREATED: 1994 BY N.MOKHOV C LAST CHANGE: 11-DEC-2001 BY NVM C----- C....................................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) DIMENSION VECT(7),VOUT(7) C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CC 1 DO L=1,6 CC VOUT(L)=VECT(L) CC END DO RETURN END C---------------------------------------------------- SUBROUTINE RFCAVT(JJ,VECT,VOUT,E,TOFF,NIB,NIM,IFLAG) C................................................ C USED ONLY IF IND(14)=T C C RF CAVITY KICK: C DISCRETE AT BOUNDARIES BETWEEN REGIONS WITH SPECIAL NUMBERS NIB AND NIM C NIB - PRIOR CROSSING, NIM - AFTER CROSSING C C INPUT : JJ, VECT (X,Y,Z,DCX,DCY,DCZ,P), E, TOFF, NIB, NIM C OUTPUT: VOUT (X,Y,Z,DCX,DCY,DCZ,P), E, IFLAG C C VECT(1)-VECT(7) AND E ARE RE-DEFINED TO VOUT(1)-VOUT(7) AND E C IFLAG=1 MUST BE RAISED C IFLAG=2 - E_new <0 C----- C CREATED: 1999 BY N.MOKHOV C LAST CHANGE: 11-DEC-2001 BY NVM C----- IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) INCLUDE 'cmasnsg.inc' DIMENSION VECT(7),VOUT(7) C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CC 1 DO L=1,7 CC VOUT(L)=VECT(L) CC END DO RETURN END C---------------------------------------------------- SUBROUTINE EDGEUS(U,V) C.................................................... C EDGE-SCATTERING PROBLEM C.................................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN END C--------------------------------------------------- SUBROUTINE VFAN(N,V) C........................................... C FIND VOLUME V(N),CM**3 OF REGION N OF THE NON-STANDARD GEOMETRY C VOLUME(N) ARE DEFINED IN SERV FOR N <= NFZP C C FS-2-2: Hg (100mrad)+Beam(67mrad) C C Version: 13-FEB-2001 C REVISION: 13-JUN-2002 BY NVM C........................................... IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) INCLUDE 'blreg1.inc' INCLUDE 'tally1.inc' COMMON/LEAKPI/WLEAK1,WLEAK2,CLARM1,CLARM2,CLARM3,CLARM4, &BBZZ1,RAPER1,BBZZ2,RAPER2 DATA NENTER/0/ SAVE NENTER PARAMETER (PI=3.141592653589793227D+00) PARAMETER (NF1=20) COMMON/BSCPHI/PHI(20),CPHI(20) DIMENSION DLPH(20) PARAMETER (BETHICK=0.2D0) ! Be-window thickness PARAMETER (BEDELTR=3.0D0) ! Be-window Delta_R PARAMETER (DELZ14=300.D0) ! SC14-SC18 C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - N1=NFZPEX ! NUMBER OF STANDARD+EXTENDED REGIONS IF(NENTER.EQ.0) THEN NENTER=1 C=== PUT HERE THE REAL VOLUMES (CM**3) FOR ALL THE NEEDED === C NON-STANDARD REGIONS <= M_MAX, I.E. REDEFINE ANY OF THE C PRE-DEFINED VOLUME(L)=0.D0 C For example: C C VOLUME(N1+2) =PI*RCOL*RCOL*180.D0 C VOLUME(N1+3) =PI*(400.D0-RCOL*RCOL)*60.D0 C VOLUME(N1+365)=VOLUME(N1+3) * R1=RAPER2+THSS1+THRES+THSS2+THW+THCR1 C=== JET === RHOLEJ=0.5D0 DLZTAR=5.D0 VJET=PI*RHOLEJ**2 R1=0.1D0 R2=0.3D0 R3=0.5D0 C=== JET UPSTREAM === VOLUME(N1+229) =VJET*65.D0 ! jet 23, -200 < z < -135 VOLUME(N1+231) =VJET*56.D0 ! jet 23, -135 < z < -79 VOLUME(N1+235) =VJET*7.8D0 ! jet 23, -79 < z < -71.2 VOLUME(N1+243) =VJET*26.2D0 ! jet 23, -71.2< z < -45 C=== JET DOWNSTREAM === VOLUME(N1+240) =VJET*200.D0 ! jet 24 C=== TARGET JET -45 < z < 20 cm === VJET1=PI*R1**2 VJET2=PI*(R2+R1)*(R2-R1) VJET3=PI*(R3+R2)*(R3-R2) DO L=1,13 N11=N1+261+L N12=N11+13 N13=N11+26 VOLUME(N11) =VJET1*DLZTAR ! r < 0.1 cm VOLUME(N12) =VJET2*DLZTAR ! 0.1 < r < 0.3 cm VOLUME(N13) =VJET3*DLZTAR ! 0.1 < r < 0.3 cm END DO VOLUME(N1+245)=0.5D0*PI*7.5D0**2*26.2D0 ! FeCo, mix7, 14, -71.2 < z < -45 VOLUME(N1+246)=VOLUME(N1+245) VOLUME(N1+227)=PI*(50.51D0**2-17.3D0**2)*115.7D0 ! mix3, 17 C=== 0.2 CM BE-WINDOW (R=18.24 CM) AT Z=610 CM=== VBEWI=PI*BEDELTR**2*BETHICK VOLUME(N1+305)=VBEWI VOLUME(N1+306)=VBEWI*3.D0 VOLUME(N1+307)=VBEWI*5.D0 VOLUME(N1+308)=VBEWI*7.D0 VOLUME(N1+309)=VBEWI*9.D0 VOLUME(N1+310)=VBEWI*11.D0 & +PI*(18.24D0*18.24D0-18.D0*18.D0)*BETHICK DLPH(1)=PHI(1)*2.D0 DO L=2,NF1 DLPH(L)=PHI(L)-PHI(L-1) END DO C=== SC3 === R1=77.56D0 R2=79.56D0 R3=98.75D0 DELZ=245.6D0-145.7D0 V1=PI*(R2*R2-R1*R1)*DELZ/360.D0 V2=PI*(R3*R3-R2*R2)*DELZ/360.D0 N11=N1 +23 N12=N11+NF1 DO L=1,NF1 VOLUME(N11+L) =V1*DLPH(L) VOLUME(N12+L) =V2*DLPH(L) END DO C=== SC4 === R1=77.56D0 R2=79.56D0 R3=88.29D0 DELZ=410.6D0-145.7D0 V1=PI*(R2*R2-R1*R1)*DELZ/360.D0 V2=PI*(R3*R3-R2*R2)*DELZ/360.D0 N11=N1 +70 N12=N11+NF1 DO L=1,NF1 VOLUME(N11+L) =V1*DLPH(L) VOLUME(N12+L) =V2*DLPH(L) END DO C=== SC5 === R1=77.56D0 R2=79.56D0 R3=84.12D0 DELZ=606.5D0-420.6D0 V1=PI*(R2*R2-R1*R1)*DELZ/360.D0 V2=PI*(R3*R3-R2*R2)*DELZ/360.D0 N11=N1 +117 N12=N11+NF1 DO L=1,NF1 VOLUME(N11+L) =V1*DLPH(L) VOLUME(N12+L) =V2*DLPH(L) END DO C=== SC6 === R1=41.56D0 R2=46.69D0 DELZ=610.3D0-600.D0 V1=PI*(R2*R2-R1*R1)*DELZ/360.D0 N11=N1 +164 DO L=1,NF1 VOLUME(N11+L) =V1*DLPH(L) END DO C=== SC7 - SC12 === RS0 =31.D0 !!! RS1 =39.00D0 !!! RS2 =42.22D0 !!! RS4 =47.D0 !!! RS5 =48.D0 !!! DV4=PI*(RS5*RS5-RS4*RS4) ! vessel DV5=PI*(RS1*RS1-RS0*RS0) ! shield SC13-SC18 C=== SC7 === RS3 =45.09D0 DELZ=900.D0-627.5D0 DV1=PI*(RS2*RS2-RS1*RS1) ! cryo DV2=PI*(RS3*RS3-RS2*RS2) ! SC DV3=PI*(RS4*RS4-RS3*RS3) ! cryo N0=192 VOLUME(N1+N0+1) =DV1*DELZ VOLUME(N1+N0+2) =DV2*DELZ VOLUME(N1+N0+3) =DV3*DELZ VOLUME(N1+N0+4) =DV4*DELZ C=== SC8 === RS3 =44.49D0 DV1=PI*(RS2*RS2-RS1*RS1) ! cryo DV2=PI*(RS3*RS3-RS2*RS2) ! SC DV3=PI*(RS4*RS4-RS3*RS3) ! cryo DELZ=1080.D0-905.D0 N0=199 VOLUME(N1+N0+1) =DV1*DELZ VOLUME(N1+N0+2) =DV2*DELZ VOLUME(N1+N0+3) =DV3*DELZ VOLUME(N1+N0+4) =DV4*DELZ C=== SC9 === RS3 =44.15D0 DV1=PI*(RS2*RS2-RS1*RS1) ! cryo DV2=PI*(RS3*RS3-RS2*RS2) ! SC DV3=PI*(RS4*RS4-RS3*RS3) ! cryo DELZ=1260.D0-1085.D0 N0=206 VOLUME(N1+N0+1) =DV1*DELZ VOLUME(N1+N0+2) =DV2*DELZ VOLUME(N1+N0+3) =DV3*DELZ VOLUME(N1+N0+4) =DV4*DELZ C=== SC10 === RS3 =43.89D0 DV1=PI*(RS2*RS2-RS1*RS1) ! cryo DV2=PI*(RS3*RS3-RS2*RS2) ! SC DV3=PI*(RS4*RS4-RS3*RS3) ! cryo DELZ=1440.D0-1265.D0 N0=213 VOLUME(N1+N0+1) =DV1*DELZ VOLUME(N1+N0+2) =DV2*DELZ VOLUME(N1+N0+3) =DV3*DELZ VOLUME(N1+N0+4) =DV4*DELZ C=== SC11 === RS3 =43.70D0 DV1=PI*(RS2*RS2-RS1*RS1) ! cryo DV2=PI*(RS3*RS3-RS2*RS2) ! SC DV3=PI*(RS4*RS4-RS3*RS3) ! cryo DELZ=1620.D0-1445.D0 N0=220 VOLUME(N1+N0+1) =DV1*DELZ VOLUME(N1+N0+2) =DV2*DELZ VOLUME(N1+N0+3) =DV3*DELZ VOLUME(N1+N0+4) =DV4*DELZ C=== SC12 === RS3 =43.54D0 DV1=PI*(RS2*RS2-RS1*RS1) ! cryo DV2=PI*(RS3*RS3-RS2*RS2) ! SC DV3=PI*(RS4*RS4-RS3*RS3) ! cryo DELZ=1862.D0-1625.D0 N0=247 VOLUME(N1+N0+1) =DV1*DELZ VOLUME(N1+N0+2) =DV2*DELZ VOLUME(N1+N0+3) =DV3*DELZ VOLUME(N1+N0+4) =DV4*DELZ C=== SC13, 1862 < Z < 2100 cm RS3 =43.54D0 DV1=PI*(RS2*RS2-RS1*RS1) ! cryo DV2=PI*(RS3*RS3-RS2*RS2) ! SC DV3=PI*(RS4*RS4-RS3*RS3) ! cryo DELZ=2100.D0-1867.D0 N0=254 VOLUME(N1+N0+1) =DV1*DELZ VOLUME(N1+N0+2) =DV2*DELZ VOLUME(N1+N0+3) =DV3*DELZ VOLUME(N1+N0+4) =DV4*DELZ VOLUME(N1+336) =DV5*(DELZ+5.D0) C=== SC14-SC18, 2100 < Z < 3600 cm RS3 =43.54D0 * DELZ=DELZ14-5.D0 DELZ=DELZ14 DV1=PI*(RS2*RS2-RS1*RS1) ! cryo DV2=PI*(RS3*RS3-RS2*RS2) ! SC DV3=PI*(RS4*RS4-RS3*RS3) ! cryo DO L=1,5 N0=311+4*(L-1) VOLUME(N1+N0+1) =DV1*DELZ VOLUME(N1+N0+2) =DV2*DELZ VOLUME(N1+N0+3) =DV3*DELZ VOLUME(N1+N0+4) =DV4*DELZ VOLUME(N1+336+L)=DV5*DELZ14 END DO C============================================================ END IF V=VOLUME(N) RETURN END C------------------------------------------------- SUBROUTINE MHSETU C........................................................ C SET UP HISTOGRAM ARRAYS C HISTOGRAM ENTRY FOR USER-DEFINED HISTOGRAMMING C C HISTOGRAM ID AVAILABLE: 700 < ID < 999 C C HISTOGRAM TYPE: C IHTYP = 1 - COLLISION C IHTYP = 2 - STEP C IHTYP = 3 - ENERGY DEPOSITION C C----- C CREATED: 15-JUN-2000 BY NVM C LAST CHANGE: 13-SEP-2000 BY NVM C----- C........................................................ IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) ************************************************************* * REMEMBER, HBOOK IS A SINGLE PRECISION ENGINE * DON'T FORGET THE 'REAL' DECLARATIONS SUCH AS: * * REAL AA,ELB,X1,X2,Y1,Y2 * CALL HBOOKB(ID,AA,NEB,ELB,0.) * * CALL HBOOK2(ID,TITLE,NX,X1,X2,NY,Y1,Y2,0.) ************************************************************* RETURN END C------------------------------------------------- SUBROUTINE MFILL(IHTYP,NREG,IM,JJ,E1,E2,DELE,W,X1,Y1,Z1,X2,Y2,Z2, & DCX,DCY,DCZ,STEP,TOF,NI) C........................................................ C HISTOGRAM ENTRY FOR USER-DEFINED HISTOGRAMMING C C HISTOGRAM ID AVAILABLE: 700 < ID < 999 C C CALL TYPE: C IHTYP = 1 - COLLISION C IHTYP = 2 - STEP ("TRACK-LENGTH") C IHTYP = 3 - ENERGY DEPOSITION (LOCAL OR ON THE STEP) C C PARTICLE ID: C JJ= 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 C p n pi+ pi- K+ K- mu+ mu- g e- e+ ap pi0 d t He3 He4 num nuam nue nuae C C NREG - REGION NUMBER FOR COLLISION OR STEP START C STEP - STEP (cm) C E1 - ENERGY BEFORE STEP (GeV) C E2 - ENERGY AFTER STEP (GeV) C DELE - ENERGY DEPOSITED (GeV), LOCALLY OR ON THE STEP C W - STATISTICAL WEIGHT C X1,Y1,Z1 - COORDINATES AT THE STEP START (cm) C X2,Y2,Z2 - COORDINATES AT THE STEP END (cm) C DCX,DCY,DCZ - DIRECTION COSINES AT THE STEP START C TOF - TIME-OF-FLIGHT AT THE STEP END (sec) C NI - HISTORY NUMBER C C IHTYP=1: E1=E2, DELE=0, STEP=0, X1=X2, Y1=Y2, Z1=Z2 C IHTYP=3: E1#E2, DELE>0; STEP=0 (X1=X2, Y1=Y2, Z1=Z2) OR STEP>0 (X1#X2, Y1#Y2, Z1#Z2) C C----- C CREATED: 15-JUN-2000 BY NVM C LAST CHANGE: 13-SEP-2000 BY NVM C----- C........................................................ IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) ************************************************************* * REMEMBER, HBOOK IS A SINGLE PRECISION ENGINE * DON'T FORGET CONVERSIONS OF THE FOLLOWING TYPE: * * REAL EEH,WWH,XL,YL,WH * EEH=REAL(E1) * WWH=REAL(W) * CALL HFILL(ID,EEH,0.,WWH) * ... * CALL HF2(ID,XL,YL,WH) ************************************************************* RETURN END C------------------------------------------------- SUBROUTINE WRTSUR(IUNIT,NI,JJ,E,W,X,Y,Z,DCX,DCY,DCZ,TOFF) C........................................................ C PARTICLE AT THE SURFACE DETECTOR C FOR WRITING, HISTOGRAMMING ETC. C UNIT=81-90 WRITE: fort.81 - fort.90 RESERVED FOR SURFACE DETECTOR FILES C C PARTICLE ID: * 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 * p n pi+ pi- K+ K- mu+ mu- g e- e+ ap pi0 d t He3 He4 num nuam nue nuae C----- C CREATED: 1999 BY N.MOKHOV (NVM) C LAST CHANGE: 22-JAN-2001 BY NVM C----- C FS-2-2: Hg (100mrad)+Beam(67mrad) C C Version: 13-FEB-2001 C REVISION: 13-JUN-2002 C........................................................ IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) INCLUDE 'cmasnsg.inc' PARAMETER (CLIGHT=29979245800.D0) * PARAMETER (IWRTYP=1) ! momentum components (particle production) *** PARAMETER (IWRTYP=2) ! energy and cosines (source term for staging) C- - - - - - - - - - - - - - - - - - - - - - - - - - - - C=== IWRTYP=1 IF(IUNIT.EQ.82) IWRTYP=2 C=== IF(IWRTYP.EQ.1) THEN ET=E+PM(JJ) PA=SQRT(E*(E+2.D0*PM(JJ))) CTOFF=CLIGHT*TOFF PX=PA*DCX PY=PA*DCY PZ=PA*DCZ WRITE(IUNIT,101)NI,JJ,X,Y,Z,PX,PY,PZ,ET,CTOFF,W 101 FORMAT(I8,I3,3F11.3,6(1PE14.6)) ELSE IF(IWRTYP.EQ.2) THEN C=== if(jj.le.12) then WRITE(IUNIT,102)NI,JJ,E,W,X,Y,Z,DCX,DCY,DCZ,TOFF 102 FORMAT(I8,I3,5(1PE13.5),3(1PE15.7),1PE12.4) end if C=== END IF RETURN END C------------------------------------------------- SUBROUTINE TAGGING(IM,NREG,WEE) C........................................................ C ENERGY DEPOSITION TAGGING C----- C LAST CHANGE: 08-NOV-2000 BY NVM C----- C........................................................ IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) INCLUDE 'tally2.inc' C- - - - - - - - - - - - - - - - - - - - - - - - - - - - IF(IM.GT.0) THEN IF(WEE.GT.1.D-50) THEN IF(NUMTAG.GT.0.AND.MTAGG.GT.0) THEN DO N = 1, NUMTAG IF(NREG.EQ.NTAGG(N)) THEN ETAG(INTAG,IETAG,N)=ETAG(INTAG,IETAG,N)+WEE ENDIF ENDDO ENDIF ENDIF ENDIF RETURN END C------------------------------------------------- BLOCK DATA BLPROCESS C................................................. C IPRCEM(K) = 0 - exclusive C IPRCEM(K) = 1 - inclusive with a probability PRCEM(K) C IPRCEM(0) - global control C----- C CREATED: 04-OCT-2000 BY NVM C LAST CHANGE: 01-JUN-2001 BY NVM C----- C................................................. * in process.inc : INTEGER NPRCEM,NPRCHT,NPRCMT,NPRCNT,NPRCHA * in process.inc : INTEGER IPRCEM,IPRCHT,IPRCMT,IPRCNT,IPRCHA * in process.inc : DOUBLE PRECISION PRCEM,PRCHT,PRCMT,PRCNT,PRCHA IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) INCLUDE 'process.inc' C- - - - - - - - - - - - - - - - - - - - - - - - - - - - C=== cems === C ... ... ... C 1 2 3 ! set EMS global bias flag: ! 0 - exclusive ! 1 - LPB ! 2 - HALF *** DATA IPRCEM/0,NPRCEM*0/ DATA IPRCEM/1,NPRCEM*0/ DATA PRCEM/NPRCEM*0.D0/ C=== hadron transport === C ... ... ... C 1 2 3 DATA IPRCHT/0,NPRCHT*0/ DATA PRCHT/NPRCHT*0.D0/ C=== muon transport === C ... ... ... C 1 2 3 DATA IPRCMT/0,NPRCMT*0/ DATA PRCMT/NPRCMT*0.D0/ C=== low-energy neutron transport === C ... ... ... C 1 2 3 DATA IPRCNT/0,NPRCNT*0/ DATA PRCNT/NPRCNT*0.D0/ C=== hadron-nucleus vertex === C ... ... ... C 1 2 3 DATA IPRCHA/0,NPRCHA*0/ DATA PRCHA/NPRCHA*0.D0/ END C------------------------------------------------- BLOCK DATA HISTDUMP C........................................................ C BASELINE VOLUME-SURFACE DETECTOR BINNING C AND C SELECTED DUMP REGION NUMBERS (0 < NBMA < 300) C IN ADDITION TO THE STANDARD GEOMETRY SECTOR C----- C CREATED: 21-NOV-2001 BY NVM C LAST CHANGE: 14-FEB-2002 BY NVM C----- C........................................................ IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER (I-N) COMMON/BHBKRZ/NZBIN(3),NRBIN(3),NXH,NYH COMMON/BLDUMP/NBU(300),NBMA C=== VOLUME R-Z DETECTOR BINNING (at NOB > 0) === DATA NZBIN/200,200,200/ ! Recommended DATA NRBIN/120,120,120/ ! Recommended C=== SURFACE X-Y DETECTOR BINNING (at NSURF > 0) === DATA NXH/150/ ! Recommended DATA NYH/150/ ! Recommended C=== SELECTED DUMP REGION NUMBERS (0 < NBMA < 300) === DATA NBMA/0/ DATA NBU/300*0/ C For example: C DATA NBMA/6/ C DATA NBU/115,116,117,921,1050,4380, C & 294*0/ C END