+++ /dev/null
-*$ CREATE AACOLL.ADD
-*COPY AACOLL
-*
-*=== Aacoll ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* A-A COLLision common: *
-* *
-* Ion-Ion collision common for Fluka 9x....: *
-* *
-* Last change on 15-apr-99 by Alfredo Ferrari, INFN-Milan *
-* *
-* Description of the variable(s): *
-* *
-* Ekpern = kinetic energy per nucleon GeV/amu *
-* Enpern = total energy per nucleon GeV/amu *
-* Plpern = momentum per nucleon GeV/c/amu *
-* Eexion = excitation energy of the projectile ion *
-* Matprj(i) = list of materials used as projectiles *
-* Nmatpr = number of materials defined inside Matprj *
-* Iproa = the projectile mass number *
-* Iproz = the projectile proton number *
-* Mattar = material number of the target *
-* Itara = the target mass number *
-* Itarz = the target proton number *
-* Matpro = material number of the (current) projectile *
-* *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* !!!! Note that the units are GeV/amu --> per unit mass !!!! *
-* !!!! with mass measured in amu (1 amu = Amuc12 GeV) !!!! *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* *
-*----------------------------------------------------------------------*
-*
- COMMON / AACOLL / EKPERN, ENPERN, PLPERN, EEXION, MATPRJ (MXXMDF),
- & NMATPR, MATPRO, IPROA , IPROZ , MATTAR, ITARA ,
- & ITARZ
-
+++ /dev/null
-*$ CREATE AADAT.ADD
-*COPY AADAT
-* *
-*=== aadat ============================================================*
-* *
- PARAMETER (IPROM = 100)
- PARAMETER (ITARM = 100)
- COMMON/AADAT/ENPERN,PLPERN,SIGAA(IPROM,ITARM),SIGNN,TMASS,AAEVNO,
- + SELAA(IPROM,ITARM),RLASTP(IPROM,ITARM),
- + MATPRO,MATTAR,LASTM,IPROA,IPROZ,ITARA,ITARZ
-
+++ /dev/null
-*$ CREATE ABLTIS.ADD
-*COPY ABLTIS
-*
-*=== abltis ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* This is the old ABLTIS common of Hadrin, extracted and put *
-* into an include file *
-* *
-* Created on 17 may 1995 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 07-feb-97 by Alfredo Ferrari *
-* *
-* Included in the following routines: *
-* *
-* AMGA *
-* CALUMO *
-* CALUMV *
-* DATESH *
-* FERHAV *
-* HADDEN *
-* HADRIN *
-* HADRIV *
-* HYPERO *
-* NUCRIV *
-* RCHANV *
-* SIGINT *
-* TCHOIC *
-* TWOPAR *
-* *
-*----------------------------------------------------------------------*
-*
- COMMON / ABLTIS / AM (-6:MXPABL), GA (-6:MXPABL),
- & TAU (-6:MXPABL), ICH (-6:MXPABL),
- & IBAR (-6:MXPABL), K1 (-6:MXPABL),
- & K2 (-6:MXPABL)
-
+++ /dev/null
-*$ CREATE ADDHP.ADD
-*COPY ADDHP
-*
-*=== addhp ============================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Include file Addhp: (it is a very old one, recently put into an *
-* include file) *
-* *
-* Created on 17 may 1995 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 03-aug-99 by Alfredo Ferrari *
-* *
-* Included in the following routines: *
-* *
-* BLKDT5 *
-* HADDEN *
-* *
-*----------------------------------------------------------------------*
-*
-* Till 3-aug-99:
-* PARAMETER ( MXPADD = 16 )
-* PARAMETER ( MXADZK = 153 )
- PARAMETER ( MXPADD = 26 )
- PARAMETER ( MXADZK = 183 )
- CHARACTER*8 ANAMZ,ZKNAMZ
- COMMON / ADDHP / AMZ (MXPADD), GAZ (MXPADD), TAUZ (MXPADD),
- & WTZ (MXADZK), ICHZ (MXPADD), IBARZ (MXPADD),
- & K1Z (MXPADD), K2Z (MXPADD), NZKZ (MXADZK,3),
- & II22
- COMMON / ADDHN / ANAMZ (MXPADD), ZKNAMZ (MXADZK)
-
+++ /dev/null
-*$ CREATE ATFFAC.ADD
-*COPY ATFFAC
-*
-*=== ATFFAC ===========================================================*
-*
-*
-*----------------------------------------------------------------------*
-* *
-* Include file atffac: ATomic Form FACtors *
-* *
-* Created on 18 march 1992 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 29-may-93 by Alfredo Ferrari *
-* *
-* Gmoliz(iz) = Z^1/3 / 121 *
-* Algmlz(iz) = Log (Gmoliz(iz)) *
-* Xsielz(iz) = asymptotic contribution of atomic electrons to pair *
-* and bremsstrahlung *
-* Fclmbz(iz) = Coulomb correction *
-* Aagelz(iz) = a for the Tsai fit to the atomic elastic form factor*
-* [1-F^2(q)]=(aq)^4/[1+(aq)^2]^2, [a] = [MeV/c]^-1 *
-* For Z>=5 is given by a = 111.7 / (Z^1/3 me) *
-* Apginz(iz) = a' for the Tsai fit to the atomic inelastic form *
-* factor S(q)=(a'q)^4/[1+(a'q)^2]^2, [a'] = [MeV/c]^-1*
-* For Z>=5 is given by a' = 724.2 / (Z^2/3 me) *
-* *
-* Actually a and a' are stored already squared !! *
-* *
-* Asqzft(iz) = a parameter for the fit to S(q,Z) computed with the *
-* Hartree-Fock method *
-* Bsqzft(iz) = b parameter for the fit to S(q,Z) computed with the *
-* Hartree-Fock method *
-* Csqzft(iz) = c parameter for the fit to S(q,Z) computed with the *
-* Hartree-Fock method *
-* Dsqzft(iz) = d parameter for the fit to S(q,Z) computed with the *
-* Hartree-Fock method *
-* Esqzft(iz) = e parameter for the fit to S(q,Z) computed with the *
-* Hartree-Fock method *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( A121 = 121. D+00 )
- PARAMETER ( A111P7 = 111.7 D+00 )
- PARAMETER ( A724P2 = 724.2 D+00 )
- PARAMETER ( A184 = 184.15 D+00 )
- PARAMETER ( A1194 = 1194. D+00 )
-*
- COMMON / ATFFAC / GMOLIZ (100), ALGMLZ (100), XSIELZ (100),
- & FCLMBZ (100), AAGELZ (100), APGINZ (100),
- & ASQZFT (100), BSQZFT (100), CSQZFT (100),
- & DSQZFT (100), ESQZFT (100)
-
+++ /dev/null
-*$ CREATE ATNUBF.ADD
-*COPY ATNUBF
-*
-*=== atnubf ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* ATmospheric NeUtrino BuFfer: *
-* *
-* Created on 29 may 1996 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 15-dec-99 by Alfredo Ferrari *
-* *
-* Description of variables: *
-* *
-* Idatnu = neutrino id (Paprop numbering) *
-* Lgatnu = neutrino generation *
-* Enatnu = neutrino energy (GeV) *
-* Diatnu = neutrino production height or distance (cm) *
-* Thatnu = neutrino direction polar (theta) angle (rad) *
-* Phatnu = neutrino direction azimuthal (phi) angle (rad) *
-* Wtatnu = neutrino weight (such to be automatically norm- *
-* alized to fluence per unit time and area) *
-* Ipatnu = parent cosmic ray id (Z + 100 x A) *
-* Ifatnu = "father" hadron/muon Fluka id *
-* Igatnu = "grandfather" hadron Fluka id *
-* Ictfnu = i1 + j1 x 3 + i2 x 9 + j2 x 27 + i3 x 81 + j3 x 243*
-* + i4 x 729 + j4 x 2187 + i5 x 6561 + j5 x 19683 *
-* ik = cutoff flag for the k_th location, direct nu *
-* jk = cutoff flag for the k_th location, mirror nu *
-* = 0 <-> not yet checked *
-* = 1 <-> neutrino not cutoffed *
-* = 2 <-> neutrino cutoffed *
-* Pmatnu = parent cosmic ray momentum (GeV/c/amu) *
-* Pfatnu = "father" hadron/muon momentum (GeV/c) *
-* Pgatnu = "grandfather" hadron momentum (GeV/c) *
-* Xpatnu = parent cosmic ray 1st interaction x coord. (cm) *
-* Ypatnu = parent cosmic ray 1st interaction y coord. (cm) *
-* Zpatnu = parent cosmic ray 1st interaction z coord. (cm) *
-* Tpatnu = parent cosmic ray direction polar angle (rad) *
-* Ppatnu = parent cosmic ray direction azimuthal angle (rad) *
-* Wpatnu = accumulated primary weight at the previous buffer *
-* flush *
-* Npatnu = accumulated primary number at the previous buffer *
-* flush *
-* Ncatnu = current pointer in the buffer *
-* Lbatnu = logical flag for atmospheric neutrino buffering *
-* Lunatn = logical unit for the atmospheric neutrino file *
-* *
-* ALL VARIABLES ARE MEANT IN THE FRAME WHERE THE NEUTRINO POSITION *
-* IS ALONG (0,0,1), THAT IS Z IS THE LOCAL ZENITH AXIS, X IS POIN- *
-* TING NORTH, AND Y IS POINTING WEST *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( MXATNU = 2000 )
- LOGICAL LBATNU
-*
- COMMON / ATNUBF / ENATNU (MXATNU), DIATNU (MXATNU),
- & THATNU (MXATNU), PHATNU (MXATNU),
- & WTATNU (MXATNU), PMATNU (MXATNU),
- & PFATNU (MXATNU), PGATNU (MXATNU),
- & XPATNU (MXATNU), YPATNU (MXATNU),
- & ZPATNU (MXATNU), TPATNU (MXATNU),
- & PPATNU (MXATNU), WPATNU,
- & IDATNU (MXATNU), LGATNU (MXATNU),
- & IPATNU (MXATNU), IFATNU (MXATNU),
- & IGATNU (MXATNU), ICTFNU (MXATNU),
- & NPATNU, NCATNU, LBATNU, LUNATN
+++ /dev/null
-*$ CREATE ATNUBM.ADD
-*COPY ATNUBM
-*
-*=== atnubm ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* ATmospheric NeUtrino Buffer for Mirrors neutrinos: *
-* *
-* Created on 29 may 1996 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 15-dec-99 by Alfredo Ferrari *
-* *
-* Description of variables: *
-* *
-* Idatnm = neutrino id (Paprop numbering) *
-* Lgatnm = neutrino generation *
-* Enatnm = neutrino energy (GeV) *
-* Diatnm = neutrino production height or distance (cm) *
-* Thatnm = neutrino direction polar (theta) angle (rad) *
-* Phatnm = neutrino direction azimuthal (phi) angle (rad) *
-* Wtatnm = neutrino weight (such to be automatically norm- *
-* alized to fluence per unit time and area) *
-* Ipatnm = parent cosmic ray id (Z + 100 x A) *
-* Ictfnm = i1 + j1 x 3 + i2 x 9 + j2 x 27 + i3 x 81 + j3 x 243*
-* + i4 x 729 + j4 x 2187 + i5 x 6561 + j5 x 19683 *
-* ik = cutoff flag for the k_th location, direct nu *
-* jk = cutoff flag for the k_th location, mirror nu *
-* = 0 <-> not yet checked *
-* = 1 <-> neutrino not cutoffed *
-* = 2 <-> neutrino cutoffed *
-* Ifatnm = "father" hadron/muon Fluka id *
-* Igatnm = "grandfather" hadron Fluka id *
-* Pmatnm = parent cosmic ray momentum (GeV/c/amu) *
-* Pfatnm = "father" hadron/muon momentum (GeV/c) *
-* Pgatnm = "grandfather" hadron momentum (GeV/c) *
-* Xpatnm = parent cosmic ray 1st interaction x coord. (cm) *
-* Ypatnm = parent cosmic ray 1st interaction y coord. (cm) *
-* Zpatnm = parent cosmic ray 1st interaction z coord. (cm) *
-* Tpatnm = parent cosmic ray direction polar angle (rad) *
-* Ppatnm = parent cosmic ray direction azimuthal angle (rad) *
-* Ncatnm = current pointer in the buffer *
-* *
-* ALL VARIABLES ARE MEANT IN THE FRAME WHERE THE NEUTRINO POSITION *
-* IS ALONG (0,0,1), THAT IS Z IS THE LOCAL ZENITH AXIS, X IS POIN- *
-* TING NORTH, AND Y IS POINTING WEST *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( MXATNM = MXATNU )
- COMMON / ATNUBM / ENATNM (MXATNM), DIATNM (MXATNM),
- & THATNM (MXATNM), PHATNM (MXATNM),
- & WTATNM (MXATNM), PMATNM (MXATNM),
- & PFATNM (MXATNM), PGATNM (MXATNM),
- & XPATNM (MXATNM), YPATNM (MXATNM),
- & ZPATNM (MXATNM), TPATNM (MXATNM),
- & PPATNM (MXATNM),
- & IDATNM (MXATNM), LGATNM (MXATNM),
- & IPATNM (MXATNM), IFATNM (MXATNM),
- & IGATNM (MXATNM), ICTFNM (MXATNM),
- & NCATNM
-
+++ /dev/null
-*$ CREATE ATNUCM.ADD
-*COPY ATNUCM
-*
-*=== atnucm ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* ATmospheric NeUtrino CoMmon: *
-* *
-* Created on 29 may 1996 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 24-feb-00 by Alfredo Ferrari *
-* *
-* *
-*----------------------------------------------------------------------*
-*
-* Earth magnetic field (Tesla) at surface at (earth) magnetic equator
- PARAMETER ( BEQUA0 = 3.12 D-05 )
-*
- COMMON / ATNUCM / BEQUAT, EARDIP, UDIPOL, VDIPOL, WDIPOL, BLATTD,
- & XDIPOL, YDIPOL, ZDIPOL, ALATDT (5), ALONDT (5),
- & NNUDTC, INUDTC, IMGFLG, IFLG3D, IFLOSC, IFLAMS,
- & NATMSH, LCFLOC (5)
- COMMON / ATNUCH / FLDATE
- CHARACTER FLDATE*7
- LOGICAL LCFLOC
-
-
+++ /dev/null
-*$ CREATE AUXPAR.ADD
-*COPY AUXPAR
-*
-*=== Auxpar ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* New version of Auxpar: *
-* *
-* Created on 20-january-1996 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 10-oct-96 by Alfredo Ferrari *
-* *
-* Included in the following subroutines or functions: not updated *
-* *
-* Description of the common block(s) and variable(s) *
-* *
-* Pxa(i) = X-component of the momentum of the i_th produced *
-* particle *
-* Pya(i) = Y-component of the momentum of the i_th produced *
-* particle *
-* Pza(i) = Z-component of the momentum of the i_th produced *
-* particle *
-* Hepa(i) = Total energy of the i_th produced particle *
-* Ama(i) = Mass of the i_th produced particle *
-* Icha(i) = Charge of the i_th produced particle *
-* Ibara(i) = Baryon number of the i_th produced particle *
-* Nrea(i) = Identity (part scheme) of the i_th produced particle *
-* Ichnfa(3,i) = Array containing additional information about pro- *
-* duction verteces, ranking etc *
-* Ana(i) = Literal name of the i_th produced particle *
-* *
-*----------------------------------------------------------------------*
-*
- CHARACTER*8 ANA
- COMMON / AUXPAR / PXA (MXPDPM), PYA (MXPDPM), PZA (MXPDPM),
- & HEPA (MXPDPM), AMA (MXPDPM), ICHA (MXPDPM),
- & IBARA (MXPDPM), NREA (MXPDPM),
- & ICHNFA(3,MXPDPM)
- COMMON / CHAXPR / ANA (MXPDPM)
-
+++ /dev/null
-*$ CREATE BALANC.ADD
-*COPY BALANC
-* *
-*=== balanc ===========================================================*
-* *
-*----------------------------------------------------------------------*
-* *
-* Include file Balanc *
-* *
-* Created on 20 april 1990 by Alfredo Ferrari *
-* INFN Milan *
-* *
-* Last change on 09-nov-99 by Alfredo Ferrari, INFN - Milan *
-* *
-* Actual common name changed from BALANC to CMBLNC on 22-jan-01 *
-* to get around a bug in the Linux compiler/linker *
-* *
-* Included in the following routines: not updated *
-* *
-* Kpprct = Id (Part) of the projectile of the current interac. *
-* Ptprct = Momentum of the projectile of the current interac. *
-* Px,y,zprct = Mom.comp. of the projectile of the current interac. *
-* Ax,y,zprct = Orb.Ang.Mom.comp. of the projectile of the current *
-* interac. *
-* Ekprct = Kin.ener. of the projectile of the current interac. *
-* Umoini = (initial and ... possibly final) invariant mass *
-* Uthinl = invariant mass threshold for inelastic scattering *
-* (h,h'X) *
-* Uthinl = invariant mass threshold for inelastic scattering *
-* (h,h'X) *
-* Uthcxp = threshold for charge exchange (h0,h-X)/(h-,h0X) *
-* Uthcxm = threshold for charge exchange (h-,h0X)/(h0,h+X) *
-* Jsprct = projectile spin (in hbar/2 units) *
-* Ipprct = projectile parity *
-* Llprct = Proj-target orbital angular momentum (hbar units) *
-* Jstrgt = target spin (in hbar/2 units) *
-* Iptrgt = target parity *
-* Lresmp = logical flag for resampling the whole event *
-* Lnupau = logical flag for resampling the target nucleus *
-* after a Pauli rejected neutrino interaction *
-* *
-*----------------------------------------------------------------------*
-*
- LOGICAL LRESMP, LNUPAU, LEVDIF, LPRDIF, LSCHAI
- COMMON /CMBLNC/ EKPRCT, PTPRCT, PXPRCT, PYPRCT, PZPRCT, AXPRCT,
- & AYPRCT, AZPRCT, ETTOT, PTTOT, PXTTOT, PYTTOT,
- & PZTTOT, ENUCR, PXNUCR, PYNUCR, PZNUCR, AXNUCR,
- & AYNUCR, AZNUCR, EINTR, PXINTR, PYINTR, PZINTR,
- & AXINTR, AYINTR, AZINTR, EINCP, EINCN, TVGREY,
- & TVGRE0, TVEUZ, EUZ, PUX, PUY, PUZ,
- & EFRM, PXFRM, PYFRM, PZFRM, PSEA, UMOINI,
- & UTHINL, UTHCXP, UTHCXM,
- & NGREYP, NGREYN, ICU, IBU, ICNUCR, IBNUCR,
- & ICINTR, IBINTR, KPPRCT, JSPRCT, IPPRCT, LLPRCT,
- & LRESMP, LNUPAU, LEVDIF, LPRDIF, LSCHAI
-
+++ /dev/null
-*$ CREATE BAMJCM.ADD
-*COPY BAMJCM
-*
-*=== bamjcm ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* BAMJev CoMmon: *
-* *
-* Created on 01 november 1997 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 04-dec-97 by Alfredo Ferrari *
-* *
-* included in: *
-* bamjet *
-* *
-* When changing kmxjcm dimension look also at verein!!!!! *
-* *
-*----------------------------------------------------------------------*
-*
- LOGICAL LOQ1, LOQ2
- PARAMETER ( KMXJCM = 100 )
-*
- COMMON / BAMJCM / RPX (0:KMXJCM,0:1), RPY (0:KMXJCM,0:1),
- & RPZ (0:KMXJCM,0:1), RE (0:KMXJCM,0:1),
- & RPX1 (0:KMXJCM,0:1), RPX2 (0:KMXJCM,0:1),
- & RPY1 (0:KMXJCM,0:1), RPY2 (0:KMXJCM,0:1),
- & ISK12(0:KMXJCM,0:1), KFR1 (0:KMXJCM,0:1),
- & KFR2 (0:KMXJCM,0:1), IV (0:KMXJCM,0:1),
- & LOQ1 (0:KMXJCM,0:1), LOQ2 (0:KMXJCM,0:1)
-
+++ /dev/null
-*$ CREATE BEAM.ADD
-*COPY BEAM
-*
-*=== Beam =============================================================*
-*
-*----------------------------------------------------------------------*
-* include file: beam copy created 26/11/86 by pa*
-* *
-* changes: on 22-oct-1993 by Alfredo Ferrari *
-* *
-* included in the following subroutines or functions: not updated *
-* *
-* description of the common block(s) and variable(s) *
-* *
-* *
-* /beam/ contains properties of the beam of primary particles *
-* pbeam = average momentum of the beam particles in gev/c *
-* dpbeam = momentum spread of the beam in gev/c *
-* divbm = angular divergense of the beam in mrad *
-* xspot = beam width in x-direction in cm *
-* yspot = beam width in y-direction in cm *
-* xina = x-coordinate of the centre of the beam spot *
-* yina = y-coordinate of the centre of the beam spot *
-* zina = z-coordinate of the centre of the beam spot *
-* tinx = direction cosine of the beam with respect to *
-* x-axis *
-* tiny = direction cosine of the beam with respect to *
-* y-axis *
-* tinz = direction cosine of the beam with respect to *
-* z-axis *
-* tinpx = direction cosine of the beam polariz. with respect to*
-* x-axis *
-* tinpy = direction cosine of the beam polariz. with respect to*
-* y-axis *
-* tinpz = direction cosine of the beam polariz. with respect to*
-* z-axis *
-* polfra = polarization fraction *
-* nforce = number of the region of forced interaction *
-* xfor = x-coord. of the starting point of the region nforce *
-* yfor = y-coord. of the starting point of the region nforce *
-* zfor = z-coord. of the starting point of the region nforce *
-* disfor = thickness of the region nforce in cm *
-* wfor = relative weight of the particle due to forcing *
-* ijbeam = beam particle type (see btype in /paprop/) *
-* ijhion = heavy ion type if ijbeam = -2 *
-* ipbite = flag describing the shape of the momentum *
-* distribution of the beam *
-* 0=rectangular, 1=gaussian *
-* idiv = flag describing the shape of the angular *
-* divergence distribution of the beam *
-* 0=rectangular, 1=gaussian *
-* ixspot = flag describing the shape of the spatial *
-* distribution of the beam spot in x-direction *
-* 0=rectangular, 1=gaussian *
-* iyspot = flag describing the shape of the spatial *
-* distribution of the beam spot in y-direction *
-* 0=rectangular, 1=gaussian *
-* beawei = weight of the beam particles *
-* lbeamc = flag for an annular beam *
-* lpperp = flag for polar. perp. to the beam direction *
-* lpfrac = flag for interpreting the polar. fraction *
-* *
-*----------------------------------------------------------------------*
- LOGICAL LBEAMC, LPPERP, LPFRAC
- COMMON / BEAM / PBEAM , DPBEAM, DIVBM , XSPOT , YSPOT , XINA ,
- 1 YINA , ZINA , TINX , TINY , TINZ , TINPX ,
- 2 TINPY , TINPZ , POLFRA, BEAWEI, XFOR , YFOR ,
- 3 ZFOR , DISFOR, WFOR , IJBEAM, IJHION, IPBITE,
- 4 IDIV , IXSPOT, IYSPOT, NFORCE, LBEAMC, LPPERP,
- 5 LPFRAC
-
+++ /dev/null
-*$ CREATE BEMIT.ADD
-*COPY BEMIT
-*----------------------------------------------------------------------*
-* include file: bemit copy created 26/11/86 by p*
-* changes: none *
-* included in the following subroutines or functions: not updated *
-* *
-* description of the common block(s) and variable(s) *
-* *
-* /bemit/ contains beam properties when emittances specified *
-* verts = s-parameter for the vertical focus, is distance of *
-* v-focus from xina,yina,zina along the beam, *
-* +ve if focus upstream of xina,yina,zina. *
-* vertl = vertical l-parameter of the beam *
-* verte = vertical emittance *
-* hors = s-parameter for horizontal focus, is distance of *
-* h-focus from xina,yina,zina along the beam, *
-* +ve if focus upstream of xina,yina,zina. *
-* horl = horizontal l-parameter of the beam *
-* hore = horizontal emittance *
-* vsig = sigma of spatial v-distribution *
-* vpsig = sigma of angular vprime-distribution *
-* hsig = sigma of spatial h-distribution *
-* hpsig = sigma of angular hprime-distribution *
-* txv = x-direction cosine of v-axis *
-* tyv = y-direction cosine of v-axis *
-* tzv = z-direction cosine of v-axis *
-* txh = x-direction cosine of h-axis *
-* tyh = y direction cosine of h-axis *
-* tzh = z-direction cosine of h-axis *
-* ibemit = 1 if emittance option chosen, if not = 0 *
-*----------------------------------------------------------------------*
- COMMON/BEMIT/VERTS,VERTL,VERTE,HORS,HORL,HORE,VSIG,VPSIG,
- 1 HSIG,HPSIG,TXV,TYV,TZV,TXH,TYH,TZH,IBEMIT
-
+++ /dev/null
-*$ CREATE BLNKCM.ADD
-*COPY BLNKCM
-*
-*=== blnkcm ===========================================================*
-*
-*======================================================================*
-* *
-* Include file Blnkcm : *
-* *
-* Created on 3 september 1989 by Alfredo Ferrari *
-* INFN, Milan *
-* *
-* Last change on 19-aug-00 by Alfredo Ferrari *
-* *
-* Blnkcm: this is the blank common for the Vax version of Fluka *
-* *
-* W A R N I N G !!!! check also blnkdm module for any change!!! *
-* *
-* Nblnmx: blank common dimension in real*8 units! *
-* *
-* Addrcm: this common contains all useful addresses for the blank *
-* common (in real*4 or i*4 numeration!!!!!!!!!!!!!!!!) *
-* *
-* Mblnmx = blank common dimension in i*4/real*4 units *
-* *
-* Kblnkl = Last memory location used in the blank common *
-* *
-* Kgmbgn = Beginning of geometry data *
-* *
-* Kgmlst = Last memory location for the geometry data *
-* *
-* Kcmbgn = Beginning of the region dependent Comsco energy *
-* and stars accumulation arrays *
-* (note this address if for zero index!!) *
-* *
-* Kcmlst = Last memory location of the region dependent *
-* Comsco energy and stars accumulation arrays *
-* *
-* Kisbgn = Beginning of isotope data tabulations *
-* *
-* Kislst = Last memory location of isotope data tabulations*
-* *
-* Kdtbgn = Beginning of detector data *
-* *
-* Kdtlst = Last memory location for the detector data *
-* *
-* Kubbgn = Beginning of user defined binning storage *
-* *
-* Kublst = Last memory location for user defined binnings *
-* *
-* Kuxbgn = Beginning of user defined bdrx storage *
-* *
-* Kuxlst = Last memory location for user defined bdrx *
-* *
-* Ktcbgn = Beginning of user defined track-length and/or *
-* collision estimators *
-* *
-* Ktclst = Last memory location for user defined track- *
-* length and/or collision density estimators *
-* *
-* Krnbgn = Beginning of user defined residual nuclei sco- *
-* ring *
-* (note this address is for zero index!!) *
-* *
-* Krnlst = Last memory location for user defined residual *
-* nuclei scoring *
-* *
-* Kylbgn = Beginning of user defined yield estimator *
-* (note this address is for zero index!!) *
-* *
-* Kyllst = Last memory location for user defined yield *
-* estimators *
-* *
-* Kxsbgn = Beginning of cross section storage *
-* *
-* Kxslst = Last memory location for cross section storage *
-* *
-* Kihbgn = Beginning of region importance storage *
-* for high energy particles *
-* (note this address is for zero index!!) *
-* *
-* Kihlst = Last memory location for region importances *
-* for high energy particles *
-* *
-* Kinbgn = Beginning of region importance storage *
-* for low energy neutrons *
-* (note this address is for zero index!!) *
-* *
-* Kinlst = Last memory location for region importances *
-* for low energy neutrons *
-* *
-* Kiebgn = Beginning of region importance storage *
-* for em cascade particles *
-* (note this address is for zero index!!) *
-* *
-* Kielst = Last memory location for region importances *
-* for em cascade particles *
-* *
-* Ketbgn = Beginning of exp. transf. parameters *
-* (note this address is for zero index!!) *
-* *
-* Ketlst = Last memory location for exp. transf. parameters*
-* *
-* Krrbgn = Beginning of region RR storage *
-* (note this address is for zero index!!) *
-* *
-* Krrlst = Last memory location for region RR storage *
-* *
-* Kglbgn = Beginning of the region dependent non-analog *
-* absorption group limit storage *
-* (note this address is for zero index!!) *
-* *
-* Kgllst = Last memory location of the region dependent *
-* non-analog absorption group limits *
-* *
-* Knabgn = Beginning of the region dependent non-analog *
-* absorption factor storage *
-* (note this address is for zero index!!) *
-* *
-* Knalst = Last memory location of the region dependent *
-* non-analog absorption factors *
-* *
-* Kgdbgn = Beginning of the region dependent biased down- *
-* scattering group limit storage *
-* (note this address is for zero index!!) *
-* *
-* Kgdlst = Last memory location of the region dependent *
-* biased downscattering group limits *
-* *
-* Kdwbgn = Beginning of the region dependent biased down- *
-* scattering factor storage *
-* (note this address is for zero index!!) *
-* *
-* Kdwlst = Last memory location of the region dependent *
-* biased downscattering factors *
-* *
-* Kgcbgn = Beginning of the region dependent group cut-off *
-* storage *
-* (note this address is for zero index!!) *
-* *
-* Kgclst = Last memory location of the region dependent *
-* group cut-off's *
-* *
-* Kwlbgn = Beginning of the region dependent weight window *
-* lower bound *
-* (note this address is for zero index!!) *
-* *
-* Kwllst = Last memory location of the region dependent *
-* weight window lower bound *
-* *
-* Kwhbgn = Beginning of the region dependent weight window *
-* higher bound *
-* (note this address is for zero index!!) *
-* *
-* Kwhlst = Last memory location of the region dependent *
-* weight window higher bound *
-* *
-* Kwmbgn = Beginning of the region dependent weight window *
-* threshold multiplication factor *
-* (note this address is for zero index!!) *
-* *
-* Kwmlst = Last memory location of the region dependent *
-* weight window threshold multiplication factor *
-* *
-* Kwsbgn = Beginning of the region dependent weight window *
-* shape profile index for low energy neutrons *
-* (note this address is for zero index!!) *
-* *
-* Kwslst = Last memory location of the region dependent *
-* shape profile index for low energy neutrons *
-* *
-* Kndbgn = Beginning of nuclear data tabulations required *
-* by the preequilibrium model *
-* *
-* Kndlst = Last memory location of nuclear data storage *
-* *
-* Kdpbgn = Beginning of the dp/dx tabulation storage *
-* (note this address is for zero index!!) *
-* *
-* Kdplst = Last memory location of dp/dx tabulations *
-* *
-* Krgbgn = Beginning of the range tabulation storage *
-* (note this address is for zero index!!) *
-* *
-* Krglst = Last memory location of range tabulations *
-* *
-* Ksgbgn = Beginning of the cross section storage *
-* (note this address is for zero index!!) *
-* *
-* Ksglst = Last memory location of cross section *
-* tabulations *
-* *
-* Kbrbgn = Beginning of the brem. (e+,e-) storage *
-* (note this address is for zero index!!) *
-* *
-* Kbrlst = Last memory location of the brem. (e+,e-) *
-* storage *
-* *
-* Kfybgn = Beginning of the fission yield storage *
-* (note this address is for zero index!!) *
-* *
-* Kfylst = Last memory location of the fission yield *
-* storage *
-* *
-* Kpwbgn = Beginning of the neutron pointwise cross section*
-* storage (note this address is for zero index!!) *
-* *
-* Kpwlst = Last memory location of the neutron pointwise *
-* cross section storage *
-* *
-* Kgrbgn = Beginning of the GDR cross section storage *
-* (note this address is for zero index!!) *
-* *
-* Kgrlst = Last memory location of the GDR cross section *
-* storage *
-* *
-* Ktmbgn = Beginning of the temporary storage *
-* (note this address is for zero index!!) *
-* *
-* W A R N I N G the blank common is initialized to 0 as a I*4 *
-* array!!!!!!!!!!!!! *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( NBLNMX = 6000000 )
- DIMENSION GMSTOR ( NBLNMX ), BRMBRR ( NBLNMX ), BRMEXP ( NBLNMX ),
- & BRMSIG ( NBLNMX ), SIGGTT ( KALGNM*NBLNMX ),
- & SIGGDR ( KALGNM*NBLNMX ), COMSCO ( NBLNMX ),
- & LBSTOR ( KALGNM*NBLNMX )
- REAL SIGGTT, SIGGDR
- LOGICAL LBSTOR
- COMMON NSTOR ( KALGNM*NBLNMX )
- COMMON / ADDRCM / MBLNMX, KBLNKL, KGMBGN, KGMLST, KCMBGN, KCMLST,
- & KISBGN, KISLST, KDTBGN, KDTLST, KUBBGN, KUBLST,
- & KUXBGN, KUXLST, KTCBGN, KTCLST, KRNBGN, KRNLST,
- & KYLBGN, KYLLST, KXSBGN, KXSLST, KIHBGN, KIHLST,
- & KINBGN, KINLST, KIEBGN, KIELST, KETBGN, KETLST,
- & KRRBGN, KRRLST, KGLBGN, KGLLST, KNABGN, KNALST,
- & KGDBGN, KGDLST, KDWBGN, KDWLST, KGCBGN, KGCLST,
- & KWLBGN, KWLLST, KWHBGN, KWHLST, KWMBGN, KWMLST,
- & KWSBGN, KWSLST, KNDBGN, KNDLST, KDPBGN, KDPLST,
- & KRGBGN, KRGLST, KSGBGN, KSGLST, KBRBGN, KBRLST,
- & KFYBGN, KFYLST, KPWBGN, KPWLST, KGRBGN, KGRLST,
- & KTMBGN
-
- EQUIVALENCE ( NSTOR (1), GMSTOR (1) )
- EQUIVALENCE ( NSTOR (1), BRMBRR (1) )
- EQUIVALENCE ( NSTOR (1), BRMEXP (1) )
- EQUIVALENCE ( NSTOR (1), BRMSIG (1) )
- EQUIVALENCE ( NSTOR (1), COMSCO (1) )
- EQUIVALENCE ( NSTOR (1), SIGGTT (1) )
- EQUIVALENCE ( NSTOR (1), SIGGDR (1) )
- EQUIVALENCE ( NSTOR (1), LBSTOR (1) )
-
+++ /dev/null
-*$ CREATE BLNKDM.ADD
-*COPY BLNKDM
-*
-*=== blnkdm ===========================================================*
-*
-*======================================================================*
-* *
-* Include file Blnkdm : *
-* *
-* Created on 3 september 1989 by Alfredo Ferrari *
-* INFN, Milan *
-* *
-* Last change on 19-aug-00 by Alfredo Ferrari *
-* *
-* Blnkdm: this is dummy version of the blank common for the Vax *
-* version of Fluka. It is included in most routines to *
-* avoid to compile them again if the common dimension have *
-* been changed!! *
-* *
-* W A R N I N G !!!! check also blnkcm module for any change!!! *
-* *
-* *
-* Addrcm: this common contains all useful addresses for the blank *
-* common (in real*4 or i*4 numeration!!!!!!!!!!!!!!!!) *
-* *
-* Mblnmx = blank common dimension in i*4/real*4 units *
-* *
-* Kblnkl = Last memory location used in the blank common *
-* *
-* Kgmbgn = Beginning of geometry data *
-* *
-* Kgmlst = Last memory location for the geometry data *
-* *
-* Kcmbgn = Beginning of the region dependent Comsco energy *
-* and stars accumulation arrays *
-* (note this address if for zero index!!) *
-* *
-* Kcmlst = Last memory location of the region dependent *
-* Comsco energy and stars accumulation arrays *
-* *
-* Kisbgn = Beginning of isotope data tabulations *
-* *
-* Kislst = Last memory location of isotope data tabulations*
-* *
-* Kdtbgn = Beginning of detector data *
-* *
-* Kdtlst = Last memory location for the detector data *
-* *
-* Kubbgn = Beginning of user defined binning storage *
-* *
-* Kublst = Last memory location for user defined binnings *
-* *
-* Kuxbgn = Beginning of user defined bdrx storage *
-* *
-* Kuxlst = Last memory location for user defined bdrx *
-* *
-* Ktcbgn = Beginning of user defined track-length and/or *
-* collision estimators *
-* *
-* Ktclst = Last memory location for user defined track- *
-* length and/or collision density estimators *
-* *
-* Krnbgn = Beginning of user defined residual nuclei sco- *
-* ring *
-* (note this address is for zero index!!) *
-* *
-* Krnlst = Last memory location for user defined residual *
-* nuclei scoring *
-* *
-* Kylbgn = Beginning of user defined yield estimator *
-* (note this address is for zero index!!) *
-* *
-* Kyllst = Last memory location for user defined yield *
-* estimators *
-* *
-* Kxsbgn = Beginning of cross section storage *
-* *
-* Kxslst = Last memory location for cross section storage *
-* *
-* Kihbgn = Beginning of region importance storage *
-* for high energy particles *
-* (note this address is for zero index!!) *
-* *
-* Kihlst = Last memory location for region importances *
-* for high energy particles *
-* *
-* Kinbgn = Beginning of region importance storage *
-* for low energy neutrons *
-* (note this address is for zero index!!) *
-* *
-* Kinlst = Last memory location for region importances *
-* for low energy neutrons *
-* *
-* Kiebgn = Beginning of region importance storage *
-* for em cascade particles *
-* (note this address is for zero index!!) *
-* *
-* Kielst = Last memory location for region importances *
-* for em cascade particles *
-* *
-* Ketbgn = Beginning of exp. transf. parameters *
-* (note this address is for zero index!!) *
-* *
-* Ketlst = Last memory location for exp. transf. parameters*
-* *
-* Krrbgn = Beginning of region RR storage *
-* (note this address is for zero index!!) *
-* *
-* Krrlst = Last memory location for region RR storage *
-* *
-* Kglbgn = Beginning of the region dependent non-analog *
-* absorption group limit storage *
-* (note this address is for zero index!!) *
-* *
-* Kgllst = Last memory location of the region dependent *
-* non-analog absorption group limits *
-* *
-* Knabgn = Beginning of the region dependent non-analog *
-* absorption factor storage *
-* (note this address is for zero index!!) *
-* *
-* Knalst = Last memory location of the region dependent *
-* non-analog absorption factors *
-* *
-* Kgdbgn = Beginning of the region dependent biased down- *
-* scattering group limit storage *
-* (note this address is for zero index!!) *
-* *
-* Kgdlst = Last memory location of the region dependent *
-* biased downscattering group limits *
-* *
-* Kdwbgn = Beginning of the region dependent biased down- *
-* scattering factor storage *
-* (note this address is for zero index!!) *
-* *
-* Kdwlst = Last memory location of the region dependent *
-* biased downscattering factors *
-* *
-* Kgcbgn = Beginning of the region dependent group cut-off *
-* storage *
-* (note this address is for zero index!!) *
-* *
-* Kgclst = Last memory location of the region dependent *
-* group cut-off's *
-* *
-* Kwlbgn = Beginning of the region dependent weight window *
-* lower bound *
-* (note this address is for zero index!!) *
-* *
-* Kwllst = Last memory location of the region dependent *
-* weight window lower bound *
-* *
-* Kwhbgn = Beginning of the region dependent weight window *
-* higher bound *
-* (note this address is for zero index!!) *
-* *
-* Kwhlst = Last memory location of the region dependent *
-* weight window higher bound *
-* *
-* Kwmbgn = Beginning of the region dependent weight window *
-* threshold multiplication factor *
-* (note this address is for zero index!!) *
-* *
-* Kwmlst = Last memory location of the region dependent *
-* weight window threshold multiplication factor *
-* *
-* Kwsbgn = Beginning of the region dependent weight window *
-* shape profile index for low energy neutrons *
-* (note this address is for zero index!!) *
-* *
-* Kwslst = Last memory location of the region dependent *
-* shape profile index for low energy neutrons *
-* *
-* Kndbgn = Beginning of nuclear data tabulations required *
-* by the preequilibrium model *
-* *
-* Kndlst = Last memory location of nuclear data storage *
-* *
-* Kdpbgn = Beginning of the dp/dx tabulation storage *
-* (note this address is for zero index!!) *
-* *
-* Kdplst = Last memory location of dp/dx tabulations *
-* *
-* Krgbgn = Beginning of the range tabulation storage *
-* (note this address is for zero index!!) *
-* *
-* Krglst = Last memory location of range tabulations *
-* *
-* Ksgbgn = Beginning of the cross section storage *
-* (note this address is for zero index!!) *
-* *
-* Ksglst = Last memory location of cross section *
-* tabulations *
-* *
-* Kbrbgn = Beginning of the brem. (e+,e-) storage *
-* (note this address is for zero index!!) *
-* *
-* Kbrlst = Last memory location of the brem. (e+,e-) *
-* storage *
-* *
-* Kfybgn = Beginning of the fission yield storage *
-* (note this address is for zero index!!) *
-* *
-* Kfylst = Last memory location of the fission yield *
-* storage *
-* *
-* Kpwbgn = Beginning of the neutron pointwise cross section*
-* storage (note this address is for zero index!!) *
-* *
-* Kpwlst = Last memory location of the neutron pointwise *
-* cross section storage *
-* *
-* Kgrbgn = Beginning of the GDR cross section storage *
-* (note this address is for zero index!!) *
-* *
-* Kgrlst = Last memory location of the GDR cross section *
-* storage *
-* *
-* Ktmbgn = Beginning of the temporary storage *
-* (note this address is for zero index!!) *
-* *
-* W A R N I N G the blank common is initialized to 0 as a I*4 *
-* array!!!!!!!!!!!!! *
-* *
-*----------------------------------------------------------------------*
-*
- DIMENSION GMSTOR ( 2 ), BRMBRR ( 2 ), BRMEXP ( 2 ), BRMSIG ( 2 ),
- & SIGGTT ( 2 ), SIGGDR ( 2 ), COMSCO ( 2 ), LBSTOR ( 2 )
- REAL SIGGTT, SIGGDR
- LOGICAL LBSTOR
- COMMON NSTOR ( 2 )
- COMMON / ADDRCM / MBLNMX, KBLNKL, KGMBGN, KGMLST, KCMBGN, KCMLST,
- & KISBGN, KISLST, KDTBGN, KDTLST, KUBBGN, KUBLST,
- & KUXBGN, KUXLST, KTCBGN, KTCLST, KRNBGN, KRNLST,
- & KYLBGN, KYLLST, KXSBGN, KXSLST, KIHBGN, KIHLST,
- & KINBGN, KINLST, KIEBGN, KIELST, KETBGN, KETLST,
- & KRRBGN, KRRLST, KGLBGN, KGLLST, KNABGN, KNALST,
- & KGDBGN, KGDLST, KDWBGN, KDWLST, KGCBGN, KGCLST,
- & KWLBGN, KWLLST, KWHBGN, KWHLST, KWMBGN, KWMLST,
- & KWSBGN, KWSLST, KNDBGN, KNDLST, KDPBGN, KDPLST,
- & KRGBGN, KRGLST, KSGBGN, KSGLST, KBRBGN, KBRLST,
- & KFYBGN, KFYLST, KPWBGN, KPWLST, KGRBGN, KGRLST,
- & KTMBGN
-
- EQUIVALENCE ( NSTOR (1), GMSTOR (1) )
- EQUIVALENCE ( NSTOR (1), BRMBRR (1) )
- EQUIVALENCE ( NSTOR (1), BRMEXP (1) )
- EQUIVALENCE ( NSTOR (1), BRMSIG (1) )
- EQUIVALENCE ( NSTOR (1), COMSCO (1) )
- EQUIVALENCE ( NSTOR (1), SIGGTT (1) )
- EQUIVALENCE ( NSTOR (1), SIGGDR (1) )
- EQUIVALENCE ( NSTOR (1), LBSTOR (1) )
-
+++ /dev/null
-*$ CREATE BLNTMP.ADD
-*COPY BLNTMP
-* *
-*=== blntmp ===========================================================*
-* *
-*----------------------------------------------------------------------*
-* *
-* Blntmp: created on 9 july 1990 by Alfredo Ferrari *
-* *
-* included in : *
-* Blnset *
-* Fluka *
-* *
-* The following are all temporary locations in I*4 addresses !! *
-* *
-* Kihbtm = Beginning of region importance storage *
-* for high energy particles *
-* (note this address if for zero index!!) *
-* *
-* Kinbtm = Beginning of region importance storage *
-* for low energy neutrons *
-* (note this address if for zero index!!) *
-* *
-* Kiebtm = Beginning of region importance storage *
-* for em cascade particles *
-* (note this address if for zero index!!) *
-* *
-* Krrbtm = Beginning of region dependent inelastic inte- *
-* raction RR/Splitting fator storage *
-* (note this address if for zero index!!) *
-* *
-* Kglbtm = Beginning of the region dependent non-analog *
-* absorption group limit storage *
-* (note this address if for zero index!!) *
-* *
-* Knabtm = Beginning of the region dependent non-analog *
-* absorption factor storage *
-* (note this address if for zero index!!) *
-* *
-* Kgcbtm = Beginning of the region dependent group cut-off *
-* storage *
-* (note this address if for zero index!!) *
-* *
-* Kgdwtm = Beginning of the region dependent biased *
-* downscattering group limit storage *
-* (note this address if for zero index!!) *
-* *
-* Kbdwtm = Beginning of the region dependent biased *
-* downscattering factor storage *
-* (note this address if for zero index!!) *
-* *
-* Kwlotm = Beginning of the region dependent weight window *
-* lower bound storage *
-* (note this address if for zero index!!) *
-* *
-* Kwhitm = Beginning of the region dependent weight window *
-* higher bound storage *
-* (note this address if for zero index!!) *
-* *
-* Kwmutm = Beginning of the region dependent WW threshold *
-* multiplicative factor storage *
-* (note this address if for zero index!!) *
-* *
-* Kwshtm = Beginning of the region dependent WW shape *
-* profile index storage *
-* (note this address if for zero index!!) *
-* *
-* Kexttm = Beginning of the region dependent exponential *
-* transformation parameter temporary storage *
-* (note this address if for zero index!!) *
-* *
-* Kstxtm = Beginning of the region dependent maximum step *
-* size temporary storage *
-* (note this address if for zero index!!) *
-* *
-* Kstntm = Beginning of the region dependent minimum step *
-* size temporary storage *
-* (note this address if for zero index!!) *
-* *
-* Kecttm = Beginning of the region dependent electron cut *
-* off energy temporary storage *
-* (note this address if for zero index!!) *
-* *
-* Kpcttm = Beginning of the region dependent photon cut *
-* off energy temporary storage *
-* (note this address if for zero index!!) *
-* *
-* Klpbtm = Beginning of the region dependent leading par- *
-* ticle flag temporary storage *
-* (note this address if for zero index!!) *
-* *
-* Nxxrgn = Number of regions for which the temporary sto- *
-* rage must be set up *
-* *
-*----------------------------------------------------------------------*
-*
- COMMON / BLNTMP / KIHBTM, KINBTM, KIEBTM, KRRBTM, KGLBTM, KNABTM,
- & KGCBTM, KGDWTM, KBDWTM, KWLOTM, KWHITM, KWMUTM,
- & KWSHTM, KEXTTM, KSTXTM, KSTNTM, KECTTM, KPCTTM,
- & KLPBTM, NXXRGN
-
+++ /dev/null
-*$ CREATE BOUNDS.ADD
-*COPY BOUNDS
-*----------------------------------------------------------------------*
-* *
-* Common Bounds for EGS4 *
-* *
-*----------------------------------------------------------------------*
-*
- COMMON /BOUNDS/ ECUT(MXXRGN), PCUT(MXXRGN), VACDST
-
+++ /dev/null
-*$ CREATE BPTECM.ADD
-*COPY BPTECM
-*
-*=== Bptecm ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Created on 25 february 1998 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 27-feb-98 by Alfredo Ferrari *
-* *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( MXPRCN = 100 )
- PARAMETER ( MXALPH = 25 )
- PARAMETER ( MXBETA = 25 )
-* If Mxprcn is 100, then the prob of the last-1 percentiles
-* is 1 - 1/100, Mxdcds is giving Eps up to 1 - 1/10^(2+Mxdcds)
-* or more generally, up to 1 - 1/(Mxprcn x 10^Mxdcds)
- PARAMETER ( MXDCDS = 6 )
-* Epsepi must be smaller than the minimum probability left
-* by Mxdcds:
- PARAMETER ( EPSEPI = 1.D-09 )
-*
- COMMON / BPTECM / ALNAL0, ALNAL1, DLNALP, ALNBE0, ALNBE1, DLNBET,
- & EPSPER (0:MXPRCN,0:MXALPH,0:MXBETA),
- & EPSDCD (0:MXDCDS,0:MXALPH,0:MXBETA),
- & EPSOMN (0:MXALPH,0:MXBETA),
- & PRCOOF (0:MXALPH,0:MXBETA),
- & PRCOTN (0:MXALPH,0:MXBETA),
- & PRCHLF (0:MXALPH,0:MXBETA),
- & PRCHPI (0:MXALPH,0:MXBETA)
-
-
+++ /dev/null
-*$ CREATE BREANG.ADD
-*COPY BREANG
-*
-*=== breang ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Created on 22 march 1991 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 22-mar-91 by Alfredo Ferrari *
-* *
-* Included in the following routines: *
-* *
-* BDANDI *
-* BREMNW *
-* BREMS *
-* *
-* Mxphtb = number of intervals on which phi(y) is tabulated *
-* Yphimn = minimum value of y for which phi is taublated *
-* Yphirt = ratio of y between two tabulated points *
-* Yphimx = maximum value of y for which phi is taublated *
-* (=Yphimn*Yphirt**(Mxphtb-1)) *
-* Phiytb = tabulated values of phi *
-* Alymin = natural logarithm of Yphimn *
-* Alyrat = natural logarithm of Yphirt *
-* Alytra = natural logarithm of the max. y allowed for Xsitra *
-* Phia00 = used for asymptotic behaviour *
-* Phib00 = used for asymptotic behaviour *
-* Phic0 = used for asymptotic behaviour *
-* Phid0 = used for asymptotic behaviour *
-* ( for y > yphimx, Phi = Phia00 + Phib00 / y^2 *
-* for y < yphimn, Phi = log(y) + Phic0 + Phid0 x y^2 ) *
-* Accrit = parameter used for the Migdal polarization effect, *
-* given by Nel x Lambda_compt^2 x r0 / pi *
-* Zbrem = approximate "effective" Z for bremsstrahlung *
-* Fcoul = Coulomb factor fc(Z) *
-* Gmolie = factor entering Moliere's expansion of Thomas-Fermi *
-* form factor ( = Z^1/3/121 ) *
-* Algmol = natural logarithm of Gmolie *
-* *
-*----------------------------------------------------------------------*
-*
-* Tpifsc = 2 x pi x fine structure constant
- PARAMETER ( TPIFSC = 4.5850621648360624 D-02 )
- PARAMETER ( MXPHTB = 100 )
- PARAMETER ( YPHIMN = 1.0 D-01 )
- PARAMETER ( YPHIRT = 1.07 D+00 )
-*
- COMMON / BREANG / PHIYTB (MXPHTB), YPHIMX, ALYMIN, ALYRAT,
- & ALYTRA, PHIA00, PHIB00, PHIC0, PHID0,
- & ACCRIT (MXXMDE), ZBREM (MXXMDE),
- & FCOUL (MXXMDE), GMOLIE (MXXMDE),
- & ALGMOL (MXXMDE)
-
+++ /dev/null
-*$ CREATE BREMPR.ADD
-*COPY BREMPR
-*----------------------------------------------------------------------*
-* *
-* Common Brempr for EMF *
-* Mxxmde = maximum number of media in Emf *
-* *
-* Variables for the new bremsstrahlung: *
-* *
-* Thbrem = total electron/positron threshold energy for *
-* bremsstrahlung production (or minimum energy *
-* of emitted photons), MeV *
-* Althbr = natural logarithm of Thbrem - me *
-* Ebrm0 = minimum energy for which bremsstrahlung data *
-* are tabulated *
-* Albrm0 = natural logarithm of Ebrm0 *
-* Ebrmrt = ratio between subsequent tabulated energies *
-* after the initial 0:nktl-3 values *
-* Abrmrt = natural logarithm of Ebrmrt *
-* Aktild = k/T values corresponding at the tabulated en- *
-* ergies ( jth energy = (Thbrem-me) / Aktild (j) )*
-* Alktld = natural logarithm of Aktild *
-* Indsum = array used for addressing data *
-* Jndsum = array used for addressing data *
-* Ind0br = zero index address of brm. branching ratios *
-* and of brm. power fit exponents *
-* Ind1br = last index address of brm. branching ratios *
-* and of brm. power fit exponents *
-* Jnd0br = zero index address of brm. tabulated ds/dk *
-* Jnd1br = last index address of brm. tabulated ds/dk *
-* Lnwbrm = Logical flag for the new bremss. *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( NKTL = 17 )
- PARAMETER ( NBRBIN = 75 )
- COMMON /BREMPR/ DL1(6,MXXMDE), DL2(6,MXXMDE), DL3(6,MXXMDE),
- & DL4(6,MXXMDE), DL5(6,MXXMDE), DL6(6,MXXMDE),
- & DELCM(MXXMDE), ALPHI(2,MXXMDE), BPAR(2,MXXMDE),
- & DELPOS(2,MXXMDE), PWR2I(50),
- & THBREM (MXXMDE), ALTHBR (MXXMDE),
- & EBRM0 (MXXMDE), ALBRM0 (MXXMDE),
- & EBRMRT (MXXMDE), ABRMRT (MXXMDE),
- & AKTILD (0:NBRBIN), ALKTLD (0:NBRBIN),
- & INDSUM (0:NBRBIN+1), IND0BR (2,MXXMDE),
- & IND1BR (2,MXXMDE), LND0BR (2,MXXMDE),
- & LND1BR (2,MXXMDE), JND0BR (2,MXXMDE),
- & JND1BR (2,MXXMDE), LNWBRM (MXXMDE)
- LOGICAL LNWBRM
- DIMENSION JNDSUM (0:NBRBIN)
- EQUIVALENCE ( INDSUM (1), JNDSUM (0) )
-
+++ /dev/null
-*$ CREATE BRPRHV.ADD
-*COPY BRPRHV
-*
-*=== brprhv ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Include file: BRPRHV *
-* *
-* BRemsstrahlung and PaiR production by HeaVy particles *
-* *
-* Created on 10 march 1992 by Alfredo Ferrari *
-* INFN - Milan *
-* *
-* Last change on 11-may-94 by Alfredo Ferrari *
-* *
-* Included in the following routines: *
-* *
-* FLUKA *
-* DPDX *
-* HEABRE *
-* HVPAIR *
-* HVBREM *
-* KASKAD *
-* SIGTAB *
-* ZEROIN *
-* *
-*----------------------------------------------------------------------*
-*
-* minimum eta^2 for pair production ( gamma = sqrt (1+eta^2) = 44.7,
-* E_prot = 42 GeV, E_mu = 4.7 GeV )
- PARAMETER ( ESQTHP = 2000.D+00 )
-* minimum eta^2 for bremsstrahlung ( gamma = sqrt (1+eta^2) = 44.7,
-* E_prot = 42 GeV, E_mu = 4.7 GeV )
- PARAMETER ( ESQTHB = 2000.D+00 )
- LOGICAL LHPAIR, LHBREM
- COMMON / BRPRHV / T0PAIR (MXXMDF), T0BREM (MXXMDF),
- & CSTBRE (MXXMDF), AABREM (MXXMDF),
- & APBREM (MXXMDF), VCR0BR (MXXMDF),
- & ALRDCS (MPDPDX,MXXMDF), FNBREM (MPDPDX,MXXMDF),
- & PCBREM (MPDPDX,MXXMDF),
- & LHPAIR (MXXMDF), LHBREM (MXXMDF), IOFNBR,
- & IOFCBR
-
+++ /dev/null
-*$ CREATE CASLIM.ADD
-*COPY CASLIM
-*
-*=== caslim ===========================================================*
-*
-*----------------------------------------------------------------------*
-* include file: caslim copy created 26/11/86 by p*
-* changes: 20-sep-89 by A. Ferrari *
-* included in the following subroutines or functions: not updated *
-* *
-* description of the common block(s) and variable(s) *
-* *
-* *
-* *
-* /caslim/ is needed to decide when to stop the run *
-* tlim = if cpu-time-left<tlim the run will be ended *
-* tmean = is the average time needed for the following *
-* of one beam particle *
-* tmax = is the maximum time needed for the following *
-* of one beam particle *
-* ttot = the cumulative time needed to follow the beam *
-* particles *
-* ncases = the maximum number of beam particles to be followed *
-* nstars = the maximum number of stars to be generated *
-* ncase = the number of beam particles followed *
-* mbatch = batch sizes *
-* nbatch = number of batches *
-* ibatch = current batch number *
-* ncoinc = flag used by the detect option to know if the ncase *
-* particle has or has not to be considered in coinci- *
-* dence with the previous one (if they have the same *
-* ncoinc they belong to the same event) *
-* lpseed = if .true. seeds will be printed for any history *
-* levtdt = if .true. a few data will be printed at each history *
-*----------------------------------------------------------------------*
-*
- LOGICAL LPSEED, LEVTDT
- COMMON / CASLIM / TLIM, TMEAN, TMAX, TTOT, NCASES, NSTARS, NCASE,
- & MBATCH(500), NBATCH, IBATCH, NCOINC, LPSEED,
- & LEVTDT
-
+++ /dev/null
-*$ CREATE CHNCMM.ADD
-*COPY CHNCMM
-*
-*=== chncmm ===========================================================*
-*
-*
-*----------------------------------------------------------------------*
-* *
-* CHaiN formation CoMMon: *
-* *
-* Created on 22 march 1995 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 21-dec-97 by Alfredo Ferrari *
-* *
-* Gammes,Unomes = gamma and eta parameters for unflavoured mesons *
-* (P(x) = C x^(gamma-1) x (1-x)**(eta-1)) *
-* Gammes,Unomes = gamma and eta parameters for baryons *
-* Gamstr,Unostr = gamma and eta parameters for strange mesons *
-* Gamsea,Unosea = gamma and eta parameters for sea (anti)quarks *
-* Seamtr = minimal transverse mass for sea (anti)quarks *
-* Fslmtr = minimal transverse mass for X fraction selection *
-* Ecutrf = reference energy in p-p collisions for setting *
-* x-fraction minimal values *
-* Ucutrf = Sqrt(s) corresponding to Ecutrf *
-* Acutrf = coefficient used for x-fraction minimal values *
-* Bcutrf = coefficient used for x-fraction minimal values *
-* For E < Ecutrf: *
-* Xcutff = ( Acutrf + Bcutrf * Etrial / Ecutrf ) *
-* * Ethsea / Ekxlab *
-* for E > Ecutrf: *
-* Xcutff = ( Acutrf + Bcutrf ) * Ethsea * Umo *
-* / ( Ucutrf * Ekxlab ) *
-* Dfscml = diffractive single chain multiplicative factor *
-* with respect to the standard single chain prob. *
-* (Ldfscv=.false.), or triple pomeron cut-off mass *
-* multiplicative factor (Ldfscv=.true.) *
-* Dfscrs = number of gamma's after which diffractive resonant *
-* production is going into single chain production *
-* Ldfscv = Old single chain (low mass) probability for *
-* diffraction (=.false.), or new one (=.true.) *
-* Lxflip = If .true. random choiche of the Xp/Xt fraction to *
-* be changed of a parjet chain is performed *
-* Lmnxch = Meaningful only for Lxflip = .false. . If .true. *
-* minimal variation of both Xp/Xt for a parjet is *
-* performed *
-* Lmcons = Meaningful only for Lxflip, Lmnxch = .false., in *
-* this case invariant mass invariance is forced when *
-* computing Xp/Xt for a parjet. *
-* Lpcons = Meaningful only for Lxflip, Lmnxch, Lmcons =.false.,*
-* in this case momentum invariance is forced when *
-* computing Xp/Xt for a parjet. Never set to .false. *
-* Lsuxkn = Flag used to decide whether update immediately X *
-* fractions after one chain has been forced to a *
-* defined mass value, or do it for both at the end *
-* Imnxfr = Flag if requesting or not minimum fractions for *
-* q/qq, and their interpretation *
-* 0 = no threshold used (rejection if unphysical), *
-* 1 = minimum thresholds used, *
-* 2 = X interpreted as fractions of the available *
-* energy (minimum masses out) *
-* Lrealx = Flag for applying X fractions to real momenta/ *
-* energies of projectile/target: it should not be *
-* activated for Imnxfr > 0 since it will be inconsi- *
-* stent *
-* L2ndmp = Flag for using (whenever available) the 2nd baryon *
-* octet and the 2nd pseudoscalar meson nonet *
-* Lchspn = Flag for selecting a precise spin configuration *
-* (and hence "fixed" mass states according to) during *
-* chain creation *
-* Lsqgsm = flag for adopting the QGSM prescription for sea *
-* quarks X fractions, and in particular the "running" *
-* eta according to the number of sea qqbar to be *
-* produced *
-* *
-*----------------------------------------------------------------------*
-*
-* Minimum lab momentum requested for valence chain formation:
-* PARAMETER ( PLBCMN = 4.0D+00 )
- PARAMETER ( PLBCMN = 3.5D+00 )
-*
- LOGICAL LDFSCV, LXFLIP, LMNXCH, LMCONS, LPCONS, LSUXKN, LREALX,
- & L2NDMP, LCHSPN, LSQGSM
- COMMON / CHNCMM / GAMMES, UNOMES, GAMBAR, UNOBAR, GAMSTR, UNOSTR,
- & GAMSEA, UNOSEA, SEAMTR, FSLMTR, ECUTRF, UCUTRF,
- & ACUTRF, BCUTRF, DFSCML, DFSCRS,
- & IMNXFR, LDFSCV, LXFLIP, LPCONS, LMNXCH, LSUXKN,
- & LREALX, L2NDMP, LCHSPN, LMCONS, LSQGSM
-
+++ /dev/null
-*$ CREATE CHNGLB.ADD
-*COPY CHNGLB
-* *
-*=== chnglb ===========================================================*
-* *
-*----------------------------------------------------------------------*
-* *
-* CHaiN and GLauBer common: *
-* *
-* Created on 10 october 1996 by Alfredo Ferrari *
-* Infn - Milan *
-* *
-* Last change on 01-jul-00 by Alfredo Ferrari *
-* *
-* Nhtprj = number of hit nucleons of the projectile *
-* Nhttrg = number of hit nucleons of the target *
-* Nseprj(i) = number of sea aq-q (or aqaq-qq) components of the *
-* i_th projectile nucleon *
-* Nsetrg(j) = number of sea aq-q (or aqaq-qq) components of the *
-* j_th target nucleon *
-* Khttrg(i) = number of target nucleons hit by the i_th projec- *
-* tile nucleon *
-* Khtprj(j) = number of projectile nucleons hit by the j_th tar- *
-* get nucleon *
-* Ihtprj(i) = id. (part scheme) of the i_th hit nucleon of the *
-* projectile (every id is possible, not only p or n *
-* in case the projectile is a single particle) *
-* Ihttrg(j) = id. (part scheme) of the j_th hit nucleon of the *
-* target (1=proton, 8=neutron) *
-* Mhtrpr(j,i) = number of collisions for the elementary j_th target*
-* nucleon - i_th projectile nucleon interaction *
-* ( 0 = no collision ) *
-* Ehtprj(i) = total energy of the i_th hit projectile nucleon *
-* in the given frame *
-* Phprjx(i) = momentum X component of the i_th hit projectile *
-* nucleon in the given frame *
-* Phprjy(i) = momentum Y component of the i_th hit projectile *
-* nucleon in the given frame *
-* Phprjz(i) = momentum Z component of the i_th hit projectile *
-* nucleon in the given frame *
-* Rhprjp(i) = local proton density (fm^-3) for the i_th hit *
-* projectile nucleon *
-* Rhprjn(i) = local neutron density (fm^-3) for the i_th hit *
-* projectile nucleon *
-* Ehttrg(j) = total energy of the j_th hit target nucleon *
-* in the given frame *
-* Phtrgx(j) = momentum X component of the j_th hit target *
-* nucleon in the given frame *
-* Phtrgy(j) = momentum Y component of the j_th hit target *
-* nucleon in the given frame *
-* Phtrgz(j) = momentum Z component of the j_th hit target *
-* nucleon in the given frame *
-* Rhtrgp(j) = local proton density (fm^-3) for the j_th hit *
-* target nucleon *
-* Rhtrgn(j) = local neutron density (fm^-3) for the j_th hit *
-* target nucleon *
-* Xqkprj(i) = (anti)quark X fraction for mesons and (anti)baryons*
-* for the i_th projectile component *
-* Xdqprj(i) = qbar/(anti)diquark X fraction for mesons/(anti)ba- *
-* ryons for the i_th projectile component *
-* Xseprj(k,i) = X fraction of the (di)quark of the k_th sea *
-* q(q)-aq(aq) couple for the i_th projectile nucleon *
-* Xasprj(k,i) = X fraction of the anti(di)quark of the k_th sea *
-* q(q)-aq(aq) couple for the i_th projectile nucleon *
-* Xqktrg(j) = quark X fraction for the j_th target nucleon *
-* Xdqtrg(j) = diquark X fraction for the j_th target nucleon *
-* Xsetrg(k,j) = X fraction of the (di)quark of the k_th sea *
-* q(q)-aq(aq) couple for the j_th target nucleon *
-* Xastrg(k,j) = X fraction of the anti(di)quark of the k_th sea *
-* q(q)-aq(aq) couple for the j_th target nucleon *
-* Iqsprj(k,i) = quark id of the k_th sea q(q)-aq(aq) couple of the *
-* i_th projectile nucleon (diquark are recognized by *
-* the double index, i.e. uu=11, us=13 etc) *
-* Iqstrg(k,j) = quark id of the k_th sea q(q)-aq(aq) couple of the *
-* i_th target nucleon *
-* Kchain(m) = type of the m_th chain: *
-* Kchain = i0 + 100 * iqprj + 10000 * iqtrg *
-* Proj Target *
-* i0 = 0 <--> sea-q sea-q *
-* = 1 <--> sea-q sea-qq *
-* = 2 <--> sea-qq sea-q *
-* = 3 <--> sea-qq sea-qq *
-* = 10 <--> sea-q valence-q *
-* = 11 <--> sea-q valence-qq *
-* = 12 <--> sea-qq valence-q *
-* = 13 <--> sea-qq valence-qq *
-* = 20 <--> valence-q sea-q *
-* = 21 <--> valence-q sea-qq *
-* = 22 <--> valence-qq sea-q *
-* = 23 <--> valence-qq sea-qq *
-* = 30 <--> valence-q valence-q *
-* = 31 <--> valence-q valence-qq *
-* = 32 <--> valence-qq valence-q *
-* = 33 <--> valence-qq valence-qq *
-* iqprj = q(q) of the (di)quarks coming from the proje- *
-* ctile *
-* iqtrg = q(q) of the (di)quarks coming from the target *
-* Mchain(m) = type of the m_th chain: *
-* Mchain = ihtprj + 1000 * ihttrg *
-* ihtprj = index of hit projectile nucleon used to build *
-* this chain *
-* ihttrg = index of hit target nucleon used to build *
-* this chain *
-* Nchai0 = original number of chains *
-* Nchain = actual number of chains *
-* Nvvchn = actual number of valence-valence chains *
-* Nsvchn = actual number of sea(prj)-valence(trg) chains *
-* Nvschn = actual number of valence(prj)-sea(trg) chains *
-* Nsschn = actual number of sea-sea chains *
-* Lglaub = logical flag for activation of Glauber calculus *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( MXHTRG = MXHTTR + 1 )
- PARAMETER ( MXHPRJ = 5 )
-* Mxseax: maximum number of sea component of a projectile/target
-* nucleon, it must be >= Max (MXHTRG-1,MXHPRJ-1)
- PARAMETER ( MXSEAX = 20 )
-* Mxchan: maximum number of chains
- PARAMETER ( MXCHAI = 200 )
-*
- LOGICAL LGLAUB
-*
- COMMON / CHNGLB / EHTPRJ (MXHPRJ), PHPRJX (MXHPRJ),
- & PHPRJY (MXHPRJ), PHPRJZ (MXHPRJ),
- & RHPRJP (MXHPRJ), RHPRJN (MXHPRJ),
- & EHTTRG (MXHTRG), PHTRGX (MXHTRG),
- & PHTRGY (MXHTRG), PHTRGZ (MXHTRG),
- & RHTRGP (MXHTRG), RHTRGN (MXHTRG),
- & XQKPRJ (MXHPRJ), XDQPRJ (MXHPRJ),
- & XSEPRJ (MXSEAX,MXHPRJ), XASPRJ (MXSEAX,MXHPRJ),
- & XQKTRG (MXHTRG), XDQTRG (MXHTRG),
- & XSETRG (MXSEAX,MXHTRG), XASTRG (MXSEAX,MXHTRG),
- & IHTPRJ (MXHPRJ), IHTTRG (MXHTRG),
- & KHTTRG (MXHPRJ), KHTPRJ (MXHTRG),
- & NSEPRJ (MXHPRJ), NSETRG (MXHTRG),
- & IQSPRJ (MXSEAX,MXHPRJ), IQSTRG (MXSEAX,MXHTRG),
- & MHTRPR (MXHTRG,MXHTRG), KCHAIN (MXCHAI),
- & MCHAIN (MXCHAI), NCHAI0, NCHAIN, NVVCHN, NSVCHN,
- & NVSCHN, NSSCHN, NHTPRJ, NHTTRG, LGLAUB
-
+++ /dev/null
-*$ CREATE CLSCCM.ADD
-*COPY CLSCCM
-*
-*=== clsccm ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* CoaLeSCence CoMmon: *
-* *
-* Created on 5 april 1996 by Alfredo Ferrari, INFN Milan *
-* *
-* Last change on 23-jun-99 by Alfredo Ferrari, INFN Milan *
-* *
-* included in the following subroutines or functions: not updated *
-* *
-* description of the common block(s) and variable(s) *
-* *
-* pclscn(i,j) = momentum sigma for coalescing a particle of mass *
-* i (i=1,2,3) into the jth heavy particle *
-* (j=-3 <-> deuteron) *
-* (j=-4 <-> triton ) *
-* (j=-5 <-> 3-He ) *
-* (j=-6 <-> alpha ) *
-* rclscn(i,j) = position sigma for coalescing a particle of mass *
-* i (i=1,2,3) into the jth heavy particle *
-* bnclmx(j) = number of maximum times the binding energy over *
-* the sum of proton/neutron masses to check for *
-* coalescence into the jth heavy particle *
-* dclwpk = sigma (fm) of the gaussian wave packet of each *
-* individual nucleon *
-* dsclcy = time (ct unit) between different preequilibrium *
-* cycles, see below *
-* ddscly = time/amu^1/3 (ct unit) between different pree- *
-* quilibrium cycles *
-* Total time = dsclcy + ddscly * A^1/3 *
-* dbscly = (relative) importance of the barrier when compu- *
-* ting the time between different preequilibrium *
-* cycles *
-* Final time = [ dsclcy + ddscly * A^1/3 ] *
-* x [ ( 1 - dbscly ) / beta_bar *
-* + dvscly / beta_part ] *
-* ftscly = multiplication factor for the above total time *
-* for cascade-preequilibrium transitions *
-* icycls = starting preequilibrium cycle to be used for *
-* coalescence checks *
-* n0clsc = number of stack particles to be skipped for *
-* coalescence purposes *
-* npclsc = (final) stack number of particles to be conside- *
-* red for coalescence purposes *
-* nsclsc = starting stack number of particles to be conside-*
-* red for coalescence purposes *
-* ndclsc = diff. stack number of particles to call the *
-* coalescence model *
-* laclsc = flag for making coalescence checks on angular *
-* momentum rather than on p and x separately *
-* lclscn = flag for activating the coalescence model *
-* iclexc = flag for coalescence excitation energy treatment *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( MXCLSC = 100 )
- LOGICAL LACLSC, LCLSCN
-*
- COMMON / CLSCCM / PCLSCN (3,-6:-3), RCLSCN (3,-6:-3), DCLWPK,
- & BNCLMX (-6:-3), DSCLCY, DDSCLY, DBSCLY, FTSCLY,
- & PXCLSC (MXCLSC), PYCLSC (MXCLSC),
- & PZCLSC (MXCLSC), ECLSCN (MXCLSC),
- & XCLSCN (MXCLSC), YCLSCN (MXCLSC),
- & ZCLSCN (MXCLSC), ACLSCN (MXCLSC),
- & ICYCLS, N0CLSC, NPCLSC, NSCLSC, NDCLSC,
- & ICLEXC, LACLSC, LCLSCN
-
+++ /dev/null
-*$ CREATE CMABRS.ADD
-*COPY CMABRS
-*
-*=== cmabrs ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* CoMmon for ABsorption at ReSt: *
-* *
-* Created on 08 july 1995 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 08-jul-95 by Alfredo Ferrari *
-* *
-* Hufffc (i) = Huff factor for mu- decay rate after atomic *
-* capture for Z=i *
-* Zeffmu (i) = Z_eff for mu- after atomic capture for Z=i *
-* *
-*----------------------------------------------------------------------*
-*
-* Parameters entering the Goulard-Primakoff formula for muon- nuclear
-* capture rates:
- PARAMETER ( G1PRMK = 261. D+00 )
- PARAMETER ( G2PRMK =-0.040D+00 )
- PARAMETER ( G3PRMK =-0.26 D+00 )
- PARAMETER ( G4PRMK = 3.24 D+00 )
- COMMON / CMABRS / ZEFFMU (100), HUFFFC (100)
-
+++ /dev/null
-*$ CREATE CMCSCM.ADD
-*COPY CMCSCM
-C------------------------------------------------------------------ COMMON /NEWGEOM/ -----------------------------------------------
- PARAMETER (MAXNOGELE=2000) ! max no geometrical elements
- PARAMETER (MAXNOGPAR=300) ! max no of parameters & pointers
- PARAMETER (MAXNGTYPE=20) ! max no of element types
-
- COMMON/NEWGEOM/HTITLE,NOGELE,IGEOTYPE(MAXNOGELE),
- + GEONAME(MAXNOGELE),MATVAL(MAXNOGELE), ! generalities
- + NGPARAM(MAXNOGELE),PARGEO(MAXNOGELE,MAXNOGPAR), ! parameters
- + NGPOINT(MAXNOGELE),IIPOINT(MAXNOGELE,MAXNOGPAR), ! pointers
- + IIMASTER,GEOTYPE(MAXNGTYPE),NONUMPAR(MAXNGTYPE) ! type & miscell
- CHARACTER*20,GEONAME
- CHARACTER*120 HTITLE
- CHARACTER*4 GEOTYPE
- DOUBLE PRECISION PARGEO
-C
-C HTITLE title(name) of geometry
-C NOGELE number of elements
-C IGEOTYPE(IGELE) type of element, address to GEOTYPE,NONUMPAR
-C GEONAME(IGELE) name of element (A20)
-C MATVAL(IGELE) material no (only for simple geometries)
-C NGPARAM(IGELE) no of associated parameters
-C PARGEO(IGELE,IPAR) associated parameters (floating DP)
-C NGPOINT(IGELE) no of associated pointers
-C IIPOINT(IGELE,IPNT) associated pointers (integers)=> IGELE of associated elements
-C IIMASTER IGELE of initiator element in the chain
-C GEOTYPE(k) key name for operator
-C NONUMPAR(k) no of elem in numeric list
-C
-C---------------------------------------------------------------END COMMON /NEWGEOM/ -----------------------------------------------
-C
-
-
-
+++ /dev/null
-*$ CREATE CMKBSG.ADD
-*COPY CMKBSG
-*
-*=== cmkbsg ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* CoMmon for Kaon-Bar-nucleon SiGmas: *
-* *
-* Created on 07 december 1996 by Alfredo Ferrari & Paola Sala *
-* INFN - MIlan *
-* Last change on 30-sep-98 by Alfredo Ferrari, INFN-Milan *
-* *
-* List of variables: *
-* *
-* Knbout(io,ir,ip,it) = reaction products indeces, (io=1,2 for the two *
-* two products, ir=1,6 for the various reactions,*
-* ip=1,2 for K- or K0bar projectiles, it=1,2 for *
-* proton or neutron targets) *
-* Ipkbar(ir,ip,it) = internal reaction identifier for the ir_th *
-* reaction with ip (1,2 for K- or K0bar) projec- *
-* tile and it (1,2 for proton or neutron) target *
-* Lcxkbr(ir,ip,it) = charge exchange flag *
-* *
-* Ir = 1 => elastic (K- N -> K- N or K0bar N -> K0bar N) *
-* (variable Selas in Sgkbar) *
-* Ir = 2 => ch.exc. (K- p -> K0bar n or K0bar n -> K- p) *
-* (variable Scx in Sgkbar) *
-* Ir = 3 => st.exc. (K- p -> pi- Sigma+ or K0bar n -> pi+ Sigma- *
-* or K- n -> pi- Sigma0 or K0bar p -> pi0 Sigma+)*
-* (variable Ssigm in Sgkbar) *
-* Ir = 4 => st.exc. (K- p -> pi+ Sigma- or K0bar n -> pi- Sigma+ *
-* or K- n -> pi0 Sigma- or K0bar p -> pi+ Sigma0)*
-* (variable Ssigmc in Sgkbar) *
-* Ir = 5 => st.exc. (K- p -> pi0 Lambda or K0bar n -> pi0 Lambda *
-* or K- n -> pi- Lambda or K0bar p -> pi+ Lambda)*
-* Ir = 6 => st.exc. (K- p -> pi0 Sigma0 or K0bar n -> pi0 Sigma0)*
-* *
-*----------------------------------------------------------------------*
-*
-* Thresholds for pion production
-* ( Kinetic energy threshold for producing particle x in a collision
-* between p and t giving rise to p,t,x:
-* Ekth_ptx = m_x ( 2 m_p + 2 m_t + m_x ) / ( 2 m_t ) )
-* ( Kinetic energy threshold for producing particle x in a collision
-* between p and t giving rise to a,b,x:
-* Ekth_pt_abx = ( ( m_a + m_a + m_x )^2 - ( m_p + m_t )^2 )
-* / ( 2 m_t ) )
-* K-+p-->Lamda+pi0+pi0
- PARAMETER ( TKMP00 = 0.0 D+00 )
-*
- PARAMETER ( MKBREA = 6 )
- PARAMETER ( MKBETB = 200 )
- PARAMETER ( MKBWAV = 11 )
-*
- LOGICAL LCXKBR
- COMMON / CMKBSG /
- & RE0KBA (MKBETB,MKBWAV,3), RE1KBA (MKBETB,MKBWAV,3),
- & AIM0KB (MKBETB,MKBWAV,3), AIM1KB (MKBETB,MKBWAV,3),
- & EKBTAB (MKBETB), NEKBTB, KBNOUT (2,MKBREA,2,2),
- & IPKBAR (MKBREA,2,2), LCXKBR (MKBREA,2,2)
-
+++ /dev/null
-*$ CREATE CMMDNR.ADD
-*COPY CMMDNR
-*
-*=== cmmdnr ==========================================================*
-*
-*---------------------------------------------------------------------*
-* Module CMMDNR: *
-* *
-* Last change A. Ferrari 26-may-1990 *
-* Created on 26-05-1990 by A. Ferrari, Infn-Milan *
-* *
-* *
-*---------------------------------------------------------------------*
-*
- LOGICAL LFLDNR
- COMMON / CMMDNR / DDNEAR, LFLDNR
-
+++ /dev/null
-*$ CREATE CMPAIR.ADD
-*COPY CMPAIR
-*
-*=== cmpair ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* CoMmon for e+/e- PAIR production by heavy charged particles *
-* *
-* Created on 03 march 1992 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 17-jun-97 by Alfredo Ferrari *
-* *
-* Included in the following routines: *
-* *
-* HEAPAI *
-* CMPAIR *
-* DSDVVV *
-* DSDVVT *
-* DSDVRR *
-* DSDVDR *
-* PHEPAI *
-* PHPPAI *
-* ALPHE *
-* ALPHP *
-* YPAIRE *
-* YPAIRP *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( FELPAI = 1.0 D+00 )
- PARAMETER ( RADLOG = 184.15 D+00 )
- PARAMETER ( COSPAI = FSCTO4 * 2.D+00 / PIPIPI / 3.D+00 *
- & PLABRC * PLABRC / AMELCT / AMELCT *
- & AVOGAD * 1.D-26 )
- COMMON / CMPAIR / AMPROJ, EPROJ, VTHRES, Z, Z2, Z13, DENS, ATOMW,
- & COST , VV, RR, RRSQ, BBETA, XXSI, AMSQRT,
- & ICHRG2, IPPROJ, MATBRE
-
+++ /dev/null
-*$ CREATE CMPHLP.ADD
-*COPY CMPHLP
-*
-*=== Cmphlp ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Created on 01 august 1999 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 01-aug-99 by Alfredo Ferrari *
-* *
-* *
-*----------------------------------------------------------------------*
-*
- COMMON / CMPHLP / CNTNT (ICOMAX), MTNM (ICOMAX), ICNMAX, NMENUM
- COMMON / CMPHCH / COMNAM (MXXMDF)
- CHARACTER*8 COMNAM
-
+++ /dev/null
-*$ CREATE CMPHNU.ADD
-*COPY CMPHNU
-* *
-*=== cmphnu ===========================================================*
-* *
-*----------------------------------------------------------------------*
-* *
-* Created on 05 october 1992 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 22-oct-92 by Alfredo Ferrari *
-* *
-* Included in the following routines: *
-* *
-* FLUKA *
-* DEFLTS *
-* EVXTES *
-* PHNCEV *
-* PHNCVR *
-* PHNVEV *
-* SIGTAB *
-* ZEROIN *
-* DSPHDV *
-* DSPHIV *
-* DSPHJV *
-* DSPVL1 *
-* DSPVL2 *
-* DSPVT1 *
-* DSPVT2 *
-* DVSPHV *
-* SGAPN *
-* *
-*----------------------------------------------------------------------*
-* *
- PARAMETER ( ANGEPP = 1.2D-04 )
-*
- LOGICAL LPHNCL
- COMMON / CMPHNU / AMPPHN, AMTPHN, EPRPHN, PPRPHN, QPH2MN, QPH2MX,
- & VVPHMN, VVPHMX, RHOPHN, CSTPHN, GXSHDW, AMNPHN,
- & A13PHN, AMPHN1, AMPHN2, ASQPH1, ASQPH2, EPSPH1,
- & EPSPH2, FR1PHN, FR2PHN, SGPHUB, XLNPHN, AOCPHN,
- & ZPHNMN, ZPHNMX, WPHNMN, WPHNMX, EOUPHN, POUPHN,
- & AMPHSQ, ENHPHN, QU2PHN, CSTPHV, ARSQP1, ARSQP2,
- & AMRPHE, T1MVOV, PHNORD, PHNEXO, PHNSTR, PHNEXS,
- & AMRP1N, VSQ44V, VVSQRD, EPSSQ1, EPSSQ2, RRPHN1,
- & RRSQR1, RRPHN2, RRSQR2, YESS1T, YESS2T, YESS1L,
- & YESS2L, AFACTZ, ALOGA1, DIFZPH, PHOZP1, ALOGB1,
- & DPHNSQ, DENPHN, ZMTPHN, MATPHN, IPPHNU,
- & JFLPHN (MXXMDF), LPHNCL
-
+++ /dev/null
-*$ CREATE CMPISG.ADD
-*COPY CMPISG
-*
-*=== cmpisg ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* CoMmon for PIon-nucleon SiGmas: *
-* *
-* Created on 07 december 1992 by Alfredo Ferrari & Paola Sala *
-* INFN - MIlan *
-* Last change on 06-sep-96 by Alfredo Ferrari, INFN-Milan *
-* *
-* List of variables: *
-* *
-* pmnpis = minimum momentum of tabulations *
-* pmmpis = median momentum of tabulations (switch from *
-* lin to log tabulations) *
-* pispis = maximum momentum for which an isotropic/- *
-* resonant term is computed for the angular *
-* distribution, it must be > pmmpis and *
-* =< pexpis / rtpisg. It is given by: *
-* pispis = pmmpis x rtpisg^(npisis-npirln) *
-* pexpis = momentum a exp(bt) term is computed from *
-* it is given by: *
-* pexpis = pmmpis x rtpisg^(npisex-npirln) *
-* pmxpis = maximum momentum of tabulations *
-* dppisg = Delta_p of the lin tabulation *
-* (dppisg = (pmmpis-pmnpis) / (npirln-1) ) *
-* rtpisg = ratio between subsequent tabulated momenta *
-* in the log part *
-* amnpis = log (pmnpis) *
-* ammpis = log (pmmpis) *
-* aispis = log (pispis) *
-* aexpis = log (pexpis) *
-* amxpis = log (pmxpis) *
-* arpisg = log (rtpisg) *
-* sgpicu(i,j,l) = cumulative cross section for cos theta = 1 *
-* - 0.1 * i at jth energy for lth reaction, ani-*
-* sotropic component (npirvr=1)/non resonant *
-* component (npirvr=2) *
-* sgpiis(j,l) = isotropic cross section (npirvr=1) /resonant*
-* cross section (npirvr=2), at jth energy for *
-* lth reaction, total cross section is given *
-* by sgpiis (j,l) + sgpicu (20,j,l) *
-* sgpidf(i,j,l) = differential cross section at cos theta = 1 *
-* - 0.1 * i at jth energy for lth reaction *
-* sgpiin(j,l) = inelastic (pion production, NO cx) cross *
-* section at jth energy for lth reaction *
-* ( l=1: pi+ p / pi- n, l=2: pi- p / pi+ n, *
-* l=3: pi0 p / pi0 n ) *
-* bpislo(j,l) = b slope parameter at jth energy for lth rea-*
-* ction (p>pexpis>pispis>pmmpis) *
-* cpislo(j,l) = bcurvature parameter at jth energy for lth *
-* reaction (p>pexpis>pispis>pmmpis) *
-* spislo(j,l) = cross section at jth energy for lth reaction*
-* for the exp(bt) part, the total cross *
-* section is given by: spislo (j,l) + *
-* sgpicu (20,j,l) *
-* sgrtrs(l) = ratio of the lth reaction at resonance with *
-* respect to the resonant "standard" form as *
-* given by Fpires *
-* brrein(l) = branching ratio in the entrance channel of *
-* the lth reaction, resonant part *
-* brreou(l) = branching ratio in the exit channel of *
-* the lth reaction, resonant part *
-* brdeou(i,j) = branching ratio in the (i=1->proton,i=2-> *
-* neutron) exit channel for 2-body resonant *
-* pion absorption of a Delta of charge j *
-* brd3ou(i,k,j) = branching ratio in the (i=1->proton,i=2-> *
-* neutron,k=1->proton,k=2->neutron) exit chan-*
-* nel for 3-body resonant pion absorption of *
-* a Delta of charge j *
-* brdeou(l) = branching ratio in the exit channel of *
-* the lth reaction, resonant part *
-* Prrsdl = random number representing the probability *
-* to select the anisotropic component *
-* ppithr(l) = threshold momentum for the pion in the lab *
-* system for the lth reaction channel *
-* rhpicr(l) = density correction factors for absorption of*
-* l type pions with respect to average rho *
-* ipirea(i,j,l) = reaction channel indexes (two at most) for *
-* l type incident particle (3=pi+,4=pi-,5=pi0)*
-* j type target nucleon (1=p,2=n) *
-* ipiine(j,l) = inelastic (pion production NO cx) reaction *
-* channel indexes for l type incident particle*
-* (3=pi+,4=pi-,5=pi0) j type target nucleon *
-* (1=p,2=n) *
-* kpiire(j,i) = incoming particles indexes (j=1,2, first the*
-* projectile pion, second the target nucleon, *
-* PAPROP numbering) for the ith reaction chan-*
-* nel *
-* kpiore(j,i) = outgoing particles indexes (j=1,2, first the*
-* pion, second the nucleon, PAPROP numbering) *
-* for the ith reaction channel *
-* ittrrs(l) = nucleon index of the resonant cross section *
-* for l type pions *
-* ldlres = flag for reaction going via an intermediate *
-* resonance Delta state *
-* *
-*----------------------------------------------------------------------*
-*
-* Thresholds for pion production
-* ( Kinetic energy threshold for producing particle x in a collision
-* between p and t giving rise to p,t,x:
-* Ekth_ptx = m_x ( 2 m_p + 2 m_t + m_x ) / ( 2 m_t ) )
-* ( Kinetic energy threshold for producing particle x in a collision
-* between p and t giving rise to a,b,x:
-* Ekth_pt_abx = ( ( m_a + m_a + m_x )^2 - ( m_p + m_t )^2 )
-* / ( 2 m_t ) )
-* p+p-->p+p+pi0
- PARAMETER ( TPPPI0 = 0.279661403974980D+00 )
-* n+n-->n+n+pi0
- PARAMETER ( TNNPI0 = 0.279648039999871D+00 )
-* p+p-->p+n+pi+
- PARAMETER ( TPPPIP = 0.292300474999261D+00 )
-* p+p-->d+pi+
- PARAMETER ( TPPDEP = 0.287520039338373D+00 )
-* n+n-->n+p+pi-
- PARAMETER ( TNNPIM = 0.286728401466252D+00 )
-* n+n-->d+pi-
- PARAMETER ( TNNDEM = 0.281954546115298D+00 )
-* p+n-->p+n+pi0
- PARAMETER ( TPNPI0 = 0.279462243848891D+00 )
-* p+n-->d+pi0
- PARAMETER ( TPNDE0 = 0.274699264355169D+00 )
-* p+n-->n+n+pi+
- PARAMETER ( TPNPIP = 0.292092020411614D+00 )
-* n+p-->n+p+pi0
- PARAMETER ( TNPPI0 = 0.279847456228455D+00 )
-* n+p-->d+pi0
- PARAMETER ( TNPDE0 = 0.275077911416144D+00 )
-* n+p-->n+n+pi+
- PARAMETER ( TNPPIP = 0.292494641748525D+00 )
-* This is the maximum momentum for which it makes sense to use
-* the "standard" resonant cross section given by Fpires to get
-* a resonant part: it can well be different from Pispis
- PARAMETER ( PIRSMX = 1.2D+00 )
-*
- PARAMETER ( NPIREA = 10 )
- PARAMETER ( NPIRTA = 68 )
- PARAMETER ( NPIRLN = 21 )
- PARAMETER ( NPIRLG = NPIRTA - NPIRLN )
- PARAMETER ( NPISIS = NPIRLN + 20 )
- PARAMETER ( NPISEX = NPIRLN + 21 )
- PARAMETER ( NPIIMN = 14 )
- PARAMETER ( NPIIRC = 6 )
-* Delta nuclear well: 35 MeV (at center)
- PARAMETER ( DELWLL = 0.035D+00 )
- CHARACTER CHPIRE*8
- LOGICAL LDLRES
- COMMON / CMPISG / PMNPIS, PMMPIS, PISPIS, PEXPIS, PMXPIS, DPPISG,
- & RTPISG, AMNPIS, AMMPIS, AISPIS, AEXPIS, AMXPIS,
- & ARPISG, BPISLO (NPIRLN:NPIRTA,NPIREA),
- & CPISLO (NPIRLN:NPIRTA,NPIREA), PPITHR (NPIREA),
- & SPISLO (NPIRLN:NPIRTA,NPIREA), APITHR (NPIREA),
- & SGPIIN (NPIIMN:NPIRTA,NPIIRC), RHPICR (1:5) ,
- & SGPICU (0:20,NPIRTA,NPIREA) , SGRTRS (NPIREA),
- & SGPIDF (0:20,NPIRTA,NPIREA) , BRREIN (NPIREA),
- & SGPIIS (NPIRTA,NPIREA) , BRREOU (NPIREA),
- & BRD3OU (2,2,-1:2), BRDEOU (2,-1:2),
- & SGABSR (2,2,4) , PRRSDL,
- & IPIREA (2,2,3:5) , IPIINE (2,3:5) , NPIRVR ,
- & KPIIRE (2,NPIREA), KPIORE (2,NPIREA) ,
- & JSTOKP (5), KPTOJS (23), ITTRRS (3:5), LDLRES
- COMMON / CHPISG / CHPIRE (NPIREA)
- DIMENSION SG2BRS (2,2), SGABSW (2,2), SG3BRS (2,2,2)
- EQUIVALENCE ( SG2BRS (1,1), SGABSR (1,1,1) )
- EQUIVALENCE ( SGABSW (1,1), SGABSR (1,1,2) )
- EQUIVALENCE ( SG3BRS (1,1,1), SGABSR (1,1,3) )
-
+++ /dev/null
-*$ CREATE CMSRES.ADD
-*COPY CMSRES
-*
-*=== cmsres ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* New version of CMSRES: *
-* *
-* Created on 20-january-1996 by Alfredo Ferrari & Paola Sala *
-* *
-* Last change on 06-dec-97 by Alfredo Ferrari *
-* *
-* Included in the following subroutines or functions: not updated *
-* *
-* Description of the common block(s) and variable(s) *
-* *
-* Pxr(i) = X-component of the momentum of the i_th produced *
-* resonance *
-* Pyr(i) = Y-component of the momentum of the i_th produced *
-* resonance *
-* Pzr(i) = Z-component of the momentum of the i_th produced *
-* resonance *
-* Her(i) = Total energy of the i_th produced resonance *
-* Amr(i) = Mass of the i_th produced resonance *
-* Ichr(i) = Charge of the i_th produced resonance *
-* Ibarr(i) = Baryon number of the i_th produced resonance *
-* Nrer(i) = Identity (part scheme) of the i_th produced resonance*
-* Ichnr(3,i) = Array containing additional informations about pro- *
-* duction verteces, ranking etc. *
-* Nres = Number of produced resonances *
-* Nres1 = Number of produced resonances from the first chain *
-* Nres2 = Number of produced resonances from the second chain *
-* Anr(i) = Literal name of the i_th produced resonance *
-* *
-*----------------------------------------------------------------------*
-*
- CHARACTER*8 ANR
- COMMON / CMSRES / PXR (MXPDPM), PYR (MXPDPM), PZR (MXPDPM),
- & HER (MXPDPM), AMR (MXPDPM), ICHR (MXPDPM),
- & IBARR (MXPDPM), NRER (MXPDPM), ICHNR(3,MXPDPM),
- & NRES, NRES1, NRES2
- COMMON / CHCMSR / ANR (MXPDPM)
-
+++ /dev/null
-*$ CREATE CMTIME.ADD
-*COPY CMTIME
-*
-*=== cmtime ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Include file cmtime *
-* *
-* Created on 03 august 1991 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 08-jul-92 by Alfredo Ferrari *
-* *
-* Included in: *
-* Electr *
-* Feeder *
-* Fluka *
-* Kaskad *
-* Kasneu *
-* Photon *
-* Zeroin *
-* Variables: *
-* Tctffp(i) = cut off time for ith-particle type *
-* in seconds *
-* Tdelap(i) = delay time before applying the ti- *
-* me cutoff for ith-particle type in *
-* seconds *
-* Tcutof = total time cutoff for the present *
-* particle in seconds *
-* Tstart = start time in seconds *
-* Mtstrp(i) = material number for the start si- *
-* gnal *
-* *
-* W A R N I N G !!! S T A R T S I G N A L N O T Y E T *
-* I M P L E M E N T E D !!! *
-* *
-*----------------------------------------------------------------------*
-*
- COMMON / CMTIME / TCTFFP (-6:NALLWP), TDELAP (-6:NALLWP), TCUTOF,
- & TSTART, MTSTRP (-6:NALLWP)
-
+++ /dev/null
-*$ CREATE COMCON.ADD
-*COPY COMCON
-*
-*=== comcon ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Include file COMpound CONstants: new version for FLUKA92 on *
-* *
-* Created on 30 october 1992 by Alfredo Ferrari *
-* INFN, Milan *
-* *
-* Last change on 28-apr-97 by Alfredo Ferrari, INFN - Milan *
-* *
-* included in the following subroutines or functions: not updated *
-* *
-* description of the common block(s) and variable(s) *
-* *
-* /comcon/ contains information about compounds *
-* icompl(imat) = number of materials in a compound *
-* matnum(i) = material numbers (compounds consist of the *
-* materials) *
-* aocmbc(i) = atomic densities in barn**-1 cm**-1 *
-* (Atoms Over Cm times Barn for Compounds) *
-* cona13(i) = A^1/3 of the constituents *
-* sumzmf(i) = cumulative z^2 for multiple scattering *
-* contnt(i) = partial densities *
-* sumacn(i) = cumulative atom contents of the compounds *
-* cabinx(i) = cumulative at.cont.*inelastic cross section *
-* cabelx(i) = cumulative at.cont.* elastic cross section *
-* anxnor = total inelastic cross section *
-* elxnor = total elastic cross section *
-* pliflu(imat) = plasma energy of the Fluka medium Imat *
-* jchflu(imat) = number of harmonic oscillator levels in a *
-* compound *
-* jc0flu(imat) = starting position for 0 index for Imat medium *
-* in the following arrays *
-* ehoflu(j) = jth - jc0flu(imat) harmonic oscillator levels *
-* of Fluka medium Imat *
-* elnhfl(j) = natural logarithm of ehoflu (j) *
-* fosflu(j) = oscillator strength for the jth - jc0flu(Imat)*
-* harmonic oscillator levels of Fluka medium *
-* Imat *
-* zhoflu(j) = atomic number of the element for the jth - *
-* jc0flu(imat) harmonic oscillator level of *
-* Fluka medium Imat *
-* ahoflu(j) = atomic weights of the element for the jth - *
-* jc0flu(imat) harmonic oscillator level of *
-* Fluka medium Imat *
-* eliflu(j) = l_i of the Sternheimer theory for the jth - *
-* jc0flu(Imat) harmonic oscillator level of *
-* Fluka medium Imat *
-* *
-*----------------------------------------------------------------------*
-*
- COMMON /COMCON/ AOCMBC (ICOMAX), CONA13 (ICOMAX), SUMZMF (ICOMAX),
- & CONTNT (ICOMAX), SUMACN (ICOMAX), CABINX (ICOMAX),
- & CABELX (ICOMAX), ANXNOR, ELXNOR, EHOFLU (ICHMAX),
- & ELNHFL (ICHMAX), FOSFLU (ICHMAX), ZHOFLU (ICHMAX),
- & AHOFLU (ICHMAX), ELIFLU (ICHMAX), PLIFLU (MXXMDF),
- & ICOMPL (MXXMDF), JC0FLU (MXXMDF), JCHFLU (MXXMDF),
- & MATNUM (ICOMAX)
-
+++ /dev/null
-*$ CREATE COMPUT.ADD
-*COPY COMPUT
-*
-*=== comput ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* include file: comput copy created 23/08/94 by afa *
-* *
-* Last change on 09-nov-98 by Alfredo Ferrari, CERN *
-* included in the following subroutines or functions: *
-* *
-* berttp *
-* blkdt1 *
-* cmsppr *
-* dtimst *
-* elsgrd *
-* epilog *
-* feeder *
-* flukam *
-* fluoin *
-* geogeo *
-* mgdraw *
-* nuscti *
-* pisgrd *
-* plotgm *
-* rsncli *
-* source *
-* usrbdx *
-* usrbin *
-* usrtrk *
-* usryld *
-* which *
-* xnbnls *
-* xnloan *
-* xsread *
-* *
-* description of the common block(s) and variable(s) *
-* *
-* *
-* /comput/ contains information about the computer used *
-* and about the input file *
-* komput = system (1=OpenVms, 2=ibm-vm, 3=ibm-mvs, *
-* 4=cray, 5=unix-aix, 6=unix-hp, *
-* 7=unix-sun, 8=DEC-unix, 9=Linux...) *
-* Cpuspe = computer speed with respect to IBM 370/168-3 *
-* or to VAX 780/11 or to IBM RISC/6000 7012/370 *
-* Cpujob = cpu limit (s) for the current job *
-* Kpwdir = last non blank character of Pwddir *
-* Kfldir = last non blank character of Hfldir *
-* Khmdir = last non blank character of Homdir *
-* Mxftnu = maximum fortran unit number allowed *
-* Comptr = model *
-* Inpfil = input file *
-* Pwddir = current work directory *
-* Hfldir = home FLUKA directory *
-* Homdir = user home directory *
-* Hostnm = host name *
-* Usrflk = user name *
-* *
-*----------------------------------------------------------------------*
-*
- CHARACTER COMPTR*50, INPFIL*80, PWDDIR*80, HFLDIR*80, HOMDIR*80,
- & HOSTNM*80, USRFLK*80
- COMMON / COMPUT / CPUSPE, CPUJOB, KOMPUT, KPWDIR, KFLDIR, KHMDIR,
- & MXFTNU
- COMMON / CHCMPT / COMPTR, INPFIL, PWDDIR, HFLDIR, HOMDIR, HOSTNM,
- & USRFLK
-
+++ /dev/null
-*$ CREATE COOKCM.ADD
-*COPY COOKCM
-*
-*----------------------------------------------------------------------*
-* *
-* Include file CookCm *
-* *
-* This is the Fluka version of LAHET common COOK *
-* *
-* This common together with the routines GETA,GETG and the relevant*
-* initialization in common BDEVAP has been obtained by the corre- *
-* sponding LAHET routines, thanks to the kindness of R.E.Prael *
-* *
-* Created on 18 january 1993 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 22-jul-00 by Alfredo Ferrari *
-* *
-* Note that the AMEAN array has been eliminated since its function *
-* is already provided by the Aprime array of EVAP-V from HETC-KFA *
-* Moreover the following variable names have been changed to avoid *
-* clashes: *
-* PZ --> PZCOOK *
-* PN --> PNCOOK *
-* SZ --> SZCOOK *
-* SN --> SNCOOK *
-* ISZ --> LDEFOZ *
-* ISN --> LDEFON *
-* and the array CON has been directly coded into GETA/GETG *
-* *
-* Data tables of Cook et. al. from AAEC/TM392, supplemented by G+C.*
-* *
-* The variables Pzgica, Pngica, Szgica, Sngica are the original *
-* values from A.Gilbert, A.G.W.Cameron, Can.J.Phys. 43 (1965) 1447 *
-* *
-* The ...IGN variables relate to the Ignyatuk-like fit for the *
-* excitation energy dependence of the level density. *
-* In particular, the asymptotic level density parameter is given *
-* by: *
-* a(oo) = alpign + betign * Ahelp *
-* where: *
-* Ahelp = A, for powign = 0 *
-* Ahelp = A^powign, for powign >< 0 *
-* and for any given Ueff (Ueff=U-delta): *
-* a(Ueff) = a(0) * G(gamma*Ueff) + a(oo) * [1 - G(gamma*Ueff)] *
-* where: *
-* G(x) = [1 - exp(-x)]/x *
-* and: *
-* gamma = gamign, for gamign > 0 *
-* gamma = -a(oo) / gamign / A^1/3, for gamign < 0 *
-* *
-*----------------------------------------------------------------------*
-*
-* Conversion factor from a to g:
- PARAMETER ( ASMTOG = SIXSIX / PIPIPI**2 )
-*
- LOGICAL LDEFOZ, LDEFON
- PARAMETER ( INCOOK = 150, IZCOOK = 98 )
- PARAMETER ( INGICA = 150, IZGICA = 98 )
- COMMON / COOKCM / ALPIGN, BETIGN, GAMIGN, POWIGN,
- & SZCOOK (IZCOOK), SNCOOK (INCOOK), PZCOOK (IZCOOK),
- & PNCOOK (INCOOK), SZGICA (IZGICA), SNGICA (INGICA),
- & PZGICA (IZGICA), PNGICA (INGICA), SZGINW (IZGICA),
- & SNGINW (INGICA), PZGINW (IZGICA), PNGINW (INGICA),
- & SZGIEX (IZGICA), SNGIEX (INGICA), PZGIEX (IZGICA),
- & PNGIEX (INGICA), LDEFOZ (IZCOOK), LDEFON (INCOOK)
-
+++ /dev/null
-*$ CREATE CORINC.ADD
-*COPY CORINC
-* *
-*=== corinc ===========================================================*
-* *
-*----------------------------------------------------------------------*
-* *
-* Created on 02 february 1990 by Alfredo Ferrari *
-* Infn - Milan *
-* *
-* Last change on 19-may-95 by Alfredo Ferrari *
-* *
-* Be sure that the parameter Inmax is >= than the same parameter *
-* in the function Nudisv *
-* *
-* Xquark = projectile (anti)quark X fraction for mesons and *
-* (anti)baryons *
-* Xqbdiq = projectile qbar/(anti)diquark X fraction for *
-* mesons/(anti)baryons *
-* Xequar = lab energy associated with Xquark *
-* Xpquar = lab momentum associated with Xquark *
-* Xeqbdq = lab energy associated with Xqbdiq *
-* Xpqbdq = lab momentum associated with Xqbdiq *
-* Xsea(i) = X fraction of the quark of the i_th sea qqbar *
-* couple *
-* Xasea(i) = X fraction of the qbar of the i_th sea qqbar *
-* couple *
-* Xesea(1,i) = lab energy associated with Xsea(i) *
-* Xesea(2,i) = lab energy associated with Xasea(i) *
-* Xpsea(1,i) = lab momentum associated with Xsea(i) *
-* Xpsea(2,i) = lab momentum associated with Xasea(i) *
-* Frainc = reduction factor for intranuclear cascade energy, *
-* including correlations *
-* Anuav = expected asymptotic (E_cms>>m_pro) average number *
-* of primary collisions, before threshold effects *
-* Sgivmd = Vector meson - A inelastic sigma *
-* Sivmdp = Vector meson - p inelastic sigma *
-* Sivmdn = Vector meson - n inelastic sigma *
-* Sgtvmd = Vector meson - A total sigma *
-* Stvmdp = Vector meson - p total sigma *
-* Stvmdn = Vector meson - n total sigma *
-* Iqsea(i) = quark id of the i_th sea qqbar couple *
-* Ijtarg(i+1) = target nucleon id of the i_th sea-valence intera- *
-* ction (i=0 --> valence-valence) *
-* Nsea = number of sea-valence interactions *
-* Nsebdf = number of sea-valence interactions before possible *
-* reductions due to diffraction exclusion *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( INMAX = 30 )
- COMMON / CORINC / XQUARK, XQBDIQ, XEQUAR, XPQUAR, XEQBDQ, XPQBDQ,
- & XSEA (INMAX), XASEA (INMAX), XESEA (2,INMAX),
- & XPSEA (2,INMAX), FRAINC, ANUAV, SGIVMD, SIVMDP,
- & SIVMDN, SGTVMD, STVMDP, STVMDN,
- & IQSEA (INMAX), IJTARG (INMAX+1), NSEA , NSEBDF
-
+++ /dev/null
-*$ CREATE COUNTQ.ADD
-*COPY COUNTQ
-*
-*=== countq ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* include file: countq copy *
-* *
-* New version of the original Countq from P.Aarnio: *
-* *
-* Now Sopp's have no meaning, it is used only to steer the new *
-* Fred James double precision random number generator *
-* *
-* Created on 19 july 1992 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 29-jan-97 by Alfredo Ferrari *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( MHLPAL = 2 * KALGNM )
- LOGICAL LFJR48
- COMMON / COUNTQ / SOPP (2), LFJR48
- DIMENSION KSOPP (MHLPAL)
- EQUIVALENCE ( KSOPP (1), SOPP (1) )
-
+++ /dev/null
-*$ CREATE CRQRKS.ADD
-*COPY CRQRKS
-*
-*=== Crqrks ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* CuRrent QuaRKS: *
-* *
-* Created on 21 october 1997 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 16-oct-00 by Alfredo Ferrari *
-* *
-* i=1,2 Iqrkx(i) = x_th (anti)quark of the i_th particle selected *
-* by qrstvx (1 selected normally, two selected for*
-* chain joining) *
-* i=-1,0 Iqrkx(i) = x_th (anti)quark of the last particle produced *
-* out of the -i jet (-i=LL in bamjev terminology) *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( MXQRKJ = 2 )
-*
- COMMON / CRQRKS / IQURK1 (-1:MXQRKJ), IQURK2 (-1:MXQRKJ),
- & IQURK3 (-1:MXQRKJ), NPRTST
+++ /dev/null
-*$ CREATE CSMCRY.ADD
-*COPY CSMCRY
-*
-*=== csmcry ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* CoSMiC RaY common: *
-* *
-* Created on 29 may 1996 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 29-mar-01 by Alfredo Ferrari *
-* *
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( MXATSH = 201 )
- PARAMETER ( MXPNSK = 64 )
- LOGICAL LGMGCO, LMBCKT, LCFCRC
- COMMON / CSMCRY / ALMGMG, PHMGMG, DOSCRN, ALPSCR, DPHSCR, BESMPL,
- & DOSMPL, TMNSMP, TMXSMP, PMNSMP, PMXSMP, PEARTH,
- & RPLANT, RPLNTS, RMNCTF, RMXCTF, CRBNNR,
- & SRSCRN (MXATSH),GAMMAE, SPNORM, CSTHPR,
- & AFLUX (79), XFLUX (79), FFLUX (79), RFLUX (79),
- & FLPINS(MXPNSK,28), FPINST(28), XCRCRR, YCRCRR,
- & ZCRCRR, TXCRCR, TYCRCR, TZCRCR, PCRCRR, IACRCR,
- & IZCRCR, IZPINS, NEPINS, IFLXFL, LGMGCO, LMBCKT,
- & LCFCRC
-
+++ /dev/null
-*$ CREATE CTITLE.ADD
-*COPY CTITLE
-*
-*=== ctitle ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Common Ctitle: it allows the identification of the run *
-* created by A. Ferrari on 10-feb-1990 *
-* *
-* included in: *
-* fluka (main) *
-* bdnopt *
-* detect *
-* jomin *
-* usrbin *
-* *
-*----------------------------------------------------------------------*
-*
- CHARACTER RUNTIT*80, RUNTIM*32, RUNKEY*10, RUNGEO*60
- COMMON / CTITLE / RUNTIT, RUNTIM, RUNKEY, RUNGEO
- COMMON / CEXPCK / ITEXPI, ITEXMX, IOPOUT, IOUTUN (MXOUTU)
-
+++ /dev/null
-*$ CREATE CURPRO.ADD
-*COPY CURPRO
-*
-*=== curpro ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* CURrent PROjectile parameters *
-* *
-* Created on 28 january 1992 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 29-jan-92 by Alfredo Ferrari *
-* *
-* Included in the following routines: *
-* *
-* BIMSEL *
-* NWISEL *
-* FORNUC *
-* *
-*----------------------------------------------------------------------*
-*
- COMMON / CURPRO / XCRRNT, YCRRNT, ZCRRNT, CXCRRN, CYCRRN, CZCRRN,
- & RCRRNT, VCRRNT, PCRRNT, ECRNNT
-
+++ /dev/null
-*$ CREATE DBLPRC.ADD
-*COPY DBLPRC
-* *
-*=== dblprc ==========================================================*
-* *
-*---------------------------------------------------------------------*
-* *
-* Dblprc: included in any routine, machine, mathematical and *
-* physical constants plus global declarations *
-* *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* !!!! O N M A C H I N E S W H E R E T H E D O U B L E !!!! *
-* !!!! P R E C I S I O N I S N O T R E Q U I R E D R E -!!!! *
-* !!!! M O V E T H E D O U B L E P R E C I S I O N !!!! *
-* !!!! S T A T E M E N T, S E T K A L G N M = 1 A N D !!!! *
-* !!!! C H A N G E A L L N U M E R I C A L C O N S - !!!! *
-* !!!! T A N T S T O S I N G L E P R E C I S I O N !!!! *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* *
-* Kalgnm = real address alignment, 2 for double precision, *
-* 1 for single precision *
-* Anglgb = this parameter should be set equal to the machine *
-* "zero" with respect to unit *
-* Anglsq = this parameter should be set equal to the square *
-* of Anglgb *
-* Axcssv = this parameter should be set equal to the number *
-* for which unity is negligible for the machine *
-* accuracy *
-* Andrfl = "underflow" of the machine for floating point *
-* operation *
-* Avrflw = "overflow" of the machine for floating point *
-* operation *
-* Ainfnt = code "infinite" *
-* Azrzrz = code "zero" *
-* Einfnt = natural logarithm of the code "infinite" *
-* Ezrzrz = natural logarithm of the code "zero" *
-* Excssv = natural logarithm of the code number for which *
-* unit is negligible *
-* Englgb = natural logarithm of the code "zero" with respect *
-* to unit *
-* Onemns = 1- of the machine, it is 1 - 2 x Anglgb *
-* Onepls = 1+ of the machine, it is 1 + 2 x Anglgb *
-* Csnnrm = maximum tolerable error on cosine normalization, *
-* u**2+v**2+w**2: assuming a typical anglgb relative *
-* error on each component we would get 2xanglgb: use *
-* 4xanglgb to avoid too many normalizations *
-* Dmxtrn = "infinite" distance for transport (cm) *
-* Rhflmn = minimal density for Fluka (g/cm^3) *
-* *
-* "Global" declarations: *
-* Lfluka = set to true for a real (full) Fluka run *
-* Lgbias = set to true for a fully biased run *
-* Lgbana = set to true for a fully analogue run *
-* Lflgeo = set to true when using the standard Fluka geometry *
-* Loflts = set to true for special off-line testing of speci- *
-* fic routines *
-* Lusrin = set to true if the user dependent initialization *
-* routine Usrini has been called at least onec *
-* *
-*---------------------------------------------------------------------*
-* *
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- PARAMETER ( KALGNM = 2 )
- PARAMETER ( ANGLGB = 5.0D-16 )
- PARAMETER ( ANGLSQ = 2.5D-31 )
- PARAMETER ( AXCSSV = 0.2D+16 )
- PARAMETER ( ANDRFL = 1.0D-38 )
- PARAMETER ( AVRFLW = 1.0D+38 )
- PARAMETER ( AINFNT = 1.0D+30 )
- PARAMETER ( AZRZRZ = 1.0D-30 )
- PARAMETER ( EINFNT = +69.07755278982137 D+00 )
- PARAMETER ( EZRZRZ = -69.07755278982137 D+00 )
- PARAMETER ( EXCSSV = +35.23192357547063 D+00 )
- PARAMETER ( ENGLGB = -35.23192357547063 D+00 )
- PARAMETER ( ONEMNS = 0.999999999999999 D+00 )
- PARAMETER ( ONEPLS = 1.000000000000001 D+00 )
- PARAMETER ( CSNNRM = 2.0D-15 )
- PARAMETER ( DMXTRN = 1.0D+08 )
- PARAMETER ( RHFLMN = 1.0D-06 )
-*
-*======================================================================*
-*======================================================================*
-*========= ==========*
-*========= M A T H E M A T I C A L C O N S T A N T S ==========*
-*========= ==========*
-*======================================================================*
-*======================================================================*
-* *
-* Numerical constants (single precision): *
-* *
-* Zersng = 0 *
-* *
-* Numerical constants (double precision): *
-* *
-* Zerzer = 0 *
-* Oneone = 1 *
-* Twotwo = 2 *
-* Thrthr = 3 *
-* Foufou = 4 *
-* Fivfiv = 5 *
-* Sixsix = 6 *
-* Sevsev = 7 *
-* Eigeig = 8 *
-* Aninen = 9 *
-* Tenten = 10 *
-* Eleven = 11 *
-* Twelve = 12 *
-* Fiften = 15 *
-* Sixten = 16 *
-* Hlfhlf = 1/2 *
-* Onethi = 1/3 *
-* Onefou = 1/4 *
-* Onefiv = 1/5 *
-* Onesix = 1/6 *
-* Onesev = 1/7 *
-* Oneeig = 1/8 *
-* Twothi = 2/3 *
-* Thrfou = 3/4 *
-* Thrtwo = 3/2 *
-* Pipipi = Circumference / diameter *
-* Twopip = 2 x Pipipi *
-* Pip5o2 = 5/2 x Pipipi *
-* Pipisq = Pipipi x Pipipi *
-* Pihalf = 1/2 x Pipipi *
-* Erfa00 = Erf (oo) = 1/2 x square root of pi *
-* Sqtwpi = square root of 2xpi *
-* Eulero = Eulero's constant *
-* Eulexp = exp ( Eulero ) *
-* E1m2eu = exp ( 1 - 2 eulero ) *
-* Eneper = "e", base of natural logarithm *
-* Sqrent = square root of "e" *
-* Sqrtwo = square root of 2 *
-* Sqrthr = square root of 3 *
-* Sqrfiv = square root of 5 *
-* Sqrsix = square root of 6 *
-* Sqrsev = square root of 7 *
-* Sqrt12 = square root of 12 *
-* *
-*----------------------------------------------------------------------*
-*
- REAL ZERSNG
- PARAMETER ( ZERSNG = 0.E+00 )
- PARAMETER ( ZERZER = 0.D+00 )
- PARAMETER ( ONEONE = 1.D+00 )
- PARAMETER ( TWOTWO = 2.D+00 )
- PARAMETER ( THRTHR = 3.D+00 )
- PARAMETER ( FOUFOU = 4.D+00 )
- PARAMETER ( FIVFIV = 5.D+00 )
- PARAMETER ( SIXSIX = 6.D+00 )
- PARAMETER ( SEVSEV = 7.D+00 )
- PARAMETER ( EIGEIG = 8.D+00 )
- PARAMETER ( ANINEN = 9.D+00 )
- PARAMETER ( TENTEN = 10.D+00 )
- PARAMETER ( ELEVEN = 11.D+00 )
- PARAMETER ( TWELVE = 12.D+00 )
- PARAMETER ( FIFTEN = 15.D+00 )
- PARAMETER ( SIXTEN = 16.D+00 )
- PARAMETER ( HLFHLF = 0.5D+00 )
- PARAMETER ( ONETHI = ONEONE / THRTHR )
- PARAMETER ( ONEFOU = ONEONE / FOUFOU )
- PARAMETER ( ONEFIV = ONEONE / FIVFIV )
- PARAMETER ( ONESIX = ONEONE / SIXSIX )
- PARAMETER ( ONESEV = ONEONE / SEVSEV )
- PARAMETER ( ONEEIG = ONEONE / EIGEIG )
- PARAMETER ( TWOTHI = TWOTWO / THRTHR )
- PARAMETER ( THRFOU = THRTHR / FOUFOU )
- PARAMETER ( THRTWO = THRTHR / TWOTWO )
- PARAMETER ( PIPIPI = 3.141592653589793238462643383279D+00 )
- PARAMETER ( TWOPIP = 6.283185307179586476925286766559D+00 )
- PARAMETER ( PIP5O2 = 7.853981633974483096156608458199D+00 )
- PARAMETER ( PIPISQ = 9.869604401089358618834490999876D+00 )
- PARAMETER ( PIHALF = 1.570796326794896619231321691640D+00 )
- PARAMETER ( ERFA00 = 0.886226925452758013649083741671D+00 )
- PARAMETER ( SQRTPI = 1.772453850905516027298167483341D+00 )
- PARAMETER ( SQTWPI = 2.506628274631000502415765284811D+00 )
- PARAMETER ( EULERO = 0.577215664901532860606512 D+00 )
- PARAMETER ( EULEXP = 1.781072417990197985236504 D+00 )
- PARAMETER ( EULLOG =-0.5495393129816448223376619 D+00 )
- PARAMETER ( E1M2EU = 0.8569023337737540831433017 D+00 )
- PARAMETER ( ENEPER = 2.718281828459045235360287471353D+00 )
- PARAMETER ( SQRENT = 1.648721270700128146848650787814D+00 )
- PARAMETER ( SQRTWO = 1.414213562373095048801688724210D+00 )
- PARAMETER ( SQRTHR = 1.732050807568877293527446341506D+00 )
- PARAMETER ( SQRFIV = 2.236067977499789696409173668731D+00 )
- PARAMETER ( SQRSIX = 2.449489742783178098197284074706D+00 )
- PARAMETER ( SQRSEV = 2.645751311064590590501615753639D+00 )
- PARAMETER ( SQRT12 = 3.464101615137754587054892683012D+00 )
-*
-*======================================================================*
-*======================================================================*
-*========= ==========*
-*========= P H Y S I C A L C O N S T A N T S ==========*
-*========= ==========*
-*======================================================================*
-*======================================================================*
-* *
-* Primary constants: *
-* *
-* Clight = speed of light in cm s-1 *
-* Avogad = Avogadro number *
-* Boltzm = k Boltzmann constant (J K-1) *
-* Amelgr = electron mass (g) *
-* Plckbr = reduced Planck constant (erg s) *
-* Elccgs = elementary charge (CGS unit) *
-* Elcmks = elementary charge (MKS unit) *
-* Amugrm = Atomic mass unit (g) *
-* Ammumu = Muon mass (amu) *
-* Amprmu = Proton mass (amu) *
-* Amnemu = Neutron mass (amu) *
-* *
-* Derived constants: *
-* *
-* Alpfsc = Fine structure constant = e^2/(hbar c) (CGS units) *
-* Amelct = Electron mass (GeV) = 10^-16Amelgr Clight^2 / Elcmks*
-* Amugev = Atomic mass unit (GeV) = 10^-16Amugrm Clight^2 *
-* / Elcmks *
-* Ammuon = Muon mass (GeV) = Ammumu * Amugev *
-* Amprtn = Proton mass (GeV) = Amprmu * Amugev *
-* Amntrn = Neutron mass (GeV) = Amnemu * Amugev *
-* Amdeut = Deuteron mass (GeV) *
-* Amalph = Alpha mass (GeV) (derived from the excess mass *
-* and an (approximate) atomic binding not a really *
-* measured constant) *
-* Cougfm = e^2 (GeV fm) = Elccgs^2 / Elcmks * 10^-7 * 10^-9 *
-* * 10^13 (10^..=erg cm->joule cm->GeV cm->GeV fm *
-* it is equal to 0.00144 GeV fm *
-* Fscto2 = (Fine structure constant)^2 *
-* Fscto3 = (Fine structure constant)^3 *
-* Fscto4 = (Fine structure constant)^4 *
-* Plabrc = Reduced Planck constant times the light velocity *
-* expressed in GeV fm *
-* Rclsel = Classical electron radius (cm) = e^2 / (m_e c^2) *
-* Bltzmn = k Boltzmann constant in GeV K-1 *
-* A0bohr = Bohr radius, hbar^2 / ( m_e e^2) (fm) = Plabrc**2 *
-* / Amelct / Cougfm, or equivalently, *
-* Plabrc / Alpfsc / Amelct *
-* Gfohb3 = Fermi constant, G_f/(hbar c)^3, in GeV^-2 *
-* Gfermi = Fermi constant in GeV fm^3 *
-* Sin2tw = sin^2 theta_Weinberg *
-* Prmgnm = proton magnetic moment (magneton) *
-* Anmgnm = neutron magnetic moment (magneton) *
-* *
-* Astronomical constants: *
-* *
-* Rearth = Earth equatorial radius (cm) *
-* Auastu = Astronomical Unit (cm) *
-* *
-* Conversion constants: *
-* *
-* GeVMeV = from GeV to MeV *
-* eMVGeV = from MeV to GeV *
-* alGVMV = from GeV to MeV, log *
-* Raddeg = from radians to degrees *
-* Degrad = from degrees to radians *
-* GeVOmg = from (photon) energy [GeV] in 2pi x frequency [s^-1]*
-* *
-* Useful constants: *
-* *
-* Fertho = constant to be used in the Fermi-Thomas approxima- *
-* ted expression for atomic binding energies *
-* Expebn = exponent to be used in the Fermi-Thomas approxima- *
-* ted expression for atomic binding energies *
-* B_atomic (Z) = Fertho x Z^Expebn (GeV) *
-* Bexc12 = Fermi-Thomas approximated expression for 12-C ato- *
-* mic binding energies (GeV) *
-* Amunmu = difference between the atomic and nuclear mass units*
-* Amuc12 = "Nuclear" mass unit = 1/12 M_nucl (12-C), *
-* M_nucl (12-C) = M_atom (12-C) - 6 m_e + B_atom(12-C)*
-* *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( CLIGHT = 2.99792458 D+10 )
- PARAMETER ( AVOGAD = 6.0221367 D+23 )
- PARAMETER ( BOLTZM = 1.380658 D-23 )
- PARAMETER ( AMELGR = 9.1093897 D-28 )
- PARAMETER ( PLCKBR = 1.05457266 D-27 )
- PARAMETER ( ELCCGS = 4.8032068 D-10 )
- PARAMETER ( ELCMKS = 1.60217733 D-19 )
- PARAMETER ( AMUGRM = 1.6605402 D-24 )
- PARAMETER ( AMMUMU = 0.113428913 D+00 )
- PARAMETER ( AMPRMU = 1.007276470 D+00 )
- PARAMETER ( AMNEMU = 1.008664904 D+00 )
-* PARAMETER ( ALPFSC = 1.D+00 / 137.035989561D+00 )
-* PARAMETER ( FSCTO2 = ALPFSC * ALPFSC )
-* PARAMETER ( FSCTO3 = FSCTO2 * ALPFSC )
-* PARAMETER ( FSCTO4 = FSCTO3 * ALPFSC )
-* It is important to set the electron mass exactly with the same
-* rounding as in the mass tables, so use the explicit expression
-* PARAMETER ( AMELCT = 1.D-16 * AMELGR * CLIGHT * CLIGHT / ELCMKS )
-* It is important to set the amu mass exactly with the same
-* rounding as in the mass tables, so use the explicit expression
-* PARAMETER ( AMUGEV = 1.D-16 * AMUGRM * CLIGHT * CLIGHT / ELCMKS )
-* It is important to set the muon,proton,neutron masses exactly with
-* the same rounding as in the mass tables, so use the explicit
-* expression
-* PARAMETER ( AMMUON = AMMUMU * AMUGEV )
-* PARAMETER ( AMPRTN = AMPRMU * AMUGEV )
-* PARAMETER ( AMNTRN = AMNEMU * AMUGEV )
-* PARAMETER ( RCLSEL = ELCCGS * ELCCGS / CLIGHT / CLIGHT / AMELGR )
-* PARAMETER ( BLTZMN = BOLTZM / ELCMKS * 1.D-09 )
- PARAMETER ( ALPFSC = 7.2973530791728595 D-03 )
- PARAMETER ( FSCTO2 = 5.3251361962113614 D-05 )
- PARAMETER ( FSCTO3 = 3.8859399018437826 D-07 )
- PARAMETER ( FSCTO4 = 2.8357075508200407 D-09 )
- PARAMETER ( PLABRC = 0.197327053 D+00 )
- PARAMETER ( AMELCT = 0.51099906 D-03 )
- PARAMETER ( AMUGEV = 0.93149432 D+00 )
- PARAMETER ( AMMUON = 0.105658389 D+00 )
- PARAMETER ( AMPRTN = 0.93827231 D+00 )
- PARAMETER ( AMNTRN = 0.93956563 D+00 )
- PARAMETER ( AMDEUT = 1.87561339 D+00 )
- PARAMETER ( AMALPH = 3.72738025692891 D+00 )
- PARAMETER ( COUGFM = ELCCGS * ELCCGS / ELCMKS * 1.D-07 * 1.D+13
- & * 1.D-09 )
- PARAMETER ( RCLSEL = 2.8179409183694872 D-13 )
- PARAMETER ( BLTZMN = 8.617385 D-14 )
- PARAMETER ( A0BOHR = PLABRC / ALPFSC / AMELCT )
- PARAMETER ( GFOHB3 = 1.16639 D-05 )
- PARAMETER ( GFERMI = GFOHB3 * PLABRC * PLABRC * PLABRC )
- PARAMETER ( SIN2TW = 0.2319 D+00 )
- PARAMETER ( PRMGNM = 2.792847386 D+00 )
- PARAMETER ( ANMGNM =-1.91304275 D+00 )
- PARAMETER ( REARTH = 6.378140 D+08 )
- PARAMETER ( AUASTU = 1.4959787066 D+13 )
- PARAMETER ( GEVMEV = 1.0 D+03 )
- PARAMETER ( EMVGEV = 1.0 D-03 )
- PARAMETER ( ALGVMV = 6.90775527898214 D+00 )
- PARAMETER ( RADDEG = 180.D+00 / PIPIPI )
- PARAMETER ( DEGRAD = PIPIPI / 180.D+00 )
- PARAMETER ( GEVOMG = CLIGHT * 1.D+13 / PLABRC )
-* Old Fermi-Thomas parametrization of atomic binding energies:
-* PARAMETER ( FERTHO = 15.73 D-09 )
-* PARAMETER ( EXPEBN = 7.D+00 / 3.D+00 )
-* PARAMETER ( BEXC12 = FERTHO * 65.41634134195703D+00 )
-* New Fermi-Thomas parametrization of atomic binding energies:
- PARAMETER ( FERTHO = 14.33 D-09 )
- PARAMETER ( EXPEBN = 2.39 D+00 )
- PARAMETER ( BEXC12 = FERTHO * 72.40715579499394D+00 )
- PARAMETER ( AMUNMU = HLFHLF * AMELCT - BEXC12 / 12.D+00 )
- PARAMETER ( AMUC12 = AMUGEV - AMUNMU )
-*
- LOGICAL LFLUKA, LGBIAS, LGBANA, LFLGEO, LOFLTS, LUSRIN
- COMMON / GLOBAL / LFLUKA, LGBIAS, LGBANA, LFLGEO, LOFLTS,
- & LUSRIN, KFLGEO, KFLDNR
-
+++ /dev/null
-*$ CREATE DCDRBS.ADD
-*COPY DCDRBS
-*
-*=== Dcdrbs ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* DeCay DiRection BiaSing: *
-* *
-* Created on 30 march 1998 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 13-apr-98 by Alfredo Ferrari *
-* *
-* Aldcdr = Lamda for eps=1-cos(theta). The polar direction *
-* around the direction corresponding to the one *
-* wished by the user is sample from *
-* P(eps) = exp (-eps/Aldcdr) *
-* U,V,Wdcdrb = Lab direction the neutrino should go along *
-* Sdcdrb = Sin(acos(Wdcdrb)) *
-* Spdcdr = Vdcdrb / Sdcdrb *
-* Cpdcdr = Udcdrb / Sdcdrb *
-* Aldcdc = current Lamda for eps=1-cos(theta) *
-* Sth0dc = Sin(Theta_0), where (Theta_0,Phi_0) is the direc- *
-* tion corresponding to U,V,Wdcdrb in the decaying *
-* particle CMS *
-* Cth0dc = Cos(Theta_0) *
-* Sph0dc = Sin(Phi_0) *
-* Cph0dc = Cos(Phi_0) *
-* Kpdcdr = number (1,2,3...) of the decay product whose *
-* direction is biased *
-* Ldcdrb(i) = flag for decay direction biasing for i_th particle *
-* type (Paprop numbering scheme) *
-* Ldcdbc = current flag for decay direction biasing *
-* *
-*----------------------------------------------------------------------*
-*
- LOGICAL LDCDRB, LDCDBC
-*
- COMMON / DCDRBS / ALDCDR, UDCDRB, VDCDRB, WDCDRB, SDCDRB, SPDCDR,
- & CPDCDR, ALDCDC, STH0DC, CTH0DC, SPH0DC, CPH0DC,
- & KPDCDR, LDCDRB (-6:NALLWP), LDCDBC
-
+++ /dev/null
-*$ CREATE DECAYC.ADD
-*COPY DECAYC
-*
-*=== Decayc ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Include file: Decayc (new version of old Decayc) *
-* *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* !!!! S E E A L S O I N C L U D E F I L E !!!! *
-* !!!! D E C A Y C 2 !!!! *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* *
-* Created on 07 february 1997 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 07-feb-97 by Alfredo Ferrari *
-* *
-* Included in the following routines: *
-* *
-* AMPART *
-* BLKDT7 *
-* CHANWT *
-* DATEST *
-* DECAY *
-* DIFEVV *
-* HADDEN *
-* *
-*----------------------------------------------------------------------*
-*
- CHARACTER*8 ZKNAME
- COMMON / DECAYC / WT (-6:IDMXDC), NZK (-6:IDMXDC,3)
- COMMON / DCYCCH / ZKNAME (-6:IDMXDC)
-
+++ /dev/null
-*$ CREATE DECAYC2.ADD
-*COPY DECAYC2
-*
-*=== Decayc2 ==========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Include file: Decayc2 (new version of old Decayc2) *
-* *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* !!!! S E E A L S O I N C L U D E F I L E !!!! *
-* !!!! D E C A Y C !!!! *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* *
-* Created on 07 february 1997 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 07-feb-97 by Alfredo Ferrari *
-* *
-* Included in the following routines: *
-* *
-* AMPART *
-* BLKDT7 *
-* CHANWT *
-* DATEST *
-* DECAY *
-* DIFEVV *
-* HADDEN *
-* *
-*----------------------------------------------------------------------*
-*
- CHARACTER*8 ZKNAMC
- COMMON / DECAYC / WTC (-6:IDMXDC), NZKC (-6:IDMXDC,3)
- COMMON / DCYCCH / ZKNAMC (-6:IDMXDC)
-
+++ /dev/null
-*$ CREATE DEPNUC.ADD
-*COPY DEPNUC
-* *
-*=== depnuc ===========================================================*
-* *
-*----------------------------------------------------------------------*
-* *
-* DEPleted NUCleus: *
-* *
-* Created on 05 may 1990 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 02-may-95 by Alfredo Ferrari *
-* *
-* Llastn = flag for the situation where just two residual *
-* target nucleons are left *
-* Llast1 = flag for the situation where just one residual *
-* target nucleon is left *
-* *
-*----------------------------------------------------------------------*
-*
- LOGICAL LLASTN, LLAST1
- COMMON /DEPNUC/ EKLAST, AMLAST, PXLAST, PYLAST, PZLAST,
- & EKINC , AMINC , PXXINC, PYYINC, PZZINC,
- & KTLAST, KTINC , LLASTN, LLAST1
-
+++ /dev/null
-*$ CREATE DETECT.ADD
-*COPY DETECT
-* *
-*=== detect ===========================================================*
-* *
-
-*----------------------------------------------------------------------*
-* *
-* detect created 20-sep-1989 by A. Ferrari *
-* *
-* included in: *
-* geoden *
-* detect *
-* bdnopt *
-* *
-* W A R N I N G any change of the Ndtcmx parameter must be *
-* done also on the Ndtcm2 parameter of the Detloc module! *
-*----------------------------------------------------------------------*
-* *
- PARAMETER (NRGNMX = 10)
- PARAMETER (NDTCMX = 10)
- PARAMETER (NSCRMX = 10)
- PARAMETER (NDTBIN = 1024)
- CHARACTER*10 TITDET,TITSCO
- LOGICAL LDTCTR
- COMMON /DETCT/ EDTMIN(NDTCMX), EDTBIN(NDTCMX), EDTCUT(NDTCMX),
- & KDTREG(NRGNMX,NDTCMX), KDTDET(NDTCMX,NSCRMX),
- & NDTSCO, NDTDET, LDTCTR, IDTREG(MXXRGN),
- & KDTSCD(NSCRMX)
- COMMON /DETCH/ TITDET(NDTCMX), TITSCO(NSCRMX)
-
+++ /dev/null
-*$ CREATE DETLOC.ADD
-*COPY DETLOC
-* *
-*=== detloc ===========================================================*
-* *
-
-*----------------------------------------------------------------------*
-* *
-* detloc created 20-sep-1989 by A. Ferrari *
-* *
-* included in: *
-* &nbs
git://git.uio.no / u / mrichter / AliRoot.git / commitdiff