DPMJET/flukapro/(DBLPRC)

   1 *$ CREATE DBLPRC.ADD
   2 *COPY DBLPRC
   3 *                                                                     *
   4 *=== dblprc ==========================================================*
   5 *                                                                     *
   6 *---------------------------------------------------------------------*
   7 *                                                                     *
   8 *      Dblprc: included in any routine, machine, mathematical and     *
   9 *              physical constants plus global declarations            *
  10 *                                                                     *
  11 *  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  *
  12 *  !!!! O N   M A C H I N E S   W H E R E   T H E   D O U B L E !!!!  *
  13 *  !!!! P R E C I S I O N   I S   N O T   R E Q U I R E D  R E -!!!!  *
  14 *  !!!! M O V E   T H E   D O U B L E   P R E C I S I O N       !!!!  *
  15 *  !!!! S T A T E M E N T,  S E T   K A L G N M = 1   A N D     !!!!  *
  16 *  !!!! C H A N G E   A L L   N U M E R I C A L   C O N S -     !!!!  *
  17 *  !!!! T A N T S   T O   S I N G L E   P R E C I S I O N       !!!!  *
  18 *  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  *
  19 *                                                                     *
  20 *         Kalgnm = real address alignment, 2 for double precision,    *
  21 *                  1 for single precision                             *
  22 *         Anglgb = this parameter should be set equal to the machine  *
  23 *                  "zero" with respect to unit                        *
  24 *         Anglsq = this parameter should be set equal to the square   *
  25 *                  of Anglgb                                          *
  26 *         Axcssv = this parameter should be set equal to the number   *
  27 *                  for which unity is negligible for the machine      *
  28 *                  accuracy                                           *
  29 *         Andrfl = "underflow" of the machine for floating point      *
  30 *                  operation                                          *
  31 *         Avrflw = "overflow"  of the machine for floating point      *
  32 *                  operation                                          *
  33 *         Ainfnt = code "infinite"                                    *
  34 *         Azrzrz = code "zero"                                        *
  35 *         Einfnt = natural logarithm of the code "infinite"           *
  36 *         Ezrzrz = natural logarithm of the code "zero"               *
  37 *         Excssv = natural logarithm of the code number for which     *
  38 *                  unit is negligible                                 *
  39 *         Englgb = natural logarithm of the code "zero" with respect  *
  40 *                  to unit                                            *
  41 *         Onemns = 1- of the machine, it is 1 - 2 x Anglgb            *
  42 *         Onepls = 1+ of the machine, it is 1 + 2 x Anglgb            *
  43 *         Csnnrm = maximum tolerable error on cosine normalization,   *
  44 *                  u**2+v**2+w**2: assuming a typical anglgb relative *
  45 *                  error on each component we would get 2xanglgb: use *
  46 *                  4xanglgb to avoid too many normalizations          *
  47 *         Dmxtrn = "infinite" distance for transport (cm)             *
  48 *         Rhflmn = minimal density for Fluka (g/cm^3)                 *
  49 *                                                                     *
  50 *   "Global" declarations:                                            *
  51 *         Lfluka = set to true for a real (full) Fluka run            *
  52 *         Lgbias = set to true for a fully biased run                 *
  53 *         Lgbana = set to true for a fully analogue run               *
  54 *         Lflgeo = set to true when using the standard Fluka geometry *
  55 *         Loflts = set to true for special off-line testing of speci- *
  56 *                  fic routines                                       *
  57 *         Lusrin = set to true if the user dependent initialization   *
  58 *                  routine Usrini has been called at least onec       *
  59 *                                                                     *
  60 *---------------------------------------------------------------------*
  61 *                                                                     *
  62       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  63       PARAMETER ( KALGNM = 2 )
  64       PARAMETER ( ANGLGB = 5.0D-16 )
  65       PARAMETER ( ANGLSQ = 2.5D-31 )
  66       PARAMETER ( AXCSSV = 0.2D+16 )
  67       PARAMETER ( ANDRFL = 1.0D-38 )
  68       PARAMETER ( AVRFLW = 1.0D+38 )
  69       PARAMETER ( AINFNT = 1.0D+30 )
  70       PARAMETER ( AZRZRZ = 1.0D-30 )
  71       PARAMETER ( EINFNT = +69.07755278982137 D+00 )
  72       PARAMETER ( EZRZRZ = -69.07755278982137 D+00 )
  73       PARAMETER ( EXCSSV = +35.23192357547063 D+00 )
  74       PARAMETER ( ENGLGB = -35.23192357547063 D+00 )
  75       PARAMETER ( ONEMNS = 0.999999999999999  D+00 )
  76       PARAMETER ( ONEPLS = 1.000000000000001  D+00 )
  77       PARAMETER ( CSNNRM = 2.0D-15 )
  78       PARAMETER ( DMXTRN = 1.0D+08 )
  79       PARAMETER ( RHFLMN = 1.0D-06 )
  80 *
  81 *======================================================================*
  82 *======================================================================*
  83 *=========                                                   ==========*
  84 *=========    M A T H E M A T I C A L   C O N S T A N T S    ==========*
  85 *=========                                                   ==========*
  86 *======================================================================*
  87 *======================================================================*
  88 *                                                                      *
  89 *   Numerical constants (single precision):                            *
  90 *                                                                      *
  91 *         Zersng = 0                                                   *
  92 *                                                                      *
  93 *   Numerical constants (double precision):                            *
  94 *                                                                      *
  95 *         Zerzer = 0                                                   *
  96 *         Oneone = 1                                                   *
  97 *         Twotwo = 2                                                   *
  98 *         Thrthr = 3                                                   *
  99 *         Foufou = 4                                                   *
 100 *         Fivfiv = 5                                                   *
 101 *         Sixsix = 6                                                   *
 102 *         Sevsev = 7                                                   *
 103 *         Eigeig = 8                                                   *
 104 *         Aninen = 9                                                   *
 105 *         Tenten = 10                                                  *
 106 *         Eleven = 11                                                  *
 107 *         Twelve = 12                                                  *
 108 *         Fiften = 15                                                  *
 109 *         Sixten = 16                                                  *
 110 *         Hlfhlf = 1/2                                                 *
 111 *         Onethi = 1/3                                                 *
 112 *         Onefou = 1/4                                                 *
 113 *         Onefiv = 1/5                                                 *
 114 *         Onesix = 1/6                                                 *
 115 *         Onesev = 1/7                                                 *
 116 *         Oneeig = 1/8                                                 *
 117 *         Twothi = 2/3                                                 *
 118 *         Thrfou = 3/4                                                 *
 119 *         Thrtwo = 3/2                                                 *
 120 *         Pipipi = Circumference / diameter                            *
 121 *         Twopip = 2 x Pipipi                                          *
 122 *         Pip5o2 = 5/2 x Pipipi                                        *
 123 *         Pipisq = Pipipi x Pipipi                                     *
 124 *         Pihalf = 1/2 x Pipipi                                        *
 125 *         Erfa00 = Erf (oo) = 1/2 x square root of pi                  *
 126 *         Sqtwpi = square root of 2xpi                                 *
 127 *         Eulero = Eulero's constant                                   *
 128 *         Eulexp = exp ( Eulero )                                      *
 129 *         E1m2eu = exp ( 1 - 2 eulero )                                *
 130 *         Eneper = "e", base of natural logarithm                      *
 131 *         Sqrent = square root of "e"                                  *
 132 *         Sqrtwo = square root of  2                                   *
 133 *         Sqrthr = square root of  3                                   *
 134 *         Sqrfiv = square root of  5                                   *
 135 *         Sqrsix = square root of  6                                   *
 136 *         Sqrsev = square root of  7                                   *
 137 *         Sqrt12 = square root of 12                                   *
 138 *                                                                      *
 139 *----------------------------------------------------------------------*
 140 *
 141       REAL ZERSNG
 142       PARAMETER ( ZERSNG = 0.E+00 )
 143       PARAMETER ( ZERZER = 0.D+00 )
 144       PARAMETER ( ONEONE = 1.D+00 )
 145       PARAMETER ( TWOTWO = 2.D+00 )
 146       PARAMETER ( THRTHR = 3.D+00 )
 147       PARAMETER ( FOUFOU = 4.D+00 )
 148       PARAMETER ( FIVFIV = 5.D+00 )
 149       PARAMETER ( SIXSIX = 6.D+00 )
 150       PARAMETER ( SEVSEV = 7.D+00 )
 151       PARAMETER ( EIGEIG = 8.D+00 )
 152       PARAMETER ( ANINEN = 9.D+00 )
 153       PARAMETER ( TENTEN = 10.D+00 )
 154       PARAMETER ( ELEVEN = 11.D+00 )
 155       PARAMETER ( TWELVE = 12.D+00 )
 156       PARAMETER ( FIFTEN = 15.D+00 )
 157       PARAMETER ( SIXTEN = 16.D+00 )
 158       PARAMETER ( HLFHLF = 0.5D+00 )
 159       PARAMETER ( ONETHI = ONEONE / THRTHR )
 160       PARAMETER ( ONEFOU = ONEONE / FOUFOU )
 161       PARAMETER ( ONEFIV = ONEONE / FIVFIV )
 162       PARAMETER ( ONESIX = ONEONE / SIXSIX )
 163       PARAMETER ( ONESEV = ONEONE / SEVSEV )
 164       PARAMETER ( ONEEIG = ONEONE / EIGEIG )
 165       PARAMETER ( TWOTHI = TWOTWO / THRTHR )
 166       PARAMETER ( THRFOU = THRTHR / FOUFOU )
 167       PARAMETER ( THRTWO = THRTHR / TWOTWO )
 168       PARAMETER ( PIPIPI = 3.141592653589793238462643383279D+00 )
 169       PARAMETER ( TWOPIP = 6.283185307179586476925286766559D+00 )
 170       PARAMETER ( PIP5O2 = 7.853981633974483096156608458199D+00 )
 171       PARAMETER ( PIPISQ = 9.869604401089358618834490999876D+00 )
 172       PARAMETER ( PIHALF = 1.570796326794896619231321691640D+00 )
 173       PARAMETER ( ERFA00 = 0.886226925452758013649083741671D+00 )
 174       PARAMETER ( SQRTPI = 1.772453850905516027298167483341D+00 )
 175       PARAMETER ( SQTWPI = 2.506628274631000502415765284811D+00 )
 176       PARAMETER ( EULERO = 0.577215664901532860606512      D+00 )
 177       PARAMETER ( EULEXP = 1.781072417990197985236504      D+00 )
 178       PARAMETER ( EULLOG =-0.5495393129816448223376619     D+00 )
 179       PARAMETER ( E1M2EU = 0.8569023337737540831433017     D+00 )
 180       PARAMETER ( ENEPER = 2.718281828459045235360287471353D+00 )
 181       PARAMETER ( SQRENT = 1.648721270700128146848650787814D+00 )
 182       PARAMETER ( SQRTWO = 1.414213562373095048801688724210D+00 )
 183       PARAMETER ( SQRTHR = 1.732050807568877293527446341506D+00 )
 184       PARAMETER ( SQRFIV = 2.236067977499789696409173668731D+00 )
 185       PARAMETER ( SQRSIX = 2.449489742783178098197284074706D+00 )
 186       PARAMETER ( SQRSEV = 2.645751311064590590501615753639D+00 )
 187       PARAMETER ( SQRT12 = 3.464101615137754587054892683012D+00 )
 188 *
 189 *======================================================================*
 190 *======================================================================*
 191 *=========                                                   ==========*
 192 *=========       P H Y S I C A L   C O N S T A N T S         ==========*
 193 *=========                                                   ==========*
 194 *======================================================================*
 195 *======================================================================*
 196 *                                                                      *
 197 *   Primary constants:                                                 *
 198 *                                                                      *
 199 *         Clight = speed of light in cm s-1                            *
 200 *         Avogad = Avogadro number                                     *
 201 *         Boltzm = k Boltzmann constant (J K-1)                        *
 202 *         Amelgr = electron mass (g)                                   *
 203 *         Plckbr = reduced Planck constant (erg s)                     *
 204 *         Elccgs = elementary charge (CGS unit)                        *
 205 *         Elcmks = elementary charge (MKS unit)                        *
 206 *         Amugrm = Atomic mass unit (g)                                *
 207 *         Ammumu = Muon    mass (amu)                                  *
 208 *         Amprmu = Proton  mass (amu)                                  *
 209 *         Amnemu = Neutron mass (amu)                                  *
 210 *                                                                      *
 211 *   Derived constants:                                                 *
 212 *                                                                      *
 213 *         Alpfsc = Fine structure constant  = e^2/(hbar c) (CGS units) *
 214 *         Amelct = Electron mass (GeV) = 10^-16Amelgr Clight^2 / Elcmks*
 215 *         Amugev = Atomic mass unit (GeV) = 10^-16Amugrm Clight^2      *
 216 *                                           / Elcmks                   *
 217 *         Ammuon = Muon    mass (GeV) = Ammumu * Amugev                *
 218 *         Amprtn = Proton  mass (GeV) = Amprmu * Amugev                *
 219 *         Amntrn = Neutron mass (GeV) = Amnemu * Amugev                *
 220 *         Amdeut = Deuteron mass (GeV)                                 *
 221 *         Amalph = Alpha    mass (GeV) (derived from the excess mass   *
 222 *                  and an (approximate) atomic binding not a really    *
 223 *                  measured constant)                                  *
 224 *         Cougfm = e^2 (GeV fm) = Elccgs^2 / Elcmks * 10^-7 * 10^-9    *
 225 *                * 10^13 (10^..=erg cm->joule cm->GeV cm->GeV fm       *
 226 *                it is equal to 0.00144 GeV fm                         *
 227 *         Fscto2 = (Fine structure constant)^2                         *
 228 *         Fscto3 = (Fine structure constant)^3                         *
 229 *         Fscto4 = (Fine structure constant)^4                         *
 230 *         Plabrc = Reduced Planck constant times the light velocity    *
 231 *                  expressed in GeV fm                                 *
 232 *         Rclsel = Classical electron radius (cm) = e^2 / (m_e c^2)    *
 233 *         Bltzmn = k Boltzmann constant in GeV K-1                     *
 234 *         A0bohr = Bohr radius, hbar^2 / ( m_e e^2) (fm) = Plabrc**2   *
 235 *                / Amelct / Cougfm, or equivalently,                   *
 236 *                Plabrc / Alpfsc / Amelct                              *
 237 *         Gfohb3 = Fermi constant, G_f/(hbar c)^3, in GeV^-2           *
 238 *         Gfermi = Fermi constant in GeV fm^3                          *
 239 *         Sin2tw = sin^2 theta_Weinberg                                *
 240 *         Prmgnm = proton  magnetic moment (magneton)                  *
 241 *         Anmgnm = neutron magnetic moment (magneton)                  *
 242 *                                                                      *
 243 *   Astronomical constants:                                            *
 244 *                                                                      *
 245 *         Rearth = Earth equatorial radius (cm)                        *
 246 *         Auastu = Astronomical Unit       (cm)                        *
 247 *                                                                      *
 248 *   Conversion constants:                                              *
 249 *                                                                      *
 250 *         GeVMeV = from GeV to MeV                                     *
 251 *         eMVGeV = from MeV to GeV                                     *
 252 *         alGVMV = from GeV to MeV, log                                *
 253 *         Raddeg = from radians to degrees                             *
 254 *         Degrad = from degrees to radians                             *
 255 *         GeVOmg = from (photon) energy [GeV] in 2pi x frequency [s^-1]*
 256 *                                                                      *
 257 *   Useful constants:                                                  *
 258 *                                                                      *
 259 *         Fertho = constant to be used in the Fermi-Thomas approxima-  *
 260 *                  ted expression for atomic binding energies          *
 261 *         Expebn = exponent to be used in the Fermi-Thomas approxima-  *
 262 *                  ted expression for atomic binding energies          *
 263 *                    B_atomic (Z) = Fertho x Z^Expebn (GeV)            *
 264 *         Bexc12 = Fermi-Thomas approximated expression for 12-C ato-  *
 265 *                  mic binding energies (GeV)                          *
 266 *         Amunmu = difference between the atomic and nuclear mass units*
 267 *         Amuc12 = "Nuclear" mass unit = 1/12 M_nucl (12-C),           *
 268 *                  M_nucl (12-C) = M_atom (12-C) - 6 m_e + B_atom(12-C)*
 269 *                                                                      *
 270 *----------------------------------------------------------------------*
 271 *
 272       PARAMETER ( CLIGHT = 2.99792458         D+10 )
 273       PARAMETER ( AVOGAD = 6.0221367          D+23 )
 274       PARAMETER ( BOLTZM = 1.380658           D-23 )
 275       PARAMETER ( AMELGR = 9.1093897          D-28 )
 276       PARAMETER ( PLCKBR = 1.05457266         D-27 )
 277       PARAMETER ( ELCCGS = 4.8032068          D-10 )
 278       PARAMETER ( ELCMKS = 1.60217733         D-19 )
 279       PARAMETER ( AMUGRM = 1.6605402          D-24 )
 280       PARAMETER ( AMMUMU = 0.113428913        D+00 )
 281       PARAMETER ( AMPRMU = 1.007276470        D+00 )
 282       PARAMETER ( AMNEMU = 1.008664904        D+00 )
 283 *     PARAMETER ( ALPFSC = 1.D+00 / 137.035989561D+00 )
 284 *     PARAMETER ( FSCTO2 = ALPFSC * ALPFSC )
 285 *     PARAMETER ( FSCTO3 = FSCTO2 * ALPFSC )
 286 *     PARAMETER ( FSCTO4 = FSCTO3 * ALPFSC )
 287 *    It is important to set the electron mass exactly with the same
 288 *    rounding as in the mass tables, so use the explicit expression
 289 *     PARAMETER ( AMELCT = 1.D-16 * AMELGR * CLIGHT * CLIGHT / ELCMKS )
 290 *    It is important to set the amu mass exactly with the same
 291 *    rounding as in the mass tables, so use the explicit expression
 292 *     PARAMETER ( AMUGEV = 1.D-16 * AMUGRM * CLIGHT * CLIGHT / ELCMKS )
 293 *    It is important to set the muon,proton,neutron masses exactly with
 294 *    the same rounding as in the mass tables, so use the explicit
 295 *    expression
 296 *     PARAMETER ( AMMUON = AMMUMU * AMUGEV )
 297 *     PARAMETER ( AMPRTN = AMPRMU * AMUGEV )
 298 *     PARAMETER ( AMNTRN = AMNEMU * AMUGEV )
 299 *     PARAMETER ( RCLSEL = ELCCGS * ELCCGS / CLIGHT / CLIGHT / AMELGR )
 300 *     PARAMETER ( BLTZMN = BOLTZM / ELCMKS * 1.D-09 )
 301       PARAMETER ( ALPFSC = 7.2973530791728595 D-03 )
 302       PARAMETER ( FSCTO2 = 5.3251361962113614 D-05 )
 303       PARAMETER ( FSCTO3 = 3.8859399018437826 D-07 )
 304       PARAMETER ( FSCTO4 = 2.8357075508200407 D-09 )
 305       PARAMETER ( PLABRC = 0.197327053        D+00 )
 306       PARAMETER ( AMELCT = 0.51099906         D-03 )
 307       PARAMETER ( AMUGEV = 0.93149432         D+00 )
 308       PARAMETER ( AMMUON = 0.105658389        D+00 )
 309       PARAMETER ( AMPRTN = 0.93827231         D+00 )
 310       PARAMETER ( AMNTRN = 0.93956563         D+00 )
 311       PARAMETER ( AMDEUT = 1.87561339         D+00 )
 312       PARAMETER ( AMALPH = 3.72738025692891   D+00 )
 313       PARAMETER ( COUGFM = ELCCGS * ELCCGS / ELCMKS * 1.D-07 * 1.D+13
 314      &                   * 1.D-09 )
 315       PARAMETER ( RCLSEL = 2.8179409183694872 D-13 )
 316       PARAMETER ( BLTZMN = 8.617385           D-14 )
 317       PARAMETER ( A0BOHR = PLABRC / ALPFSC / AMELCT )
 318       PARAMETER ( GFOHB3 = 1.16639            D-05 )
 319       PARAMETER ( GFERMI = GFOHB3 * PLABRC * PLABRC * PLABRC )
 320       PARAMETER ( SIN2TW = 0.2319             D+00 )
 321       PARAMETER ( PRMGNM = 2.792847386        D+00 )
 322       PARAMETER ( ANMGNM =-1.91304275         D+00 )
 323       PARAMETER ( REARTH = 6.378140           D+08 )
 324       PARAMETER ( AUASTU = 1.4959787066       D+13 )
 325       PARAMETER ( GEVMEV = 1.0                D+03 )
 326       PARAMETER ( EMVGEV = 1.0                D-03 )
 327       PARAMETER ( ALGVMV = 6.90775527898214   D+00 )
 328       PARAMETER ( RADDEG = 180.D+00 / PIPIPI )
 329       PARAMETER ( DEGRAD = PIPIPI / 180.D+00 )
 330       PARAMETER ( GEVOMG = CLIGHT * 1.D+13 / PLABRC )
 331 *  Old Fermi-Thomas parametrization of atomic binding energies:
 332 *     PARAMETER ( FERTHO = 15.73       D-09 )
 333 *     PARAMETER ( EXPEBN = 7.D+00 / 3.D+00  )
 334 *     PARAMETER ( BEXC12 = FERTHO * 65.41634134195703D+00 )
 335 *  New Fermi-Thomas parametrization of atomic binding energies:
 336       PARAMETER ( FERTHO = 14.33       D-09 )
 337       PARAMETER ( EXPEBN = 2.39        D+00 )
 338       PARAMETER ( BEXC12 = FERTHO * 72.40715579499394D+00 )
 339       PARAMETER ( AMUNMU = HLFHLF * AMELCT - BEXC12 / 12.D+00 )
 340       PARAMETER ( AMUC12 = AMUGEV - AMUNMU )
 341 *
 342       LOGICAL LFLUKA, LGBIAS, LGBANA, LFLGEO, LOFLTS, LUSRIN
 343       COMMON / GLOBAL / LFLUKA, LGBIAS, LGBANA, LFLGEO, LOFLTS,
 344      &                  LUSRIN, KFLGEO, KFLDNR
 345