+++ /dev/null
-*======================================================================*
-* Routines to open and close a given file with a given FORTRAN unit *
-* from the C++ world *
-*======================================================================*
-*
-*=== FLUKA_OPENINP ====================================================*
-*
- SUBROUTINE FLUKA_OPENINP(IOUNIT,FILNAM)
-*
-*----------------------------------------------------------------------*
-* Opens a file with a given unit number
-*
-*
-* IOUNIT: Input unit to be assiged to the file
-* FILNAM: Name of the file
-*
-*----------------------------------------------------------------------*
-*
-
- IMPLICIT NONE
- INTEGER IOUNIT
- CHARACTER*(*) FILNAM
-
- OPEN (UNIT=IOUNIT, FILE=FILNAM, STATUS="OLD")
- RETURN
- 9999 END
-
- SUBROUTINE FLUKA_OPENOUT(IOUNIT,FILNAM)
-*
-*----------------------------------------------------------------------*
-* Opens a file with a given unit number
-*
-*
-* IOUNIT: Input unit to be assiged to the file
-* FILNAM: Name of the file
-*
-*----------------------------------------------------------------------*
-*
-
- IMPLICIT NONE
- INTEGER IOUNIT
- CHARACTER*(*) FILNAM
-
- OPEN (UNIT=IOUNIT, FILE=FILNAM, STATUS="UNKNOWN")
-
- RETURN
- 9999 END
-
-
-*
-*=== FLUKA_CLOSEINP ====================================================*
-*
- SUBROUTINE FLUKA_CLOSEINP(IOUNIT)
-*
-*----------------------------------------------------------------------*
-* Closes the given unit number
-*
-*
-* IOUNIT: Input unit to be assiged to the file
-*
-*----------------------------------------------------------------------*
-*
- IMPLICIT NONE
- INTEGER IOUNIT
-
-
- CLOSE (UNIT=IOUNIT)
-
- RETURN
- 9999 END
+++ /dev/null
-#ifndef FALLDLT_H
-#define FALLDLT_H
-
-#include "cfortran.h"
-#include "Rtypes.h"
-extern "C" {
-//*$ CREATE ALLDLT.ADD
-//*COPY ALLDLT
-//*
-//*=== Alldlt ===========================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* Copyright (C) 2005-2006 by Alfredo Ferrari *
-//* All Rights Reserved. *
-//* *
-//* *
-//* Include file: alldlt (ALL DeLTas) vv *
-//* *
-//* Created on 10 october 2005 by Alfredo Ferrari *
-//* INFN - Milan *
-//* *
-//* Last change on 19-feb-06 by Alfredo Ferrari *
-//* *
-//* Included in the following routines: *
-//* *
-//* blockmvax/bdtrns.f *
-//* dedxmvax/dedxfl.f *
-//* dedxmvax/enion.f *
-//* dedxmvax/enionf.f *
-//* emfmvax/ededxf.f *
-//* emfmvax/emenio.f *
-//* emfmvax/emfsco.f *
-//* emfmvax/pdedxf.f *
-//* kaskadmvax/kaskad.f *
-//* *
-//* Talldl (m) = kinetic energy of the m_th primary electron *
-//* emitted during energy loss fluctuation pro- *
-//* cesses *
-//* Tallmn = minimum energy of the recorded primary *
-//* electrons
-//* X/Y/Zalldl (m) = position coord. of the m_th primary electron *
-//* emitted during energy loss fluctuation pro- *
-//* cesses *
-//*
-//* Nalldl = number of recorded primary electrons *
-//* Lalldl = logical flag for primary electrons recording *
-//* *
-//*----------------------------------------------------------------------*
-//*
-// PARAMETER ( MXALLD = 5000 )
-//*
-// LOGICAL LALLDL
-// COMMON / ALLDLT / TALLDL (MXALLD), XALLDL (MXALLD),
-// & YALLDL (MXALLD), ZALLDL (MXALLD),
-// & TALLMN, NALLDL, LALLDL
-// SAVE / ALLDLT /
-
- const Int_t mxalld = 5000;
- typedef struct {
- Double_t talldl[mxalld];
- Double_t xalldl[mxalld];
- Double_t yalldl[mxalld];
- Double_t zalldl[mxalld];
- Double_t tallmn;
- Int_t nalldl;
- Int_t lalldl;
- } alldltCommon;
-#define ALLDLT COMMON_BLOCK(ALLDLT,alldlt)
- COMMON_BLOCK_DEF(alldltCommon,ALLDLT);
-}
-
-#endif
+++ /dev/null
-#ifndef FBEAMCM_H
-#define FBEAMCM_H 1
-
-#include "cfortran.h"
-#include "Rtypes.h"
-extern "C" {
-
-//*=== beam =============================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* CoMmon for BEAM properties: *
-//* *
-//* Pbeam = average beam particle momentum (GeV/c) *
-//* Pbmmax = maximum momentum for which tabulations must be *
-//* generated (GeV/c) *
-//* Dpbeam = beam momentum spread (GeV/c) *
-//* Divbm = beam angular divergense (mrad) *
-//* Xspot = beam width in (beam frame) x-direction (cm) *
-//* Yspot = beam width in (beam frame) y-direction (cm) *
-//* Xbeam = beam spot centre (geom frame) x-coordinate (cm) *
-//* Ybeam = beam spot centre (geom frame) y-coordinate (cm) *
-//* Zbeam = beam spot centre (geom frame) z-coordinate (cm) *
-//* Ubeam = beam direction cosine wrt the (beam frame) x-axis *
-//* Vbeam = beam direction cosine wrt the (beam frame) y-axis *
-//* Wbeam = beam direction cosine wrt the (beam frame) z-axis *
-//* Ubmpol = beam polarization cosine wrt the (beam frame) x-axis *
-//* Vbmpol = beam polarization cosine wrt the (beam frame) y-axis *
-//* Wbmpol = beam polarization cosine wrt the (beam frame) z-axis *
-//* Polfra = polarization fraction *
-//* Rflood = emission radius for a uniform and isotropic source *
-//* or maximum radius for a cylindrical/spherical volume *
-//* source *
-//* Rvlmax = emission radius for a uniform and isotropic source *
-//* or maximum radius for a cylindrical/spherical volume *
-//* source *
-//* Rvlmin = minimum radius for a cylindrical/spherical volume *
-//* source *
-//* Dxvlmx = maximum Dx for a cartesian volume source *
-//* (particle emitted inside [Xina+Dxvlmn/2,Xina+Dxvlmx/2]*
-//* and inside [Xina-Dxvlmx/2, Xina-Dxvlmn/2]) *
-//* Dxvlmn = minimum Dx for a cartesian volume source *
-//* Dyvlmx = maximum Dy for a cartesian volume source *
-//* (particle emitted inside [Yina+Dyvlmn/2,Yina+Dyvlmx/2]*
-//* and inside [Yina-Dyvlmx/2, Yina-Dyvlmn/2]) *
-//* Dyvlmn = minimum Dy for a cartesian volume source *
-//* Dzvlmx = maximum Dz for a cartesian/cylindrical volume source *
-//* (particle emitted inside [Zina+Dzvlmn/2,Zina+Dzvlmx/2]*
-//* and inside [Zina-Dzvlmx/2, Zina-Dzvlmn/2]) *
-//* Dzvlmn = minimum Dz for a cartesian/cylindrical volume source *
-//* Ijbeam = beam particle type (see btype in /paprop/) *
-//* Ijhion = heavy ion type if ijbeam = -2 *
-//* Ldpgss = true for a gaussian momentum distribution of the *
-//* beam particles, false for a rectangular one *
-//* Ldvgss = true for a gaussian angular divergence distribution *
-//* of the beam particles, false for a rectangular one *
-//* Ldxgss = true for a gaussian spatial distribution of the beam *
-//* spot in the x-direction, false for a rectangular one *
-//* Ldygss = true for a gaussian spatial distribution of the beam *
-//* spot in the y-direction, false for a rectangular one *
-//* 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 *
-//* Bmaxis(j,i) = j_th component of the i_th axis used to define the *
-//* conventional x,y,z beam reference frame *
-//*!!!!! ATTENTION: in C++ it is the component bmaxis(i,j) !!!!! *
-//* Lbaxis = logical flag for using a beam axis frame different *
-//* from the standard one *
-//* Lflood = logical flag for using a uniform and isotropic beam *
-//* source out of a sphere of radius Rflood *
-//* Lvlcar = logical flag for using a cartesian volume source *
-//* Lvlcyl = logical flag for using a cylindrical volume source *
-//* Lvlsph = logical flag for using a spherical volume source *
-//* Lsourc = logical flag for a user written source routine *
-//* Lrdbea = logical flag for a radioactive isotope beam * 2006.3
-//* *
-//*----------------------------------------------------------------------*
-
-typedef struct {
- Double_t pbeam;
- Double_t dpbeam;
- Double_t pbmmax;
- Double_t divbm;
- Double_t xspot;
- Double_t yspot;
- Double_t xbeam;
- Double_t ybeam;
- Double_t zbeam;
- Double_t ubeam;
- Double_t vbeam;
- Double_t wbeam;
- Double_t ubmpol;
- Double_t vbmpol;
- Double_t wbmpol;
- Double_t polfra;
- Double_t beawei;
- Double_t bmaxis[3][3];
- Double_t rvlmin;
- Double_t rvlmax;
- Double_t dxvlmn;
- Double_t dxvlmx;
- Double_t dyvlmn;
- Double_t dyvlmx;
- Double_t dzvlmn;
- Double_t dzvlmx;
- Int_t ijbeam;
- Int_t ijhion;
- Int_t ldpgss;
- Int_t ldvgss;
- Int_t ldxgss;
- Int_t ldygss;
- Int_t lbeamc;
- Int_t lpperp;
- Int_t lpfrac;
- Int_t lbaxis;
- Int_t lflood;
- Int_t lvlcar;
- Int_t lvlcyl;
- Int_t lvlsph;
- Int_t lsourc;
- Int_t lrdbea; // 2006.3
-} beamcmCommon;
-#define BEAMCM COMMON_BLOCK(BEAMCM,beamcm)
-COMMON_BLOCK_DEF(beamcmCommon,BEAMCM);
-}
-
-#endif
+++ /dev/null
-#ifndef FDBLPRC_H
-#define FDBLPRC_H 1
-
-#include "Rtypes.h"
-#include "cfortran.h"
-extern "C" {
-//*$ 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 *
-//* kalch8 = character*8 address alignment wrt the precision *
-//* defined by kalgnm (mostly 1 in all situations) *
-//* i2algn = integer*2 address alignment wrt the normal integer *
-//* precision (mostly 2, 4 for 64 bit integers) *
-//* 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 once *
-//* lnmgeo = set to true for a name-base geometry input *
-//* lnminp = set to true for a name-base fluka input *
-//* Lfrfmt = set to true for a free-format based Fluka input *
-//* lfdrtr = set to true for going in/out feeder/flukam at each *
-//* event *
-//* *
-//*---------------------------------------------------------------------*
-//* *
-const Int_t kalgnm = 2;
-const Int_t kalch8 = 1;
-const Int_t i2algn = 2;
-const Double_t anglgb = 5.0e-16;
-const Double_t anglsq = 2.5e-31;
-const Double_t axcssv = 0.2e+16;
-const Double_t andrfl = 1.0e-38;
-const Double_t avrflw = 1.0e+38;
-const Double_t ainfnt = 1.0e+30;
-const Double_t azrzrz = 1.0e-30;
-const Double_t einfnt = +69.07755278982137e+00;
-const Double_t ezrzrz = -69.07755278982137e+00;
-const Double_t excssv = +35.23192357547063e+00;
-const Double_t englgb = -35.23192357547063e+00;
-const Double_t onemns = 0.999999999999999e+00;
-const Double_t onepls = 1.000000000000001e+00;
-const Double_t csnnrm = 2.0e-15;
-const Double_t dmxtrn = 1.0e+08;
-const Double_t rhflmn = 1.0e-10;
-//*
-//*======================================================================*
-//*======================================================================*
-//*========= ==========*
-//*========= 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 *
-//* two2o3 = 2^2/3 *
-//* 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 *
-//* s2fwhm = 2 x square root of 2 x logarithm of 2 *
-//* *
-//*----------------------------------------------------------------------*
-//*
- const Float_t zersng = 0.e+00;
- const Double_t zerzer = 0.e+00;
- const Double_t oneone = 1.e+00;
- const Double_t twotwo = 2.e+00;
- const Double_t thrthr = 3.e+00;
- const Double_t foufou = 4.e+00;
- const Double_t fivfiv = 5.e+00;
- const Double_t sixsix = 6.e+00;
- const Double_t sevsev = 7.e+00;
- const Double_t eigeig = 8.e+00;
- const Double_t aninen = 9.e+00;
- const Double_t tenten = 10.e+00;
- const Double_t eleven = 11.e+00;
- const Double_t twelve = 12.e+00;
- const Double_t fiften = 15.e+00;
- const Double_t sixten = 16.e+00;
- const Double_t hlfhlf = 0.5e+00;
- const Double_t onethi = oneone/thrthr;
- const Double_t onefou = oneone/foufou;
- const Double_t onefiv = oneone/fivfiv;
- const Double_t onesix = oneone/sixsix;
- const Double_t onesev = oneone/sevsev;
- const Double_t oneeig = oneone/eigeig;
- const Double_t twothi = twotwo/thrthr;
- const Double_t thrfou = thrthr/foufou;
- const Double_t thrtwo = thrthr/twotwo;
- const Double_t fouthr = foufou/thrthr;
- const Double_t pipipi = 3.141592653589793238462643383279e+00;
- const Double_t two2o3 = 1.587401051968199e+00; // 2006.3
- const Double_t twopip = 6.283185307179586476925286766559e+00;
- const Double_t pip5o2 = 7.853981633974483096156608458199e+00;
- const Double_t pipisq = 9.869604401089358618834490999876e+00;
- const Double_t pihalf = 1.570796326794896619231321691640e+00;
- const Double_t erfa00 = 0.886226925452758013649083741671e+00;
- const Double_t sqrtpi = 1.772453850905516027298167483341e+00;
- const Double_t sqtwpi = 2.506628274631000502415765284811e+00;
- const Double_t eulero = 0.577215664901532860606512e+00;
- const Double_t eulexp = 1.781072417990197985236504e+00;
- const Double_t eullog = -0.5495393129816448223376619e+00;
- const Double_t e1m2eu = 0.8569023337737540831433017e+00;
- const Double_t eneper = 2.718281828459045235360287471353e+00;
- const Double_t sqrent = 1.648721270700128146848650787814e+00;
- const Double_t sqrtwo = 1.414213562373095048801688724210e+00;
- const Double_t sqrthr = 1.732050807568877293527446341506e+00;
- const Double_t sqrfiv = 2.236067977499789696409173668731e+00;
- const Double_t sqrsix = 2.449489742783178098197284074706e+00;
- const Double_t sqrsev = 2.645751311064590590501615753639e+00;
- const Double_t sqrt12 = 3.464101615137754587054892683012e+00;
- const Double_t s2fwhm = 2.354820045030949e+00;
- const Double_t twolog = 0.693147180559945309417232121458e+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) *
-//* epsil0 = vacuum dielectric constant (MKS unit) *
-//* amugrm = atomic mass unit (g) *
-//* ammumu = muon mass (amu) *
-//* amprmu = proton mass (amu) *
-//* amnemu = neutron mass (amu) *
-//* * //* Note: *
-//* e[MKS]^2/ (4 pi epsilon0 hbar[MKS] c[MKS]) = alpha = 1/137 *
-//* e[CGS]^2/ (hbar[CGS] c[CGS]) = alpha = 1/137 *
-//* with c[MKs] = 10^-2 c[CGS], hbar[MKS] = 10^-7 hbar[CGS] *
-//* 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) *
-//* s0thms = sigma_0 Thomson, 8/3 pi r_e^2 (mb) *
-//* *
-//* astronomical constants: *
-//* *
-//* rearth = earth equatorial radius (cm) *
-//* auastu = astronomical unit (cm) *
-//* *
-//* conversion constants: *
-//* *
-//* gevmev = from gev to mev *
-//* emvgev = from mev to gev *
-//* gev2ev = from gev to ev *
-//* ev2gev = from ev 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]*
-//* cmq2mb = from square centimetres to millibarns *
-//* *
-//* 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)*
-//* *
-//*----------------------------------------------------------------------*
-//*
- const Double_t clight = 2.99792458e+10;
- const Double_t avogad = 6.0221367e+23;
- const Double_t boltzm = 1.380658e-23;
- const Double_t amelgr = 9.1093897e-28;
- const Double_t plckbr = 1.05457266e-27;
- const Double_t elccgs = 4.8032068e-10;
- const Double_t elcmks = 1.60217733e-19;
- const Double_t epsil0 = 8.854187817e-12; // 2006.3
- const Double_t amugrm = 1.6605402e-24;
- const Double_t ammumu = 0.113428913e+00;
- const Double_t amprmu = 1.007276470e+00;
- const Double_t amnemu = 1.008664904e+00;
-//* const Double_t alpfsc = 1.e+00 / 137.035989561e+00
-//* const Double_t fscto2 = alpfsc * alpfsc
-//* const Double_t fscto3 = fscto2 * alpfsc
-//* const Double_t 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
-//* const Double_t amelct = 1.e-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
-//* const Double_t amugev = 1.e-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
-//* const Double_t ammuon = ammumu * amugev
-//* const Double_t amprtn = amprmu * amugev
-//* const Double_t amntrn = amnemu * amugev
-//* const Double_t rclsel = elccgs * elccgs / clight / clight / amelgr
-//* const Double_t bltzmn = boltzm / elcmks * 1.e-09
-const Double_t alpfsc = 7.2973530791728595e-3;
-const Double_t fscto2 = 5.3251361962113614e-5;
-const Double_t fscto3 = 3.8859399018437826e-7;
-const Double_t fscto4 = 2.8357075508200407e-9;
-const Double_t plabrc = 0.197327053e+00;
-const Double_t amelct = 0.51099906e-3;
-const Double_t amugev = 0.93149432e+00;
-const Double_t ammuon = 0.105658389e+00;
-const Double_t amprtn = 0.93827231e+00;
-const Double_t amntrn = 0.93956563e+00;
-const Double_t amdeut = 1.87561339e+00;
-const Double_t amalph = 3.72738025692891e+00;
-const Double_t cougfm = elccgs*elccgs/elcmks*(1.e-7)*(1.e+13)*(1.e-9);
-const Double_t rclsel = 2.8179409183694872e-13;
-const Double_t alamb0 = twotwo * pipipi * rclsel / alpfsc;
-const Double_t bltzmn = 8.617385e-14;
-const Double_t a0bohr = plabrc/alpfsc/amelct;
-const Double_t gfohb3 = 1.16639e-5;
-const Double_t gfermi = gfohb3*plabrc*plabrc*plabrc;
-const Double_t sin2tw = 0.2319e+00;
-const Double_t prmgnm = 2.792847386e+00;
-const Double_t anmgnm = -1.91304275e+00;
-const Double_t rearth = 6.378140e+8;
-const Double_t auastu = 1.4959787066e+13;
-const Double_t gevmev = 1.0e+3;
-const Double_t ev2gev = 1.0e-9;
-const Double_t gev2ev = 1.0e+9;
-const Double_t emvgev = 1.0e-3;
-const Double_t cmq2mb = 1.0e+27;
-const Double_t fmb2ba = 1.0e-3;
-const Double_t bar2mb = 1.0e+3;
-const Double_t fmb2fs = 1.0e-1;
-const Double_t fms2mb = 1.0e+1;
-const Double_t algvmv = 6.90775527898214e+00;
-const Double_t raddeg = (180.e+00)/pipipi;
-const Double_t degrad = pipipi/(180.e+00);
-const Double_t gevomg = clight*(1.e+13)/plabrc;
-const Double_t s0thms = eigeig / thrthr * pipipi * rclsel * rclsel * cmq2mb;
-//* old Fermi-Thomas parametrization of atomic binding energies:
-//* const Double_t fertho = 15.73 e-9
-//* const Double_t expebn = 7.e+00 / 3.e+00
-//* const Double_t bexc12 = fertho * 65.41634134195703e+00
-//* new Fermi-Thomas parametrization of atomic binding energies:
-const Double_t fertho = 14.33e-9;
-const Double_t expebn = 2.39e+00;
-const Double_t bexc12 = fertho*72.40715579499394e+00;
-const Double_t amunmu = hlfhlf*amelct-bexc12/12.e+00;
-const Double_t amuc12 = amugev-amunmu;
-//* Old MeV units:
-const Double_t amemev = gevmev * amelct;
-//*
-
-typedef struct {
- Int_t lfluka;
- Int_t lgbias;
- Int_t lgbana;
- Int_t lflgeo;
- Int_t loflts;
- Int_t lusrin;
- Int_t lusrgl; // 2006.3
- Int_t lnmgeo;
- Int_t lnminp;
- Int_t lfrfmt;
- Int_t lfdrtr;
- Int_t kflgeo;
- Int_t kfldnr;
-} globalCommon;
-#define GLOBAL COMMON_BLOCK(GLOBAL,global)
-COMMON_BLOCK_DEF(globalCommon,GLOBAL);
-}
-
-#endif
+++ /dev/null
-#ifndef FDIMPAR_H
-#define FDIMPAR_H
-
-#include "cfortran.h"
-#include "Rtypes.h"
-extern "C" {
-//*----------------------------------------------------------------------*
-//* *
-//* DIMPAR: included in any routine *
-//* *
-//* Mxxrgn = maximum number of regions *
-//* Mxxmdf = maximum number of media in Fluka *
-//* Mxxmde = maximum number of media in Emf *
-//* Mfstck = stack dimension in Fluka *
-//* Mestck = stack dimension in Emf *
-//* Mostck = stack dimension for optical photons *
-//* Mxprsn = secondary stack dimension for resonance generator *
-//* Mxpdpm = secondary stack dimension for DPM generators *
-//* Mxpscs = secondary stack dimension overall *
-//* Mxoutu = maximum number of output units *
-//* Nallwp = number of allowed particles *
-//* Nelemx = number of maximum allowed elements of a compound *
-//* or mixture *
-//* Mpdpdx = number of particle types for which EM dE/dx pro- *
-//* cesses (ion,pair,bremss) have to be computed *
-//* Mxhttr = maximum number of (hit) target nucleons for a *
-//* given collision generation *
-//* Icomax = maximum number of materials for compounds/mixtures *
-//* (equal to the sum of the number of materials for *
-//* every compound/mixture) *
-//* Ichmax = maximum number of harmonic oscillator levels for *
-//* compounds/mixtures (equal to the sum of the number *
-//* of harmonic oscillator levels for every compound *
-//* /mixture) *
-//* Nstbis = number of stable isotopes recorded in common iso- *
-//* top *
-//* Nqstis = number of "quasi" stable isotopes which are not *
-//* in the standard isotopic composition of a given *
-//* element, but for which special data (like GDR data)*
-//* are anyway available *
-//* Ntstis = total number of stable ans "quasi" stable isotopes *
-//* Mxpabl = number of resonances inside Hadrin common blocks *
-//* Idmaxp = number of particles/resonances defined in common *
-//* part *
-//* Idmxdc = number of particles/resonances decay channels *
-//* defined in common decayc *
-//* Ihypmx = maximum number of hyperons in a hypernucleus *
-//* Mkbmx1 = dimension for KWB real spare array in Fluka Stack *
-//* Mkbmx2 = dimension for KWB int. spare array in Fluka Stack *
-//* Mxirrd = maximum number of irradiation sub-intervals *
-//* Mxtrdc = maximum number of decay (cooling) times *
-//* Nktl = overall dimension parameter for EMF bremsstrahlung *
-//* *
-//*----------------------------------------------------------------------*
-
- const Int_t mxxrgn = 20000;
-// const Int_t mxxmdf = 510;
-// const Int_t mxxmde = 502;
- const Int_t mxxmdf = 710; // 2006.3
- const Int_t mxxmde = 702; // 2006.3
- const Int_t mfstck = 6500;
- const Int_t mestck = 100;
- const Int_t mostck = 2000;
- const Int_t mxprsn = 100;
- const Int_t mxpdpm = 800;
- const Int_t mxpscs = 4999;
- const Int_t mxoutu = 50;
- const Int_t nallwp = 64;
- const Int_t nelemx = 80;
- const Int_t mpdpdx = 18;
- const Int_t mxhttr = 260;
- const Int_t mxseax = 20; // 2006.3
- const Int_t mxhtnc = mxseax + 1; // 2006.3
-// const Int_t icomax = 1000;
- const Int_t icomax = 2400; // 2006.3
- const Int_t ichmax = icomax+mxxmdf;
- const Int_t nstbis = 304;
- const Int_t nqstis = 46;
- const Int_t ntstis = nstbis + nqstis;
-
-//* till 3-aug-99:
-//* const Int_t mxpabl = 110;
- const Int_t mxpabl = 120;
- const Int_t idmaxp = 450;
- const Int_t idmxdc = 2000;
- const Int_t mxmcin = 410;
- const Int_t ihypmx = 4;
-//* till 19-jul-2000:
-//* const Int_t mkbmx1 = 9;
-//* const Int_t mkbmx2 = 3;
- const Int_t mkbmx1 = 11;
- const Int_t mkbmx2 = 11;
- const Int_t mxirrd = 500;
- const Int_t mxtrdc = 500;
- const Int_t nktl = 17;
-}
-
-#endif
+++ /dev/null
-#include "cfortran.h"
-#include "Rtypes.h"
-
-#include "Fdimpar.h"
-
-extern "C" {
-/*$ CREATE DPDXCM.ADD
-*COPY DPDXCM
-*
-*=== dpdxcm ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Copyright (C) 1989-2006 by Alfredo Ferrari *
-* All Rights Reserved. *
-* *
-* *
-* Include file: dpdxcm (DP/DX CoMmon) *
-* *
-* Created on 10 february 1991 by Alfredo Ferrari *
-* INFN - Milan *
-* *
-* Last change on 21-may-06 by Alfredo Ferrari *
-* *
-* Included in the following routines: *
-* *
-* blockmvax/bdtrns.f *
-* dedxmvax/dedsdv.f *
-* dedxmvax/dedx.f *
-* dedxmvax/dedxfl.f *
-* dedxmvax/deltad.f *
-* dedxmvax/deltar.f *
-* dedxmvax/deltas.f *
-* dedxmvax/delthr.f *
-* dedxmvax/delths.f *
-* dedxmvax/dpdx.f *
-* dedxmvax/dpdxio.f *
-* dedxmvax/enion.f *
-* dedxmvax/enionf.f *
-* dedxmvax/gdedxc.f *
-* dedxmvax/heabre.f *
-* dedxmvax/hosufl.f *
-* dedxmvax/hvbrem.f *
-* dedxmvax/hvpair.f *
-* dedxmvax/t0zffc.f *
-* elsmvax/sigtab.f *
-* emfmvax/ededxf.f *
-* emfmvax/emfin.f *
-* emfmvax/emfret.f *
-* emfmvax/emfsco.f *
-* emfmvax/emfstp.f *
-* emfmvax/pdedxf.f *
-* kaskadmvax/hmsnsc.f *
-* kaskadmvax/kashea.f *
-* kaskadmvax/kaskad.f *
-* kaskadmvax/mulhad.f *
-* kaskadmvax/omegah.f *
-* kaskadmvax/sgttot.f *
-* kaskadmvax/stepop.f *
-* mainmvax/deflts.f *
-* mainmvax/dltcrd.f *
-* mainmvax/matcrd.f *
-* mainmvax/zeroin.f *
-* *
-* Avionp (m) = average ionization potential (eV) of medium m *
-* Ccster (m) = Sternheimer cbar parameter for medium m *
-* X0ster (m) = Sternheimer x0 parameter for medium m *
-* Xester (m) = Sternheimer x1 parameter for medium m *
-* Amster (m) = Sternheimer m parameter for medium m *
-* Aaster (m) = Sternheimer a parameter for medium m *
-* D0ster (m) = Sternheimer delta0 parameter for medium m *
-* Aviont (m) = auxiliary ionization potential of medium m *
-* T0dpdx (m) = delta ray production threshold of medium m *
-* (all particle but e+/e-) *
-* Tedpdx (m) = delta ray production threshold of medium m *
-* (electrons and positrons) *
-* Gaspfl (m) = pressure (atm) if a gas *
-* Pthrmx = maximum momentum of the tabulations *
-* Anpicm (m) = average number of primary ionization per cm *
-* for a mip for medium m (at NTP for a gas) *
-* Frstip (m) = first ionization potential for medium m (GeV) *
-* Faltmt (m) = density modifying factor for a possible alt- *
-* ernate material for medium m *
-* Maltmt (m) = alternate material for medium m *
-* Msdpdx (m) = possible "special material" flag for medium m *
-* 0: no special treatment *
-* 1: implicit delta production down to Avionr *
-* inside ..dedxf.. routines with recording *
-* of the selected values activated *
-*----------------------------------------------------------------------*
-*
- PARAMETER ( MNDPDX = 50 )
- PARAMETER ( RMDPDX = 1.15D+00 )
- PARAMETER ( DPDXR1 = 0.15D+00 )
- PARAMETER ( DPDXR2 = 0.70D+00 )
- PARAMETER ( ERDEDX = 0.15D+00 * 0.15D+00 )
- PARAMETER ( MDPDXH = 4 )
-* Toln10 = 2 x log (10)
- PARAMETER ( TOLN10 = 4.605170185988091 D+00 )
-*
- LOGICAL LDELTA, LPDETB, LETFUN
- COMMON / DPDXCM / P0DPDX (MPDPDX,MXXMDF), P1DPDX (MPDPDX,MXXMDF),
- & TMDPDX (MXXMDF), T0DPDX (MXXMDF),
- & TEDPDX (MXXMDF), D0DPDX (MXXMDF),
- & AVIONP (MXXMDF), RHORFL (MXXMDF),
- & GASPFL (MXXMDF), CCSTER (MXXMDF),
- & AMSTER (MXXMDF), XOSTER (MXXMDF),
- & XESTER (MXXMDF), AASTER (MXXMDF),
- & D0STER (MXXMDF), AVIONT (MXXMDF),
- & ETDPDX (MXXMDF), ALMASS (MPDPDX), PTHRMX,
- & FRSTIP (MXXMDF), ANPICM (MXXMDF),
- & FALTMT (MXXMDF), MALTMT (MXXMDF),
- & MSDPDX (MXXMDF), NBDPDX (MXXMDF),
- & KDPDXT (MPDPDX,MXXMDF),
- & LDELTA (MXXMDF), LPDETB (MXXMDF),
- & IJDPDX (-6:NALLWP), LETFUN
- SAVE / DPDXCM /
-*/
-
- const Int_t mndpdx = 50;
- const Double_t rmdpdx = 1.15e0;
- const Double_t dpdxr1 = 0.15e0;
- const Double_t dpdxr2 = 0.70e0;
- const Double_t erdedx = 0.15e0 * 0.15e0;
- const Int_t mdpdxh = 4;
-
- typedef struct {
- Double_t p0dpdx [mxxmdf][mpdpdx];
- Double_t p1dpdx [mxxmdf][mpdpdx];
- Double_t tmdpdx [mxxmdf];
- Double_t t0dpdx [mxxmdf];
- Double_t tedpdx [mxxmdf];
- Double_t d0dpdx [mxxmdf];
- Double_t avionp [mxxmdf];
- Double_t rhorfl [mxxmdf];
- Double_t gaspfl [mxxmdf];
- Double_t ccster [mxxmdf];
- Double_t amster [mxxmdf];
- Double_t xoster [mxxmdf];
- Double_t xester [mxxmdf];
- Double_t aaster [mxxmdf];
- Double_t d0ster [mxxmdf];
- Double_t aviont [mxxmdf];
- Double_t etdpdx [mxxmdf];
- Double_t almass [mpdpdx];
- Double_t pthrmx;
- Double_t frstip [mxxmdf];
- Double_t anpicm [mxxmdf];
- Double_t faltmt [mxxmdf];
- Int_t maltmt [mxxmdf];
- Int_t msdpdx [mxxmdf];
- Int_t nbdpdx [mxxmdf];
- Int_t kdpdxt [mxxmdf][mpdpdx];
- Int_t ldelta [mxxmdf];
- Int_t lpdetb [mxxmdf];
- Int_t ijdpdx [nallwp + 7];
- Int_t letfun;
- } dpdxcmCommon;
-#define DPDXCM COMMON_BLOCK(DPDXCM,dpdxcm)
-COMMON_BLOCK_DEF(dpdxcmCommon, DPDXCM);
-}
+++ /dev/null
-#include "Rtypes.h"
-//
-// Structure saving parameters of Fluka procedures
-// mgdraw(Int_t& icode, Int_t& mreg)
-// bxdraw(Int_t& icode, Int_t& mreg, Int_t& newreg,
-// Double_t& xsco, Double_t& ysco, Double_t& zsco)
-// eedraw(Int_t& icode)
-// endraw(Int_t& icode, Int_t& mreg,
-// Double_t& rull, Double_t& xsco, Double_t& ysco, Double_t& zsco)
-// sogdraw
-// usdraw(Int_t& icode, Int_t& mreg,
-// Double_t& xsco, Double_t& ysco, Double_t& zsco)
-//
-//*---------------------- icode values ----------------------------------*
-//* *
-//* Icode = 1: call from Kaskad *
-//* Icode = 2: call from Emfsco *
-//* Icode = 3: call from Kasneu *
-//* Icode = 4: call from Kashea *
-//* Icode = 5: call from Kasoph *
-//* *
-//* Boundary- (X) crossing *
-//* ====================== *
-//* Icode = 1x: call from Kaskad *
-//* Icode = 19: boundary crossing *
-//* Icode = 2x: call from Emfsco *
-//* Icode = 29: boundary crossing *
-//* Icode = 3x: call from Kasneu *
-//* Icode = 39: boundary crossing *
-//* Icode = 4x: call from Kashea *
-//* Icode = 49: boundary crossing *
-//* Icode = 59: call from Kasoph *
-//* Icode = 59: boundary crossing *
-//* *
-//* ENergy deposition DRAWing: *
-//* ========================= *
-//* *
-//* Icode = 1x: call from Kaskad *
-//* 10: elastic interaction recoil *
-//* 11: inelastic interaction recoil *
-//* 12: stopping particle *
-//* 13: pseudo-neutron deposition *
-//* 14: escape *
-//* 15: time kill *
-//* Icode = 2x: call from Emfsco *
-//* 20: local energy deposition (i.e. photoelectric) *
-//* 21: below threshold, iarg=1 *
-//* 22: below threshold, iarg=2 *
-//* 23: escape *
-//* 24: time kill *
-//* Icode = 3x: call from Kasneu *
-//* 30: target recoil *
-//* 31: below threshold *
-//* 32: escape *
-//* 33: time kill *
-//* Icode = 4x: call from Kashea *
-//* 40: escape *
-//* 41: time kill *
-//* Icode = 5x: call from Kasoph *
-//* 50: optical photon absorption *
-//* 51: escape *
-//* 52: time kill *
-//* *
-//* USer dependent DRAWing: *
-//* ====================== *
-//* *
-//* Icode = 10x: call from Kaskad *
-//* 100: elastic interaction secondaries *
-//* 101: inelastic interaction secondaries *
-//* 102: particle decay secondaries *
-//* 103: delta ray generation secondaries *
-//* 104: pair production secondaries *
-//* 105: bremsstrahlung secondaries *
-//* Icode = 20x: call from Emfsco *
-//* 208: bremsstrahlung secondaries *
-//* 210: Moller secondaries *
-//* 212: Bhabha secondaries *
-//* 214: in-flight annihilation secondaries *
-//* 215: annihilation at rest secondaries *
-//* 217: pair production secondaries *
-//* 219: Compton scattering secondaries *
-//* 221: photoelectric secondaries *
-//* 225: Rayleigh scattering secondaries *
-//* Icode = 30x: call from Kasneu *
-//* 300: interaction secondaries *
-//* Icode = 40x: call from Kashea *
-//* 400: delta ray generation secondaries *
-//* For all interactions secondaries are put on FINUC common (kp=1,np)
-//* but for KASHEA delta ray generation where only the secondary *
-//* electron is present and stacked on STACK common for kp=lstack *
-//* *
-//*---------------------- end of icode values ---------------------------*
-//
-
-typedef struct {
- Int_t icode;
- Int_t mreg;
- Int_t newreg;
- Double_t rull;
- Double_t xsco;
- Double_t ysco;
- Double_t zsco;
-} Fdrawcalls;
-
+++ /dev/null
-#ifndef FEMFRGN_H
-#define FEMFRGN_H 1
-
-#include "cfortran.h"
-#include "Rtypes.h"
-extern "C" {
- //*$ CREATE EMFRGN.ADD
- //*COPY EMFRGN
- //*
- //*----------------------------------------------------------------------*
- //* *
- //* Common Emfrgn for EMF *
- //* *
- //*----------------------------------------------------------------------*
- //*
- // COMMON / EMFRGN / ELETHR (MXXRGN), PHOTHR (MXXRGN),
- // & EMREJE, EMSAMP, EMSNGL,
- // & MEDEMF (MXXRGN), IRAYLR (MXXRGN), NRGEMF,
- // & NOSCAT, NOLLDA
- // OLD EFMRGN:
- // COMMON / EFMRGN / RHOR (MXXRGN), ECUT (MXXRGN), PCUT (MXXRGN),
- // & EMREJE, EMSAMP, EMSNGL, VACDST,
- // & MEDEMF (MXXRGN), IRAYLR (MXXRGN), NRGEMF,
- // & NOSCAT, NOLLDA
- //*D === Obsolete variable names === *
- //*D DIMENSION MED (MXXRGN)
- //*D EQUIVALENCE ( MED (1), MEDEMF (1) )
-typedef struct {
- Double_t elethr[mxxrgn];
- Double_t phothr[mxxrgn];
- Double_t emreje;
- Double_t emsamp;
- Double_t emsngl;
- Int_t medemf[mxxrgn];
- Int_t iraylr[mxxrgn];
- Int_t nrgemf;
- Int_t noscat;
- Int_t nollda;
-} emfrgnCommon;
-
-#define EMFRGN COMMON_BLOCK(EMFRGN,emfrgn)
-COMMON_BLOCK_DEF(emfrgnCommon,EMFRGN);
-}
-
-#endif
+++ /dev/null
-#ifndef FEMFSTK
-#define FEMFSTK_H 1
-
-#include "Rtypes.h"
-#include "cfortran.h"
-
-#include "Fdimpar.h"
-extern "C" {
-//*$ create emfstk.add
-//*copy emfstk
-//*
-//*=== emfstk ===========================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* common emfstk (emf stack) for emf *
-//* *
-//* last change on 08-oct-97 by alfredo ferrari *
-//* *
-//*----------------------------------------------------------------------*
-//*
-
-typedef struct {
- Double_t etemf[mestck]; // total energy in MeV
- Double_t pmemf[mestck];
- Double_t xemf[mestck]; // particle x-coordinate
- Double_t yemf[mestck]; // particle y-coordinate
- Double_t zemf[mestck]; // particle z-coordinate
- Double_t uemf[mestck]; // x direction cosine
- Double_t vemf[mestck]; // y direction cosine
- Double_t wemf[mestck]; // z direction cosine
- Double_t dnear[mestck]; // equivalent to GEANT "safety"
- Double_t upol[mestck]; // polarisation in x direction
- Double_t vpol[mestck]; // polarisation in y direction
- Double_t wpol[mestck]; // polarisation in z direction
- Double_t usnrml[mestck];
- Double_t vsnrml[mestck];
- Double_t wsnrml[mestck];
- Double_t wtemf[mestck]; // weight
- Double_t agemf[mestck]; // age
- Double_t cmpemf[mestck];
- Double_t espark[mestck][mkbmx1];
- Double_t rdlyem[mestck];
- Int_t iespak[mestck][mkbmx2];
- Int_t ichemf[mestck]; // charge
- Int_t iremf[mestck]; // region
- Int_t irlatt[mestck]; // lattice cell
- Int_t nhpemf[mestck];
- Int_t lloemf[mestck]; // generation number
- Int_t louemf[mestck];
- Int_t lrdemf[mestck];
- Int_t npemf; // number of particles in stack
- Int_t npstrt; // EMF stack index before the interaction (since
- // the projectile disappears it is also the starting
- // index of secondaries)
-//*d === obsolete variable names === *
-//*d parameter ( idmemf = mestck )
-//*d dimension e (idmemf), wt (idmemf), iq (idmemf), ir (idmemf)
-//*d equivalence ( e (1), etemf (1) )
-//*d equivalence ( wt (1), wtemf (1) )
-//*d equivalence ( ir (1), iremf (1) )
-//*d equivalence ( iq (1), ichemf (1) )
-//*d equivalence ( np, npemf )
-} emfstkCommon;
-#define EMFSTK COMMON_BLOCK(EMFSTK,emfstk)
-COMMON_BLOCK_DEF(emfstkCommon,EMFSTK);
-}
-#endif
+++ /dev/null
-extern "C" {
-//*$ create evtflg.add
-//*copy evtflg
-//*
-//*=== evtflg ===========================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* event flags: *
-//* *
-//* created on 19 may 1998 by alfredo ferrari & paola sala *
-//* infn - milan *
-//* *
-//* last change on 13-aug-99 by alfredo ferrari *
-//* *
-//* *
-//*----------------------------------------------------------------------*
-//*
-//*
-
-typedef struct {
- Int_t lelevt;
- Int_t linevt;
- Int_t ldecay;
- Int_t ldltry;
- Int_t lpairp;
- Int_t lbrmsp;
- Int_t lannrs;
- Int_t lannfl;
- Int_t lphoel;
- Int_t lcmptn;
- Int_t lcohsc;
- Int_t llensc;
- Int_t loppsc;
- Int_t leldis;
- Int_t lrdcay;
- Int_t ntrcks;
-} evtflgCommon;
-#define EVTFLG COMMON_BLOCK(EVTFLG,evtflg)
-COMMON_BLOCK_DEF(evtflgCommon,EVTFLG);
-}
+++ /dev/null
-extern "C" {
-//*$ create fheavy.add
-//*copy fheavy
-//*
-//*=== fheavy ===========================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* include file: fheavy *
-//* *
-//* created on 5 april 1990 by alfredo ferrari, infn milan *
-//* *
-//* last change on 26-jul-97 by alfredo ferrari, infn milan *
-//* *
-//* included in the following subroutines or functions: not updated *
-//* *
-//* description of the common block(s) and variable(s) *
-//* *
-//* /fheavy/ is the storage for heavy secondaries created in the *
-//* nuclear evaporation *
-//* npheav = number of secondaries *
-//* kheavy(ip) = type of the secondary ip *
-//* ( 3 = deuteron, 4 = 3-h, 5 = 3-he, 6 = 4-he, *
-//* 7-12 = "heavy" fragment specified by ibheav and *
-//* icheav ) *
-//* cxheav(ip) = direction cosine of the secondary ip *
-//* with respect to x-axis *
-//* cyheav(ip) = direction cosine of the secondary ip *
-//* with respect to y-axis *
-//* czheav(ip) = direction cosine of the secondary ip *
-//* with respect to z-axis *
-//* tkheav(ip) = kinetic energy of secondary ip *
-//* pheavy(ip) = momentum of the secondary ip *
-//* wheavy(ip) = weight of the secondary ip *
-//* agheav(ip) = "age" of the secondary ip with respect to the *
-//* interaction time *
-//* amheav(kp) = atomic masses of the twelve types of evaporated *
-//* or fragmented or fissioned particles *
-//* amnhea(kp) = nuclear masses of the twelve types of evaporated *
-//* or fragmented or fissioned particles *
-//* bhheav(jp,kp) = (nuclear) binding energy of the jp_th hyperon of *
-//* the kp-type heavy particle *
-//* anheav(kp) = name of the kp-type heavy particle *
-//* icheav(kp) = charge of the kp-type heavy particle *
-//* ibheav(kp) = mass number of the kp-type heavy particle *
-//* imheav(kp) = isomeric state of the kp-type heavy particle *
-//* ihheav(kp) = number of hyperons of the kp-type heavy particle *
-//* khheav(jp,kp) = id of the jp_th hyperon of the kp-type heavy *
-//* particle *
-//* infhea(ip) = possible extra infos for the ip_th secondary * 2006.3
-//* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-//* !!! there is now the possibility to produce up to 6 "heavy" !!!! *
-//* !!! fragments besides the residual nucleus recorded in !!!! *
-//* !!! resnuc: they are identified by indeces 7-12, of course !!!! *
-//* !!! the corresponding physical properties (z,a,m..) must be !!!! *
-//* !!! updated every time they are produced !!!! *
-//* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-//*----------------------------------------------------------------------*
-//*
-const Int_t mxheav = 100;
-const Int_t kxheav = 30;
-
-typedef struct {
- Double_t cxheav[mxheav];
- Double_t cyheav[mxheav];
- Double_t czheav[mxheav];
- Double_t tkheav[mxheav];
- Double_t pheavy[mxheav];
- Double_t wheavy[mxheav];
- Double_t agheav[mxheav];
- Double_t bhheav[kxheav][ihypmx];
- Double_t amheav[kxheav];
- Double_t amnhea[kxheav];
- Int_t kheavy[mxheav];
- Int_t infhea[mxheav]; // 2006.3
- Int_t icheav[kxheav];
- Int_t ibheav[kxheav];
- Int_t imheav[kxheav];
- Int_t ihheav[kxheav];
- Int_t khheav[kxheav][ihypmx];
- Int_t npheav;
-} fheavyCommon;
-#define FHEAVY COMMON_BLOCK(FHEAVY,fheavy)
-COMMON_BLOCK_DEF(fheavyCommon,FHEAVY);
-
-typedef struct {
- Char_t anheav[kxheav][8];
-} fheavcCommon;
-#define FHEAVC COMMON_BLOCK(FHEAVC,fheavc)
-COMMON_BLOCK_DEF(fheavcCommon,FHEAVC);
-}
+++ /dev/null
-#include "cfortran.h"
-#include "Rtypes.h"
-
-#include "Fdimpar.h"
-
-extern "C" {
-/*$ CREATE FLKMAT.ADD
-*COPY FLKMAT
-*
-*=== Flkmat ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Partial (some variables come from FLUKA87) *
-* Copyright (C) 1996-2005 by Alfredo Ferrari *
-* All Rights Reserved. *
-* *
-* *
-* FLuKa MATerial properties and atomic data *
-* *
-* Version for Fluka91/.../2005/...: *
-* *
-* Last change on 28-Apr-05 by Alfredo Ferrari, INFN-Milan *
-* *
-* *
-* This common contains the basic properties of the materials used *
-* in the FLUKA run. Other properties are recorded in specialized *
-* commons (ie for dE/dx etc) *
-* *
-* Aocmbm(i) = Atomic density of the i_th material in barn^-1 cm^-1 *
-* (Atoms Over Cm times Barn for Materials) *
-* Eocmbm(i) = Electron density of the i_th material in barn^-1cm^-1*
-* (Atoms Over Cm times Barn for Materials) *
-* Amss(i) = Atomic weight (g/mole) of the i_th material *
-* Amssem(i) = "Effective" i_th material atomic weight for the para-*
-* metrized EM cascade *
-* Rho(i) = Density of the i_th material *
-* Ztar(i) = Atomic number of the i_th material *
-* Zsqtar(i) = Squared atomic number of the i_th material *
-* Ztarem(i) = "Effective" atomic number for the i_th material for *
-* the parametrized EM cascade *
-* Ainlng(i) = Inelastic scattering length of the i_th material *
-* for beam particles at the average beam energy in cm *
-* Aellng(i) = Elastic scattering length of the i_th material for *
-* beam particles at average beam energy in cm *
-* X0rad(i) = Radiation lengths of the materials in cm *
-* Ainnth(i) = Inelastic scattering length of the i_th material *
-* for neutrons at threshold energy in cm *
-* Medium(k) = Material number of the k_th region *
-* Mulflg(i) = Flags for multiple scattering options for the i_th *
-* material *
-* Icomp(i) = Starting address in the Matnum array if the i_th *
-* material is a compound/mixture, 0 otherwise *
-* Mssnum(i) = Mass number of the target nucleus for the i_th mater-*
-* ial, if =< 0 it means that it is in the natural isot-*
-* opic composition *
-* Msindx(i) = Index for tabulations for the given isotope of the *
-* target nucleus (meaningful only for mssnum > 0) *
-* that it is in the natural isotopic composition *
-* Lcmpnd(i) = logical flag for real compounds versus mixtures *
-* Matnam(i) = Alphabetical name of the i_th material number *
-* Nregs = total number of regions *
-* Nregcg = total number of combinatorial geometry regions *
-* Nmat = total number of materials used in the problem *
-* Mtbsnm = medium for which inelastic interaction biasing must *
-* be done *
-* *
-* Mxxmdf = maximum number of materials *
-* Mxxrgn = maximum number of regions *
-* *
-*----------------------------------------------------------------------*
-*
- CHARACTER*8 MATNAM
- LOGICAL LCMPND
- COMMON / FLKMAT / AOCMBM(MXXMDF), EOCMBM(MXXMDF), AMSS (MXXMDF),
- & AMSSEM(MXXMDF), RHO (MXXMDF), ZTAR (MXXMDF),
- & ZTAREM(MXXMDF), ZSQTAR(MXXMDF), AINLNG(MXXMDF),
- & AELLNG(MXXMDF), X0RAD (MXXMDF), AINNTH(MXXMDF),
- & MEDIUM(MXXRGN), MULFLG(MXXMDF), ICOMP (MXXMDF),
- & MSSNUM(MXXMDF), MSINDX(MXXMDF), LCMPND(MXXMDF),
- & NREGS , NMAT , MTBSNM, NREGCG
- COMMON / CHFLKM / MATNAM(MXXMDF)
- SAVE / FLKMAT /
- SAVE / CHFLKM /
-*/
-
- typedef struct {
- Double_t aocmbm[mxxmdf];
- Double_t eocmbm[mxxmdf];
- Double_t amss [mxxmdf];
- Double_t amssem[mxxmdf];
- Double_t rho [mxxmdf];
- Double_t ztar [mxxmdf];
- Double_t ztarem[mxxmdf];
- Double_t zsqtar[mxxmdf];
- Double_t ainlng[mxxmdf];
- Double_t aellng[mxxmdf];
- Double_t x0rad [mxxmdf];
- Double_t ainnth[mxxmdf];
- Int_t medium[mxxrgn];
- Int_t mulflg[mxxmdf];
- Int_t icomp [mxxmdf];
- Int_t mssnum[mxxmdf];
- Int_t msindx[mxxmdf];
- Int_t lcmpnd[mxxmdf];
- Int_t nregs;
- Int_t nmat;
- Int_t mtbsnm;
- Int_t nregcg;
- } flkmatCommon;
-#define FLKMAT COMMON_BLOCK(FLKMAT,flkmat)
- COMMON_BLOCK_DEF(flkmatCommon, FLKMAT);
-}
+++ /dev/null
-#ifndef FFLKSTK_H
-#define FFLKSTK_H 1
-
-#include "cfortran.h"
-#include "Rtypes.h"
-
-#include "Fdimpar.h"
-
-extern "C" {
-//*$ create flkstk.add
-//*copy flkstk
-//*
-//*=== flkstk ============================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* FLUKA90-200x particle stack: *
-//* *
-//* Changes: last change on 15-may-2005 by Alfredo Ferrari *
-//* INFN, Milan *
-//* *
-//* *
-//* description of the common block(s) and variable(s) *
-//* *
-//* /Flkstk/ stack for the primaries *
-//* Wtflk = particle statistical weight *
-//* Pmoflk = particle (laboratory) momentum (GeV/c) *
-//* Tkeflk = particle (laboratory) kinetic energy (GeV) *
-//* Xflk = particle position x-coordinate *
-//* Yflk = particle position y-coordinate *
-//* Zflk = particle position z-coordinate *
-//* Txflk = particle direction x-coordinate *
-//* Tyflk = particle direction y-coordinate *
-//* Tzflk = particle direction z-coordinate *
-//* Txpol = x direction cosine of the particle polarization *
-//* Typol = y direction cosine of the particle polarization *
-//* Tzpol = z direction cosine of the particle polarization *
-//* Txnor = x direction cosine of a (possible) surface normal *
-//* Tynor = y direction cosine of a (possible) surface normal *
-//* Tznor = z direction cosine of a (possible) surface normal *
-//* Dfnear = distance to the nearest boundary *
-//* Agestk = age of the particle (seconds) *
-//* Aknshr = Kshort component of K0/K0bar *
-//* Frcphn = cross section for force photonuclear interaction (if *
-//* < 0), distance to a forced photonuclear interaction *
-//* (if > 0) *
-//* Lfrphn = flag for forced photonuclear interaction *
-//* Raddly = delay (s) in production wrt the nominal primary "0" *
-//* time for particle produced in radioactive decays *
-//* (i.e. those coming from decays of daughter isotopes), *
-//* when in analogue mode, flag for position in the *
-//* activr array when in non-analogue mode *
-//* Cmpath = cumulative path travelled by the particle since it *
-//* was produced (cm) *
-//* Sparek = spare real variables available for K.W.Burn *
-//* Ispark = spare integer variables available for K.W.Burn *
-//* Iloflk = particle identity (Paprop numbering) *
-//* Igroup = energy group for low energy neutrons *
-//* Loflk = particle generation *
-//* Louse = user flag *
-//* Nrgflk = particle region number *
-//* Nlattc = particle lattice cell number *
-//* Nhspnt = pointer to the history object (Geant4 geometry) *
-//* Nevent = number of the event which created the particle *
-//* Numpar = particle number *
-//* Lraddc = flag for particles generated in radioactive decays *
-//* Nparma = largest particle number ever reached *
-//* Nstmax = highest value of the stack pointer ever reached *
-//* in the run *
-//* Npflka = Fluka stack pointer *
-//* Nstaol = stack pointer of the last processed particle *
-//* Igroun = energy group number of the last processed particle *
-//* if it is a low energy neutron *
-//*----------------------------------------------------------------------*
-//*
-
-typedef struct {
- Double_t xflk[mfstck+1]; //(0:MFSTCK)
- Double_t yflk[mfstck+1]; //(0:MFSTCK)
- Double_t zflk[mfstck+1]; //(0:MFSTCK)
- Double_t txflk[mfstck+1]; //(0:MFSTCK)
- Double_t tyflk[mfstck+1]; //(0:MFSTCK)
- Double_t tzflk[mfstck+1]; //(0:MFSTCK)
- Double_t txpol[mfstck+1]; //(0:MFSTCK)
- Double_t typol[mfstck+1]; //(0:MFSTCK)
- Double_t tzpol[mfstck+1]; //(0:MFSTCK)
- Double_t txnor[mfstck+1]; //(0:MFSTCK)
- Double_t tynor[mfstck+1]; //(0:MFSTCK)
- Double_t tznor[mfstck+1]; //(0:MFSTCK)
- Double_t wtflk[mfstck+1]; //(0:MFSTCK)
- Double_t pmoflk[mfstck+1]; //(0:MFSTCK)
- Double_t tkeflk[mfstck+1]; //(0:MFSTCK)
- Double_t dfnear[mfstck+1]; //(0:MFSTCK)
- Double_t agestk[mfstck+1]; //(0:MFSTCK)
- Double_t aknshr[mfstck+1]; //(0:MFSTCK)
- Double_t raddly[mfstck+1]; //(0:MFSTCK)
- Double_t cmpath[mfstck+1]; //(0:MFSTCK)
- Double_t frcphn[mfstck+1]; //(0:MFSTCK)
- Double_t sparek[mfstck+1][mkbmx1]; //(MKBMX1,0:MFSTCK)
- Int_t ispark[mfstck+1][mkbmx2]; //(MKBMX2,0:MFSTCK)
- Int_t iloflk[mfstck+1]; //(0:MFSTCK)
- Int_t igroup[mfstck+1]; //(0:MFSTCK)
- Int_t loflk[mfstck+1]; //(0:MFSTCK)
- Int_t louse[mfstck+1]; //(0:MFSTCK)
- Int_t nrgflk[mfstck+1]; //(0:MFSTCK)
- Int_t nlattc[mfstck+1]; //(0:MFSTCK)
- Int_t nhspnt[mfstck+1]; //(0:MFSTCK)
- Int_t nevent[mfstck+1]; //(0:MFSTCK)
- Int_t numpar[mfstck+1]; //(0:MFSTCK)
- Int_t lraddc[mfstck+1]; //(0:MFSTCK)
- Int_t lfrphn[mfstck+1]; //(0:MFSTCK)
- Int_t nparma;
- Int_t nstmax;
- Int_t npflka;
- Int_t nstaol;
- Int_t igroun;
-} flkstkCommon;
-#define FLKSTK COMMON_BLOCK(FLKSTK,flkstk)
-COMMON_BLOCK_DEF(flkstkCommon,FLKSTK);
-}
-
-#endif
+++ /dev/null
-#ifndef FGENSTK
-#define FGENSTK_H 1
-
-#include "Rtypes.h"
-#include "cfortran.h"
-
-#include "Fdimpar.h"
-//*$ CREATE GENSTK.ADD
-//*COPY GENSTK
-//*
-//*=== Genstk ===========================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* hadron GENerator STacK for FLUKA: (new version of old Finuc of *
-//* FLUKA86 by J.Ranft) *
-//* *
-//* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-//* !!!! S E E A L S O I N C L U D E F I L E !!!! *
-//* !!!! G E N S T K 2 !!!! *
-//* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-//* *
-//* Created on 20 january 1996 by Alfredo Ferrari & Paola Sala *
-//* Infn - Milan *
-//* *
-//* Last change on 15-may-05 by Alfredo Ferrari *
-//* *
-//* *
-//* /Genstk/ is the storage for secondaries created in hadronic *
-//* events *
-//* Np = total number of secondaries *
-//* Kpart (ip) = (Paprop) id of the ip_th secondary *
-//* Cxr (ip) = x-axis direction cosine of the ip_th secondary *
-//* Cyr (ip) = y-axis direction cosine of the ip_th secondary *
-//* Czr (ip) = z-axis direction cosine of the ip_th secondary *
-//* Cxrpol (ip) = x-axis direction cosine of the ip_th secondary *
-//* polarization vector (rest frame when applicable) *
-//* Cyrpol (ip) = y-axis direction cosine of the ip_th secondary *
-//* polarization vector (rest frame when applicable) *
-//* Czrpol (ip) = z-axis direction cosine of the ip_th secondary *
-//* polarization vector (rest frame when applicable) *
-//* Tki (ip) = laboratory kinetic energy of ip_th secondary (GeV)*
-//* Plr (ip) = laboratory momentum of the ip_th secondary (GeV/c)*
-//* Wei (ip) = statistical weight of the ip_th secondary *
-//* Agesec (ip) = "age" of the ip_th secondary with respect to the *
-//* interaction time *
-//* Tv = excitation energy (GeV) *
-//* Tvcms = actual excitation energy of the residual nucleus *
-//* Tvrecl = recoil kinetic energy of the residual nucleus *
-//* Tvheav = recoil kinetic energies of heavy (2-H, 3-H, 3-He, *
-//* 4-He) fragments after evaporation *
-//* Tvbind = approximate energy wasted in nuclear binding *
-//* effects (not yet operational) *
-//* Infext (ip) = possible extra infos for the ip_th secondary * 2006.3
-//* *
-//*----------------------------------------------------------------------*
-
-extern "C" {
-const Int_t mxp = mxpscs;
-//*
-
-typedef struct {
- Double_t cxr[mxp];
- Double_t cyr[mxp];
- Double_t czr[mxp];
- Double_t cxrpol[mxp];
- Double_t cyrpol[mxp];
- Double_t czrpol[mxp];
- Double_t tki[mxp];
- Double_t plr[mxp];
- Double_t wei[mxp];
- Double_t agesec[mxp];
- Double_t tv;
- Double_t tvcms;
- Double_t tvrecl;
- Double_t tvheav;
- Double_t tvbind;
- Int_t kpart[mxp];
- Int_t infext[mxpscs];
- Int_t np0;
- Int_t np;
-} genstkCommon;
-#define GENSTK COMMON_BLOCK(GENSTK,genstk)
-COMMON_BLOCK_DEF(genstkCommon,GENSTK);
-}
-#endif
+++ /dev/null
-#ifndef FIOIOCM_H
-#define FIOIOCM_H
-
-#include "Rtypes.h"
-#include "cfortran.h"
-extern "C" {
-
-/*
-*$ CREATE IOIOCM.ADD
-*COPY IOIOCM
-*
-*=== Ioiocm ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Copyright (C) 2002-2006 by Alfredo Ferrari *
-* All Rights Reserved. *
-* *
-* *
-* IOn-IOn CoMmon: *
-* *
-* Ion-Ion collision common for Fluka9x/Fluka200x....: *
-* *
-* Last change on 19-apr-06 by Alfredo Ferrari, INFN-Milan *
-* *
-* Description of the variable(s): *
-* *
-* Eknion = laboratory kinetic energy per nucleon (GeV/amu) *
-* Etnion = laboratory total energy per nucleon (GeV/amu) *
-* Plnion = laboratory momentum per nucleon (GeV/c/amu) *
-* Eexion = excitation energy of the projectile ion (GeV) *
-* T12ion = half life of the projectile ion (for Eexion=0) (s) *
-* 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 *
-* Iprom = the projectile isomer number *
-* *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* !!!! Note that the units are GeV/amu --> per unit mass !!!! *
-* !!!! with mass measured in amu (1 amu = Amuc12 GeV) !!!! *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* *
-*----------------------------------------------------------------------*
-*
- COMMON / IOIOCM / EKNION, ETNION, PLNION, EEXION, T12ION,
- & MATPRJ (MXXMDF), NMATPR, IPROA , IPROZ , IPROM
- SAVE / IOIOCM /
-*/
- typedef struct {
- Double_t eknion;
- Double_t etnion;
- Double_t plnion;
- Double_t eexion;
- Double_t t12ion;
- Int_t matprj[mxxmdf];
- Int_t nmatpr;
- Int_t iproa;
- Int_t iproz;
- Int_t iprom;
- } ioiocmCommon;
-#define IOIOCM COMMON_BLOCK(IOIOCM,ioiocm)
-COMMON_BLOCK_DEF(ioiocmCommon, IOIOCM);
-
-}
-#endif
+++ /dev/null
-extern "C" {
-//*$ create iounit.add
-//*copy iounit
-//* *
-//*=== iounit ===========================================================*
-//* *
-//*----------------------------------------------------------------------*
-//* *
-//* iounit: included in any routine *
-//* *
-//* created on 01 june 1990 by alfredo ferrari, infn -milan *
-//* *
-//* last change on 20-jan-99 by alfredo ferrari *
-//* *
-//* lunin = standard input unit *
-//* lunout = standard output unit *
-//* lunerr = standard error unit *
-//* lunber = input file for bertini nuclear data *
-//* lunech = echo file for pegs dat *
-//* lunflu = input file for photoelectric edges and x-ray fluo- *
-//* rescence data *
-//* lungeo = scratch file for combinatorial geometry *
-//* lunpmf = input file for pegs material data *
-//* lunran = output file for the final random number seed *
-//* lunxsc = input file for low energy neutron cross sections *
-//* lundet = output file for the detect option *
-//* lunray = output file for ray-tracing options *
-//* lunrdb = unit number for reading (extra) auxiliary external *
-//* files to be closed just after reading *
-//* lunrd2 = unit number for reading (extra) auxiliary external *
-//* files to be closed just after reading *
-//* lunscr = unit number to be used for temporary scratch files *
-//* lunpgo = output file for plotgeom *
-//* lunpgs = store (formatted/unformatted) file for plotgeom *
-//* *
-//*----------------------------------------------------------------------*
-//* *
-const Int_t lunin = 5;
-//* start_vax_seq
-//* parameter ( lunout = 6 )
-//* end_vax_seq
-//* start_ibm_seq
-//* parameter ( lunout = 6 )
-//* end_ibm_seq
-//* start_unix_seq
-const Int_t lunout = 11;
-//* end_unix_seq
-const Int_t lunerr = 15;
-const Int_t lunber = 14;
-const Int_t lunech = 8;
-const Int_t lunflu = 13;
-const Int_t lungeo = 16;
-const Int_t lunpmf = 12;
-const Int_t lunran = 2;
-const Int_t lunxsc = 9;
-const Int_t lundet = 17;
-const Int_t lunray = 10;
-const Int_t lunrdb = 1;
-const Int_t lunrd2 = 18;
-const Int_t lundpm = 19;
-const Int_t lunpgo = 7;
-const Int_t lunpgs = 4;
-const Int_t lunscr = 3;
-}
+++ /dev/null
-#ifndef FLTCLCM_H
-#define FLTCLCM_H 1
-
-#include "cfortran.h"
-#include "Rtypes.h"
-
-extern "C" {
-//*$ create ltclcm.add
-//*copy ltclcm
-//*
-//*=== ltclcm ===========================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* lattice cell common: *
-//* *
-//* created on 09 december 1993 by alfredo ferrari & paola sala *
-//* infn - milan *
-//* *
-//* last change on 10-dec-93 by alfredo ferrari *
-//* *
-//* *
-//*----------------------------------------------------------------------*
-//*
-
-typedef struct {
- Int_t mlattc;
- Int_t newlat;
- Int_t mlatld;
- Int_t mlatm1;
- Int_t mltsen;
- Int_t mltsm1;
-} ltclcmCommon;
-#define LTCLCM COMMON_BLOCK(LTCLCM,ltclcm)
-COMMON_BLOCK_DEF(ltclcmCommon,LTCLCM);
-}
-
-#endif
+++ /dev/null
-#ifndef FOPPHCM_H
-#define FOPPHCM_H 1
-
-#include "Rtypes.h"
-#include "cfortran.h"
-#include "Fdimpar.h"
-
-extern "C" {
-/*
-*=== Opphcm ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* OPtical PHoton CoMmon: *
-* *
-* Created on 19 september 1997 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 11-jan-99 by Alfredo Ferrari *
-* *
-* Opphpr (ip,im) = ip_th optical property parameter of the im_th *
-* material (non metal) *
-* ip = *
-* 1: refraction index *
-* 2: absorption coeff. (cm^-1) *
-* 3: diffusion coeff. (cm^-1) *
-* 4: refraction index 1st derivative *
-* 5: absorption 1st derivative *
-* 6: diffusion 1st derivative *
-* 7: refraction index 2nd derivative *
-* 8: absorption 2nd derivative *
-* 9: diffusion 2nd derivative *
-* 10: refraction index 3rd derivative *
-* 11: absorption 3rd derivative *
-* 12: diffusion 3rd derivative *
-* metal: *
-* ip = *
-* 1: refraction index (not used) *
-* 2: absorption coeff. (cm^-1) (not used) *
-* 3: 1 - reflectivity index *
-* 7: 1 - reflectivity index 1st derivative *
-* 9: 1 - reflectivity index 2nd derivative *
-* 12: 1 - reflectivity index 3rd derivative *
-* Emncer (im) = minimum energy for Cerenkov photon production *
-* for im_th medium *
-* Emxcer (im) = maximum energy for Cerenkov photon production *
-* for im_th medium *
-* Rmxcer (im) = maximum refractive index in the energy range *
-* of interest for Cerenkov photon production *
-* for im_th medium *
-* Escint (je,im) = energy for je_th scintillation photon produc- *
-* tion for im_th medium *
-* Fscint (je,im) = fraction of energy emitted as the je_th scin- *
-* tillation photon energy for im_th medium *
-* Sscint (je,im) = sensitivity for the je_th scintillation photon*
-* energy for im_th medium *
-* Tscint (je,im) = time constant of je_th scintillation photon *
-* production for im_th medium *
-* Emntrd (im) = minimum energy for transition radiation photon*
-* production for im_th medium *
-* Emxtrd (im) = maximum energy for transition radiation photon*
-* production for im_th medium *
-* Wvmnop (im) = minimum wavelength for opt. photon transport *
-* for im_th medium (default: 250 nm) *
-* Wvcnop (im) = central wavelength for opt. photon transport *
-* for im_th medium (default: 589 nm, Na D) *
-* Wvmxop (im) = maximum wavelength for opt. photon transport *
-* for im_th medium (default: 600 nm) *
-* Ommnop (im) = minimum 2pi x freq. for opt. photon transport *
-* for im_th medium *
-* Omcnop (im) = central 2pi x freq. for opt. photon transport *
-* for im_th medium *
-* Ommxop (im) = maximum 2pi x freq. for opt. photon transport *
-* for im_th medium *
-* Wvmnsn = minimum wavelength for opt. photon sensitivity*
-* (default: 25 nm) *
-* Wvcnsn = central wavelength for opt. photon sensitivity*
-* (default: 589 nm, Na D) *
-* Wvmxsn = maximum wavelength for opt. photon sensitivity*
-* for im_th medium (default: 6000 nm) *
-* Ommnsn = minimum 2pi x freq. for opt. photon sensiti- *
-* vity *
-* Omcnsn = central 2pi x freq. for opt. photon sensiti- *
-* vity *
-* Ommxsn = maximum 2pi x freq. for opt. photon sensiti- *
-* vity *
-* Opsnmx = maximum of optical photon sensitivity *
-* Rghnss (ib) = Roughness parameter for ib_th material-to-ma- *
-* terial boundary ib_th *
-* M1rghn (ib) = 1st material of ib_th material-to-material *
-* boundary *
-* M2rghn (ib) = 2nd material of ib_th material-to-material *
-* boundary *
-* M1rgbx (ix) = 1st region of ix_th region-to-region special *
-* boundary *
-* M2rgbx (ix) = 2nd region of ix_th region-to-region special *
-* boundary *
-* Lopprp (im) = logical flag for optical properties of im_th *
-* material *
-* Lopmtl (im) = logical flag whether the im_th optical mate- *
-* rial is a metal or not *
-* Lwvopp (im) = logical flag whether optical properties of *
-* im_th material are expressed as a function of *
-* wavelength (true) or 2pi x frequency (false). *
-* By default it is true. *
-* Lwvops = logical flag whether optical photon sensiti- *
-* vities are expressed as a function of wave- *
-* length (true) or 2pi x frequency (false). *
-* By default it is true. *
-* Lcrnkv (im) = logical flag for Cerenkov photon production *
-* for im_th material *
-* Lscntl (im) = logical flag for scintillation photon produ- *
-* ction for im_th material *
-* Ltscnt (je,im) = logical flag for time constant for je_th *
-* scintill photon production in im_th medium *
-* Ltrrad (im) = logical flag for transition radiation photon *
-* production for im_th material *
-* Lopphp (im) = logical flag for transition radiation photon *
-* production for im_th material *
-* Nxoppb = number of material boundaries for which the *
-* roughness has been defined *
-* Nxopbx = number of region boundaries for which the *
-* special user routine ophbdx should be called *
-* *
-*----------------------------------------------------------------------*
-
- PARAMETER ( MXOPSN = 4 )
- PARAMETER ( MXOPPR = 12 )
- PARAMETER ( MXOPPB = 20 )
- PARAMETER ( MXOPBX = 40 )
- PARAMETER ( MXSCPH = 3 )
- PARAMETER ( WVMNTR = 250.D-07 )
- PARAMETER ( WVCNTR = 589.D-07 )
- PARAMETER ( WVMXTR = 600.D-07 )
- LOGICAL LOPPRP, LOPMTL, LWVOPP, LCRNKV, LTRRAD, LSCNTL, LOPPHP,
- & LWVOPS, LTSCNT
- COMMON / OPPHCM / WVMNSN, WVCNSN, WVMXSN, OMMNSN, OMCNSN, OMMXSN,
- & OPSNMX, OPSNPR (MXOPSN),OPPHPR (MXOPPR,MXXMDF),
- & EMNCER (MXXMDF), EMXCER (MXXMDF), RMXCER (MXXMDF),
- & EMNTRD (MXXMDF), EMXTRD (MXXMDF), WVMNOP (MXXMDF),
- & WVMXOP (MXXMDF), WVCNOP (MXXMDF), OMMNOP (MXXMDF),
- & OMMXOP (MXXMDF), OMCNOP (MXXMDF), RGHNSS (MXOPPB),
- & ESCINT (MXSCPH,MXXMDF), FSCINT (MXSCPH,MXXMDF),
- & SSCINT (MXSCPH,MXXMDF), TSCINT(MXSCPH,MXXMDF),
- & M1RGHN (MXOPPB), M2RGHN (MXOPPB), M1RGBX (MXOPBX),
- & M2RGBX (MXOPBX), LOPPRP (MXXMDF), LOPMTL (MXXMDF),
- & LWVOPP (MXXMDF), LCRNKV (MXXMDF), LSCNTL (MXXMDF),
- & LTRRAD (MXXMDF), LOPPHP (MXXMDF), LWVOPS, NXOPPB,
- & NXOPBX, LTSCNT (MXSCPH,MXXMDF)
-*/
- const Int_t mxopsn = 4;
- const Int_t mxoppr = 12;
- const Int_t mxoppb = 20;
- const Int_t mxopbx = 40;
- const Int_t mxscph = 3;
- const Double_t wvmntr = 250.e-07;
- const Double_t wvcntr = 589.e-07;
- const Double_t wvmxtr = 600.e-07;
-
- typedef struct {
- Double_t wvmnsn;
- Double_t wvcnsn;
- Double_t wvmxsn;
- Double_t ommnsn;
- Double_t omcnsn;
- Double_t ommxsn;
- Double_t opsnmx;
- Double_t opsnpr [mxopsn];
- Double_t opphpr [mxxmdf][mxoppr];
- Double_t emncer [mxxmdf];
- Double_t emxcer [mxxmdf];
- Double_t rmxcer [mxxmdf];
- Double_t emntrd [mxxmdf];
- Double_t emxtrd [mxxmdf];
- Double_t wvmnop [mxxmdf];
- Double_t wvmxop [mxxmdf];
- Double_t wvcnop [mxxmdf];
- Double_t ommnop [mxxmdf];
- Double_t ommxop [mxxmdf];
- Double_t omcnop [mxxmdf];
- Double_t rghnss [mxoppb];
- Double_t escint [mxxmdf][mxscph];
- Double_t fscint [mxxmdf][mxscph];
- Double_t sscint [mxxmdf][mxscph];
- Double_t tscint [mxxmdf][mxscph];
- Int_t m1rghn [mxoppb];
- Int_t m2rghn [mxoppb];
- Int_t m1rgbx [mxopbx];
- Int_t m2rgbx [mxopbx];
- Int_t lopprp [mxxmdf];
- Int_t lopmtl [mxxmdf];
- Int_t lwvopp [mxxmdf];
- Int_t lcrnkv [mxxmdf];
- Int_t lscntl [mxxmdf];
- Int_t ltrrad [mxxmdf];
- Int_t lopphp [mxxmdf];
- Int_t lwvops;
- Int_t nxoppb;
- Int_t nxopbx;
- Int_t ltscnt [mxxmdf][mxscph];
- } opphcmCommon;
-#define OPPHCM COMMON_BLOCK(OPPHCM,opphcm)
-COMMON_BLOCK_DEF(opphcmCommon,OPPHCM);
-}
-#endif
+++ /dev/null
-#ifndef OPPHST
-#define OPPHST_H 1
-
-#include "Rtypes.h"
-#include "cfortran.h"
-#include "Fdimpar.h"
-
-extern "C" {
-
-//*$ CREATE OPPHST.ADD
-//*COPY OPPHST
-//*
-//*=== Opphst ===========================================================//*
-//*
-//*----------------------------------------------------------------------//*
-//* //*
-//* OPtical PHoton STack: //*
-//* //*
-//* Created on 19 september 1997 by Alfredo Ferrari & Paola Sala //*
-//* Infn - Milan //*
-//* //*
-//* Last change on 13-oct-98 by Alfredo Ferrari //*
-//* //*
-//* wtopph = weight of the photon //*
-//* poptph = laboratory momentum of the photon in GeV/c //*
-//* xoptph = x-coordinate of the photon //*
-//* yoptph = y-coordinate of the photon //*
-//* zoptph = z-coordinate of the photon //*
-//* txopph = direction cosine of the photon //*
-//* with respect to x-axis //*
-//* tyopph = direction cosine of the photon //*
-//* with respect to y-axis //*
-//* tzopph = direction cosine of the photon //*
-//* with respect to z-axis //*
-//* txpopp = direction cosine of the photon polarization //*
-//* typopp = direction cosine of the photon polarization //*
-//* tzpopp = direction cosine of the photon polarization //*
-//* donear = distance to the nearest boundary //*
-//* agopph = age of the photon (seconds) //*
-//* cmpopp = total path length of the photon (cm) //*
-//* loopph = generation of the photon //*
-//* louopp = user flag //*
-//* nregop = number of the region of the photon //*
-//* nlatop = number of the lattice cell of the photon //*
-//* tpropp = kinetic energy of parent particle of the photon //*
-//* apropp = age of the parent particle of the photon (seconds) //*
-//* ipropp = id (paprop) of the parent particle of the photon //*
-//* lpropp = generation of the parent particle of the photon //*
-//* npropp = # of the primary track which generated the photon //*
-//* (not used for the moment) //*
-//* lstopp = stack pointer //*
-//* lmxopp = highest value of the stack pointer encountered //*
-//* in the run //*
-//* //*
-//*----------------------------------------------------------------------//*
-//*
-typedef struct {
- Double_t wtopph [mostck];
- Double_t poptph [mostck];
- Double_t xoptph [mostck];
- Double_t yoptph [mostck];
- Double_t zoptph [mostck];
- Double_t txopph [mostck];
- Double_t tyopph [mostck];
- Double_t tzopph [mostck];
- Double_t txpopp [mostck];
- Double_t typopp [mostck];
- Double_t tzpopp [mostck];
- Double_t donear [mostck];
- Double_t agopph [mostck];
- Double_t tpropp [mostck];
- Double_t apropp [mostck];
- Double_t cmpopp [mostck];
- Double_t sparok [mostck][mkbmx1];
- Int_t ispork [mostck][mkbmx2];
- Int_t loopph [mostck];
- Int_t louopp [mostck];
- Int_t nregop [mostck];
- Int_t nlatop [mostck];
- Int_t ipropp [mostck];
- Int_t lpropp [mostck];
- Int_t npropp [mostck];
- Int_t lstopp;
- Int_t lmxopp;
-} opphstCommon;
-
-#define OPPHST COMMON_BLOCK(OPPHST,opphst)
-COMMON_BLOCK_DEF(opphstCommon, OPPHST);
-
-}
-#endif
-
+++ /dev/null
-#ifndef FPAPROP_H
-#define FPAPROP_H 1
-
-#include "Rtypes.h"
-#include "cfortran.h"
-
-#include "Fdimpar.h"
-
-extern "C" {
- //*$ CREATE PAPROP.ADD
- //*COPY PAPROP
- //*
- //*=== paprop ===========================================================*
- //*
- //*----------------------------------------------------------------------*
- //* *
- //* PArticle PROPerties: *
- //* *
- //* !!!! N E W V E R S I O N F O R FLUKA9x/FLUKA200x !!!! *
- //* *
- //* Created on 07 may 1991 by Alfredo Ferrari & Paola Sala *
- //* Infn - Milan *
- //* *
- //* Last change on 03-jul-97 by Alfredo Ferrari *
- //* *
- //* Variable description: *
- //* *
- //* btype (i) = literal name of the i_th particle *
- //* am (i) = i_th particle mass (GeV) *
- //* amdisc(i) = i_th particle mass (GeV) for energy conservation *
- //* purposes when discarded *
- //* ichrge(i) = electric charge of the i_th particle *
- //* ibarch(i) = baryonic charge of the i_th particle *
- //* iscore(j) = id for the j_th scored distribution *
- //* gnname(k) = name of the k_th generalized particle type * 2006.3
- //* ijdisc(i) = flag for discarding the i_th particle type *
- //* tmnlf (i) = mean (not half!) life of the i_th particle (s) *
- //* biasdc(i) = decay biasing factor for the i_th particle *
- //* biasin(i) = inelastic interaction biasing factor for the i_th *
- //* particle *
- //* lhadro(i) = True if the i_th particle type is a hadron *
- //* jspinp(i) = i_th particle spin (in units of 1/2) *
- //* iparty(i) = i_th particle parity (when meaningful) *
- //* iparid(i) = particle type id flag for the i_th particle *
- //* lbsdcy(i) = logical flag for biased decay for the i_th parti- *
- //* cle: if .true. the biasing factor is used as an *
- //* upper limit to the decay length *
- //* lprbsd = logical flag for biased decay: if .true. the bia- *
- //* sing factor is applied only to primaries *
- //* lprbsi = logical flag for inelastic interaction biasing: *
- //* if .true. the biasing factor is applied only to *
- //* primaries *
- //* lsclwf = logical flag for low energy neutron fission sco- *
- //* ring *
- //* lscnbl = logical flag for neutron balance scoring *
- //* *
- //*----------------------------------------------------------------------*
-
-
-// const Int_t mxgnpr = 33; // 2006.3
- const Int_t mxgnpr = 35;
- typedef struct {
- Double_t am[nallwp+7]; //(-6:NALLWP)
- Double_t amdisc[nallwp+7]; //(-6:NALLWP)
- Double_t tmnlf[nallwp+7]; //(-6:NALLWP)
- Double_t biasdc[nallwp+7]; //(-6:NALLWP)
- Double_t biasin[nallwp+7]; //(-6:NALLWP)
- Int_t ichrge[nallwp+7]; //(-6:NALLWP)
- Int_t ibarch[nallwp+7]; //(-6:NALLWP)
- Int_t ijdisc[nallwp+7]; //(-6:NALLWP)
- Int_t jspinp[nallwp+7]; //(-6:NALLWP)
- Int_t iparty[nallwp+7]; //(-6:NALLWP)
- Int_t iparid[nallwp+7]; //(-6:NALLWP)
- Int_t lhadro[nallwp+7]; //(-6:NALLWP)
- Int_t lbsdcy[nallwp+7]; //(-6:NALLWP)
- Int_t iscore[12];
- Int_t lprbsd;
- Int_t lprbsi;
- Int_t lsclwf;
- Int_t lscnbl;
- } papropCommon;
-#define PAPROP COMMON_BLOCK(PAPROP,paprop)
-COMMON_BLOCK_DEF(papropCommon,PAPROP);
-
- typedef struct {
- Char_t btype[nallwp+7][8]; //(-6:NALLWP)
-// Char_t genpar[mxgnpr][8]; // 2006.3
- Char_t gnname[mxgnpr][8]; // 2006.3
- } chpprpCommon;
-#define CHPPRP COMMON_BLOCK(CHPPRP,chpprp)
-COMMON_BLOCK_DEF(chpprpCommon,CHPPRP);
-}
-#endif
+++ /dev/null
-#ifndef FPART_H
-#define FPART_H 1
-
-#include "Rtypes.h"
-#include "cfortran.h"
-#include "Fdimpar.h" //For some constants
-extern "C" {
-//*$ create part.add
-//*copy part
-//*
-//*=== part =============================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* include file: part copy revised on 20-08-96 by a. ferrari *
-//* *
-//* last change on 14-oct-00 by alfredo ferrari *
-//* *
-//* included in the following subroutines or functions: *
-//* *
-//* w a r n i n g !!!! check also part2 and part3 for any change!!! *
-//* *
-//* description of the common block(s) and variable(s) *
-//* *
-//* am = particle mass (gev/c^2) *
-//* ga = particle width (gev) *
-//* tau = particle mean life (s) *
-//* amdisc = "effective" particle mass for energy balance (gev) *
-//* zmnabs = lower width (adimensional unit) to be used during *
-//* particle decay to assure that at least one decay *
-//* channel is physically open *
-//* atnmna = atan (zmnabs) *
-//* ich = particle electric charge *
-//* ibar = particle baryon number *
-//* isosym = index of the isospin reversed (t_z --> -t_z) *
-//* particle (if any, if 0 no such particle is available*
-//* in the part listing) *
-//* ichcon = index of the charge conjugated (antiparticle) *
-//* particle (if any, if 0 no such particle is available*
-//* in the part listing) *
-//* k1 = index of first decay channel *
-//* k2 = index of last decay channel *
-//* kptoip = conversion from part to paprop numbering *
-//* iptokp = conversion from paprop to part numbering *
-//* kptoia = conversion from part to abltis numbering *
-//* iatokp = conversion from abltis to part numbering *
-//* idcflg = decay flag *
-//* iptype = particle type *
-//* -1: heavy fragments *
-//* 0: unknown particle or lepton *
-//* 1: nucleon *
-//* 2: antinucleon *
-//* 3: pion *
-//* 4: k+/k0 *
-//* -4: kshrt/klong *
-//* 5: k-/k0bar *
-//* 6: lamda/sigma (strangeness -1 hyperon) *
-//* 7: xsi (strangeness -2 hyperon) *
-//* 8: omega (strangeness -3 hyperon) *
-//* 9: alamda/asigma (strangeness +1 antihyperon) *
-//* 10: axsi (strangeness +2 antihyperon) *
-//* 11: aomega (strangeness +3 antihyperon) *
-//* 12: d+/d0 *
-//* 13: d-/d0bar *
-//* 14: d_s+/d_s- *
-//* 15: lambda_c+ *
-//* 16: xsi_c+/xsi_c0 *
-//* 17: xsi'_c+/xsi'_c0 *
-//* 18: omega_c *
-//* 19: alambda_c+ *
-//* 20: axsi_c-/axsi_c0 *
-//* 21: axsi'_c-/axsi'_c0 *
-//* 22: aomega_c *
-//* aname = particle literal name *
-//* *
-//*----------------------------------------------------------------------*
-//*
-
-typedef struct {
- Double_t am[idmaxp+7];
- Double_t ga[idmaxp+7];
- Double_t tau[idmaxp+7];
- Double_t amdisc[idmaxp+7];
- Double_t zmnabs[idmaxp+7];
- Double_t atnmna[idmaxp+7];
- Int_t ich[idmaxp+7];
- Int_t ibar[idmaxp+7];
- Int_t isosym[idmaxp+7];
- Int_t ichcon[idmaxp+7];
- Int_t k1[idmaxp+7];
- Int_t k2[idmaxp+7];
- Int_t kptoip[idmaxp+7];
- Int_t iptokp[nallwp+7];
- Int_t kptoia[idmaxp+7];
- Int_t iatokp[mxpabl+7];
- Int_t idcflg[nallwp+7];
- Int_t iptype[nallwp+7];
-} partCommon;
-#define PART COMMON_BLOCK(PART,part)
-COMMON_BLOCK_DEF(partCommon,PART);
-
-typedef struct {
- Char_t aname[idmaxp+7][8];
-} chpartCommon;
-#define CHPART COMMON_BLOCK(CHPART,chpart)
-COMMON_BLOCK_DEF(chpartCommon,CHPART);
-}
-
-//Get functions
-inline Double_t GetFlukaAM(unsigned int i) {return PART.am[i+6];}
-inline Double_t GetFlukaGA(unsigned int i) {return PART.ga[i+6];}
-inline Double_t GetFlukaTAU(unsigned int i) {return PART.tau[i+6];}
-inline Double_t GetFlukaAMDISC(unsigned int i) {return PART.amdisc[i+6];}
-inline Double_t GetFlukaZMNABS(unsigned int i) {return PART.zmnabs[i+6];}
-inline Double_t GetFlukaATNMNA(unsigned int i) {return PART.atnmna[i+6];}
-inline Int_t GetFlukaICH(unsigned int i) {return PART.ich[i+6];}
-inline Int_t GetFlukaIBAR(unsigned int i) {return PART.ibar[i+6];}
-inline Int_t GetFlukaISOSYM(unsigned int i) {return PART.isosym[i+6];}
-inline Int_t GetFlukaICHCON(unsigned int i) {return PART.ichcon[i+6];}
-inline Int_t GetFlukaK1(unsigned int i) {return PART.k1[i+6];}
-inline Int_t GetFlukaK2(unsigned int i) {return PART.k2[i+6];}
-inline Int_t GetFlukaKPTOIP(unsigned int i) {return PART.kptoip[i+6];}
-inline Int_t GetFlukaIPTOKP(unsigned int i) {return PART.iptokp[i+6];}
-inline Int_t GetFlukaKPTOIA(unsigned int i) {return PART.kptoia[i+6];}
-inline Int_t GetFlukaIATOKP(unsigned int i) {return PART.iatokp[i+6];}
-inline Int_t GetFlukaIDCFLG(unsigned int i) {return PART.idcflg[i+6];}
-inline Int_t GetFlukaIPTYPE(unsigned int i) {return PART.iptype[i+6];}
-
-#endif
+++ /dev/null
-extern "C" {
-//*$ create scohlp.add
-//*copy scohlp
-//*
-//*=== scohlp ===========================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* Copyright (C) 1991-2005 by Alfredo Ferrari & Paola Sala *
-//* All Rights Reserved. *
-//* *
-//* *
-//* Created on 05 august 1991 by Alfredo Ferrari & Paola Sala *
-//* Infn - Milan *
-//* *
-//* Last change on 29-oct-94 by Alfredo Ferrari *
-//* *
-//* Energy/Star binnings/scorings (Comscw): *
-//* ISCRNG = 1 --> Energy density binning *
-//* ISCRNG = 2 --> Star density binning *
-//* ISCRNG = 3 --> Residual nuclei scoring *
-//* JSCRNG = # of the binning *
-//* Flux like binnings/estimators (Fluscw): *
-//* ISCRNG = 1 --> Boundary crossing estimator *
-//* ISCRNG = 2 --> Track length binning *
-//* ISCRNG = 3 --> Track length estimator *
-//* ISCRNG = 4 --> Collision density estimator *
-//* ISCRNG = 5 --> Yield estimator *
-//* JSCRNG = # of the binning/estimator *
-//* *
-//*----------------------------------------------------------------------*
-
-typedef struct {
- Int_t iscrng;
- Int_t jscrng;
- Int_t lsczer;
-} scohlpCommon;
-#define SCOHLP COMMON_BLOCK(SCOHLP,scohlp)
-COMMON_BLOCK_DEF(scohlpCommon,SCOHLP);
-}
+++ /dev/null
-#include "cfortran.h"
-#include "Rtypes.h"
-
-#include "Fdimpar.h"
-
-extern "C" {
-//*$ create souevt.add
-//*copy souevt
-
-//*=== Souevt ===========================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* Copyright (C) 1996-2005 by Alfredo Ferrari & Paola Sala *
-//* All Rights Reserved. *
-//* *
-//* *
-//* SOUrce EVenT: *
-//* *
-//* Created on 14 november 1996 by Alfredo Ferrari & Paola Sala *
-//* Infn - Milan *
-//* *
-//* Last change on 16-mar-98 by Alfredo Ferrari *
-//* *
-//* X,Y,Zsoevt(i) = position of the i_th source particle *
-//* TX,Y,Zsoev(i) = direction of the i_th source particle *
-//* Wtsoev(i) = weight of the i_th source particle *
-//* Pmsoev(i) = momentum of the i_th source particle *
-//* Tksoev(i) = kin. energy of the i_th source particle *
-//* Agsoev(i) = age of the i_th source particle *
-//* Aksoev(i) = Kaon ampl. of the i_th source particle *
-//* Ussoev(j,i) = user var. of the i_th source particle *
-//* Ijsoev(i) = identity of the i_th source particle *
-//* Nrsoev(i) = region of the i_th source particle *
-//* Nlsoev(i) = lattice of the i_th source particle *
-//* Losoev(i) = user flag of the i_th source particle *
-//* Iusoev(j,i) = user flags of the i_th source particle *
-//* Npsoev = number of the source particles *
-//* *
-//*----------------------------------------------------------------------*
-
-const Int_t mxsoev = 100;
-
-typedef struct {
- Double_t xsoevt[mxsoev];
- Double_t ysoevt[mxsoev];
- Double_t zsoevt[mxsoev];
- Double_t txsoev[mxsoev];
- Double_t tysoev[mxsoev];
- Double_t tzsoev[mxsoev];
- Double_t txpsov[mxsoev];
- Double_t typsov[mxsoev];
- Double_t tzpsov[mxsoev];
- Double_t wtsoev[mxsoev];
- Double_t pmsoev[mxsoev];
- Double_t tksoev[mxsoev];
- Double_t agsoev[mxsoev];
- Double_t aksoev[mxsoev];
- Double_t ussoev[mkbmx1][mxsoev];
- Int_t ijsoev[mxsoev];
- Int_t nrsoev[mxsoev];
- Int_t nlsoev[mxsoev];
- Int_t losoev[mxsoev];
- Int_t iusoevo[mkbmx2][mxsoev];
- Int_t npsoev;
-
-} souevtCommon;
-#define SOUEVT COMMON_BLOCK(SOUEVT,souevt)
-COMMON_BLOCK_DEF(souevtCommon,SOUEVT);
-}
+++ /dev/null
-#ifndef FSOURCM_H
-#define FSOURCM_H 1
-
-#include "Rtypes.h"
-#include "cfortran.h"
-extern "C" {
-//*$ create sourcm.add
-//*copy sourcm
-//*
-//*=== Sourcm ===========================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* Include file: sourcm *
-//* *
-//* version march 1996 by Alfredo Ferrari, INFN - Milan *
-//* *
-//* Last change on 09-mar-02 by Alfredo Ferrari *
-//* *
-//* Included in the following subroutines or functions: *
-//* *
-//* BDNOPT *
-//* FLKEND *
-//* EVTDAT *
-//* FEEDER *
-//* FLUKAM *
-//* MGDRAW *
-//* SOURCE *
-//* *
-//* *
-//* Whasou(1-18) = user variables *
-//* Tkesum = total kinetic energy of the primaries of the *
-//* user written source *
-//* Lussrc = flag to inform that the user written source was *
-//* used *
-//* Sdusou = user character variable *
-//* Lsouit = source is called iteratively until it is .true. *
-//* *
-//*----------------------------------------------------------------------*
-//*
-
-typedef struct {
- Double_t whasou[18];
- Double_t tkesum;
- Int_t lussrc;
- Int_t lsouit;
-} sourcmCommon;
-#define SOURCM COMMON_BLOCK(SOURCM,sourcm)
-COMMON_BLOCK_DEF(sourcmCommon,SOURCM);
-
-typedef struct {
- Char_t sdusou[8];
-} chsocmCommon;
-#define CHSOCM COMMON_BLOCK(CHSOCM,chsocm)
-COMMON_BLOCK_DEF(chsocmCommon,CHSOCM);
-
-typedef struct {
- Double_t xn[3];
- Double_t wn[3];
- Double_t distn;
- Int_t irltno;
- Int_t irrnor;
-} norlatCommon;
-#define NORLAT COMMON_BLOCK(NORLAT,norlat)
-COMMON_BLOCK_DEF(norlatCommon,NORLAT);
-
-typedef struct {
- Double_t xb[3];
- Double_t wb[3];
- Double_t wp[3];
- Double_t xp[3];
- Double_t rin;
- Double_t rout;
- Double_t pinf;
- Double_t dist;
- Int_t ir;
- Int_t idbg;
- Int_t irprim;
- Int_t nasc;
- Int_t lsurf;
- Int_t nbo;
- Int_t lri;
- Int_t lro;
- Int_t kloop;
- Int_t loop;
- Int_t itype;
- Int_t n0a;
-} paremCommon;
-#define PAREM COMMON_BLOCK(PAREM,parem)
-COMMON_BLOCK_DEF(paremCommon,PAREM);
-}
-
-#endif
+++ /dev/null
-#include "Fdimpar.h"
-extern "C" {
-/*
-*$ CREATE STEPSZ.ADD
-*COPY STEPSZ
-*
-*=== stepsz ===========================================================*
-*
-*----------------------------------------------------------------------*
-* *
-* Common stepsz for setting the minimum and maximum step sizes on a *
-* a region by region basis: very useful for vacuum re- *
-* gions with magnetic filed and for saving time ( and *
-* accuracy ) with the new plc and lca algorithm in *
-* Emf and Fluka *
-* *
-* W A R N I N G !!!!! At the moment implemented only for *
-* electron and positron transport in Emf and for charged *
-* particles transport in Fluka with the new multiple scat- *
-* tering module!!!!!! *
-* *
-* created by A. Ferrari & P. Sala on 14-jan-1990 *
-* *
-* included in: *
-* fiprou *
-* flukam (main) *
-* kashea *
-* kaskad *
-* electr (new version) *
-* mageas *
-* magnew *
-* zeroin *
-* *
-* Stepmn = minimum step size (cm) *
-* Stepmx = maximum step size (cm) *
-* Mxxrgn = maximum number of regions *
-* *
-*----------------------------------------------------------------------*
-*/
-
-// COMMON / STEPSZ / STEPMN ( MXXRGN ), STEPMX ( MXXRGN )
-typedef struct {
- Double_t stepmn[mxxrgn];
- Double_t stepmx[mxxrgn];
-} stepszCommon;
-
-#define STEPSZ COMMON_BLOCK(STEPSZ,stepsz)
-COMMON_BLOCK_DEF(stepszCommon,STEPSZ);
-
-}
-
+++ /dev/null
-#ifndef FSUMCOU_H
-#define FSUMCOU_H 1
-
-#include "cfortran.h"
-#include "Rtypes.h"
-
-#include "Fdimpar.h"
-
-extern "C" {
-//*=== Sumcou ===========================================================*
-//*
-//*----------------------------------------------------------------------*
-//* *
-//* All additions wrt the original one are: *
-//* Copyright (C) 2005-2005 by Alfredo Ferrari & Paola Sala *
-//* All Rights Reserved. *
-//* *
-//* *
-//* SUMmary COUnters common for FLUKA9x/200x: *
-//* *
-//* (New version of the original STARS comon) *
-//* *
-//* *
-//* Created on 15 may 1990 by Alfredo Ferrari & Paola Sala *
-//* Infn - Milan *
-//* *
-//* Last change on 09-jul-05 by Alfredo Ferrari *
-//* *
-//* *
-//* Variable description: *
-//* *
-//* Ntstar = total number of stars generated (modulo 1000000000) *
-//* Neulow = total number of low energy neutron interactions *
-//* (modulo 1000000000) *
-//* Numdec = total number of decays (modulo 1000000000) *
-//* Numoph = total number of optical photons generated *
-//* (modulo 1000000000) *
-//* Mtstar = total number of stars generated / 100000000 *
-//* Meulow = total number of low energy neutron interactions *
-//* / 1000000000 *
-//* Mumdec = total number of decays / 1000000000 *
-//* Mumoph = total number of optical photons generated /1000000000*
-//* Wneulw(k,j) = total weight of the low energy neutron interactions *
-//* Woptph(k,j) = total weight of generated optical photons *
-//* Westar(k,j) = weight of the stars generated by *
-//* different particle types *
-//* Westop(k,j) = weight of particles of different types stopped *
-//* Wedaug(k,j) = weight of the decay products *
-//* Wekill(k,j) = weight of the time-killed particles *
-//* Wedecy(k,j) = weight of the particles decayed *
-//* Weifis(k,j) = weight of high energy fissions generated by particles*
-//* of different kind *
-//* Deccts(k,j) = decay c tau scoring *
-//* Wdecct(k,j) = weight of the particles decayed for which a c tau *
-//* scoring is done *
-//* Weprdc(k,j) = weight of produced particles of different kind *
-//* Wlwnsc(k,j) = weight of the low energy neutrons interaction secon- *
-//* daries *
-//* Wophsc(k,j) = weight of optical photons production/interaction *
-//* secondaries *
-//* Weipri = total weight of the primaries handled *
-//* Edpsco(i,j) = energy deposition scoring (j = 1: prompt particles, *
-//* j = 2: decay particles) *
-//* Edpsco(1,j) = by ionisation *
-//* Edpsco(2,j) = by pi-zeros and/or EM cascade *
-//* Edpsco(3,j) = by nuclear excitation (or nuclear recoil *
-//* and heavies if the evaporation module is *
-//* activated) *
-//* Edpsco(4,j) = by stopped particles *
-//* Edpsco(5,j) = energy leaving the system *
-//* Edpsco(6,j) = energy carried by discarded particles *
-//* Edpsco(7,j) = by residual excitation energy (only if the *
-//* evaporation module is activated) *
-//* Edpsco(8,j) = by low energy neutrons (kerma due to low *
-//* energy neutrons transport is in effect) *
-//* Edpsco(9,j) = energy carried by time killed particles *
-//* Edpsco(10,j)= energy wasted for nuclear binding energy *
-//* effects for (low energy neutrons excluded) *
-//* Edpsco(11,j)= energy wasted for nuclear binding energy *
-//* effects for low energy neutrons *
-//* *
-//*----------------------------------------------------------------------*
-//*
-
-typedef struct {
- Double_t westar[2][nallwp+7];
- Double_t westop[2][nallwp+7];
- Double_t wedaug[2][nallwp+7];
- Double_t wekill[2][nallwp+7];
- Double_t wedecy[2][nallwp+7];
- Double_t weifis[2][nallwp+7];
- Double_t deccts[2][nallwp+7];
- Double_t wdecct[2][nallwp+7];
- Double_t weprdc[2][nallwp+7];
- Double_t wlwnsc[2][4];
- Double_t wophsc[2][4];
- Double_t edpsco[2][11];
- Double_t woptph;
- Double_t wneulw;
- Double_t weipri;
- Int_t numdec;
- Int_t ntstar;
- Int_t neulow;
- Int_t numoph;
- Int_t mumdec;
- Int_t mtstar;
- Int_t meulow;
- Int_t mumoph;
-} sumcouCommon;
-#define SUMCOU COMMON_BLOCK(SUMCOU,sumcou)
-COMMON_BLOCK_DEF(sumcouCommon,SUMCOU);
-}
-
-#endif
+++ /dev/null
-#include "cfortran.h"
-#include "Rtypes.h"
-
-#include "Fdimpar.h"
-
-extern "C" {
-//*$ create trackr.add
-//*copy trackr
-//* *
-//*=== trackr ===========================================================*
-//* *
-//*----------------------------------------------------------------------*
-//* *
-//* tracks recording by alfredo ferrari, infn - milan *
-//* *
-//* last change 31 january 2001 by alfredo ferrari *
-//* *
-//* included in : *
-//* electr *
-//* emfsco *
-//* kaskad (new version) *
-//* kashea *
-//* kasneu *
-//* geoden (new version) *
-//* mageas *
-//* magmov *
-//* magnew *
-//* move *
-//* photon *
-//* usrsco *
-//* *
-//* ntrack = number of track segments *
-//* mtrack = number of energy deposition events along the track *
-//* 0 < i < ntrack *
-//* xtrack = end x-point of the ith track segment *
-//* ytrack = end y-point of the ith track segment *
-//* ztrack = end z-point of the ith track segment *
-//* 1 < i < ntrack *
-//* ttrack = length of the ith track segment *
-//* 1 < j < mtrack *
-//* dtrack = energy deposition of the jth deposition event *
-//* dptrck = momentum loss of the jth deposition event *
-//* *
-//* Jtrack = identity number of the particle: for recoils or *
-//* kerma deposition it can be outside the allowed *
-//* particle id range, assuming values like: *
-//* 208: "heavy" recoil *
-//* 211: EM below threshold *
-//* 308: low energy neutron kerma *
-//* in those cases the id of the particle originating *
-//* the interaction is saved inside J0trck (which othe-*
-//* rwise is zero) *
-//* J0trck = see above *
-//* Ifltrk = flag used for internal debugging (trying to solve *
-//* possible residual issues with Mgdraw driven *
-//* quenching) *
-//* etrack = total energy of the particle *
-//* ptrack = momentum of the particle (not always defined, if *
-//* < 0 must be obtained from etrack) *
-//* cx,y,ztrck = direction cosines of the current particle *
-//* cx,y,ztrpl = polarization cosines of the current particle *
-//* wtrack = weight of the particle *
-//* wscrng = scoring weight: it can differ from wtrack if some *
-//* biasing techniques are used (for example inelastic *
-//* interaction length biasing) *
-//* ctrack = total curved path *
-//* cmtrck = cumulative curved path since particle birth *
-//* zfftrk = <z_eff> of the particle *
-//* zfrttk = actual z_eff of the particle *
-//* atrack = age of the particle *
-//* akshrt = kshrt amplitude for k0/k0bar *
-//* aklong = klong amplitude for k0/k0bar *
-//* wninou = neutron algebraic balance of interactions (both *
-//* for "high" energy particles and "low" energy *
-//* neutrons) *
-//* spausr = user defined spare variables for the current *
-//* particle *
-//* sttrck = macroscopic total cross section for low energy *
-//* neutron collisions *
-//* satrck = macroscopic absorption cross section for low energy*
-//* neutron collisions (it can be negative for pnab>1) *
-//* ktrack = if > 0 neutron group of the particle (neutron) *
-//* *
-//* ntrack > 0, mtrack > 0 : energy loss distributed along the *
-//* track *
-//* ntrack > 0, mtrack = 0 : no energy loss along the track *
-//* ntrack = 0, mtrack = 0 : local energy deposition (the *
-//* value and the point are not re- *
-//* corded in trackr) *
-//* mmtrck = flag recording the material index for low energy *
-//* neutron collisions *
-//* lt1trk = initial lattice cell of the current track *
-//* (or lattice cell for a point energy deposition) *
-//* lt2trk = final lattice cell of the current track *
-//* ihspnt = current geometry history pointer (not set if -1) *
-//* ltrack = flag recording the generation number *
-//* llouse = user defined flag for the current particle *
-//* ispusr = user defined spare flags for the current particle *
-//* lfsssc = logical flag for inelastic interactions ending with*
-//* fission (used also for low energy neutrons) *
-//* *
-//*----------------------------------------------------------------------*
-//
-
-//
-// TFluka specific:
-// ispusr[mkbmx2 - 1] : track index in vmcstack
-// ispusr[mkbmx2 - 2] : flag for "interrupted" track
-//
-
-const Int_t mxtrck = 2500;
-
-typedef struct {
- Double_t xtrack[mxtrck+1];
- Double_t ytrack[mxtrck+1];
- Double_t ztrack[mxtrck+1];
- Double_t ttrack[mxtrck];
- Double_t dtrack[mxtrck];
- Double_t dptrck[mxtrck][3];
- Double_t etrack;
- Double_t ptrack;
- Double_t cxtrck;
- Double_t cytrck;
- Double_t cztrck;
- Double_t wtrack;
- Double_t cxtrpl;
- Double_t cytrpl;
- Double_t cztrpl;
- Double_t zfftrk;
- Double_t zfrttk;
- Double_t atrack;
- Double_t ctrack;
- Double_t cmtrck;
- Double_t akshrt;
- Double_t aklong;
- Double_t wscrng;
- Double_t wninou;
- Double_t spausr[mkbmx1];
- Double_t sttrck;
- Double_t satrck;
- Int_t ntrack;
- Int_t mtrack;
- Int_t ifltrk;
- Int_t jtrack;
- Int_t j0trck;
- Int_t ktrack;
- Int_t mmtrck;
- Int_t lt1trk;
- Int_t lt2trk;
- Int_t ihspnt;
- Int_t ltrack;
- Int_t llouse;
- Int_t ispusr[mkbmx2];
- Int_t lfsssc;
- Int_t lpkill;
-} trackrCommon;
-#define TRACKR COMMON_BLOCK(TRACKR,trackr)
-COMMON_BLOCK_DEF(trackrCommon,TRACKR);
-//static union { Double_t spause; Double_t spausr[0];};
-//static union { Int_t ispuse; Int_t ispusr[0];};
-}
+++ /dev/null
-#ifndef ROOT_TCallf77
-#define ROOT_TCallf77
-/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * See cxx source for full Copyright notice */
-
-/* $Id$ */
-
-#ifndef WIN32
-# define type_of_call
-# define DEFCHARD const char*
-# define DEFCHARL , const int
-# define PASSCHARD(string) string
-# define PASSCHARL(string) , strlen(string)
-#else
-# define type_of_call _stdcall
-# define DEFCHARD const char* , const int
-# define DEFCHARL
-# define PASSCHARD(string) string, strlen(string)
-# define PASSCHARL(string)
-#endif
-#define DEFCHARA DEFCHARD DEFCHARL
-#define PASSCHARA(string) PASSCHARD(string) PASSCHARL(string)
-#endif //ROOT_TCallf77
+++ /dev/null
-/**************************************************************************
- * Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * *
- * Author: The ALICE Off-line Project. *
- * Contributors are mentioned in the code where appropriate. *
- * *
- * Permission to use, copy, modify and distribute this software and its *
- * documentation strictly for non-commercial purposes is hereby granted *
- * without fee, provided that the above copyright notice appears in all *
- * copies and that both the copyright notice and this permission notice *
- * appear in the supporting documentation. The authors make no claims *
- * about the suitability of this software for any purpose. It is *
- * provided "as is" without express or implied warranty. *
- **************************************************************************/
-
-/* $Id$ */
-
-//
-// Realisation of the TVirtualMC interface for the FLUKA code
-// (See official web side http://www.fluka.org/).
-//
-// This implementation makes use of the TGeo geometry modeller.
-// User configuration is via automatic generation of FLUKA input cards.
-//
-// Authors:
-// A. Fasso
-// E. Futo
-// A. Gheata
-// A. Morsch
-//
-
-#include <Riostream.h>
-#include <TList.h>
-
-#include "TFluka.h"
-#include "TFlukaIon.h"
-#include "TFlukaCodes.h"
-#include "TCallf77.h" //For the fortran calls
-#include "Fdblprc.h" //(DBLPRC) fluka common
-#include "Fsourcm.h" //(SOURCM) fluka common
-#include "Fgenstk.h" //(GENSTK) fluka common
-#include "Fiounit.h" //(IOUNIT) fluka common
-#include "Fpaprop.h" //(PAPROP) fluka common
-#include "Fpart.h" //(PART) fluka common
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Fpaprop.h" //(PAPROP) fluka common
-#include "Ffheavy.h" //(FHEAVY) fluka common
-#include "Fopphst.h" //(OPPHST) fluka common
-#include "Fflkstk.h" //(FLKSTK) fluka common
-#include "Fstepsz.h" //(STEPSZ) fluka common
-#include "Fopphst.h" //(OPPHST) fluka common
-#include "Fltclcm.h" //(LTCLCM) fluka common
-#include "Falldlt.h" //(ALLDLT) fluka common
-
-#include "TVirtualMC.h"
-#include "TMCProcess.h"
-#include "TGeoManager.h"
-#include "TGeoMaterial.h"
-#include "TGeoMedium.h"
-#include "TFlukaMCGeometry.h"
-#include "TGeoMCGeometry.h"
-#include "TFlukaCerenkov.h"
-#include "TFlukaConfigOption.h"
-#include "TFlukaScoringOption.h"
-#include "TLorentzVector.h"
-#include "TArrayI.h"
-#include "TArrayD.h"
-#include "TDatabasePDG.h"
-#include "TStopwatch.h"
-
-
-// Fluka methods that may be needed.
-#ifndef WIN32
-# define flukam flukam_
-# define fluka_openinp fluka_openinp_
-# define fluka_openout fluka_openout_
-# define fluka_closeinp fluka_closeinp_
-# define mcihad mcihad_
-# define mpdgha mpdgha_
-# define newplo newplo_
-# define genout genout_
-# define flkend flkend_
-#else
-# define flukam FLUKAM
-# define fluka_openinp FLUKA_OPENINP
-# define fluka_openout FLUKA_OPENOUT
-# define fluka_closeinp FLUKA_CLOSEINP
-# define mcihad MCIHAD
-# define mpdgha MPDGHA
-# define newplo NEWPLO
-# define genout GENOUT
-# define flkend FLKEND
-#endif
-
-extern "C"
-{
- //
- // Prototypes for FLUKA functions
- //
- void type_of_call flukam(const int&);
- void type_of_call newplo();
- void type_of_call genout();
- void type_of_call flkend();
- void type_of_call fluka_openinp(const int&, DEFCHARA);
- void type_of_call fluka_openout(const int&, DEFCHARA);
- void type_of_call fluka_closeinp(const int&);
- int type_of_call mcihad(const int&);
- int type_of_call mpdgha(const int&);
-}
-
-//
-// Class implementation for ROOT
-//
-ClassImp(TFluka)
-
-//
-//----------------------------------------------------------------------------
-// TFluka constructors and destructors.
-//______________________________________________________________________________
-TFluka::TFluka()
- :TVirtualMC(),
- fVerbosityLevel(0),
- fNEvent(0),
- fInputFileName(""),
- fCoreInputFileName(""),
- fCaller(kNoCaller),
- fIcode(kNoProcess),
- fNewReg(-1),
- fRull(0),
- fXsco(0),
- fYsco(0),
- fZsco(0),
- fPItime(0),
- fPIlength(0),
- fNPI(0),
- fTrackIsEntering(kFALSE),
- fTrackIsExiting(kFALSE),
- fTrackIsNew(kFALSE),
- fFieldFlag(kTRUE),
- fDummyBoundary(kFALSE),
- fStopped(kFALSE),
- fStopEvent(kFALSE),
- fStopRun(kFALSE),
- fPrimaryElectronIndex(-1),
- fLowEnergyNeutronTransport(kFALSE),
- fMaterials(0),
- fNVolumes(0),
- fCurrentFlukaRegion(-1),
- fNCerenkov(0),
- fGeom(0),
- fMCGeo(0),
- fUserConfig(0),
- fUserScore(0),
- fUserIons(0)
-{
- //
- // Default constructor
- //
- for (Int_t i = 0; i < 4; i++) fPint[i] = 0.;
-}
-
-//______________________________________________________________________________
-TFluka::TFluka(const char *title, Int_t verbosity, Bool_t isRootGeometrySupported)
- :TVirtualMC("TFluka",title, isRootGeometrySupported),
- fVerbosityLevel(verbosity),
- fNEvent(0),
- fInputFileName(""),
- fCoreInputFileName(""),
- fCaller(kNoCaller),
- fIcode(kNoProcess),
- fNewReg(-1),
- fRull(0),
- fXsco(0),
- fYsco(0),
- fZsco(0),
- fPItime(0),
- fPIlength(0),
- fNPI(0),
- fTrackIsEntering(kFALSE),
- fTrackIsExiting(kFALSE),
- fTrackIsNew(kFALSE),
- fFieldFlag(kTRUE),
- fDummyBoundary(kFALSE),
- fStopped(kFALSE),
- fStopEvent(kFALSE),
- fStopRun(kFALSE),
- fPrimaryElectronIndex(-1),
- fLowEnergyNeutronTransport(kFALSE),
- fMaterials(0),
- fNVolumes(0),
- fCurrentFlukaRegion(-1),
- fNCerenkov(0),
- fGeom(0),
- fMCGeo(0),
- fUserConfig(new TObjArray(100)),
- fUserScore(new TObjArray(100)),
- fUserIons(0)
-{
- // create geometry interface
- for (Int_t i = 0; i < 4; i++) fPint[i] = 0.;
-
- if (fVerbosityLevel >=3)
- cout << "<== TFluka::TFluka(" << title << ") constructor called." << endl;
- SetCoreInputFileName();
- SetInputFileName();
- fMCGeo = new TGeoMCGeometry("MCGeo", "TGeo Implementation of VirtualMCGeometry", kFALSE);
- fGeom = new TFlukaMCGeometry("geom", "FLUKA VMC Geometry");
- if (verbosity > 2) fGeom->SetDebugMode(kTRUE);
- PrintHeader();
-}
-
-//______________________________________________________________________________
-TFluka::~TFluka()
-{
- // Destructor
- if (fVerbosityLevel >=3)
- cout << "<== TFluka::~TFluka() destructor called." << endl;
- if (fMaterials) delete [] fMaterials;
-
-// delete fGeom;
-// delete fMCGeo;
-
- if (fUserConfig) {
- fUserConfig->Delete();
- delete fUserConfig;
- }
-
- if (fUserScore) {
- fUserScore->Delete();
- delete fUserScore;
- }
-}
-
-//
-//______________________________________________________________________________
-// TFluka control methods
-//______________________________________________________________________________
-void TFluka::Init() {
-//
-// Geometry initialisation
-//
- if (fVerbosityLevel >=3) cout << "==> TFluka::Init() called." << endl;
-
- if (!gGeoManager) new TGeoManager("geom", "FLUKA geometry");
- fApplication->ConstructGeometry();
- if (!gGeoManager->IsClosed()) {
- TGeoVolume *top = (TGeoVolume*)gGeoManager->GetListOfVolumes()->First();
- gGeoManager->SetTopVolume(top);
- gGeoManager->CloseGeometry("di");
- } else {
- TGeoNodeCache *cache = gGeoManager->GetCache();
- if (!cache->HasIdArray()) {
- Warning("Init", "Node ID tracking must be enabled with TFluka: enabling...\n");
- cache->BuildIdArray();
- }
- }
- fNVolumes = fGeom->NofVolumes();
- fGeom->CreateFlukaMatFile("flukaMat.inp");
- if (fVerbosityLevel >=3) {
- printf("== Number of volumes: %i\n ==", fNVolumes);
- cout << "\t* InitPhysics() - Prepare input file to be called" << endl;
- }
-
- fApplication->InitGeometry();
- fApplication->ConstructOpGeometry();
- //
- // Add ions to PDG Data base
- //
- AddParticlesToPdgDataBase();
- fApplication->AddIons();
- //
-}
-
-
-//______________________________________________________________________________
-void TFluka::FinishGeometry() {
-//
-// Build-up table with region to medium correspondance
-//
- if (fVerbosityLevel >=3) {
- cout << "==> TFluka::FinishGeometry() called." << endl;
- printf("----FinishGeometry - applying misalignment if any\n");
- cout << "<== TFluka::FinishGeometry() called." << endl;
- }
- TVirtualMCApplication::Instance()->MisalignGeometry();
-}
-
-//______________________________________________________________________________
-void TFluka::BuildPhysics() {
-//
-// Prepare FLUKA input files and call FLUKA physics initialisation
-//
-
- if (fVerbosityLevel >=3)
- cout << "==> TFluka::BuildPhysics() called." << endl;
-
-
- if (fVerbosityLevel >=3) {
- TList *medlist = gGeoManager->GetListOfMedia();
- TIter next(medlist);
- TGeoMedium* med = 0x0;
- TGeoMaterial* mat = 0x0;
- Int_t ic = 0;
-
- while((med = (TGeoMedium*)next()))
- {
- mat = med->GetMaterial();
- printf("Medium %5d %12s %5d %5d\n", ic, (med->GetName()), med->GetId(), mat->GetIndex());
- ic++;
- }
- }
-
-
- // Prepare input file with the current physics settings
-
- InitPhysics();
-// Open fortran files
- const char* fname = fInputFileName;
- fluka_openinp(lunin, PASSCHARA(fname));
- fluka_openout(11, PASSCHARA("fluka.out"));
-// Read input cards
- cout << "==> TFluka::BuildPhysics() Read input cards." << endl;
- TStopwatch timer;
- timer.Start();
- GLOBAL.lfdrtr = true;
- flukam(1);
- cout << "<== TFluka::BuildPhysics() Read input cards End"
- << Form(" R:%.2fs C:%.2fs", timer.RealTime(),timer.CpuTime()) << endl;
-// Close input file
- fluka_closeinp(lunin);
-// Finish geometry
- FinishGeometry();
-}
-
-//______________________________________________________________________________
-void TFluka::ProcessEvent() {
-//
-// Process one event
-//
- if (fStopRun) {
- Warning("ProcessEvent", "User Run Abortion: No more events handled !\n");
- fNEvent += 1;
- return;
- }
-
- if (fVerbosityLevel >=3)
- cout << "==> TFluka::ProcessEvent() called." << endl;
- fApplication->GeneratePrimaries();
- SOURCM.lsouit = true;
- flukam(1);
- if (fVerbosityLevel >=3)
- cout << "<== TFluka::ProcessEvent() called." << endl;
- //
- // Increase event number
- //
- fNEvent += 1;
-}
-
-//______________________________________________________________________________
-Bool_t TFluka::ProcessRun(Int_t nevent) {
-//
-// Run steering
-//
-
- if (fVerbosityLevel >=3)
- cout << "==> TFluka::ProcessRun(" << nevent << ") called."
- << endl;
-
- if (fVerbosityLevel >=2) {
- cout << "\t* GLOBAL.fdrtr = " << (GLOBAL.lfdrtr?'T':'F') << endl;
- cout << "\t* Calling flukam again..." << endl;
- }
-
- Int_t todo = TMath::Abs(nevent);
- for (Int_t ev = 0; ev < todo; ev++) {
- TStopwatch timer;
- timer.Start();
- fApplication->BeginEvent();
- ProcessEvent();
- fApplication->FinishEvent();
- cout << "Event: "<< ev
- << Form(" R:%.2fs C:%.2fs", timer.RealTime(),timer.CpuTime()) << endl;
- }
-
- if (fVerbosityLevel >=3)
- cout << "<== TFluka::ProcessRun(" << nevent << ") called."
- << endl;
-
- // Write fluka specific scoring output
- genout();
- newplo();
- flkend();
-
- return kTRUE;
-}
-
-//_____________________________________________________________________________
-// methods for building/management of geometry
-
-// functions from GCONS
-//____________________________________________________________________________
-void TFluka::Gfmate(Int_t imat, char *name, Float_t &a, Float_t &z,
- Float_t &dens, Float_t &radl, Float_t &absl,
- Float_t* /*ubuf*/, Int_t& /*nbuf*/) {
-//
- TGeoMaterial *mat;
- TIter next (gGeoManager->GetListOfMaterials());
- while ((mat = (TGeoMaterial*)next())) {
- if (mat->GetUniqueID() == (UInt_t)imat) break;
- }
- if (!mat) {
- Error("Gfmate", "no material with index %i found", imat);
- return;
- }
- sprintf(name, "%s", mat->GetName());
- a = mat->GetA();
- z = mat->GetZ();
- dens = mat->GetDensity();
- radl = mat->GetRadLen();
- absl = mat->GetIntLen();
-}
-
-//______________________________________________________________________________
-void TFluka::Gfmate(Int_t imat, char *name, Double_t &a, Double_t &z,
- Double_t &dens, Double_t &radl, Double_t &absl,
- Double_t* /*ubuf*/, Int_t& /*nbuf*/) {
-//
- TGeoMaterial *mat;
- TIter next (gGeoManager->GetListOfMaterials());
- while ((mat = (TGeoMaterial*)next())) {
- if (mat->GetUniqueID() == (UInt_t)imat) break;
- }
- if (!mat) {
- Error("Gfmate", "no material with index %i found", imat);
- return;
- }
- sprintf(name, "%s", mat->GetName());
- a = mat->GetA();
- z = mat->GetZ();
- dens = mat->GetDensity();
- radl = mat->GetRadLen();
- absl = mat->GetIntLen();
-}
-
-// detector composition
-//______________________________________________________________________________
-void TFluka::Material(Int_t& kmat, const char* name, Double_t a,
- Double_t z, Double_t dens, Double_t radl, Double_t absl,
- Float_t* buf, Int_t nwbuf) {
-//
- Double_t* dbuf = fGeom->CreateDoubleArray(buf, nwbuf);
- Material(kmat, name, a, z, dens, radl, absl, dbuf, nwbuf);
- delete [] dbuf;
-}
-
-//______________________________________________________________________________
-void TFluka::Material(Int_t& kmat, const char* name, Double_t a,
- Double_t z, Double_t dens, Double_t radl, Double_t absl,
- Double_t* /*buf*/, Int_t /*nwbuf*/) {
-//
-// Define a material
- TGeoMaterial *mat;
- kmat = gGeoManager->GetListOfMaterials()->GetSize();
- if ((z-Int_t(z)) > 1E-3) {
- mat = fGeom->GetMakeWrongMaterial(z);
- if (mat) {
- mat->SetRadLen(radl,absl);
- mat->SetUniqueID(kmat);
- return;
- }
- }
- gGeoManager->Material(name, a, z, dens, kmat, radl, absl);
-}
-
-//______________________________________________________________________________
-void TFluka::Mixture(Int_t& kmat, const char *name, Float_t *a,
- Float_t *z, Double_t dens, Int_t nlmat, Float_t *wmat) {
-//
-// Define a material mixture
-//
- Double_t* da = fGeom->CreateDoubleArray(a, TMath::Abs(nlmat));
- Double_t* dz = fGeom->CreateDoubleArray(z, TMath::Abs(nlmat));
- Double_t* dwmat = fGeom->CreateDoubleArray(wmat, TMath::Abs(nlmat));
-
- Mixture(kmat, name, da, dz, dens, nlmat, dwmat);
- for (Int_t i=0; i<nlmat; i++) {
- a[i] = da[i]; z[i] = dz[i]; wmat[i] = dwmat[i];
- }
-
- delete [] da;
- delete [] dz;
- delete [] dwmat;
-}
-
-//______________________________________________________________________________
-void TFluka::Mixture(Int_t& kmat, const char *name, Double_t *a,
- Double_t *z, Double_t dens, Int_t nlmat, Double_t *wmat) {
-//
- // Defines mixture OR COMPOUND IMAT as composed by
- // THE BASIC NLMAT materials defined by arrays A,Z and WMAT
- //
- // If NLMAT > 0 then wmat contains the proportion by
- // weights of each basic material in the mixture.
- //
- // If nlmat < 0 then WMAT contains the number of atoms
- // of a given kind into the molecule of the COMPOUND
- // In this case, WMAT in output is changed to relative
- // weigths.
- //
- Int_t i,j;
- if (nlmat < 0) {
- nlmat = - nlmat;
- Double_t amol = 0;
- for (i=0;i<nlmat;i++) {
- amol += a[i]*wmat[i];
- }
- for (i=0;i<nlmat;i++) {
- wmat[i] *= a[i]/amol;
- }
- }
- kmat = gGeoManager->GetListOfMaterials()->GetSize();
- // Check if we have elements with fractional Z
- TGeoMaterial *mat = 0;
- TGeoMixture *mix = 0;
- Bool_t mixnew = kFALSE;
- for (i=0; i<nlmat; i++) {
- if (z[i]-Int_t(z[i]) < 1E-3) continue;
- // We have found an element with fractional Z -> loop mixtures to look for it
- for (j=0; j<kmat; j++) {
- mat = (TGeoMaterial*)gGeoManager->GetListOfMaterials()->At(j);
- if (!mat) break;
- if (!mat->IsMixture()) continue;
- mix = (TGeoMixture*)mat;
- if (TMath::Abs(z[i]-mix->GetZ()) >1E-3) continue;
- mixnew = kTRUE;
- break;
- }
- if (!mixnew) Warning("Mixture","%s : cannot find component %i with fractional Z=%f\n", name, i, z[i]);
- break;
- }
- if (mixnew) {
- Int_t nlmatnew = nlmat+mix->GetNelements()-1;
- Double_t *anew = new Double_t[nlmatnew];
- Double_t *znew = new Double_t[nlmatnew];
- Double_t *wmatnew = new Double_t[nlmatnew];
- Int_t ind=0;
- for (j=0; j<nlmat; j++) {
- if (j==i) continue;
- anew[ind] = a[j];
- znew[ind] = z[j];
- wmatnew[ind] = wmat[j];
- ind++;
- }
- for (j=0; j<mix->GetNelements(); j++) {
- anew[ind] = mix->GetAmixt()[j];
- znew[ind] = mix->GetZmixt()[j];
- wmatnew[ind] = wmat[i]*mix->GetWmixt()[j];
- ind++;
- }
- Mixture(kmat, name, anew, znew, dens, nlmatnew, wmatnew);
- delete [] anew;
- delete [] znew;
- delete [] wmatnew;
- return;
- }
- // Now we need to compact identical elements within the mixture
- // First check if this happens
- mixnew = kFALSE;
- for (i=0; i<nlmat-1; i++) {
- for (j=i+1; j<nlmat; j++) {
- if (z[i] == z[j]) {
- mixnew = kTRUE;
- break;
- }
- }
- if (mixnew) break;
- }
- if (mixnew) {
- Int_t nlmatnew = 0;
- Double_t *anew = new Double_t[nlmat];
- Double_t *znew = new Double_t[nlmat];
- memset(znew, 0, nlmat*sizeof(Double_t));
- Double_t *wmatnew = new Double_t[nlmat];
- Bool_t skipi;
- for (i=0; i<nlmat; i++) {
- skipi = kFALSE;
- for (j=0; j<nlmatnew; j++) {
- if (z[i] == z[j]) {
- wmatnew[j] += wmat[i];
- skipi = kTRUE;
- break;
- }
- }
- if (skipi) continue;
- anew[nlmatnew] = a[i];
- znew[nlmatnew] = z[i];
- wmatnew[nlmatnew] = wmat[i];
- nlmatnew++;
- }
- Mixture(kmat, name, anew, znew, dens, nlmatnew, wmatnew);
- delete [] anew;
- delete [] znew;
- delete [] wmatnew;
- return;
- }
- gGeoManager->Mixture(name, a, z, dens, nlmat, wmat, kmat);
-}
-
-//______________________________________________________________________________
-void TFluka::Medium(Int_t& kmed, const char *name, Int_t nmat,
- Int_t isvol, Int_t ifield, Double_t fieldm, Double_t tmaxfd,
- Double_t stemax, Double_t deemax, Double_t epsil,
- Double_t stmin, Float_t* ubuf, Int_t nbuf) {
- // Define a medium
- //
- kmed = gGeoManager->GetListOfMedia()->GetSize()+1;
- fMCGeo->Medium(kmed, name, nmat, isvol, ifield, fieldm, tmaxfd, stemax, deemax,
- epsil, stmin, ubuf, nbuf);
-}
-
-//______________________________________________________________________________
-void TFluka::Medium(Int_t& kmed, const char *name, Int_t nmat,
- Int_t isvol, Int_t ifield, Double_t fieldm, Double_t tmaxfd,
- Double_t stemax, Double_t deemax, Double_t epsil,
- Double_t stmin, Double_t* ubuf, Int_t nbuf) {
- // Define a medium
- //
- kmed = gGeoManager->GetListOfMedia()->GetSize()+1;
- fMCGeo->Medium(kmed, name, nmat, isvol, ifield, fieldm, tmaxfd, stemax, deemax,
- epsil, stmin, ubuf, nbuf);
-}
-
-//______________________________________________________________________________
-void TFluka::Matrix(Int_t& krot, Double_t thetaX, Double_t phiX,
- Double_t thetaY, Double_t phiY, Double_t thetaZ,
- Double_t phiZ) {
-//
- krot = gGeoManager->GetListOfMatrices()->GetEntriesFast();
- fMCGeo->Matrix(krot, thetaX, phiX, thetaY, phiY, thetaZ, phiZ);
-}
-
-//______________________________________________________________________________
-void TFluka::Gstpar(Int_t itmed, const char* param, Double_t parval) {
-//
-//
-//
- Bool_t process = kFALSE;
- Bool_t modelp = kFALSE;
-
- if (strncmp(param, "DCAY", 4) == 0 ||
- strncmp(param, "PAIR", 4) == 0 ||
- strncmp(param, "COMP", 4) == 0 ||
- strncmp(param, "PHOT", 4) == 0 ||
- strncmp(param, "PFIS", 4) == 0 ||
- strncmp(param, "DRAY", 4) == 0 ||
- strncmp(param, "ANNI", 4) == 0 ||
- strncmp(param, "BREM", 4) == 0 ||
- strncmp(param, "MUNU", 4) == 0 ||
- strncmp(param, "CKOV", 4) == 0 ||
- strncmp(param, "HADR", 4) == 0 ||
- strncmp(param, "LOSS", 4) == 0 ||
- strncmp(param, "MULS", 4) == 0 ||
- strncmp(param, "RAYL", 4) == 0 ||
- strncmp(param, "STRA", 4) == 0)
- {
- process = kTRUE;
- }
-
- if (strncmp(param, "PRIMIO_N", 8) == 0 ||
- strncmp(param, "PRIMIO_E", 8) == 0)
- {
- modelp = kTRUE;
- }
-
- if (process) {
- // Process switch
- SetProcess(param, Int_t (parval), itmed);
- } else if (modelp) {
- // Model parameters
- SetModelParameter(param, parval, itmed);
- } else {
- // Cuts
- SetCut(param, parval, itmed);
- }
-
-
-}
-
-// functions from GGEOM
-//_____________________________________________________________________________
-void TFluka::Gsatt(const char *name, const char *att, Int_t val)
-{
- // Set visualisation attributes for one volume
- char vname[5];
- fGeom->Vname(name,vname);
- char vatt[5];
- fGeom->Vname(att,vatt);
- gGeoManager->SetVolumeAttribute(vname, vatt, val);
-}
-
-//______________________________________________________________________________
-Int_t TFluka::Gsvolu(const char *name, const char *shape, Int_t nmed,
- Float_t *upar, Int_t np) {
-//
- return fMCGeo->Gsvolu(name, shape, nmed, upar, np);
-}
-
-//______________________________________________________________________________
-Int_t TFluka::Gsvolu(const char *name, const char *shape, Int_t nmed,
- Double_t *upar, Int_t np) {
-//
- return fMCGeo->Gsvolu(name, shape, nmed, upar, np);
-}
-
-//______________________________________________________________________________
-void TFluka::Gsdvn(const char *name, const char *mother, Int_t ndiv,
- Int_t iaxis) {
-//
- fMCGeo->Gsdvn(name, mother, ndiv, iaxis);
-}
-
-//______________________________________________________________________________
-void TFluka::Gsdvn2(const char *name, const char *mother, Int_t ndiv,
- Int_t iaxis, Double_t c0i, Int_t numed) {
-//
- fMCGeo->Gsdvn2(name, mother, ndiv, iaxis, c0i, numed);
-}
-
-//______________________________________________________________________________
-void TFluka::Gsdvt(const char *name, const char *mother, Double_t step,
- Int_t iaxis, Int_t numed, Int_t ndvmx) {
-//
- fMCGeo->Gsdvt(name, mother, step, iaxis, numed, ndvmx);
-}
-
-//______________________________________________________________________________
-void TFluka::Gsdvt2(const char *name, const char *mother, Double_t step,
- Int_t iaxis, Double_t c0, Int_t numed, Int_t ndvmx) {
-//
- fMCGeo->Gsdvt2(name, mother, step, iaxis, c0, numed, ndvmx);
-}
-
-//______________________________________________________________________________
-void TFluka::Gsord(const char * /*name*/, Int_t /*iax*/) {
-//
-// Nothing to do with TGeo
-}
-
-//______________________________________________________________________________
-void TFluka::Gspos(const char *name, Int_t nr, const char *mother,
- Double_t x, Double_t y, Double_t z, Int_t irot,
- const char *konly) {
-//
- fMCGeo->Gspos(name, nr, mother, x, y, z, irot, konly);
-}
-
-//______________________________________________________________________________
-void TFluka::Gsposp(const char *name, Int_t nr, const char *mother,
- Double_t x, Double_t y, Double_t z, Int_t irot,
- const char *konly, Float_t *upar, Int_t np) {
- //
- fMCGeo->Gsposp(name, nr, mother, x, y, z, irot, konly, upar, np);
-}
-
-//______________________________________________________________________________
-void TFluka::Gsposp(const char *name, Int_t nr, const char *mother,
- Double_t x, Double_t y, Double_t z, Int_t irot,
- const char *konly, Double_t *upar, Int_t np) {
- //
- fMCGeo->Gsposp(name, nr, mother, x, y, z, irot, konly, upar, np);
-}
-
-//______________________________________________________________________________
-void TFluka::Gsbool(const char* /*onlyVolName*/, const char* /*manyVolName*/) {
-//
-// Nothing to do with TGeo
-}
-
-//______________________________________________________________________
-Bool_t TFluka::GetTransformation(const TString &volumePath,TGeoHMatrix &mat)
-{
- // Returns the Transformation matrix between the volume specified
- // by the path volumePath and the Top or mater volume. The format
- // of the path volumePath is as follows (assuming ALIC is the Top volume)
- // "/ALIC_1/DDIP_1/S05I_2/S05H_1/S05G_3". Here ALIC is the top most
- // or master volume which has only 1 instance of. Of all of the daughter
- // volumes of ALICE, DDIP volume copy #1 is indicated. Similarly for
- // the daughter volume of DDIP is S05I copy #2 and so on.
- // Inputs:
- // TString& volumePath The volume path to the specific volume
- // for which you want the matrix. Volume name
- // hierarchy is separated by "/" while the
- // copy number is appended using a "_".
- // Outputs:
- // TGeoHMatrix &mat A matrix with its values set to those
- // appropriate to the Local to Master transformation
- // Return:
- // A logical value if kFALSE then an error occurred and no change to
- // mat was made.
-
- // We have to preserve the modeler state
- return fMCGeo->GetTransformation(volumePath, mat);
-}
-
-//______________________________________________________________________
-Bool_t TFluka::GetShape(const TString &volumePath,TString &shapeType,
- TArrayD &par)
-{
- // Returns the shape and its parameters for the volume specified
- // by volumeName.
- // Inputs:
- // TString& volumeName The volume name
- // Outputs:
- // TString &shapeType Shape type
- // TArrayD &par A TArrayD of parameters with all of the
- // parameters of the specified shape.
- // Return:
- // A logical indicating whether there was an error in getting this
- // information
- return fMCGeo->GetShape(volumePath, shapeType, par);
-}
-
-//______________________________________________________________________
-Bool_t TFluka::GetMaterial(const TString &volumeName,
- TString &name,Int_t &imat,
- Double_t &a,Double_t &z,Double_t &dens,
- Double_t &radl,Double_t &inter,TArrayD &par)
-{
- // Returns the Material and its parameters for the volume specified
- // by volumeName.
- // Note, Geant3 stores and uses mixtures as an element with an effective
- // Z and A. Consequently, if the parameter Z is not integer, then
- // this material represents some sort of mixture.
- // Inputs:
- // TString& volumeName The volume name
- // Outputs:
- // TSrting &name Material name
- // Int_t &imat Material index number
- // Double_t &a Average Atomic mass of material
- // Double_t &z Average Atomic number of material
- // Double_t &dens Density of material [g/cm^3]
- // Double_t &radl Average radiation length of material [cm]
- // Double_t &inter Average interaction length of material [cm]
- // TArrayD &par A TArrayD of user defined parameters.
- // Return:
- // kTRUE if no errors
- return fMCGeo->GetMaterial(volumeName,name,imat,a,z,dens,radl,inter,par);
-}
-
-//______________________________________________________________________
-Bool_t TFluka::GetMedium(const TString &volumeName,TString &name,
- Int_t &imed,Int_t &nmat,Int_t &isvol,Int_t &ifield,
- Double_t &fieldm,Double_t &tmaxfd,Double_t &stemax,
- Double_t &deemax,Double_t &epsil, Double_t &stmin,
- TArrayD &par)
-{
- // Returns the Medium and its parameters for the volume specified
- // by volumeName.
- // Inputs:
- // TString& volumeName The volume name.
- // Outputs:
- // TString &name Medium name
- // Int_t &nmat Material number defined for this medium
- // Int_t &imed The medium index number
- // Int_t &isvol volume number defined for this medium
- // Int_t &iflield Magnetic field flag
- // Double_t &fieldm Magnetic field strength
- // Double_t &tmaxfd Maximum angle of deflection per step
- // Double_t &stemax Maximum step size
- // Double_t &deemax Maximum fraction of energy allowed to be lost
- // to continuous process.
- // Double_t &epsil Boundary crossing precision
- // Double_t &stmin Minimum step size allowed
- // TArrayD &par A TArrayD of user parameters with all of the
- // parameters of the specified medium.
- // Return:
- // kTRUE if there where no errors
- return fMCGeo->GetMedium(volumeName,name,imed,nmat,isvol,ifield,fieldm,tmaxfd,stemax,deemax,epsil,stmin,par);
-}
-
-//______________________________________________________________________________
-void TFluka::SetCerenkov(Int_t itmed, Int_t npckov, Float_t* ppckov,
- Float_t* absco, Float_t* effic, Float_t* rindex) {
-//
-// Set Cerenkov properties for medium itmed
-//
-// npckov: number of sampling points
-// ppckov: energy values
-// absco: absorption length
-// effic: quantum efficiency
-// rindex: refraction index
-//
-//
-//
-// Create object holding Cerenkov properties
-//
-
- TFlukaCerenkov* cerenkovProperties = new TFlukaCerenkov(npckov, ppckov, absco, effic, rindex);
-//
-// Pass object to medium
- TGeoMedium* medium = gGeoManager->GetMedium(itmed);
- medium->SetCerenkovProperties(cerenkovProperties);
-}
-
-void TFluka::SetCerenkov(Int_t itmed, Int_t npckov, Float_t* ppckov,
- Float_t* absco, Float_t* effic, Float_t* rindex, Float_t* rfl) {
-//
-// Set Cerenkov properties for medium itmed
-//
-// npckov: number of sampling points
-// ppckov: energy values
-// absco: absorption length
-// effic: quantum efficiency
-// rindex: refraction index
-// rfl: reflectivity for boundary to medium itmed
-//
-//
-// Create object holding Cerenkov properties
-//
- TFlukaCerenkov* cerenkovProperties = new TFlukaCerenkov(npckov, ppckov, absco, effic, rindex, rfl);
-//
-// Pass object to medium
- TGeoMedium* medium = gGeoManager->GetMedium(itmed);
- medium->SetCerenkovProperties(cerenkovProperties);
-}
-
-
-//______________________________________________________________________________
-void TFluka::SetCerenkov(Int_t itmed, Int_t npckov, Double_t *ppckov,
- Double_t *absco, Double_t *effic, Double_t *rindex) {
-//
-// Set Cerenkov properties for medium itmed
-//
-// npckov: number of sampling points
-// ppckov: energy values
-// absco: absorption length
-// effic: quantum efficiency
-// rindex: refraction index
-//
-
-//
-// Double_t version
- Float_t* fppckov = CreateFloatArray(ppckov, npckov);
- Float_t* fabsco = CreateFloatArray(absco, npckov);
- Float_t* feffic = CreateFloatArray(effic, npckov);
- Float_t* frindex = CreateFloatArray(rindex, npckov);
-
- SetCerenkov(itmed, npckov, fppckov, fabsco, feffic, frindex);
-
- delete [] fppckov;
- delete [] fabsco;
- delete [] feffic;
- delete [] frindex;
-}
-
-void TFluka::SetCerenkov(Int_t itmed, Int_t npckov, Double_t* ppckov,
- Double_t* absco, Double_t* effic, Double_t* rindex, Double_t* rfl) {
-//
-// Set Cerenkov properties for medium itmed
-//
-// npckov: number of sampling points
-// ppckov: energy values
-// absco: absorption length
-// effic: quantum efficiency
-// rindex: refraction index
-// rfl: reflectivity for boundary to medium itmed
-//
-
-//
-// // Double_t version
- Float_t* fppckov = CreateFloatArray(ppckov, npckov);
- Float_t* fabsco = CreateFloatArray(absco, npckov);
- Float_t* feffic = CreateFloatArray(effic, npckov);
- Float_t* frindex = CreateFloatArray(rindex, npckov);
- Float_t* frfl = CreateFloatArray(rfl, npckov);
-
- SetCerenkov(itmed, npckov, fppckov, fabsco, feffic, frindex, frfl);
-
- delete [] fppckov;
- delete [] fabsco;
- delete [] feffic;
- delete [] frindex;
- delete [] frfl;
-}
-
-// Euclid
-//______________________________________________________________________________
-void TFluka::WriteEuclid(const char* /*fileName*/, const char* /*topVol*/,
- Int_t /*number*/, Int_t /*nlevel*/) {
-//
-// Not with TGeo
- Warning("WriteEuclid", "Not implemented !");
-}
-
-
-
-//_____________________________________________________________________________
-// methods needed by the stepping
-//____________________________________________________________________________
-
-Int_t TFluka::GetMedium() const {
-//
-// Get the medium number for the current fluka region
-//
- if (gGeoManager->IsOutside()) {
- return (-1);
- } else {
- return (fGeom->GetMedium()); // this I need to check due to remapping !!!
- }
-}
-
-//____________________________________________________________________________
-Int_t TFluka::GetDummyRegion() const
-{
-// Returns index of the dummy region.
- return fGeom->GetDummyRegion();
-}
-
-//____________________________________________________________________________
-Int_t TFluka::GetDummyLattice() const
-{
-// Returns index of the dummy lattice.
- return fGeom->GetDummyLattice();
-}
-
-//____________________________________________________________________________
-// particle table usage
-// ID <--> PDG transformations
-//_____________________________________________________________________________
-Int_t TFluka::IdFromPDG(Int_t pdg) const
-{
-
- //
- // Return Fluka code from PDG and pseudo ENDF code
- Int_t idSpecial[4] = {TFlukaIon::GetIonPdg(2,4),
- TFlukaIon::GetIonPdg(2,3),
- TFlukaIon::GetIonPdg(1,3),
- TFlukaIon::GetIonPdg(1,2)};
- // Catch the feedback photons
- if (pdg == 50000051) return (kFLUKAoptical);
-
- // Light ions (d,t,h3,alpha)
- for (Int_t i = 0; i < 4; i++) {
- if (pdg == idSpecial[i]) return (i + kFLUKAcodemin);
- }
-
- // Heavy ions
- if (pdg > TFlukaIon::GetIonPdg(1,1)) return (-2);
-
- // MCIHAD() goes from pdg to fluka internal.
- Int_t intfluka = mcihad(pdg);
- // KPTOIP array goes from internal to official
- return GetFlukaKPTOIP(intfluka);
-}
-
-//______________________________________________________________________________
-Int_t TFluka::PDGFromId(Int_t id) const
-{
- //
- // Return PDG code and pseudo ENDF code from Fluka code
- Int_t idSpecial[6] = {TFlukaIon::GetIonPdg(2,4), // alpha
- TFlukaIon::GetIonPdg(2,3), // He3
- TFlukaIon::GetIonPdg(1,3), // triton
- TFlukaIon::GetIonPdg(1,2), // deuteron
- TFlukaIon::GetIonPdg(0,0), // gen. ion
- 50000050};
- // IPTOKP array goes from official to internal
-
- if (id == kFLUKAoptical) {
-// Cerenkov photon
-// if (fVerbosityLevel >= 3)
-// printf("\n PDGFromId: Cerenkov Photon \n");
- return 50000050;
- }
-// Error id
- if (id == 0 || id < kFLUKAcodemin || id > kFLUKAcodemax) {
- if (fVerbosityLevel >= 3)
- printf("PDGFromId: Error id = 0 %5d %5d\n", id, fCaller);
- return -1;
- }
-// Good id
- if (id > 0) {
- Int_t intfluka = GetFlukaIPTOKP(id);
- if (intfluka == 0) {
- if (fVerbosityLevel >= 3)
- printf("PDGFromId: Error intfluka = 0: %d\n", id);
- return -1;
- } else if (intfluka < 0) {
- if (fVerbosityLevel >= 3)
- printf("PDGFromId: Error intfluka < 0: %d\n", id);
- return -1;
- }
-// if (fVerbosityLevel >= 3)
-// printf("mpdgha called with %d %d \n", id, intfluka);
- return mpdgha(intfluka);
- } else {
- // ions and optical photons
- return idSpecial[id - kFLUKAcodemin];
- }
-}
-
-void TFluka::StopTrack()
-{
- // Set stopping conditions
- // Works for photons and charged particles
- fStopped = kTRUE;
-}
-
-//_____________________________________________________________________________
-// methods for physics management
-//____________________________________________________________________________
-//
-// set methods
-//
-
-void TFluka::SetProcess(const char* flagName, Int_t flagValue, Int_t imed)
-{
-// Set process user flag for material imat
-//
-//
-// Update if already in the list
-//
- TIter next(fUserConfig);
- TFlukaConfigOption* proc;
- while((proc = (TFlukaConfigOption*)next()))
- {
- if (proc->Medium() == imed) {
- proc->SetProcess(flagName, flagValue);
- return;
- }
- }
- proc = new TFlukaConfigOption(imed);
- proc->SetProcess(flagName, flagValue);
- fUserConfig->Add(proc);
-}
-
-//______________________________________________________________________________
-Bool_t TFluka::SetProcess(const char* flagName, Int_t flagValue)
-{
-// Set process user flag
-//
-//
- SetProcess(flagName, flagValue, -1);
- return kTRUE;
-}
-
-//______________________________________________________________________________
-void TFluka::SetCut(const char* cutName, Double_t cutValue, Int_t imed)
-{
-// Set user cut value for material imed
-//
- TIter next(fUserConfig);
- TFlukaConfigOption* proc;
- while((proc = (TFlukaConfigOption*)next()))
- {
- if (proc->Medium() == imed) {
- proc->SetCut(cutName, cutValue);
- return;
- }
- }
-
- proc = new TFlukaConfigOption(imed);
- proc->SetCut(cutName, cutValue);
- fUserConfig->Add(proc);
-}
-
-
-//______________________________________________________________________________
-void TFluka::SetModelParameter(const char* parName, Double_t parValue, Int_t imed)
-{
-// Set model parameter for material imed
-//
- TIter next(fUserConfig);
- TFlukaConfigOption* proc;
- while((proc = (TFlukaConfigOption*)next()))
- {
- if (proc->Medium() == imed) {
- proc->SetModelParameter(parName, parValue);
- return;
- }
- }
-
- proc = new TFlukaConfigOption(imed);
- proc->SetModelParameter(parName, parValue);
- fUserConfig->Add(proc);
-}
-
-//______________________________________________________________________________
-Bool_t TFluka::SetCut(const char* cutName, Double_t cutValue)
-{
-// Set user cut value
-//
-//
- SetCut(cutName, cutValue, -1);
- return kTRUE;
-}
-
-
-void TFluka::SetUserScoring(const char* option, const char* sdum, Int_t npr, char* outfile, Float_t* what)
-{
-//
-// Adds a user scoring option to the list
-//
- TFlukaScoringOption* opt = new TFlukaScoringOption(option, sdum, npr,outfile,what);
- fUserScore->Add(opt);
-}
-//______________________________________________________________________________
-void TFluka::SetUserScoring(const char* option, const char* sdum, Int_t npr, char* outfile, Float_t* what,
- const char* det1, const char* det2, const char* det3)
-{
-//
-// Adds a user scoring option to the list
-//
- TFlukaScoringOption* opt = new TFlukaScoringOption(option, sdum, npr, outfile, what, det1, det2, det3);
- fUserScore->Add(opt);
-}
-
-//______________________________________________________________________________
-Double_t TFluka::Xsec(char*, Double_t, Int_t, Int_t)
-{
- Warning("Xsec", "Not yet implemented.!\n"); return -1.;
-}
-
-
-//______________________________________________________________________________
-void TFluka::InitPhysics()
-{
-//
-// Physics initialisation with preparation of FLUKA input cards
-//
-// Construct file names
- FILE *pFlukaVmcCoreInp, *pFlukaVmcFlukaMat, *pFlukaVmcInp;
- TString sFlukaVmcTmp = "flukaMat.inp";
- TString sFlukaVmcInp = GetInputFileName();
- TString sFlukaVmcCoreInp = GetCoreInputFileName();
-
-// Open files
- if ((pFlukaVmcCoreInp = fopen(sFlukaVmcCoreInp.Data(),"r")) == NULL) {
- Warning("InitPhysics", "\nCannot open file %s\n",sFlukaVmcCoreInp.Data());
- exit(1);
- }
- if ((pFlukaVmcFlukaMat = fopen(sFlukaVmcTmp.Data(),"r")) == NULL) {
- Warning("InitPhysics", "\nCannot open file %s\n",sFlukaVmcTmp.Data());
- exit(1);
- }
- if ((pFlukaVmcInp = fopen(sFlukaVmcInp.Data(),"w")) == NULL) {
- Warning("InitPhysics", "\nCannot open file %s\n",sFlukaVmcInp.Data());
- exit(1);
- }
-
-// Copy core input file
- Char_t sLine[255];
- Float_t fEventsPerRun;
-
- while ((fgets(sLine,255,pFlukaVmcCoreInp)) != NULL) {
- if (strncmp(sLine,"GEOEND",6) != 0)
- fprintf(pFlukaVmcInp,"%s",sLine); // copy until GEOEND card
- else {
- fprintf(pFlukaVmcInp,"GEOEND\n"); // add GEOEND card
- goto flukamat;
- }
- } // end of while until GEOEND card
-
-
- flukamat:
- while ((fgets(sLine,255,pFlukaVmcFlukaMat)) != NULL) { // copy flukaMat.inp file
- fprintf(pFlukaVmcInp,"%s\n",sLine);
- }
-
- while ((fgets(sLine,255,pFlukaVmcCoreInp)) != NULL) {
- if (strncmp(sLine,"START",5) != 0)
- fprintf(pFlukaVmcInp,"%s\n",sLine);
- else {
- sscanf(sLine+10,"%10f",&fEventsPerRun);
- goto fin;
- }
- } //end of while until START card
-
- fin:
-
-
-// Pass information to configuration objects
-
- Float_t fLastMaterial = fGeom->GetLastMaterialIndex();
- TFlukaConfigOption::SetStaticInfo(pFlukaVmcInp, 3, fLastMaterial, fGeom);
-
- TIter next(fUserConfig);
- TFlukaConfigOption* proc;
- while((proc = dynamic_cast<TFlukaConfigOption*> (next()))) proc->WriteFlukaInputCards();
-//
-// Process Fluka specific scoring options
-//
- TFlukaScoringOption::SetStaticInfo(pFlukaVmcInp, fGeom);
- Float_t loginp = -49.0;
- Int_t inp = 0;
- Int_t nscore = fUserScore->GetEntries();
-
- TFlukaScoringOption *mopo = 0;
- TFlukaScoringOption *mopi = 0;
-
- for (Int_t isc = 0; isc < nscore; isc++)
- {
- mopo = dynamic_cast<TFlukaScoringOption*> (fUserScore->At(isc));
- char* fileName = mopo->GetFileName();
- Int_t size = strlen(fileName);
- Float_t lun = -1.;
-//
-// Check if new output file has to be opened
- for (Int_t isci = 0; isci < isc; isci++) {
-
-
- mopi = dynamic_cast<TFlukaScoringOption*> (fUserScore->At(isci));
- if(strncmp(mopi->GetFileName(), fileName, size)==0) {
- //
- // No, the file already exists
- lun = mopi->GetLun();
- mopo->SetLun(lun);
- break;
- }
- } // inner loop
-
- if (lun == -1.) {
- // Open new output file
- inp++;
- mopo->SetLun(loginp + inp);
- mopo->WriteOpenFlukaFile();
- }
- mopo->WriteFlukaInputCards();
- }
-
-// Add RANDOMIZ card
- fprintf(pFlukaVmcInp,"RANDOMIZ %10.1f%10.0f\n", 1., Float_t(gRandom->GetSeed()));
-// User defined ion
- if (fUserIons) TFlukaIon::WriteUserInputCard(pFlukaVmcInp);
-// Add START and STOP card
- fprintf(pFlukaVmcInp,"START %10.1f\n",fEventsPerRun);
- fprintf(pFlukaVmcInp,"STOP \n");
-
-
-// Close files
- fclose(pFlukaVmcCoreInp);
- fclose(pFlukaVmcFlukaMat);
- fclose(pFlukaVmcInp);
-
-
-//
-// Initialisation needed for Cerenkov photon production and transport
- TObjArray *matList = GetFlukaMaterials();
- Int_t nmaterial = matList->GetEntriesFast();
- fMaterials = new Int_t[nmaterial+25];
-
- for (Int_t im = 0; im < nmaterial; im++)
- {
- TGeoMaterial* material = dynamic_cast<TGeoMaterial*> (matList->At(im));
- Int_t idmat = material->GetIndex();
- fMaterials[idmat] = im;
- }
-} // end of InitPhysics
-
-
-//______________________________________________________________________________
-void TFluka::SetMaxStep(Double_t step)
-{
-// Set the maximum step size
-// if (step > 1.e4) return;
-
-// Int_t mreg=0, latt=0;
-// fGeom->GetCurrentRegion(mreg, latt);
-
-
- Int_t mreg = fGeom->GetCurrentRegion();
- STEPSZ.stepmx[mreg - 1] = step;
-}
-
-
-Double_t TFluka::MaxStep() const
-{
-// Return the maximum for current medium
- Int_t mreg, latt;
- fGeom->GetCurrentRegion(mreg, latt);
- return (STEPSZ.stepmx[mreg - 1]);
-}
-
-//______________________________________________________________________________
-void TFluka::SetMaxNStep(Int_t)
-{
-// SetMaxNStep is dummy procedure in TFluka !
- if (fVerbosityLevel >=3)
- cout << "SetMaxNStep is dummy procedure in TFluka !" << endl;
-}
-
-//______________________________________________________________________________
-void TFluka::SetUserDecay(Int_t)
-{
-// SetUserDecay is dummy procedure in TFluka !
- if (fVerbosityLevel >=3)
- cout << "SetUserDecay is dummy procedure in TFluka !" << endl;
-}
-
-//
-// dynamic properties
-//
-//______________________________________________________________________________
-void TFluka::TrackPosition(TLorentzVector& position) const
-{
-// Return the current position in the master reference frame of the
-// track being transported
-// TRACKR.atrack = age of the particle
-// TRACKR.xtrack = x-position of the last point
-// TRACKR.ytrack = y-position of the last point
-// TRACKR.ztrack = z-position of the last point
- FlukaCallerCode_t caller = GetCaller();
- if (caller == kENDRAW || caller == kUSDRAW ||
- caller == kBXExiting || caller == kBXEntering ||
- caller == kUSTCKV) {
- position.SetX(GetXsco());
- position.SetY(GetYsco());
- position.SetZ(GetZsco());
- position.SetT(TRACKR.atrack);
- }
- else if (caller == kMGDRAW) {
- Int_t i = -1;
- if ((i = fPrimaryElectronIndex) > -1) {
- // Primary Electron Ionisation
- Double_t x, y, z, t;
- GetPrimaryElectronPosition(i, x, y, z, t);
- position.SetX(x);
- position.SetY(y);
- position.SetZ(z);
- position.SetT(t);
- } else {
- position.SetX(TRACKR.xtrack[TRACKR.ntrack]);
- position.SetY(TRACKR.ytrack[TRACKR.ntrack]);
- position.SetZ(TRACKR.ztrack[TRACKR.ntrack]);
- position.SetT(TRACKR.atrack);
- }
- }
- else if (caller == kSODRAW) {
- Int_t ist = FLKSTK.npflka;
- position.SetX(FLKSTK.xflk[ist]);
- position.SetY(FLKSTK.yflk[ist]);
- position.SetZ(FLKSTK.zflk[ist]);
- position.SetT(FLKSTK.agestk[ist]);
- } else if (caller == kMGResumedTrack) {
- position.SetX(TRACKR.spausr[0]);
- position.SetY(TRACKR.spausr[1]);
- position.SetZ(TRACKR.spausr[2]);
- position.SetT(TRACKR.spausr[3]);
- }
- else
- Warning("TrackPosition","position not available");
-}
-
-//______________________________________________________________________________
-void TFluka::TrackPosition(Double_t& x, Double_t& y, Double_t& z) const
-{
-// Return the current position in the master reference frame of the
-// track being transported
-// TRACKR.atrack = age of the particle
-// TRACKR.xtrack = x-position of the last point
-// TRACKR.ytrack = y-position of the last point
-// TRACKR.ztrack = z-position of the last point
- FlukaCallerCode_t caller = GetCaller();
- if (caller == kENDRAW || caller == kUSDRAW ||
- caller == kBXExiting || caller == kBXEntering ||
- caller == kUSTCKV) {
- x = GetXsco();
- y = GetYsco();
- z = GetZsco();
- }
- else if (caller == kMGDRAW) {
- Int_t i = -1;
- if ((i = fPrimaryElectronIndex) > -1) {
- Double_t t;
- GetPrimaryElectronPosition(i, x, y, z, t);
- } else {
- x = TRACKR.xtrack[TRACKR.ntrack];
- y = TRACKR.ytrack[TRACKR.ntrack];
- z = TRACKR.ztrack[TRACKR.ntrack];
- }
- }
- else if (caller == kSODRAW) {
- Int_t ist = FLKSTK.npflka;
- x = FLKSTK.xflk[ist];
- y = FLKSTK.yflk[ist];
- z = FLKSTK.zflk[ist];
- }
- else if (caller == kMGResumedTrack) {
- x = TRACKR.spausr[0];
- y = TRACKR.spausr[1];
- z = TRACKR.spausr[2];
- }
- else
- Warning("TrackPosition","position not available");
-}
-
-//______________________________________________________________________________
-void TFluka::TrackMomentum(TLorentzVector& momentum) const
-{
-// Return the direction and the momentum (GeV/c) of the track
-// currently being transported
-// TRACKR.ptrack = momentum of the particle (not always defined, if
-// < 0 must be obtained from etrack)
-// TRACKR.cx,y,ztrck = direction cosines of the current particle
-// TRACKR.etrack = total energy of the particle
-// TRACKR.jtrack = identity number of the particle
-// PAPROP.am[TRACKR.jtrack] = particle mass in gev
- FlukaCallerCode_t caller = GetCaller();
- FlukaProcessCode_t icode = GetIcode();
-
- if (caller != kEEDRAW &&
- caller != kMGResumedTrack &&
- caller != kSODRAW &&
- caller != kUSDRAW &&
- (caller != kENDRAW || (icode != kEMFSCOstopping1 && icode != kEMFSCOstopping2))) {
- if (TRACKR.ptrack >= 0) {
- momentum.SetPx(TRACKR.ptrack*TRACKR.cxtrck);
- momentum.SetPy(TRACKR.ptrack*TRACKR.cytrck);
- momentum.SetPz(TRACKR.ptrack*TRACKR.cztrck);
- momentum.SetE(TRACKR.etrack);
- return;
- }
- else {
- Double_t p = sqrt(TRACKR.etrack * TRACKR.etrack - ParticleMassFPC(TRACKR.jtrack) * ParticleMassFPC(TRACKR.jtrack));
- momentum.SetPx(p*TRACKR.cxtrck);
- momentum.SetPy(p*TRACKR.cytrck);
- momentum.SetPz(p*TRACKR.cztrck);
- momentum.SetE(TRACKR.etrack);
- return;
- }
- } else if (caller == kMGResumedTrack) {
- momentum.SetPx(TRACKR.spausr[4]);
- momentum.SetPy(TRACKR.spausr[5]);
- momentum.SetPz(TRACKR.spausr[6]);
- momentum.SetE (TRACKR.spausr[7]);
- return;
- } else if (caller == kENDRAW && (icode == kEMFSCOstopping1 || icode == kEMFSCOstopping2)) {
- momentum.SetPx(0.);
- momentum.SetPy(0.);
- momentum.SetPz(0.);
- momentum.SetE(TrackMass());
-
- } else if (caller == kSODRAW) {
- Int_t ist = FLKSTK.npflka;
- Double_t p = FLKSTK.pmoflk[ist];
- Int_t ifl = FLKSTK.iloflk[ist];
- Double_t m = PAPROP.am[ifl + 6];
- Double_t e = TMath::Sqrt(p * p + m * m);
- momentum.SetPx(p * FLKSTK.txflk[ist]);
- momentum.SetPy(p * FLKSTK.tyflk[ist]);
- momentum.SetPz(p * FLKSTK.tzflk[ist]);
- momentum.SetE(e);
- } else if (caller == kUSDRAW) {
- if (icode == kEMFSCObrems ||
- icode == kEMFSCOmoller ||
- icode == kEMFSCObhabha ||
- icode == kEMFSCOcompton )
- {
- momentum.SetPx(fPint[0]);
- momentum.SetPy(fPint[1]);
- momentum.SetPz(fPint[2]);
- momentum.SetE(fPint[3]);
- } else if (icode == kKASKADdray ||
- icode == kKASKADbrems ||
- icode == kKASKADpair) {
- momentum.SetPx(GENSTK.plr[0] * GENSTK.cxr[0]);
- momentum.SetPy(GENSTK.plr[0] * GENSTK.cyr[0]);
- momentum.SetPz(GENSTK.plr[0] * GENSTK.czr[0]);
- momentum.SetE (GENSTK.tki[0] + PAPROP.am[GENSTK.kpart[0]+6]);
- } else {
- Double_t p = sqrt(TRACKR.etrack * TRACKR.etrack
- - ParticleMassFPC(TRACKR.jtrack)
- * ParticleMassFPC(TRACKR.jtrack));
- momentum.SetPx(p*TRACKR.cxtrck);
- momentum.SetPy(p*TRACKR.cytrck);
- momentum.SetPz(p*TRACKR.cztrck);
- momentum.SetE(TRACKR.etrack);
- }
- }
- else
- Warning("TrackMomentum","momentum not available");
-}
-
-//______________________________________________________________________________
-void TFluka::TrackMomentum(Double_t& px, Double_t& py, Double_t& pz, Double_t& e) const
-{
-// Return the direction and the momentum (GeV/c) of the track
-// currently being transported
-// TRACKR.ptrack = momentum of the particle (not always defined, if
-// < 0 must be obtained from etrack)
-// TRACKR.cx,y,ztrck = direction cosines of the current particle
-// TRACKR.etrack = total energy of the particle
-// TRACKR.jtrack = identity number of the particle
-// PAPROP.am[TRACKR.jtrack] = particle mass in gev
- FlukaCallerCode_t caller = GetCaller();
- FlukaProcessCode_t icode = GetIcode();
- if (caller != kEEDRAW &&
- caller != kMGResumedTrack &&
- caller != kSODRAW &&
- caller != kUSDRAW &&
- (caller != kENDRAW || (icode != kEMFSCOstopping1 && icode != kEMFSCOstopping2))) {
- if (TRACKR.ptrack >= 0) {
- px = TRACKR.ptrack*TRACKR.cxtrck;
- py = TRACKR.ptrack*TRACKR.cytrck;
- pz = TRACKR.ptrack*TRACKR.cztrck;
- e = TRACKR.etrack;
- return;
- }
- else {
- Double_t p = sqrt(TRACKR.etrack * TRACKR.etrack - ParticleMassFPC(TRACKR.jtrack) * ParticleMassFPC(TRACKR.jtrack));
- px = p*TRACKR.cxtrck;
- py = p*TRACKR.cytrck;
- pz = p*TRACKR.cztrck;
- e = TRACKR.etrack;
- return;
- }
- } else if (caller == kMGResumedTrack) {
- px = TRACKR.spausr[4];
- py = TRACKR.spausr[5];
- pz = TRACKR.spausr[6];
- e = TRACKR.spausr[7];
- return;
- } else if (caller == kENDRAW && (icode == kEMFSCOstopping1 || icode == kEMFSCOstopping2)) {
- px = 0.;
- py = 0.;
- pz = 0.;
- e = TrackMass();
- } else if (caller == kSODRAW) {
- Int_t ist = FLKSTK.npflka;
- Double_t p = FLKSTK.pmoflk[ist];
- Int_t ifl = FLKSTK.iloflk[ist];
- Double_t m = PAPROP.am[ifl + 6];
- e = TMath::Sqrt(p * p + m * m);
- px = p * FLKSTK.txflk[ist];
- py = p * FLKSTK.tyflk[ist];
- pz = p * FLKSTK.tzflk[ist];
- } else if (caller == kUSDRAW) {
- if (icode == kEMFSCObrems ||
- icode == kEMFSCOmoller ||
- icode == kEMFSCObhabha ||
- icode == kEMFSCOcompton )
- {
- px = fPint[0];
- py = fPint[1];
- pz = fPint[2];
- e = fPint[3];
- } else if (icode == kKASKADdray ||
- icode == kKASKADbrems ||
- icode == kKASKADpair) {
- px = GENSTK.plr[0] * GENSTK.cxr[0];
- py = GENSTK.plr[0] * GENSTK.cyr[0];
- pz = GENSTK.plr[0] * GENSTK.czr[0];
- e = GENSTK.tki[0] + PAPROP.am[GENSTK.kpart[0]+6];
- } else {
- Double_t p = sqrt(TRACKR.etrack * TRACKR.etrack - ParticleMassFPC(TRACKR.jtrack) * ParticleMassFPC(TRACKR.jtrack));
- px = p*TRACKR.cxtrck;
- py = p*TRACKR.cytrck;
- pz = p*TRACKR.cztrck;
- e = TRACKR.etrack;
- }
- }
- else
- Warning("TrackMomentum","momentum not available");
-}
-
-//______________________________________________________________________________
-Double_t TFluka::TrackStep() const
-{
-// Return the length in centimeters of the current step
-// TRACKR.ctrack = total curved path
- FlukaCallerCode_t caller = GetCaller();
- if (caller == kMGDRAW) {
- Int_t i;
- if ((i = fPrimaryElectronIndex) > -1) {
- if (i > 0) {
- return (fPIlength[i] - fPIlength[i-1]);
- } else {
- Double_t s (TRACKR.ctrack - (fPIlength[fNPI - 1] - fPIlength[0]));
- return s;
- }
- } else {
- return TRACKR.ctrack;
- }
- } else if (caller == kBXEntering || caller == kBXExiting ||
- caller == kENDRAW || caller == kUSDRAW ||
- caller == kUSTCKV || caller == kMGResumedTrack ||
- caller == kSODRAW)
- {
- return 0.0;
- } else {
- Warning("TrackStep", "track step not available");
- return 0.0;
- }
-}
-
-//______________________________________________________________________________
-Double_t TFluka::TrackLength() const
-{
-// TRACKR.cmtrck = cumulative curved path since particle birth
- FlukaCallerCode_t caller = GetCaller();
- if (caller == kMGDRAW) {
- Int_t i;
- if ((i = fPrimaryElectronIndex) > -1) {
- return fPIlength[i];
- } else {
- return TRACKR.cmtrck;
- }
-
- } else if (caller == kBXEntering || caller == kBXExiting ||
- caller == kENDRAW || caller == kUSDRAW || caller == kUSTCKV)
- return TRACKR.cmtrck;
- else if (caller == kMGResumedTrack)
- return TRACKR.spausr[8];
- else if (caller == kSODRAW)
- return 0.0;
- else {
- Warning("TrackLength", "track length not available for caller %5d \n", caller);
- return 0.0;
- }
-}
-
-
-//______________________________________________________________________________
-Double_t TFluka::TrackTime() const
-{
-// Return the current time of flight of the track being transported
-// TRACKR.atrack = age of the particle
- FlukaCallerCode_t caller = GetCaller();
- if (caller == kMGDRAW) {
- Int_t i;
- if ((i = fPrimaryElectronIndex) > -1) {
- Double_t t = fPItime[i];
- return t;
- } else {
- return TRACKR.atrack;
- }
- } else if (caller == kBXEntering || caller == kBXExiting ||
- caller == kENDRAW || caller == kUSDRAW ||
- caller == kUSTCKV)
- return TRACKR.atrack;
- else if (caller == kMGResumedTrack)
- return TRACKR.spausr[3];
- else if (caller == kSODRAW) {
- return (FLKSTK.agestk[FLKSTK.npflka]);
- }
- else {
- Warning("TrackTime", "track time not available");
- return 0.0;
- }
-}
-
-//______________________________________________________________________________
-Double_t TFluka::Edep() const
-{
-// Energy deposition
-// if TRACKR.ntrack = 0, TRACKR.mtrack = 0:
-// -->local energy deposition (the value and the point are not recorded in TRACKR)
-// but in the variable "rull" of the procedure "endraw.cxx"
-// if TRACKR.ntrack > 0, TRACKR.mtrack = 0:
-// -->no energy loss along the track
-// if TRACKR.ntrack > 0, TRACKR.mtrack > 0:
-// -->energy loss distributed along the track
-// TRACKR.dtrack = energy deposition of the jth deposition event
-
- // If coming from bxdraw we have 2 steps of 0 length and 0 edep
- // If coming from usdraw we just signal particle production - no edep
- // If just first time after resuming, no edep for the primary
- FlukaCallerCode_t caller = GetCaller();
-
- if (caller == kBXExiting || caller == kBXEntering ||
- caller == kUSDRAW || caller == kMGResumedTrack ||
- caller == kSODRAW)
- return 0.0;
- Double_t sum = 0;
- Int_t i = -1;
-
- // Material with primary ionisation activated but number of primary electrons nprim = 0
- if (fPrimaryElectronIndex == -2) return 0.0;
- // nprim > 0
- if ((i = fPrimaryElectronIndex) > -1) {
- // Primary ionisation
- sum = GetPrimaryElectronKineticEnergy(i);
- if (sum > 100.) {
- printf("edep > 100. %d %d %f \n", i, ALLDLT.nalldl, sum);
- }
- return sum;
- } else {
- // Normal ionisation
- if (TRACKR.mtrack > 1) printf("Edep: %6d\n", TRACKR.mtrack);
-
- for ( Int_t j=0;j<TRACKR.mtrack;j++) {
- sum +=TRACKR.dtrack[j];
- }
- if (TRACKR.ntrack == 0 && TRACKR.mtrack == 0)
- return fRull + sum;
- else {
- return sum;
- }
- }
-}
-
-//______________________________________________________________________________
-Int_t TFluka::CorrectFlukaId() const
-{
- // since we don't put photons and e- created bellow transport cut on the vmc stack
- // and there is a call to endraw for energy deposition for each of them
- // and they have the track number of their parent, but different identity (pdg)
- // so we want to assign also their parent identity.
-
- if( (IsTrackStop())
- && TRACKR.ispusr[mkbmx2 - 4] == TRACKR.ispusr[mkbmx2 - 1]
- && TRACKR.jtrack != TRACKR.ispusr[mkbmx2 - 3] ) {
- if (fVerbosityLevel >=3)
- cout << "CorrectFlukaId() for icode=" << GetIcode()
- << " track=" << TRACKR.ispusr[mkbmx2 - 1]
- << " current PDG=" << PDGFromId(TRACKR.jtrack)
- << " assign parent PDG=" << PDGFromId(TRACKR.ispusr[mkbmx2 - 3]) << endl;
- return TRACKR.ispusr[mkbmx2 - 3]; // assign parent identity
- }
- if (TRACKR.jtrack <= 64){
- return TRACKR.jtrack;
- } else {
- return TRACKR.j0trck;
- }
-}
-
-
-//______________________________________________________________________________
-Int_t TFluka::TrackPid() const
-{
-// Return the id of the particle transported
-// TRACKR.jtrack = identity number of the particle
- FlukaCallerCode_t caller = GetCaller();
- if (caller != kEEDRAW && caller != kSODRAW) {
- return PDGFromId( CorrectFlukaId() );
- }
- else if (caller == kSODRAW) {
- return PDGFromId(FLKSTK.iloflk[FLKSTK.npflka]);
- }
- else
- return -1000;
-}
-
-//______________________________________________________________________________
-Double_t TFluka::TrackCharge() const
-{
-// Return charge of the track currently transported
-// PAPROP.ichrge = electric charge of the particle
-// TRACKR.jtrack = identity number of the particle
-
- FlukaCallerCode_t caller = GetCaller();
- if (caller != kEEDRAW && caller != kSODRAW)
- return PAPROP.ichrge[CorrectFlukaId() + 6];
- else if (caller == kSODRAW) {
- Int_t ifl = PDGFromId(FLKSTK.iloflk[FLKSTK.npflka]);
- return PAPROP.ichrge[ifl + 6];
- }
- else
- return -1000.0;
-}
-
-//______________________________________________________________________________
-Double_t TFluka::TrackMass() const
-{
-// PAPROP.am = particle mass in GeV
-// TRACKR.jtrack = identity number of the particle
- FlukaCallerCode_t caller = GetCaller();
- if (caller != kEEDRAW && caller != kSODRAW)
- return PAPROP.am[CorrectFlukaId()+6];
- else if (caller == kSODRAW) {
- Int_t ifl = FLKSTK.iloflk[FLKSTK.npflka];
- return PAPROP.am[ifl + 6];
- }
- else
- return -1000.0;
-}
-
-//______________________________________________________________________________
-Double_t TFluka::Etot() const
-{
-// TRACKR.etrack = total energy of the particle
- FlukaCallerCode_t caller = GetCaller();
- FlukaProcessCode_t icode = GetIcode();
- if (caller != kEEDRAW && caller != kSODRAW && caller != kUSDRAW)
- {
- return TRACKR.etrack;
- } else if (caller == kUSDRAW) {
- if (icode == kEMFSCObrems ||
- icode == kEMFSCOmoller ||
- icode == kEMFSCObhabha ||
- icode == kEMFSCOcompton ) {
- return fPint[3];
- }
- else if (icode == kKASKADdray ||
- icode == kKASKADbrems ||
- icode == kKASKADpair) {
- return (GENSTK.tki[0] + PAPROP.am[GENSTK.kpart[0]+6]);
- } else {
- return TRACKR.etrack;
- }
-
- }
- else if (caller == kSODRAW) {
- Int_t ist = FLKSTK.npflka;
- Double_t p = FLKSTK.pmoflk[ist];
- Int_t ifl = FLKSTK.iloflk[ist];
- Double_t m = PAPROP.am[ifl + 6];
- Double_t e = TMath::Sqrt(p * p + m * m);
- return e;
- }
- printf("Etot %5d %5d \n", caller, icode);
-
- return -1000.0;
-}
-
-//
-// track status
-//
-//______________________________________________________________________________
-Bool_t TFluka::IsNewTrack() const
-{
-// Return true for the first call of Stepping()
- return fTrackIsNew;
-}
-
-void TFluka::SetTrackIsNew(Bool_t flag)
-{
-// Return true for the first call of Stepping()
- fTrackIsNew = flag;
-
-}
-
-
-//______________________________________________________________________________
-Bool_t TFluka::IsTrackInside() const
-{
-// True if the track is not at the boundary of the current volume
-// In Fluka a step is always inside one kind of material
-// If the step would go behind the region of one material,
-// it will be shortened to reach only the boundary.
-// Therefore IsTrackInside() is always true.
- FlukaCallerCode_t caller = GetCaller();
- if (caller == kBXEntering || caller == kBXExiting)
- return 0;
- else
- return 1;
-}
-
-//______________________________________________________________________________
-Bool_t TFluka::IsTrackEntering() const
-{
-// True if this is the first step of the track in the current volume
-
- FlukaCallerCode_t caller = GetCaller();
- if (caller == kBXEntering)
- return 1;
- else return 0;
-}
-
-//______________________________________________________________________________
-Bool_t TFluka::IsTrackExiting() const
-{
-// True if track is exiting volume
-//
- FlukaCallerCode_t caller = GetCaller();
- if (caller == kBXExiting)
- return 1;
- else return 0;
-}
-
-//______________________________________________________________________________
-Bool_t TFluka::IsTrackOut() const
-{
-// True if the track is out of the setup
-// means escape
- FlukaProcessCode_t icode = GetIcode();
-
- if (icode == kKASKADescape ||
- icode == kEMFSCOescape ||
- icode == kKASNEUescape ||
- icode == kKASHEAescape ||
- icode == kKASOPHescape)
- return 1;
- else return 0;
-}
-
-//______________________________________________________________________________
-Bool_t TFluka::IsTrackDisappeared() const
-{
-// All inelastic interactions and decays
-// fIcode from usdraw
- FlukaProcessCode_t icode = GetIcode();
- if (icode == kKASKADinelint || // inelastic interaction
- icode == kKASKADdecay || // particle decay
- icode == kKASKADdray || // delta ray generation by hadron
- icode == kKASKADpair || // direct pair production
- icode == kKASKADbrems || // bremsstrahlung (muon)
- icode == kEMFSCObrems || // bremsstrahlung (electron)
- icode == kEMFSCOmoller || // Moller scattering
- icode == kEMFSCObhabha || // Bhaba scattering
- icode == kEMFSCOanniflight || // in-flight annihilation
- icode == kEMFSCOannirest || // annihilation at rest
- icode == kEMFSCOpair || // pair production
- icode == kEMFSCOcompton || // Compton scattering
- icode == kEMFSCOphotoel || // Photoelectric effect
- icode == kKASNEUhadronic || // hadronic interaction
- icode == kKASHEAdray // delta-ray
- ) return 1;
- else return 0;
-}
-
-//______________________________________________________________________________
-Bool_t TFluka::IsTrackStop() const
-{
-// True if the track energy has fallen below the threshold
-// means stopped by signal or below energy threshold
- FlukaProcessCode_t icode = GetIcode();
- if (icode == kKASKADstopping || // stopping particle
- icode == kKASKADtimekill || // time kill
- icode == kEMFSCOstopping1 || // below user-defined cut-off
- icode == kEMFSCOstopping2 || // below user cut-off
- icode == kEMFSCOtimekill || // time kill
- icode == kKASNEUstopping || // neutron below threshold
- icode == kKASNEUtimekill || // time kill
- icode == kKASHEAtimekill || // time kill
- icode == kKASOPHtimekill) return 1; // time kill
- else return 0;
-}
-
-//______________________________________________________________________________
-Bool_t TFluka::IsTrackAlive() const
-{
-// Means not disappeared or not out
- FlukaProcessCode_t icode = GetIcode();
-
- if (IsTrackOut() ||
- IsTrackStop() ||
- icode == kKASKADinelint || // inelastic interaction
- icode == kKASKADdecay || // particle decay
- icode == kEMFSCOanniflight || // in-flight annihilation
- icode == kEMFSCOannirest || // annihilation at rest
- icode == kEMFSCOpair || // pair production
- icode == kEMFSCOphotoel || // Photoelectric effect
- icode == kKASNEUhadronic // hadronic interaction
- )
- {
- // Exclude the cases for which the particle has disappeared (paused) but will reappear later (= alive).
- return 0;
- } else {
- return 1;
- }
-}
-
-//
-// secondaries
-//
-
-//______________________________________________________________________________
-Int_t TFluka::NSecondaries() const
-
-{
-// Number of secondary particles generated in the current step
-// GENSTK.np = number of secondaries except light and heavy ions
-// FHEAVY.npheav = number of secondaries for light and heavy secondary ions
- FlukaCallerCode_t caller = GetCaller();
- if (caller == kUSDRAW) // valid only after usdraw
- return GENSTK.np + FHEAVY.npheav;
- else if (caller == kUSTCKV) {
- // Cerenkov Photon production
- return fNCerenkov;
- }
- return 0;
-} // end of NSecondaries
-
-//______________________________________________________________________________
-void TFluka::GetSecondary(Int_t isec, Int_t& particleId,
- TLorentzVector& position, TLorentzVector& momentum)
-{
-// Copy particles from secondary stack to vmc stack
-//
-
- FlukaCallerCode_t caller = GetCaller();
- if (caller == kUSDRAW) { // valid only after usdraw
- if (GENSTK.np > 0) {
- // Hadronic interaction
- if (isec >= 0 && isec < GENSTK.np) {
- particleId = PDGFromId(GENSTK.kpart[isec]);
- position.SetX(fXsco);
- position.SetY(fYsco);
- position.SetZ(fZsco);
- position.SetT(TRACKR.atrack);
- momentum.SetPx(GENSTK.plr[isec]*GENSTK.cxr[isec]);
- momentum.SetPy(GENSTK.plr[isec]*GENSTK.cyr[isec]);
- momentum.SetPz(GENSTK.plr[isec]*GENSTK.czr[isec]);
- momentum.SetE(GENSTK.tki[isec] + PAPROP.am[GENSTK.kpart[isec]+6]);
- }
- else if (isec >= GENSTK.np && isec < GENSTK.np + FHEAVY.npheav) {
- Int_t jsec = isec - GENSTK.np;
- particleId = FHEAVY.kheavy[jsec]; // this is Fluka id !!!
- position.SetX(fXsco);
- position.SetY(fYsco);
- position.SetZ(fZsco);
- position.SetT(TRACKR.atrack);
- momentum.SetPx(FHEAVY.pheavy[jsec]*FHEAVY.cxheav[jsec]);
- momentum.SetPy(FHEAVY.pheavy[jsec]*FHEAVY.cyheav[jsec]);
- momentum.SetPz(FHEAVY.pheavy[jsec]*FHEAVY.czheav[jsec]);
- if (FHEAVY.tkheav[jsec] >= 3 && FHEAVY.tkheav[jsec] <= 6)
- momentum.SetE(FHEAVY.tkheav[jsec] + PAPROP.am[jsec+6]);
- else if (FHEAVY.tkheav[jsec] > 6)
- momentum.SetE(FHEAVY.tkheav[jsec] + FHEAVY.amnhea[jsec]); // to be checked !!!
- }
- else
- Warning("GetSecondary","isec out of range");
- }
- } else if (caller == kUSTCKV) {
- Int_t index = OPPHST.lstopp - isec;
- position.SetX(OPPHST.xoptph[index]);
- position.SetY(OPPHST.yoptph[index]);
- position.SetZ(OPPHST.zoptph[index]);
- position.SetT(OPPHST.agopph[index]);
- Double_t p = OPPHST.poptph[index];
-
- momentum.SetPx(p * OPPHST.txopph[index]);
- momentum.SetPy(p * OPPHST.tyopph[index]);
- momentum.SetPz(p * OPPHST.tzopph[index]);
- momentum.SetE(p);
- }
- else
- Warning("GetSecondary","no secondaries available");
-
-} // end of GetSecondary
-
-
-//______________________________________________________________________________
-TMCProcess TFluka::ProdProcess(Int_t) const
-
-{
-// Name of the process that has produced the secondary particles
-// in the current step
-
- Int_t mugamma = (TRACKR.jtrack == kFLUKAphoton ||
- TRACKR.jtrack == kFLUKAmuplus ||
- TRACKR.jtrack == kFLUKAmuminus);
- FlukaProcessCode_t icode = GetIcode();
-
- if (icode == kKASKADdecay) return kPDecay;
- else if (icode == kKASKADpair || icode == kEMFSCOpair) return kPPair;
- else if (icode == kEMFSCOcompton) return kPCompton;
- else if (icode == kEMFSCOphotoel) return kPPhotoelectric;
- else if (icode == kKASKADbrems || icode == kEMFSCObrems) return kPBrem;
- else if (icode == kKASKADdray || icode == kKASHEAdray) return kPDeltaRay;
- else if (icode == kEMFSCOmoller || icode == kEMFSCObhabha) return kPDeltaRay;
- else if (icode == kEMFSCOanniflight || icode == kEMFSCOannirest) return kPAnnihilation;
- else if (icode == kKASKADinelint) {
- if (!mugamma) return kPHadronic;
- else if (TRACKR.jtrack == kFLUKAphoton) return kPPhotoFission;
- else return kPMuonNuclear;
- }
- else if (icode == kEMFSCOrayleigh) return kPRayleigh;
-// Fluka codes 100, 300 and 400 still to be investigasted
- else return kPNoProcess;
-}
-
-
-Int_t TFluka::StepProcesses(TArrayI &proc) const
-{
- //
- // Return processes active in the current step
- //
- FlukaProcessCode_t icode = GetIcode();
- FlukaCallerCode_t caller = GetCaller();
- proc.Set(1);
- TMCProcess iproc;
- if (caller == kBXEntering || caller == kBXExiting || caller == kEEDRAW || caller == kSODRAW) {
- iproc = kPTransportation;
- }
- else if (caller == kUSTCKV) {
- iproc = kPCerenkov;
- } else {
- switch (icode) {
- case kEMFSCO:
- if (Edep() > 0.) {
- iproc = kPEnergyLoss;
- } else {
- iproc = kPTransportation;
- }
- break;
- case kKASKAD:
- if (Edep() > 0.) {
- iproc = kPEnergyLoss;
- } else {
- iproc = kPTransportation;
- }
- break;
- case kKASHEA:
- case kKASNEU:
- case kKASOPH:
- case kKASKADescape:
- case kEMFSCOescape:
- case kKASNEUescape:
- case kKASHEAescape:
- case kKASOPHescape:
- iproc = kPTransportation;
- break;
- case kKASKADtimekill:
- case kEMFSCOtimekill:
- case kKASNEUtimekill:
- case kKASHEAtimekill:
- case kKASOPHtimekill:
- iproc = kPTOFlimit;
- break;
- case kKASKADstopping:
- case kEMFSCOstopping1:
- case kEMFSCOstopping2:
- case kKASNEUstopping:
- iproc = kPStop;
- break;
- case kKASKADinelint:
- case kKASNEUhadronic:
- iproc = kPHadronic;
- break;
- case kKASKADinelarecoil:
- iproc = kPHadronic;
- break;
- case kKASKADnelint:
- iproc = kPHElastic;
- break;
- case kKASOPHabsorption:
- iproc = kPLightAbsorption;
- break;
- case kKASOPHrefraction:
- iproc = kPLightRefraction;
- break;
- case kEMFSCOlocaldep :
- iproc = kPPhotoelectric;
- break;
- default:
- iproc = ProdProcess(0);
- }
- }
-
- proc[0] = iproc;
- return 1;
-}
-//______________________________________________________________________________
-Int_t TFluka::VolId2Mate(Int_t id) const
-{
-//
-// Returns the material number for a given volume ID
-//
- return fMCGeo->VolId2Mate(id);
-}
-
-//______________________________________________________________________________
-const char* TFluka::VolName(Int_t id) const
-{
-//
-// Returns the volume name for a given volume ID
-//
- return fMCGeo->VolName(id);
-}
-
-Int_t TFluka::MediumId(const Text_t* mediumName) const
-{
- //
- // Return the unique medium id for medium with name mediumName
- TList *medlist = gGeoManager->GetListOfMedia();
- TGeoMedium* med = (TGeoMedium*) medlist->FindObject(mediumName);
- if (med) {
- return (med->GetId());
- } else {
- return (-1);
- }
-}
-
-//______________________________________________________________________________
-Int_t TFluka::VolId(const Text_t* volName) const
-{
-//
-// Converts from volume name to volume ID.
-// Time consuming. (Only used during set-up)
-// Could be replaced by hash-table
-//
- char sname[20];
- Int_t len;
- strncpy(sname, volName, len = strlen(volName));
- sname[len] = 0;
- while (sname[len - 1] == ' ') sname[--len] = 0;
- return fMCGeo->VolId(sname);
-}
-
-//______________________________________________________________________________
-Int_t TFluka::CurrentVolID(Int_t& copyNo) const
-{
-//
-// Return the logical id and copy number corresponding to the current fluka region
-//
- if (gGeoManager->IsOutside()) return 0;
- TGeoNode *node = gGeoManager->GetCurrentNode();
- copyNo = node->GetNumber();
- Int_t id = node->GetVolume()->GetNumber();
- return id;
-}
-
-//______________________________________________________________________________
-Int_t TFluka::CurrentVolOffID(Int_t off, Int_t& copyNo) const
-{
-//
-// Return the logical id and copy number of off'th mother
-// corresponding to the current fluka region
-//
- if (off<0 || off>gGeoManager->GetLevel()) return 0;
- if (off==0) return CurrentVolID(copyNo);
- TGeoNode *node = gGeoManager->GetMother(off);
- if (!node) return 0;
- copyNo = node->GetNumber();
- return node->GetVolume()->GetNumber();
-}
-
-//______________________________________________________________________________
-const char* TFluka::CurrentVolName() const
-{
-//
-// Return the current volume name
-//
- if (gGeoManager->IsOutside()) return "OutOfWorld";
- return gGeoManager->GetCurrentVolume()->GetName();
-}
-
-//______________________________________________________________________________
-const char* TFluka::CurrentVolOffName(Int_t off) const
-{
-//
-// Return the volume name of the off'th mother of the current volume
-//
- if (off<0 || off>gGeoManager->GetLevel()) return 0;
- if (off==0) return CurrentVolName();
- TGeoNode *node = gGeoManager->GetMother(off);
- if (!node) return 0;
- return node->GetVolume()->GetName();
-}
-
-const char* TFluka::CurrentVolPath() {
- // Return the current volume path
- return gGeoManager->GetPath();
-}
-//______________________________________________________________________________
-Int_t TFluka::CurrentMaterial(Float_t & a, Float_t & z,
- Float_t & dens, Float_t & radl, Float_t & absl) const
-{
-//
-// Return the current medium number and material properties
-//
- Int_t copy;
- Int_t id = TFluka::CurrentVolID(copy);
- Int_t med = TFluka::VolId2Mate(id);
- TGeoVolume* vol = gGeoManager->GetCurrentVolume();
- TGeoMaterial* mat = vol->GetMaterial();
- a = mat->GetA();
- z = mat->GetZ();
- dens = mat->GetDensity();
- radl = mat->GetRadLen();
- absl = mat->GetIntLen();
-
- return med;
-}
-
-//______________________________________________________________________________
-void TFluka::Gmtod(Float_t* xm, Float_t* xd, Int_t iflag)
-{
-// Transforms a position from the world reference frame
-// to the current volume reference frame.
-//
-// Geant3 desription:
-// ==================
-// Computes coordinates XD (in DRS)
-// from known coordinates XM in MRS
-// The local reference system can be initialized by
-// - the tracking routines and GMTOD used in GUSTEP
-// - a call to GMEDIA(XM,NUMED)
-// - a call to GLVOLU(NLEVEL,NAMES,NUMBER,IER)
-// (inverse routine is GDTOM)
-//
-// If IFLAG=1 convert coordinates
-// IFLAG=2 convert direction cosinus
-//
-// ---
- Double_t xmL[3], xdL[3];
- Int_t i;
- for (i=0;i<3;i++) xmL[i]=xm[i];
- if (iflag == 1) gGeoManager->MasterToLocal(xmL,xdL);
- else gGeoManager->MasterToLocalVect(xmL,xdL);
- for (i=0;i<3;i++) xd[i] = xdL[i];
-}
-
-//______________________________________________________________________________
-void TFluka::Gmtod(Double_t* xm, Double_t* xd, Int_t iflag)
-{
-//
-// See Gmtod(Float_t*, Float_t*, Int_t)
-//
- if (iflag == 1) gGeoManager->MasterToLocal(xm,xd);
- else gGeoManager->MasterToLocalVect(xm,xd);
-}
-
-//______________________________________________________________________________
-void TFluka::Gdtom(Float_t* xd, Float_t* xm, Int_t iflag)
-{
-// Transforms a position from the current volume reference frame
-// to the world reference frame.
-//
-// Geant3 desription:
-// ==================
-// Computes coordinates XM (Master Reference System
-// knowing the coordinates XD (Detector Ref System)
-// The local reference system can be initialized by
-// - the tracking routines and GDTOM used in GUSTEP
-// - a call to GSCMED(NLEVEL,NAMES,NUMBER)
-// (inverse routine is GMTOD)
-//
-// If IFLAG=1 convert coordinates
-// IFLAG=2 convert direction cosinus
-//
-// ---
- Double_t xmL[3], xdL[3];
- Int_t i;
- for (i=0;i<3;i++) xdL[i] = xd[i];
- if (iflag == 1) gGeoManager->LocalToMaster(xdL,xmL);
- else gGeoManager->LocalToMasterVect(xdL,xmL);
- for (i=0;i<3;i++) xm[i]=xmL[i];
-}
-
-//______________________________________________________________________________
-void TFluka::Gdtom(Double_t* xd, Double_t* xm, Int_t iflag)
-{
-//
-// See Gdtom(Float_t*, Float_t*, Int_t)
-//
- if (iflag == 1) gGeoManager->LocalToMaster(xd,xm);
- else gGeoManager->LocalToMasterVect(xd,xm);
-}
-
-//______________________________________________________________________________
-TObjArray *TFluka::GetFlukaMaterials()
-{
-//
-// Get array of Fluka materials
- return fGeom->GetMatList();
-}
-
-//______________________________________________________________________________
-void TFluka::SetMreg(Int_t l, Int_t lttc)
-{
-// Set current fluka region
- fCurrentFlukaRegion = l;
- fGeom->SetMreg(l,lttc);
-}
-
-
-
-
-//______________________________________________________________________________
-TString TFluka::ParticleName(Int_t pdg) const
-{
- // Return particle name for particle with pdg code pdg.
- Int_t ifluka = IdFromPDG(pdg);
- return TString((CHPPRP.btype[ifluka - kFLUKAcodemin]), 8);
-}
-
-
-//______________________________________________________________________________
-Double_t TFluka::ParticleMass(Int_t pdg) const
-{
- // Return particle mass for particle with pdg code pdg.
- Int_t ifluka = IdFromPDG(pdg);
- return (PAPROP.am[ifluka - kFLUKAcodemin]);
-}
-
-//______________________________________________________________________________
-Double_t TFluka::ParticleMassFPC(Int_t fpc) const
-{
- // Return particle mass for particle with Fluka particle code fpc
- return (PAPROP.am[fpc - kFLUKAcodemin]);
-}
-
-//______________________________________________________________________________
-Double_t TFluka::ParticleCharge(Int_t pdg) const
-{
- // Return particle charge for particle with pdg code pdg.
- Int_t ifluka = IdFromPDG(pdg);
- return Double_t(PAPROP.ichrge[ifluka - kFLUKAcodemin]);
-}
-
-//______________________________________________________________________________
-Double_t TFluka::ParticleLifeTime(Int_t pdg) const
-{
- // Return particle lifetime for particle with pdg code pdg.
- Int_t ifluka = IdFromPDG(pdg);
- return (PAPROP.tmnlf[ifluka - kFLUKAcodemin]);
-}
-
-//______________________________________________________________________________
-void TFluka::Gfpart(Int_t pdg, char* name, Int_t& type, Float_t& mass, Float_t& charge, Float_t& tlife)
-{
- // Retrieve particle properties for particle with pdg code pdg.
-
- strcpy(name, ParticleName(pdg).Data());
- type = ParticleMCType(pdg);
- mass = ParticleMass(pdg);
- charge = ParticleCharge(pdg);
- tlife = ParticleLifeTime(pdg);
-}
-
-//______________________________________________________________________________
-void TFluka::PrintHeader()
-{
- //
- // Print a header
- printf("\n");
- printf("\n");
- printf("------------------------------------------------------------------------------\n");
- printf("- You are using the TFluka Virtual Monte Carlo Interface to FLUKA. -\n");
- printf("- Please see the file fluka.out for FLUKA output and licensing information. -\n");
- printf("------------------------------------------------------------------------------\n");
- printf("\n");
- printf("\n");
-}
-
-
-#define pshckp pshckp_
-#define ustckv ustckv_
-
-
-extern "C" {
- void pshckp(Double_t & px, Double_t & py, Double_t & pz, Double_t & e,
- Double_t & vx, Double_t & vy, Double_t & vz, Double_t & tof,
- Double_t & polx, Double_t & poly, Double_t & polz, Double_t & wgt, Int_t& ntr)
- {
- //
- // Pushes one cerenkov photon to the stack
- //
-
- TFluka* fluka = (TFluka*) gMC;
- TVirtualMCStack* cppstack = fluka->GetStack();
- Int_t parent = TRACKR.ispusr[mkbmx2-1];
- cppstack->PushTrack(0, parent, 50000050,
- px, py, pz, e,
- vx, vy, vz, tof,
- polx, poly, polz,
- kPCerenkov, ntr, wgt, 0);
- if (fluka->GetVerbosityLevel() >= 3)
- printf("pshckp: track=%d parent=%d lattc=%d %s\n", ntr, parent, TRACKR.lt1trk, fluka->CurrentVolName());
- }
-
- void ustckv(Int_t & nphot, Int_t & mreg, Double_t & x, Double_t & y, Double_t & z)
- {
- //
- // Calls stepping in order to signal cerenkov production
- //
- TFluka *fluka = (TFluka*)gMC;
- fluka->SetMreg(mreg, TRACKR.lt1trk); //LTCLCM.mlatm1);
- fluka->SetXsco(x);
- fluka->SetYsco(y);
- fluka->SetZsco(z);
- fluka->SetNCerenkov(nphot);
- fluka->SetCaller(kUSTCKV);
- if (fluka->GetVerbosityLevel() >= 3)
- printf("ustckv: %10d mreg=%d lattc=%d newlat=%d (%f, %f, %f) edep=%f vol=%s\n",
- nphot, mreg, TRACKR.lt1trk, LTCLCM.newlat, x, y, z, fluka->Edep(), fluka->CurrentVolName());
-
- // check region lattice consistency (debug Ernesto)
- // *****************************************************
- Int_t nodeId;
- Int_t volId = fluka->CurrentVolID(nodeId);
- Int_t crtlttc = gGeoManager->GetCurrentNodeId()+1;
-
- if( mreg != volId && !gGeoManager->IsOutside() ) {
- cout << " ustckv: track=" << TRACKR.ispusr[mkbmx2-1] << " pdg=" << fluka->PDGFromId(TRACKR.jtrack)
- << " icode=" << fluka->GetIcode() << " gNstep=" << fluka->GetNstep() << endl
- << " fluka mreg=" << mreg << " mlttc=" << TRACKR.lt1trk << endl
- << " TGeo volId=" << volId << " crtlttc=" << crtlttc << endl
- << " common TRACKR lt1trk=" << TRACKR.lt1trk << " lt2trk=" << TRACKR.lt2trk << endl
- << " common LTCLCM newlat=" << LTCLCM.newlat << " mlatld=" << LTCLCM.mlatld << endl
- << " mlatm1=" << LTCLCM.mlatm1 << " mltsen=" << LTCLCM.mltsen << endl
- << " mltsm1=" << LTCLCM.mltsm1 << " mlattc=" << LTCLCM.mlattc << endl;
- if( TRACKR.lt1trk == crtlttc ) cout << " *************************************************************" << endl;
- }
- // *****************************************************
-
-
-
- (TVirtualMCApplication::Instance())->Stepping();
- }
-}
-
-//______________________________________________________________________________
-void TFluka::AddParticlesToPdgDataBase() const
-{
-
-//
-// Add particles to the PDG data base
-
- TDatabasePDG *pdgDB = TDatabasePDG::Instance();
-
- const Double_t kAu2Gev = 0.9314943228;
- const Double_t khSlash = 1.0545726663e-27;
- const Double_t kErg2Gev = 1/1.6021773349e-3;
- const Double_t khShGev = khSlash*kErg2Gev;
- const Double_t kYear2Sec = 3600*24*365.25;
-//
-// Ions
-//
- pdgDB->AddParticle("Deuteron","Deuteron",2*kAu2Gev+8.071e-3,kTRUE,
- 0,3,"Ion",TFlukaIon::GetIonPdg(1,2));
- pdgDB->AddParticle("Triton","Triton",3*kAu2Gev+14.931e-3,kFALSE,
- khShGev/(12.33*kYear2Sec),3,"Ion",TFlukaIon::GetIonPdg(1,3));
- pdgDB->AddParticle("Alpha","Alpha",4*kAu2Gev+2.424e-3,kTRUE,
- khShGev/(12.33*kYear2Sec),6,"Ion",TFlukaIon::GetIonPdg(2,4));
- pdgDB->AddParticle("HE3","HE3",3*kAu2Gev+14.931e-3,kFALSE,
- 0,6,"Ion",TFlukaIon::GetIonPdg(2,3));
-
-//
-//
-//
-// Special particles
-//
- pdgDB->AddParticle("Cherenkov","Cherenkov",0,kFALSE,
- 0,0,"Special",GetSpecialPdg(50));
- pdgDB->AddParticle("FeedbackPhoton","FeedbackPhoton",0,kFALSE,
- 0,0,"Special",GetSpecialPdg(51));
-}
-
-
-//
-// Info about primary ionization electrons
-//
-
-//______________________________________________________________________________
-Int_t TFluka::GetNPrimaryElectrons()
-{
- // Get number of primary electrons
- return ALLDLT.nalldl;
-}
-
-//______________________________________________________________________________
-Double_t TFluka::GetPrimaryElectronKineticEnergy(Int_t i) const
-{
- // Returns kinetic energy of primary electron i
-
- Double_t ekin = -1.;
-
- if (i >= 0 && i < ALLDLT.nalldl) {
- ekin = ALLDLT.talldl[i];
- } else {
- Warning("GetPrimaryElectronKineticEnergy",
- "Primary electron index out of range %d %d \n",
- i, ALLDLT.nalldl);
- }
- return ekin;
-}
-
-void TFluka::GetPrimaryElectronPosition(Int_t i, Double_t& x, Double_t& y, Double_t& z, Double_t& t) const
-{
- // Returns position of primary electron i
- if (i >= 0 && i < ALLDLT.nalldl) {
- x = ALLDLT.xalldl[i];
- y = ALLDLT.yalldl[i];
- z = ALLDLT.zalldl[i];
- t = ALLDLT.talldl[i];
- return;
- } else {
- Warning("GetPrimaryElectronPosition",
- "Primary electron index out of range %d %d \n",
- i, ALLDLT.nalldl);
- return;
- }
- return;
-}
-
-
-//__________________________________________________________________
-Int_t TFluka::GetSpecialPdg(Int_t number) const
-{
-// Numbering for special particles
-
- return 50000000 + number;
-}
-
-
-void TFluka::PrimaryIonisationStepping(Int_t nprim)
-{
-// Call Stepping for primary ionisation electrons
-// Protection against nprim > mxalld
-// Multiple steps for nprim > 0
- Int_t i;
- fNPI = nprim;
- if (nprim > 0) {
- CalcPrimaryIonisationTime();
- for (i = 0; i < nprim; i++) {
- SetCurrentPrimaryElectronIndex(i);
- (TVirtualMCApplication::Instance())->Stepping();
- if (i == 0) SetTrackIsNew(kFALSE);
- }
- } else {
- // No primary electron ionisation
- // Call Stepping anyway but flag nprim = 0 as index = -2
- SetCurrentPrimaryElectronIndex(-2);
- (TVirtualMCApplication::Instance())->Stepping();
- }
- // Reset the index
- SetCurrentPrimaryElectronIndex(-1);
-}
-
-//______________________________________________________________________
-Float_t* TFluka::CreateFloatArray(Double_t* array, Int_t size) const
-{
-// Converts Double_t* array to Float_t*,
-// !! The new array has to be deleted by user.
-// ---
-
- Float_t* floatArray;
- if (size>0) {
- floatArray = new Float_t[size];
- for (Int_t i=0; i<size; i++)
- if (array[i] >= FLT_MAX )
- floatArray[i] = FLT_MAX/100.;
- else
- floatArray[i] = array[i];
- }
- else {
- //floatArray = 0;
- floatArray = new Float_t[1];
- }
- return floatArray;
-}
-
-void TFluka::CalcPrimaryIonisationTime()
-{
- // Calculates the primary ionisation time
- if (fPItime) delete [] fPItime;
- fPItime = new Double_t[fNPI];
- if (fPIlength) delete [] fPIlength;
- fPIlength = new Double_t[fNPI];
- //
- Double_t px, py, pz, e, t;
- TrackMomentum(px, py, pz, e);
- Double_t p = TMath::Sqrt(px * px + py * py + pz * pz);
- Double_t beta = p / e;
- Double_t x0, y0, z0;
- fPItime[fNPI -1] = TRACKR.atrack;
- fPIlength[fNPI -1] = TRACKR.cmtrck;
- GetPrimaryElectronPosition(fNPI - 1, x0, y0, z0, t);
- if (fNPI > 1) {
- for (Int_t i = fNPI - 2; i > -1; i--) {
- Double_t x, y, z, time;
- GetPrimaryElectronPosition(i, x, y, z, time);
- Double_t ds = TMath::Sqrt((x-x0) * (x-x0) + (y-y0) * (y-y0) + (z-z0) * (z-z0));
- fPItime[i] = fPItime[i+1] - ds / (beta * 2.99792458e10);
- fPIlength[i] = fPIlength[i+1] - ds;
- x0 = x; y0 = y; z0 = z;
- }
- }
-
-}
-
-Bool_t TFluka::DefineIon(const char* name , Int_t z, Int_t a, Int_t q, Double_t exE, Double_t mass)
-{
- // User defined ion that can be used as a primary
- fUserIons = kTRUE;
- TFlukaIon::AddIon(name, z, a, q,exE, mass);
- return kTRUE;
-}
+++ /dev/null
-#ifndef TFLUKA_H
-#define TFLUKA_H
-/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * See cxx source for full Copyright notice */
-
-/* $Id$ */
-
-///////////////////////////////////////////////////////////////////////////////
-// //
-// //
-// FLUKA implementation of the VirtualMC Interface //
-// //
-// //
-///////////////////////////////////////////////////////////////////////////////
-
-
-#include "TVirtualMC.h"
-#include "TMCOptical.h"
-#include "TFlukaCodes.h"
-#include "TFlukaMCGeometry.h"
-
-//Forward declaration
-class TGeoMCGeometry;
-//class TFlukaMCGeometry;
-class TGeoMaterial;
-
-class TFluka : public TVirtualMC {
-
- public:
- TFluka(const char *title, Int_t verbosity = 0, Bool_t isRootGeometrySupported = 0);
- TFluka();
- virtual ~TFluka();
- virtual Bool_t IsRootGeometrySupported() const { return kTRUE;}
-
- Int_t GetNstep() { return fGeom->GetNstep(); } // to be removed
-
- //
- // Methods for building/management of geometry
- // ------------------------------------------------
- //
-
- // Functions from GCONS
- virtual void Gfmate(Int_t imat, char *name, Float_t &a, Float_t &z,
- Float_t &dens, Float_t &radl, Float_t &absl,
- Float_t* ubuf, Int_t& nbuf);
- virtual void Gfmate(Int_t imat, char *name, Double_t &a, Double_t &z,
- Double_t &dens, Double_t &radl, Double_t &absl,
- Double_t* ubuf, Int_t& nbuf);
-
- // Detector composition
- virtual void Material(Int_t& kmat, const char* name, Double_t a,
- Double_t z, Double_t dens, Double_t radl, Double_t absl,
- Float_t* buf, Int_t nwbuf);
- virtual void Material(Int_t& kmat, const char* name, Double_t a,
- Double_t z, Double_t dens, Double_t radl, Double_t absl,
- Double_t* buf, Int_t nwbuf);
- virtual void Mixture(Int_t& kmat, const char *name, Float_t *a,
- Float_t *z, Double_t dens, Int_t nlmat, Float_t *wmat);
- virtual void Mixture(Int_t& kmat, const char *name, Double_t *a,
- Double_t *z, Double_t dens, Int_t nlmat, Double_t *wmat);
- virtual void Medium(Int_t& kmed, const char *name, Int_t nmat,
- Int_t isvol, Int_t ifield, Double_t fieldm, Double_t tmaxfd,
- Double_t stemax, Double_t deemax, Double_t epsil,
- Double_t stmin, Float_t* ubuf, Int_t nbuf);
- virtual void Medium(Int_t& kmed, const char *name, Int_t nmat,
- Int_t isvol, Int_t ifield, Double_t fieldm, Double_t tmaxfd,
- Double_t stemax, Double_t deemax, Double_t epsil,
- Double_t stmin, Double_t* ubuf, Int_t nbuf);
- virtual void Matrix(Int_t& krot, Double_t thetaX, Double_t phiX,
- Double_t thetaY, Double_t phiY, Double_t thetaZ,
- Double_t phiZ);
- virtual void Gstpar(Int_t itmed, const char *param, Double_t parval);
-
- // Functions from GGEOM
- virtual Int_t Gsvolu(const char *name, const char *shape, Int_t nmed,
- Float_t *upar, Int_t np);
- virtual Int_t Gsvolu(const char *name, const char *shape, Int_t nmed,
- Double_t *upar, Int_t np);
- virtual void Gsdvn(const char *name, const char *mother, Int_t ndiv,
- Int_t iaxis);
- virtual void Gsdvn2(const char *name, const char *mother, Int_t ndiv,
- Int_t iaxis, Double_t c0i, Int_t numed);
- virtual void Gsdvt(const char *name, const char *mother, Double_t step,
- Int_t iaxis, Int_t numed, Int_t ndvmx);
- virtual void Gsdvt2(const char *name, const char *mother, Double_t step,
- Int_t iaxis, Double_t c0, Int_t numed, Int_t ndvmx);
- virtual void Gsord(const char *name, Int_t iax);
- virtual void Gspos(const char *name, Int_t nr, const char *mother,
- Double_t x, Double_t y, Double_t z, Int_t irot,
- const char *konly="ONLY");
- virtual void Gsposp(const char *name, Int_t nr, const char *mother,
- Double_t x, Double_t y, Double_t z, Int_t irot,
- const char *konly, Float_t *upar, Int_t np);
- virtual void Gsposp(const char *name, Int_t nr, const char *mother,
- Double_t x, Double_t y, Double_t z, Int_t irot,
- const char *konly, Double_t *upar, Int_t np);
- virtual void Gsbool(const char* onlyVolName, const char* manyVolName);
-
- // functions for access to geometry
- //
- // Return the Transformation matrix between the volume specified by
- // the path volumePath and the top or master volume.
- virtual Bool_t GetTransformation(const TString& volumePath,
- TGeoHMatrix& matrix);
-
- // Return the name of the shape and its parameters for the volume
- // specified by the volume name.
- virtual Bool_t GetShape(const TString& volumePath,
- TString& shapeType, TArrayD& par);
-
- // Returns the material parameters for the volume specified by
- // the volume name.
- virtual Bool_t GetMaterial(const TString& volumeName,
- TString& name, Int_t& imat,
- Double_t& a, Double_t& z, Double_t& density,
- Double_t& radl, Double_t& inter, TArrayD& par);
-
- // Returns the medium parameters for the volume specified by the
- // volume name.
- virtual Bool_t GetMedium(const TString& volumeName,
- TString& name, Int_t& imed,
- Int_t& nmat, Int_t& isvol, Int_t& ifield,
- Double_t& fieldm, Double_t& tmaxfd, Double_t& stemax,
- Double_t& deemax, Double_t& epsil, Double_t& stmin,
- TArrayD& par);
-
- virtual void SetCerenkov(Int_t itmed, Int_t npckov, Float_t *ppckov,
- Float_t *absco, Float_t *effic, Float_t *rindex);
- virtual void SetCerenkov(Int_t itmed, Int_t npckov, Double_t *ppckov,
- Double_t *absco, Double_t *effic, Double_t *rindex);
- virtual void SetCerenkov(Int_t itmed, Int_t npckov, Float_t *ppckov,
- Float_t *absco, Float_t *effic, Float_t *rindex, Float_t *rfl);
- virtual void SetCerenkov(Int_t itmed, Int_t npckov, Double_t *ppckov,
- Double_t *absco, Double_t *effic, Double_t *rindex, Double_t *rfl);
-
-//
- virtual void DefineOpSurface(const char* name, EMCOpSurfaceModel model, EMCOpSurfaceType surface,
- EMCOpSurfaceFinish surfaceFinish, Double_t sigmaAlpha);
-
- virtual void SetBorderSurface(const char* name, const char* vol1Name, int vol1CopyNo, const char* vol2Name, int vol2CopyNo,
- const char* opSurfaceName);
-
-
- virtual void SetSkinSurface(const char* name, const char* volName, const char* opSurfaceName);
-
- virtual void SetMaterialProperty(Int_t itmed, const char* propertyName, Int_t np, Double_t* pp, Double_t* values);
-
- virtual void SetMaterialProperty(Int_t itmed, const char* propertyName, Double_t value);
-
- virtual void SetMaterialProperty(const char* surfaceName, const char* propertyName, Int_t np, Double_t* pp, Double_t* values);
-
- // Functions for drawing
- virtual void DrawOneSpec(const char* /*name*/)
- {Warning("DrawOneSpec", "Not yet implemented !\n");}
- virtual void Gsatt(const char* name, const char* att, Int_t val);
- virtual void Gdraw(const char*,Double_t /*theta = 30*/, Double_t /*phi = 30*/,
- Double_t /*psi = 0*/, Double_t /*u0 = 10*/, Double_t /*v0 = 10*/,
- Double_t /*ul = 0.01*/, Double_t /*vl = 0.01*/)
- {Warning("Gdraw", "Not yet implemented !\n");}
-
- // Euclid
- virtual void WriteEuclid(const char*, const char*, Int_t, Int_t);
-
- // Getters
- Int_t GetDummyRegion() const;
- Int_t GetDummyLattice() const;
- virtual Int_t VolId(const Text_t* volName) const;
- virtual const char* VolName(Int_t id) const;
- virtual Int_t NofVolumes() const {return fNVolumes;}
- virtual Int_t VolId2Mate(Int_t id) const;
- // Return the unique numeric identifier for medium name mediumName
- virtual Int_t MediumId(const Text_t* mediumName) const;
-
- //
- // Methods for physics management
- // ------------------------------------------------
- //
-
- // User configuration
- virtual Bool_t SetProcess(const char* flagName, Int_t flagValue);
- virtual void SetProcess(const char* flagName, Int_t flagValue, Int_t imed);
- virtual Bool_t SetCut(const char* cutName, Double_t cutValue);
- virtual void SetCut(const char* cutName, Double_t cutValue, Int_t imed);
- virtual void SetModelParameter(const char* parName, Double_t parValue, Int_t imed);
- virtual TObjArray* GetListOfUserConfigs() {return fUserConfig;}
- virtual Double_t Xsec(char*, Double_t, Int_t, Int_t);
- virtual void SetLowEnergyNeutronTransport(Bool_t flag) {fLowEnergyNeutronTransport = flag;}
- virtual Bool_t LowEnergyNeutronTransport() {return fLowEnergyNeutronTransport;}
- // Particle table usage
- virtual Int_t IdFromPDG(Int_t id) const;
- virtual Int_t PDGFromId(Int_t pdg) const;
- virtual void DefineParticles()
- {Warning("DefineParticles", "Not yet implemented !\n");}
- virtual Bool_t SetDecayMode(Int_t /*pdg*/,
- Float_t /*bratio*/[6], Int_t /*mode*/[6][3])
- {return kFALSE;}
-
-
- //
- // methods for step management
- // ------------------------------------------------
- //
-
- // Action methods
- virtual void StopTrack();
- virtual void ResetStoppingCondition() {fStopped = kFALSE;}
- virtual Bool_t GetStoppingCondition() const {return fStopped;}
-
- virtual void StopEvent() {fStopEvent = kTRUE;}
- virtual void StopRun() {fStopEvent = kTRUE; fStopRun = kTRUE;}
- virtual Bool_t EventIsStopped() const {return fStopEvent;}
- virtual void SetStopEvent(Bool_t flag) {fStopEvent = flag;}
-
- // Set methods
- virtual void SetMaxStep (Double_t step);
- virtual void SetMaxNStep(Int_t);
- virtual void SetUserDecay(Int_t);
-
- // Get methods
- // Tracking volume(s)
- virtual Int_t CurrentVolID(Int_t& copyNo) const;
- virtual Int_t CurrentVolOffID(Int_t off, Int_t& copyNo) const;
- virtual const char* CurrentVolName() const;
- virtual const char* CurrentVolOffName(Int_t off) const;
- virtual Int_t CurrentMaterial(Float_t &a, Float_t &z,
- Float_t &dens, Float_t &radl, Float_t &absl) const;
- virtual Int_t CurrentEvent() const {return fNEvent;}
-
- virtual void Gmtod(Float_t* xm, Float_t* xd, Int_t iflag);
-
- virtual void Gmtod(Double_t* xm, Double_t* xd, Int_t iflag);
-
- virtual void Gdtom(Float_t* xd, Float_t* xm, Int_t iflag);
-
- virtual void Gdtom(Double_t* xd, Double_t* xm, Int_t iflag);
-
- virtual Double_t MaxStep() const;
- virtual Int_t GetMaxNStep() const
- {Warning("GetMaxNStep", "Not yet implemented !\n"); return -1;}
- virtual Int_t GetMedium() const;
- virtual Int_t CurrentMedium() const {return GetMedium();}
-
- // Tracking particle
- // dynamic properties
- virtual void TrackPosition(TLorentzVector& position) const;
- virtual void TrackPosition(Double_t& x, Double_t& y, Double_t& z) const;
- virtual void TrackMomentum(TLorentzVector& momentum) const;
- virtual void TrackMomentum(Double_t& px, Double_t& py, Double_t& pz, Double_t& e) const;
- virtual Double_t TrackStep() const;
- virtual Double_t TrackLength() const;
- virtual Double_t TrackTime() const;
- virtual Double_t Edep() const;
- // Static properties
- virtual Int_t CorrectFlukaId() const;
- virtual Int_t TrackPid() const;
- virtual Double_t TrackCharge() const;
- virtual Double_t TrackMass() const;
- virtual Double_t Etot() const;
- // Track status
- virtual Bool_t IsNewTrack() const;
- virtual Bool_t IsTrackInside() const;
- virtual Bool_t IsTrackEntering() const;
- virtual Bool_t IsTrackExiting() const;
- virtual Bool_t IsTrackOut() const;
- virtual Bool_t IsTrackDisappeared() const;
- virtual Bool_t IsTrackStop() const;
- virtual Bool_t IsTrackAlive() const;
-
- // Secondaries
- virtual Int_t NSecondaries() const;
- virtual void SetNCerenkov(Int_t nc) {fNCerenkov = nc;}
-
- virtual void GetSecondary(Int_t isec, Int_t& particleId,
- TLorentzVector& position, TLorentzVector& momentum);
- virtual Bool_t SecondariesAreOrdered() const {return kFALSE;}
- virtual TMCProcess ProdProcess(Int_t iproc) const ;
- virtual Int_t StepProcesses(TArrayI & proc) const;
- //
- // Geant3 specific methods
- // !!! need to be transformed to common interface
- //
- virtual void Gdopt(const char*,const char*)
- {Warning("Gdopt", "Not yet implemented !\n");}
- virtual void SetClipBox(const char*,Double_t=-9999,Double_t=0, Double_t=-9999,
- Double_t=0,Double_t=-9999,Double_t=0)
- {Warning("SetClipBox", "Not yet implemented !\n");}
- virtual void DefaultRange()
- {Warning("DefaultRange", "Not yet implemented !\n");}
- virtual void Gdhead(Int_t, const char*, Double_t=0)
- {Warning("Gdhead", "Not yet implemented !\n");}
- virtual void Gdman(Double_t, Double_t, const char*)
- {Warning("Gdman", "Not yet implemented !\n");}
- virtual void SetColors()
- {Warning("SetColors", "Not yet implemented !\n");}
- virtual void Gtreve()
- {Warning("Gtreve", "Not yet implemented !\n");}
- virtual void GtreveRoot()
- {Warning("GtreveRoot", "Not yet implemented !\n");}
- virtual void Gckmat(Int_t, char*)
- {Warning("Gckmat", "Not yet implemented !\n");}
- virtual void InitLego()
- {Warning("InitLego", "Not yet implemented !\n");}
-//
- virtual void Gfpart(Int_t pdg, char* name, Int_t& type, Float_t& mass, Float_t& charge, Float_t& tlife);
- virtual void Gspart(Int_t, const char*, Int_t, Double_t, Double_t, Double_t)
- {Warning("Gspart", "Not yet implemented !\n");}
-
- //
- // Particle Properties
- // -------------------
- //
- virtual Bool_t DefineParticle(Int_t, const char*, TMCParticleType, Double_t, Double_t, Double_t) {return kFALSE;}
- virtual Bool_t DefineParticle(Int_t, const char*, TMCParticleType, Double_t, Double_t, Double_t,
- const TString&, Double_t, Int_t, Int_t, Int_t, Int_t, Int_t, Int_t, Int_t, Int_t,
- Bool_t, Bool_t = kFALSE, const TString& = "", Int_t = 0, Double_t = 0.0, Double_t = 0.0) {return kFALSE;}
- virtual Bool_t DefineIon(const char* name , Int_t z, Int_t a, Int_t q, Double_t exE, Double_t mass);
-
- virtual TString ParticleName(int pdg) const;
- virtual Double_t ParticleMass(int pdg) const;
- virtual Double_t ParticleMassFPC(int fpc) const;
- virtual Double_t ParticleCharge(int pdg) const;
- virtual Double_t ParticleLifeTime(int pdg) const;
- virtual TMCParticleType ParticleMCType(int) const {return (TMCParticleType) 9;}
- //
- // Control methods
- // ------------------------------------------------
- //
-
- virtual void Init();
- virtual void InitPhysics();
- virtual void FinishGeometry();
- virtual void BuildPhysics();
- virtual void ProcessEvent();
- virtual Bool_t ProcessRun(Int_t nevent);
-
-
- //
- // FLUKA Scoring specific methods
- // ------------------------------
- //
- virtual void SetUserScoring(const char* option, const char* sdum, Int_t npr,char* outfile, Float_t* what);
- virtual void SetUserScoring(const char* option, const char* sdum, Int_t npr,char* outfile, Float_t* what,
- const char* det1, const char* det2, const char* det3);
- //
- // New Getter and Setters
- // ------------------------------------------------
- //
- // - Core input file name
- TString GetCoreInputFileName() const {return fCoreInputFileName;}
- void SetCoreInputFileName(const char* file = "coreFlukaVmc.inp") {fCoreInputFileName = file;}
-
- // - Input file name
- TString GetInputFileName() const {return fInputFileName;}
- void SetInputFileName(const char* file = "FlukaVmc.inp") {fInputFileName = file;}
-
- // - Verbosity level
- Int_t GetVerbosityLevel() const {return fVerbosityLevel;}
- void SetVerbosityLevel(Int_t l) {fVerbosityLevel = l;}
-
- //
- // - Fluka Draw procedures identifiers, see TFlukaCodes.h
- //
- FlukaCallerCode_t GetCaller() const {return fCaller;}
- FlukaProcessCode_t GetIcode() const {return fIcode;}
- Int_t GetMreg() const {return fCurrentFlukaRegion;}
- Int_t GetNewreg() const {return fNewReg;}
- Double_t GetRull() const {return fRull;}
- Double_t GetXsco() const {return fXsco;}
- Double_t GetYsco() const {return fYsco;}
- Double_t GetZsco() const {return fZsco;}
- Int_t GetCurrentFlukaRegion() const {return fCurrentFlukaRegion;}
- // - Fluka Draw Setters
- void SetCurrentFlukaRegion(Int_t reg) {fCurrentFlukaRegion=reg;}
- void SetCaller(FlukaCallerCode_t l) {fCaller = l;}
- void SetIcode(FlukaProcessCode_t l) {fIcode = l;}
- void SetMreg(Int_t l, Int_t lttc);
- void SetNewreg(Int_t l, Int_t /*lttc*/) {fNewReg = l;}
- void SetRull(Double_t r) {fRull = r;}
- void SetXsco(Double_t x) {fXsco = x;}
- void SetYsco(Double_t y) {fYsco = y;}
- void SetZsco(Double_t z) {fZsco = z;}
- void SetPint(Double_t px, Double_t py, Double_t pz, Double_t e) {fPint[0] = px; fPint[1] = py; fPint[2] = pz; fPint[3] = e;}
- void SetTrackIsEntering(){fTrackIsEntering = kTRUE; fTrackIsExiting = kFALSE;}
- void SetTrackIsExiting() {fTrackIsExiting = kTRUE; fTrackIsEntering = kFALSE;}
- void SetTrackIsInside() {fTrackIsExiting = kFALSE; fTrackIsEntering = kFALSE;}
- void SetTrackIsNew(Bool_t flag = kTRUE);
-
- void SetDummyBoundary(Int_t mode) {fDummyBoundary = mode;}
- Int_t GetDummyBoundary() const {return fDummyBoundary;}
- Bool_t IsDummyBoundary() const {return (fDummyBoundary==0)?kFALSE:kTRUE;}
-
- void EnableField(Bool_t flag=kTRUE) {fFieldFlag = flag;}
- Bool_t IsFieldEnabled() const {return fFieldFlag;}
-
- Int_t GetMaterialIndex(Int_t idmat) const {return fMaterials[idmat];}
-
- TObjArray * GetFlukaMaterials();
- virtual void SetRootGeometry() {;} // Dummy
- virtual Int_t NofVolDaughters(const char* volName) const;
- virtual const char* VolDaughterName(const char* volName, Int_t i) const;
- virtual Int_t VolDaughterCopyNo(const char* volName, Int_t i) const;
- virtual const char* CurrentVolPath();
- virtual void ForceDecayTime(Float_t){;}
- //
- // Info about primary ionization electrons
- Int_t GetNPrimaryElectrons();
- Double_t GetPrimaryElectronKineticEnergy(Int_t i) const;
- void GetPrimaryElectronPosition(Int_t i, Double_t& x, Double_t& y, Double_t& z, Double_t& t) const;
- void SetCurrentPrimaryElectronIndex(Int_t i) {fPrimaryElectronIndex = i;}
- void PrimaryIonisationStepping(Int_t nprim);
- void CalcPrimaryIonisationTime();
- private:
-
- // Copy constructor and operator= declared but not implemented (-Weff++ flag)
- TFluka(const TFluka &mc); //: TVirtualMC(mc) {;}
- TFluka & operator=(const TFluka &); // {return (*this);}
-
- void PrintHeader();
- void AddParticlesToPdgDataBase() const;
-
- Int_t GetSpecialPdg(Int_t number) const;
-
- Float_t* CreateFloatArray(Double_t* array, Int_t size) const;
-
- //
- Int_t fVerbosityLevel; //Verbosity level (0 lowest - 3 highest)
- Int_t fNEvent; //Current event number
- TString fInputFileName; //Name of the real input file
- TString fCoreInputFileName; //Name of the input file
-
- FlukaCallerCode_t fCaller; // Parameter to indicate who is the caller of the Fluka Draw
- FlukaProcessCode_t fIcode; // Fluka Draw procedures formal parameter
- Int_t fNewReg; // Fluka Draw procedures formal parameter
- Double_t fRull; // Fluka Draw procedures formal parameter
- Double_t fXsco; // Fluka Draw procedures formal parameter
- Double_t fYsco; // Fluka Draw procedures formal parameter
- Double_t fZsco; // Fluka Draw procedures formal parameter
- Double_t fPint[4]; // 4-vector of particle after interaction
- Double_t* fPItime; // Time distribution of primary ionisations
- Double_t* fPIlength; // Track length distribution of primary ionisations
- Int_t fNPI; // Number of primary ionisation steps
- Bool_t fTrackIsEntering; // Flag for track entering
- Bool_t fTrackIsExiting; // Flag for track exiting
- Bool_t fTrackIsNew; // Flag for new track
- Bool_t fFieldFlag; // Flag for magnetic field
- Int_t fDummyBoundary; // Flag for crossing dummy boundaries
- Bool_t fStopped; // Flag for stopping
- Bool_t fStopEvent; // Flag for stopped event
- Bool_t fStopRun; // Flag for stopped run
- Int_t fPrimaryElectronIndex; // Primary electron Index
- Bool_t fLowEnergyNeutronTransport; // Flag to force low energy neutron transport
-
- //
- //Geometry through TGeo
- //
- Int_t* fMaterials; //!Array of indices
- Int_t fNVolumes; //!Current number of volumes
- Int_t fCurrentFlukaRegion; // Index of fluka region at each step
- Int_t fNCerenkov; // Number of cerekov photons
- TFlukaMCGeometry *fGeom; // TGeo-FLUKA interface
- TGeoMCGeometry *fMCGeo; // Interface to TGeo builder
-
- // SetProcess, SetCut and user Scoring dynamic storage
- TObjArray* fUserConfig; // List of user physics configuration
- TObjArray* fUserScore; // List of user scoring options
- // User defined Ion
- Bool_t fUserIons; // User requests ion transport
-
- //
-
- ClassDef(TFluka,1) // C++ interface to Fluka montecarlo
-
-
- // Temporary implementation of new functions
- // To be removed with the next release
-};
- inline Int_t TFluka::NofVolDaughters(const char* /*volName*/) const {
- Warning("NofVolDaughters", "New function - not yet implemented.");
- return 0;
- }
-
- inline const char* TFluka::VolDaughterName(const char* /*volName*/, Int_t /*i*/) const {
- Warning("VolDaughterName", "New function - not yet implemented.");
- return "";
- }
-
- inline Int_t TFluka::VolDaughterCopyNo(const char* /*volName*/, Int_t /*i*/) const {
- Warning("VolDaughterCopyNo", "New function - not yet implemented.");
- return 0;
- }
-
-
-inline void TFluka::DefineOpSurface(const char* /*name*/, EMCOpSurfaceModel /*model*/, EMCOpSurfaceType /*surface*/,
- EMCOpSurfaceFinish /*surfaceFinish*/, Double_t /*sigmaAlpha*/)
-{
- Warning("DefineOpSurface", "New function - not yet implemented.");
-}
-
-
-inline void TFluka::SetBorderSurface(const char* /*name*/, const char* /*vol1Name*/, int /*vol1CopyNo*/, const char* /*vol2Name*/,
- int /*vol2CopyNo*/, const char* /*opSurfaceName*/)
-{
- Warning("SetBorderSurface", "New function - not yet implemented.");
-}
-
-
-inline void TFluka::SetSkinSurface(const char* /*name*/, const char* /*volName*/, const char* /*opSurfaceName*/)
-{
- Warning("SetSkinSurface", "New function - not yet implemented.");
-}
-
-
-inline void TFluka::SetMaterialProperty(Int_t /*itmed*/, const char* /*propertyName*/, Int_t /*np*/, Double_t* /*pp*/, Double_t* /*values*/)
-{
- Warning("SetMaterialProperty", "New function - not yet implemented.");
-}
-
-
-inline void TFluka::SetMaterialProperty(Int_t /*itmed*/, const char* /*propertyName*/, Double_t /*value*/)
-{
- Warning("SetMaterialProperty", "New function - not yet implemented.");
-}
-
-
-inline void TFluka::SetMaterialProperty(const char* /*surfaceName*/, const char* /*propertyName*/, Int_t /*np*/,
- Double_t* /*pp*/, Double_t* /*values*/)
-{
- Warning("SetMaterialProperty", "New function - not yet implemented.");
-}
-
-
-
-#endif //TFLUKA
-
+++ /dev/null
-/**************************************************************************
- * Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * *
- * Author: The ALICE Off-line Project. *
- * Contributors are mentioned in the code where appropriate. *
- * *
- * Permission to use, copy, modify and distribute this software and its *
- * documentation strictly for non-commercial purposes is hereby granted *
- * without fee, provided that the above copyright notice appears in all *
- * copies and that both the copyright notice and this permission notice *
- * appear in the supporting documentation. The authors make no claims *
- * about the suitability of this software for any purpose. It is *
- * provided "as is" without express or implied warranty. *
- **************************************************************************/
-
-/* $Id$*/
-
-//
-// Stores user defined cerenkov properties of media like
-// absorption coefficient, refraction index and quantum efficiency.
-// The properties are stored in arrays. The array index corresponds to discrete
-// optical photon energies defined in fEnergy.
-// Access to the properties is provided by interpolation.
-//
-// Author:
-// A. Morsch
-// andreas.morsch@cern.ch
-//
-
-#include "TFlukaCerenkov.h"
-
-Double_t TFlukaCerenkov::fgGlobalMaximumEfficiency = 0.;
-
-ClassImp(TFlukaCerenkov)
-
-
-TFlukaCerenkov::TFlukaCerenkov()
- : fSamples(0),
- fIsMetal(kFALSE),
- fIsSensitive(kFALSE),
- fEnergy(0),
- fWaveLength(0),
- fAbsorptionCoefficient(0),
- fQuantumEfficiency(0),
- fRefractionIndex(0),
- fReflectivity(0),
- fMaximumEfficiency(0.)
-{
-// Default constructor
-}
-
-
-TFlukaCerenkov::TFlukaCerenkov(Int_t npckov, Float_t *ppckov, Float_t *absco, Float_t *effic, Float_t *rindex)
- : fSamples(npckov),
- fIsMetal(kFALSE),
- fIsSensitive(kFALSE),
- fEnergy(new Float_t[fSamples]),
- fWaveLength(new Float_t[fSamples]),
- fAbsorptionCoefficient(new Float_t[fSamples]),
- fQuantumEfficiency(new Float_t[fSamples]),
- fRefractionIndex(new Float_t[fSamples]),
- fReflectivity(new Float_t[fSamples]),
- fMaximumEfficiency(0.)
-{
-// Constructor
-
-// fSamples = npckov;
-// fEnergy = new Float_t[fSamples];
-// fWaveLength = new Float_t[fSamples];
-// fAbsorptionCoefficient = new Float_t[fSamples];
-// fRefractionIndex = new Float_t[fSamples];
-// fQuantumEfficiency = new Float_t[fSamples];
-// fReflectivity = new Float_t[fSamples];
-
- for (Int_t i = 0; i < fSamples; i++) {
- fEnergy[i] = ppckov[i];
- fWaveLength[i] = khc / ppckov[i];
- if (absco[i] > 0.) {
- fAbsorptionCoefficient[i] = 1./ absco[i];
- } else {
- fAbsorptionCoefficient[i] = 1.e15;
- }
- fRefractionIndex[i] = rindex[i];
- fQuantumEfficiency[i] = effic[i];
- //
- // Find local maximum quantum efficiency
- if (effic[i] > fMaximumEfficiency) fMaximumEfficiency = effic[i];
- //
- // Flag is sensitive if quantum efficiency 0 < eff < 1 for at least one value.
- if (effic[i] < 1. && effic[i] > 0.) fIsSensitive = 1;
- // G3 way to define metal
- if (rindex[0] == 0.) {
- fIsMetal = kTRUE;
- fReflectivity[i] = absco[i];
- }
- }
- // Find global maximum quantum efficiency
- if (fMaximumEfficiency > GetGlobalMaximumEfficiency()) {
- SetGlobalMaximumEfficiency(fMaximumEfficiency);
- }
-}
-
-TFlukaCerenkov::TFlukaCerenkov(Int_t npckov, Float_t *ppckov, Float_t *absco, Float_t *effic, Float_t *rindex, Float_t *refl)
- : fSamples(npckov),
- fIsMetal(kFALSE),
- fIsSensitive(kFALSE),
- fEnergy(new Float_t[fSamples]),
- fWaveLength(new Float_t[fSamples]),
- fAbsorptionCoefficient(new Float_t[fSamples]),
- fQuantumEfficiency(new Float_t[fSamples]),
- fRefractionIndex(new Float_t[fSamples]),
- fReflectivity(new Float_t[fSamples]),
- fMaximumEfficiency(0.)
-{
- // Constructor including reflectivity
-// fSamples = npckov;
-// fEnergy = new Float_t[fSamples];
-// fWaveLength = new Float_t[fSamples];
-// fAbsorptionCoefficient = new Float_t[fSamples];
-// fRefractionIndex = new Float_t[fSamples];
-// fQuantumEfficiency = new Float_t[fSamples];
-
-
- for (Int_t i = 0; i < fSamples; i++) {
- fEnergy[i] = ppckov[i];
- fWaveLength[i] = khc / ppckov[i];
- if (absco[i] > 0.) {
- fAbsorptionCoefficient[i] = 1./ absco[i];
- } else {
- fAbsorptionCoefficient[i] = 1.e15;
- }
- fRefractionIndex[i] = rindex[i];
- fQuantumEfficiency[i] = effic[i];
- //
- // Find local maximum quantum efficiency
- if (effic[i] > fMaximumEfficiency) fMaximumEfficiency = effic[i];
- //
- // Flag is sensitive if quantum efficiency 0 < eff < 1 for at least one value.
- if (effic[i] < 1. && effic[i] > 0.) fIsSensitive = 1;
- //
-
- }
- // Find global maximum quantum efficiency
- if (fMaximumEfficiency > GetGlobalMaximumEfficiency()) {
- SetGlobalMaximumEfficiency(fMaximumEfficiency);
- }
-// fReflectivity = new Float_t[fSamples];
- for (Int_t i = 0; i < fSamples; i++) fReflectivity[i] = refl[i];
- fIsMetal = kTRUE;
-}
-
-Float_t TFlukaCerenkov::GetAbsorptionCoefficient(Float_t energy)
-{
-//
-// Get AbsorptionCoefficient for given energy
-//
- return Interpolate(energy, fEnergy, fAbsorptionCoefficient);
-
-}
-
-Float_t TFlukaCerenkov::GetRefractionIndex(Float_t energy)
-{
-//
-// Get RefractionIndex for given energy
-//
- return Interpolate(energy, fEnergy, fRefractionIndex);
-
-}
-
-Float_t TFlukaCerenkov::GetReflectivity(Float_t energy)
-{
-//
-// Get RefractionIndex for given energy
-//
- return Interpolate(energy, fEnergy, fReflectivity);
-
-}
-
-Float_t TFlukaCerenkov::GetQuantumEfficiency(Float_t energy)
-{
-//
-// Get QuantumEfficiency for given energy
-//
- return Interpolate(energy, fEnergy, fQuantumEfficiency);
-
-}
-
-
-Float_t TFlukaCerenkov::GetAbsorptionCoefficientByWaveLength(Float_t wavelength)
-{
-//
-// Get AbsorptionCoefficient for given wavelength
-//
- Float_t energy = khc / wavelength;
- return Interpolate(energy, fEnergy, fAbsorptionCoefficient);
-
-}
-
-Float_t TFlukaCerenkov::GetRefractionIndexByWaveLength(Float_t wavelength)
-{
-//
-// Get RefractionIndex for given wavelenth
-//
- Float_t energy = khc / wavelength;
- return Interpolate(energy, fEnergy, fRefractionIndex);
-}
-
-Float_t TFlukaCerenkov::GetReflectivityByWaveLength(Float_t wavelength)
-{
-//
-// Get RefractionIndex for given wavelenth
-//
- Float_t energy = khc / wavelength;
- return Interpolate(energy, fEnergy, fReflectivity);
-}
-
-Float_t TFlukaCerenkov::GetQuantumEfficiencyByWaveLength(Float_t wavelength)
-{
-//
-// Get QuantumEfficiency for given wavelength
-//
- Float_t energy = khc / wavelength;
- return Interpolate(energy, fEnergy, fQuantumEfficiency);
-}
-
-Float_t TFlukaCerenkov::Interpolate(Float_t value, Float_t* array1, Float_t* array2)
-{
-//
-// Interpolate array values
-//
- if (value < array1[0] && value >= array1[fSamples - 1]) {
- Warning("Interpolate()", "Photon energy out of range. Returning 0.");
- return (0.);
- }
-
- Int_t i = TMath::BinarySearch(fSamples, array1, value);
- if (i == (fSamples-1)) {
- return (array2[i]);
- } else {
- return (array2[i] + (array2[i+1] - array2[i]) / (array1[i+1] - array1[i]) * (value - array1[i]));
- }
-}
-
+++ /dev/null
-#ifndef TFLUKACERENKOV
-#define TFLUKACERENKOV
-
-/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * See cxx source for full Copyright notice */
-
-/* $Id$ */
-
-///////////////////////////////////////////////////////////////////////////////
-// //
-// //
-// Class that gives access to optical properties for Cerenkov photon //
-// production and transport //
-// //
-// //
-///////////////////////////////////////////////////////////////////////////////
-
-
-#include <TObject.h>
-#include <TMath.h>
-
-const Double_t khc = 2. * TMath::Pi() * 0.1973269602e-13; // GeV cm
-
-
-class TFlukaCerenkov : public TObject
-{
-
-public:
- // constructors
- TFlukaCerenkov();
- TFlukaCerenkov(Int_t npckov, Float_t *ppckov, Float_t *absco, Float_t *effic, Float_t *rindex);
- TFlukaCerenkov(Int_t npckov, Float_t *ppckov, Float_t *absco, Float_t *effic, Float_t *rindex, Float_t* rfl);
- virtual Float_t GetAbsorptionCoefficient(Float_t energy);
- virtual Float_t GetQuantumEfficiency(Float_t energy);
- virtual Float_t GetRefractionIndex(Float_t energy);
- virtual Float_t GetReflectivity(Float_t energy);
- virtual Float_t GetAbsorptionCoefficientByWaveLength(Float_t energy);
- virtual Float_t GetQuantumEfficiencyByWaveLength(Float_t energy);
- virtual Float_t GetRefractionIndexByWaveLength(Float_t energy);
- virtual Float_t GetReflectivityByWaveLength(Float_t energy);
- virtual Float_t GetMinimumEnergy() {return fEnergy[0];}
- virtual Float_t GetMaximumEnergy() {return fEnergy[fSamples-1];}
- virtual Float_t GetMinimumWavelength() {return khc / fEnergy[fSamples-1];}
- virtual Float_t GetMaximumWavelength() {return khc / fEnergy[0];}
- virtual Int_t GetNSamples() {return fSamples;}
- virtual Bool_t IsMetal() {return fIsMetal;}
- virtual Bool_t IsSensitive() {return fIsSensitive;}
- virtual Double_t GetMaximumEfficiency() const {return fMaximumEfficiency;}
- static Double_t GetGlobalMaximumEfficiency() {return fgGlobalMaximumEfficiency;}
- static void SetGlobalMaximumEfficiency(Double_t eff) {fgGlobalMaximumEfficiency = eff;}
-
- protected:
-
- virtual Float_t Interpolate(Float_t energy, Float_t* array1, Float_t* array2);
-
- protected:
- Int_t fSamples; // Number of sampling points
- Bool_t fIsMetal; // Flag for metals
- Bool_t fIsSensitive; // Flag for metals
- Float_t* fEnergy; // [fSamples] Energy (GeV)
- Float_t* fWaveLength; // [fSamples] Wafelength (cm)
- Float_t* fAbsorptionCoefficient; // [fSamples] Absorption Coefficient (1/cm)
- Float_t* fQuantumEfficiency; // [fSamples] Quantum efficiency
- Float_t* fRefractionIndex; // [fSamples] Refraction Index
- Float_t* fReflectivity; // [fSamples] Reflectivity
- Double_t fMaximumEfficiency; // Local maximum quantum efficiency
- // static
- static Double_t fgGlobalMaximumEfficiency; // Global maximum quantum efficiency
-
- private:
- // Copy constructor and operator= declared but not implemented (-Weff++ flag)
- TFlukaCerenkov(const TFlukaCerenkov&);
- TFlukaCerenkov& operator=(const TFlukaCerenkov&);
-
- ClassDef(TFlukaCerenkov, 1) // CerenkovProperties
-};
-
-#endif
-
+++ /dev/null
-#ifndef TFLUKACODES
-#define TFLUKACODES
-typedef enum {
- kNoProcess = 0,
- kKASKAD = 1, // KASKAD code first digit
- kKASKADelarecoil = 10, // elastic interaction recoil
- kKASKADinelarecoil = 11, // inelastic interaction recoil
- kKASKADstopping = 12, // stopping particle
- kKASKADpseudon = 13, // pseudo-neutron deposition
- kKASKADescape = 14, // escape
- kKASKADtimekill = 15, // time kill
- kKASKADboundary = 19, // boundary crossing
- kKASKADnelint = 100, // elastic interaction
- kKASKADinelint = 101, // inelastic interaction
- kKASKADdecay = 102, // particle decay
- kKASKADdray = 103, // delta ray generation
- kKASKADpair = 104, // pair production
- kKASKADbrems = 105, // bremsstrahlung
- kEMFSCO = 2, // EMFSCO code first digit
- kEMFSCOlocaldep = 20, // local energy deposition (i.e. photoelectric)
- kEMFSCOstopping1 = 21, // below user-defined cut-off
- kEMFSCOstopping2 = 22, // below user cut-off
- kEMFSCOescape = 23, // escape
- kEMFSCOtimekill = 24, // time kill
- kEMFSCOboundary = 29, // boundary crossing
- kEMFSCObrems = 208, // bremsstrahlung
- kEMFSCOmoller = 210, // Moller
- kEMFSCObhabha = 212, // Bhabha
- kEMFSCOanniflight = 214, // in-flight annihilation
- kEMFSCOannirest = 215, // annihilation at rest
- kEMFSCOpair = 217, // pair production
- kEMFSCOcompton = 219, // Compton scattering
- kEMFSCOphotoel = 221, // photoelectric effect
- kEMFSCOrayleigh = 225, // Rayleigh scattering
- kKASNEU = 3, // KASNEU code first digit
- kKASNEUtargrecoil = 30, // target recoil
- kKASNEUstopping = 31, // neutron below threshold
- kKASNEUescape = 32, // escape
- kKASNEUtimekill = 33, // time kill
- kKASNEUboundary = 39, // boundary crossing
- kKASNEUhadronic = 300, // neutron interaction
- kKASHEA = 4, // KASHEA code first digit
- kKASHEAescape = 40, // escape
- kKASHEAtimekill = 41, // time kill
- kKASHEAboundary = 49, // boundary crossing
- kKASHEAdray = 400, // delta ray generation
- kKASOPH = 5, // KASOPH code first digit
- kKASOPHabsorption = 50, // optical photon absorption
- kKASOPHescape = 51, // escape
- kKASOPHtimekill = 52, // time kill
- kKASOPHrefraction = 59 // boundary crossing (i.e. refraction)
-}
-FlukaProcessCode_t;
-
-typedef enum {
- kNoCaller = 0,
- kEEDRAW = 2, // Stepping called from eedraw
- kENDRAW = 3, // Stepping called from endraw
- kMGDRAW = 4, // Stepping called from mgdraw
- kSODRAW = 5, // Stepping called from sodraw
- kUSDRAW = 6, // Stepping called from usdraw
- kBXEntering = 11, // Stepping called from bxdraw (entering track)
- kBXExiting = 12, // Stepping called from bxdraw (exiting track)
- kMGResumedTrack = 40, // Stepping called from mgdraw (resumed track)
- kUSTCKV = 50 // Stepping called from ustckv
-}
-FlukaCallerCode_t;
-
-typedef enum {
- kFLUKAcodemin = - 6, // minimum particle code used by FLUKA
- kFLUKAcodemax = 250, // maximum particle code used by FLUKA
- kFLUKAoptical = - 1, // code for optical photon
- kFLUKAelectron = 3, // electron
- kFLUKApositron = 4, // positron
- kFLUKAphoton = 7, // photon
- kFLUKAmuplus = 10, // mu+
- kFLUKAmuminus = 11 // mu-
-}
-FlukaParticleCode_t;
-
-#endif //TFLUKACODE
+++ /dev/null
-/**************************************************************************
- * Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * *
- * Author: The ALICE Off-line Project. *
- * Contributors are mentioned in the code where appropriate. *
- * *
- * Permission to use, copy, modify and distribute this software and its *
- * documentation strictly for non-commercial purposes is hereby granted *
- * without fee, provided that the above copyright notice appears in all *
- * copies and that both the copyright notice and this permission notice *
- * appear in the supporting documentation. The authors make no claims *
- * about the suitability of this software for any purpose. It is *
- * provided "as is" without express or implied warranty. *
- **************************************************************************/
-
-/* $Id$*/
-
-#include "TFlukaConfigOption.h"
-#include "TFlukaMCGeometry.h"
-#include "TFluka.h"
-#include "TFlukaCerenkov.h"
-
-#include <TString.h>
-#include <TList.h>
-#include <TObjArray.h>
-#include <TVirtualMC.h>
-#include <TGeoMaterial.h>
-#include <TGeoMedium.h>
-#include <TGeoManager.h>
-#include <TGeoMedium.h>
-
-Float_t TFlukaConfigOption::fgMatMin(-1.);
-Float_t TFlukaConfigOption::fgMatMax(-1.);
-FILE* TFlukaConfigOption::fgFile(0x0);
-TFlukaMCGeometry* TFlukaConfigOption::fgGeom(0x0);
-
-Double_t TFlukaConfigOption::fgDCutValue[11];
-Int_t TFlukaConfigOption::fgDProcessFlag[15];
-
-
-ClassImp(TFlukaConfigOption)
-
-
-TFlukaConfigOption::TFlukaConfigOption()
- :fMedium(-1),
- fCMatMin(-1),
- fCMatMax(-1),
- fCMaterial(0)
-{
- // Default constructor
- Int_t i;
- for (i = 0; i < 11; i++) fCutValue[i] = -1.;
- for (i = 0; i < 15; i++) fProcessFlag[i] = -1;
-}
-
-
-TFlukaConfigOption::TFlukaConfigOption(Int_t medium)
- :fMedium(medium),
- fCMatMin(-1),
- fCMatMax(-1),
- fCMaterial(0)
-{
- // Constructor
- Int_t i;
- for (i = 0; i < 11; i++) fCutValue[i] = -1.;
- for (i = 0; i < 15; i++) fProcessFlag[i] = -1;
-}
-
-void TFlukaConfigOption::SetCut(const char* flagname, Double_t val)
-{
- // Set a cut value
- const TString cuts[11] =
- {"CUTGAM", "CUTELE", "CUTNEU", "CUTHAD", "CUTMUO", "BCUTE", "BCUTM", "DCUTE", "DCUTM", "PPCUTM", "TOFMAX"};
- Int_t i;
- for (i = 0; i < 11; i++) {
- if (cuts[i].CompareTo(flagname) == 0) {
- fCutValue[i] = val;
- if (fMedium == -1) fgDCutValue[i] = val;
- break;
- }
- }
-}
-
-void TFlukaConfigOption::SetModelParameter(const char* flagname, Double_t val)
-{
- // Set a model parameter value
- const TString parms[2] = {"PRIMIO_N", "PRIMIO_E"};
- Int_t i;
- for (i = 0; i < 2; i++) {
- if (parms[i].CompareTo(flagname) == 0) {
- fModelParameter[i] = val;
- break;
- }
- }
-}
-
-
-void TFlukaConfigOption::SetProcess(const char* flagname, Int_t flag)
-{
- // Set a process flag
- const TString process[15] =
- {"DCAY", "PAIR", "COMP", "PHOT", "PFIS", "DRAY", "ANNI", "BREM", "MUNU", "CKOV",
- "HADR", "LOSS", "MULS", "RAYL", "STRA"};
-
- Int_t i;
- for (i = 0; i < 15; i++) {
- if (process[i].CompareTo(flagname) == 0) {
- fProcessFlag[i] = flag;
- if (fMedium == -1) fgDProcessFlag[i] = flag;
- break;
- }
- }
-}
-
-void TFlukaConfigOption::WriteFlukaInputCards()
-{
- // Write the FLUKA input cards for the set of process flags and cuts
- //
- //
- //
- // Check if global option or medium specific
-
- Bool_t mediumIsSensitive = kFALSE;
- TGeoMedium* med = 0x0;
- TGeoMedium* medium = 0x0;
- TGeoMaterial* mat = 0x0;
-
- if (fMedium != -1) {
- TFluka* fluka = (TFluka*) gMC;
- fMedium = fgGeom->GetFlukaMaterial(fMedium);
- //
- // Check if material is actually used
- Int_t* reglist;
- Int_t nreg;
- reglist = fgGeom->GetMaterialList(fMedium, nreg);
- if (nreg == 0) {
- // Material not used -- return
- return;
- }
- //
- // Find material
- TObjArray *matList = fluka->GetFlukaMaterials();
- Int_t nmaterial = matList->GetEntriesFast();
- fCMaterial = 0;
- for (Int_t im = 0; im < nmaterial; im++)
- {
- fCMaterial = dynamic_cast<TGeoMaterial*> (matList->At(im));
- Int_t idmat = fCMaterial->GetIndex();
- if (idmat == fMedium) break;
- } // materials
- //
- // Find medium
- TList *medlist = gGeoManager->GetListOfMedia();
- TIter next(medlist);
- while((med = (TGeoMedium*)next()))
- {
- mat = med->GetMaterial();
- if (mat->GetIndex() == fMedium) {
- medium = med;
- break;
- }
- } // media
- //
- // Check if sensitive
- if (medium->GetParam(0) != 0.) mediumIsSensitive = kTRUE;
-
- fprintf(fgFile,"*\n*Material specific process and cut settings for #%8d %s\n", fMedium, fCMaterial->GetName());
- fCMatMin = fMedium;
- fCMatMax = fMedium;
- } else {
- fprintf(fgFile,"*\n*Global process and cut settings \n");
- fCMatMin = fgMatMin;
- fCMatMax = fgMatMax;
- }
-
-//
-// Handle Process Flags
-//
-//
-// First make sure that all cuts are taken into account
- if (DefaultProcessFlag(kPAIR) > 0 && fProcessFlag[kPAIR] == -1 && (fCutValue[kCUTELE] >= 0. || fCutValue[kPPCUTM] >= 0.))
- fProcessFlag[kPAIR] = DefaultProcessFlag(kPAIR);
- if (DefaultProcessFlag(kBREM) > 0 && fProcessFlag[kBREM] == -1 && (fCutValue[kBCUTE] >= 0. || fCutValue[kBCUTM] >= 0.))
- fProcessFlag[kBREM] = DefaultProcessFlag(kBREM);
- if (DefaultProcessFlag(kDRAY) > 0 && fProcessFlag[kDRAY] == -1 && (fCutValue[kDCUTE] >= 0. || fCutValue[kDCUTM] >= 0.))
- fProcessFlag[kDRAY] = DefaultProcessFlag(kDRAY);
-//
-//
- if (fProcessFlag[kDCAY] != -1) ProcessDCAY();
- if (fProcessFlag[kPAIR] != -1) ProcessPAIR();
- if (fProcessFlag[kBREM] != -1) ProcessBREM();
- if (fProcessFlag[kCOMP] != -1) ProcessCOMP();
- if (fProcessFlag[kPHOT] != -1) ProcessPHOT();
- if (fProcessFlag[kPFIS] != -1) ProcessPFIS();
- if (fProcessFlag[kANNI] != -1) ProcessANNI();
- if (fProcessFlag[kMUNU] != -1) ProcessMUNU();
- if (fProcessFlag[kHADR] != -1) ProcessHADR();
- if (fProcessFlag[kMULS] != -1) ProcessMULS();
- if (fProcessFlag[kRAYL] != -1) ProcessRAYL();
-
- if (fProcessFlag[kLOSS] != -1 || fProcessFlag[kDRAY] != -1) ProcessLOSS();
- if ((fMedium == -1 && fProcessFlag[kCKOV] > 0) || (fMedium > -1 && fProcessFlag[kCKOV] != -1)) ProcessCKOV();
-
-//
-// Handle Cuts
-//
- if (fCutValue[kCUTGAM] >= 0.) ProcessCUTGAM();
- if (fCutValue[kCUTELE] >= 0.) ProcessCUTELE();
- if (fCutValue[kCUTNEU] >= 0.) ProcessCUTNEU();
- if (fCutValue[kCUTHAD] >= 0.) ProcessCUTHAD();
- if (fCutValue[kCUTMUO] >= 0.) ProcessCUTMUO();
-//
-// Time of flight
- if (fCutValue[kTOFMAX] >= 0.) ProcessTOFMAX();
-
-//
-// Tracking precission
- if (mediumIsSensitive) ProcessSensitiveMedium();
-}
-
-void TFlukaConfigOption::ProcessDCAY()
-{
- // Process DCAY option
- fprintf(fgFile,"*\n* --- DCAY --- Decays. Flag = %5d\n", fProcessFlag[kDCAY]);
- if (fProcessFlag[kDCAY] == 0) {
- printf("Decays cannot be switched off \n");
- } else {
- fprintf(fgFile, "* Decays are on by default\n");
- }
-}
-
-
-void TFlukaConfigOption::ProcessPAIR()
-{
- // Process PAIR option
- fprintf(fgFile,"*\n* --- PAIR --- Pair production by gammas, muons and hadrons. Flag = %5d, PPCUTM = %13.4g, PPCUTE = %13.4g\n",
- fProcessFlag[kPAIR], fCutValue[kCUTELE], fCutValue[kPPCUTM]);
- //
- // gamma -> e+ e-
- //
- if (fProcessFlag[kPAIR] > 0) {
- fprintf(fgFile,"EMFCUT %10.1f%10.1f%10.4g%10.1f%10.1f%10.1fPHOT-THR\n",0., 0., 0.0, fCMatMin, fCMatMax, 1.);
- } else {
- fprintf(fgFile,"EMFCUT %10.1f%10.1f%10.4g%10.1f%10.1f%10.1fPHOT-THR\n",0., 0., 1e10, fCMatMin, fCMatMax, 1.);
- }
-
- //
- // Direct pair production by Muons and Hadrons
- //
- //
- // Attention ! This card interferes with BREM
- //
-
- if (fProcessFlag[kBREM] == -1 ) fProcessFlag[kBREM] = fgDProcessFlag[kBREM];
- if (fCutValue[kBCUTM] == -1.) fCutValue[kBCUTM] = fgDCutValue[kBCUTM];
-
-
- Float_t flag = -3.;
- if (fProcessFlag[kPAIR] > 0 && fProcessFlag[kBREM] == 0) flag = 1.;
- if (fProcessFlag[kPAIR] == 0 && fProcessFlag[kBREM] > 0) flag = 2.;
- if (fProcessFlag[kPAIR] > 0 && fProcessFlag[kBREM] > 0) flag = 3.;
- if (fProcessFlag[kPAIR] == 0 && fProcessFlag[kBREM] == 0) flag = -3.;
- // Flag BREM card as handled
- fProcessFlag[kBREM] = - fProcessFlag[kBREM];
-
- //
- // Energy cut for pair prodution
- //
- Float_t cutP = fCutValue[kPPCUTM];
- if (fCutValue[kPPCUTM] == -1.) cutP = fgDCutValue[kPPCUTM];
- // In G3 this is the cut on the total energy of the e+e- pair
- // In FLUKA the cut is on the kinetic energy of the electron and poistron
- cutP = cutP / 2. - 0.51099906e-3;
- if (cutP < 0.) cutP = 0.;
- // No explicite generation of e+/e-
- if (fProcessFlag[kPAIR] == 2) cutP = -1.;
- //
- // Energy cut for bremsstrahlung
- //
- Float_t cutB = 0.;
- if (flag > 1.) {
- fprintf(fgFile,"*\n* +++ BREM --- Bremsstrahlung by muons/hadrons. Flag = %5d, BCUTM = %13.4g \n",
- fProcessFlag[kBREM], fCutValue[kBCUTM]);
-
- cutB = fCutValue[kBCUTM];
- // No explicite production of gammas
- if (fProcessFlag[kBREM] == 2) cutB = -1.;
- }
-
- fprintf(fgFile,"PAIRBREM %10.1f%10.4g%10.4g%10.1f%10.1f\n",flag, cutP, cutB, fCMatMin, fCMatMax);
-}
-
-
-void TFlukaConfigOption::ProcessBREM()
-{
- // Process BREM option
- fprintf(fgFile,"*\n* --- BREM --- Bremsstrahlung by e+/- and muons/hadrons. Flag = %5d, BCUTE = %13.4g, BCUTM = %13.4g \n",
- fProcessFlag[kBREM], fCutValue[kBCUTE], fCutValue[kBCUTM]);
-
- //
- // e+/- -> e+/- gamma
- //
- Float_t cutB = fCutValue[kBCUTE];
- if (fCutValue[kBCUTE] == -1.) cutB = fgDCutValue[kBCUTE];
-
-
- if (TMath::Abs(fProcessFlag[kBREM]) > 0) {
- fprintf(fgFile,"EMFCUT %10.4g%10.1f%10.1f%10.1f%10.1f%10.1fELPO-THR\n",cutB, 0., 0., fCMatMin, fCMatMax, 1.);
- } else {
- fprintf(fgFile,"EMFCUT %10.4g%10.1f%10.1f%10.1f%10.1f%10.1fELPO-THR\n",1.e10, 0., 0., fCMatMin, fCMatMax, 1.);
- }
-
- //
- // Bremsstrahlung by muons and hadrons
- //
- cutB = fCutValue[kBCUTM];
- if (fCutValue[kBCUTM] == -1.) cutB = fgDCutValue[kBCUTM];
- if (fProcessFlag[kBREM] == 2) cutB = -1.;
- Float_t flag = 2.;
- if (fProcessFlag[kBREM] == 0) flag = -2.;
-
- fprintf(fgFile,"PAIRBREM %10.1f%10.4g%10.4g%10.1f%10.1f\n", flag, 0., cutB, fCMatMin, fCMatMax);
-}
-
-void TFlukaConfigOption::ProcessCOMP()
-{
- // Process COMP option
- fprintf(fgFile,"*\n* --- COMP --- Compton scattering Flag = %5d \n", fProcessFlag[kCOMP]);
-
- //
- // Compton scattering
- //
-
- if (fProcessFlag[kCOMP] > 0) {
- fprintf(fgFile,"EMFCUT %10.1f%10.1f%10.1f%10.1f%10.1f%10.1fPHOT-THR\n",0. , 0., 0., fCMatMin, fCMatMax, 1.);
- } else {
- fprintf(fgFile,"EMFCUT %10.4g%10.1f%10.1f%10.1f%10.1f%10.1fPHOT-THR\n",1.e10, 0., 0., fCMatMin, fCMatMax, 1.);
- }
-}
-
-void TFlukaConfigOption::ProcessPHOT()
-{
- // Process PHOS option
- fprintf(fgFile,"*\n* --- PHOT --- Photoelectric effect. Flag = %5d\n", fProcessFlag[kPHOT]);
-
- //
- // Photoelectric effect
- //
-
- if (fProcessFlag[kPHOT] > 0) {
- fprintf(fgFile,"EMFCUT %10.4g%10.4g%10.4g%10.1f%10.1f%10.1fPHOT-THR\n",0., 0., 0., fCMatMin, fCMatMax, 1.);
- } else {
- fprintf(fgFile,"EMFCUT %10.1f%10.4g%10.1f%10.1f%10.1f%10.1fPHOT-THR\n",0., 1.e10, 0., fCMatMin, fCMatMax, 1.);
- }
-}
-
-void TFlukaConfigOption::ProcessANNI()
-{
- // Process ANNI option
- fprintf(fgFile,"*\n* --- ANNI --- Positron annihilation. Flag = %5d \n", fProcessFlag[kANNI]);
-
- //
- // Positron annihilation
- //
-
- if (fProcessFlag[kANNI] > 0) {
- fprintf(fgFile,"EMFCUT %10.1f%10.1f%10.1f%10.1f%10.1f%10.1fANNH-THR\n",0. , 0., 0., fCMatMin, fCMatMax, 1.);
- } else {
- fprintf(fgFile,"EMFCUT %10.4g%10.1f%10.1f%10.1f%10.1f%10.1fANNH-THR\n",1.e10, 0., 0., fCMatMin, fCMatMax, 1.);
- }
-}
-
-
-void TFlukaConfigOption::ProcessPFIS()
-{
- // Process PFIS option
- fprintf(fgFile,"*\n* --- PFIS --- Photonuclear interaction Flag = %5d\n", fProcessFlag[kPFIS]);
-
- //
- // Photonuclear interactions
- //
-
- if (fProcessFlag[kPFIS] > 0) {
- fprintf(fgFile,"PHOTONUC %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f\n",(Float_t) fProcessFlag[kPFIS], 0., 0., fCMatMin, fCMatMax, 1.);
- } else {
- fprintf(fgFile,"PHOTONUC %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f\n",-1. , 0., 0., fCMatMin, fCMatMax, 1.);
- }
-}
-
-void TFlukaConfigOption::ProcessMUNU()
-{
- // Process MUNU option
- fprintf(fgFile,"*\n* --- MUNU --- Muon nuclear interaction. Flag = %5d\n", fProcessFlag[kMUNU]);
-
- //
- // Muon nuclear interactions
- //
- if (fProcessFlag[kMUNU] > 0) {
- fprintf(fgFile,"MUPHOTON %10.1f%10.3f%10.3f%10.1f%10.1f%10.1f\n",(Float_t )fProcessFlag[kMUNU], 0.25, 0.75, fCMatMin, fCMatMax, 1.);
- } else {
- fprintf(fgFile,"MUPHOTON %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f\n",-1. , 0., 0., fCMatMin, fCMatMax, 1.);
- }
-}
-
-void TFlukaConfigOption::ProcessRAYL()
-{
- // Process RAYL option
- fprintf(fgFile,"*\n* --- RAYL --- Rayleigh Scattering. Flag = %5d\n", fProcessFlag[kRAYL]);
-
- //
- // Rayleigh scattering
- //
- Int_t nreg;
- Int_t* reglist = fgGeom->GetMaterialList(fMedium, nreg);
- //
- // Loop over regions of a given material
- for (Int_t k = 0; k < nreg; k++) {
- Float_t ireg = reglist[k];
- if (fProcessFlag[kRAYL] > 0) {
- fprintf(fgFile,"EMFRAY %10.1f%10.1f%10.1f%10.1f\n", 1., ireg, ireg, 1.);
- } else {
- fprintf(fgFile,"EMFRAY %10.1f%10.1f%10.1f%10.1f\n", 3., ireg, ireg, 1.);
- }
- }
-}
-
-void TFlukaConfigOption::ProcessCKOV()
-{
- // Process CKOV option
- fprintf(fgFile,"*\n* --- CKOV --- Cerenkov Photon production. %5d\n", fProcessFlag[kCKOV]);
-
- //
- // Cerenkov photon production
- //
-
- TFluka* fluka = (TFluka*) gMC;
- TObjArray *matList = fluka->GetFlukaMaterials();
- Int_t nmaterial = matList->GetEntriesFast();
- for (Int_t im = 0; im < nmaterial; im++)
- {
- TGeoMaterial* material = dynamic_cast<TGeoMaterial*> (matList->At(im));
- Int_t idmat = material->GetIndex();
-//
-// Check if global option
- if (fMedium != -1 && idmat != fMedium) continue;
-
- TFlukaCerenkov* cerenkovProp;
- if (!(cerenkovProp = dynamic_cast<TFlukaCerenkov*>(material->GetCerenkovProperties()))) continue;
- //
- // This medium has Cerenkov properties
- //
- //
- if (fMedium == -1 || (fMedium != -1 && fProcessFlag[kCKOV] > 0)) {
- // Write OPT-PROD card for each medium
- Float_t emin = cerenkovProp->GetMinimumEnergy();
- Float_t emax = cerenkovProp->GetMaximumEnergy();
- fprintf(fgFile, "OPT-PROD %10.4g%10.4g%10.4g%10.4g%10.4g%10.4gCERENKOV\n", emin, emax, 0.,
- Float_t(idmat), Float_t(idmat), 0.);
- //
- // Write OPT-PROP card for each medium
- // Forcing FLUKA to call user routines (queffc.cxx, rflctv.cxx, rfrndx.cxx)
- //
- fprintf(fgFile, "OPT-PROP %10.4g%10.4g%10.4g%10.1f%10.1f%10.1fWV-LIMIT\n",
- cerenkovProp->GetMinimumWavelength(), cerenkovProp->GetMaximumWavelength(), cerenkovProp->GetMaximumWavelength(),
- Float_t(idmat), Float_t(idmat), 0.0);
-
-
- fprintf(fgFile, "OPT-PROP %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f\n", -100., -100., -100.,
- Float_t(idmat), Float_t(idmat), 0.0);
-
- for (Int_t j = 0; j < 3; j++) {
- fprintf(fgFile, "OPT-PROP %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f&\n", -100., -100., -100.,
- Float_t(idmat), Float_t(idmat), 0.0);
- }
-
-
- // Photon detection efficiency user defined
- if (cerenkovProp->IsSensitive())
- fprintf(fgFile, "OPT-PROP %10.1f%10.1f%10.1f%10.1f%10.1f%10.1fSENSITIV\n", -100., -100., -100.,
- Float_t(idmat), Float_t(idmat), 0.0);
- // Material has a reflective surface
- if (cerenkovProp->IsMetal())
- fprintf(fgFile, "OPT-PROP %10.1f%10.1f%10.1f%10.1f%10.1f%10.1fMETAL\n", -100., -100., -100.,
- Float_t(idmat), Float_t(idmat), 0.0);
-
- } else {
- fprintf(fgFile,"OPT-PROD %10.1f%10.1f%10.1f%10.1f%10.1f%10.1fCERE-OFF\n",0., 0., 0., fCMatMin, fCMatMax, 1.);
- }
- }
-}
-
-
-void TFlukaConfigOption::ProcessHADR()
-{
- // Process HADR option
- fprintf(fgFile,"*\n* --- HADR --- Hadronic interactions. Flag = %5d\n", fProcessFlag[kHADR]);
-
- if (fProcessFlag[kHADR] > 0) {
- fprintf(fgFile,"*\n*Hadronic interaction is ON by default in FLUKA\n");
- } else {
- if (fMedium != -1) {
- printf("Hadronic interactions cannot be switched off material by material !\n");
- } else {
- fprintf(fgFile,"THRESHOL %10.1f%10.1f%10.1f%10.1e%10.1f\n",0., 0., 0., 1.e10, 0.);
- }
- }
-}
-
-
-
-void TFlukaConfigOption::ProcessMULS()
-{
- // Process MULS option
- fprintf(fgFile,"*\n* --- MULS --- Muliple Scattering. Flag = %5d\n", fProcessFlag[kMULS]);
- //
- // Multiple scattering
- //
- if (fProcessFlag[kMULS] > 0) {
- fprintf(fgFile,"*\n*Multiple scattering is ON by default in FLUKA\n");
- } else {
- fprintf(fgFile,"MULSOPT %10.1f%10.1f%10.1f%10.1f%10.1f\n",0., 3., 3., fCMatMin, fCMatMax);
- }
-}
-
-void TFlukaConfigOption::ProcessLOSS()
-{
- // Process LOSS option
- fprintf(fgFile,"*\n* --- LOSS --- Ionisation energy loss. Flags: LOSS = %5d, DRAY = %5d, STRA = %5d; Cuts: DCUTE = %13.4g, DCUTM = %13.4g \n",
- fProcessFlag[kLOSS], fProcessFlag[kDRAY], fProcessFlag[kSTRA], fCutValue[kDCUTE], fCutValue[kDCUTM]);
- //
- // Ionisation energy loss
- //
- //
- // Impose consistency
-
- if (fProcessFlag[kLOSS] == 1 || fProcessFlag[kLOSS] == 3 || fProcessFlag[kLOSS] > 10) {
- // Restricted fluctuations
- fProcessFlag[kDRAY] = 1;
- } else if (fProcessFlag[kLOSS] == 2) {
- // Full fluctuations
- fProcessFlag[kDRAY] = 0;
- fCutValue[kDCUTE] = 1.e10;
- fCutValue[kDCUTM] = 1.e10;
- } else {
- if (fProcessFlag[kDRAY] == 1) {
- fProcessFlag[kLOSS] = 1;
- } else if (fProcessFlag[kDRAY] == 0) {
- fProcessFlag[kLOSS] = 2;
- fCutValue[kDCUTE] = 1.e10;
- fCutValue[kDCUTM] = 1.e10;
- }
- }
-
- if (fCutValue[kDCUTE] == -1.) fCutValue[kDCUTE] = fgDCutValue[kDCUTE];
- if (fCutValue[kDCUTM] == -1.) fCutValue[kDCUTM] = fgDCutValue[kDCUTM];
-
- Float_t cutM = fCutValue[kDCUTM];
-
-
- if (fProcessFlag[kSTRA] == -1) fProcessFlag[kSTRA] = fgDProcessFlag[kSTRA];
- if (fProcessFlag[kSTRA] == 0) fProcessFlag[kSTRA] = 1;
- Float_t stra = (Float_t) fProcessFlag[kSTRA];
-
-
- if (fProcessFlag[kLOSS] == 1 || fProcessFlag[kLOSS] == 3) {
-//
-// Restricted energy loss fluctuations
-//
- fprintf(fgFile,"IONFLUCT %10.1f%10.1f%10.1f%10.1f%10.1f\n", 1., 1., stra, fCMatMin, fCMatMax);
- fprintf(fgFile,"DELTARAY %10.4g%10.1f%10.1f%10.1f%10.1f%10.1f\n", cutM, 0., 0., fCMatMin, fCMatMax, 1.);
- } else if (fProcessFlag[kLOSS] > 10) {
-//
-// Primary ionisation electron generation
-//
- // Ionisation model
- Float_t ioModel = Float_t (fProcessFlag[kLOSS]-10);
- // Effective 1st ionisation potential
- Float_t ePot = ModelParameter(kPRIMIOE);
- // Number of primary ionisations per cm for a mip
- Float_t nPrim = ModelParameter(kPRIMION);
-
- fprintf(fgFile,"IONFLUCT %10.1f%10.1f%10.1f%10.1f%10.1f\n", 1., 1., stra, fCMatMin, fCMatMax);
- fprintf(fgFile,"IONFLUCT %10.1f%10.1f%10.1f%10.1f%10.1f%10.1fPRIM-ION\n", ePot, nPrim, ioModel, fCMatMin, fCMatMax, 1.);
- fprintf(fgFile,"DELTARAY %10.4g%10.1f%10.1f%10.1f%10.1f%10.1f\n", cutM, 0., 0., fCMatMin, fCMatMax, 1.);
- } else if (fProcessFlag[kLOSS] == 4) {
-//
-// No fluctuations
-//
- fprintf(fgFile,"IONFLUCT %10.1f%10.1f%10.1f%10.1f%10.1f\n",-1., -1., stra, fCMatMin, fCMatMax);
- fprintf(fgFile,"DELTARAY %10.4g%10.1f%10.1f%10.1f%10.1f%10.1f\n", -1., 0., 0., fCMatMin, fCMatMax, 1.);
- } else {
-//
-// Full fluctuations
-//
- fprintf(fgFile,"IONFLUCT %10.1f%10.1f%10.1f%10.1f%10.1f\n",1., 1., stra, fCMatMin, fCMatMax);
- fprintf(fgFile,"DELTARAY %10.4g%10.1f%10.1f%10.1f%10.1f%10.1f\n", -1., 0., 0., fCMatMin, fCMatMax, 1.);
- }
-}
-
-
-void TFlukaConfigOption::ProcessCUTGAM()
-{
-// Cut on gammas
-//
- fprintf(fgFile,"*\n*Cut for Gammas. CUTGAM = %13.4g\n", fCutValue[kCUTGAM]);
- if (fMedium == -1) {
- fprintf(fgFile,"EMFCUT %10.4g%10.4g%10.1f%10.1f%10.1f%10.1f\n",
- 0., fCutValue[kCUTGAM], 0., 0., Float_t(fgGeom->NofVolumes()), 1.);
-
- } else {
- Int_t nreg, *reglist;
- Float_t ireg;
- reglist = fgGeom->GetMaterialList(fMedium, nreg);
- // Loop over regions of a given material
- for (Int_t k = 0; k < nreg; k++) {
- ireg = reglist[k];
- fprintf(fgFile,"EMFCUT %10.4g%10.4g%10.1f%10.1f%10.1f%10.1f\n", 0.,fCutValue[kCUTGAM], 0., ireg, ireg, 1.);
- }
- }
-
- // Transport production cut used for pemf
- //
- // FUDGEM paramter. The parameter takes into account th contribution of atomic electrons to multiple scattering.
- // For production and transport cut-offs larger than 100 keV it must be set = 1.0, while in the keV region it must be
- Float_t parFudgem = (fCutValue[kCUTGAM] > 1.e-4)? 1.0 : 0.0 ;
- fprintf(fgFile,"EMFCUT %10.4g%10.4g%10.1f%10.1f%10.1f%10.1fPROD-CUT\n",
- 0., fCutValue[kCUTGAM], parFudgem, fCMatMin, fCMatMax, 1.);
-}
-
-void TFlukaConfigOption::ProcessCUTELE()
-{
-// Cut on e+/e-
-//
- fprintf(fgFile,"*\n*Cut for e+/e-. CUTELE = %13.4g\n", fCutValue[kCUTELE]);
- if (fMedium == -1) {
- fprintf(fgFile,"EMFCUT %10.4g%10.4g%10.1f%10.1f%10.1f%10.1f\n",
- -fCutValue[kCUTELE], 0., 0., 0., Float_t(fgGeom->NofVolumes()), 1.);
- } else {
- Int_t nreg, *reglist;
- Float_t ireg;
- reglist = fgGeom->GetMaterialList(fMedium, nreg);
- // Loop over regions of a given material
- for (Int_t k = 0; k < nreg; k++) {
- ireg = reglist[k];
- fprintf(fgFile,"EMFCUT %10.4g%10.4g%10.1f%10.1f%10.1f%10.1f\n", -fCutValue[kCUTELE], 0., 0., ireg, ireg, 1.);
- }
- }
- // Transport production cut used for pemf
- //
- // FUDGEM paramter. The parameter takes into account th contribution of atomic electrons to multiple scattering.
- // For production and transport cut-offs larger than 100 keV it must be set = 1.0, while in the keV region it must be
- Float_t parFudgem = (fCutValue[kCUTELE] > 1.e-4)? 1.0 : 0.0;
- fprintf(fgFile,"EMFCUT %10.4g%10.4g%10.1f%10.1f%10.1f%10.1fPROD-CUT\n",
- -fCutValue[kCUTELE], 0., parFudgem, fCMatMin, fCMatMax, 1.);
-}
-
-void TFlukaConfigOption::ProcessCUTNEU()
-{
- // Cut on neutral hadrons
- fprintf(fgFile,"*\n*Cut for neutral hadrons. CUTNEU = %13.4g\n", fCutValue[kCUTNEU]);
-
- // Cut on neutral hadrons
- fprintf(fgFile,"*\n*Cut for neutral hadrons. CUTNEU = %13.4g\n", fCutValue[kCUTNEU]);
-
- // Energy group structure of the 72-neutron ENEA data set:
- const Float_t neutronGroupUpLimit[72] = {
- 1.9600E-02, 1.7500E-02, 1.4918E-02, 1.3499E-02, 1.2214E-02, 1.1052E-02, 1.0000E-02, 9.0484E-03,
- 8.1873E-03, 7.4082E-03, 6.7032E-03, 6.0653E-03, 5.4881E-03, 4.9659E-03, 4.4933E-03, 4.0657E-03,
- 3.6788E-03, 3.3287E-03, 3.0119E-03, 2.7253E-03, 2.4660E-03, 2.2313E-03, 2.0190E-03, 1.8268E-03,
- 1.6530E-03, 1.4957E-03, 1.3534E-03, 1.2246E-03, 1.1080E-03, 1.0026E-03, 9.0718E-04, 8.2085E-04,
- 7.4274E-04, 6.0810E-04, 4.9787E-04, 4.0762E-04, 3.3373E-04, 2.7324E-04, 2.2371E-04, 1.8316E-04,
- 1.4996E-04, 1.2277E-04, 8.6517E-05, 5.2475E-05, 3.1828E-05, 2.1852E-05, 1.5034E-05, 1.0332E-05,
- 7.1018E-06, 4.8809E-06, 3.3546E-06, 2.3054E-06, 1.5846E-06, 1.0446E-06, 6.8871E-07, 4.5400E-07,
- 2.7537E-07, 1.6702E-07, 1.0130E-07, 6.1442E-08, 3.7267E-08, 2.2603E-08, 1.5535E-08, 1.0677E-08,
- 7.3375E-09, 5.0435E-09, 3.4662E-09, 2.3824E-09, 1.6374E-09, 1.1254E-09, 6.8257E-10, 4.1400E-10
- };
-
- Float_t cut = fCutValue[kCUTNEU];
- //
- // 8.0 = Neutron
- // 9.0 = Antineutron
- // Find the FLUKA neutron group corresponding to the cut
- //
- Float_t neutronCut = cut;
- Int_t groupCut = 1; // if cut is > 19.6 MeV no low energy neutron transport is performed
- if (neutronCut < 0.0196) {
- neutronCut = 0.0196;
- // Search the group cutoff for the energy cut
- Int_t i;
- for( i=0; i<72; i++ ) {
- if (cut > neutronGroupUpLimit[i]) break;
- }
- groupCut = i+1;
- }
-
- if (fMedium == -1) {
- Float_t cutV = fCutValue[kCUTNEU];
- // 8.0 = Neutron
- // 9.0 = Antineutron
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -neutronCut, 8.0, 9.0);
- fprintf(fgFile,"LOW-BIAS %10.4g%10.4g%10.1f%10.1f%10.1f%10.1f\n",
- Float_t(groupCut), 73.0, 0.95, 2., Float_t(fgGeom->NofVolumes()), 1.);
- //
- //
- // 12.0 = Kaon zero long
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cutV, 12.0, 12.0);
- // 17.0 = Lambda, 18.0 = Antilambda
- // 19.0 = Kaon zero short
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cutV, 17.0, 19.0);
- // 22.0 = Sigma zero, Pion zero, Kaon zero
- // 25.0 = Antikaon zero
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cutV, 22.0, 25.0);
- // 32.0 = Antisigma zero
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cutV, 32.0, 32.0);
- // 34.0 = Xi zero
- // 35.0 = AntiXi zero
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cutV, 34.0, 35.0);
- // 47.0 = D zero
- // 48.0 = AntiD zero
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cutV, 47.0, 48.0);
- // 53.0 = Xi_c zero
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cutV, 53.0, 53.0);
- // 55.0 = Xi'_c zero
- // 56.0 = Omega_c zero
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cutV, 55.0, 56.0);
- // 59.0 = AntiXi_c zero
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cutV, 59.0, 59.0);
- // 61.0 = AntiXi'_c zero
- // 62.0 = AntiOmega_c zero
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cutV, 61.0, 62.0);
- } else {
- TFluka* fluka = (TFluka*) gMC;
- printf("Low energy neutron transport %5d\n", fluka->LowEnergyNeutronTransport());
-
- if (!(fluka->LowEnergyNeutronTransport())) {
- Int_t nreg, *reglist;
- Float_t ireg;
- reglist = fgGeom->GetMaterialList(fMedium, nreg);
-
- // Loop over regions of a given material
- for (Int_t k = 0; k < nreg; k++) {
- ireg = reglist[k];
- fprintf(fgFile,"LOW-BIAS %10.4g%10.4g%10.1f%10.1f%10.1f%10.1f\n",
- Float_t(groupCut), 73.0, 0.95, ireg, ireg, 1.);
- }
- }
- Warning("ProcessCUTNEU",
- "Material #%4d %s: Cut on neutral hadrons (Ekin > %9.3e) material by material only implemented for low-energy neutrons !\n",
- fMedium, fCMaterial->GetName(), cut);
- }
-}
-
-void TFlukaConfigOption::ProcessCUTHAD()
-{
- // Cut on charged hadrons
- fprintf(fgFile,"*\n*Cut for charge hadrons. CUTHAD = %13.4g\n", fCutValue[kCUTHAD]);
- Float_t cut = fCutValue[kCUTHAD];
- if (fMedium == -1) {
- // 1.0 = Proton
- // 2.0 = Antiproton
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 1.0, 2.0);
- // 13.0 = Positive Pion, Negative Pion, Positive Kaon
- // 16.0 = Negative Kaon
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 13.0, 16.0);
- // 20.0 = Negative Sigma
- // 21.0 = Positive Sigma
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 20.0, 21.0);
- // 31.0 = Antisigma minus
- // 33.0 = Antisigma plus
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 31.0, 31.0);
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 33.0, 33.0);
- // 36.0 = Negative Xi, Positive Xi, Omega minus
- // 39.0 = Antiomega
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 36.0, 39.0);
- // 45.0 = D plus
- // 46.0 = D minus
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 45.0, 46.0);
- // 49.0 = D_s plus, D_s minus, Lambda_c plus
- // 52.0 = Xi_c plus
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 49.0, 52.0);
- // 54.0 = Xi'_c plus
- // 60.0 = AntiXi'_c minus
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 54.0, 54.0);
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 60.0, 60.0);
- // 57.0 = Antilambda_c minus
- // 58.0 = AntiXi_c minus
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n", -cut, 57.0, 58.0);
- } else {
- Warning("ProcessCUTHAD",
- "Material #%4d %s: Cut on charged hadrons (Ekin > %9.3e) material by material not yet implemented !\n",
- fMedium, fCMaterial->GetName(), cut);
- }
-}
-
-void TFlukaConfigOption::ProcessCUTMUO()
-{
- // Cut on muons
- fprintf(fgFile,"*\n*Cut for muons. CUTMUO = %13.4g\n", fCutValue[kCUTMUO]);
- Float_t cut = fCutValue[kCUTMUO];
- if (fMedium == -1) {
- fprintf(fgFile,"PART-THR %10.4g%10.1f%10.1f\n",-cut, 10.0, 11.0);
- } else {
- Warning("ProcessCUTMUO", "Material #%4d %s: Cut on muons (Ekin > %9.3e) material by material not yet implemented !\n",
- fMedium, fCMaterial->GetName(), cut);
- }
-
-
-}
-
-void TFlukaConfigOption::ProcessTOFMAX()
-{
- // Cut time of flight
- Float_t cut = fCutValue[kTOFMAX];
- fprintf(fgFile,"*\n*Cut on time of flight. TOFMAX = %13.4g\n", fCutValue[kTOFMAX]);
- fprintf(fgFile,"TIME-CUT %10.4g%10.1f%10.1f%10.1f%10.1f\n",cut*1.e9,0.,0.,-6.0,64.0);
-}
-
-void TFlukaConfigOption::ProcessSensitiveMedium()
-{
- //
- // Special options for sensitive media
- //
-
- fprintf(fgFile,"*\n*Options for sensitive medium \n");
- //
- // EMFFIX
- fprintf(fgFile,"EMFFIX %10.4g%10.4g%10.1f%10.1f%10.1f%10.1f\n", fCMatMin, 0.05, 0., 0., 0., 0.);
- //
- // FLUKAFIX
- fprintf(fgFile,"FLUKAFIX %10.3g %10.3f\n", 0.05, fCMatMin);
-}
+++ /dev/null
-#ifndef TFLUKACONFIGOPTION
-#define TFLUKACONFIGOPTION
-
-/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * See cxx source for full Copyright notice */
-
-/* $Id$ */
-
-///////////////////////////////////////////////////////////////////////////////
-// //
-// //
-// Class to store FLUKA and VMC configuration options: //
-// Cuts, Processes, User Scoring //
-// //
-// //
-// Author: andreas.morsch@cern.ch //
-// //
-// //
-///////////////////////////////////////////////////////////////////////////////
-//
-
-
-//
-
-#include <TObject.h>
-
-typedef enum {kDCAY, kPAIR, kCOMP, kPHOT, kPFIS, kDRAY, kANNI, kBREM,
- kMUNU, kCKOV, kHADR, kLOSS, kMULS, kRAYL, kSTRA} FlukaProcessOption_t;
-typedef enum {kCUTGAM, kCUTELE, kCUTNEU, kCUTHAD, kCUTMUO, kBCUTE, kBCUTM, kDCUTE, kDCUTM, kPPCUTM, kTOFMAX} FlukaCutOption_t;
-typedef enum {kPRIMION, kPRIMIOE} FlukaModelOption_t;
-
-class TFlukaMCGeometry;
-class TGeoMaterial;
-
-class TFlukaConfigOption : public TObject
-{
-public:
- // Constructors
- TFlukaConfigOption();
- TFlukaConfigOption(Int_t imed);
- // Getters
- Double_t Cut(FlukaCutOption_t i) const {return fCutValue[i];}
- Int_t Flag(FlukaProcessOption_t i) const {return fProcessFlag[i];}
- Double_t ModelParameter(FlukaModelOption_t i) const {return fModelParameter[i];}
- Int_t Medium() const {return fMedium;}
- // Setters
- void SetCut(const char* flagname, Double_t val);
- void SetModelParameter(const char* flagname, Double_t val);
- void SetProcess(const char* flagname, Int_t flagValue);
- void SetMedium(Int_t imed) {fMedium = imed;}
- //
- void WriteFlukaInputCards();
- void ProcessDCAY();
- void ProcessPAIR();
- void ProcessBREM();
- void ProcessCOMP();
- void ProcessPHOT();
- void ProcessANNI();
- void ProcessPFIS();
- void ProcessMUNU();
- void ProcessRAYL();
- void ProcessCKOV();
- void ProcessHADR();
- void ProcessMULS();
- void ProcessLOSS();
-
- void ProcessCUTGAM();
- void ProcessCUTELE();
- void ProcessCUTNEU();
- void ProcessCUTHAD();
- void ProcessCUTMUO();
- void ProcessTOFMAX();
- void ProcessSensitiveMedium();
-
- //
- static void SetStaticInfo(FILE* file, Float_t matMin, Float_t matMax, TFlukaMCGeometry* geom)
- {fgFile = file; fgMatMin = matMin; fgMatMax = matMax; fgGeom = geom;}
- static Double_t DefaultCut(FlukaCutOption_t i) {return fgDCutValue[i];}
- static Int_t DefaultProcessFlag(FlukaProcessOption_t i) {return fgDProcessFlag[i];}
-
-
- protected:
- Double_t fCutValue[11]; // User cut
- Int_t fProcessFlag[15]; // User flag assigned to processes
- Double_t fModelParameter[15]; // User model parameter
- Int_t fMedium; // Material assigned to user settings
- Float_t fCMatMin; // Minimum material number used for current card
- Float_t fCMatMax; // Maximum material number used for current card
- TGeoMaterial* fCMaterial; // Current material
-
- // static
- static Double_t fgDCutValue[11]; // User default cut
- static Int_t fgDProcessFlag[15]; // User default flag assigned to processes
- static Float_t fgMatMin; // Minimum material number
- static Float_t fgMatMax; // Maximum meterial number
- static FILE* fgFile; // Output file
- static TFlukaMCGeometry* fgGeom; // Pointer to geometry
-
- private:
- // Copy constructor and operator= declared but not implemented (-Weff++ flag)
- TFlukaConfigOption(const TFlukaConfigOption&);
- TFlukaConfigOption& operator=(const TFlukaConfigOption&);
-
- ClassDef(TFlukaConfigOption, 1) // Fluka Configuration Option
-};
-
-#endif
-
+++ /dev/null
-/**************************************************************************
- * Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * *
- * Author: The ALICE Off-line Project. *
- * Contributors are mentioned in the code where appropriate. *
- * *
- * Permission to use, copy, modify and distribute this software and its *
- * documentation strictly for non-commercial purposes is hereby granted *
- * without fee, provided that the above copyright notice appears in all *
- * copies and that both the copyright notice and this permission notice *
- * appear in the supporting documentation. The authors make no claims *
- * about the suitability of this software for any purpose. It is *
- * provided "as is" without express or implied warranty. *
- **************************************************************************/
-
-/* $Id$*/
-
-//
-// Stores user defined ion properties.
-// Fluka allows only one user defined ion which can be used as a beam particle.
-// Author:
-// A. Morsch
-// andreas.morsch@cern.ch
-//
-
-#include "TFlukaIon.h"
-#include <TDatabasePDG.h>
-
-ClassImp(TFlukaIon)
-
-
-TFlukaIon::TFlukaIon() :
- TNamed("", "Ion"),
- fZ(0),
- fA(0),
- fQ(0),
- fExEnergy(0.),
- fMass(0.)
-{
-// Default constructor
-}
-
-
-TFlukaIon::TFlukaIon(const char* name, Int_t z, Int_t a, Int_t q, Double_t exE, Double_t mass) :
- TNamed(name, "Ion"),
- fZ(z),
- fA(a),
- fQ(q),
- fExEnergy(exE),
- fMass(mass)
-
-{
-// Constructor
- AddIon(a, z);
-}
-
-Int_t TFlukaIon::GetIonPdg(Int_t z, Int_t a, Int_t i)
-{
-// Acording to
-// http://cepa.fnal.gov/psm/stdhep/pdg/montecarlorpp-2006.pdf
-
- return 1000000000 + 10*1000*z + 10*a + i;
-}
-
-Int_t TFlukaIon::GetZ(Int_t pdg)
-{
-// Acording to
-// http://cepa.fnal.gov/psm/stdhep/pdg/montecarlorpp-2006.pdf
-
- return (pdg - 1000000000)/10000;
-}
-
-
-Int_t TFlukaIon::GetA(Int_t pdg)
-{
-// Acording to
-// http://cepa.fnal.gov/psm/stdhep/pdg/montecarlorpp-2006.pdf
-
- Int_t a = pdg - 1000000000;
- a %= 10000;
- a /= 10;
- return (a);
-}
-
-Int_t TFlukaIon::GetIsomerNumber(Int_t pdg)
-{
-// Acording to
-// http://cepa.fnal.gov/psm/stdhep/pdg/montecarlorpp-2006.pdf
-
- Int_t is = pdg - 1000000000;
- is %= 10000;
- is %= 10;
- return (is);
-}
-
-void TFlukaIon::AddIon(Int_t a, Int_t z)
-{
-
- // Add a new ion
- TDatabasePDG *pdgDB = TDatabasePDG::Instance();
- const Double_t kAu2Gev = 0.9314943228;
- Int_t pdg = GetIonPdg(z, a);
- if (pdgDB->GetParticle(pdg)) return;
-
- pdgDB->AddParticle(Form("Iion A = %5d Z = %5d", a, z),"Ion", Float_t(a) * kAu2Gev + 8.071e-3, kTRUE,
- 0, 3 * z, "Ion", pdg);
-}
-
-void TFlukaIon::AddIon(const char* name, Int_t z, Int_t a, Int_t q,
- Double_t exE, Double_t mass)
-{
-// User defined ion
- TDatabasePDG *pdgDB = TDatabasePDG::Instance();
- const Double_t kAu2Gev = 0.9314943228;
- Int_t is = (exE > 0.)? 1 : 0;
- if (q == 0) q = z;
- Int_t pdg = GetIonPdg(z, a, is);
- if (pdgDB->GetParticle(pdg)) return;
- if (mass == 0.) mass = Float_t(a) * kAu2Gev + 8.071e-3;
-
- pdgDB->AddParticle(name, "User Ion", mass, kTRUE, 0, 3 * q, "Ion", pdg);
-}
-
-void TFlukaIon::WriteUserInputCard(FILE* pFlukaVmcInp)
-{
- // Write the user input card
- // EVENTYPE 0. 0. 2. 0. 0. 0.DPMJET
- fprintf(pFlukaVmcInp,"EVENTYPE 0. 0. 2. 0. 0. 0.DPMJET\n");
-}
+++ /dev/null
-#ifndef TFLUKAION_H
-#define TFLUKAION_H
-
-/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * See cxx source for full Copyright notice */
-
-/* $Id$ */
-
-///////////////////////////////////////////////////////////////////////////////
-// //
-// //
-// Class that gives access to properties of ions used as primary particles //
-// //
-// //
-// //
-///////////////////////////////////////////////////////////////////////////////
-
-
-#include <TNamed.h>
-
-class TFlukaIon : public TNamed
-{
-
-public:
- TFlukaIon();
- TFlukaIon(const char* name, Int_t z, Int_t a, Int_t q, Double_t exE, Double_t mass = 0.);
- Int_t GetZ() const {return fZ;}
- Int_t GetA() const {return fA;}
-
- Int_t GetQ() const {return fQ;}
- Double_t GetExcitationEnergy() const {return fExEnergy;}
- Double_t GetMass() const {return fMass;}
- Int_t GetPdgCode() const {return GetIonPdg(fZ, fA);}
- //
- static void WriteUserInputCard(FILE* file);
- //
- static void AddIon(Int_t a, Int_t z);
- static void AddIon(const char* name, Int_t z, Int_t a, Int_t q,
- Double_t exE, Double_t mass);
- static Int_t GetIonPdg(Int_t z, Int_t a, Int_t i = 0);
- static Int_t GetZ(Int_t pdg);
- static Int_t GetA(Int_t pdg);
- static Int_t GetIsomerNumber(Int_t pdg);
-
- protected:
- Int_t fZ; // Z
- Int_t fA; // A
- Int_t fQ; // Q
- Double_t fExEnergy; // Excitation energy
- Double_t fMass; // Mass
- private:
- // Copy constructor and operator= declared but not implemented (-Weff++ flag)
- TFlukaIon(const TFlukaIon&);
- TFlukaIon& operator=(const TFlukaIon&);
-
- ClassDef(TFlukaIon, 1) // Ion Properties
-};
-
-#endif
-
+++ /dev/null
-#ifdef __CINT__
-/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * See cxx source for full Copyright notice */
-
-/* $Id$ */
-
-#pragma link off all globals;
-#pragma link off all classes;
-#pragma link off all functions;
-
-
-#pragma link C++ class TFluka+;
-#pragma link C++ class TFlukaIon+;
-#pragma link C++ class TFlukaMCGeometry+;
-#pragma link C++ class TFlukaCerenkov+;
-#pragma link C++ class TFlukaConfigOption+;
-#pragma link C++ class TFlukaScoringOption+;
-
-#endif
-
-
-
-
-
+++ /dev/null
-/**************************************************************************
- * Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * *
- * Author: The ALICE Off-line Project. *
- * Contributors are mentioned in the code where appropriate. *
- * *
- * Permission to use, copy, modify and distribute this software and its *
- * documentation strictly for non-commercial purposes is hereby granted *
- * without fee, provided that the above copyright notice appears in all *
- * copies and that both the copyright notice and this permission notice *
- * appear in the supporting documentation. The authors make no claims *
- * about the suitability of this software for any purpose. It is *
- * provided "as is" without express or implied warranty. *
- **************************************************************************/
-
-// $Id$
-
-// Class TFlukaMCGeometry
-// --------------------
-// Implementation of the TVirtualMCGeometry interface
-// for defining and using TGeo geometry with FLUKA.
-// This allows the FLUKA MonteCarlo to run with the TGeo
-// geometrical modeller
-// Author: Andrei Gheata 10/07/2003
-
-#include "Riostream.h"
-#include "TList.h"
-#include "TCallf77.h"
-#include "TFluka.h"
-#include "TSystem.h"
-#include "TFlukaMCGeometry.h"
-#include "TFlukaConfigOption.h"
-#include "TGeoManager.h"
-#include "TGeoVolume.h"
-#include "TObjString.h"
-#include "Fsourcm.h"
-#include "Ftrackr.h"
-#include "Fstepsz.h" //(STEPSZ) fluka common
-
-#ifndef WIN32
-# define idnrwr idnrwr_
-# define g1wr g1wr_
-# define g1rtwr g1rtwr_
-# define conhwr conhwr_
-# define inihwr inihwr_
-# define jomiwr jomiwr_
-# define lkdbwr lkdbwr_
-# define lkfxwr lkfxwr_
-# define lkmgwr lkmgwr_
-# define lkwr lkwr_
-# define magfld magfld_
-# define nrmlwr nrmlwr_
-# define rgrpwr rgrpwr_
-# define isvhwr isvhwr_
-
-#else
-
-# define idnrwr IDNRWR
-# define g1wr G1WR
-# define g1rtwr G1RTWR
-# define conhwr CONHWR
-# define inihwr INIHWR
-# define jomiwr JOMIWR
-# define lkdbwr LKDBWR
-# define lkfxwr LKFXWR
-# define lkmgwr LKMGWR
-# define lkwr LKWR
-# define magfld MAGFLD
-# define nrmlwr NRMLWR
-# define rgrpwr RGRPWR
-# define isvhwr ISVHWR
-
-#endif
-
-//____________________________________________________________________________
-extern "C"
-{
- //
- // Prototypes for FLUKA navigation methods
- //
- Int_t type_of_call idnrwr(const Int_t & /*nreg*/, const Int_t & /*mlat*/);
- void type_of_call g1wr(Double_t & /*pSx*/, Double_t & /*pSy*/, Double_t & /*pSz*/,
- Double_t * /*pV*/, Int_t & /*oldReg*/ , const Int_t & /*oldLttc*/, Double_t & /*propStep*/,
- Int_t & /*nascFlag*/, Double_t & /*retStep*/, Int_t & /*newReg*/,
- Double_t & /*saf*/, Int_t & /*newLttc*/, Int_t & /*LttcFlag*/,
- Double_t *s /*Lt*/, Int_t * /*jrLt*/);
-
- void type_of_call g1rtwr();
- void type_of_call conhwr(Int_t & /*intHist*/, Int_t & /*incrCount*/);
- void type_of_call inihwr(Int_t & /*intHist*/);
- void type_of_call jomiwr(const Int_t & /*nge*/, const Int_t & /*lin*/, const Int_t & /*lou*/,
- Int_t & /*flukaReg*/);
- void type_of_call lkdbwr(Double_t & /*pSx*/, Double_t & /*pSy*/, Double_t & /*pSz*/,
- Double_t * /*pV*/, const Int_t & /*oldReg*/, const Int_t & /*oldLttc*/,
- Int_t & /*flagErr*/, Int_t & /*newReg*/, Int_t & /*newLttc*/);
- void type_of_call lkfxwr(Double_t & /*pSx*/, Double_t & /*pSy*/, Double_t & /*pSz*/,
- Double_t * /*pV*/, const Int_t & /*oldReg*/, const Int_t & /*oldLttc*/,
- Int_t & /*flagErr*/, Int_t & /*newReg*/, Int_t & /*newLttc*/);
- void type_of_call lkmgwr(Double_t & /*pSx*/, Double_t & /*pSy*/, Double_t & /*pSz*/,
- Double_t * /*pV*/, const Int_t & /*oldReg*/, const Int_t & /*oldLttc*/,
- Int_t & /*flagErr*/, Int_t & /*newReg*/, Int_t & /*newLttc*/);
- void type_of_call lkwr(Double_t & /*pSx*/, Double_t & /*pSy*/, Double_t & /*pSz*/,
- Double_t * /*pV*/, const Int_t & /*oldReg*/, const Int_t & /*oldLttc*/,
- Int_t & /*flagErr*/, Int_t & /*newReg*/, Int_t & /*newLttc*/);
-// void type_of_call magfld(const Double_t & /*pX*/, const Double_t & /*pY*/, const Double_t & /*pZ*/,
-// Double_t & /*cosBx*/, Double_t & /*cosBy*/, Double_t & /*cosBz*/,
-// Double_t & /*Bmag*/, Int_t & /*reg*/, Int_t & /*idiscflag*/);
- void type_of_call nrmlwr(Double_t & /*pSx*/, Double_t & /*pSy*/, Double_t & /*pSz*/,
- Double_t & /*pVx*/, Double_t & /*pVy*/, Double_t & /*pVz*/,
- Double_t * /*norml*/, const Int_t & /*oldReg*/,
- const Int_t & /*newReg*/, Int_t & /*flagErr*/);
- void type_of_call rgrpwr(const Int_t & /*flukaReg*/, const Int_t & /*ptrLttc*/, Int_t & /*g4Reg*/,
- Int_t * /*indMother*/, Int_t * /*repMother*/, Int_t & /*depthFluka*/);
- Int_t type_of_call isvhwr(const Int_t & /*fCheck*/, const Int_t & /*intHist*/);
-}
-
-// TFluka global pointer
-TFluka *gFluka = 0;
-TFlukaMCGeometry *gMCGeom = 0;
-Int_t gNstep = 0;
-
-ClassImp(TFlukaMCGeometry)
-
-TFlukaMCGeometry* TFlukaMCGeometry::fgInstance= NULL;
-
-//_____________________________________________________________________________
-TFlukaMCGeometry::TFlukaMCGeometry(const char *name, const char *title)
- :TNamed(name, title),
- fDebug(kFALSE),
- fLastMaterial(0),
- fDummyRegion(0),
- fCurrentRegion(0),
- fCurrentLattice(0),
- fNextRegion(0),
- fNextLattice(0),
- fRegionList(0),
- fIndmat(0),
- fMatList(new TObjArray(256)),
- fMatNames(new TObjArray(256))
-{
- //
- // Standard constructor
- //
- gFluka = (TFluka*)gMC;
- gMCGeom = this;
- gNstep = 0;
-}
-
-//_____________________________________________________________________________
-TFlukaMCGeometry::TFlukaMCGeometry()
- :TNamed(),
- fDebug(kFALSE),
- fLastMaterial(0),
- fDummyRegion(0),
- fCurrentRegion(0),
- fCurrentLattice(0),
- fNextRegion(0),
- fNextLattice(0),
- fRegionList(0),
- fIndmat(0),
- fMatList(0),
- fMatNames(0)
-
-{
- //
- // Default constructor
- //
- gFluka = (TFluka*)gMC;
- gMCGeom = this;
- gNstep = 0;
-}
-
-//_____________________________________________________________________________
-TFlukaMCGeometry::~TFlukaMCGeometry()
-{
- //
- // Destructor
- //
- fgInstance=0;
- if (fRegionList) delete [] fRegionList;
- if (fMatList) delete fMatList;
- if (fMatNames) {fMatNames->Delete(); delete fMatNames;}
- if (gGeoManager) delete gGeoManager;
-}
-
-//
-// private methods
-//
-
-//_____________________________________________________________________________
-Double_t* TFlukaMCGeometry::CreateDoubleArray(Float_t* array, Int_t size) const
-{
-// Converts Float_t* array to Double_t*,
-// !! The new array has to be deleted by user.
-// ---
-
- Double_t* doubleArray;
- if (size>0) {
- doubleArray = new Double_t[size];
- for (Int_t i=0; i<size; i++) doubleArray[i] = array[i];
- }
- else {
- //doubleArray = 0;
- doubleArray = new Double_t[1];
- }
- return doubleArray;
-}
-//
-// public methods
-
-
-//_____________________________________________________________________________
-Int_t TFlukaMCGeometry::GetMedium() const
-{
-// Get current medium number
- Int_t imed = 0;
- TGeoNode *node = gGeoManager->GetCurrentNode();
- if (!node) imed = gGeoManager->GetTopNode()->GetVolume()->GetMedium()->GetId();
- else imed = node->GetVolume()->GetMedium()->GetId();
- if (fDebug) printf("GetMedium=%i\n", imed);
- return imed;
-}
-
-//_____________________________________________________________________________
-Int_t TFlukaMCGeometry::GetFlukaMaterial(Int_t imed) const
-{
-// Returns FLUKA material index for medium IMED
- TGeoMedium *med = (TGeoMedium*)gGeoManager->GetListOfMedia()->At(imed-1);
- if (!med) {
- Error("GetFlukaMaterial", "MEDIUM %i nor found", imed);
- return -1;
- }
- TGeoMaterial* mat = med->GetMaterial();
- if (!mat->IsUsed()) return -1;
- Int_t imatfl = med->GetMaterial()->GetIndex();
- return imatfl;
-}
-
-//_____________________________________________________________________________
-Int_t *TFlukaMCGeometry::GetRegionList(Int_t imed, Int_t &nreg)
-{
-// Get an ordered list of regions matching a given medium number
- nreg = 0;
- if (!fRegionList) fRegionList = new Int_t[NofVolumes()+1];
- TIter next(gGeoManager->GetListOfUVolumes());
- TGeoVolume *vol;
- Int_t imedium, ireg;
- while ((vol = (TGeoVolume*)next())) {
- TGeoMedium* med;
- if ((med = vol->GetMedium()) == 0) continue;
- imedium = med->GetId();
- if (imedium == imed) {
- ireg = vol->GetNumber();
- fRegionList[nreg++] = ireg;
- }
- }
- return fRegionList;
-}
-
-//_____________________________________________________________________________
-Int_t *TFlukaMCGeometry::GetMaterialList(Int_t imat, Int_t &nreg)
-{
-// Get an ordered list of regions matching a given medium number
- nreg = 0;
- if (!fRegionList) fRegionList = new Int_t[NofVolumes()+1];
- TIter next(gGeoManager->GetListOfUVolumes());
- TGeoVolume *vol;
- Int_t imaterial, ireg;
- while ((vol = (TGeoVolume*)next())) {
- TGeoMedium* med;
- if ((med = vol->GetMedium()) == 0) continue;
- imaterial = med->GetMaterial()->GetIndex();
- if (imaterial == imat) {
- ireg = vol->GetNumber();
- fRegionList[nreg++] = ireg;
- }
- }
- return fRegionList;
-}
-
-//_____________________________________________________________________________
-Int_t TFlukaMCGeometry::NofVolumes() const
-{
- //
- // Return total number of volumes in the geometry
- //
-
- return gGeoManager->GetListOfUVolumes()->GetEntriesFast()-1;
-}
-
-//_____________________________________________________________________________
-TGeoMaterial * TFlukaMCGeometry::GetMakeWrongMaterial(Double_t z)
-{
-// Try to replace a wrongly-defined material
- static Double_t kz[23] = {7.3, 17.8184, 7.2167, 10.856, 8.875, 8.9, 7.177,
- 25.72, 6.2363, 7.1315, 47.7056, 10.6467, 7.8598, 2.10853, 10.6001, 9.1193,
- 15.3383, 4.55, 9.6502, 6.4561, 21.7963, 29.8246, 15.4021};
-
- Int_t ind;
- Double_t dz;
- for (ind=0; ind<23; ind++) {
- dz = TMath::Abs(z-kz[ind]);
- if (dz<1E-4) break;
- }
- if (ind>22) {
- printf("Cannot patch material with Z=%g\n", z);
- return 0;
- }
- TGeoMixture *mix = 0;
- TGeoElement *element;
- TGeoElementTable *table = gGeoManager->GetElementTable();
- switch (ind) {
- case 0: // AIR
- mix = new TGeoMixture("TPC_AIR", 4, 0.001205);
- element = table->GetElement(6); // C
- mix->DefineElement(0, element, 0.000124);
- element = table->GetElement(7); // N
- mix->DefineElement(1, element, 0.755267);
- element = table->GetElement(8); // O
- mix->DefineElement(2, element, 0.231781);
- element = table->GetElement(18); // AR
- mix->DefineElement(3, element, 0.012827);
- break;
- case 1: //SDD SI CHIP
- mix = new TGeoMixture("ITS_SDD_SI", 6, 2.4485);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.004367771);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.039730642);
- element = table->GetElement(7);
- mix->DefineElement(2, element, 0.001396798);
- element = table->GetElement(8);
- mix->DefineElement(3, element, 0.01169634);
- element = table->GetElement(14);
- mix->DefineElement(4, element, 0.844665);
- element = table->GetElement(47);
- mix->DefineElement(5, element, 0.09814344903);
- break;
- case 2: // WATER
- mix = new TGeoMixture("ITS_WATER", 2, 1.0);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.111898344);
- element = table->GetElement(8);
- mix->DefineElement(1, element, 0.888101656);
- break;
- case 3: // CERAMICS
- mix = new TGeoMixture("ITS_CERAMICS", 5, 3.6);
- element = table->GetElement(8);
- mix->DefineElement(0, element, 0.59956);
- element = table->GetElement(13);
- mix->DefineElement(1, element, 0.3776);
- element = table->GetElement(14);
- mix->DefineElement(2, element, 0.00933);
- element = table->GetElement(24);
- mix->DefineElement(3, element, 0.002);
- element = table->GetElement(25);
- mix->DefineElement(4, element, 0.0115);
- break;
- case 4: // EPOXY
- mix = new TGeoMixture("MUON_G10FR4", 4, 1.8);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.19);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.18);
- element = table->GetElement(8);
- mix->DefineElement(2, element, 0.35);
- element = table->GetElement(14);
- mix->DefineElement(3, element, 0.28);
- break;
- case 5: // EPOXY
- mix = new TGeoMixture("G10FR4", 4, 1.8);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.19);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.18);
- element = table->GetElement(8);
- mix->DefineElement(2, element, 0.35);
- element = table->GetElement(14);
- mix->DefineElement(3, element, 0.28);
- break;
- case 6: // KAPTON
- mix = new TGeoMixture("ITS_KAPTON", 4, 1.3);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.026363415);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.6911272);
- element = table->GetElement(7);
- mix->DefineElement(2, element, 0.073271325);
- element = table->GetElement(8);
- mix->DefineElement(3, element, 0.209238060);
- break;
- case 7: // INOX
- mix = new TGeoMixture("ITS_INOX", 9, 7.9);
- element = table->GetElement(6);
- mix->DefineElement(0, element, 0.0003);
- element = table->GetElement(14);
- mix->DefineElement(1, element, 0.01);
- element = table->GetElement(15);
- mix->DefineElement(2, element, 0.00045);
- element = table->GetElement(16);
- mix->DefineElement(3, element, 0.0003);
- element = table->GetElement(24);
- mix->DefineElement(4, element, 0.17);
- element = table->GetElement(25);
- mix->DefineElement(5, element, 0.02);
- element = table->GetElement(26);
- mix->DefineElement(6, element, 0.654);
- element = table->GetElement(28);
- mix->DefineElement(7, element, 0.12);
- element = table->GetElement(42);
- mix->DefineElement(8, element, 0.025);
- break;
- case 8: // ROHACELL
- mix = new TGeoMixture("ROHACELL", 4, 0.05);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.07836617);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.64648941);
- element = table->GetElement(7);
- mix->DefineElement(2, element, 0.08376983);
- element = table->GetElement(8);
- mix->DefineElement(3, element, 0.19137459);
- break;
- case 9: // SDD-C-AL
- mix = new TGeoMixture("ITS_SDD-C-AL", 5, 1.9837);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.022632);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.8176579);
- element = table->GetElement(7);
- mix->DefineElement(2, element, 0.0093488);
- element = table->GetElement(8);
- mix->DefineElement(3, element, 0.0503618);
- element = table->GetElement(13);
- mix->DefineElement(4, element, 0.1);
- break;
- case 10: // X7R-CAP
- mix = new TGeoMixture("ITS_X7R-CAP", 7, 6.72);
- element = table->GetElement(8);
- mix->DefineElement(0, element, 0.085975822);
- element = table->GetElement(22);
- mix->DefineElement(1, element, 0.084755042);
- element = table->GetElement(28);
- mix->DefineElement(2, element, 0.038244751);
- element = table->GetElement(29);
- mix->DefineElement(3, element, 0.009471271);
- element = table->GetElement(50);
- mix->DefineElement(4, element, 0.321736471);
- element = table->GetElement(56);
- mix->DefineElement(5, element, 0.251639432);
- element = table->GetElement(82);
- mix->DefineElement(6, element, 0.2081768);
- break;
- case 11: // SDD ruby sph. Al2O3
- mix = new TGeoMixture("ITS_AL2O3", 2, 3.97);
- element = table->GetElement(8);
- mix->DefineElement(0, element, 0.5293);
- element = table->GetElement(13);
- mix->DefineElement(1, element, 0.4707);
- break;
- case 12: // SDD HV microcable
- mix = new TGeoMixture("ITS_HV-CABLE", 5, 1.6087);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.01983871336);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.520088819984);
- element = table->GetElement(7);
- mix->DefineElement(2, element, 0.0551367996);
- element = table->GetElement(8);
- mix->DefineElement(3, element, 0.157399667056);
- element = table->GetElement(13);
- mix->DefineElement(4, element, 0.247536);
- break;
- case 13: //SDD LV+signal cable
- mix = new TGeoMixture("ITS_LV-CABLE", 5, 2.1035);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.0082859922);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.21722436468);
- element = table->GetElement(7);
- mix->DefineElement(2, element, 0.023028867);
- element = table->GetElement(8);
- mix->DefineElement(3, element, 0.06574077612);
- element = table->GetElement(13);
- mix->DefineElement(4, element, 0.68572);
- break;
- case 14: //SDD hybrid microcab
- mix = new TGeoMixture("ITS_HYB-CAB", 5, 2.0502);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.00926228815);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.24281879711);
- element = table->GetElement(7);
- mix->DefineElement(2, element, 0.02574224025);
- element = table->GetElement(8);
- mix->DefineElement(3, element, 0.07348667449);
- element = table->GetElement(13);
- mix->DefineElement(4, element, 0.64869);
- break;
- case 15: //SDD anode microcab
- mix = new TGeoMixture("ITS_ANOD-CAB", 5, 1.7854);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.0128595919215);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.392653705471);
- element = table->GetElement(7);
- mix->DefineElement(2, element, 0.041626868025);
- element = table->GetElement(8);
- mix->DefineElement(3, element, 0.118832707289);
- element = table->GetElement(13);
- mix->DefineElement(4, element, 0.431909);
- break;
- case 16: // inox/alum
- mix = new TGeoMixture("ITS_INOX-AL", 5, 3.0705);
- element = table->GetElement(13);
- mix->DefineElement(0, element, 0.816164);
- element = table->GetElement(14);
- mix->DefineElement(1, element, 0.000919182);
- element = table->GetElement(24);
- mix->DefineElement(2, element, 0.0330906);
- element = table->GetElement(26);
- mix->DefineElement(3, element, 0.131443);
- element = table->GetElement(28);
- mix->DefineElement(4, element, 0.0183836);
- case 17: // MYLAR
- mix = new TGeoMixture("TPC_MYLAR", 3, 1.39);
- element = table->GetElement(1);
- mix->DefineElement(0, element, 0.0416667);
- element = table->GetElement(6);
- mix->DefineElement(1, element, 0.625);
- element = table->GetElement(8);
- mix->DefineElement(2, element, 0.333333);
- break;
- case 18: // SPDBUS(AL+KPT+EPOX) - unknown composition
- mix = new TGeoMixture("ITS_SPDBUS", 1, 1.906);
- element = table->GetElement(9);
- mix->DefineElement(0, element, 1.);
- z = element->Z();
- break;
- case 19: // SDD/SSD rings - unknown composition
- mix = new TGeoMixture("ITS_SDDRINGS", 1, 1.8097);
- element = table->GetElement(6);
- mix->DefineElement(0, element, 1.);
- z = element->Z();
- break;
- case 20: // SPD end ladder - unknown composition
- mix = new TGeoMixture("ITS_SPDEL", 1, 3.6374);
- element = table->GetElement(22);
- mix->DefineElement(0, element, 1.);
- z = element->Z();
- break;
- case 21: // SDD end ladder - unknown composition
- mix = new TGeoMixture("ITS_SDDEL", 1, 0.3824);
- element = table->GetElement(30);
- mix->DefineElement(0, element, 1.);
- z = element->Z();
- break;
- case 22: // SSD end ladder - unknown composition
- mix = new TGeoMixture("ITS_SSDEL", 1, 0.68);
- element = table->GetElement(16);
- mix->DefineElement(0, element, 1.);
- z = element->Z();
- break;
- }
- mix->SetZ(z);
- printf("Patched with mixture %s\n", mix->GetName());
- return mix;
-}
-
-//_____________________________________________________________________________
-void TFlukaMCGeometry::CreateFlukaMatFile(const char *fname)
-{
- // ==== from FLUGG ====
- // NAMES OF ELEMENTS AND COMPOUNDS: the names must be written in upper case,
- // according to the fluka standard. In addition,. they must be equal to the
- // names of the fluka materials - see fluka manual - in order that the
- // program load the right cross sections, and equal to the names included in
- // the .pemf. Otherwise the user must define the LOW-MAT CARDS, and make his
- // own .pemf, in order to get the right cross sections loaded in memory.
- // Materials defined by FLUKA
- TString sname;
- gGeoManager->Export("geometry.root");
- if (fname) sname = fname;
- else sname = "flukaMat.inp";
- ofstream out;
- out.open(sname.Data(), ios::out);
- if (!out.good()) {
- Fatal("CreateFlukaMatFile", "could not open file %s for writing", sname.Data());
- return;
- }
- PrintHeader(out, "MATERIALS AND COMPOUNDS");
- PrintHeader(out, "MATERIALS");
- Int_t i,j,idmat;
- Int_t counttothree, nelem;
- Double_t a,z,rho, w;
- TGeoElementTable *table = gGeoManager->GetElementTable();
- TGeoElement *element;
- element = table->GetElement(13);
- element->SetTitle("ALUMINUM"); // this is how FLUKA likes it ...
- element = table->GetElement(15);
- element->SetTitle("PHOSPHO"); // same story ...
- Int_t nelements = table->GetNelements();
- TList *matlist = gGeoManager->GetListOfMaterials();
- TIter next(matlist);
- Int_t nmater = matlist->GetSize();
- Int_t nfmater = 0;
- Int_t newind = 26; // here non predefined materials start
-
- TGeoMaterial *mat;
- TGeoMixture *mix = 0;
- TString matname;
- TObjString *objstr;
- // Create all needed elements
- for (Int_t iel = 1; iel < nelements; iel++) {
- element = table->GetElement(iel);
- // skip elements which are not defined
- if (!element->IsUsed() && !element->IsDefined()) continue;
- matname = element->GetTitle();
- ToFlukaString(matname);
- rho = 0.999;
-
- mat = new TGeoMaterial(matname, element->A(), element->Z(), rho);
- // Check if the element has been predefined by FLUKA
- Int_t pmid = GetPredefinedMaterialId(Int_t(element->Z()));
- if (pmid > 0) {
- mat->SetIndex(pmid);
- } else {
- mat->SetIndex(newind++);
- }
-
- mat->SetUsed(kTRUE);
- fMatList->Add(mat);
- objstr = new TObjString(matname.Data());
- fMatNames->Add(objstr);
- nfmater++;
- }
-
- fIndmat = nfmater;
- // Adjust material names and add them to FLUKA list
- for (i=0; i<nmater; i++) {
- mat = (TGeoMaterial*)matlist->At(i);
- if (!mat->IsUsed()) continue;
- z = mat->GetZ();
- a = mat->GetA();
- rho = mat->GetDensity();
- if (mat->GetZ()<0.001) {
- mat->SetIndex(2); // vacuum, built-in inside FLUKA
- continue;
- }
- matname = mat->GetName();
- FlukaMatName(matname);
-
- mat->SetIndex(newind++);
- objstr = new TObjString(matname.Data());
- fMatList->Add(mat);
- fMatNames->Add(objstr);
- nfmater++;
- }
-
- // Dump all elements with MATERIAL cards
- for (i=0; i<nfmater; i++) {
- mat = (TGeoMaterial*)fMatList->At(i);
-// mat->SetUsed(kFALSE);
- mix = 0;
- out << setw(10) << "MATERIAL ";
- out.setf(static_cast<std::ios::fmtflags>(0),std::ios::floatfield);
- objstr = (TObjString*)fMatNames->At(i);
- matname = objstr->GetString();
- z = mat->GetZ();
- a = mat->GetA();
- rho = mat->GetDensity();
- if (mat->IsMixture()) {
- out << setw(10) << " ";
- out << setw(10) << " ";
- mix = (TGeoMixture*)mat;
- } else {
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << z;
- out << setw(10) << setprecision(3) << a;
- }
- out.setf(static_cast<std::ios::fmtflags>(0),std::ios::floatfield);
- out << setw(10) << setiosflags(ios::scientific) << setprecision(3) << rho;
- out.setf(static_cast<std::ios::fmtflags>(0),std::ios::floatfield);
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << Double_t(mat->GetIndex());
- out << setw(10) << " ";
- out << setw(10) << " ";
- out << setw(8) << matname.Data() << endl;
- if (!mix) {
- // add LOW-MAT card for NEON to associate with ARGON neutron xsec
- if (z==10) {
- out << setw(10) << "LOW-MAT ";
- out.setf(static_cast<std::ios::fmtflags>(0),std::ios::floatfield);
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << Double_t(mat->GetIndex());
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << 18.;
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << -2.;
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << 293.;
- out << setw(10) << " ";
- out << setw(10) << " ";
-// out << setw(8) << matname.Data() << endl;
- out << setw(8) << " " << endl;
- }
- else {
- element = table->GetElement((int)z);
- TString elename = element->GetTitle();
- ToFlukaString(elename);
- if( matname.CompareTo( elename ) != 0 ) {
- out << setw(10) << "LOW-MAT ";
- out.setf(static_cast<std::ios::fmtflags>(0),std::ios::floatfield);
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << Double_t(mat->GetIndex());
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << z;
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << " ";
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << " ";
- out << setw(10) << " ";
- out << setw(10) << " ";
- // missing material at Low Energy Cross Section Table
- if( (int)z==10 || (int)z==21 || (int)z==34 || (int)z==37 || (int)z==39 || (int)z==44 ||
- (int)z==45 || (int)z==46 || (int)z==52 || (int)z==57 || (int)z==59 || (int)z==60 ||
- (int)z==61 || (int)z==65 || (int)z==66 || (int)z==67 || (int)z==68 || (int)z==69 ||
- (int)z==70 || (int)z==71 || (int)z==72 || (int)z==76 || (int)z==77 || (int)z==78 ||
- (int)z==81 || (int)z==84 || (int)z==85 || (int)z==86 || (int)z==87 || (int)z==88 ||
- (int)z==89 || (int)z==91 )
- out << setw(8) << "UNKNOWN " << endl;
- else
- out << setw(8) << elename.Data() << endl;
- // out << setw(8) << " " << endl;
- }
- }
- continue;
- }
- counttothree = 0;
- out << setw(10) << "COMPOUND ";
- nelem = mix->GetNelements();
- objstr = (TObjString*)fMatNames->At(i);
- matname = objstr->GetString();
- for (j=0; j<nelem; j++) {
- w = (mix->GetWmixt())[j];
- if (w<0.00001) w=0.00001;
- z = (mix->GetZmixt())[j];
- a = (mix->GetAmixt())[j];
- idmat = GetElementIndex(Int_t(z));
- if (!idmat) Error("CreateFlukaMatFile", "element with Z=%f not found", z);
- out.setf(static_cast<std::ios::fmtflags>(0),std::ios::floatfield);
- out << setw(10) << setiosflags(ios::fixed) << setprecision(6) << -w;
- out.setf(static_cast<std::ios::fmtflags>(0),std::ios::floatfield);
- out << setw(10) << setiosflags(ios::fixed) << setprecision(1) << Double_t(idmat);
- counttothree++;
- if (counttothree == 3) {
- out << matname.Data();
- out << endl;
- if ( (j+1) != nelem) out << setw(10) << "COMPOUND ";
- counttothree = 0;
- }
- }
- if (nelem%3) {
- for (j=0; j<(3-(nelem%3)); j++)
- out << setw(10) << " " << setw(10) << " ";
- out << matname.Data();
- out << endl;
- }
- }
- Int_t nvols = gGeoManager->GetListOfUVolumes()->GetEntriesFast()-1;
- TGeoVolume *vol;
- // Now print the material assignments
- Double_t flagfield = 0.;
- printf("#############################################################\n");
- if (gFluka->IsFieldEnabled()) {
- flagfield = 1.;
- printf("Magnetic field enabled\n");
- } else printf("Magnetic field disabled\n");
- printf("#############################################################\n");
-
- PrintHeader(out, "TGEO MATERIAL ASSIGNMENTS");
- for (i=1; i<=nvols; i++) {
- TGeoMedium* med;
- vol = gGeoManager->GetVolume(i);
- if ((med = vol->GetMedium()) == 0) continue;
- mat = med->GetMaterial();
- idmat = mat->GetIndex();
- for (Int_t jmat = 0; jmat < nfmater; jmat++) {
- mat = (TGeoMaterial*)fMatList->At(jmat);
- if (mat->GetIndex() == idmat) mat->SetUsed(kTRUE);
- }
-
- Float_t hasfield = (vol->GetMedium()->GetParam(1) > 0) ? flagfield : 0.;
- out << "* Assigning material: " << vol->GetMedium()->GetMaterial()->GetName() << " to Volume: " << vol->GetName();
- out << endl;
-
- out << setw(10) << "ASSIGNMAT ";
- out.setf(static_cast<std::ios::fmtflags>(0),std::ios::floatfield);
- out << setw(10) << setiosflags(ios::fixed) << Double_t(idmat);
- out << setw(10) << setiosflags(ios::fixed) << Double_t(i);
- out << setw(10) << "0.0";
- out << setw(10) << "0.0";
- out << setw(10) << setiosflags(ios::fixed) << hasfield;
- out << setw(10) << "0.0";
- out << endl;
- }
- // dummy region
- idmat = 2; // vacuum
- fDummyRegion = nvols+1;
- out << "* Dummy region: " << endl;
- out << setw(10) << "ASSIGNMAT ";
- out.setf(static_cast<std::ios::fmtflags>(0),std::ios::floatfield);
- out << setw(10) << setiosflags(ios::fixed) << idmat;
- out << setw(10) << setiosflags(ios::fixed) << fDummyRegion;
- out << setw(10) << "0.0";
- out << setw(10) << "0.0";
- out << setw(10) << "0.0";
- out << setw(10) << "0.0" << endl;
- out.close();
-// fLastMaterial = nfmater+2;
- fLastMaterial = newind;
-}
-
-//_____________________________________________________________________________
-void TFlukaMCGeometry::PrintHeader(ofstream &out, const char *text) const
-{
-// Print a FLUKA header.
- out << "*\n" << "*\n" << "*\n";
- out << "********************* " << text << " *********************\n"
- << "*\n";
- out << "*...+....1....+....2....+....3....+....4....+....5....+....6....+....7..."
- << endl;
- out << "*" << endl;
-}
-
-//_____________________________________________________________________________
-Int_t TFlukaMCGeometry::RegionId() const
-{
-// Returns current region id <-> TGeo node id
- if (gGeoManager->IsOutside()) return 0;
- return gGeoManager->GetCurrentNode()->GetUniqueID();
-}
-
-//_____________________________________________________________________________
-Int_t TFlukaMCGeometry::GetElementIndex(Int_t z) const
-{
-// Get index of a material having a given Z element.
- TIter next(fMatList);
- TGeoMaterial *mat;
- Int_t index = 0;
- while ((mat=(TGeoMaterial*)next())) {
- if (mat->IsMixture()) continue;
- if (mat->GetElement()->Z() == z) return mat->GetIndex();
- }
- return index;
-}
-
-//_____________________________________________________________________________
-void TFlukaMCGeometry::SetMreg(Int_t mreg, Int_t lttc)
-{
-// Update if needed next history;
-// if (gFluka->GetDummyBoundary()==2) {
-// gGeoManager->CdNode(fNextLattice-1);
-// return;
-// }
- if (lttc == TFlukaMCGeometry::kLttcOutside) {
- fCurrentRegion = NofVolumes()+2;
- fCurrentLattice = lttc;
- gGeoManager->CdTop();
- gGeoManager->SetOutside(kTRUE);
- }
- if (lttc == TFlukaMCGeometry::kLttcVirtual) return;
- if (lttc <=0) {
- Error("TFlukaMCGeometry::SetMreg","Invalide lattice %i",lttc);
- return;
- }
- fCurrentRegion = mreg;
- fCurrentLattice = lttc;
-
- Int_t crtlttc = gGeoManager->GetCurrentNodeId()+1;
- if (crtlttc == lttc) return;
- gGeoManager->CdNode(lttc-1);
- while (gGeoManager->GetCurrentVolume()->IsAssembly()) gGeoManager->CdUp();
-}
-
-//_____________________________________________________________________________
-void TFlukaMCGeometry::SetCurrentRegion(Int_t mreg, Int_t latt)
-{
-// Set index/history for next entered region
- fCurrentRegion = mreg;
- fCurrentLattice = latt;
-}
-
-//_____________________________________________________________________________
-void TFlukaMCGeometry::SetNextRegion(Int_t mreg, Int_t latt)
-{
-// Set index/history for next entered region
- fNextRegion = mreg;
- fNextLattice = latt;
-}
-
-//_____________________________________________________________________________
-void TFlukaMCGeometry::ToFlukaString(TString &str) const
-{
-// ToFlukaString converts an string to something usefull in FLUKA:
-// * Capital letters
-// * Only 8 letters
-// * Replace ' ' by '_'
- if (str.Length()<8) {
- str += " ";
- }
- str.Remove(8);
- Int_t ilast;
- for (ilast=7; ilast>0; ilast--) if (str(ilast)!=' ') break;
- str.ToUpper();
- for (Int_t pos=0; pos<ilast; pos++)
- if (str(pos)==' ') str.Replace(pos,1,"_",1);
- return;
-}
-
-//_____________________________________________________________________________
-void TFlukaMCGeometry::FlukaMatName(TString &str) const
-{
-// Strip the detector name
- TObjArray * tokens = str.Tokenize("_");
- Int_t ntok = tokens->GetEntries();
- if (ntok > 1) {
- TString head = ((TObjString*) tokens->At(0))->GetString();
- Int_t nhead = head.Length();
- str = str.Remove(0, nhead + 1);
- }
- tokens->Clear();
- delete tokens;
-// Convert a name to upper case 8 chars.
- ToFlukaString(str);
- Int_t ilast;
- for (ilast=7; ilast>0; ilast--) if (str(ilast)!=' ') break;
- if (ilast>5) ilast = 5;
- char number[3];
- TIter next(fMatNames);
- TObjString *objstr;
- TString matname;
- Int_t index = 0;
- while ((objstr=(TObjString*)next())) {
- matname = objstr->GetString();
- if (matname == str) {
- index++;
- if (index<10) {
- number[0] = '0';
- sprintf(&number[1], "%d", index);
- } else if (index<100) {
- sprintf(number, "%d", index);
- } else {
- Error("FlukaMatName", "Too many materials %s", str.Data());
- return;
- }
- str.Replace(ilast+1, 2, number);
- str.Remove(8);
- }
- }
-}
-
-//______________________________________________________________________________
-void TFlukaMCGeometry::Vname(const char *name, char *vname) const
-{
- //
- // convert name to upper case. Make vname at least 4 chars
- //
- Int_t l = strlen(name);
- Int_t i;
- l = l < 4 ? l : 4;
- for (i=0;i<l;i++) vname[i] = toupper(name[i]);
- for (i=l;i<4;i++) vname[i] = ' ';
- vname[4] = 0;
-}
-
-
-//______________________________________________________________________________
-Int_t TFlukaMCGeometry::GetNstep()
-{
- // return gNstep for debug propose
- return gNstep;
-}
-
-
-Int_t TFlukaMCGeometry::GetPredefinedMaterialId(Int_t z) const
-{
-// Get predifined material id from Z if present in list
- const Int_t kMax = 25;
-
- static Int_t idFluka[kMax] =
- {-1, -1, 1, 2, 4, 6, 7, 8, 12, 13,
- 26, 29, 47, 14, 79, 80, 82, 73, 11, 18,
- 20, 50, 74, 22, 28};
-
- Int_t id = -1;
-
- for (Int_t i = 0; i < kMax; i++)
- {
- if (z == idFluka[i]) {
- id = i + 1;
- break;
- }
-
- }
-
- return id;
-}
-
-// FLUKA GEOMETRY WRAPPERS - to replace FLUGG wrappers
-//
-//_____________________________________________________________________________
-Int_t idnrwr(const Int_t & /*nreg*/, const Int_t & /*mlat*/)
-{
-// from FLUGG:
-// Wrapper for setting DNEAR option on fluka side. Must return 0
-// if user doesn't want Fluka to use DNEAR to compute the
-// step (the same effect is obtained with the GLOBAL (WHAT(3)=-1)
-// card in fluka input), returns 1 if user wants Fluka always to
-// use DNEAR (in this case, be sure that GEANT4 DNEAR is unique,
-// coming from all directions!!!)
- if (gMCGeom->IsDebugging()) printf("========== Dummy IDNRWR\n");
- return 0;
-}
-
-//_____________________________________________________________________________
-void g1wr(Double_t &pSx, Double_t &pSy, Double_t &pSz,
- Double_t *pV, Int_t &oldReg , const Int_t &oldLttc, Double_t &propStep,
- Int_t &/*nascFlag*/, Double_t &retStep, Int_t &newReg,
- Double_t &saf, Int_t &newLttc, Int_t <tcFlag,
- Double_t *sLt, Int_t *jrLt)
-
-{
- // Initialize FLUKa point and direction;
- static Int_t ierr = 0;
- gNstep++;
-// gMCGeom->SetDebugMode(kTRUE);
-
- NORLAT.xn[0] = pSx;
- NORLAT.xn[1] = pSy;
- NORLAT.xn[2] = pSz;
-
- Int_t olttc = oldLttc;
- if (oldLttc<=0) {
- gGeoManager->FindNode(pSx,pSy,pSz);
- olttc = gGeoManager->GetCurrentNodeId()+1;
- oldReg = gGeoManager->GetCurrentVolume()->GetNumber();
- }
-
- if (gMCGeom->IsDebugging()) {
- cout << "g1wr gNstep=" << gNstep << " oldReg="<< oldReg <<" olttc="<< olttc
- << " track=" << TRACKR.ispusr[mkbmx2-1] << endl;
- cout << " point: (" << pSx << ", " << pSy << ", " << pSz << ") dir: ("
- << pV[0] << ", " << pV[1] << ", " << pV[2] << ")" << endl;
- }
-
-
- Int_t ccreg=0,cclat=0;
- gMCGeom->GetCurrentRegion(ccreg,cclat);
- Bool_t crossed = (ccreg==oldReg && cclat==olttc)?kFALSE:kTRUE;
-
- gMCGeom->SetCurrentRegion(oldReg, olttc);
- // Initialize default return values
- lttcFlag = 0;
- jrLt[lttcFlag] = olttc;
- sLt[lttcFlag] = propStep;
- jrLt[lttcFlag+1] = -1;
- sLt[lttcFlag+1] = 0.;
- newReg = oldReg;
- newLttc = olttc;
- Bool_t crossedDummy = (oldReg == gFluka->GetDummyRegion())?kTRUE:kFALSE;
- Int_t curLttc, curReg;
- if (crossedDummy) {
- // FLUKA crossed the dummy boundary - update new region/history
- retStep = TGeoShape::Tolerance();
- saf = 0.;
- gMCGeom->GetNextRegion(newReg, newLttc);
- gMCGeom->SetMreg(newReg, newLttc);
- sLt[lttcFlag] = TGeoShape::Tolerance(); // null step in current region
- lttcFlag++;
- jrLt[lttcFlag] = newLttc;
- sLt[lttcFlag] = TGeoShape::Tolerance(); // null step in next region
- jrLt[lttcFlag+1] = -1;
- sLt[lttcFlag+1] = 0.; // null step in next region;
- if (gMCGeom->IsDebugging()) printf("=> crossed dummy!! newReg=%i newLttc=%i\n", newReg, newLttc);
- return;
- }
-
- // Reset outside flag
- gGeoManager->SetOutside(kFALSE);
-
- curLttc = gGeoManager->GetCurrentNodeId()+1;
- curReg = gGeoManager->GetCurrentVolume()->GetNumber();
- if (olttc != curLttc) {
- // FLUKA crossed the boundary : we trust that the given point is really there,
- // so we just update TGeo state
- gGeoManager->CdNode(olttc-1);
- curLttc = gGeoManager->GetCurrentNodeId()+1;
- curReg = gGeoManager->GetCurrentVolume()->GetNumber();
- }
- // Now the current TGeo state reflects the FLUKA state
-
- gGeoManager->SetCurrentPoint(pSx, pSy, pSz);
- gGeoManager->SetCurrentDirection(pV);
- Double_t pt[3], local[3], ldir[3];
- Int_t pid = TRACKR.jtrack;
- pt[0] = pSx;
- pt[1] = pSy;
- pt[2] = pSz;
- gGeoManager->MasterToLocal(pt,local);
- gGeoManager->MasterToLocalVect(pV,ldir);
-/*
- Bool_t valid = gGeoManager->GetCurrentVolume()->Contains(local);
- if (!valid) {
- printf("location not valid in %s pid=%i\n", gGeoManager->GetPath(),pid);
- printf("local:(%f, %f, %f) ldir:(%f, %f, %f)\n", local[0],local[1],local[2],ldir[0],ldir[1],ldir[2]);
-// gGeoManager->FindNode();
-// printf(" -> actual location: %s\n", gGeoManager->GetPath());
- }
-*/
- Double_t pstep = propStep;
- Double_t snext = propStep;
- const Double_t epsil = 0.9999999 * TGeoShape::Tolerance();
- // This should never happen !!!
- if (pstep<TGeoShape::Tolerance()) {
- printf("Proposed step is 0 !!!\n");
- pstep = 2.*TGeoShape::Tolerance();
- }
- if (crossed) {
- gGeoManager->FindNextBoundaryAndStep(pstep);
- snext = gGeoManager->GetStep();
- saf = 0.;
- if (snext <= TGeoShape::Tolerance()) {
-// printf("FLUKA crossed boundary but snext=%g\n", snext);
- ierr++;
- snext = epsil;
- } else {
- snext += TGeoShape::Tolerance();
- ierr = 0;
- }
- } else {
- gGeoManager->FindNextBoundaryAndStep(pstep, kTRUE);
- snext = gGeoManager->GetStep();
- saf = gGeoManager->GetSafeDistance();
- if (snext <= TGeoShape::Tolerance()) {
-// printf("FLUKA put particle on bondary without crossing\n");
- ierr++;
- snext = epsil;
- saf = 0.;
- } else {
- snext += TGeoShape::Tolerance();
- ierr = 0;
- }
- if (saf<0) saf=0.;
- saf -= saf*3.0e-09;
- }
-// if (ierr>1) {
-// printf("%d snext=%g\n", ierr, snext);
-// }
- if (ierr == 10) {
-// printf("Too many null steps - sending error code -33...\n");
- newReg = -33; // Error code
- ierr = 0;
- return;
- }
-
- PAREM.dist = snext;
- NORLAT.distn = snext;
- NORLAT.xn[0] += snext*pV[0];
- NORLAT.xn[1] += snext*pV[1];
- NORLAT.xn[2] += snext*pV[2];
- if (!gGeoManager->IsOnBoundary()) {
- // Next boundary further than proposed step, which is approved
- if (saf>propStep) saf = propStep;
- retStep = propStep;
- sLt[lttcFlag] = propStep;
- return;
- }
- if (saf>snext) saf = snext; // Safety should be less than the proposed step if a boundary will be crossed
- gGeoManager->SetCurrentPoint(pSx,pSy,pSz);
- newLttc = (gGeoManager->IsOutside())?(TFlukaMCGeometry::kLttcOutside):gGeoManager->GetCurrentNodeId()+1;
- newReg = (gGeoManager->IsOutside())?(gMCGeom->NofVolumes()+2):gGeoManager->GetCurrentVolume()->GetNumber();
- if (gMCGeom->IsDebugging()) printf("=> newReg=%i newLttc=%i\n", newReg, newLttc);
-
- // We really crossed the boundary, but is it the same region ?
- gMCGeom->SetNextRegion(newReg, newLttc);
-
- if ( ((newReg==oldReg && newLttc!=olttc) || (oldReg!=newReg && olttc==newLttc) ) && pid!=-1) {
- // Virtual boundary between replicants
- newReg = gFluka->GetDummyRegion();
- newLttc = TFlukaMCGeometry::kLttcVirtual;
- if (gMCGeom->IsDebugging()) printf("=> virtual boundary!! newReg=%i newLttc=%i\n", newReg, newLttc);
- }
-
- retStep = snext;
- sLt[lttcFlag] = snext;
- lttcFlag++;
- jrLt[lttcFlag] = newLttc;
- sLt[lttcFlag] = snext;
- jrLt[lttcFlag+1] = -1;
-
- sLt[lttcFlag+1] = 0.;
- gGeoManager->SetOutside(kFALSE);
- gGeoManager->CdNode(olttc-1);
- if (gMCGeom->IsDebugging()) {
- printf("=> snext=%g safe=%g\n", snext, saf);
- for (Int_t i=0; i<lttcFlag+1; i++) printf(" jrLt[%i]=%i sLt[%i]=%g\n", i,jrLt[i],i,sLt[i]);
- }
-}
-
-//_____________________________________________________________________________
-void g1rtwr()
-{
-
- if (gMCGeom->IsDebugging()) printf("========== Dummy G1RTWR\n");
-}
-
-//_____________________________________________________________________________
-void conhwr(Int_t & intHist, Int_t & incrCount)
-{
- if (gMCGeom->IsDebugging()) printf("========== Dummy CONHWR intHist=%d incrCount=%d currentNodeId=%d\n",
- intHist, incrCount, gGeoManager->GetCurrentNodeId()+1 );
-// if( incrCount != -1 ) {
-// if (intHist==0) gGeoManager->CdTop();
-// else gGeoManager->CdNode(intHist-1);
-// }
-// intHist = gGeoManager->GetCurrentNodeId()+1;
-}
-
-//_____________________________________________________________________________
-void inihwr(Int_t &intHist)
-{
- if (gMCGeom->IsDebugging())
- printf("========== Inside INIHWR -> reinitializing history: %i \n", intHist);
- if (gGeoManager->IsOutside()) gGeoManager->CdTop();
- if (intHist<0) {
-// printf("=== wrong history number\n");
- return;
- }
- if (intHist==0) gGeoManager->CdTop();
- else gGeoManager->CdNode(intHist-1);
- if (gMCGeom->IsDebugging()) {
- printf(" --- current path: %s\n", gGeoManager->GetPath());
- printf("<= INIHWR\n");
- }
-}
-
-//_____________________________________________________________________________
-void jomiwr(const Int_t & /*nge*/, const Int_t & /*lin*/, const Int_t & /*lou*/,
- Int_t &flukaReg)
-{
-// Geometry initialization wrapper called by FLUKAM. Provides to FLUKA the
-// number of regions (volumes in TGeo)
- // build application geometry
- if (gMCGeom->IsDebugging()) printf("========== Inside JOMIWR\n");
- flukaReg = gGeoManager->GetListOfUVolumes()->GetEntriesFast()+1;
- if (gMCGeom->IsDebugging()) printf("<= JOMIWR: last region=%i\n", flukaReg);
-}
-
-//_____________________________________________________________________________
-void lkdbwr(Double_t &pSx, Double_t &pSy, Double_t &pSz,
- Double_t *pV, const Int_t &oldReg, const Int_t &oldLttc,
- Int_t &flagErr, Int_t &newReg, Int_t &newLttc)
-{
- if (gMCGeom->IsDebugging()) {
- printf("========== Inside LKDBWR (%f, %f, %f)\n",pSx, pSy, pSz);
- printf(" in: pV=(%f, %f, %f)\n", pV[0], pV[1], pV[2]);
- printf(" in: oldReg=%i oldLttc=%i\n", oldReg, oldLttc);
- }
- lkwr(pSx,pSy,pSz,pV,oldReg,oldLttc,flagErr,newReg,newLttc);
-}
-
-//_____________________________________________________________________________
-void lkfxwr(Double_t &pSx, Double_t &pSy, Double_t &pSz,
- Double_t *pV, const Int_t &oldReg, const Int_t &oldLttc,
- Int_t &flagErr, Int_t &newReg, Int_t &newLttc)
-{
- if (gMCGeom->IsDebugging()) {
- printf("========== Inside LKFXWR (%f, %f, %f)\n",pSx, pSy, pSz);
- printf(" in: pV=(%f, %f, %f)\n", pV[0], pV[1], pV[2]);
- printf(" in: oldReg=%i oldLttc=%i\n", oldReg, oldLttc);
- }
- lkwr(pSx,pSy,pSz,pV,oldReg,oldLttc,flagErr,newReg,newLttc);
-}
-
-//_____________________________________________________________________________
-void lkmgwr(Double_t &pSx, Double_t &pSy, Double_t &pSz,
- Double_t *pV, const Int_t &oldReg, const Int_t &oldLttc,
- Int_t &flagErr, Int_t &newReg, Int_t &newLttc)
-{
- if (gMCGeom->IsDebugging()) {
- printf("========== Inside LKMGWR (%f, %f, %f)\n",pSx, pSy, pSz);
- printf(" in: pV=(%f, %f, %f)\n", pV[0], pV[1], pV[2]);
- printf(" in: oldReg=%i oldLttc=%i\n", oldReg, oldLttc);
- }
- lkwr(pSx,pSy,pSz,pV,oldReg,oldLttc,flagErr,newReg,newLttc);
-}
-
-//_____________________________________________________________________________
-void lkwr(Double_t &pSx, Double_t &pSy, Double_t &pSz,
- Double_t *pV, const Int_t &oldReg, const Int_t &oldLttc,
- Int_t &flagErr, Int_t &newReg, Int_t &newLttc)
-{
- if (gMCGeom->IsDebugging()) {
- printf("========== Inside LKWR (%f, %f, %f)\n",pSx, pSy, pSz);
- printf(" in: pV=(%f, %f, %f)\n", pV[0], pV[1], pV[2]);
- printf(" in: oldReg=%i oldLttc=%i\n", oldReg, oldLttc);
- }
- flagErr = 0;
- Double_t epsil = 1000.*TGeoShape::Tolerance();
- TGeoNode *node = gGeoManager->FindNode(pSx+epsil*pV[0], pSy+epsil*pV[1], pSz+epsil*pV[2]);
- if (gGeoManager->IsOutside()) {
- newReg = gMCGeom->NofVolumes()+2;
- newLttc = TFlukaMCGeometry::kLttcOutside;
- gGeoManager->SetOutside(kFALSE);
- if (oldLttc>0 && oldLttc<newLttc) gGeoManager->CdNode(oldLttc-1);
- return;
- }
- gGeoManager->SetOutside(kFALSE);
- newReg = node->GetVolume()->GetNumber();
- newLttc = gGeoManager->GetCurrentNodeId()+1;
- if (oldLttc==TFlukaMCGeometry::kLttcOutside || oldLttc==0) return;
-
- Int_t dummy = gFluka->GetDummyRegion();
- if (oldReg==dummy) {
- Int_t newreg1, newlttc1;
- gMCGeom->GetNextRegion(newreg1, newlttc1);
- if (newreg1==newReg && newlttc1==newLttc) {
- newReg = dummy;
- newLttc = TFlukaMCGeometry::kLttcVirtual;
- flagErr = newReg;
- if (gMCGeom->IsDebugging()) printf(" virtual boundary (oldReg==dummy) !! newReg=%i newLttc=%i\n", newReg, newLttc);
- }
- return;
- }
-
- if (oldReg==newReg && oldLttc!=newLttc) {
- newReg = dummy;
- newLttc = TFlukaMCGeometry::kLttcVirtual;
- if (gMCGeom->IsDebugging()) printf(" virtual boundary!! newReg=%i newLttc=%i\n", newReg, newLttc);
- }
-
- if( oldReg!=newReg && oldLttc==newLttc ) {
- // this should not happen!! ??? Ernesto
-// cout << " lkwr oldReg!=newReg ("<< oldReg <<"!="<< newReg
-// << ") && oldLttc==newLttc ("<< newLttc <<") !!!!!!!!!!!!!!!!!" << endl;
- newReg = dummy;
- newLttc = TFlukaMCGeometry::kLttcVirtual;
- flagErr = newReg;
- }
-
- if (gMCGeom->IsDebugging()) {
- printf(" LKWR: newReg=%i newLttc=%i\n", newReg, newLttc);
- }
-}
-
-//_____________________________________________________________________________
-void nrmlwr(Double_t &pSx, Double_t &pSy, Double_t &pSz,
- Double_t &pVx, Double_t &pVy, Double_t &pVz,
- Double_t *norml, const Int_t &oldReg,
- const Int_t &newReg, Int_t &flagErr)
-{
- if (gMCGeom->IsDebugging()) {
- printf("========== Inside NRMLWR (%g, %g, %g, %g, %g, %g)\n", pSx,pSy,pSz,pVx,pVy,pVz);
- printf(" (%g, %g, %g)\n", NORLAT.xn[0], NORLAT.xn[1], NORLAT.xn[2]);
- printf(" oldReg=%i, newReg=%i\n", oldReg,newReg);
- }
- gGeoManager->SetCurrentPoint(NORLAT.xn[0], NORLAT.xn[1], NORLAT.xn[2]);
- gGeoManager->SetCurrentDirection(pVx, pVy, pVz);
- Double_t *dnorm = gGeoManager->FindNormalFast();
- flagErr = 0;
- if (!dnorm) {
- printf(" ERROR: Cannot compute fast normal\n");
- flagErr = 1;
- norml[0] = -pVx;
- norml[1] = -pVy;
- norml[2] = -pVz;
- } else {
- norml[0] = -dnorm[0];
- norml[1] = -dnorm[1];
- norml[2] = -dnorm[2];
- }
-
- if (gMCGeom->IsDebugging()) {
- printf(" normal to boundary: (%g, %g, %g)\n", norml[0], norml[1], norml[2]);
- printf("<= NRMLWR\n");
- }
-
-}
-
-//_____________________________________________________________________________
-void rgrpwr(const Int_t & /*flukaReg*/, const Int_t & /*ptrLttc*/, Int_t & /*g4Reg*/,
- Int_t * /*indMother*/, Int_t * /*repMother*/, Int_t & /*depthFluka*/)
-{
- if (gMCGeom->IsDebugging()) printf("=> Dummy RGRPWR\n");
-}
-
-//_____________________________________________________________________________
-Int_t isvhwr(const Int_t &check, const Int_t & intHist)
-{
-// from FLUGG:
-// Wrapper for saving current navigation history (fCheck=default)
-// and returning its pointer. If fCheck=-1 copy of history pointed
-// by intHist is made in NavHistWithCount object, and its pointer
-// is returned. fCheck=1 and fCheck=2 cases are only in debugging
-// version: an array is created by means of FGeometryInit functions
-// (but could be a static int * ptrArray = new int[10000] with
-// file scope as well) that stores a flag for deleted/undeleted
-// histories and at the end of event is checked to verify that
-// all saved history objects have been deleted.
-
-// For TGeo, just return the current node ID. No copy need to be made.
-
- if (gMCGeom->IsDebugging()) printf("=> Inside ISVHWR check=%d intHist=%d\n", check, intHist);
- if (check<0) return intHist;
- Int_t histInt = gGeoManager->GetCurrentNodeId()+1;
- if (gMCGeom->IsDebugging()) printf("<= ISVHWR: history is: %i in: %s\n", histInt, gGeoManager->GetPath());
- return histInt;
-}
-
-
-
-
+++ /dev/null
-#ifndef TFLUKAMCGEOMETRY_H
-#define TFLUKAMCGEOMETRY_H
-/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * See cxx source for full Copyright notice */
-
-//
-// Class TFlukaMCGeometry
-// --------------------
-// Implementation of the TVirtualMCGeometry interface
-// for defining and using TGeo geometry with FLUKA.
-//
-// Author: Andrei Gheata 10/07/2003
-
-#ifndef ROOT_TNamed
-#include "TNamed.h"
-#endif
-
-class TGeoMaterial;
-
-
-class TFlukaMCGeometry :public TNamed {
-
- public:
- enum EFlukaLatticeTypes {
- kLttcOutside = 999999999,
- kLttcVirtual = 1000000000
- };
-
- TFlukaMCGeometry();
- TFlukaMCGeometry(const char* name, const char* title);
- virtual ~TFlukaMCGeometry();
-
- // get methods
- Int_t GetNstep(); // to be removed
- Int_t GetMedium() const;
- Int_t *GetRegionList(Int_t imed, Int_t &nreg);
- Int_t *GetMaterialList(Int_t imat, Int_t &nreg);
- Int_t GetFlukaMaterial(Int_t imed) const;
- Int_t GetLastMaterialIndex() const {return fLastMaterial;}
- virtual Int_t NofVolumes() const;
- // FLUKA specific methods
- void CreateFlukaMatFile(const char *fname=0);
- void PrintHeader(ofstream &out, const char *text) const;
- Bool_t IsDebugging() const {return fDebug;}
- void SetDebugMode(Bool_t flag=kTRUE) {fDebug = flag;}
- void SetMreg(Int_t mreg, Int_t lttc);
- void SetCurrentRegion(Int_t mreg, Int_t latt);
- void GetCurrentRegion(Int_t &mreg, Int_t &latt) const {mreg=fCurrentRegion; latt=fCurrentLattice;}
- Int_t GetCurrentRegion() const {return fCurrentRegion;}
- Int_t GetDummyRegion() const {return fDummyRegion;}
- Int_t GetDummyLattice() const {return kLttcVirtual;}
- void SetNextRegion(Int_t mreg, Int_t latt);
- void GetNextRegion(Int_t &mreg, Int_t &latt) const {mreg=fNextRegion; latt=fNextLattice;}
- TGeoMaterial *GetMakeWrongMaterial(Double_t z);
- TObjArray *GetMatList() {return fMatList;}
- TObjArray *GetMatNames() {return fMatNames;}
- Int_t GetElementIndex(Int_t z) const;
- Int_t RegionId() const;
- void ToFlukaString(TString &str) const;
- void FlukaMatName(TString &str) const;
- Int_t GetPredefinedMaterialId(Int_t z) const;
- Double_t* CreateDoubleArray(Float_t* array, Int_t size) const;
- void Vname(const char *name, char *vname) const;
-
- private:
- // Copy constructor and operator= declared but not implemented (-Weff++ flag)
- TFlukaMCGeometry(const TFlukaMCGeometry& rhs);
- TFlukaMCGeometry& operator=(const TFlukaMCGeometry& /*rhs*/); // {return (*this);}
-
- static TFlukaMCGeometry* fgInstance; // singleton instance
- Bool_t fDebug; // debug flag
- Int_t fLastMaterial; // last FLUKA material index
- Int_t fDummyRegion; // index of dummy region
- Int_t fCurrentRegion; // current region number
- Int_t fCurrentLattice; // current lattice history
- Int_t fNextRegion; // next region number
- Int_t fNextLattice; // next lattice history
- Int_t *fRegionList; //! region list matching a given medium number
- Int_t fIndmat; // material index where pemf file creation starts
- TObjArray *fMatList; //! material list as known by FLUKA
- TObjArray *fMatNames; //! list of FLUKA material names
-
- ClassDef(TFlukaMCGeometry,1) //Virtual MonteCarlo Interface
-};
-
-#endif //ROOT_TFlukaMCGeometry
+++ /dev/null
-#ifdef __CINT__
-/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * See cxx source for full Copyright notice */
-
-/* $Id$ */
-
-#pragma link off all globals;
-#pragma link off all classes;
-#pragma link off all functions;
-
-#pragma link C++ class TFluka+;
-#pragma link C++ class TFlukaMCGeometry+;
-#pragma link C++ class TFlukaCerenkov+;
-#endif
-
-
-
-
-
+++ /dev/null
-/**************************************************************************
- * Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * *
- * Author: The ALICE Off-line Project. *
- * Contributors are mentioned in the code where appropriate. *
- * *
- * Permission to use, copy, modify and distribute this software and its *
- * documentation strictly for non-commercial purposes is hereby granted *
- * without fee, provided that the above copyright notice appears in all *
- * copies and that both the copyright notice and this permission notice *
- * appear in the supporting documentation. The authors make no claims *
- * about the suitability of this software for any purpose. It is *
- * provided "as is" without express or implied warranty. *
- **************************************************************************/
-
-/* $Id$*/
-
-#include "TFlukaScoringOption.h"
-#include "TFlukaMCGeometry.h"
-#include <TGeoManager.h>
-#include <TGeoVolume.h>
-
-ClassImp(TFlukaScoringOption)
-
-FILE* TFlukaScoringOption::fgFile(0x0);
-TFlukaMCGeometry* TFlukaScoringOption::fgGeom(0x0);
-
-TFlukaScoringOption::TFlukaScoringOption()
- : fNopfl(0),
- fOutFile(""),
- fLun(0)
-{
-
- // Default constructor
-}
-
-TFlukaScoringOption::TFlukaScoringOption(const char* name, const char* sdum, Int_t nopfl, char* outfile, Float_t* what)
- : TNamed(name, sdum),
- fNopfl(nopfl),
- fOutFile(outfile),
- fLun(0)
-{
- // Constructor
- fNopfl = nopfl;
- fOutFile = outfile;
- Int_t npar = (nopfl == 0)? 6 : 12;
- for (Int_t i = 0; i < npar; i++) fWhat[i] = what[i];
-}
-
-TFlukaScoringOption::TFlukaScoringOption(const char* name, const char* sdum, Int_t nopfl, char* outfile, Float_t* what,
- const char* det1, const char* det2, const char* det3)
- : TNamed(name, sdum),
- fNopfl(nopfl + 2),
- fOutFile(outfile),
- fLun(0)
-{
- // Constructor
-// fNopfl = nopfl + 2;
-// fOutFile = outfile;
- Int_t npar = (nopfl == 0)? 6 : 12;
- for (Int_t i = 0; i < npar; i++) fWhat[i] = what[i];
-
- fName[0] = det1;
- fName[1] = det2;
- fName[2] = det3;
-}
-
-
-//--- GET METHODS
-//______________________________________________
-const char* TFlukaScoringOption::GetRegName(Int_t ndet)
-{
- // Return ndet'th region name
- return fName[ndet - 1];
-}
-
-//
-// Write Fluka Input Cards
-//
-void TFlukaScoringOption::WriteOpenFlukaFile()
-{
- //
- // Write Fluka input card for output file opening
- //
- fprintf(fgFile, "OPEN %10.1f %s\n",
- GetLun(), "NEW");
- fprintf(fgFile, "%s\n", GetFileName());
-}
-
-
-void TFlukaScoringOption::WriteFlukaInputCards()
-{
- //
- // Write the Fluka Input Cards for this scoring option
- //
-
- const char* cont_line = "&";
-
-//***************************************************************************
-//* Par()==0 only 6 parameter && regions by float *
-//* Par()==1 only 6 parameter && regions by Name *
-//* Par()==2 12 parameter && regions by float *
-//* Par()==3 12 parameter && regions by Name *
-//* Par()==4 12 parameter && regions by Name (for USRBIN only) *
-//***************************************************************************
-//
-// USRBIN
-//
- if(strncmp(GetName(), "USRBIN", 6) == 0){
- if (Par() == 0) {
- fprintf(fgFile, "USRBIN %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f%s\n",
- What(1), What(2), GetLun(), What(4), What(5), What(6), GetTitle());
- } else if (Par() == 1) {
- fprintf(fgFile, "USRBIN %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f%s\n",
- What(1), What(2), GetLun(), What(4), What(5), What(6), GetTitle());
- fprintf(fgFile, "USRBIN %10.1f%10.4g%10.1f%10.1f%10.1f%10.1f %s\n",
- What(7), What(8), What(9), What(10), What(11), What(12), cont_line);
- } else if (Par() == 2) {
- if(What(1) == 2.0 || What(1) == 12){
- fprintf(fgFile, "USRBIN %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f%s\n",
- What(1), What(2), GetLun(), Float_t(GetRegionByName(GetRegName(1))),
- Float_t(GetRegionByName(GetRegName(2))), Float_t(GetRegionByName(GetRegName(3))), GetTitle());
- fprintf(fgFile, "USRBIN %10.1f%10.4g%10.1f%10.1f%10.1f%10.1f %s\n",
- Float_t(GetRegionByName(GetRegName(1))), Float_t(GetRegionByName(GetRegName(2))),
- Float_t(GetRegionByName(GetRegName(3))), 1., 1., 1., cont_line);
- } else {
- printf("Check consistency of SetUserScoring values \n");
- }
- }
- }
-
-//
-// USRBDX
-//
- if(strncmp(GetName(), "USRBDX", 6) == 0){
- if (Par() == 2) {
- fprintf(fgFile, "USRBDX %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f\n",
- What(1), What(2), GetLun(), Float_t(GetRegionByName(GetRegName(1))),
- Float_t(GetRegionByName(GetRegName(2))), What(6));
- } else if (Par() == 3) {
- fprintf(fgFile, "USRBDX %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f\n",
- What(1), What(2), GetLun(), Float_t(GetRegionByName(GetRegName(1))),
- Float_t(GetRegionByName(GetRegName(2))), What(6));
- fprintf(fgFile, "USRBDX %10.1f%10.4g%10.1f%10.1f%10.1f%10.1f %s\n",
- What(7), What(8), What(9), What(10), What(11), What(12), cont_line);
- }
- }
-
-//
-// USTRACK
-//
- if(strncmp(GetName(), "USRTRACK", 6) == 0){
- fprintf(fgFile, "USRTRACK %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f\n",
- What(1), What(2), GetLun(), Float_t(GetRegionByName(GetRegName(1))), What(4), What(5));
- fprintf(fgFile, "USRTRACK %10.1f%10.4g %s\n",
- What(7), What(8), cont_line);
- }
-
-//
-// USRCOLL
-//
- if(strncmp(GetName(), "USRCOLL", 6) == 0){
- fprintf(fgFile, "USRCOLL %10.1f%10.1f%10.1f%10.1f%10.1f%10.1f\n",
- What(1), What(2), GetLun(), Float_t(GetRegionByName(GetRegName(1))), What(4), What(5));
- fprintf(fgFile, "USRCOLL %10.1f%10.4g %s\n",
- What(7), What(8), cont_line);
- }
-}
-
-
-Int_t TFlukaScoringOption::GetRegionByName(const char* detname)
-{
-// Get number of region for a given detector name
- TGeoVolume* vol = dynamic_cast<TGeoVolume*>((gGeoManager->GetListOfVolumes())->FindObject(detname));
- Int_t ireg = (vol)? vol->GetNumber() : -999;
- return ireg;
-}
+++ /dev/null
-#ifndef TFLUKASCORINGOPTION
-#define TFLUKASCORINGOPTION
-
-/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
- * See cxx source for full Copyright notice */
-
-/* $Id$ */
-
-///////////////////////////////////////////////////////////////////////////////
-// //
-// //
-// Class to store FLUKA specific scoring options //
-// //
-// //
-// Authors: Andreas Morsch <andreas.morsch@cern.ch> //
-// Barbara Dalena <Barbara.Dalena@ba.infn.it> //
-// //
-///////////////////////////////////////////////////////////////////////////////
-
-
-#include <TNamed.h>
-class TFlukaMCGeometry;
-
-
-class TFlukaScoringOption : public TNamed
-{
-public:
- // Constructors
- TFlukaScoringOption();
- TFlukaScoringOption(const char* name, const char* sdum, Int_t nopfl, char* outfile, Float_t* what);
- TFlukaScoringOption(const char* name, const char* sdum, Int_t nopfl, char* outfile, Float_t* what,
- const char* det1, const char* det2, const char* det3);
- // Getters
- Float_t What(Int_t indi) const {return fWhat[indi - 1];}
- Int_t Par() const {return fNopfl;}
- char* GetFileName() const {return fOutFile;}
- Float_t GetLun() const {return fLun;}
- const char* GetRegName(Int_t ndet);
- void SetPar(Int_t val) {fNopfl = val;}
- void SetFileName(char* outfile) {fOutFile = outfile;}
- void SetLun(Float_t lun) {fLun = lun;}
-
-//
- void WriteFlukaInputCards();
- void WriteOpenFlukaFile();
- Int_t GetRegionByName(const char* detname);
-
- static void SetStaticInfo(FILE* file, TFlukaMCGeometry* geom)
- {fgFile = file; fgGeom = geom;}
-
- protected:
- Int_t fNopfl; // Number of paramters
- Float_t fWhat[12]; // WHAT()
- const char* fName[3]; // Region Name
- char* fOutFile; // Output file
- Float_t fLun; // Logical Unit Number for Fluka output
-
- // Static
- static FILE* fgFile; // Output file
- static TFlukaMCGeometry* fgGeom; // Pointer to geometry
-
- private:
- // Copy constructor and operator= declared but not implemented (-Weff++ flag)
- TFlukaScoringOption(const TFlukaScoringOption&);
- TFlukaScoringOption& operator=(const TFlukaScoringOption&);
-
- ClassDef(TFlukaScoringOption, 1) // Fluka Scoring Option
-};
-
-#endif
-
+++ /dev/null
-#include "Fdimpar.h" //(DIMPAR) fluka include
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Fiounit.h" //(IOUNIT) fluka common
-#include "TFluka.h"
-#include "TGeoMaterial.h"
-#include "TFlukaCerenkov.h"
-
-
-#ifndef WIN32
-# define abscff abscff_
-#else
-# define abscff ABSCFF
-#endif
-extern "C" {
-Double_t abscff(Double_t& wvlngt, Double_t& /*omgpho*/, Int_t& mmat)
-{
-// printf("abscff%f %d\n", wvlngt, mmat);
-
-//
-// Return absorption length for given photon energy and material
-//
-
- TFluka* fluka = (TFluka*) gMC;
-//
-// Check if stopping has been required by user
-//
- if (fluka->GetStoppingCondition()) {
- fluka->ResetStoppingCondition();
- return (1.e15);
- }
-//
-// Get absorption coefficient for current material
-//
- TGeoMaterial* material = (TGeoMaterial*) (fluka->GetFlukaMaterials())->At(fluka->GetMaterialIndex(mmat));
- TFlukaCerenkov* cerenkov = dynamic_cast<TFlukaCerenkov*> (material->GetCerenkovProperties());
- Double_t y = (cerenkov->GetAbsorptionCoefficientByWaveLength(wvlngt));
- return (y);
-
-}
-}
-
-
+++ /dev/null
-#include <Riostream.h>
-
-#include "TFluka.h"
-#include "TFlukaCodes.h"
-#include "TFlukaMCGeometry.h"
-#include "Fdimpar.h" //(DIMPAR) fluka include
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Fltclcm.h" //(LTCLCM) fluka common
-#include "Fopphst.h" //(OPPHST) fluka common
-
-#ifndef WIN32
-# define bxdraw bxdraw_
-#else
-# define bxdraw BXDRAW
-#endif
-
-
-#include "TGeoManager.h"
-
-
-extern "C" {
-void bxdraw(Int_t& icode, Int_t& mreg, Int_t& newreg,
- Double_t& xsco, Double_t& ysco, Double_t& zsco)
-{
- TFluka* fluka = (TFluka*) gMC;
- Int_t oldlttc = TRACKR.lt1trk; //LTCLCM.mlatm1;
- Int_t newlttc = LTCLCM.newlat;
- fluka->SetIcode((FlukaProcessCode_t)icode);
-// fluka->SetNewreg(newreg,newlttc);
- fluka->SetXsco(xsco);
- fluka->SetYsco(ysco);
- fluka->SetZsco(zsco);
- Int_t verbosityLevel = fluka->GetVerbosityLevel();
- Bool_t debug = (verbosityLevel>=3)?kTRUE:kFALSE;
- // nothing to do if particle is crossing a dummy region
- if (mreg == fluka->GetDummyRegion() ||
- newreg == fluka->GetDummyRegion() ||
- oldlttc == TFlukaMCGeometry::kLttcVirtual ||
- newlttc == TFlukaMCGeometry::kLttcVirtual
- ) return;
-
-//
-// Double step for boundary crossing
-//
- fluka->SetTrackIsNew(kFALSE); // has to be called BEFORE Stepping()
- if (mreg != fluka->GetDummyRegion() && newreg != fluka->GetDummyRegion()) {
- if (debug) printf("bxdraw (ex) \n");
- fluka->SetTrackIsExiting();
- fluka->SetCaller(kBXExiting);
- fluka->SetMreg(mreg,oldlttc);
-
- // check region lattice consistency (debug Ernesto)
- // *****************************************************
- Int_t nodeId;
- Int_t volId = fluka->CurrentVolID(nodeId);
- Int_t crtlttc = gGeoManager->GetCurrentNodeId()+1;
- if(debug && mreg != volId && !gGeoManager->IsOutside()) {
- cout << " bxdraw: track=" << TRACKR.ispusr[mkbmx2-1]<< " pdg=" << fluka->PDGFromId(TRACKR.jtrack)
- << " icode=" << icode << " gNstep=" << fluka->GetNstep() << endl
- << " fluka mreg=" << mreg << " oldlttc=" << oldlttc << " newreg=" << newreg << " newlttc=" << newlttc << endl
- << " TGeo volId=" << volId << " crtlttc=" << crtlttc << endl
- << " common TRACKR lt1trk=" << TRACKR.lt1trk << " lt2trk=" << TRACKR.lt2trk << endl
- << " common LTCLCM newlat=" << LTCLCM.newlat << " mlatld=" << LTCLCM.mlatld << endl
- << " mlatm1=" << LTCLCM.mlatm1 << " mltsen=" << LTCLCM.mltsen << endl
- << " mltsm1=" << LTCLCM.mltsm1 << " mlattc=" << LTCLCM.mlattc << endl;
- if( oldlttc == crtlttc ) cout << " **************************** Exit *********************************" << endl;
- }
- // *****************************************************
-
-
-
- TVirtualMCStack* cppstack = fluka->GetStack();
-
- if (TRACKR.jtrack == -1) {
- cppstack->SetCurrentTrack(OPPHST.louopp[OPPHST.lstopp]);
- } else {
- cppstack->SetCurrentTrack( TRACKR.ispusr[mkbmx2-1] );
- }
-
- (TVirtualMCApplication::Instance())->Stepping();
- }
- if (newreg != fluka->GetDummyRegion()) {
- if (debug) printf("bxdraw (en) \n");
- fluka->SetCaller(kBXEntering);
- fluka->SetTrackIsEntering();
- if (fluka->GetDummyBoundary() == 1) fluka->SetDummyBoundary(2);
- fluka->SetMreg(newreg,newlttc);
-
- // check region lattice consistency (debug Ernesto)
- // *****************************************************
- Int_t nodeId;
- Int_t volId = fluka->CurrentVolID(nodeId);
- Int_t crtlttc = gGeoManager->GetCurrentNodeId()+1;
- if(debug && newreg != volId && !gGeoManager->IsOutside()) {
- cout << " bxdraw: track=" << TRACKR.ispusr[mkbmx2-1] << " pdg=" << fluka->PDGFromId(TRACKR.jtrack)
- << " icode=" << icode << " gNstep=" << fluka->GetNstep() << endl
- << " fluka mreg=" << mreg << " oldlttc=" << oldlttc << " newreg=" << newreg << " newlttc=" << newlttc << endl
- << " TGeo volId=" << volId << " crtlttc=" << crtlttc << endl
- << " common TRACKR lt1trk=" << TRACKR.lt1trk << " lt2trk=" << TRACKR.lt2trk << endl
- << " common LTCLCM newlat=" << LTCLCM.newlat << " mlatld=" << LTCLCM.mlatld << endl
- << " mlatm1=" << LTCLCM.mlatm1 << " mltsen=" << LTCLCM.mltsen << endl
- << " mltsm1=" << LTCLCM.mltsm1 << " mlattc=" << LTCLCM.mlattc << endl;
- if( newlttc == crtlttc ) cout << " ******************************** Enter *****************************" << endl;
- }
- // *****************************************************
-
- TVirtualMCStack* cppstack = fluka->GetStack();
- if (TRACKR.jtrack == -1) {
- cppstack->SetCurrentTrack(OPPHST.louopp[OPPHST.lstopp]);
- } else {
- cppstack->SetCurrentTrack( TRACKR.ispusr[mkbmx2-1] );
- }
-
- (TVirtualMCApplication::Instance())->Stepping();
- }
-
-} // end of bxdraw
-} // end of extern "C"
-
+++ /dev/null
-#include "Fdimpar.h" //(DIMPAR) fluka include
-#include "Fdblprc.h" //(DBLPRC) fluka include
-#include "Fiounit.h" //(IOUNIT) fluka common
-#include "Fflkmat.h" //(FLKMAT) fluka common
-#include "Fscohlp.h" //(SCOHLP) fluka common
-#include "Fsouevt.h" //(SOUEVT) fluka common
-#ifndef WIN32
-#define comscw comscw_
-#define type_of_call
-#else
-#define comscw COMSCW
-#define type_of_call _stdcall
-#endif
-const Double_t oned = 1.00000e+00;
-const Double_t factr = 1.60217e-07;
-extern "C" double type_of_call comscw(int& ij, double& xa, double& ya, double& za,
- int& mreg, double& rull, int& llo, int& icall)
-
-{
-//
-// Return comscw
-//
- SCOHLP.lsczer = kFALSE;
- if (FLKMAT.rho[FLKMAT.medium[mreg]] < 1.0e-15)
-{
- return 1.;
-}
- if (SCOHLP.iscrng == 1 ) {
-// printf("comscw %f %f %f %f %f \n", FLKMAT.rho[FLKMAT.medium[mreg]], 4.1e+15*rull*factr/FLKMAT.rho[FLKMAT.medium[mreg]], xa, ya, za);
- return factr/FLKMAT.rho[FLKMAT.medium[mreg]];
-}
- return 1.;
-}
+++ /dev/null
-*$ CREATE COMSCW.FOR
-*COPY COMSCW
-*
-*=== comscw ===========================================================*
-*
- DOUBLE PRECISION FUNCTION COMSCW ( IJ , XA , YA , ZA ,
- & MREG , RULL , LLO , ICALL )
-
- INCLUDE '(DBLPRC)'
- INCLUDE '(DIMPAR)'
- INCLUDE '(IOUNIT)'
-* *
-*----------------------------------------------------------------------*
-* *
-* Special multiplication factors for activity scoring. *
-* *
-* Note: Data files 'LE-CH.dat' and 'LE-EC.dat' read on unit 20. *
-* *
-* *
-* SDUM = 'abcdefgh' Lesco *
-* *
-* 'ab' = 'LE' division by exemption limits activated *
-* *
-* 'c' = 'C' : division by CERN zonage limits *
-* 'def' = '10 ' : division by 1/10 of the value 10 *
-* 'def' = '100' : division by 1/100 of the value 100 *
-* otherwise: division by the value itself 1 *
-* 'c' = 'S' : division by Swiss LE values 2 *
-* 'c' = 'E' : division by European concentration limits 3 *
-* *
-* Comscw = 1. for selected isotope *
-* = 0. otherwise *
-* *
-* 'ab' = 'IS' selection of individual isotops activated 9999 *
-* *
-* 'cd' = symbol of isotope *
-* 'efg' = mass number of isotope *
-* 'h' = 'm' : metastable state *
-* *
-* Comscw = 1. for selected isotope *
-* = 0. otherwise *
-* *
-* otherwise Comscw = 1. -1 *
-* *
-* Example(s): *
-* *
-* SDUM = 'LEC10xxx' : division by 1/10 of LE(EU) or by Swiss LE *
-* = 'LESxxxxx' : division by Swiss LE *
-* = 'ISV 48x' : scoring of activity for V48 *
-* = 'ISMn 52m' : scoring of activity for mMn52 *
-* *
-* Note: 'x' refers to characters without specific meaning *
-* *
-* Input variables: *
-* *
-* Ij = (generalized) particle code *
-* Xa,Ya,Za = position *
-* Mreg = region number *
-* Rull = amount to be deposited *
-* Llo = particle generation *
-* Icall = call id *
-* *
-* Output variables: *
-* *
-* Comscw = factor the scored amount will be multiplied by *
-* Lsczer = logical flag, if true no amount will be scored *
-* regardless of Comscw *
-* *
-* Useful variables (common SCOHLP): *
-* *
-* Energy/Star binnings/scorings (Comscw): *
-* ISCRNG = 1 --> Energy density binning *
-* ISCRNG = 2 --> Star density binning *
-* ISCRNG = 3 --> Residual nuclei scoring *
-* ISCRNG = 4 --> Momentum transfer density binning *
-* ISCRNG = 5 --> Activity density binning *
-* JSCRNG = # of the binning *
-* *
-* Useful variables (common SOUEVT): *
-* *
-* X,Y,Zsoevt(i) = position of the i_th source particle *
-* TX,Y,Zsoev(i) = direction of the i_th source particle *
-* Wtsoev(i) = weight of the i_th source particle *
-* Pmsoev(i) = momentum of the i_th source particle *
-* Tksoev(i) = kin. energy of the i_th source particle *
-* Agsoev(i) = age of the i_th source particle *
-* Aksoev(i) = Kaon ampl. of the i_th source particle *
-* Ussoev(i) = user var. of the i_th source particle *
-* Ijsoev(i) = identity of the i_th source particle *
-* Nrsoev(i) = region of the i_th source particle *
-* Nlsoev(i) = lattice of the i_th source particle *
-* Npsoev = number of the source particles *
-*----------------------------------------------------------------------*
-*
- INCLUDE '(FLKMAT)'
- INCLUDE '(SCOHLP)'
- INCLUDE '(SOUEVT)'
-*
- INCLUDE '(RSNCCM)'
- INCLUDE '(USRBIN)'
- DIMENSION IZSCO(MXUSBN),IASCO(MXUSBN),ISSCO(MXUSBN),
- & LESCO(MXUSBN)
-*
- CHARACTER CISOIN*2,CISO*2,CSET*10,CDUM*4,CA*3
- PARAMETER (IZMAX = 109,
- & IAZMIN = 2,
- & IAZMAX = 160)
- DIMENSION CISO(IZMAX)
- DIMENSION XLESWS(IZMAX,IAZMIN:IAZMAX,2),
- & XLEECO(IZMAX,IAZMIN:IAZMAX,2),
- & XLEO10(IZMAX,IAZMIN:IAZMAX,2)
- DATA CISO /
- & 'H ','He','Li','Be','B ','C ','N ','O ','F ','Ne','Na',
- & 'Mg','Al','Si','P ','S ','Cl','Ar','K ','Ca','Sc','Ti',
- & 'V ','Cr','Mn','Fe','Co','Ni','Cu','Zn','Ga','Ge','As',
- & 'Se','Br','Kr','Rb','Sr','Y ','Zr','Nb','Mo','Tc','Ru',
- & 'Rh','Pd','Ag','Cd','In','Sn','Sb','Te','I ','Xe','Cs',
- & 'Ba','La','Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy',
- & 'Ho','Er','Tm','Yb','Lu','Hf','Ta','W ','Re','Os','Ir',
- & 'Pt','Au','Hg','Tl','Pb','Bi','Po','At','Rn','Fr','Ra',
- & 'Ac','Th','Pa','U ','Np','Pu','Am','Cm','Bk','Cf','Es',
- & 'Fm','Md','No','Lr','Rf','Ha','Sg','Ns','Hs','Mt'/
-*
- LOGICAL LFIRST,LFOUND
- DATA LFIRST /.TRUE./
-*
- LSCZER = .FALSE.
- COMSCW = ONEONE
-
- IF (LFIRST) THEN
-
- WRITE(LUNOUT,'(A)') ' COMSCW: activity weighting activated'
- LFIRST = .FALSE.
-*
-*----------------------------------------------------------------------*
-* Initialization
-*
-* LE data taken from Appendix 3 column 9,
-* Ordonnance sur la radioprotection (ORaP) du 22 juin 1994
-* (etat au 4 avril 2000)
-*
-* (data file in Bq/kg!)
-*
- DO 104 IZ=1,IZMAX
- DO 105 IAZ=IAZMIN,IAZMAX
- XLESWS(IZ,IAZ,1) = ZERZER
- XLESWS(IZ,IAZ,2) = ZERZER
- 105 CONTINUE
- 104 CONTINUE
-*
- OPEN(20,FILE='LE-CH.dat',STATUS='UNKNOWN')
- NISO = 0
- IZ0 = 1
- 100 CONTINUE
- READ(20,*,END=101) CISOIN,IA,XLIMIT
-* convert from Bq/kg into Bq/g
- XLIMIT = 1.0D-3*XLIMIT
- LFOUND = .FALSE.
- DO 102 IZ=IZ0,IZMAX
- IF (CISOIN.EQ.CISO(IZ)) THEN
- IF (IA.LT.0) THEN
- IS = 2
- IA = ABS(IA)
- ELSE
- IS = 1
- ENDIF
- IAZ = IA-IZ
- IF ((IAZ.LT.IAZMIN).OR.(IAZ.GT.IAZMAX)) THEN
- WRITE(LUNOUT,*)
- & ' COMSCW: warning! Iaz out of allowed range: ',
- & IAZ, IAZMIN,IAZMAX
- STOP
- ENDIF
- IF (XLESWS(IZ,IAZ,IS).GT.ZERZER) THEN
- WRITE(LUNOUT,*)
- & ' COMSCW: warning! two entries for this isotope: ',
- & CISOIN,IA,XLIMIT
- STOP
- ELSE
- XLESWS(IZ,IAZ,IS) = XLIMIT
- ENDIF
- NISO = NISO+1
- IZ0 = IZ
- LFOUND = .TRUE.
- GOTO 103
- ENDIF
- 102 CONTINUE
- WRITE(LUNOUT,*)
- & ' COMSCW: isotope not recognized: ',CISOIN,IA,XLIMIT
- STOP
- 103 CONTINUE
- GOTO 100
- 101 CONTINUE
- CLOSE(20)
-*
-* LE data taken from
-* Official journal of the European Communities L159, 29 June 1996
-* Council Directive 96/29/Euratom
-*
-* (data file in Bq/g!)
-*
- DO 204 IZ=1,IZMAX
- DO 205 IAZ=IAZMIN,IAZMAX
- XLEECO(IZ,IAZ,1) = ZERZER
- XLEECO(IZ,IAZ,2) = ZERZER
- 205 CONTINUE
- 204 CONTINUE
-*
- OPEN(20,FILE='LE-EC.dat',STATUS='UNKNOWN')
- NISO = 0
- IZ0 = 1
- 200 CONTINUE
- READ(20,*,END=201) CISOIN,IA,XLIMIT,IFLAG
- LFOUND = .FALSE.
- DO 202 IZ=IZ0,IZMAX
- IF (CISOIN.EQ.CISO(IZ)) THEN
- IF (IA.LT.0) THEN
- IS = 2
- IA = ABS(IA)
- ELSE
- IS = 1
- ENDIF
- IAZ = IA-IZ
- IF ((IAZ.LT.IAZMIN).OR.(IAZ.GT.IAZMAX)) THEN
- WRITE(LUNOUT,*)
- & ' COMSCW: warning! Iaz out of allowed range: ',
- & IAZ, IAZMIN,IAZMAX
- STOP
- ENDIF
- IF (XLEECO(IZ,IAZ,IS).GT.ZERZER) THEN
- WRITE(LUNOUT,*)
- & ' COMSCW: warning! two entries for this isotope: ',
- & CISOIN,IA,XLIMIT
- STOP
- ELSE
- XLEECO(IZ,IAZ,IS) = XLIMIT
-* zero entries with Swiss values
- IF (IFLAG.EQ.1) XLEECO(IZ,IAZ,IS) = ZERZER
- ENDIF
- NISO = NISO+1
- IZ0 = IZ
- LFOUND = .TRUE.
- GOTO 203
- ENDIF
- 202 CONTINUE
- WRITE(LUNOUT,*)
- & ' COMSCW: isotope not recognized: ',CISOIN,IA,XLIMIT
- STOP
- 203 CONTINUE
- GOTO 200
- 201 CONTINUE
- CLOSE(20)
- DO 404 IZ=1,IZMAX
- DO 405 IAZ=IAZMIN,IAZMAX
- DO 406 IS=1,2
- XLEO10(IZ,IAZ,IS) = ZERZER
- IF (XLEECO(IZ,IAZ,IS).GT.ZERZER) THEN
- XLEO10(IZ,IAZ,IS) = XLEECO(IZ,IAZ,IS)/10.0D0
- ELSE
- XLEO10(IZ,IAZ,IS) = XLESWS(IZ,IAZ,IS)
- ENDIF
- 406 CONTINUE
- 405 CONTINUE
- 404 CONTINUE
-*
- DO 500 I=1,MXUSBN
- IZSCO(I) = 0
- IASCO(I) = 0
- ISSCO(I) = 0
- LESCO(I) = 0
- 500 CONTINUE
-
- ENDIF
-*
-*----------------------------------------------------------------------*
-* Online weighting
-*
- IF ( ISCRNG .EQ. 5 ) THEN
-*
-* determine type of weighting
- IF (LESCO(JSCRNG).EQ.0) THEN
- CSET = TITUSB(JSCRNG)
- IF (CSET(1:2).EQ.'IS') THEN
- LESCO(JSCRNG) = 9999
- DO 700 IZ=1,IZMAX
- IF (CSET(3:4).EQ.CISO(IZ)) THEN
- IZSCO(JSCRNG) = IZ
- READ(CSET,'(A4,A3)') CDUM,CA
- READ(CA,'(I3)') IASCO(JSCRNG)
- IF (CSET(8:8).EQ.'m') THEN
- ISSCO(JSCRNG) = 2
- ELSE
- ISSCO(JSCRNG) = 1
- ENDIF
- ENDIF
- 700 CONTINUE
- IF ((IZSCO(JSCRNG).LE.0).OR.(IASCO(JSCRNG).LE.0)
- & .OR.(ISSCO(JSCRNG).LE.0)) THEN
- WRITE(LUNOUT,*) ' COMSCW: unknown isotope, Z,A,S = ',
- & IZSCO(JSCRNG),IASCO(JSCRNG),ISSCO(JSCRNG)
- STOP
- ENDIF
- ELSEIF(CSET(1:2).EQ.'LE') THEN
- IF (CSET(3:3).EQ.'C') THEN
- IF (CSET(4:6).EQ.'100') THEN
- LESCO(JSCRNG) = 100
- ELSEIF (CSET(4:6).EQ.'10') THEN
- LESCO(JSCRNG) = 10
- ELSE
- LESCO(JSCRNG) = 1
- ENDIF
- ELSEIF (CSET(3:3).EQ.'S') THEN
- LESCO(JSCRNG) = 2
- ELSEIF (CSET(3:3).EQ.'E') THEN
- LESCO(JSCRNG) = 3
- ELSE
- WRITE(LUNOUT,*) ' COMSCW: unknown LE set ',CSET(3:3)
- STOP
- ENDIF
- ELSE
- LESCO(JSCRNG) = -1
- ENDIF
- WRITE(LUNOUT,1000) ' COMSCW: scoring ',JSCRNG,CSET,
- & ' weighted with properties ',
- & LESCO(JSCRNG),IZSCO(JSCRNG),IASCO(JSCRNG),ISSCO(JSCRNG)
- 1000 FORMAT(A,I3,2A,I5,3I4)
- ENDIF
-*
-* obtain present isotope from common block
- JA = IARSDL(1)
- JZ = IZRSDL(1)
- JS = ISRSDL(1)+1
- IF (JS.GT.2) JS = 2
- JAZ = JA-JZ
-*
- COMSCW = ZERZER
- IF (LESCO(JSCRNG).EQ.-1) THEN
- COMSCW = ONEONE
- ELSEIF (LESCO(JSCRNG).EQ.9999) THEN
- IF ((JA.EQ.IASCO(JSCRNG)).AND.(JZ.EQ.IZSCO(JSCRNG)).AND.
- & (JS.EQ.ISSCO(JSCRNG))) THEN
- COMSCW = ONEONE
- ELSE
- COMSCW = ZERZER
- ENDIF
- ELSEIF ((LESCO(JSCRNG).EQ.1).OR.(LESCO(JSCRNG).EQ.10).OR.
- & (LESCO(JSCRNG).EQ.100)) THEN
- FACT = 10.0D0/DBLE(LESCO(JSCRNG))
- IF (XLEO10(JZ,JAZ,JS).GT.ZERZER)
- & COMSCW = ONEONE/(FACT*XLEO10(JZ,JAZ,JS))
- ELSEIF (LESCO(JSCRNG).EQ.2) THEN
- IF (XLESWS(JZ,JAZ,JS).GT.ZERZER)
- & COMSCW = ONEONE/XLESWS(JZ,JAZ,JS)
- ELSEIF (LESCO(JSCRNG).EQ.3) THEN
- IF (XLEECO(JZ,JAZ,JS).GT.ZERZER)
- & COMSCW = ONEONE/XLEECO(JZ,JAZ,JS)
- ELSE
- WRITE(LUNOUT,*) ' COMSCW: invalid option ',LESCO(JSCRNG)
- STOP
- ENDIF
-
- ENDIF
-
- RETURN
-*=== End of function Comscw ===========================================*
- END
+++ /dev/null
-*$ CREATE CRNKVP.FOR
-*COPY CRNKVP
-*
-*=== Crnkvp ===========================================================*
-*
- SUBROUTINE CRNKVP ( MREG, NEWREG, DDNEAR, LEMAGN, DEDXCK )
-
- INCLUDE '(DBLPRC)'
- INCLUDE '(DIMPAR)'
- INCLUDE '(IOUNIT)'
-*
-*----------------------------------------------------------------------*
-* *
-* Copyright (C) 1997-2003 by Alfredo Ferrari & Paola Sala *
-* All Rights Reserved. *
-* *
-* *
-* CeReNKoV Production: *
-* *
-* Created on 21 september 1997 by Alfredo Ferrari & Paola Sala *
-* Infn - Milan *
-* *
-* Last change on 30-oct-98 by Alfredo Ferrari *
-* *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* !!!!!! Important: Etrack, Ptrack, Atrack, are supposed !!!!!! *
-* !!!!!! to be the INITIAL values (not yet updated at the !!!!!! *
-* !!!!!! end of the step). !!!!!! *
-* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *
-* *
-* dN/dEdx = alpha^2 z^2 / [ r_e m_e c^2 ] [ 1 - 1 / (beta n)^2 ] *
-* *
-* Note the wavelength is always assumed to be the vacuum one *
-* *
-*----------------------------------------------------------------------*
-*
- INCLUDE '(FHEAVY)'
- INCLUDE '(FLKMAT)'
- INCLUDE '(MULBOU)'
- INCLUDE '(OPPHCM)'
- INCLUDE '(OPPHST)'
- INCLUDE '(PAPROP)'
- INCLUDE '(SUMCOU)'
- INCLUDE '(TRACKR)'
-*
- PARAMETER ( CSNPRN = 100.D+00 * CSNNRM )
- PARAMETER ( CRNKC0 = ALPFSC * ALPFSC / RCLSEL / AMELCT )
- LOGICAL LEMAGN, LMEQNT, LNWSUB, LSMPAN, LDUMMY, LBXRFL
-* Statement functions:
-* INCLUDE '(DORTSF)'
- INCLUDE '(UNRTSF)'
-*
-* No magnetic field end step Newreg check implemented for the moment:
-*
-*
-* IF ( LEMAGN )
-* & CALL FLABRT ( 'CRNKVP', ' STOP:LEMAGN-NOT-YET-IMPLEMENTED' )
-* No change of lattice check implemented for the moment:
-* IF ( LT1TRK .NE. LT2TRK ) CALL FLABRT ( 'CRNKVP',
-* & ' STOP:LT1TRK.NE.LT2TRK-NOT-YET-IMPLEMENTED' )
- DEDXCK = ZERZER
- MMAT = MEDIUM (MREG)
- IF ( JTRACK .GE. -6 ) THEN
- AMPRTC = AM (JTRACK)
- ELSE
- AMPRTC = AMNHEA (-JTRACK)
- END IF
-* +-------------------------------------------------------------------*
-* | Find the maximum refractive index over the interval allowed
-* | for Cerenkov production:
- IF ( RMXCER (MMAT) .LT. ZERZER ) THEN
- RMXCER (MMAT) = RFNDMX (MMAT)
- END IF
-* |
-* +-------------------------------------------------------------------*
- BETNCR = PTRACK / ETRACK * RMXCER (MMAT)
-* Maximum beta x n already below 1: no chance to emit any photon
- IF ( BETNCR .LE. ONEONE ) RETURN
- LMEQNT = MTRACK .EQ. NTRACK
- DTRCKT = ZERZER
-* +-------------------------------------------------------------------*
-* | Loop on energy deposition sub-steps:
- DO 300 ID = 1, MTRACK
- DTRCKT = DTRCKT + DTRACK (ID)
- 300 CONTINUE
-* |
-* +-------------------------------------------------------------------*
- TTRCKT = ZERZER
-* +-------------------------------------------------------------------*
-* | Loop on track sub-steps (be careful with magnetic field they are
-* | not the straight distance between the end points):
- DO 500 IT = 1, NTRACK
- TTRCKT = TTRCKT + TTRACK (IT)
- 500 CONTINUE
-* |
-* +-------------------------------------------------------------------*
- CRVCRR = CTRACK / TTRCKT
- IF ( JTRACK .GE. -6 ) THEN
- CRNKCS = CRNKC0 * ( DBLE ( ICHRGE (JTRACK) ) )**2 * OPSNMX
- ELSE
- CRNKCS = CRNKC0 * ( DBLE ( ICHEAV(-JTRACK) ) )**2 * OPSNMX
- END IF
- BTNFCR = ( BETNCR - ONEONE ) * ( BETNCR + ONEONE ) / BETNCR**2
-* Macroscopic sigma for production (cm^-1)
- SIGMCK = CRNKCS * ( EMXCER (MMAT) - EMNCER (MMAT) ) * BTNFCR
-* Average number of emitted photons:
- NEMPHO = NINT ( CTRACK * SIGMCK )
-* Take a three sigma clearance:
- NEMPHO = NEMPHO + 10 + 3 * NINT ( SQRT ( CTRACK * SIGMCK ) )
- NEMPHO = MIN ( NEMPHO, MOSTCK )
-*D IF ( LSTOPP .GT. MOSTCK - NEMPHO ) WRITE (77,*)
-*D & ' ###CRNKVP:LSTOPP:',LSTOPP,NEMPHO
-* +-------------------------------------------------------------------*
-* | Empty the stack if too full: compute and save the normal in case
-* | it is required
- IF ( LSTOPP .GT. MOSTCK - NEMPHO ) THEN
- LDUMMY = LBXRFL ( NEWREG, MREG, ZERZER, ZERZER, ONEONE )
- CALL KASOPH ( .TRUE. )
- END IF
-* |
-* +-------------------------------------------------------------------*
-* Total wiggled and curved track used up to now:
- TRUSED = ZERZER
- ETINTR = ETRACK
- PTINTR = PTRACK
- TRINTR = ZERZER
- NTRKLD = 0
-* Current lattice number and index inside Mulbou:
- IRLTCR = 0
- LATCCR = MULTTC (IRLTCR)
-* Variables in the current Ntrckr bin:
- NTRKCR = 1
- PTRKCR = PTRACK
- ETRKCR = ETRACK
- ATRKCR = ATRACK
- TRNRSD = TTRACK (NTRKCR) * CRVCRR
-* +-------------------------------------------------------------------*
-* | Ntrack = Mtrack
- IF ( LMEQNT ) THEN
- DEDXCR = DTRACK (NTRKCR) / TRNRSD
-* |
-* +-------------------------------------------------------------------*
-* | Ntrack >< Mtrack
- ELSE
- DEDXCR = DTRCKT / CTRACK
- END IF
-* |
-* +-------------------------------------------------------------------*
-* +-------------------------------------------------------------------*
-* | Stacking loop for Cerenkov photons:
- NPROD = 0
- 1000 CONTINUE
-*D IF ( SIGMCK .LT. ZERZER ) WRITE (77,*)
-*D & ' ^^^CRNKVP:SIGMCK,BTNFCR',SIGMCK,BTNFCR
-*D IF ( DEDXCR .LT. AZRZRZ ) WRITE (77,*)' ###CRNKVP:',
-*D & 'MMAT,JTRACK,DEDXCR,NTRKCR,DTRACK(NTRKCR),CTRACK,TRNRSD,DTRCKT',
-*D & MMAT,JTRACK,DEDXCR,NTRKCR,DTRACK(NTRKCR),CTRACK,TRNRSD,DTRCKT
-* | Empty the stack if too full:
-*D IF ( LSTOPP .EQ. MOSTCK ) WRITE (77,*)
-*D & ' ###CRNKVP:LSTOPP:',LSTOPP
-* | +----------------------------------------------------------------*
-* | | Empty the stack if too full: compute and save the normal in
-* | | case it is required
- IF ( LSTOPP .EQ. MOSTCK ) THEN
- LDUMMY = LBXRFL ( NEWREG, MREG, ZERZER, ZERZER, ONEONE )
- CALL KASOPH ( .TRUE. )
- END IF
-* | |
-* | +----------------------------------------------------------------*
- DSTPRD = - LOG ( ONEONE - FLRNDM (DSTPRD) ) / SIGMCK
- TRUSED = TRUSED + DSTPRD
-*dbgD WRITE (77,*) ' CRNKVP:DSTPRD,TRUSED,CTRACK,TRNRSD',
-*dbgD & DSTPRD,TRUSED,CTRACK,TRNRSD
- IF ( TRUSED .GE. CTRACK ) GO TO 7000
-* | +----------------------------------------------------------------*
-* | | Sub-step loop:
- 1500 CONTINUE
-*D IF ( NTRKCR .GT. NTRACK ) WRITE (77,*)
-*D & ' ^^^CRNKVP:NTRKCR,NTRACK',NTRKCR,NTRACK
-* | | +-------------------------------------------------------------*
-* | | | The production point is inside the current sub-step:
- IF ( DSTPRD .LE. TRNRSD ) THEN
-* | | | Update the distance from the previous interaction:
- TRINTR = TRINTR + DSTPRD
-* | | | Update the residual distance available in the current
-* | | | sub-step
- TRNRSD = TRNRSD - DSTPRD
- ETRKCR = ETRKCR - DSTPRD * DEDXCR
- LNWSUB = .FALSE.
-* | | |
-* | | +-------------------------------------------------------------*
-* | | | The production point is outside the current sub-step:
- ELSE
-* | | | Update the distance from the previous interaction:
- TRINTR = TRINTR + TRNRSD
- ETRKCR = ETRKCR - TRNRSD * DEDXCR
- DSTPRD = DSTPRD - TRNRSD
-* | | | Change sub-step:
- NTRKCR = NTRKCR + 1
-* | | | Update the residual distance available in the current
-* | | | sub-step
- TRNRSD = TTRACK (NTRKCR) * CRVCRR
-* | | | Update the current dE/dx:
- IF ( LMEQNT ) DEDXCR = DTRACK (NTRKCR) / TRNRSD
- LNWSUB = .TRUE.
- END IF
-* | | |
-* | | +-------------------------------------------------------------*
- IF ( LNWSUB ) GO TO 1500
-* | | end sub-step loop:
-* | +----------------------------------------------------------------*
- PTRKCR = SQRT ( ( ETRKCR - AMPRTC ) * ( ETRKCR + AMPRTC ) )
-* | +----------------------------------------------------------------*
-* | | Update the particle "age" (beta=p/E, dp/dE=E/p):
-* | | Etrkcr
-* | | /
-* | | Dt = - | dE dx/dE E/(pc) = 1/c dx/dE [ Ptintr - Ptrkcr ]
-* | | /
-* | | Etintr
- IF ( ETINTR - ETRKCR .GT. CSNNRM * ETRKCR ) THEN
-* | | Average dE/dx from the previous (fictitious) interaction:
- DEDXAV = ( ETINTR - ETRKCR ) / TRINTR
- ATRKCR = ATRKCR + ( PTINTR - PTRKCR ) / DEDXAV / CLIGHT
-* | |
-* | +----------------------------------------------------------------*
-* | |
- ELSE
- ATRKCR = ATRKCR + TRINTR * ETRKCR / PTRKCR / CLIGHT
- END IF
-* | |
-* | +----------------------------------------------------------------*
- PTINTR = PTRKCR
- ETINTR = ETRKCR
- TRINTR = ZERZER
- BETNLD = BETNCR
- BETNCR = PTRKCR / ETRKCR * RMXCER (MMAT)
-*dbgD WRITE (77,*) ' CRNKVP:BETNCR,RMXCER,LSTOPP',
-*dbgD & BETNCR,RMXCER(MMAT),LSTOPP
-* | No longer any chance to emit Cerenkov photons:
- IF ( BETNCR .LE. ONEONE ) GO TO 7000
- BTNFLD = BTNFCR
- BTNFCR = ( BETNCR - ONEONE ) * ( BETNCR + ONEONE ) / BETNCR**2
- FREJE = BTNFCR / BTNFLD
-*D IF ( FREJE .GT. ONEPLS ) WRITE (77,*) ' ^^^CRNKVP:',
-*D & 'FREJE,BETNCR,BETNLD,DEDXCR,PTRKCR,ETRKCR,PTRACK,ETRACK',
-*D & FREJE,BETNCR,BETNLD,DEDXCR,PTRKCR,ETRKCR,PTRACK,ETRACK
-* | Update the macroscopic sigma: beta can only decrease
- SIGMCK = SIGMCK * FREJE
- RNDREJ = FLRNDM (RNDREJ)
- IF ( RNDREJ .GE. FREJE ) GO TO 1000
-* |--<--<--<--<--< Interaction rejected because of the decrease in beta
- RNDREJ = RNDREJ / FREJE
-* | Sample the emitted photon energy:
- EPHSMP = RNDREJ * ( EMXCER (MMAT) - EMNCER (MMAT) )
- & + EMNCER (MMAT)
-* | 2pi x freq.:
- OMGSMP = GEVOMG * EPHSMP
-* | Wavelength:
- WVLSMP = TWOPIP * CLIGHT / OMGSMP
-* | Compute the refraction index at the right wavelength/frequency:
- RFISMP = FOPTPR ( 1, WVLSMP, OMGSMP, MMAT )
- BETNSM = PTRKCR / ETRKCR * RFISMP
-*dbgD WRITE (77,*) ' CRNKVP:BETNSM,RFISMP,EPHSMP,WVLSMP,OMGSMP',
-*dbgD & BETNSM,RFISMP,EPHSMP,WVLSMP,OMGSMP
- IF ( BETNSM .LE. ONEONE ) GO TO 1000
-* |--<--<--<--<--< No chance to emit Cerenkov photons at this frequency
- BTNFSM = ( BETNSM - ONEONE ) * ( BETNSM + ONEONE ) / BETNSM**2
-* | Compute the quantum efficiency for this emitted energy:
- OPSENS = FOPTSN ( WVLSMP, OMGSMP )
- FREJE = BTNFSM / BTNFCR * OPSENS / OPSNMX
-*D IF ( FREJE .GT. ONEPLS ) WRITE (77,*)
-*D & ' ^^^CRNKVP:FREJE,RFISMP,RMXCER(MMAT),OPSENS,MMAT',
-*D & FREJE,RFISMP,RMXCER(MMAT),OPSENS,MMAT
- RNDREJ = FLRNDM (RNDREJ)
-*dbgD WRITE (77,*) ' CRNKVP:BTNFSM,BTNFCR,RNDREJ',
-*dbgD & BTNFSM,BTNFCR,RNDREJ
- IF ( RNDREJ .GE. FREJE ) GO TO 1000
-* |--<--<--<--<--< Interaction rejected because of the decrease in n
-* | Eventually a Cerenkov photon is going to be emitted:
-* | +----------------------------------------------------------------*
-* | | New production sub-step:
- IF ( NTRKCR .NE. NTRKLD ) THEN
- UTRKCR = XTRACK (NTRKCR) - XTRACK (NTRKCR-1)
- VTRKCR = YTRACK (NTRKCR) - YTRACK (NTRKCR-1)
- WTRKCR = ZTRACK (NTRKCR) - ZTRACK (NTRKCR-1)
- TUVWCR = SQRT ( UTRKCR**2 + VTRKCR**2 + WTRKCR**2 )
- UTRKCR = UTRKCR / TUVWCR
- VTRKCR = VTRKCR / TUVWCR
- WTRKCR = WTRKCR / TUVWCR
- SINT02 = UTRKCR**2 + VTRKCR**2
- LSMPAN = SINT02 .LT. ANGLSQ
- COSTH0 = WTRKCR
- IF ( .NOT. LSMPAN ) THEN
- SINTH0 = SQRT (SINT02)
- COSPH0 = UTRKCR / SINTH0
- SINPH0 = VTRKCR / SINTH0
- END IF
- NTRKLD = NTRKCR
- END IF
-* | |
-* | +----------------------------------------------------------------*
- SRNRSD = TUVWCR * TRNRSD / CRVCRR / TTRACK (NTRKCR)
-*D IF ( SRNRSD .LT. ZERZER .OR. SRNRSD .GT. TUVWCR )
-*D & WRITE (77,*)' ^^^CRNKVP:SRNRSD,TUVWCR,NTRKCR',
-*D & SRNRSD,TUVWCR,NTRKCR
- XTRKCR = XTRACK (NTRKCR) - UTRKCR * SRNRSD
- YTRKCR = YTRACK (NTRKCR) - VTRKCR * SRNRSD
- ZTRKCR = ZTRACK (NTRKCR) - WTRKCR * SRNRSD
-* | +----------------------------------------------------------------*
-* | | Put here the check on lattice change:
- IF ( NULTTC .GT. 0 ) THEN
-* | | Current (possibly curved in mag. field) non wiggled path:
- TRLATT = TRUSED / CRVCRR
- IF ( TRLATT .LE. TSLTTC (IRLTCR) ) THEN
- LATCCR = MULTTC (IRLTCR)
- ELSE
- DO 2000 IL = IRLTCR + 1, NULTTC
- IF ( TRLATT .LE. TSLTTC (IL) ) THEN
- IRLTCR = IL
- LATCCR = MULTTC (IRLTCR)
- GO TO 2010
- END IF
- 2000 CONTINUE
-*D CALL FLABRT ( 'CRNKVP', 'STOP:CRNKVP-NO-VALID-LATTICE' )
- 2010 CONTINUE
- END IF
- END IF
-* | |
-* | +----------------------------------------------------------------*
-* | +----------------------------------------------------------------*
-* | | Put here the check on the end point in magnetic field:
- IF ( LEMAGN .AND. NTRKCR .EQ. NTRACK .AND. MREG .NE. NEWREG )
- & THEN
- NEWLSV = NEWLAT
- MLATSV = MLATTC
- NROLD = NEWREG
- CALL GEOMAG ( XTRKCR, YTRKCR, ZTRKCR, UTRKCR, VTRKCR,
- & WTRKCR, NWREG , NROLD , IDSCCK )
- NEWLAT = NEWLSV
- MLATTC = MLATSV
- IF ( NWREG .EQ. NROLD ) GO TO 7000
-* | |-->-->--> already beyond the real crossing point:
- END IF
-* | |
-* | +----------------------------------------------------------------*
- LSTOPP = LSTOPP + 1
- NUMOPH = NUMOPH + 1
- IF ( NUMOPH .GT. 1000000000 ) THEN
- MUMOPH = MUMOPH + 1
- NUMOPH = NUMOPH + 1000000000
- END IF
- WOPTPH = WOPTPH + WTRACK
- POPTPH (LSTOPP) = EPHSMP
-* | +----------------------------------------------------------------*
-* | | No easy safe way to reconstruct Dnear along a magnetic field
-* | | step:
- IF ( LEMAGN ) THEN
- DONEAR (LSTOPP) = ZERZER
-* | |
-* | +----------------------------------------------------------------*
-* | | Questionable: ddnear actually refers to the end track point
- ELSE
- DONEAR (LSTOPP) = MAX ( DDNEAR - CTRACK + TRUSED, ZERZER )
- END IF
-* | |
-* | +----------------------------------------------------------------*
- XOPTPH (LSTOPP) = XTRKCR
- YOPTPH (LSTOPP) = YTRKCR
- ZOPTPH (LSTOPP) = ZTRKCR
- NREGOP (LSTOPP) = MREG
- NLATOP (LSTOPP) = LATCCR
- COSTHE = ONEONE / BETNSM
- SINTHE = SQRT ( ( ONEONE - COSTHE ) * ( ONEONE + COSTHE ) )
- CALL SFECFE ( SINPHI, COSPHI )
- UPRIME = COSPHI * SINTHE
- VPRIME = SINPHI * SINTHE
- WPRIME = COSTHE
- IF ( LSMPAN ) THEN
- TXOPPH (LSTOPP) = UPRIME
- TYOPPH (LSTOPP) = VPRIME
- TZOPPH (LSTOPP) = WPRIME * COSTH0
- ELSE
- TXOPPH (LSTOPP) = UNDOXR ( UPRIME, VPRIME, WPRIME, SINPH0,
- & COSPH0, SINTH0, COSTH0 )
- TYOPPH (LSTOPP) = UNDOYR ( UPRIME, VPRIME, WPRIME, SINPH0,
- & COSPH0, SINTH0, COSTH0 )
- TZOPPH (LSTOPP) = UNDOZR ( UPRIME, VPRIME, WPRIME, SINPH0,
- & COSPH0, SINTH0, COSTH0 )
- END IF
-* | Set-up the polarization vector: the following for linear pola-
-* | rization lying in the plane defined by the photon and the
-* | original particle direction:
- TXPOPP (LSTOPP) = UTRKCR / SINTHE - COSTHE / SINTHE
- & * TXOPPH (LSTOPP)
- TYPOPP (LSTOPP) = VTRKCR / SINTHE - COSTHE / SINTHE
- & * TYOPPH (LSTOPP)
- TZPOPP (LSTOPP) = WTRKCR / SINTHE - COSTHE / SINTHE
- & * TZOPPH (LSTOPP)
- SCADOT = TXOPPH (LSTOPP) * TXPOPP (LSTOPP)
- & + TYOPPH (LSTOPP) * TYPOPP (LSTOPP)
- & + TZOPPH (LSTOPP) * TZPOPP (LSTOPP)
- IF ( SCADOT .GT. CSNPRN ) THEN
- WRITE (LUNERR,'(A,1PG23.15,A)')
- & ' *** Crnkvp: bad polarization',
- & SCADOT, ' ***'
-*D WRITE (77,'(A,1PG23.15)')
-*D & ' ^^^Crnkvp: bad polarization',
-*D & SCADOT
- END IF
- WTOPPH (LSTOPP) = WTRACK
- AGOPPH (LSTOPP) = ATRKCR
- CMPOPP (LSTOPP) = ZERZER
- LOOPPH (LSTOPP) = LTRACK + 1
-*
-*
-* Hook to TFluka
-*
- PXCR = EPHSMP * TXOPPH (LSTOPP)
- PYCR = EPHSMP * TYOPPH (LSTOPP)
- PZCR = EPHSMP * TZOPPH (LSTOPP)
- POX = TXPOPP(LSTOPP)
- POY = TYPOPP(LSTOPP)
- POZ = TZPOPP(LSTOPP)
- CALL pshckp(PXCR, PYCR, PZCR, EPHSMP, XTRKCR,
- & YTRKCR , ZTRKCR, ATRKCR, POX, POY, POZ, WTRACK, ITFL)
- NPROD = NPROD + 1
- CALL ustckv(NPROD, MREG, XTRKCR, YTRKCR, ZTRKCR)
-*
-*
-*
-* | !!!!!! Here Stuprf should be used !!!!!!
- LOUOPP (LSTOPP) = ITFL
- DO 2100 ISPR = 1, MKBMX1
- SPAROK (ISPR,LSTOPP) = SPAUSR (ISPR)
- 2100 CONTINUE
- DO 2200 ISPR = 1, MKBMX2
- ISPORK (ISPR,LSTOPP) = ISPUSR (ISPR)
- 2200 CONTINUE
-* | Save the parent features:
- TPROPP (LSTOPP) = ETRACK - AMPRTC
- APROPP (LSTOPP) = ATRKCR
- LPROPP (LSTOPP) = LTRACK
- IPROPP (LSTOPP) = JTRACK
- NPROPP (LSTOPP) = 0
-* | Update the "current" particle values:
- ETRKCR = ETRKCR - EPHSMP
- DEDXCK = DEDXCK + EPHSMP
- PTRKCR = SQRT ( ( ETRKCR - AMPRTC ) * ( ETRKCR + AMPRTC ) )
- PTINTR = PTRKCR
- ETINTR = ETRKCR
- TRINTR = ZERZER
- BETNLD = BETNCR
- BETNCR = PTRKCR / ETRKCR * RMXCER (MMAT)
-* | No longer any chance to emit Cerenkov photons:
- IF ( BETNCR .LE. ONEONE ) GO TO 7000
- BTNFLD = BTNFCR
- BTNFCR = ( BETNCR - ONEONE ) * ( BETNCR + ONEONE ) / BETNCR**2
-* | Update the macroscopic sigma: beta can only decrease
- SIGMCK = SIGMCK * BTNFCR / BTNFLD
- GO TO 1000
-* |
-* +-------------------------------------------------------------------*
- 7000 CONTINUE
- RETURN
-*=== End of subroutine Crnkvp =========================================*
- END
-
+++ /dev/null
-#include "Fdimpar.h" //(DIMPAR) fluka include
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Fiounit.h" //(IOUNIT) fluka common
-#ifndef WIN32
-# define dffcff dffcff_
-#else
-# define dffcff DFFCFF
-#endif
-extern "C" {
-Double_t dffcff(Double_t& /*wvlngt*/, Double_t& /*omgpho*/, Int_t& /*mmat*/)
-{
-// printf("dffcff called %e %e %d \n", wvlngt, omgpho, mmat);
- return (0.);
-}
-}
-
-
+++ /dev/null
-#include <Riostream.h>
-#include "TVirtualMCApplication.h"
-
-#include "TFluka.h"
-#include "TFlukaCodes.h"
-
-#ifndef WIN32
-# define eedraw eedraw_
-#else
-# define eedraw EEDRAW
-#endif
-extern "C" {
-void eedraw(Int_t& icode)
-{
- ((TFluka*) gMC)->SetCaller(kEEDRAW);
- ((TFluka*) gMC)->SetIcode((FlukaProcessCode_t) icode);
-} // end of eedraw
-} // end of extern "C"
-
+++ /dev/null
-#include <Riostream.h>
-#include "TVirtualMCApplication.h"
-#include "TGeoMaterial.h"
-#include "TGeoManager.h"
-#include <TParticle.h>
-#include "TFlukaCerenkov.h"
-
-#include "TFluka.h"
-#include "TFlukaCodes.h"
-
-#include "Fdimpar.h" //(DIMPAR) fluka include
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Fltclcm.h" //(LTCLCM) fluka common
-#include "Fpaprop.h" //(PAPROP) fluka common
-#include "Fopphst.h" //(OPPHST) fluka common
-
-#ifndef WIN32
-# define endraw endraw_
-#else
-# define endraw ENDRAW
-#endif
-extern "C" {
-void endraw(Int_t& icode, Int_t& mreg, Double_t& rull, Double_t& xsco, Double_t& ysco, Double_t& zsco)
-{
- TFluka* fluka = (TFluka*) gMC;
- // nothing to do if particle in dummy region
- if (mreg == fluka->GetDummyRegion()) return;
- Int_t verbosityLevel = fluka->GetVerbosityLevel();
- Bool_t debug = (verbosityLevel >= 3)? kTRUE : kFALSE;
- Int_t mlttc = (icode==kKASKADinelarecoil) ? TRACKR.lt2trk : TRACKR.lt1trk; //LTCLCM.mlatm1;
- fluka->SetCaller(kENDRAW);
- fluka->SetRull(rull);
- fluka->SetXsco(xsco);
- fluka->SetYsco(ysco);
- fluka->SetZsco(zsco);
- fluka->SetMreg(mreg, mlttc);
-
- Float_t edep = rull;
- Int_t ipt = fluka->PDGFromId(TRACKR.jtrack);
- if (ipt == -1) {
- if (debug) printf("Unknown particle %5d %5d \n", TRACKR.jtrack, icode);
- return;
- }
-
- if (TRACKR.jtrack == -1) {
- // Handle quantum efficiency the G3 way
- if (debug) printf("endraw: Cerenkov photon depositing energy: %d %e\n", mreg, rull);
- TGeoMaterial* material = (gGeoManager->GetCurrentVolume())->GetMaterial();
- TFlukaCerenkov* cerenkov = dynamic_cast<TFlukaCerenkov*> (material->GetCerenkovProperties());
- if (cerenkov) {
- Double_t eff = (cerenkov->GetQuantumEfficiency(rull));
- if (gRandom->Rndm() > eff) {
- edep = 0.;
- }
- }
- }
-
- TVirtualMCStack* cppstack = fluka->GetStack();
-
- if (debug) {
- cout << "ENDRAW For icode=" << icode
- << " track=" << TRACKR.ispusr[mkbmx2-1] << " pdg=" << fluka->PDGFromId(TRACKR.jtrack)
- << " edep="<< edep << " mreg=" << mreg << endl;
- }
-
- // check region lattice consistency (debug Ernesto)
- // *****************************************************
- Int_t nodeId;
- Int_t volId = fluka->CurrentVolID(nodeId);
- Int_t crtlttc = gGeoManager->GetCurrentNodeId()+1;
- if(debug && mreg != volId && !gGeoManager->IsOutside() ) {
- cout << " endraw: track=" << TRACKR.ispusr[mkbmx2-1] << " pdg=" << fluka->PDGFromId(TRACKR.jtrack)
- << " icode=" << icode << " gNstep=" << fluka->GetNstep() << endl
- << " fluka mreg=" << mreg << " mlttc=" << mlttc << endl
- << " TGeo volId=" << volId << " crtlttc=" << crtlttc << endl
- << " common TRACKR lt1trk=" << TRACKR.lt1trk << " lt2trk=" << TRACKR.lt2trk << endl
- << " common LTCLCM newlat=" << LTCLCM.newlat << " mlatld=" << LTCLCM.mlatld << endl
- << " mlatm1=" << LTCLCM.mlatm1 << " mltsen=" << LTCLCM.mltsen << endl
- << " mltsm1=" << LTCLCM.mltsm1 << " mlattc=" << LTCLCM.mlattc << endl;
- if( mlttc == crtlttc ) cout << " *************************************************************" << endl;
- }
- // *****************************************************
- if (icode != kEMFSCOstopping1 && icode != kEMFSCOstopping2) {
- fluka->SetIcode((FlukaProcessCode_t)icode);
- fluka->SetRull(edep);
- if (icode == kKASKADelarecoil && TRACKR.ispusr[mkbmx2-5]) {
- // Elastic recoil and in stuprf npprmr > 0,
- // the secondary being loaded is actually still the interacting particle
- cppstack->SetCurrentTrack( TRACKR.ispusr[mkbmx2-4] );
- } else if (TRACKR.jtrack == -1) {
- cppstack->SetCurrentTrack(OPPHST.louopp[OPPHST.lstopp]);
- } else {
- cppstack->SetCurrentTrack(TRACKR.ispusr[mkbmx2-1] );
- }
-
- (TVirtualMCApplication::Instance())->Stepping();
-
- } else {
- //
- // For icode 21,22 the particle has fallen below thresshold.
- // This has to be signalled to the StepManager()
- //
- cppstack->SetCurrentTrack( TRACKR.ispusr[mkbmx2-1] );
-
- fluka->SetRull(edep);
- fluka->SetIcode((FlukaProcessCode_t) icode);
- (TVirtualMCApplication::Instance())->Stepping();
- fluka->SetTrackIsNew(kFALSE);
-// fluka->SetIcode((FlukaProcessCode_t)icode);
-// fluka->SetRull(0.);
-// (TVirtualMCApplication::Instance())->Stepping();
- }
-} // end of endraw
-} // end of extern "C"
-
+++ /dev/null
-*$ CREATE FLUSCW.FOR
-*COPY FLUSCW
-* *
-*=== fluscw ===========================================================*
-* *
- DOUBLE PRECISION FUNCTION FLUSCW
- #(IJ,PLA,TXX,TYY,TZZ,WEE,XX,YY,ZZ,NREG,IOLREG,LLO,NSURF)
-
- INCLUDE '(DBLPRC)'
- INCLUDE '(DIMPAR)'
- INCLUDE '(IOUNIT)'
- SAVE
-
- INCLUDE '(PAPROP)'
- INCLUDE '(USRBIN)'
- INCLUDE '(USRBDX)'
- INCLUDE '(USRTRC)'
- INCLUDE '(SCOHLP)'
-*
-*----------------------------------------------------------------------*
-* *
-* This functions returns neutron, proton and pion displacement damage *
-* weight factors. *
-* *
-*----------------------------------------------------------------------*
-* *
-* Input variables: *
-* *
-* Ij = (generalized) particle code *
-* Pla = particle momentum (if > 0), or kinetic energy (if <0 )*
-* Txx,yy,zz = particle direction cosines *
-* Wee = particle weight *
-* Xx,Yy,Zz = position *
-* Nreg = (new) region number *
-* Iolreg = (old) region number *
-* Llo = particle generation *
-* Nsurf = transport flag (ignore!) *
-* *
-* Output variables: *
-* *
-* Fluscw = factor the scored amount will be multiplied by *
-* Lsczer = logical flag, if true no amount will be scored *
-* regardless of Fluscw *
-* *
-* Useful variables (common SCOHLP): *
-* *
-* Flux like binnings/estimators (Fluscw): *
-* ISCRNG = 1 --> Boundary crossing estimator *
-* ISCRNG = 2 --> Track length binning *
-* ISCRNG = 3 --> Track length estimator *
-* ISCRNG = 4 --> Collision density estimator *
-* ISCRNG = 5 --> Yield estimator *
-* JSCRNG = # of the binning/estimator *
-* *
-*----------------------------------------------------------------------*
-*
- LOGICAL LFIRST
-
-
- DATA LFIRST /.TRUE./
-*
-* the default is unit weight
- FLUSCW = ONEONE
- LSCZER = .FALSE.
-*
-* skip all scorings other than tracklength
- IF (ISCRNG.NE.2) RETURN
-* skip all particles other than protons, pions and neutrons
- IF ((IJ.NE.1).AND.(IJ.NE.13).AND.(IJ.NE.14).AND.(IJ.NE.8)) RETURN
-*
-* read displacement damage factors
- IF (LFIRST) THEN
- WRITE(LUNOUT,1000)
- 1000 FORMAT(1X,'FLUSCW: direct conversion of neutron fluence to',
- & ' 1 MeV neutron equivalent requested')
- WRITE(LUNOUT,*) ' neutrons'
- OPEN(19,FILE='disdam_n.dat',STATUS='UNKNOWN')
- CALL SKIP(19,7)
- CALL RDXSC(19,LUNOUT,IDNDAM,-3)
- CLOSE(19)
- WRITE(LUNOUT,*) ' protons '
- OPEN(19,FILE='disdam_p.dat',STATUS='UNKNOWN')
- CALL SKIP(19,7)
- CALL RDXSC(19,LUNOUT,IDPDAM,-2)
- CLOSE(19)
- WRITE(LUNOUT,*) ' pions '
- OPEN(19,FILE='disdam_pi.dat',STATUS='UNKNOWN')
- CALL SKIP(19,7)
- CALL RDXSC(19,LUNOUT,IDODAM,-2)
- CLOSE(19)
- LFIRST = .FALSE.
- ENDIF
-*
-* should be always called with ekin ( pla < 0 ),
-* but we leave the check for the moment..
- IF (PLA.LT.0.0D0) THEN
- EKIN = ABS(PLA)
- ELSEIF (PLA.GT.0.0D0) THEN
- EKIN = SQRT(PLA**2+AM(IJ)**2)-AM(IJ)
- ELSE
- RETURN
- ENDIF
-*
-* calculate the weight
- IF (IJ.EQ.1) THEN
- FLUSCW = XSECT(IDPDAM,EKIN,0)
- ELSEIF ((IJ.EQ.13).OR.(IJ.EQ.14)) THEN
- FLUSCW = XSECT(IDODAM,EKIN,0)
- ELSEIF (IJ.EQ.8) THEN
- FLUSCW = XSECT(IDNDAM,EKIN,0)
- ELSE
- STOP ' FLUSCW: inconsistent IJ '
- ENDIF
-
- RETURN
- END
-*
-*===rdxsc==============================================================*
-*
- SUBROUTINE RDXSC(LINP,LCHK,IDXSEC,MODE)
-
-************************************************************************
-* LINP logical input unit *
-* LCHK > 0 cross section data are plotted to unit LCHK *
-* in equidistant log. binning using double-log. *
-* interpolation *
-* (otherwise they are not plotted) *
-* IDXSEC index of stored cross section in common *
-* |MODE| = 1 cross section data given as histogram *
-* i.e. E_lo(i) sigma(i) *
-* E_hi(i) sigma(i) *
-* with increasing energy *
-* = 2 cross section data given for bin averages with *
-* increasing energy *
-* = 3 cross section data given for bin averages with *
-* decreasing energy *
-* if MODE < 0 the energy unit is assumed to be MeV (otherwise GeV) *
-************************************************************************
-
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- SAVE
-
- PARAMETER (MAXSDT = 10,
- & MAXSBI = 1400)
- COMMON /CSECT/ XSEAV(MAXSDT,MAXSBI),XS(MAXSDT,MAXSBI),
- & NXSBIN(MAXSDT),NXSDT
- DIMENSION TMPXS(2,MAXSBI)
-
- LOGICAL LFIRST
- DATA LFIRST /.TRUE./
-
- IF (LFIRST) THEN
- NXSDT = 0
- DO 1 IDT=1,MAXSDT
- NXSBIN(IDT) = 0
- DO 2 IBIN=1,MAXSBI
- XSEAV(IDT,IBIN) = 0.0D0
- XS(IDT,IBIN) = 0.0D0
- 2 CONTINUE
- 1 CONTINUE
- LFIRST = .FALSE.
- ENDIF
-
- NXSDT = NXSDT+1
-
- NEBIN = 0
- 10 CONTINUE
- NEBIN = NEBIN+1
- IF (NEBIN.GT.MAXSBI) STOP ' nebin > maxsbi !!!'
- IF (IABS(MODE).EQ.1) THEN
- READ(LINP,*,END=9000) ELOW,XS(NXSDT,NEBIN)
- READ(LINP,*) ELHI,XS(NXSDT,NEBIN)
- XSEAV(NXSDT,NEBIN) = SQRT(ELOW*ELHI)
- IF (MODE.LT.0) XSEAV(NXSDT,NEBIN) = 1.D-3*XSEAV(NXSDT,NEBIN)
- ELSEIF (IABS(MODE).EQ.2) THEN
- READ(LINP,*,END=9000) XSEAV(NXSDT,NEBIN),XS(NXSDT,NEBIN)
- IF (MODE.LT.0) XSEAV(NXSDT,NEBIN) = 1.D-3*XSEAV(NXSDT,NEBIN)
- ELSEIF (IABS(MODE).EQ.3) THEN
- READ(LINP,*,END=9000) TMPXS(1,NEBIN),TMPXS(2,NEBIN)
- IF (MODE.LT.0) TMPXS(1,NEBIN) = 1.D-3*TMPXS(1,NEBIN)
- ELSE
- STOP ' RDXSC: unsupported mode ! '
- ENDIF
- GOTO 10
- 9000 CONTINUE
-
- IF (IABS(MODE).EQ.3) THEN
- DO 3 I=1,NEBIN-1
- IDX = NEBIN-I
- XSEAV(NXSDT,IDX) = TMPXS(1,I)
- XS(NXSDT,IDX) = TMPXS(2,I)
- 3 CONTINUE
- ENDIF
-
- NXSBIN(NXSDT) = NEBIN-1
- IDXSEC = NXSDT
-
- IF (LCHK.GT.0) THEN
- AELO = LOG10(XSEAV(IDXSEC,1))
- AEHI = LOG10(XSEAV(IDXSEC,NXSBIN(IDXSEC)))
- DAE = (AEHI-AELO)/DBLE(NXSBIN(IDXSEC))
- DO 4 I=1,NXSBIN(IDXSEC)+1
- AE = AELO+DBLE(I-1)*DAE
- E = 10.0D0**AE
- WRITE(LCHK,'(1X,2E15.5)') E,XSECT(IDXSEC,E,0)
- 4 CONTINUE
- ENDIF
-
- RETURN
- END
-*
-*===xsect==============================================================*
-*
- DOUBLE PRECISION FUNCTION XSECT(IDXSEC,E,MODE)
-
-************************************************************************
-* IDXSEC index of stored cross section in common *
-* E energy *
-************************************************************************
-
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- SAVE
-
- PARAMETER (MAXSDT = 10,
- & MAXSBI = 1400)
- COMMON /CSECT/ XSEAV(MAXSDT,MAXSBI),XS(MAXSDT,MAXSBI),
- & NXSBIN(MAXSDT),NXSDT
-
- IF (E.LE.XSEAV(IDXSEC,1)) THEN
- CS = 0.0D0
- ELSEIF (E.GT.XSEAV(IDXSEC,NXSBIN(IDXSEC))) THEN
- N = NXSBIN(IDXSEC)-1
- CS = XSCINT(IDXSEC,E,N)
- ELSE
- DO 1 J=1,NXSBIN(IDXSEC)-1
- IF ((E.GT.XSEAV(IDXSEC,J)).AND.(E.LE.XSEAV(IDXSEC,J+1)))
- & THEN
- CS = XSCINT(IDXSEC,E,J)
- GOTO 2
- ENDIF
- 1 CONTINUE
- STOP ' xsection value not found '
- 2 CONTINUE
- ENDIF
- XSECT = CS
-
- RETURN
- END
-*
-*===xscint=============================================================*
-*
- DOUBLE PRECISION FUNCTION XSCINT(IDXSEC,E,J)
-
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- SAVE
-
- PARAMETER (MAXSDT = 10,
- & MAXSBI = 1400)
- COMMON /CSECT/ XSEAV(MAXSDT,MAXSBI),XS(MAXSDT,MAXSBI),
- & NXSBIN(MAXSDT),NXSDT
-
- FAC = (LOG10(E) -LOG10(XSEAV(IDXSEC,J)))/
- & (LOG10(XSEAV(IDXSEC,J+1))-LOG10(XSEAV(IDXSEC,J)))
- XSCINT = LOG10(XS(IDXSEC,J))
- & +(LOG10(XS(IDXSEC,J+1))-LOG10(XS(IDXSEC,J)))*FAC
- XSCINT = 10**(XSCINT)
-
- RETURN
- END
-*
-*===skip===============================================================*
-*
- SUBROUTINE SKIP(LUNIT,NSKIP)
-
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
- SAVE
- PARAMETER (LOUT=6,LLOOK=9)
-
- CHARACTER*132 ACARD
-
- IF (NSKIP.EQ.0) RETURN
-
- DO 1 K=1,NSKIP
- READ(LUNIT,'(A132)') ACARD
- 1 CONTINUE
-
- RETURN
- END
+++ /dev/null
-************************************************************************
-* Energy dependent factors for the conversion of fluence to *
-* effective dose and ambient dose equivalent for neutrons, protons, *
-* charged pions, muons, photons and electrons. *
-* *
-* The following sets are available: *
-* (for photons and electrons see note below) *
-* *
-* 1-3: Effective dose from ICRP74 and Pelliccioni data *
-* calculated with ICRP radiation weighting factors Wr *
-* 1: Anterior-Posterior irradiation *
-* 2: Rotational irradiation geometry *
-* 3: WORST possible geometry for the irradiation *
-* *
-* 4-6: Effective dose from ICRP74 and Pelliccioni data *
-* calculated with the Pelliccioni radiation weighting *
-* factors Wr *
-* 4: Anterior-Posterior irradiation *
-* 5: Rotational irradiation geometry *
-* 6: WORST possible geometry for the irradiation *
-* *
-* 7: Ambient dose equivalent from ICRP74 and Pelliccioni data *
-* *
-* 8: Ambient dose equivalent with old "GRS"-conversion factors *
-* *
-* The different sets are invoked by EXTRAWEI (WHAT(3)=1) and the *
-* first five characters of the SDUM input parameter of the USRBIN, *
-* USRTRACK or USRBDX cards (case-insensitive) : *
-* *
-* SDUM(1:5) = *
-* 'EAP74' = 1 'ERT74' = 2 'EWT74' = 3 *
-* 'EAPMP' = 4 'ERTMP' = 5 'EWTMP' = 6 *
-* 'AMB74' = 7 'AMBGS' = 8 *
-* *
-* The default (any other SDUM) is unit weight factor. *
-* *
-* Conversion factor sets for hadrons (n,p,pi) and muons can be *
-* enabled separately from those for photons and electrons by *
-* setting the 6th character of SDUM: *
-* *
-* SDUM(6:6) = 1 only hadrons and muons (zero factor returned for *
-* electrons and photons) *
-* = 2 only electrons/positrons and photons (zero factor *
-* returned for hadrons and muons) *
-* otherwise: all particles considered (default) *
-* *
-* Note: Photons and electrons: *
-* Only sets 1-3 and 7 are implemented for photons and electrons*
-* If sets 4-6 are requested sets 1-3 are used instead. *
-* For set 8 zero values are returned. *
-* *
-* Note 2: Stand-alone use: *
-* The function can be used "stand-alone" (i.e. independent *
-* from FLUKA). In this case different conversion factor sets *
-* are invoked by the first parameter (IIJ) *
-* *
-* IIJ = -(is*10000+id) where *
-* *
-* is = index of parameter set *
-* id = particle identity *
-* *
-* (example: -80008 = neutron with GRS-conversion factor set) *
-************************************************************************
-* *
-*=== fluscw ===========================================================*
-* *
- DOUBLE PRECISION FUNCTION FLUSCW
- & (IIJ,PLA,TXX,TYY,TZZ,WEE,XX,YY,ZZ,NREG,IOLREG,LLO,NSURF)
-
- INCLUDE '(DBLPRC)'
- INCLUDE '(DIMPAR)'
- INCLUDE '(IOUNIT)'
- SAVE
-
- INCLUDE '(PAPROP)'
- INCLUDE '(USRBIN)'
- INCLUDE '(USRBDX)'
- INCLUDE '(USRTRC)'
- INCLUDE '(SCOHLP)'
-
- LOGICAL LFIRST
- CHARACTER*10 CSET
- DIMENSION LFIRST(0:8)
-
- PARAMETER (NBIN1N=81,NBIN2N=150,
- & NBIN1P=64,NBIN2P=61,
- & NBIN1I=71,
- & NBIN1M=71,NBIN2M=16,
- & NBIN1G=81,
- & NBIN1E=41,NBIN2E=81)
-
- DIMENSION ITT(40)
-* 1 - neutron, 2 - proton, 3 - pion+, 4 - pion-, 5 - muon+, 5 - muon-,
-* 7 - photon, 8 - electron, 99 - the rest
- DATA ITT/ 2, 2, 8, 8,99,99, 7, 1, 1, 5,
- & 5,99, 3, 4, 3, 4, 1, 1,99, 4,
- & 3,99,99,99,99,99,99,99,99,99,
- & 99,99,99,99,99,99,99,99,99,99/
-*
-*-----------------------------------------------------------------------
-*
-* Effective dose for neutrons from ICRP74 and Pelliccioni data
-* calculated with ICRP radiation weighting factors Wr
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION EBINN(NBIN1N),AEBINN(NBIN1N)
- DATA EBINN /
- 1 1.000D-12, 1.000D-11, 2.530D-11, 1.000D-10, 2.000D-10,
- 2 5.000D-10, 1.000D-09, 2.000D-09, 5.000D-09, 1.000D-08,
- 3 2.000D-08, 5.000D-08, 1.000D-07, 2.000D-07, 5.000D-07,
- 4 1.000D-06, 2.000D-06, 5.000D-06, 1.000D-05, 2.000D-05,
- 5 3.000D-05, 5.000D-05, 7.000D-05, 1.000D-04, 1.500D-04,
- 6 2.000D-04, 3.000D-04, 5.000D-04, 7.000D-04, 9.000D-04,
- 7 1.000D-03, 1.200D-03, 2.000D-03, 3.000D-03, 4.000D-03,
- 8 5.000D-03, 6.000D-03, 7.000D-03, 8.000D-03, 9.000D-03,
- 9 1.000D-02, 1.200D-02, 1.400D-02, 1.500D-02, 1.600D-02,
- * 1.800D-02, 2.000D-02, 3.000D-02, 5.000D-02, 7.500D-02,
- 1 1.000D-01, 1.500D-01, 2.000D-01, 3.000D-01, 5.000D-01,
- 2 7.000D-01, 1.000D+00, 1.500D+00, 2.000D+00, 3.000D+00,
- 3 5.000D+00, 7.000D+00, 1.000D+01, 1.500D+01, 2.000D+01,
- 4 3.000D+01, 5.000D+01, 7.000D+01, 1.000D+02, 1.500D+02,
- 5 2.000D+02, 3.000D+02, 5.000D+02, 7.000D+02, 1.000D+03,
- 6 1.500D+03, 2.000D+03, 3.000D+03, 5.000D+03, 7.000D+03,
- 7 1.000D+04/
- DIMENSION AP74N(NBIN1N),RT74N(NBIN1N),WT74N(NBIN1N),
- & AAP74N(NBIN1N),ART74N(NBIN1N),AWT74N(NBIN1N)
-* Anterior-Posterior irradiation
- DATA AP74N /
- 1 5.2D0, 6.6D0, 7.6D0, 10.0D0, 11.2D0,
- 2 12.8D0, 13.8D0, 14.5D0, 15.0D0, 15.1D0,
- 3 15.1D0, 14.8D0, 14.6D0, 14.4D0, 14.2D0,
- 4 14.2D0, 14.4D0, 15.7D0, 18.3D0, 23.8D0,
- 5 29.0D0, 38.5D0, 47.2D0, 59.8D0, 80.2D0,
- 6 99.0D0, 133.0D0, 188.0D0, 231.0D0, 267.0D0,
- 7 282.0D0, 310.0D0, 383.0D0, 432.0D0, 458.0D0,
- 8 474.0D0, 483.0D0, 490.0D0, 494.0D0, 497.0D0,
- 9 499.0D0, 499.0D0, 496.0D0, 494.0D0, 491.0D0,
- * 486.0D0, 480.0D0, 458.0D0, 437.0D0, 429.0D0,
- 1 429.0D0, 431.0D0, 447.0D0, 491.0D0, 581.0D0,
- 2 663.0D0, 767.0D0, 905.0D0, 1016.0D0, 1191.0D0,
- 3 1443.0D0, 1628.0D0, 1840.0D0, 2097.0D0, 2291.0D0,
- 4 2581.0D0, 2978.0D0, 3263.0D0, 3590.0D0, 3999.0D0,
- 5 4315.0D0, 4801.0D0, 5484.0D0, 5980.0D0, 6550.0D0,
- 6 7255.0D0, 7794.0D0, 8614.0D0, 9751.0D0, 10569.0D0,
- 7 11500.0D0/
-* Rotational irradiation geometry
- DATA RT74N /
- 1 2.99D0, 3.72D0, 4.40D0, 5.75D0, 6.43D0,
- 2 7.27D0, 7.84D0, 8.31D0, 8.72D0, 8.90D0,
- 3 8.92D0, 8.82D0, 8.69D0, 8.56D0, 8.40D0,
- 4 8.34D0, 8.39D0, 9.06D0, 10.6D0, 13.8D0,
- 5 16.9D0, 22.7D0, 27.8D0, 34.8D0, 45.4D0,
- 6 54.8D0, 71.6D0, 99.4D0, 123.0D0, 144.0D0,
- 7 154.0D0, 173.0D0, 234.0D0, 283.0D0, 315.0D0,
- 8 335.0D0, 348.0D0, 358.0D0, 366.0D0, 373.0D0,
- 9 378.0D0, 385.0D0, 390.0D0, 391.0D0, 393.0D0,
- * 394.0D0, 395.0D0, 395.0D0, 404.0D0, 422.0D0,
- 1 443.0D0, 496.0D0, 535.0D0, 594.0D0, 681.0D0,
- 2 754.0D0, 854.0D0, 1008.0D0, 1149.0D0, 1396.0D0,
- 3 1792.0D0, 2102.0D0, 2460.0D0, 2884.0D0, 3192.0D0,
- 4 3639.0D0, 4238.0D0, 4669.0D0, 5180.0D0, 5855.0D0,
- 5 6406.0D0, 7296.0D0, 8634.0D0, 9664.0D0, 10900.0D0,
- 6 12505.0D0, 13788.0D0, 15828.0D0, 18844.0D0, 21145.0D0,
- 7 23900.0D0/
-* WORST possible geometry for the irradiation
- DATA WT74N /
- 1 5.2D0, 6.6D0, 7.6D0, 10.0D0, 11.2D0,
- 2 12.8D0, 13.8D0, 14.5D0, 15.0D0, 15.1D0,
- 3 15.1D0, 14.8D0, 14.6D0, 14.4D0, 14.2D0,
- 4 14.2D0, 14.4D0, 15.7D0, 18.3D0, 23.8D0,
- 5 29.0D0, 38.5D0, 47.2D0, 59.8D0, 80.2D0,
- 6 99.0D0, 133.0D0, 188.0D0, 231.0D0, 267.0D0,
- 7 282.0D0, 310.0D0, 383.0D0, 432.0D0, 458.0D0,
- 8 474.0D0, 483.0D0, 490.0D0, 494.0D0, 497.0D0,
- 9 499.0D0, 499.0D0, 496.0D0, 494.0D0, 491.0D0,
- * 486.0D0, 480.0D0, 458.0D0, 444.0D0, 459.0D0,
- 1 477.0D0, 523.0D0, 559.0D0, 616.0D0, 707.0D0,
- 2 785.0D0, 892.0D0, 1056.0D0, 1205.0D0, 1468.0D0,
- 3 1898.0D0, 2244.0D0, 2660.0D0, 3184.0D0, 3586.0D0,
- 4 4201.0D0, 5065.0D0, 5702.0D0, 6450.0D0, 7415.0D0,
- 5 8184.0D0, 9409.0D0, 11224.0D0, 12618.0D0, 14300.0D0,
- 6 16512.0D0, 18304.0D0, 21196.0D0, 25562.0D0, 28960.0D0,
- 7 33100.0D0/
-*
-* Effective dose for protons from ICRP74 and Pelliccioni data
-* calculated with ICRP radiation weighting factors Wr
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION E74P(NBIN1P),AE74P(NBIN1P)
- DATA E74P /
- 1 5.00D-03, 6.50D-03, 8.00D-03, 1.00D-02, 1.25D-02,
- 2 1.50D-02, 2.00D-02, 2.50D-02, 3.00D-02, 4.00D-02,
- 3 5.00D-02, 6.50D-02, 8.00D-02, 1.00D-01, 1.25D-01,
- 4 1.50D-01, 2.00D-01, 2.50D-01, 3.00D-01, 4.00D-01,
- 5 5.00D-01, 6.50D-01, 8.00D-01, 1.00D+00, 1.25D+00,
- 6 1.50D+00, 2.00D+00, 2.50D+00, 3.00D+00, 4.00D+00,
- 7 5.00D+00, 6.50D+00, 8.00D+00, 1.00D+01, 1.25D+01,
- 8 1.50D+01, 2.00D+01, 2.50D+01, 3.00D+01, 4.00D+01,
- 9 5.00D+01, 6.50D+01, 8.00D+01, 1.00D+02, 1.25D+02,
- * 1.50D+02, 2.00D+02, 2.50D+02, 3.00D+02, 4.00D+02,
- 1 5.00D+02, 6.50D+02, 8.00D+02, 1.00D+03, 1.25D+03,
- 2 1.50D+03, 2.00D+03, 2.50D+03, 3.00D+03, 4.00D+03,
- 3 5.00D+03, 6.50D+03, 8.00D+03, 1.00D+04/
- DIMENSION AP74P(NBIN1P),RT74P(NBIN1P),WT74P(NBIN1P),
- & AAP74P(NBIN1P),ART74P(NBIN1P),AWT74P(NBIN1P)
-* Anterior-Posterior irradiation
- DATA AP74P /
- 1 57.5D0, 65.4D0, 74.3D0, 89.5D0, 116.4D0,
- 2 155.2D0, 289.0D0, 546.5D0, 982.1D0, 2540.0D0,
- 3 4810.0D0, 6969.6D0, 7336.4D0, 6820.0D0, 6080.5D0,
- 4 5467.0D0, 4570.0D0, 3977.7D0, 3573.9D0, 3089.0D0,
- 5 2840.0D0, 2673.7D0, 2597.5D0, 2530.0D0, 2455.9D0,
- 6 2410.1D0, 2420.0D0, 2534.3D0, 2688.1D0, 2996.8D0,
- 7 3240.0D0, 3464.8D0, 3601.1D0, 3730.0D0, 3862.6D0,
- 8 3975.3D0, 4155.7D0, 4292.5D0, 4398.5D0, 4547.2D0,
- 9 4640.0D0, 4722.1D0, 4784.0D0, 4870.0D0, 4995.2D0,
- * 5128.6D0, 5394.4D0, 5645.8D0, 5879.5D0, 6298.2D0,
- 1 6662.4D0, 7129.9D0, 7525.5D0, 7970.0D0, 8428.5D0,
- 2 8812.8D0, 9438.1D0, 9940.3D0, 10362.6D0, 11053.4D0,
- 3 11611.9D0, 12297.0D0, 12863.8D0, 13500.0D0/
-* Rotational irradiation geometry
- DATA RT74P /
- 1 48.2D0, 54.5D0, 61.1D0, 71.4D0, 87.6D0,
- 2 108.5D0, 169.7D0, 266.8D0, 409.7D0, 875.8D0,
- 3 1582.0D0, 2499.1D0, 3087.1D0, 3642.5D0, 4289.0D0,
- 4 4804.9D0, 5160.0D0, 4771.6D0, 4200.7D0, 3304.3D0,
- 5 2832.5D0, 2593.8D0, 2546.2D0, 2540.0D0, 2518.5D0,
- 6 2501.2D0, 2527.5D0, 2630.4D0, 2767.2D0, 3059.7D0,
- 7 3330.0D0, 3664.4D0, 3928.8D0, 4200.0D0, 4446.4D0,
- 8 4629.0D0, 4888.9D0, 5074.6D0, 5222.2D0, 5461.2D0,
- 9 5665.0D0, 5941.3D0, 6192.5D0, 6497.5D0, 6842.1D0,
- * 7154.8D0, 7708.2D0, 8190.8D0, 8621.5D0, 9370.8D0,
- 1 10013.3D0, 10839.7D0, 11549.4D0, 12367.5D0, 13243.7D0,
- 2 14005.1D0, 15295.5D0, 16377.1D0, 17317.0D0, 18910.3D0,
- 3 20245.9D0, 21937.1D0, 23374.8D0, 25025.0D0/
-* WORST possible geometry for the irradiation
- DATA WT74P /
- 1 59.2D0, 66.8D0, 75.5D0, 90.6D0, 117.3D0,
- 2 155.8D0, 289.0D0, 545.6D0, 980.1D0, 2540.0D0,
- 3 4810.0D0, 6860.6D0, 7172.3D0, 6820.0D0, 6501.3D0,
- 4 6255.9D0, 5640.0D0, 4889.3D0, 4237.9D0, 3379.9D0,
- 5 2950.0D0, 2718.2D0, 2661.4D0, 2650.0D0, 2639.8D0,
- 6 2636.5D0, 2670.0D0, 2751.5D0, 2859.1D0, 3109.6D0,
- 7 3380.0D0, 3787.8D0, 4155.1D0, 4550.0D0, 4897.3D0,
- 8 5139.5D0, 5459.3D0, 5672.7D0, 5839.6D0, 6122.3D0,
- 9 6390.0D0, 6794.6D0, 7181.0D0, 7650.0D0, 8163.8D0,
- * 8616.8D0, 9397.9D0, 10064.3D0, 10651.5D0, 11662.8D0,
- 1 12524.9D0, 13633.2D0, 14589.0D0, 15700.0D0, 16904.4D0,
- 2 17963.1D0, 19781.3D0, 21326.4D0, 22683.3D0, 25011.0D0,
- 3 26986.3D0, 29515.1D0, 31686.5D0, 34200.0D0/
-*
-* Effective dose for charged pions from ICRP74 and Pelliccioni data
-* calculated with ICRP radiation weighting factors Wr
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION EBINI(NBIN1I),AEBINI(NBIN1I)
- DATA EBINI/
- 1 1.00D-03, 1.25D-03, 1.50D-03, 2.00D-03, 2.50D-03,
- 2 3.00D-03, 4.00D-03, 5.00D-03, 6.50D-03, 8.00D-03,
- 3 1.00D-02, 1.25D-02, 1.50D-02, 2.00D-02, 2.50D-02,
- 4 3.00D-02, 4.00D-02, 5.00D-02, 6.50D-02, 8.00D-02,
- 5 1.00D-01, 1.25D-01, 1.50D-01, 2.00D-01, 2.50D-01,
- 6 3.00D-01, 4.00D-01, 5.00D-01, 6.50D-01, 8.00D-01,
- 7 1.00D+00, 1.25D+00, 1.50D+00, 2.00D+00, 2.50D+00,
- 8 3.00D+00, 4.00D+00, 5.00D+00, 6.50D+00, 8.00D+00,
- 9 1.00D+01, 1.25D+01, 1.50D+01, 2.00D+01, 2.50D+01,
- * 3.00D+01, 4.00D+01, 5.00D+01, 6.50D+01, 8.00D+01,
- 1 1.00D+02, 1.25D+02, 1.50D+02, 2.00D+02, 2.50D+02,
- 2 3.00D+02, 4.00D+02, 5.00D+02, 6.50D+02, 8.00D+02,
- 3 1.00D+03, 1.25D+03, 1.50D+03, 2.00D+03, 2.50D+03,
- 4 3.00D+03, 4.00D+03, 5.00D+03, 6.50D+03, 8.00D+03,
- 5 1.00D+04/
- DIMENSION AP74I(NBIN1I),RT74I(NBIN1I),WT74I(NBIN1I),
- & AP74J(NBIN1I),RT74J(NBIN1I),WT74J(NBIN1I),
- & AAP74I(NBIN1I),ART74I(NBIN1I),AWT74I(NBIN1I),
- & AAP74J(NBIN1I),ART74J(NBIN1I),AWT74J(NBIN1I)
-* Anterior-Posterior irradiation
-* Positive pions
- DATA AP74I /
- 1 71.3D0, 76.3D0, 80.9D0, 89.3D0, 97.4D0,
- 2 105.6D0, 122.3D0, 140.1D0, 168.8D0, 200.6D0,
- 3 248.0D0, 315.4D0, 389.4D0, 547.5D0, 707.6D0,
- 4 859.7D0, 1117.7D0, 1300.0D0, 1445.7D0, 1498.3D0,
- 5 1498.6D0, 1454.3D0, 1396.7D0, 1290.0D0, 1209.1D0,
- 6 1148.3D0, 1065.0D0, 1013.1D0, 968.2D0, 946.4D0,
- 7 938.0D0, 946.1D0, 962.9D0, 1002.2D0, 1038.6D0,
- 8 1068.4D0, 1107.9D0, 1125.0D0, 1124.7D0, 1115.3D0,
- 9 1105.0D0, 1101.1D0, 1103.4D0, 1116.2D0, 1133.3D0,
- * 1151.6D0, 1188.2D0, 1222.6D0, 1269.5D0, 1311.1D0,
- 1 1360.0D0, 1412.9D0, 1459.0D0, 1537.5D0, 1603.3D0,
- 2 1660.3D0, 1756.4D0, 1836.3D0, 1936.3D0, 2020.2D0,
- 3 2115.0D0, 2214.8D0, 2300.1D0, 2442.1D0, 2558.6D0,
- 4 2658.2D0, 2823.7D0, 2959.4D0, 3127.6D0, 3267.5D0,
- 5 3425.0D0/
-* Negative pions
- DATA AP74J /
- 1 349.0D0, 359.7D0, 369.2D0, 387.2D0, 404.9D0,
- 2 422.9D0, 460.0D0, 499.0D0, 560.9D0, 626.8D0,
- 3 721.0D0, 847.1D0, 975.3D0, 1218.2D0, 1427.1D0,
- 4 1594.6D0, 1806.2D0, 1880.0D0, 1830.5D0, 1712.3D0,
- 5 1546.4D0, 1373.0D0, 1243.0D0, 1080.0D0, 996.1D0,
- 6 950.4D0, 909.5D0, 898.1D0, 902.1D0, 915.7D0,
- 7 938.0D0, 965.9D0, 991.4D0, 1033.7D0, 1065.3D0,
- 8 1088.4D0, 1115.5D0, 1125.0D0, 1121.7D0, 1113.2D0,
- 9 1105.0D0, 1102.9D0, 1106.1D0, 1119.7D0, 1137.0D0,
- * 1155.2D0, 1191.3D0, 1225.1D0, 1271.0D0, 1311.9D0,
- 1 1360.0D0, 1412.3D0, 1458.1D0, 1536.2D0, 1601.9D0,
- 2 1658.9D0, 1755.2D0, 1835.3D0, 1935.6D0, 2019.8D0,
- 3 2115.0D0, 2215.1D0, 2300.6D0, 2442.7D0, 2559.4D0,
- 4 2659.0D0, 2824.4D0, 2960.0D0, 3128.0D0, 3267.8D0,
- 5 3425.0D0/
-* Rotational irradiation geometry
-* Positive pions
- DATA RT74I /
- 1 37.0D0, 39.1D0, 40.9D0, 44.5D0, 48.0D0,
- 2 51.7D0, 59.5D0, 68.0D0, 82.3D0, 98.6D0,
- 3 123.5D0, 160.1D0, 201.6D0, 294.8D0, 395.2D0,
- 4 496.8D0, 686.5D0, 842.0D0, 1002.6D0, 1099.3D0,
- 5 1167.8D0, 1200.3D0, 1203.6D0, 1177.5D0, 1141.2D0,
- 6 1106.0D0, 1047.8D0, 1005.6D0, 964.7D0, 942.3D0,
- 7 931.0D0, 935.2D0, 949.0D0, 986.7D0, 1027.2D0,
- 8 1065.8D0, 1133.5D0, 1188.0D0, 1249.8D0, 1295.9D0,
- 9 1342.0D0, 1384.2D0, 1416.2D0, 1463.7D0, 1499.2D0,
- * 1528.4D0, 1576.7D0, 1618.0D0, 1673.5D0, 1724.6D0,
- 1 1789.0D0, 1865.3D0, 1936.9D0, 2067.0D0, 2182.4D0,
- 2 2286.3D0, 2467.4D0, 2622.2D0, 2819.2D0, 2985.8D0,
- 3 3174.0D0, 3370.4D0, 3537.1D0, 3811.8D0, 4035.6D0,
- 4 4225.8D0, 4540.7D0, 4798.2D0, 5117.5D0, 5383.9D0,
- 5 5685.0D0/
-* Negative pions
- DATA RT74J /
- 1 194.8D0, 196.1D0, 197.6D0, 201.6D0, 206.9D0,
- 2 213.3D0, 228.3D0, 245.9D0, 275.9D0, 309.7D0,
- 3 360.2D0, 431.1D0, 506.5D0, 659.1D0, 802.8D0,
- 4 930.0D0, 1123.6D0, 1236.5D0, 1292.2D0, 1280.7D0,
- 5 1229.6D0, 1156.7D0, 1093.0D0, 1004.5D0, 956.1D0,
- 6 929.0D0, 904.6D0, 898.4D0, 902.7D0, 913.5D0,
- 7 931.0D0, 953.5D0, 975.4D0, 1015.8D0, 1052.0D0,
- 8 1084.5D0, 1140.7D0, 1188.0D0, 1246.7D0, 1293.6D0,
- 9 1342.0D0, 1386.3D0, 1419.5D0, 1468.1D0, 1503.8D0,
- * 1532.9D0, 1580.6D0, 1621.1D0, 1675.4D0, 1725.5D0,
- 1 1789.0D0, 1864.5D0, 1935.7D0, 2065.3D0, 2180.6D0,
- 2 2284.4D0, 2465.8D0, 2620.8D0, 2818.3D0, 2985.3D0,
- 3 3174.0D0, 3370.8D0, 3537.7D0, 3812.8D0, 4036.7D0,
- 4 4227.0D0, 4541.7D0, 4799.1D0, 5118.1D0, 5384.2D0,
- 5 5685.0D0/
-* WORST possible geometry for the irradiation
-* Positive pions
- DATA WT74I /
- 1 71.3D0, 76.3D0, 80.8D0, 89.2D0, 97.3D0,
- 2 105.5D0, 122.2D0, 139.9D0, 168.7D0, 200.5D0,
- 3 248.0D0, 315.6D0, 389.9D0, 548.5D0, 709.1D0,
- 4 861.5D0, 1119.2D0, 1300.0D0, 1442.3D0, 1491.8D0,
- 5 1489.9D0, 1445.3D0, 1389.6D0, 1290.0D0, 1217.9D0,
- 6 1165.1D0, 1093.7D0, 1049.0D0, 1008.9D0, 987.0D0,
- 7 974.0D0, 972.3D0, 979.2D0, 1004.7D0, 1037.1D0,
- 8 1072.1D0, 1144.0D0, 1215.0D0, 1315.6D0, 1402.7D0,
- 9 1495.0D0, 1577.3D0, 1635.9D0, 1714.7D0, 1766.7D0,
- * 1805.1D0, 1862.6D0, 1908.6D0, 1969.8D0, 2028.0D0,
- 1 2105.0D0, 2201.5D0, 2295.6D0, 2472.3D0, 2633.3D0,
- 2 2780.5D0, 3041.0D0, 3265.9D0, 3553.6D0, 3796.8D0,
- 3 4070.0D0, 4351.8D0, 4588.0D0, 4972.1D0, 5280.3D0,
- 4 5539.3D0, 5962.8D0, 6305.5D0, 6726.6D0, 7076.1D0,
- 5 7470.0D0/
-* Negative pions
- DATA WT74J /
- 1 349.0D0, 359.6D0, 369.1D0, 386.9D0, 404.5D0,
- 2 422.4D0, 459.5D0, 498.5D0, 560.4D0, 626.5D0,
- 3 721.0D0, 847.7D0, 976.5D0, 1220.5D0, 1430.2D0,
- 4 1597.9D0, 1808.6D0, 1880.0D0, 1826.1D0, 1704.9D0,
- 5 1537.4D0, 1364.6D0, 1236.7D0, 1080.0D0, 1003.4D0,
- 6 964.3D0, 934.0D0, 929.9D0, 939.9D0, 955.0D0,
- 7 974.0D0, 992.6D0, 1008.2D0, 1036.3D0, 1063.9D0,
- 8 1092.2D0, 1151.7D0, 1215.0D0, 1312.1D0, 1400.0D0,
- 9 1495.0D0, 1579.7D0, 1639.9D0, 1720.2D0, 1772.5D0,
- * 1810.8D0, 1867.4D0, 1912.4D0, 1972.1D0, 2029.2D0,
- 1 2105.0D0, 2200.5D0, 2294.1D0, 2470.1D0, 2631.0D0,
- 2 2778.2D0, 3038.8D0, 3264.1D0, 3552.4D0, 3796.2D0,
- 3 4070.0D0, 4352.4D0, 4589.0D0, 4973.4D0, 5281.8D0,
- 4 5540.9D0, 5964.3D0, 6306.8D0, 6727.5D0, 7076.6D0,
- 5 7470.0D0/
-*
-* Effective dose for photons from ICRP74 and Pelliccioni data
-* calculated with ICRP radiation weighting factors Wr
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION E74G(NBIN1G),AE74G(NBIN1G)
- DATA E74G /
- 1 0.10000D-05, 0.12589D-05, 0.15849D-05, 0.19953D-05, 0.25119D-05,
- 2 0.31623D-05, 0.39811D-05, 0.50119D-05, 0.63096D-05, 0.79433D-05,
- 3 0.10000D-04, 0.12589D-04, 0.15849D-04, 0.19953D-04, 0.25119D-04,
- 4 0.31623D-04, 0.39811D-04, 0.50119D-04, 0.63096D-04, 0.79433D-04,
- 5 0.10000D-03, 0.12589D-03, 0.15849D-03, 0.19953D-03, 0.25119D-03,
- 6 0.31623D-03, 0.39811D-03, 0.50119D-03, 0.63096D-03, 0.79433D-03,
- 7 0.10000D-02, 0.12589D-02, 0.15849D-02, 0.19953D-02, 0.25119D-02,
- 8 0.31623D-02, 0.39811D-02, 0.50119D-02, 0.63096D-02, 0.79433D-02,
- 9 0.10000D-01, 0.12589D-01, 0.15849D-01, 0.19953D-01, 0.25119D-01,
- * 0.31623D-01, 0.39811D-01, 0.50119D-01, 0.63096D-01, 0.79433D-01,
- 1 0.10000D+00, 0.12589D+00, 0.15849D+00, 0.19953D+00, 0.25119D+00,
- 2 0.31623D+00, 0.39811D+00, 0.50119D+00, 0.63096D+00, 0.79433D+00,
- 3 0.10000D+01, 0.12589D+01, 0.15849D+01, 0.19953D+01, 0.25119D+01,
- 4 0.31623D+01, 0.39811D+01, 0.50119D+01, 0.63096D+01, 0.79433D+01,
- 5 0.10000D+02, 0.12589D+02, 0.15849D+02, 0.19953D+02, 0.25119D+02,
- 6 0.31623D+02, 0.39811D+02, 0.50119D+02, 0.63096D+02, 0.79433D+02,
- 7 0.10000D+03/
- DIMENSION AP74G(NBIN1G),RT74G(NBIN1G),WT74G(NBIN1G),
- & AAP74G(NBIN1G),ART74G(NBIN1G),AWT74G(NBIN1G)
-* Anterior-Posterior irradiation
- DATA AP74G /
- 1 0.54559D+03, 0.37003D+03, 0.24945D+03, 0.16496D+03, 0.10888D+03,
- 2 0.71724D+02, 0.46941D+02, 0.29765D+02, 0.18658D+02, 0.11621D+02,
- 3 0.71617D+01, 0.43328D+01, 0.26230D+01, 0.15912D+01, 0.97875D+00,
- 4 0.62511D+00, 0.45300D+00, 0.41541D+00, 0.45697D+00, 0.50270D+00,
- 5 0.55300D+00, 0.68970D+00, 0.86020D+00, 0.10728D+01, 0.13381D+01,
- 6 0.16688D+01, 0.20814D+01, 0.25952D+01, 0.31566D+01, 0.38395D+01,
- 7 0.46700D+01, 0.55604D+01, 0.65903D+01, 0.76977D+01, 0.89735D+01,
- 8 0.10487D+02, 0.12358D+02, 0.13617D+02, 0.15456D+02, 0.17725D+02,
- 9 0.21000D+02, 0.24813D+02, 0.29318D+02, 0.34640D+02, 0.41642D+02,
- * 0.49614D+02, 0.57329D+02, 0.61958D+02, 0.67831D+02, 0.74261D+02,
- 1 0.81300D+02, 0.85676D+02, 0.90288D+02, 0.95149D+02, 0.98906D+02,
- 2 0.10280D+03, 0.10684D+03, 0.11104D+03, 0.11458D+03, 0.11823D+03,
- 3 0.12200D+03, 0.12364D+03, 0.12530D+03, 0.12698D+03, 0.12798D+03,
- 4 0.12898D+03, 0.12999D+03, 0.13101D+03, 0.13167D+03, 0.13233D+03,
- 5 0.13300D+03, 0.13452D+03, 0.13606D+03, 0.13761D+03, 0.13919D+03,
- 6 0.14078D+03, 0.14239D+03, 0.14401D+03, 0.14467D+03, 0.14533D+03,
- 7 0.14600D+03/
-* Rotational irradiation geometry
- DATA RT74G /
- 1 0.54559D+03, 0.37003D+03, 0.24945D+03, 0.16496D+03, 0.10888D+03,
- 2 0.71724D+02, 0.46941D+02, 0.29765D+02, 0.18655D+02, 0.11608D+02,
- 3 0.69154D+01, 0.37516D+01, 0.20643D+01, 0.11725D+01, 0.61014D+00,
- 4 0.35636D+00, 0.27520D+00, 0.26661D+00, 0.30429D+00, 0.34763D+00,
- 5 0.39750D+00, 0.50246D+00, 0.63525D+00, 0.80327D+00, 0.10159D+01,
- 6 0.12851D+01, 0.16259D+01, 0.20570D+01, 0.25456D+01, 0.31506D+01,
- 7 0.39000D+01, 0.46762D+01, 0.56061D+01, 0.67125D+01, 0.79141D+01,
- 8 0.93241D+01, 0.10963D+02, 0.12696D+02, 0.14881D+02, 0.17439D+02,
- 9 0.20700D+02, 0.24597D+02, 0.29229D+02, 0.34738D+02, 0.41889D+02,
- * 0.50210D+02, 0.59027D+02, 0.68568D+02, 0.78333D+02, 0.89610D+02,
- 1 0.10265D+03, 0.11038D+03, 0.11871D+03, 0.12770D+03, 0.13443D+03,
- 2 0.14150D+03, 0.14896D+03, 0.15681D+03, 0.16272D+03, 0.16887D+03,
- 3 0.17525D+03, 0.18162D+03, 0.18826D+03, 0.19518D+03, 0.19927D+03,
- 4 0.20343D+03, 0.20768D+03, 0.21203D+03, 0.21473D+03, 0.21747D+03,
- 5 0.22025D+03, 0.22378D+03, 0.22737D+03, 0.23102D+03, 0.23474D+03,
- 6 0.23852D+03, 0.24237D+03, 0.24628D+03, 0.24898D+03, 0.25173D+03,
- 7 0.25450D+03/
-* WORST possible geometry for the irradiation
- DATA WT74G /
- 1 0.54559D+03, 0.37003D+03, 0.24945D+03, 0.16496D+03, 0.10888D+03,
- 2 0.71724D+02, 0.46941D+02, 0.29765D+02, 0.18658D+02, 0.11621D+02,
- 3 0.71617D+01, 0.43328D+01, 0.26230D+01, 0.15912D+01, 0.97875D+00,
- 4 0.62511D+00, 0.45300D+00, 0.41541D+00, 0.45697D+00, 0.50270D+00,
- 5 0.55300D+00, 0.68970D+00, 0.86020D+00, 0.10728D+01, 0.13381D+01,
- 6 0.16688D+01, 0.20814D+01, 0.25952D+01, 0.31566D+01, 0.38395D+01,
- 7 0.46700D+01, 0.55604D+01, 0.65903D+01, 0.76977D+01, 0.89735D+01,
- 8 0.10487D+02, 0.12358D+02, 0.13724D+02, 0.16218D+02, 0.18813D+02,
- 9 0.23000D+02, 0.27007D+02, 0.31713D+02, 0.37238D+02, 0.45249D+02,
- * 0.53784D+02, 0.59748D+02, 0.71072D+02, 0.83565D+02, 0.98879D+02,
- 1 0.11700D+03, 0.12735D+03, 0.13861D+03, 0.15087D+03, 0.16030D+03,
- 2 0.17027D+03, 0.18087D+03, 0.19208D+03, 0.20036D+03, 0.20899D+03,
- 3 0.21800D+03, 0.22815D+03, 0.23877D+03, 0.24988D+03, 0.25669D+03,
- 4 0.26363D+03, 0.27076D+03, 0.27805D+03, 0.28262D+03, 0.28897D+03,
- 5 0.30000D+03, 0.30985D+03, 0.32002D+03, 0.33053D+03, 0.34138D+03,
- 6 0.35259D+03, 0.36417D+03, 0.37616D+03, 0.39209D+03, 0.40869D+03,
- 7 0.42600D+03/
-*
-* Effective dose for electrons from ICRP74 and Pelliccioni data
-* calculated with ICRP radiation weighting factors Wr
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION E74E(NBIN1E),AE74E(NBIN1E)
- DATA E74E /
- 1 0.50000D-02, 0.64047D-02, 0.82039D-02, 0.10509D-01, 0.13461D-01,
- 2 0.17242D-01, 0.22086D-01, 0.28291D-01, 0.36239D-01, 0.46420D-01,
- 3 0.59460D-01, 0.76165D-01, 0.97562D-01, 0.12497D+00, 0.16008D+00,
- 4 0.20505D+00, 0.26265D+00, 0.33644D+00, 0.43096D+00, 0.55203D+00,
- 5 0.70711D+00, 0.90576D+00, 0.11602D+01, 0.14861D+01, 0.19037D+01,
- 6 0.24385D+01, 0.31235D+01, 0.40010D+01, 0.51250D+01, 0.65647D+01,
- 7 0.84090D+01, 0.10771D+02, 0.13797D+02, 0.17673D+02, 0.22638D+02,
- 8 0.28998D+02, 0.37145D+02, 0.47580D+02, 0.60946D+02, 0.78068D+02,
- 9 0.10000D+03/
- DIMENSION AP74E(NBIN1E),RT74E(NBIN1E),WT74E(NBIN1E),
- & AAP74E(NBIN1E),ART74E(NBIN1E),AWT74E(NBIN1E)
-* Anterior-Posterior irradiation
- DATA AP74E /
- 1 0.11700D+03, 0.14636D+03, 0.18310D+03, 0.22254D+03, 0.24108D+03,
- 2 0.26117D+03, 0.28218D+03, 0.30367D+03, 0.32392D+03, 0.33732D+03,
- 3 0.34585D+03, 0.35438D+03, 0.36312D+03, 0.36782D+03, 0.37210D+03,
- 4 0.37679D+03, 0.38468D+03, 0.39275D+03, 0.40098D+03, 0.40825D+03,
- 5 0.41392D+03, 0.41968D+03, 0.42412D+03, 0.42769D+03, 0.43128D+03,
- 6 0.43436D+03, 0.43732D+03, 0.44030D+03, 0.44373D+03, 0.45113D+03,
- 7 0.45866D+03, 0.46611D+03, 0.47323D+03, 0.48045D+03, 0.48778D+03,
- 8 0.49522D+03, 0.50278D+03, 0.51045D+03, 0.51057D+03, 0.50878D+03,
- 9 0.50700D+03/
-* Rotational irradiation geometry
- DATA RT74E /
- 1 0.46000D+02, 0.59898D+02, 0.78750D+02, 0.10262D+03, 0.12495D+03,
- 2 0.15440D+03, 0.19064D+03, 0.23250D+03, 0.26904D+03, 0.29888D+03,
- 3 0.31637D+03, 0.33039D+03, 0.34523D+03, 0.35974D+03, 0.37500D+03,
- 4 0.39072D+03, 0.40301D+03, 0.41573D+03, 0.42889D+03, 0.44070D+03,
- 5 0.45012D+03, 0.45980D+03, 0.47394D+03, 0.49154D+03, 0.50997D+03,
- 6 0.52079D+03, 0.52974D+03, 0.53887D+03, 0.54941D+03, 0.57165D+03,
- 7 0.59498D+03, 0.61689D+03, 0.63350D+03, 0.65061D+03, 0.66823D+03,
- 8 0.68638D+03, 0.70507D+03, 0.72432D+03, 0.72548D+03, 0.72208D+03,
- 9 0.71875D+03/
-* WORST possible geometry for the irradiation
- DATA WT74E /
- 1 0.11700D+03, 0.14636D+03, 0.18310D+03, 0.22254D+03, 0.24108D+03,
- 2 0.26117D+03, 0.28218D+03, 0.30367D+03, 0.32392D+03, 0.34459D+03,
- 3 0.35514D+03, 0.36261D+03, 0.37023D+03, 0.37763D+03, 0.38513D+03,
- 4 0.39659D+03, 0.41277D+03, 0.42961D+03, 0.44714D+03, 0.46712D+03,
- 5 0.48808D+03, 0.50997D+03, 0.52813D+03, 0.54373D+03, 0.57298D+03,
- 6 0.58967D+03, 0.60557D+03, 0.63059D+03, 0.65754D+03, 0.69411D+03,
- 7 0.73271D+03, 0.77101D+03, 0.80533D+03, 0.84117D+03, 0.87861D+03,
- 8 0.91771D+03, 0.95856D+03, 0.10012D+04, 0.10295D+04, 0.10545D+04,
- 9 0.10800D+04/
-*
-*-----------------------------------------------------------------------
-*
-* Effective dose for neutrons from ICRP74 and Pelliccioni data
-* calculated with the Pelliccioni radiation weighting factors Wr
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION APPLN(NBIN1N),RTPLN(NBIN1N),WTPLN(NBIN1N),
- & AAPPLN(NBIN1N),ARTPLN(NBIN1N),AWTPLN(NBIN1N)
-* Anterior-Posterior irradiation
- DATA APPLN /
- 1 5.2D0, 6.6D0, 7.6D0, 10.0D0, 11.2D0,
- 2 12.8D0, 13.8D0, 14.5D0, 15.0D0, 15.1D0,
- 3 15.1D0, 14.8D0, 14.6D0, 14.4D0, 14.2D0,
- 4 14.2D0, 14.4D0, 15.7D0, 18.3D0, 23.8D0,
- 5 29.0D0, 38.5D0, 47.2D0, 59.8D0, 80.2D0,
- 6 99.0D0, 133.0D0, 188.0D0, 231.0D0, 267.0D0,
- 7 282.0D0, 310.0D0, 383.0D0, 432.0D0, 458.0D0,
- 8 474.0D0, 483.0D0, 490.0D0, 494.0D0, 497.0D0,
- 9 499.0D0, 499.0D0, 496.0D0, 494.0D0, 491.0D0,
- * 486.0D0, 480.0D0, 458.0D0, 437.0D0, 429.0D0,
- 1 409.0D0, 385.0D0, 378.0D0, 379.0D0, 399.0D0,
- 2 422.0D0, 455.0D0, 503.0D0, 544.0D0, 610.0D0,
- 3 707.0D0, 776.0D0, 852.0D0, 937.0D0, 996.0D0,
- 4 1081.0D0, 1197.0D0, 1284.0D0, 1390.0D0, 1536.0D0,
- 5 1658.0D0, 1856.0D0, 2150.0D0, 2368.0D0, 2620.0D0,
- 6 2926.0D0, 3156.0D0, 3495.0D0, 3948.0D0, 4260.0D0,
- 7 4600.0D0/
-* Rotational irradiation geometry
- DATA RTPLN /
- 1 2.99D0, 3.72D0, 4.40D0, 5.75D0, 6.43D0,
- 2 7.27D0, 7.84D0, 8.31D0, 8.72D0, 8.90D0,
- 3 8.92D0, 8.82D0, 8.69D0, 8.56D0, 8.40D0,
- 4 8.34D0, 8.39D0, 9.06D0, 10.6D0, 13.8D0,
- 5 16.9D0, 22.7D0, 27.8D0, 34.8D0, 45.4D0,
- 6 54.8D0, 71.6D0, 99.4D0, 123.0D0, 144.0D0,
- 7 154.0D0, 173.0D0, 234.0D0, 283.0D0, 315.0D0,
- 8 335.0D0, 348.0D0, 358.0D0, 366.0D0, 373.0D0,
- 9 378.0D0, 385.0D0, 390.0D0, 391.0D0, 393.0D0,
- * 394.0D0, 395.0D0, 395.0D0, 404.0D0, 422.0D0,
- 1 400.0D0, 417.0D0, 428.0D0, 441.0D0, 462.0D0,
- 2 482.0D0, 513.0D0, 566.0D0, 615.0D0, 702.0D0,
- 3 840.0D0, 947.0D0, 1070.0D0, 1216.0D0, 1324.0D0,
- 4 1484.0D0, 1706.0D0, 1871.0D0, 2070.0D0, 2336.0D0,
- 5 2555.0D0, 2910.0D0, 3447.0D0, 3862.0D0, 4360.0D0,
- 6 5005.0D0, 5520.0D0, 6338.0D0, 7542.0D0, 8458.0D0,
- 7 9550.0D0/
-* WORST possible geometry for the irradiation
- DATA WTPLN /
- 1 5.2D0, 6.6D0, 7.6D0, 10.0D0, 11.2D0,
- 2 12.8D0, 13.8D0, 14.5D0, 15.0D0, 15.1D0,
- 3 15.1D0, 14.8D0, 14.6D0, 14.4D0, 14.2D0,
- 4 14.2D0, 14.4D0, 15.7D0, 18.3D0, 23.8D0,
- 5 29.0D0, 38.5D0, 47.2D0, 59.8D0, 80.2D0,
- 6 99.0D0, 133.0D0, 188.0D0, 231.0D0, 267.0D0,
- 7 282.0D0, 310.0D0, 383.0D0, 432.0D0, 458.0D0,
- 8 474.0D0, 483.0D0, 490.0D0, 494.0D0, 497.0D0,
- 9 499.0D0, 499.0D0, 496.0D0, 494.0D0, 491.0D0,
- * 486.0D0, 480.0D0, 458.0D0, 444.0D0, 459.0D0,
- 1 460.0D0, 460.0D0, 461.0D0, 465.0D0, 481.0D0,
- 2 501.0D0, 535.0D0, 595.0D0, 653.0D0, 757.0D0,
- 3 927.0D0, 1062.0D0, 1220.0D0, 1413.0D0, 1557.0D0,
- 4 1775.0D0, 2080.0D0, 2307.0D0, 2580.0D0, 2944.0D0,
- 5 3242.0D0, 3726.0D0, 4460.0D0, 5030.0D0, 5720.0D0,
- 6 6623.0D0, 7352.0D0, 8520.0D0, 10267.0D0, 11614.0D0,
- 7 13240.0D0/
-*
-* Effective dose for protons from Pelliccioni data
-* calculated with the Pelliccioni radiation weighting factors Wr
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION EPLP(NBIN1P),AEPLP(NBIN1P)
- DATA EPLP /
- 1 5.00D-03, 6.50D-03, 8.00D-03, 1.00D-02, 1.25D-02,
- 2 1.50D-02, 2.00D-02, 2.50D-02, 3.00D-02, 4.00D-02,
- 3 5.00D-02, 6.50D-02, 8.00D-02, 1.00D-01, 1.25D-01,
- 4 1.50D-01, 2.00D-01, 2.50D-01, 3.00D-01, 4.00D-01,
- 5 5.00D-01, 6.50D-01, 8.00D-01, 1.00D+00, 1.25D+00,
- 6 1.50D+00, 2.00D+00, 2.50D+00, 3.00D+00, 4.00D+00,
- 7 5.00D+00, 6.50D+00, 8.00D+00, 1.00D+01, 1.25D+01,
- 8 1.50D+01, 2.00D+01, 2.50D+01, 3.00D+01, 4.00D+01,
- 9 5.00D+01, 6.50D+01, 8.00D+01, 1.00D+02, 1.25D+02,
- * 1.50D+02, 2.00D+02, 2.50D+02, 3.00D+02, 4.00D+02,
- 1 5.00D+02, 6.50D+02, 8.00D+02, 1.00D+03, 1.25D+03,
- 2 1.50D+03, 2.00D+03, 2.50D+03, 3.00D+03, 4.00D+03,
- 3 5.00D+03, 6.50D+03, 8.00D+03, 1.00D+04/
- DIMENSION APPLP(NBIN1P),RTPLP(NBIN1P),WTPLP(NBIN1P),
- & AAPPLP(NBIN1P),ARTPLP(NBIN1P),AWTPLP(NBIN1P)
-* Anterior-Posterior irradiation
- DATA APPLP /
- 1 23.0D0, 26.1D0, 29.7D0, 35.8D0, 46.6D0,
- 2 62.1D0, 115.6D0, 218.6D0, 392.8D0, 1016.0D0,
- 3 1924.0D0, 2787.8D0, 2934.5D0, 2728.0D0, 2432.2D0,
- 4 2186.8D0, 1828.0D0, 1591.1D0, 1429.6D0, 1235.6D0,
- 5 1136.0D0, 1069.5D0, 1039.0D0, 1012.0D0, 982.4D0,
- 6 964.0D0, 968.0D0, 1013.7D0, 1075.3D0, 1198.7D0,
- 7 1296.0D0, 1385.9D0, 1440.4D0, 1492.0D0, 1545.0D0,
- 8 1590.1D0, 1662.3D0, 1717.0D0, 1759.4D0, 1818.9D0,
- 9 1856.0D0, 1888.9D0, 1913.6D0, 1948.0D0, 1998.1D0,
- * 2051.5D0, 2157.8D0, 2258.3D0, 2351.8D0, 2519.3D0,
- 1 2664.9D0, 2852.0D0, 3010.2D0, 3188.0D0, 3371.4D0,
- 2 3525.1D0, 3775.2D0, 3976.1D0, 4145.1D0, 4421.4D0,
- 3 4644.7D0, 4918.8D0, 5145.5D0, 5400.0D0/
-* Rotational irradiation geometry
- DATA RTPLP /
- 1 19.3D0, 21.8D0, 24.4D0, 28.6D0, 35.0D0,
- 2 43.4D0, 67.9D0, 106.7D0, 163.9D0, 350.3D0,
- 3 632.8D0, 999.7D0, 1234.8D0, 1457.0D0, 1715.6D0,
- 4 1921.9D0, 2064.0D0, 1908.6D0, 1680.3D0, 1321.7D0,
- 5 1133.0D0, 1037.5D0, 1018.5D0, 1016.0D0, 1007.4D0,
- 6 1000.5D0, 1011.0D0, 1052.2D0, 1106.9D0, 1223.9D0,
- 7 1332.0D0, 1465.8D0, 1571.5D0, 1680.0D0, 1778.6D0,
- 8 1851.6D0, 1955.6D0, 2029.8D0, 2088.9D0, 2184.5D0,
- 9 2266.0D0, 2376.5D0, 2477.0D0, 2599.0D0, 2736.9D0,
- * 2861.9D0, 3083.3D0, 3276.3D0, 3448.6D0, 3748.3D0,
- 1 4005.3D0, 4335.9D0, 4619.7D0, 4947.0D0, 5297.5D0,
- 2 5602.0D0, 6118.2D0, 6550.8D0, 6926.8D0, 7564.1D0,
- 3 8098.4D0, 8774.8D0, 9349.9D0, 10010.0D0/
-* WORST possible geometry for the irradiation
- DATA WTPLP /
- 1 23.7D0, 26.7D0, 30.2D0, 36.2D0, 46.9D0,
- 2 62.3D0, 115.6D0, 218.2D0, 392.1D0, 1016.0D0,
- 3 1924.0D0, 2744.2D0, 2868.9D0, 2728.0D0, 2600.5D0,
- 4 2502.4D0, 2256.0D0, 1955.7D0, 1695.1D0, 1351.9D0,
- 5 1180.0D0, 1087.3D0, 1064.6D0, 1060.0D0, 1055.9D0,
- 6 1054.6D0, 1068.0D0, 1100.6D0, 1143.6D0, 1243.8D0,
- 7 1352.0D0, 1515.1D0, 1662.0D0, 1820.0D0, 1958.9D0,
- 8 2055.8D0, 2183.7D0, 2269.1D0, 2335.9D0, 2448.9D0,
- 9 2556.0D0, 2717.9D0, 2872.4D0, 3060.0D0, 3265.5D0,
- * 3446.7D0, 3759.1D0, 4025.7D0, 4260.6D0, 4665.1D0,
- 1 5009.9D0, 5453.3D0, 5835.6D0, 6280.0D0, 6761.8D0,
- 2 7185.2D0, 7912.5D0, 8530.5D0, 9073.3D0, 10004.4D0,
- 3 10794.5D0, 11806.0D0, 12674.6D0, 13680.0D0/
-*
-* Effective dose for charged pions from ICRP74 and Pelliccioni data
-* calculated with the Pelliccioni radiation weighting factors Wr
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION APPLI(NBIN1I),RTPLI(NBIN1I),WTPLI(NBIN1I),
- & APPLJ(NBIN1I),RTPLJ(NBIN1I),WTPLJ(NBIN1I),
- & AAPPLI(NBIN1I),ARTPLI(NBIN1I),AWTPLI(NBIN1I),
- & AAPPLJ(NBIN1I),ARTPLJ(NBIN1I),AWTPLJ(NBIN1I)
-* Anterior-Posterior irradiation
-* Positive pions
- DATA APPLI /
- 1 71.3D0, 77.4D0, 82.9D0, 92.9D0, 102.3D0,
- 2 111.4D0, 129.4D0, 147.6D0, 175.8D0, 205.5D0,
- 3 248.0D0, 305.6D0, 366.3D0, 491.1D0, 613.9D0,
- 4 729.7D0, 930.0D0, 1083.3D0, 1233.9D0, 1320.6D0,
- 5 1378.7D0, 1401.7D0, 1397.4D0, 1357.9D0, 1308.7D0,
- 6 1262.3D0, 1186.8D0, 1133.1D0, 1082.0D0, 1054.7D0,
- 7 1042.0D0, 1048.9D0, 1066.7D0, 1110.3D0, 1151.5D0,
- 8 1185.4D0, 1230.6D0, 1250.0D0, 1249.3D0, 1238.7D0,
- 9 1228.0D0, 1226.1D0, 1231.9D0, 1253.2D0, 1279.4D0,
- * 1306.6D0, 1359.6D0, 1408.7D0, 1474.7D0, 1532.7D0,
- 1 1600.0D0, 1671.9D0, 1734.0D0, 1838.2D0, 1924.4D0,
- 2 1998.2D0, 2121.1D0, 2221.8D0, 2346.0D0, 2448.6D0,
- 3 2563.0D0, 2681.5D0, 2781.4D0, 2945.1D0, 3077.4D0,
- 4 3189.2D0, 3372.7D0, 3521.6D0, 3704.2D0, 3855.1D0,
- 5 4024.0D0/
-* Negative pions
- DATA APPLJ /
- 1 471.6D0, 506.5D0, 537.4D0, 592.1D0, 641.1D0,
- 2 686.9D0, 772.5D0, 853.8D0, 972.0D0, 1088.3D0,
- 3 1243.1D0, 1435.8D0, 1618.2D0, 1929.9D0, 2159.7D0,
- 4 2310.6D0, 2419.2D0, 2350.0D0, 2095.4D0, 1827.2D0,
- 5 1537.2D0, 1284.1D0, 1118.2D0, 939.1D0, 867.2D0,
- 6 841.0D0, 842.7D0, 871.4D0, 926.9D0, 981.2D0,
- 7 1042.0D0, 1097.6D0, 1137.2D0, 1188.2D0, 1217.5D0,
- 8 1234.5D0, 1249.0D0, 1250.0D0, 1242.0D0, 1233.6D0,
- 9 1228.0D0, 1230.4D0, 1238.5D0, 1262.0D0, 1288.7D0,
- * 1315.6D0, 1367.4D0, 1414.9D0, 1478.6D0, 1534.6D0,
- 1 1600.0D0, 1670.4D0, 1731.5D0, 1834.7D0, 1920.6D0,
- 2 1994.5D0, 2117.8D0, 2219.1D0, 2344.3D0, 2447.7D0,
- 3 2563.0D0, 2682.2D0, 2782.6D0, 2946.8D0, 3079.3D0,
- 4 3191.2D0, 3374.6D0, 3523.1D0, 3705.3D0, 3855.8D0,
- 5 4024.0D0/
-* Rotational irradiation geometry
-* Positive pions
- DATA RTPLI /
- 1 37.0D0, 39.6D0, 42.0D0, 46.3D0, 50.4D0,
- 2 54.5D0, 62.9D0, 71.7D0, 85.7D0, 101.0D0,
- 3 123.5D0, 155.1D0, 189.7D0, 264.5D0, 342.9D0,
- 4 421.7D0, 571.2D0, 701.7D0, 855.7D0, 969.0D0,
- 5 1074.4D0, 1156.9D0, 1204.2D0, 1239.5D0, 1235.2D0,
- 6 1215.9D0, 1167.8D0, 1124.8D0, 1078.1D0, 1050.2D0,
- 7 1034.3D0, 1036.8D0, 1051.2D0, 1093.1D0, 1138.6D0,
- 8 1182.3D0, 1258.8D0, 1320.0D0, 1388.6D0, 1439.8D0,
- 9 1492.0D0, 1541.8D0, 1581.2D0, 1642.6D0, 1690.9D0,
- * 1731.9D0, 1801.2D0, 1861.1D0, 1940.9D0, 2013.7D0,
- 1 2104.0D0, 2209.2D0, 2306.8D0, 2482.1D0, 2636.1D0,
- 2 2773.6D0, 3011.0D0, 3211.5D0, 3463.6D0, 3673.6D0,
- 3 3907.0D0, 4145.7D0, 4344.4D0, 4664.8D0, 4919.7D0,
- 4 5132.6D0, 5478.2D0, 5755.7D0, 6094.3D0, 6373.3D0,
- 5 6686.0D0/
-* Negative pions
- DATA RTPLJ /
- 1 263.2D0, 276.2D0, 287.6D0, 308.3D0, 327.7D0,
- 2 346.4D0, 383.5D0, 420.8D0, 478.2D0, 537.7D0,
- 3 621.1D0, 730.7D0, 840.4D0, 1044.2D0, 1215.0D0,
- 4 1347.7D0, 1504.9D0, 1545.6D0, 1479.2D0, 1366.5D0,
- 5 1222.2D0, 1081.8D0, 983.3D0, 873.5D0, 832.4D0,
- 6 822.1D0, 838.3D0, 871.8D0, 927.6D0, 978.9D0,
- 7 1034.3D0, 1083.5D0, 1118.8D0, 1167.6D0, 1202.1D0,
- 8 1229.9D0, 1277.1D0, 1320.0D0, 1380.7D0, 1434.0D0,
- 9 1492.0D0, 1547.0D0, 1589.5D0, 1653.8D0, 1702.9D0,
- * 1743.6D0, 1811.3D0, 1869.0D0, 1945.9D0, 2016.2D0,
- 1 2104.0D0, 2207.2D0, 2303.5D0, 2477.5D0, 2631.1D0,
- 2 2768.5D0, 3006.4D0, 3207.8D0, 3461.2D0, 3672.3D0,
- 3 3907.0D0, 4146.8D0, 4346.2D0, 4667.4D0, 4922.7D0,
- 4 5135.7D0, 5481.2D0, 5758.2D0, 6096.0D0, 6374.3D0,
- 5 6686.0D0/
-* WORST possible geometry for the irradiation
-* Positive pions
- DATA WTPLI /
- 1 71.3D0, 77.4D0, 82.9D0, 92.9D0, 102.2D0,
- 2 111.3D0, 129.2D0, 147.4D0, 175.6D0, 205.4D0,
- 3 248.0D0, 305.8D0, 366.7D0, 492.1D0, 615.2D0,
- 4 731.2D0, 931.3D0, 1083.3D0, 1231.0D0, 1315.0D0,
- 5 1370.7D0, 1393.0D0, 1390.3D0, 1357.9D0, 1318.2D0,
- 6 1280.7D0, 1218.8D0, 1173.2D0, 1127.4D0, 1100.0D0,
- 7 1082.0D0, 1078.0D0, 1084.8D0, 1113.2D0, 1149.9D0,
- 8 1189.6D0, 1270.7D0, 1350.0D0, 1461.3D0, 1557.6D0,
- 9 1661.0D0, 1755.8D0, 1825.8D0, 1924.6D0, 1993.8D0,
- * 2047.3D0, 2130.6D0, 2198.4D0, 2287.7D0, 2370.2D0,
- 1 2476.0D0, 2604.6D0, 2727.7D0, 2955.3D0, 3160.1D0,
- 2 3345.9D0, 3671.9D0, 3950.9D0, 4305.1D0, 4601.8D0,
- 3 4932.0D0, 5269.1D0, 5548.6D0, 5997.6D0, 6353.0D0,
- 4 6648.7D0, 7126.6D0, 7508.9D0, 7974.2D0, 8357.4D0,
- 5 8787.0D0/
-* Negative pions
- DATA WTPLJ /
- 1 471.6D0, 506.4D0, 537.2D0, 591.6D0, 640.5D0,
- 2 686.1D0, 771.6D0, 853.0D0, 971.2D0, 1087.8D0,
- 3 1243.1D0, 1436.7D0, 1620.1D0, 1933.5D0, 2164.4D0,
- 4 2315.4D0, 2422.4D0, 2350.0D0, 2090.4D0, 1819.3D0,
- 5 1528.2D0, 1276.2D0, 1112.5D0, 939.1D0, 873.5D0,
- 6 853.3D0, 865.4D0, 902.3D0, 965.7D0, 1023.3D0,
- 7 1082.0D0, 1128.0D0, 1156.5D0, 1191.3D0, 1215.9D0,
- 8 1238.9D0, 1289.7D0, 1350.0D0, 1452.7D0, 1551.2D0,
- 9 1661.0D0, 1761.9D0, 1835.7D0, 1938.1D0, 2008.2D0,
- * 2061.5D0, 2142.8D0, 2208.1D0, 2293.7D0, 2373.2D0,
- 1 2476.0D0, 2602.2D0, 2723.8D0, 2949.7D0, 3153.9D0,
- 2 3339.6D0, 3666.1D0, 3946.2D0, 4301.9D0, 4600.1D0,
- 3 4932.0D0, 5270.5D0, 5551.0D0, 6001.1D0, 6357.0D0,
- 4 6652.8D0, 7130.5D0, 7512.2D0, 7976.6D0, 8358.7D0,
- 5 8787.0D0/
-*
-* Effective dose for muons from ICRP74 and Pelliccioni data
-* calculated with the ICRP/Pelliccioni radiation weighting factors Wr
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION EBINM(NBIN1M),AEBINM(NBIN1M)
- DATA EBINM/
- 1 1.00D-03, 1.25D-03, 1.50D-03, 2.00D-03, 2.50D-03,
- 2 3.00D-03, 4.00D-03, 5.00D-03, 6.50D-03, 8.00D-03,
- 3 1.00D-02, 1.25D-02, 1.50D-02, 2.00D-02, 2.50D-02,
- 4 3.00D-02, 4.00D-02, 5.00D-02, 6.50D-02, 8.00D-02,
- 5 1.00D-01, 1.25D-01, 1.50D-01, 2.00D-01, 2.50D-01,
- 6 3.00D-01, 4.00D-01, 5.00D-01, 6.50D-01, 8.00D-01,
- 7 1.00D+00, 1.25D+00, 1.50D+00, 2.00D+00, 2.50D+00,
- 8 3.00D+00, 4.00D+00, 5.00D+00, 6.50D+00, 8.00D+00,
- 9 1.00D+01, 1.25D+01, 1.50D+01, 2.00D+01, 2.50D+01,
- * 3.00D+01, 4.00D+01, 5.00D+01, 6.50D+01, 8.00D+01,
- 1 1.00D+02, 1.25D+02, 1.50D+02, 2.00D+02, 2.50D+02,
- 2 3.00D+02, 4.00D+02, 5.00D+02, 6.50D+02, 8.00D+02,
- 3 1.00D+03, 1.25D+03, 1.50D+03, 2.00D+03, 2.50D+03,
- 4 3.00D+03, 4.00D+03, 5.00D+03, 6.50D+03, 8.00D+03,
- 5 1.00D+04/
- DIMENSION APPLM(NBIN1M),RTPLM(NBIN1M),WTPLM(NBIN1M),
- & AAPPLM(NBIN1M),ARTPLM(NBIN1M),AWTPLM(NBIN1M)
-* Anterior-Posterior irradiation
- DATA APPLM /
- 1 177.0D0, 178.0D0, 180.0D0, 182.0D0, 184.0D0,
- 2 186.0D0, 188.0D0, 193.0D0, 200.0D0, 211.0D0,
- 3 243.0D0, 337.7D0, 449.7D0, 672.5D0, 830.5D0,
- 4 913.8D0, 921.6D0, 821.5D0, 635.1D0, 495.7D0,
- 5 385.0D0, 353.0D0, 340.0D0, 339.0D0, 337.0D0,
- 6 335.0D0, 334.0D0, 333.0D0, 332.0D0, 332.0D0,
- 7 332.5D0, 333.0D0, 334.0D0, 335.0D0, 336.0D0,
- 8 337.0D0, 338.0D0, 339.0D0, 340.0D0, 341.0D0,
- 9 340.5D0, 337.0D0, 335.0D0, 333.3D0, 332.9D0,
- * 333.1D0, 334.2D0, 335.5D0, 337.4D0, 338.9D0,
- 1 340.5D0, 341.9D0, 343.0D0, 344.4D0, 345.3D0,
- 2 346.0D0, 346.8D0, 347.4D0, 348.1D0, 348.5D0,
- 3 349.0D0, 349.5D0, 349.9D0, 350.6D0, 351.2D0,
- 4 351.7D0, 352.7D0, 353.7D0, 355.0D0, 356.2D0,
- 5 357.7D0/
-* Rotational irradiation geometry
- DATA RTPLM /
- 1 94.0D0, 96.0D0, 98.0D0, 99.0D0, 100.0D0,
- 2 101.0D0, 102.0D0, 105.0D0, 110.0D0, 116.0D0,
- 3 124.2D0, 155.8D0, 192.5D0, 275.5D0, 363.2D0,
- 4 445.4D0, 566.2D0, 614.1D0, 587.3D0, 529.0D0,
- 5 463.8D0, 414.5D0, 385.4D0, 354.2D0, 339.2D0,
- 6 331.4D0, 325.3D0, 324.5D0, 326.5D0, 329.4D0,
- 7 332.8D0, 335.9D0, 338.1D0, 340.8D0, 342.4D0,
- 8 343.5D0, 344.7D0, 345.4D0, 346.0D0, 346.3D0,
- 9 346.6D0, 346.9D0, 347.1D0, 347.4D0, 347.7D0,
- * 347.9D0, 348.2D0, 348.5D0, 348.8D0, 349.0D0,
- 1 349.3D0, 349.6D0, 349.8D0, 350.1D0, 350.4D0,
- 2 350.6D0, 351.0D0, 351.2D0, 351.6D0, 351.8D0,
- 3 352.1D0, 352.4D0, 352.6D0, 353.0D0, 353.2D0,
- 4 353.5D0, 353.8D0, 354.1D0, 354.4D0, 354.7D0,
- 5 354.9D0/
-* WORST possible geometry for the irradiation
- DATA WTPLM /
- 1 177.0D0, 180.0D0, 182.0D0, 184.0D0, 186.0D0,
- 2 188.0D0, 191.0D0, 195.0D0, 204.0D0, 215.0D0,
- 3 243.0D0, 339.2D0, 452.5D0, 672.5D0, 818.9D0,
- 4 892.6D0, 908.7D0, 847.5D0, 728.2D0, 628.6D0,
- 5 537.5D0, 470.8D0, 430.9D0, 386.9D0, 364.4D0,
- 6 351.6D0, 339.2D0, 334.4D0, 332.6D0, 333.1D0,
- 7 334.5D0, 336.2D0, 337.6D0, 339.9D0, 341.6D0,
- 8 343.0D0, 345.2D0, 346.8D0, 348.6D0, 349.8D0,
- 9 351.0D0, 352.0D0, 352.7D0, 353.5D0, 354.0D0,
- * 354.3D0, 354.7D0, 354.8D0, 355.0D0, 355.0D0,
- 1 355.0D0, 355.0D0, 355.0D0, 354.9D0, 354.9D0,
- 2 354.9D0, 354.8D0, 354.7D0, 354.6D0, 354.6D0,
- 3 354.5D0, 354.4D0, 354.4D0, 354.3D0, 354.2D0,
- 4 354.2D0, 354.1D0, 354.1D0, 354.0D0, 354.0D0,
- 5 354.0D0/
-*
-*-----------------------------------------------------------------------
-*
-* Ambient dose equivalent for neutrons from ICRP74 and Pelliccioni data
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION AMBN(NBIN1N),AAMBN(NBIN1N)
- DATA AMBN /
- 1 6.6D0, 9.0D0, 10.6D0, 12.9D0, 13.5D0,
- 2 13.6D0, 13.3D0, 12.9D0, 12.0D0, 11.3D0,
- 3 10.6D0, 9.9D0, 9.4D0, 8.9D0, 8.3D0,
- 4 7.9D0, 7.7D0, 8.0D0, 10.5D0, 16.6D0,
- 5 23.7D0, 41.1D0, 60.0D0, 88.0D0, 132.0D0,
- 6 170.0D0, 233.0D0, 322.0D0, 375.0D0, 400.0D0,
- 7 416.0D0, 425.0D0, 420.0D0, 412.0D0, 408.0D0,
- 8 405.0D0, 400.0D0, 405.0D0, 409.0D0, 420.0D0,
- 9 440.0D0, 480.0D0, 520.0D0, 540.0D0, 555.0D0,
- * 570.0D0, 600.0D0, 515.0D0, 400.0D0, 330.0D0,
-* high-energy extrapolation according to Pelliccioni
- 1 285.0D0, 253.0D0, 247.0D0, 259.0D0, 298.0D0,
- 2 335.0D0, 377.0D0, 421.0D0, 447.0D0, 476.0D0,
- 3 499.0D0, 508.0D0, 511.0D0, 510.0D0, 508.0D0,
- 4 504.0D0, 501.0D0, 504.0D0, 511.0D0, 528.0D0,
- 5 545.0D0, 577.0D0, 629.0D0, 669.0D0, 717.0D0,
- 6 777.0D0, 824.0D0, 896.0D0, 998.0D0, 1073.0D0,
- 7 1160.0D0/
-* high-energy extrapolation according to Sannikov and Savitskaya
-C 1 285.0D0, 253.0D0, 285.0D0, 306.0D0, 420.0D0,
-C 2 500.0D0, 647.0D0, 733.0D0, 789.0D0, 862.0D0,
-C 3 951.0D0, 1000.0D0, 1050.0D0, 1050.0D0, 1046.0D0,
-C 4 1038.0D0, 1031.0D0, 1038.0D0, 1052.0D0, 1087.0D0,
-C 5 1122.0D0, 1188.0D0, 1295.0D0, 1377.0D0, 1476.0D0,
-C 6 1600.0D0, 1696.0D0, 1845.0D0, 2055.0D0, 2209.0D0,
-C 7 2388.0D0/
-* 1cm-Pb-modified Snoopy (A&B) response
-C DATA AMBN /
-CC & 0.13272E+01,0.35280E+01,0.44158E+01,0.61860E+01,0.76848E+01,
-CC & 0.91501E+01,0.10320E+02,0.11686E+02,0.13774E+02,0.15550E+02,
-CC & 0.17568E+02,0.20671E+02,0.23400E+02,0.26452E+02,0.31107E+02,
-CC & 0.35200E+02,0.40029E+02,0.47957E+02,0.55050E+02,0.63372E+02,
-CC & 0.68650E+02,0.76109E+02,0.83508E+02,0.98300E+02,0.12183E+03,
-CC & 0.14270E+03,0.18229E+03,0.25960E+03,0.33847E+03,0.39849E+03,
-CC & 0.41700E+03,0.44177E+03,0.46149E+03,0.45284E+03,0.44749E+03,
-CC & 0.44458E+03,0.43180E+03,0.40909E+03,0.38360E+03,0.36038E+03,
-CC & 0.34000E+03,0.33184E+03,0.32509E+03,0.32212E+03,0.31936E+03,
-CC & 0.31438E+03,0.31000E+03,0.34000E+03,0.32675E+03,0.32092E+03,
-CC & 0.33000E+03,0.33581E+03,0.34000E+03,0.35000E+03,0.42979E+03,
-CC & 0.47896E+03,0.53000E+03,0.10000E-12,0.10000E-12,0.10000E-12,
-CC & 0.10000E-12,0.10000E-12,0.10000E-12,0.10000E-12,0.10000E-12,
-CC & 0.10000E-12,0.10000E-12,0.10000E-12,0.10000E-12,0.10000E-12,
-CC & 0.10000E-12,0.10000E-12,0.10000E-12,0.10000E-12,0.10000E-12,
-CC & 0.10000E-12,0.10000E-12,0.10000E-12,0.10000E-12,0.10000E-12,
-CC & 0.10000E-12/
-C & 0.13272E+01,0.35280E+01,0.44158E+01,0.61860E+01,0.76848E+01,
-C & 0.91501E+01,0.10320E+02,0.11686E+02,0.13774E+02,0.15550E+02,
-C & 0.17568E+02,0.20671E+02,0.23400E+02,0.26452E+02,0.31107E+02,
-C & 0.35200E+02,0.40029E+02,0.47957E+02,0.55050E+02,0.63372E+02,
-C & 0.68650E+02,0.76109E+02,0.83508E+02,0.98300E+02,0.12183E+03,
-C & 0.14270E+03,0.18229E+03,0.25960E+03,0.33847E+03,0.39849E+03,
-C & 0.41700E+03,0.44177E+03,0.46149E+03,0.45284E+03,0.44749E+03,
-C & 0.44458E+03,0.43180E+03,0.40909E+03,0.38360E+03,0.36038E+03,
-C & 0.34000E+03,0.33184E+03,0.32509E+03,0.32212E+03,0.31936E+03,
-C & 0.31438E+03,0.31000E+03,0.34000E+03,0.32675E+03,0.32092E+03,
-C & 0.33000E+03,0.33581E+03,0.34000E+03,0.35000E+03,0.42979E+03,
-C & 0.47896E+03,0.53000E+03,0.58919E+03,0.63516E+03,0.70610E+03,
-C & 0.80686E+03,0.88096E+03,0.96695E+03,0.10749E+04,0.11588E+04,
-C & 0.12882E+04,0.14721E+04,0.16072E+04,0.17641E+04,0.19612E+04,
-C & 0.21142E+04,0.23503E+04,0.26857E+04,0.29323E+04,0.32185E+04,
-C & 0.35780E+04,0.38571E+04,0.42879E+04,0.48998E+04,0.53498E+04,
-C & 0.58720E+04/
-*
-* Ambient dose equivalent for protons from Pelliccioni data
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION EAMBP(NBIN2P),AEAMBP(NBIN2P)
- DATA EAMBP /
- 1 1.00D-02, 1.25D-02, 1.50D-02, 2.00D-02, 2.50D-02,
- 2 3.00D-02, 4.00D-02, 5.00D-02, 6.50D-02, 8.00D-02,
- 3 1.00D-01, 1.25D-01, 1.50D-01, 2.00D-01, 2.50D-01,
- 4 3.00D-01, 4.00D-01, 5.00D-01, 6.50D-01, 8.00D-01,
- 5 1.00D+00, 1.25D+00, 1.50D+00, 2.00D+00, 2.50D+00,
- 6 3.00D+00, 4.00D+00, 5.00D+00, 6.50D+00, 8.00D+00,
- 7 1.00D+01, 1.25D+01, 1.50D+01, 2.00D+01, 2.50D+01,
- 8 3.00D+01, 4.00D+01, 5.00D+01, 6.50D+01, 8.00D+01,
- 9 1.00D+02, 1.25D+02, 1.50D+02, 2.00D+02, 2.50D+02,
- * 3.00D+02, 4.00D+02, 5.00D+02, 6.50D+02, 8.00D+02,
- 1 1.00D+03, 1.25D+03, 1.50D+03, 2.00D+03, 2.50D+03,
- 2 3.00D+03, 4.00D+03, 5.00D+03, 6.50D+03, 8.00D+03,
- 3 1.00D+04/
- DIMENSION AMBP(NBIN2P),AAMBP(NBIN2P)
- DATA AMBP /
- 1 .0D0, .0D0, .0D0, .0D0, .0D0,
- 2 .0D0, 4289.5D0, 2790.0D0, 2000.8D0, 1710.4D0,
- 3 1520.0D0, 1362.6D0, 1247.6D0, 1091.3D0, 991.0D0,
- 4 921.9D0, 835.3D0, 786.0D0, 746.5D0, 726.7D0,
- 5 714.4D0, 709.6D0, 710.3D0, 717.9D0, 727.7D0,
- 6 737.2D0, 753.3D0, 765.0D0, 776.0D0, 782.7D0,
- 7 788.1D0, 792.0D0, 794.4D0, 797.0D0, 798.6D0,
- 8 799.8D0, 802.2D0, 804.9D0, 809.5D0, 814.6D0,
- 9 822.0D0, 831.7D0, 841.2D0, 858.9D0, 874.6D0,
- * 888.6D0, 912.4D0, 932.0D0, 955.9D0, 975.2D0,
- 1 996.0D0, 1016.4D0, 1032.5D0, 1056.4D0, 1073.1D0,
- 2 1085.2D0, 1100.8D0, 1109.3D0, 1114.7D0, 1115.1D0,
- 3 1111.1D0/
-*
-* Ambient dose equivalent for ch. pions from ICRP74 and Pelliccioni data
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION AMBI(NBIN1I),AMBJ(NBIN1I),
- & AAMBI(NBIN1I),AAMBJ(NBIN1I)
-* Positive pions
- DATA AMBI /
- 1 224.0D0, 245.3D0, 264.1D0, 296.5D0, 323.8D0,
- 2 347.5D0, 387.2D0, 419.9D0, 459.9D0, 492.5D0,
- 3 528.0D0, 563.6D0, 592.9D0, 640.3D0, 678.9D0,
- 4 712.1D0, 769.2D0, 819.0D0, 884.5D0, 938.6D0,
- 5 994.0D0, 1040.7D0, 1067.6D0, 1080.0D0, 1059.4D0,
- 6 1026.9D0, 958.6D0, 900.6D0, 835.9D0, 792.4D0,
- 7 757.0D0, 735.3D0, 726.0D0, 722.9D0, 727.1D0,
- 8 733.1D0, 743.7D0, 750.0D0, 752.4D0, 751.2D0,
- 9 748.0D0, 743.9D0, 740.2D0, 734.0D0, 729.2D0,
- * 725.4D0, 720.1D0, 716.7D0, 714.0D0, 712.9D0,
- 1 713.0D0, 714.7D0, 717.1D0, 722.7D0, 728.4D0,
- 2 733.8D0, 743.6D0, 752.1D0, 762.9D0, 772.0D0,
- 3 782.0D0, 792.2D0, 800.7D0, 814.4D0, 825.2D0,
- 4 834.1D0, 848.4D0, 859.8D0, 873.3D0, 884.2D0,
- 5 896.0D0/
-* Negative pions
- DATA AMBJ /
- 1 1130.0D0, 1245.2D0, 1345.3D0, 1507.9D0, 1631.0D0,
- 2 1723.7D0, 1843.3D0, 1902.4D0, 1921.2D0, 1890.7D0,
- 3 1810.0D0, 1684.7D0, 1563.7D0, 1368.4D0, 1231.1D0,
- 4 1135.8D0, 1024.1D0, 975.0D0, 960.9D0, 974.3D0,
- 5 1003.4D0, 1038.1D0, 1063.2D0, 1080.0D0, 1062.8D0,
- 6 1031.8D0, 964.1D0, 905.4D0, 839.2D0, 794.2D0,
- 7 757.0D0, 733.4D0, 722.6D0, 717.3D0, 720.2D0,
- 8 725.5D0, 735.8D0, 743.0D0, 747.7D0, 748.8D0,
- 9 748.0D0, 745.7D0, 742.9D0, 737.5D0, 732.8D0,
- * 728.9D0, 722.9D0, 718.9D0, 715.2D0, 713.5D0,
- 1 713.0D0, 714.2D0, 716.4D0, 721.7D0, 727.4D0,
- 2 732.9D0, 742.8D0, 751.5D0, 762.6D0, 771.8D0,
- 3 782.0D0, 792.4D0, 801.0D0, 814.7D0, 825.5D0,
- 4 834.5D0, 848.8D0, 860.0D0, 873.5D0, 884.3D0,
- 5 896.0D0/
-*
-* Ambient dose equivalent for muons from ICRP74 and Pelliccioni data
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION AMBM(NBIN1M),AAMBM(NBIN1M)
- DATA AMBM /
- 1 394.0D0, 411.7D0, 426.6D0, 450.7D0, 469.5D0,
- 2 484.8D0, 508.3D0, 525.6D0, 544.3D0, 557.4D0,
- 3 569.5D0, 578.9D0, 583.9D0, 585.1D0, 579.3D0,
- 4 569.5D0, 543.9D0, 515.5D0, 474.1D0, 439.0D0,
- 5 402.6D0, 369.8D0, 347.0D0, 320.0D0, 307.2D0,
- 6 301.2D0, 297.8D0, 298.9D0, 302.8D0, 307.0D0,
- 7 311.5D0, 315.1D0, 317.3D0, 319.7D0, 320.7D0,
- 8 321.1D0, 321.2D0, 320.9D0, 320.5D0, 320.1D0,
- 9 320.0D0, 320.2D0, 320.5D0, 321.3D0, 322.0D0,
- * 322.7D0, 323.7D0, 324.4D0, 324.9D0, 325.1D0,
- 1 325.0D0, 324.5D0, 323.9D0, 322.5D0, 321.3D0,
- 2 320.2D0, 318.6D0, 317.4D0, 316.2D0, 315.4D0,
- 3 315.0D0, 314.9D0, 315.1D0, 315.9D0, 316.8D0,
- 4 317.7D0, 319.5D0, 321.0D0, 323.0D0, 324.7D0,
- 5 326.5D0/
-*
-* Ambient dose equivalent for photons from ICRP74 and Pelliccioni data
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION AMBG(NBIN1G),AAMBG(NBIN1G)
- DATA AMBG /
- 1 0.29512E-08, 0.16406E-07, 0.91199E-07, 0.50699E-06, 0.28184E-05,
- 2 0.15667E-04, 0.87096E-04, 0.48417E-03, 0.26915E-02, 0.14962E-01,
- 3 0.83176E-01, 0.46238E+00, 0.93903E+00, 0.10505E+01, 0.93070E+00,
- 4 0.76366E+00, 0.62173E+00, 0.52108E+00, 0.51322E+00, 0.55911E+00,
- 5 0.61958E+00, 0.72946E+00, 0.92815E+00, 0.12264E+01, 0.15403E+01,
- 6 0.19055E+01, 0.23480E+01, 0.27945E+01, 0.36249E+01, 0.42697E+01,
- 7 0.51844E+01, 0.61688E+01, 0.71466E+01, 0.82509E+01, 0.95675E+01,
- 8 0.10544E+02, 0.10715E+02, 0.10375E+02, 0.94276E+01, 0.91033E+01,
- 9 0.87619E+01, 0.84957E+01, 0.83464E+01, 0.82813E+01, 0.82585E+01,
- * 0.82149E+01, 0.82566E+01, 0.86437E+01, 0.88675E+01, 0.89207E+01,
- 1 0.90012E+01, 0.92640E+01, 0.96872E+01, 0.10186E+02, 0.10715E+02,
- 2 0.11169E+02, 0.11561E+02, 0.11803E+02, 0.11885E+02, 0.11830E+02,
- 3 0.11695E+02, 0.11535E+02, 0.11429E+02, 0.11508E+02, 0.11830E+02,
- 4 0.12331E+02, 0.12882E+02, 0.13305E+02, 0.13428E+02, 0.13092E+02,
- 5 0.12190E+02, 0.12190E+02, 0.12190E+02, 0.12190E+02, 0.12190E+02,
- 6 0.12190E+02, 0.12190E+02, 0.12190E+02, 0.12190E+02, 0.12190E+02,
- 7 0.12190E+02/
-*
-* Ambient dose equivalent for electrons from ICRP74 and Pelliccioni data
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION EAMBE(NBIN2E),AEAMBE(NBIN2E)
- DATA EAMBE /
- 1 0.20000E-02, 0.22896E-02, 0.26212E-02, 0.30008E-02, 0.34354E-02,
- 2 0.39329E-02, 0.45025E-02, 0.51545E-02, 0.59010E-02, 0.67556E-02,
- 3 0.77339E-02, 0.88540E-02, 0.10136E-01, 0.11604E-01, 0.13285E-01,
- 4 0.15209E-01, 0.17411E-01, 0.19932E-01, 0.22819E-01, 0.26124E-01,
- 5 0.29907E-01, 0.34238E-01, 0.39196E-01, 0.44873E-01, 0.51371E-01,
- 6 0.58811E-01, 0.67328E-01, 0.77078E-01, 0.88241E-01, 0.10102E+00,
- 7 0.11565E+00, 0.13240E+00, 0.15157E+00, 0.17352E+00, 0.19865E+00,
- 8 0.22742E+00, 0.26036E+00, 0.29806E+00, 0.34122E+00, 0.39064E+00,
- 9 0.44721E+00, 0.51198E+00, 0.58612E+00, 0.67101E+00, 0.76818E+00,
- * 0.87943E+00, 0.10068E+01, 0.11526E+01, 0.13195E+01, 0.15106E+01,
- 1 0.17294E+01, 0.19798E+01, 0.22665E+01, 0.25948E+01, 0.29705E+01,
- 2 0.34007E+01, 0.38932E+01, 0.44570E+01, 0.51025E+01, 0.58414E+01,
- 3 0.66874E+01, 0.76559E+01, 0.87646E+01, 0.10034E+02, 0.11487E+02,
- 4 0.13151E+02, 0.15055E+02, 0.17235E+02, 0.19731E+02, 0.22589E+02,
- 5 0.25860E+02, 0.29605E+02, 0.33892E+02, 0.38801E+02, 0.44420E+02,
- 6 0.50853E+02, 0.58217E+02, 0.66648E+02, 0.76300E+02, 0.87350E+02,
- 7 0.10000E+03/
-*
- DIMENSION AMBE(NBIN2E),AAMBE(NBIN2E)
- DATA AMBE /
- 1 1.00000E-12, 0.16082E+03, 0.19885E+03, 0.32509E+03, 0.41665E+03,
- 2 0.45092E+03, 0.44206E+03, 0.41582E+03, 0.38863E+03, 0.36471E+03,
- 3 0.34608E+03, 0.33323E+03, 0.32465E+03, 0.32115E+03, 0.32097E+03,
- 4 0.32279E+03, 0.32481E+03, 0.32583E+03, 0.32546E+03, 0.32233E+03,
- 5 0.31724E+03, 0.31179E+03, 0.30738E+03, 0.30701E+03, 0.31035E+03,
- 6 0.31401E+03, 0.31705E+03, 0.31769E+03, 0.31635E+03, 0.31477E+03,
- 7 0.31497E+03, 0.31646E+03, 0.31903E+03, 0.32163E+03, 0.32354E+03,
- 8 0.32444E+03, 0.32485E+03, 0.32398E+03, 0.32261E+03, 0.32087E+03,
- 9 0.31913E+03, 0.31669E+03, 0.31472E+03, 0.31256E+03, 0.31087E+03,
- * 0.30919E+03, 0.30832E+03, 0.30848E+03, 0.30932E+03, 0.31016E+03,
- 1 0.31154E+03, 0.31390E+03, 0.31573E+03, 0.31831E+03, 0.32056E+03,
- 2 0.32277E+03, 0.32480E+03, 0.32730E+03, 0.32833E+03, 0.32986E+03,
- 3 0.33037E+03, 0.33037E+03, 0.32972E+03, 0.32810E+03, 0.32810E+03,
- 4 0.32810E+03, 0.32810E+03, 0.32810E+03, 0.32810E+03, 0.32810E+03,
- 5 0.32810E+03, 0.32810E+03, 0.32810E+03, 0.32810E+03, 0.32810E+03,
- 6 0.32810E+03, 0.32810E+03, 0.32810E+03, 0.32810E+03, 0.32810E+03,
- 7 0.32810E+03/
-*
-*-----------------------------------------------------------------------
-*
-* Ambient dose equivalent for neutrons ("GRS"-conversion factors)
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION H10N(NBIN2N),H10PR(NBIN2N),H10PI(NBIN2N),H10MU(NBIN2M),
- & AH10MU(NBIN2M)
- DATA H10N/
- 1 7.62D0, 7.84D0, 8.06D0, 8.28D0, 8.50D0,
- 2 8.71D0, 8.92D0, 9.12D0, 9.32D0, 9.50D0,
- 3 9.67D0, 9.83D0, 9.97D0, 10.10D0, 10.21D0,
- 4 10.30D0, 10.38D0, 10.43D0, 10.46D0, 10.47D0,
- 5 10.47D0, 10.43D0, 10.38D0, 10.31D0, 10.22D0,
- 6 10.11D0, 9.99D0, 9.85D0, 9.69D0, 9.52D0,
- 7 9.35D0, 9.16D0, 8.96D0, 8.76D0, 8.56D0,
- 8 8.35D0, 8.15D0, 7.94D0, 7.74D0, 7.54D0,
- 9 7.35D0, 7.16D0, 6.99D0, 6.82D0, 6.67D0,
- * 6.53D0, 6.40D0, 6.30D0, 6.22D0, 6.16D0,
- 1 6.13D0, 6.14D0, 6.19D0, 6.29D0, 6.45D0,
- 2 6.69D0, 7.03D0, 7.49D0, 8.11D0, 8.93D0,
- 3 10.04D0, 11.51D0, 13.47D0, 16.08D0, 19.58D0,
- 4 24.24D0, 30.42D0, 38.53D0, 49.03D0, 62.35D0,
- 5 78.83D0, 98.66D0, 121.76D0, 147.73D0, 175.91D0,
- 6 205.40D0, 235.18D0, 264.24D0, 291.70D0, 316.84D0,
- 7 339.20D0, 358.53D0, 374.78D0, 388.05D0, 398.56D0,
- 8 406.61D0, 412.66D0, 417.53D0, 423.43D0, 436.87D0,
- 9 472.90D0, 539.16D0, 598.43D0, 623.89D0, 595.0D0 ,
- * 524.0D0 , 365.0D0 , 323.0D0 , 321.0D0 , 323.0D0 ,
- 1 325.0D0 , 328.0D0 , 333.0D0 , 338.0D0 , 344.0D0 ,
- 2 353.0D0 , 371.0D0 , 482.0D0 , 581.0D0 , 677.0D0 ,
- 3 777.0D0 , 882.0D0 , 1005.0D0 , 1125.0D0 , 1265.0D0 ,
- 4 1410.0D0 , 1570.0D0 , 1740.0D0 , 1930.0D0 , 2130.0D0 ,
- 5 2360.0D0 , 2600.0D0 , 2880.0D0 , 3180.0D0 , 3500.0D0 ,
- 6 3860.0D0 , 4250.0D0 , 4700.0D0 , 5180.0D0 , 5610.0D0 ,
- 7 6290.0D0 , 6900.0D0 , 7570.0D0 , 8280.0D0 , 9000.0D0 ,
- 8 9830.0D0 , 10700.0D0 , 11600.0D0 , 12650.0D0 , 13600.0D0 ,
- 9 14750.0D0 , 15900.0D0 , 17100.0D0 , 18450.0D0 , 19700.0D0 ,
- * 21100.0D0 , 22500.0D0 , 23900.0D0 , 25500.0D0 , 27000.0D0 /
-*
-* Ambient dose equivalent for protons ("GRS"-conversion factors)
-* Energy in GeV, dose in pSv.cm^2
-*
- DATA H10PR/
- 1 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 2 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 3 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 4 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 5 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 6 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 7 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 8 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 9 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- * 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 1 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 2 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 3 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 4 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 5 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 6 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 7 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 8 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 9 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- * 3130.0D0, 2530.0D0, 2130.0D0, 1825.0D0, 1585.0D0,
- 1 1390.0D0, 1230.0D0, 1105.0D0, 1000.0D0, 923.0D0,
- 2 864.0D0, 828.0D0, 898.0D0, 965.0D0, 1040.0D0,
- 3 1125.0D0, 1220.0D0, 1335.0D0, 1455.0D0, 1595.0D0,
- 4 1740.0D0, 1905.0D0, 2080.0D0, 2270.0D0, 2480.0D0,
- 5 2710.0D0, 2960.0D0, 3240.0D0, 3550.0D0, 3870.0D0,
- 6 4240.0D0, 4630.0D0, 5090.0D0, 5570.0D0, 6000.0D0,
- 7 6690.0D0, 7300.0D0, 7980.0D0, 8690.0D0, 9410.0D0,
- 8 10250.0D0, 11100.0D0, 12050.0D0, 13100.0D0, 14050.0D0,
- 9 15200.0D0, 16350.0D0, 17550.0D0, 18900.0D0, 20100.0D0,
- * 21600.0D0, 22300.0D0, 24400.0D0, 26000.0D0, 27500.0D0/
-*
-* Ambient dose equivalent for charged pions ("GRS"-conversion factors)
-* Energy in GeV, dose in pSv.cm^2
-*
- DATA H10PI/
- 1 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 2 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 3 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 4 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 5 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 6 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 7 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 8 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 9 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- * 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 1 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 2 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 3 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 4 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 5 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 6 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 7 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 8 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- 9 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
- * 1640.0D0, 1560.0D0, 1495.0D0, 1445.0D0, 1405.0D0,
- 1 1375.0D0, 1355.0D0, 1345.0D0, 1335.0D0, 1330.0D0,
- 2 1330.0D0, 1330.0D0, 1330.0D0, 1335.0D0, 1340.0D0,
- 3 1345.0D0, 1350.0D0, 1360.0D0, 1485.0D0, 1630.0D0,
- 4 1780.0D0, 1945.0D0, 2120.0D0, 2310.0D0, 2520.0D0,
- 5 2750.0D0, 3000.0D0, 3280.0D0, 3580.0D0, 3910.0D0,
- 6 4270.0D0, 4670.0D0, 5120.0D0, 5600.0D0, 6040.0D0,
- 7 6720.0D0, 7330.0D0, 8010.0D0, 8720.0D0, 9440.0D0,
- 8 10300.0D0, 11150.0D0, 12050.0D0, 13100.0D0, 14050.0D0,
- 9 15200.0D0, 16350.0D0, 17550.0D0, 18900.0D0, 20200.0D0,
- * 21600.0D0, 23000.0D0, 24400.0D0, 26000.0D0, 27500.0D0/
-*
-* Ambient dose equivalent for muons ("GRS"-conversion factors)
-* Energy in GeV, dose in pSv.cm^2
-*
- DIMENSION EAMBM(NBIN2M),AEAMBM(NBIN2M)
- DATA EAMBM/
- 1 1.0D-02, 2.0D-02, 5.0D-02, 1.0D-01, 2.0D-01,
- 2 5.0D-01, 1.0D+00, 2.0D+00, 5.0D+00, 1.0D+01,
- 3 2.0D+01, 5.0D+01, 1.0D+02, 2.0D+02, 5.0D+02,
- 4 1.0D+03/
- DATA H10MU /
- 1 2600.0D0, 2600.0D0, 2600.0D0, 2600.0D0, 350.0D0,
- 2 330.0D0, 350.0D0, 360.0D0, 380.0D0, 390.0D0,
- 3 410.0D0, 430.0D0, 450.0D0, 480.0D0, 560.0D0,
- 4 680.0D0/
-*
-*-----------------------------------------------------------------------
-*
- DATA LFIRST /.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.,
- & .TRUE.,.TRUE.,.TRUE.,.TRUE./
- DATA CSET /' '/
-
-* default is zero weighting
- FLUSCW = 0.0D0
- ITEST = 0
- IJ = IIJ
-
-* calculate logarithms of energy-bins at the very first call
- IF (LFIRST(0)) THEN
- DO 1 I=1,NBIN1N
- AEBINN(I) = LOG10(EBINN(I))
- AAP74N(I) = LOG10(AP74N(I))
- ART74N(I) = LOG10(RT74N(I))
- AWT74N(I) = LOG10(WT74N(I))
- AAPPLN(I) = LOG10(APPLN(I))
- ARTPLN(I) = LOG10(RTPLN(I))
- AWTPLN(I) = LOG10(WTPLN(I))
- AAMBN(I) = LOG10(AMBN(I))
- 1 CONTINUE
- DO 2 I=1,NBIN1P
- AE74P(I) = LOG10(E74P(I))
- AEPLP(I) = LOG10(EPLP(I))
- AAP74P(I) = LOG10(AP74P(I))
- ART74P(I) = LOG10(RT74P(I))
- AWT74P(I) = LOG10(WT74P(I))
- AAPPLP(I) = LOG10(APPLP(I))
- ARTPLP(I) = LOG10(RTPLP(I))
- AWTPLP(I) = LOG10(WTPLP(I))
- 2 CONTINUE
- DO 3 I=1,NBIN1I
- AEBINI(I) = LOG10(EBINI(I))
- AAP74I(I) = LOG10(AP74I(I))
- ART74I(I) = LOG10(RT74I(I))
- AWT74I(I) = LOG10(WT74I(I))
- AAP74J(I) = LOG10(AP74J(I))
- ART74J(I) = LOG10(RT74J(I))
- AWT74J(I) = LOG10(WT74J(I))
- AAPPLI(I) = LOG10(APPLI(I))
- ARTPLI(I) = LOG10(RTPLI(I))
- AWTPLI(I) = LOG10(WTPLI(I))
- AAPPLJ(I) = LOG10(APPLJ(I))
- ARTPLJ(I) = LOG10(RTPLJ(I))
- AWTPLJ(I) = LOG10(WTPLJ(I))
- AAMBI(I) = LOG10(AMBI(I))
- AAMBJ(I) = LOG10(AMBJ(I))
- 3 CONTINUE
- DO 4 I=1,NBIN1M
- AEBINM(I) = LOG10(EBINM(I))
- AAPPLM(I) = LOG10(APPLM(I))
- ARTPLM(I) = LOG10(RTPLM(I))
- AWTPLM(I) = LOG10(WTPLM(I))
- AAMBM(I) = LOG10(AMBM(I))
- 4 CONTINUE
- DO 5 I=1,NBIN2P
- AEAMBP(I) = LOG10(EAMBP(I))
- IF (AMBP(I).GT.0.0D0) THEN
- AAMBP(I) = LOG10(AMBP(I))
- ELSE
- AAMBP(I) = LOG10(ANGLGB)
- ENDIF
- 5 CONTINUE
- DO 6 I=1,NBIN2M
- AEAMBM(I) = LOG10(EAMBM(I))
- AH10MU(I) = LOG10(H10MU(I))
- 6 CONTINUE
- DO 7 I=1,NBIN1G
- AE74G(I) = LOG10(E74G(I))
- AAP74G(I) = LOG10(AP74G(I))
- ART74G(I) = LOG10(RT74G(I))
- AWT74G(I) = LOG10(WT74G(I))
- AAMBG(I) = LOG10(AMBG(I))
- 7 CONTINUE
- DO 8 I=1,NBIN1E
- AE74E(I) = LOG10(E74E(I))
- AAP74E(I) = LOG10(AP74E(I))
- ART74E(I) = LOG10(RT74E(I))
- AWT74E(I) = LOG10(WT74E(I))
- 8 CONTINUE
- DO 9 I=1,NBIN2E
- AEAMBE(I) = LOG10(EAMBE(I))
- AAMBE(I) = LOG10(AMBE(I))
- 9 CONTINUE
- LFIRST(0) = .FALSE.
- ENDIF
-
-* test print
- IF (IJ.LT.-10000) THEN
-* test print for set number itest (i.e. -20001 gives the proton
-* conversion factors for set 2)
-* return particle-id of conversion factor set used for particle IJ
-* via LLO
- ITEST = -IJ/10000
- IJ = -IJ-10000*ITEST
- IF (ITT(IJ).EQ.1) THEN
- LLO = 8
- ELSEIF (ITT(IJ).EQ.2) THEN
- LLO = 1
- ELSEIF (ITT(IJ).EQ.3) THEN
- LLO = 13
- ELSEIF (ITT(IJ).EQ.4) THEN
- LLO = 14
- ELSEIF (ITT(IJ).EQ.5) THEN
- LLO = 10
- ELSEIF (ITT(IJ).EQ.6) THEN
- LLO = 11
- ELSEIF (ITT(IJ).EQ.7) THEN
- LLO = 7
- ELSEIF (ITT(IJ).EQ.8) THEN
- LLO = 3
- ELSEIF (ITT(IJ).EQ.99) THEN
- LLO = 0
- ELSE
- LLO = -1
- ENDIF
- ELSE
-* ISCRNG = 1 for usrbdx
-* = 2 for usrbin
-* = 3 for usrtrack
-* return unit weight for all other detectors
- IF ((ISCRNG.NE.1).AND.(ISCRNG.NE.2).AND.(ISCRNG.NE.3)) THEN
- FLUSCW = 1.0D0
- RETURN
- ENDIF
- ENDIF
-*
-* At this point the detector is either usrbdx or usrbin or usrtrack.
-*
-* Now check if any of the available conversion factor sets is requested
-* in which case the default conversion factor is zero. Otherwise the
-* default factor is one.
- IF (ITEST.EQ.0) THEN
-* usrbdx
- IF (ISCRNG.EQ.1) THEN
- CSET = TITUSX(JSCRNG)
-* usrtrack
- ELSEIF (ISCRNG.EQ.3) THEN
- CSET = TITUTC(JSCRNG)
-* usrbin
- ELSE
- CSET = TITUSB(JSCRNG)
- ENDIF
- IF ((CSET(1:3).EQ.'EAP').OR.(CSET(1:3).EQ.'eap').OR.
- & (CSET(1:3).EQ.'ERT').OR.(CSET(1:3).EQ.'ert').OR.
- & (CSET(1:3).EQ.'EWT').OR.(CSET(1:3).EQ.'ewt').OR.
- & (CSET(1:3).EQ.'AMB').OR.(CSET(1:3).EQ.'amb')) THEN
- FLUSCW = 0.0D0
- ELSE
-* skip the rest for all other sdum's
- FLUSCW = 1.0D0
- RETURN
- ENDIF
- ENDIF
-*
-* At this point one of the available conversion factor sets is
-* requested by sdum.
-*
-* check for particle type
-* return zero weight for all particles with ij < 1 or > 40 and for
-* all particles with flag=99 (see array ITT)
- IF ((IJ.LT.1).OR.(IJ.GT.40)) RETURN
- IPART = ITT(IJ)
- IF (IPART.EQ.99) RETURN
-
-* kinetic energy
- IF (PLA.LT.0.0D0) THEN
- EKIN = ABS(PLA)
- ELSEIF (PLA.GT.0.0D0) THEN
- EKIN = SQRT(PLA**2+AM(IJ)**2)-AM(IJ)
- ELSE
- RETURN
- ENDIF
-*
-*
-* conversion factor set
- IF (ITEST.EQ.0) THEN
-* for muons there is only a Pelliccioni weighting factor set
- IF (IPART.EQ.5) THEN
- IF ((CSET(1:1).EQ.'E').AND.(CSET(4:5).EQ.'74'))
- & CSET(4:5) = 'MP'
- IF ((CSET(1:1).EQ.'e').AND.(CSET(4:5).EQ.'74'))
- & CSET(4:5) = 'mp'
- ENDIF
-* for photons and electrons there is only a ICRP weighting factor set
- IF ((IPART.EQ.7).OR.(IPART.EQ.8)) THEN
- IF (((CSET(1:1).EQ.'E' ).OR.(CSET(1:1).EQ.'e' )).AND.
- & ((CSET(4:5).EQ.'MP').OR.(CSET(4:5).EQ.'mp'))) THEN
- CSET(4:5) = '74'
-* for photons and electrons there is no GRS amb. dose equivalent data set
- ELSEIF ((CSET(1:3).EQ.'AMB').OR.(CSET(1:3).EQ.'amb')) THEN
- IF ((CSET(4:5).EQ.'GS').OR.(CSET(4:5).EQ.'gs')) RETURN
- ENDIF
-* skip if only hadronic part is requested
- IF (CSET(6:6).EQ.'1') RETURN
- ELSE
-* skip if only electromagnetic part is requested
- IF (CSET(6:6).EQ.'2') RETURN
- ENDIF
- ELSE
- IF (IPART.EQ.5) THEN
- IF (ITEST.EQ.1) ITEST = 4
- IF (ITEST.EQ.2) ITEST = 5
- IF (ITEST.EQ.3) ITEST = 6
- ENDIF
- IF ((IPART.EQ.7).OR.(IPART.EQ.8)) THEN
- IF (ITEST.EQ.4) ITEST = 1
- IF (ITEST.EQ.5) ITEST = 2
- IF (ITEST.EQ.6) ITEST = 3
- IF (ITEST.GE.9) RETURN
- ENDIF
- ENDIF
-*
-*
-* Effective dose (ICRP radiation weighting factors Wr)
-* Anterior-Posterior irradiation
- IF ((CSET(1:5).EQ.'EAP74').OR.(CSET(1:5).EQ.'eap74')
- & .OR.(ITEST.EQ.1)) THEN
- IF (LFIRST(1).AND.(ITEST.EQ.0)) THEN
- WRITE(LUNOUT,1000)
- WRITE(LUNOUT,1002)
- WRITE(LUNOUT,1004)
- LFIRST(1) = .FALSE.
- ENDIF
- IF (IPART.EQ.1) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINN(1)) THEN
- FLUSCW = AP74N(1)
- ELSEIF (AEKIN.GT.AEBINN(NBIN1N)) THEN
- FLUSCW = AP74N(NBIN1N)
- ELSEIF ((AEKIN.GE.AEBINN(47)).AND.(AEKIN.LE.AEBINN(NBIN1N)))
- & THEN
- XBIN = (AEKIN-AEBINN(47))/(AEBINN(NBIN1N)-AEBINN(47))
- & *DBLE(NBIN1N-47)+47.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINN(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINN(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1N) THEN
- FLUSCW = AP74N(NBIN1N)
- ELSE
- FLUSCW =( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (AAP74N(IBINHI)-AAP74N(IBINLO))+AAP74N(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSE
- IBINLO = 1
- IBINHI = 47
- 10 CONTINUE
- IF ((IBINHI-IBINLO).EQ.1) GOTO 11
- KK = (IBINHI+IBINLO)/2
- IF (AEKIN.LE.AEBINN(KK)) THEN
- IBINHI = KK
- ELSE
- IBINLO = KK
- ENDIF
- GOTO 10
- 11 CONTINUE
- FLUSCW = ( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (AAP74N(IBINHI)-AAP74N(IBINLO))+AAP74N(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSEIF (IPART.EQ.2) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AE74P(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AE74P(NBIN1P)) THEN
- FLUSCW = AP74P(NBIN1P)
- ELSE
- XBIN = (AEKIN-AE74P(1))/(AE74P(NBIN1P)-AE74P(1))
- & *DBLE(NBIN1P-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AE74P(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AE74P(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1P) THEN
- FLUSCW = AP74P(NBIN1P)
- ELSE
- FLUSCW =( AEKIN-AE74P(IBINLO))/
- & (AE74P(IBINHI)-AE74P(IBINLO))*
- & (AAP74P(IBINHI)-AAP74P(IBINLO))+AAP74P(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.3) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = AP74I(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = AP74I(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (AAP74I(IBINHI)-AAP74I(IBINLO))+AAP74I(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.4) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = AP74J(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = AP74J(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (AAP74J(IBINHI)-AAP74J(IBINLO))+AAP74J(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.7) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AE74G(1)) THEN
- FLUSCW = AP74G(1)
- ELSEIF (AEKIN.GT.AE74G(NBIN1G)) THEN
- FLUSCW = AP74G(NBIN1G)
- ELSE
- XBIN = (AEKIN-AE74G(1))/(AE74G(NBIN1G)-AE74G(1))
- & *DBLE(NBIN1G-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AE74G(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AE74G(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1G) THEN
- FLUSCW = AP74G(NBIN1G)
- ELSE
- FLUSCW =( AEKIN-AE74G(IBINLO))/
- & (AE74G(IBINHI)-AE74G(IBINLO))*
- & (AAP74G(IBINHI)-AAP74G(IBINLO))+AAP74G(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.8) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AE74E(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AE74E(NBIN1E)) THEN
- FLUSCW = AP74E(NBIN1E)
- ELSE
- XBIN = (AEKIN-AE74E(1))/(AE74E(NBIN1E)-AE74E(1))
- & *DBLE(NBIN1E-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AE74E(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AE74E(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1E) THEN
- FLUSCW = AP74E(NBIN1E)
- ELSE
- FLUSCW =( AEKIN-AE74E(IBINLO))/
- & (AE74E(IBINHI)-AE74E(IBINLO))*
- & (AAP74E(IBINHI)-AAP74E(IBINLO))+AAP74E(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ENDIF
-*
-*
-* Effective dose (ICRP radiation weighting factors Wr)
-* Rotational irradiation geometry
- ELSEIF ((CSET(1:5).EQ.'ERT74').OR.(CSET(1:5).EQ.'ert74')
- & .OR.(ITEST.EQ.2)) THEN
- IF (LFIRST(2).AND.(ITEST.EQ.0)) THEN
- WRITE(LUNOUT,1000)
- WRITE(LUNOUT,1002)
- WRITE(LUNOUT,1005)
- LFIRST(2) = .FALSE.
- ENDIF
- IF (IPART.EQ.1) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINN(1)) THEN
- FLUSCW = RT74N(1)
- ELSEIF (AEKIN.GT.AEBINN(NBIN1N)) THEN
- FLUSCW = RT74N(NBIN1N)
- ELSEIF ((AEKIN.GE.AEBINN(47)).AND.(AEKIN.LE.AEBINN(NBIN1N)))
- & THEN
- XBIN = (AEKIN-AEBINN(47))/(AEBINN(NBIN1N)-AEBINN(47))
- & *DBLE(NBIN1N-47)+47.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINN(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINN(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1N) THEN
- FLUSCW = RT74N(NBIN1N)
- ELSE
- FLUSCW =( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (ART74N(IBINHI)-ART74N(IBINLO))+ART74N(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSE
- IBINLO = 1
- IBINHI = 47
- 20 CONTINUE
- IF ((IBINHI-IBINLO).EQ.1) GOTO 21
- KK = (IBINHI+IBINLO)/2
- IF (AEKIN.LE.AEBINN(KK)) THEN
- IBINHI = KK
- ELSE
- IBINLO = KK
- ENDIF
- GOTO 20
- 21 CONTINUE
- FLUSCW = ( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (ART74N(IBINHI)-ART74N(IBINLO))+ART74N(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSEIF (IPART.EQ.2) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AE74P(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AE74P(NBIN1P)) THEN
- FLUSCW = RT74P(NBIN1P)
- ELSE
- XBIN = (AEKIN-AE74P(1))/(AE74P(NBIN1P)-AE74P(1))
- & *DBLE(NBIN1P-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AE74P(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AE74P(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1P) THEN
- FLUSCW = RT74P(NBIN1P)
- ELSE
- FLUSCW =( AEKIN-AE74P(IBINLO))/
- & (AE74P(IBINHI)-AE74P(IBINLO))*
- & (ART74P(IBINHI)-ART74P(IBINLO))+ART74P(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.3) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = RT74I(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = RT74I(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (ART74I(IBINHI)-ART74I(IBINLO))+ART74I(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.4) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = RT74J(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = RT74J(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (ART74J(IBINHI)-ART74J(IBINLO))+ART74J(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.7) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AE74G(1)) THEN
- FLUSCW = RT74G(1)
- ELSEIF (AEKIN.GT.AE74G(NBIN1G)) THEN
- FLUSCW = RT74G(NBIN1G)
- ELSE
- XBIN = (AEKIN-AE74G(1))/(AE74G(NBIN1G)-AE74G(1))
- & *DBLE(NBIN1G-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AE74G(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AE74G(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1G) THEN
- FLUSCW = RT74G(NBIN1G)
- ELSE
- FLUSCW =( AEKIN-AE74G(IBINLO))/
- & (AE74G(IBINHI)-AE74G(IBINLO))*
- & (ART74G(IBINHI)-ART74G(IBINLO))+ART74G(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.8) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AE74E(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AE74E(NBIN1E)) THEN
- FLUSCW = RT74E(NBIN1E)
- ELSE
- XBIN = (AEKIN-AE74E(1))/(AE74E(NBIN1E)-AE74E(1))
- & *DBLE(NBIN1E-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AE74E(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AE74E(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1E) THEN
- FLUSCW = RT74E(NBIN1E)
- ELSE
- FLUSCW =( AEKIN-AE74E(IBINLO))/
- & (AE74E(IBINHI)-AE74E(IBINLO))*
- & (ART74E(IBINHI)-ART74E(IBINLO))+ART74E(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ENDIF
-*
-*
-* Effective dose (ICRP radiation weighting factors Wr)
-* Worst possible geometry for the irradiation
- ELSEIF ((CSET(1:5).EQ.'EWT74').OR.(CSET(1:5).EQ.'ewt74')
- & .OR.(ITEST.EQ.3)) THEN
- IF (LFIRST(3).AND.(ITEST.EQ.0)) THEN
- WRITE(LUNOUT,1000)
- WRITE(LUNOUT,1002)
- WRITE(LUNOUT,1006)
- LFIRST(3) = .FALSE.
- ENDIF
- IF (IPART.EQ.1) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINN(1)) THEN
- FLUSCW = WT74N(1)
- ELSEIF (AEKIN.GT.AEBINN(NBIN1N)) THEN
- FLUSCW = WT74N(NBIN1N)
- ELSEIF ((AEKIN.GE.AEBINN(47)).AND.(AEKIN.LE.AEBINN(NBIN1N)))
- & THEN
- XBIN = (AEKIN-AEBINN(47))/(AEBINN(NBIN1N)-AEBINN(47))
- & *DBLE(NBIN1N-47)+47.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINN(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINN(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1N) THEN
- FLUSCW = WT74N(NBIN1N)
- ELSE
- FLUSCW =( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (AWT74N(IBINHI)-AWT74N(IBINLO))+AWT74N(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSE
- IBINLO = 1
- IBINHI = 47
- 30 CONTINUE
- IF ((IBINHI-IBINLO).EQ.1) GOTO 31
- KK = (IBINHI+IBINLO)/2
- IF (AEKIN.LE.AEBINN(KK)) THEN
- IBINHI = KK
- ELSE
- IBINLO = KK
- ENDIF
- GOTO 30
- 31 CONTINUE
- FLUSCW = ( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (AWT74N(IBINHI)-AWT74N(IBINLO))+AWT74N(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSEIF (IPART.EQ.2) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AE74P(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AE74P(NBIN1P)) THEN
- FLUSCW = WT74P(NBIN1P)
- ELSE
- XBIN = (AEKIN-AE74P(1))/(AE74P(NBIN1P)-AE74P(1))
- & *DBLE(NBIN1P-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AE74P(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AE74P(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1P) THEN
- FLUSCW = WT74P(NBIN1P)
- ELSE
- FLUSCW =( AEKIN-AE74P(IBINLO))/
- & (AE74P(IBINHI)-AE74P(IBINLO))*
- & (AWT74P(IBINHI)-AWT74P(IBINLO))+AWT74P(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.3) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = WT74I(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = WT74I(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (AWT74I(IBINHI)-AWT74I(IBINLO))+AWT74I(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.4) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = WT74J(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = WT74J(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (AWT74J(IBINHI)-AWT74J(IBINLO))+AWT74J(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.7) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AE74G(1)) THEN
- FLUSCW = WT74G(1)
- ELSEIF (AEKIN.GT.AE74G(NBIN1G)) THEN
- FLUSCW = WT74G(NBIN1G)
- ELSE
- XBIN = (AEKIN-AE74G(1))/(AE74G(NBIN1G)-AE74G(1))
- & *DBLE(NBIN1G-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AE74G(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AE74G(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1G) THEN
- FLUSCW = WT74G(NBIN1G)
- ELSE
- FLUSCW =( AEKIN-AE74G(IBINLO))/
- & (AE74G(IBINHI)-AE74G(IBINLO))*
- & (AWT74G(IBINHI)-AWT74G(IBINLO))+AWT74G(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.8) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AE74E(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AE74E(NBIN1E)) THEN
- FLUSCW = WT74E(NBIN1E)
- ELSE
- XBIN = (AEKIN-AE74E(1))/(AE74E(NBIN1E)-AE74E(1))
- & *DBLE(NBIN1E-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AE74E(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AE74E(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1E) THEN
- FLUSCW = WT74E(NBIN1E)
- ELSE
- FLUSCW =( AEKIN-AE74E(IBINLO))/
- & (AE74E(IBINHI)-AE74E(IBINLO))*
- & (AWT74E(IBINHI)-AWT74E(IBINLO))+AWT74E(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ENDIF
-*
-* Effective dose (Pelliccioni radiation weighting factors Wr)
-* Anterior-Posterior irradiation
- ELSEIF ((CSET(1:5).EQ.'EAPMP').OR.(CSET(1:5).EQ.'eapmp')
- & .OR.(ITEST.EQ.4)) THEN
- IF (LFIRST(4).AND.(ITEST.EQ.0)) THEN
- WRITE(LUNOUT,1000)
- WRITE(LUNOUT,1003)
- WRITE(LUNOUT,1004)
- LFIRST(4) = .FALSE.
- ENDIF
- IF (IPART.EQ.1) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINN(1)) THEN
- FLUSCW = APPLN(1)
- ELSEIF (AEKIN.GT.AEBINN(NBIN1N)) THEN
- FLUSCW = APPLN(NBIN1N)
- ELSEIF ((AEKIN.GE.AEBINN(47)).AND.(AEKIN.LE.AEBINN(NBIN1N)))
- & THEN
- XBIN = (AEKIN-AEBINN(47))/(AEBINN(NBIN1N)-AEBINN(47))
- & *DBLE(NBIN1N-47)+47.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINN(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINN(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1N) THEN
- FLUSCW = APPLN(NBIN1N)
- ELSE
- FLUSCW =( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (AAPPLN(IBINHI)-AAPPLN(IBINLO))+AAPPLN(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSE
- IBINLO = 1
- IBINHI = 47
- 40 CONTINUE
- IF ((IBINHI-IBINLO).EQ.1) GOTO 41
- KK = (IBINHI+IBINLO)/2
- IF (AEKIN.LE.AEBINN(KK)) THEN
- IBINHI = KK
- ELSE
- IBINLO = KK
- ENDIF
- GOTO 40
- 41 CONTINUE
- FLUSCW = ( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (AAPPLN(IBINHI)-AAPPLN(IBINLO))+AAPPLN(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSEIF (IPART.EQ.2) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEPLP(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEPLP(NBIN1P)) THEN
- FLUSCW = APPLP(NBIN1P)
- ELSE
- XBIN = (AEKIN-AEPLP(1))/(AEPLP(NBIN1P)-AEPLP(1))
- & *DBLE(NBIN1P-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEPLP(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEPLP(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1P) THEN
- FLUSCW = APPLP(NBIN1P)
- ELSE
- FLUSCW =( AEKIN-AEPLP(IBINLO))/
- & (AEPLP(IBINHI)-AEPLP(IBINLO))*
- & (AAPPLP(IBINHI)-AAPPLP(IBINLO))+AAPPLP(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.3) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = APPLI(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = APPLI(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (AAPPLI(IBINHI)-AAPPLI(IBINLO))+AAPPLI(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.4) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = APPLJ(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = APPLJ(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (AAPPLJ(IBINHI)-AAPPLJ(IBINLO))+AAPPLJ(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.5) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINM(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINM(NBIN1M)) THEN
- FLUSCW = APPLM(NBIN1M)
- ELSE
- XBIN = (AEKIN-AEBINM(1))/(AEBINM(NBIN1M)-AEBINM(1))
- & *DBLE(NBIN1M-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINM(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINM(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1M) THEN
- FLUSCW = APPLM(NBIN1M)
- ELSE
- FLUSCW =( AEKIN-AEBINM(IBINLO))/
- & (AEBINM(IBINHI)-AEBINM(IBINLO))*
- & (AAPPLM(IBINHI)-AAPPLM(IBINLO))+AAPPLM(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ENDIF
-*
-*
-* Effective dose (Pelliccioni radiation weighting factors Wr)
-* Rotational irradiation geometry
- ELSEIF ((CSET(1:5).EQ.'ERTMP').OR.(CSET(1:5).EQ.'ertmp')
- & .OR.(ITEST.EQ.5)) THEN
- IF (LFIRST(5).AND.(ITEST.EQ.0)) THEN
- WRITE(LUNOUT,1000)
- WRITE(LUNOUT,1003)
- WRITE(LUNOUT,1005)
- LFIRST(5) = .FALSE.
- ENDIF
- IF (IPART.EQ.1) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINN(1)) THEN
- FLUSCW = RTPLN(1)
- ELSEIF (AEKIN.GT.AEBINN(NBIN1N)) THEN
- FLUSCW = RTPLN(NBIN1N)
- ELSEIF ((AEKIN.GE.AEBINN(47)).AND.(AEKIN.LE.AEBINN(NBIN1N)))
- & THEN
- XBIN = (AEKIN-AEBINN(47))/(AEBINN(NBIN1N)-AEBINN(47))
- & *DBLE(NBIN1N-47)+47.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINN(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINN(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1N) THEN
- FLUSCW = RTPLN(NBIN1N)
- ELSE
- FLUSCW =( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (ARTPLN(IBINHI)-ARTPLN(IBINLO))+ARTPLN(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSE
- IBINLO = 1
- IBINHI = 47
- 50 CONTINUE
- IF ((IBINHI-IBINLO).EQ.1) GOTO 51
- KK = (IBINHI+IBINLO)/2
- IF (AEKIN.LE.AEBINN(KK)) THEN
- IBINHI = KK
- ELSE
- IBINLO = KK
- ENDIF
- GOTO 50
- 51 CONTINUE
- FLUSCW = ( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (ARTPLN(IBINHI)-ARTPLN(IBINLO))+ARTPLN(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSEIF (IPART.EQ.2) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEPLP(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEPLP(NBIN1P)) THEN
- FLUSCW = RTPLP(NBIN1P)
- ELSE
- XBIN = (AEKIN-AEPLP(1))/(AEPLP(NBIN1P)-AEPLP(1))
- & *DBLE(NBIN1P-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEPLP(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEPLP(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1P) THEN
- FLUSCW = RTPLP(NBIN1P)
- ELSE
- FLUSCW =( AEKIN-AEPLP(IBINLO))/
- & (AEPLP(IBINHI)-AEPLP(IBINLO))*
- & (ARTPLP(IBINHI)-ARTPLP(IBINLO))+ARTPLP(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.3) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = RTPLI(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = RTPLI(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (ARTPLI(IBINHI)-ARTPLI(IBINLO))+ARTPLI(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.4) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = RTPLJ(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = RTPLJ(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (ARTPLJ(IBINHI)-ARTPLJ(IBINLO))+ARTPLJ(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.5) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINM(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINM(NBIN1M)) THEN
- FLUSCW = RTPLM(NBIN1M)
- ELSE
- XBIN = (AEKIN-AEBINM(1))/(AEBINM(NBIN1M)-AEBINM(1))
- & *DBLE(NBIN1M-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINM(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINM(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1M) THEN
- FLUSCW = RTPLM(NBIN1M)
- ELSE
- FLUSCW =( AEKIN-AEBINM(IBINLO))/
- & (AEBINM(IBINHI)-AEBINM(IBINLO))*
- & (ARTPLM(IBINHI)-ARTPLM(IBINLO))+ARTPLM(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ENDIF
-*
-*
-* Effective dose (Pelliccioni radiation weighting factors Wr)
-* Worst possible geometry for the irradiation
- ELSEIF ((CSET(1:5).EQ.'EWTMP').OR.(CSET(1:5).EQ.'ewtmp')
- & .OR.(ITEST.EQ.6)) THEN
- IF (LFIRST(6).AND.(ITEST.EQ.0)) THEN
- WRITE(LUNOUT,1000)
- WRITE(LUNOUT,1003)
- WRITE(LUNOUT,1006)
- LFIRST(6) = .FALSE.
- ENDIF
- IF (IPART.EQ.1) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINN(1)) THEN
- FLUSCW = WTPLN(1)
- ELSEIF (AEKIN.GT.AEBINN(NBIN1N)) THEN
- FLUSCW = WTPLN(NBIN1N)
- ELSEIF ((AEKIN.GE.AEBINN(47)).AND.(AEKIN.LE.AEBINN(NBIN1N)))
- & THEN
- XBIN = (AEKIN-AEBINN(47))/(AEBINN(NBIN1N)-AEBINN(47))
- & *DBLE(NBIN1N-47)+47.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINN(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINN(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1N) THEN
- FLUSCW = WTPLN(NBIN1N)
- ELSE
- FLUSCW =( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (AWTPLN(IBINHI)-AWTPLN(IBINLO))+AWTPLN(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSE
- IBINLO = 1
- IBINHI = 47
- 60 CONTINUE
- IF ((IBINHI-IBINLO).EQ.1) GOTO 61
- KK = (IBINHI+IBINLO)/2
- IF (AEKIN.LE.AEBINN(KK)) THEN
- IBINHI = KK
- ELSE
- IBINLO = KK
- ENDIF
- GOTO 60
- 61 CONTINUE
- FLUSCW = ( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (AWTPLN(IBINHI)-AWTPLN(IBINLO))+AWTPLN(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSEIF (IPART.EQ.2) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEPLP(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEPLP(NBIN1P)) THEN
- FLUSCW = WTPLP(NBIN1P)
- ELSE
- XBIN = (AEKIN-AEPLP(1))/(AEPLP(NBIN1P)-AEPLP(1))
- & *DBLE(NBIN1P-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEPLP(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEPLP(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1P) THEN
- FLUSCW = WTPLP(NBIN1P)
- ELSE
- FLUSCW =( AEKIN-AEPLP(IBINLO))/
- & (AEPLP(IBINHI)-AEPLP(IBINLO))*
- & (AWTPLP(IBINHI)-AWTPLP(IBINLO))+AWTPLP(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.3) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = WTPLI(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = WTPLI(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (AWTPLI(IBINHI)-AWTPLI(IBINLO))+AWTPLI(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.4) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = WTPLJ(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = WTPLJ(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (AWTPLJ(IBINHI)-AWTPLJ(IBINLO))+AWTPLJ(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.5) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINM(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINM(NBIN1M)) THEN
- FLUSCW = WTPLM(NBIN1M)
- ELSE
- XBIN = (AEKIN-AEBINM(1))/(AEBINM(NBIN1M)-AEBINM(1))
- & *DBLE(NBIN1M-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINM(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINM(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1M) THEN
- FLUSCW = WTPLM(NBIN1M)
- ELSE
- FLUSCW =( AEKIN-AEBINM(IBINLO))/
- & (AEBINM(IBINHI)-AEBINM(IBINLO))*
- & (AWTPLM(IBINHI)-AWTPLM(IBINLO))+AWTPLM(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ENDIF
-*
-*
-* Ambient dose equivalent (from ICRP74 and Pelliccioni data)
- ELSEIF ((CSET(1:5).EQ.'AMB74').OR.(CSET(1:5).EQ.'amb74')
- & .OR.(ITEST.EQ.7)) THEN
- IF (LFIRST(7).AND.(ITEST.EQ.0)) THEN
- WRITE(LUNOUT,1001)
- WRITE(LUNOUT,1008)
- LFIRST(7) = .FALSE.
- ENDIF
- IF (IPART.EQ.1) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINN(1)) THEN
- FLUSCW = AMBN(1)
- ELSEIF (AEKIN.GT.AEBINN(NBIN1N)) THEN
- FLUSCW = AMBN(NBIN1N)
- ELSEIF ((AEKIN.GE.AEBINN(47)).AND.(AEKIN.LE.AEBINN(NBIN1N)))
- & THEN
- XBIN = (AEKIN-AEBINN(47))/(AEBINN(NBIN1N)-AEBINN(47))
- & *DBLE(NBIN1N-47)+47.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINN(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINN(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1N) THEN
- FLUSCW = AMBN(NBIN1N)
- ELSE
- FLUSCW = ( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (AAMBN(IBINHI)-AAMBN(IBINLO))+AAMBN(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSE
- IBINLO = 1
- IBINHI = 47
- 70 CONTINUE
- IF ((IBINHI-IBINLO).EQ.1) GOTO 71
- KK = (IBINHI+IBINLO)/2
- IF (AEKIN.LE.AEBINN(KK)) THEN
- IBINHI = KK
- ELSE
- IBINLO = KK
- ENDIF
- GOTO 70
- 71 CONTINUE
- FLUSCW = ( AEKIN-AEBINN(IBINLO))/
- & (AEBINN(IBINHI)-AEBINN(IBINLO))*
- & (AAMBN(IBINHI)-AAMBN(IBINLO))+AAMBN(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ELSEIF (IPART.EQ.2) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEAMBP(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEAMBP(NBIN2P)) THEN
- FLUSCW = AMBP(NBIN2P)
- ELSE
- XBIN = (AEKIN-AEAMBP(1))/(AEAMBP(NBIN2P)-AEAMBP(1))
- & *DBLE(NBIN2P-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEAMBP(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEAMBP(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN2P) THEN
- FLUSCW = AMBP(NBIN2P)
- ELSE
- FLUSCW = ( AEKIN-AEAMBP(IBINLO))/
- & (AEAMBP(IBINHI)-AEAMBP(IBINLO))*
- & (AAMBP(IBINHI)-AAMBP(IBINLO))+AAMBP(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.3) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = AMBI(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = AMBI(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (AAMBI(IBINHI)-AAMBI(IBINLO))+AAMBI(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.4) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINI(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINI(NBIN1I)) THEN
- FLUSCW = AMBJ(NBIN1I)
- ELSE
- XBIN = (AEKIN-AEBINI(1))/(AEBINI(NBIN1I)-AEBINI(1))
- & *DBLE(NBIN1I-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINI(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINI(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1I) THEN
- FLUSCW = AMBJ(NBIN1I)
- ELSE
- FLUSCW =( AEKIN-AEBINI(IBINLO))/
- & (AEBINI(IBINHI)-AEBINI(IBINLO))*
- & (AAMBJ(IBINHI)-AAMBJ(IBINLO))+AAMBJ(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.5) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEBINM(1)) THEN
- RETURN
- ELSEIF (AEKIN.GT.AEBINM(NBIN1M)) THEN
- FLUSCW = AMBM(NBIN1M)
- ELSE
- XBIN = (AEKIN-AEBINM(1))/(AEBINM(NBIN1M)-AEBINM(1))
- & *DBLE(NBIN1M-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEBINM(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEBINM(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1M) THEN
- FLUSCW = AMBM(NBIN1M)
- ELSE
- FLUSCW =( AEKIN-AEBINM(IBINLO))/
- & (AEBINM(IBINHI)-AEBINM(IBINLO))*
- & (AAMBM(IBINHI)-AAMBM(IBINLO))+AAMBM(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.7) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AE74G(1)) THEN
- FLUSCW = AMBG(1)
- ELSEIF (AEKIN.GT.AE74G(NBIN1G)) THEN
- FLUSCW = AMBG(NBIN1G)
- ELSE
- XBIN = (AEKIN-AE74G(1))/(AE74G(NBIN1G)-AE74G(1))
- & *DBLE(NBIN1G-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AE74G(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AE74G(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN1G) THEN
- FLUSCW = AMBG(NBIN1G)
- ELSE
- FLUSCW =( AEKIN-AE74G(IBINLO))/
- & (AE74G(IBINHI)-AE74G(IBINLO))*
- & (AAMBG(IBINHI)-AAMBG(IBINLO))+AAMBG(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSEIF (IPART.EQ.8) THEN
- AEKIN = LOG10(EKIN)
- IF (AEKIN.LT.AEAMBE(1)) THEN
- FLUSCW = AMBE(1)
- ELSEIF (AEKIN.GT.AEAMBE(NBIN2E)) THEN
- FLUSCW = AMBE(NBIN2E)
- ELSE
- XBIN = (AEKIN-AEAMBE(1))/(AEAMBE(NBIN2E)-AEAMBE(1))
- & *DBLE(NBIN2E-1)+1.0D0
- IBINLO = INT(XBIN)
- IBINHI = IBINLO+1
- IF (AEKIN.LT.AEAMBE(IBINLO)) THEN
- IBINLO = IBINLO-1
- IBINHI = IBINLO+1
- ELSEIF (AEKIN.GT.AEAMBE(IBINHI)) THEN
- IBINLO = IBINLO+1
- IBINHI = IBINLO+1
- ENDIF
- IF (IBINHI.GT.NBIN2E) THEN
- FLUSCW = AMBE(NBIN2E)
- ELSE
- FLUSCW =( AEKIN-AEAMBE(IBINLO))/
- & (AEAMBE(IBINHI)-AEAMBE(IBINLO))*
- & (AAMBE(IBINHI)-AAMBE(IBINLO))+AAMBE(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ENDIF
-*
-*
-* Ambient dose equivalent (old GRS conversion factors)
- ELSEIF ((CSET(1:5).EQ.'AMBGS').OR.(CSET(1:5).EQ.'ambgs')
- & .OR.(ITEST.EQ.8)) THEN
- IF (LFIRST(8).AND.(ITEST.EQ.0)) THEN
- WRITE(LUNOUT,1001)
- WRITE(LUNOUT,1007)
- LFIRST(8) = .FALSE.
- ENDIF
- AEKIN = LOG10(EKIN)
- IF (IPART.EQ.1) THEN
- XDUM = (11.0D0+AEKIN)*10.0D0
- KENERG = INT(XDUM)+1
- IF ((KENERG.LT.1).OR.(KENERG.GT.NBIN2N)) RETURN
- FLUSCW = H10N(KENERG)
- ELSEIF (IPART.EQ.2) THEN
- XDUM = (11.0D0+AEKIN)*10.0D0
- KENERG = INT(XDUM)+1
- IF ((KENERG.LT.1).OR.(KENERG.GT.NBIN2N)) RETURN
- FLUSCW = H10PR(KENERG)
- ELSEIF ((IPART.EQ.3).OR.(IPART.EQ.4)) THEN
- XDUM = (11.0D0+AEKIN)*10.0D0
- KENERG = INT(XDUM)+1
- IF ((KENERG.LT.1).OR.(KENERG.GT.NBIN2N)) RETURN
- FLUSCW = H10PI(KENERG)
- ELSEIF (IPART.EQ.5) THEN
- IF (AEKIN.LT.AEAMBM(1)) THEN
- FLUSCW = H10MU(1)
- ELSEIF (AEKIN.GT.AEAMBM(NBIN2M)) THEN
- FLUSCW = H10MU(NBIN2M)
- ELSE
- IBINLO = 1
- IBINHI = NBIN2M
- 80 CONTINUE
- IF ((IBINHI-IBINLO).EQ.1) GOTO 81
- KK = (IBINHI+IBINLO)/2
- IF (AEKIN.LE.AEAMBM(KK)) THEN
- IBINHI = KK
- ELSE
- IBINLO = KK
- ENDIF
- GOTO 80
- 81 CONTINUE
- FLUSCW = ( AEKIN-AEAMBM(IBINLO))/
- & (AEAMBM(IBINHI)-AEAMBM(IBINLO))*
- & (AH10MU(IBINHI)-AH10MU(IBINLO))+AH10MU(IBINLO)
- FLUSCW = 10.0D0**FLUSCW
- ENDIF
- ENDIF
- ELSE
-* this point should never be reached since the check for a valid
-* sdum has already been done above
- FLUSCW = 0.0D0
- ENDIF
-
- LSCZER = .FALSE.
-
- RETURN
-
- 1000 FORMAT(1X,'FLUSCW: direct conversion of fluence to effective ',
- & 'dose requested with')
- 1001 FORMAT(1X,'FLUSCW: direct conversion of fluence to ambient ',
- & 'dose eq. requested with')
- 1002 FORMAT(12X,'- ICRP radiation weighting factors Wr')
- 1003 FORMAT(12X,'- Pelliccioni radiation weighting factors Wr')
- 1004 FORMAT(12X,'- anterior-posterior irradiation')
- 1005 FORMAT(12X,'- rotational irradiation geometry')
- 1006 FORMAT(12X,'- worst possible geometry for the irradiation')
- 1007 FORMAT(12X,'- GRS conversion factors')
- 1008 FORMAT(12X,'- ICRP74 and Pelliccioni conversion factors')
-
- END
+++ /dev/null
-# Sources
-SRCS:= TFluka.cxx TFlukaMCGeometry.cxx TFlukaCerenkov.cxx \
- TFlukaConfigOption.cxx TFlukaScoringOption.cxx TFlukaIon.cxx \
- magfld.cxx source.cxx mgdraw.cxx bxdraw.cxx eedraw.cxx \
- endraw.cxx sodraw.cxx usdraw.cxx stupre.cxx stuprf.cxx \
- abscff.cxx dffcff.cxx queffc.cxx rflctv.cxx rfrndx.cxx
-
-# Headers
-HDRS:= TFluka.h TFlukaMCGeometry.h TFlukaCerenkov.h TFlukaConfigOption.h \
- TFlukaScoringOption.h TFlukaIon.h
-
-FSRCS:= FLUKA_input.f crnkvp.f
-
-ifeq ($(FLUSCW),1MEVN)
- FSRCS+=fluscw_1mevn.f
-endif
-
-ifeq ($(FLUSCW),DEQ99C)
- FSRCS+=fluscw_deq99c.f
-endif
-
-ifeq ($(COMSCW),DEFAULT)
- SRCS+=comscw.cxx
-endif
-
-ifeq ($(COMSCW),ACTIVITY)
- FSRCS+=comscw_activity.f
-endif
-
-
-# ROOT Dictionary
-DHDR:= TFlukaLinkDef.h
-
-# Extra includes and libraries
-EINCLUDE:= $(FLUPRO)/flukapro $(FLUPRO)/emfadd $(FLUPRO)/flukaadd
-ELIBSDIR:= $(FLUPRO)
-ELIBS := flukahp
-
-ifeq (g95,$(findstring g95,$(ROOTBUILD)))
-ELIBS += f95
-ELIBSDIR += $(shell find /sw/lib -name libf95.a | xargs dirname)
-PACKDYFLAGS := $(DYFLAGS) \
- -Wl,-u,_bdandi \
- -Wl,-u,_bdevap \
- -Wl,-u,_bdhdr1 \
- -Wl,-u,_bdhdr2 \
- -Wl,-u,_bdhdr3 \
- -Wl,-u,_bdinpt \
- -Wl,-u,_bdmuls \
- -Wl,-u,_bdnopt \
- -Wl,-u,_bdpart \
- -Wl,-u,_bdphfl \
- -Wl,-u,_bdprdc \
- -Wl,-u,_bdpwxs \
- -Wl,-u,_bdrndm \
- -Wl,-u,_bdsqzi \
- -Wl,-u,_bdtrns \
- -Wl,-u,_countr \
- -Wl,-u,_elproi \
- -Wl,-u,_hadini \
- -Wl,-u,_bdgtfr \
- -Wl,-u,_bdpree
-
-endif
-
-
+++ /dev/null
-#include "TVirtualMCApplication.h"
-#include "TFluka.h"
-#include "Fdblprc.h" //(DBLPRC) fluka common
-//
-// #include "TCallf77.h"
-
-#ifndef WIN32
-#define magfld magfld_
-#define type_of_call
-#else
-#define magfld MAGFLD
-#define type_of_call _stdcall
-#endif
-
-extern "C" void type_of_call magfld(double& x, double& y, double& z,
- double& btx, double& bty, double& btz, double& b,
- int& /*nreg*/,int& idisc)
-{
-
-/*
-*----------------------------------------------------------------------*
-* *
-* *
-* Input variables: *
-* x,y,z = current position *
-* nreg = current region *
-* Output variables: *
-* btx,bty,btz = cosines of the magn. field vector *
-* B = magnetic field intensity (Tesla) *
-* idisc = set to 1 if the particle has to be discarded *
-* *
-*----------------------------------------------------------------------*
-*/
-
-
- Double_t bc[3];
- Double_t xc[3];
-
- xc[0] = x;
- xc[1] = y;
- xc[2] = z;
-
-
-
-//
-// Check if stopping has been required by user
-//
- idisc = 0;
- TFluka* fluka = (TFluka*) gMC;
- if (fluka->GetStoppingCondition()) {
- fluka->ResetStoppingCondition();
- idisc = 1;
- }
-
- (TVirtualMCApplication::Instance())->Field(xc, bc);
-
- b = sqrt(bc[0] * bc[0] + bc[1] * bc[1] + bc[2] * bc[2]);
- if (b) {
- btx = bc[0]/b;
- bty = bc[1]/b;
- Double_t btt = btx * btx + bty * bty;
- if (btt >= (Double_t) 1.) {
- btx /= TMath::Sqrt(btt);
- bty /= TMath::Sqrt(btt);
- b /= TMath::Sqrt(btt);
- btz = (Double_t) 0.;
- } else {
- btz = TMath::Sign(TMath::Sqrt((Double_t) 1. - btt), bc[2]);
- }
- } else {
- btx = 0.;
- bty = 0.;
- btz = 1.;
- }
-
- // from kG to T
- b /= (Double_t) 10.;
-}
+++ /dev/null
-#include <Riostream.h>
-#include "TVirtualMCApplication.h"
-#include "TVirtualMCStack.h"
-#include "TFluka.h"
-#include "TFlukaCodes.h"
-
-// Fluka includes
-#include "Fdimpar.h" //(DIMPAR)
-#include "Fdblprc.h" //(DBLPRC)
-#include "Ftrackr.h" //(TRACKR)
-#include "Fopphst.h" //(OPPHST)
-#include "Fflkstk.h" //(FLKSTK)
-#include "Fltclcm.h" //(LTCLCM)
-#include "Fpaprop.h" //(PAPROP)
-#include "Falldlt.h" //(ALLDLT)
-#include "Fdpdxcm.h" //(DPDXCM)
-#include "Fflkmat.h" //(FLKMAT)
-
-#include "TGeoManager.h"
-
-#ifndef WIN32
-# define mgdraw mgdraw_
-#else
-# define mgdraw MGDRAW
-#endif
-
-extern "C" {
-void mgdraw(Int_t& icode, Int_t& mreg)
-{
- TFluka* fluka = (TFluka*) gMC;
- if (mreg == fluka->GetDummyRegion()) return;
-//
-// Make sure that stack has currrent track Id
-//
- Int_t trackId = -1;
- TVirtualMCStack* cppstack = fluka->GetStack();
-
- if (TRACKR.jtrack == -1) {
- trackId = OPPHST.louopp[OPPHST.lstopp];
- if (trackId == 0) {
- trackId = FLKSTK.ispark[FLKSTK.npflka][mkbmx2-1];
- }
- } else {
- trackId = TRACKR.ispusr[mkbmx2-1];
- }
-
- Int_t verbosityLevel = fluka->GetVerbosityLevel();
- if (TRACKR.jtrack < -6) {
- // from -7 to -12 = "heavy" fragment
- // assing parent id
- // id < -6 was skipped in stuprf => if (kpart < -6) return;
- if (verbosityLevel >= 3) {
- cout << "mgdraw: (heavy fragment) jtrack < -6 =" << TRACKR.jtrack
- << " assign parent pdg=" << fluka->PDGFromId(TRACKR.ispusr[mkbmx2 - 3]) << endl;
- }
-// TRACKR.jtrack = TRACKR.ispusr[mkbmx2 - 3];
- }
-
- cppstack->SetCurrentTrack(trackId);
-//
-//
- Int_t mlttc = TRACKR.lt1trk; // LTCLCM.mlatm1;
- fluka->SetMreg(mreg, mlttc);
- fluka->SetIcode((FlukaProcessCode_t) icode);
- fluka->SetCaller(kMGDRAW);
-
- Int_t nodeId;
- Int_t volId = fluka->CurrentVolID(nodeId);
- Int_t crtlttc = gGeoManager->GetCurrentNodeId()+1;
-
- // check region lattice consistency (debug Ernesto)
- // *****************************************************
- if(verbosityLevel>=3 && mreg != volId && !gGeoManager->IsOutside() ) {
- cout << " mgdraw: track=" << trackId << " pdg=" << fluka->PDGFromId(TRACKR.jtrack)
- << " icode=" << icode << " gNstep=" << fluka->GetNstep() << endl
- << " fluka mreg=" << mreg << " mlttc=" << mlttc << endl
- << " TGeo volId=" << volId << " crtlttc=" << crtlttc << endl
- << " common TRACKR lt1trk=" << TRACKR.lt1trk << " lt2trk=" << TRACKR.lt2trk << endl
- << " common LTCLCM newlat=" << LTCLCM.newlat << " mlatld=" << LTCLCM.mlatld << endl
- << " mlatm1=" << LTCLCM.mlatm1 << " mltsen=" << LTCLCM.mltsen << endl
- << " mltsm1=" << LTCLCM.mltsm1 << " mlattc=" << LTCLCM.mlattc << endl;
- if( mlttc == crtlttc ) cout << " *************************************************************" << endl;
- }
- // *****************************************************
-
-
- Int_t med = FLKMAT.medium[mreg - 1]; // Medium
- Int_t msd = DPDXCM.msdpdx[med - 1]; // Iionisation model
-
- if (!TRACKR.ispusr[mkbmx2 - 2]) {
- if (verbosityLevel >= 3) {
- cout << endl << "mgdraw: energy deposition for:" << trackId
- << " icode=" << icode
- << " pdg=" << fluka->PDGFromId(TRACKR.jtrack)
- << " flukaid="<< TRACKR.jtrack
- << " mreg=" << mreg
- << " np =" << ALLDLT.nalldl
- << endl;
-
- }
-
- if (msd > 0) {
-//
-// Primary ionsiations
- Int_t nprim = ALLDLT.nalldl;
- if (nprim >= mxalld) {
- nprim = mxalld;
- Warning("mgdraw", "nprim > mxalld, nprim: %6d pdg: %6d mreg %6d p %13.3f step %13.3f\n",
- ALLDLT.nalldl,
- fluka->PDGFromId(TRACKR.jtrack),
- mreg,
- TRACKR.ptrack,
- TRACKR.ctrack);
- }
- fluka->PrimaryIonisationStepping(nprim);
- } else {
- // Single step
- (TVirtualMCApplication::Instance())->Stepping();
- fluka->SetTrackIsNew(kFALSE);
- }
-
- } else {
- //
- // Tracking is being resumed after secondary tracking
- //
- if (verbosityLevel >= 3) {
- cout << endl << "mgdraw: resuming Stepping(): " << trackId << endl;
- }
-
- fluka->SetTrackIsNew(kTRUE);
- fluka->SetCaller(kMGResumedTrack);
- (TVirtualMCApplication::Instance())->Stepping();
-
- // Reset flag and stored values
- TRACKR.ispusr[mkbmx2 - 2] = 0;
- for (Int_t i = 0; i < 9; i++) TRACKR.spausr[i] = -1.;
-
-
- if (verbosityLevel >= 3) {
- cout << endl << " !!! I am in mgdraw - first Stepping() after resume: " << icode << endl;
- cout << " Track= " << trackId << " region = " << mreg << endl;
- }
-
- fluka->SetTrackIsNew(kFALSE);
- fluka->SetCaller(kMGDRAW);
- if (msd == 0) {
- (TVirtualMCApplication::Instance())->Stepping();
- } else {
- Int_t nprim = ALLDLT.nalldl;
-// Protection against nprim > mxalld
- if (nprim >= mxalld) {
- nprim = mxalld;
- Warning("mgdraw", "nprim > mxalld, nprim: %6d pdg: %6d mreg %6d p %13.3f step %13.3f\n",
- ALLDLT.nalldl,
- fluka->PDGFromId(TRACKR.jtrack),
- mreg,
- TRACKR.ptrack,
- TRACKR.ctrack);
- }
- fluka->PrimaryIonisationStepping(nprim);
- } // primary ionisation switched on
- } // tracking resumed
-} // end of mgdraw
-} // end of extern "C"
-
+++ /dev/null
-#include "Fdimpar.h" //(DIMPAR) fluka include
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Fiounit.h" //(IOUNIT) fluka common
-#include "Fopphcm.h" //(OPPHCM) fluka common
-#include "TGeoMaterial.h"
-#include "TFlukaCerenkov.h"
-#include "TFluka.h"
-#include "TGeoManager.h"
-
-#ifndef WIN32
-# define queffc queffc_
-#else
-# define queffc QUEFFC
-#endif
-extern "C" {
- Double_t queffc(Double_t& /*wvlngt*/, Double_t& /*omgpho*/)
- {
- Double_t eff = TFlukaCerenkov::GetGlobalMaximumEfficiency();
- return (eff);
- }
-}
-
+++ /dev/null
-#include "Fdimpar.h" //(DIMPAR) fluka include
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Fiounit.h" //(IOUNIT) fluka common
-#include "TFluka.h"
-#include "TGeoMaterial.h"
-#include "TFlukaCerenkov.h"
-
-
-#ifndef WIN32
-# define rflctv rflctv_
-#else
-# define rflctv RFLCTV
-#endif
-extern "C" {
-Double_t rflctv(Double_t& wvlngt, Double_t& /*omgpho*/, Int_t& mmat)
-{
-//
-// Return reflectivity (1-r) for given photon energy and material
-//
- TFluka* fluka = (TFluka*) gMC;
- TGeoMaterial* material = (TGeoMaterial*) (fluka->GetFlukaMaterials())->At(fluka->GetMaterialIndex(mmat));
- TFlukaCerenkov* cerenkov = dynamic_cast<TFlukaCerenkov*> (material->GetCerenkovProperties());
- Double_t y = 0.;
- if (cerenkov->IsMetal()) y = (cerenkov->GetReflectivityByWaveLength(wvlngt));
- return (y);
-}
-}
+++ /dev/null
-#include "Fdimpar.h" //(DIMPAR) fluka include
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Fiounit.h" //(IOUNIT) fluka common
-#include "TFluka.h"
-#include "TGeoMaterial.h"
-#include "TFlukaCerenkov.h"
-
-#ifndef WIN32
-# define rfrndx rfrndx_
-#else
-# define rfrndx RFRNDX
-#endif
-extern "C" {
-Double_t rfrndx(Double_t& wvlngt, Double_t& /*omgpho*/, Int_t& mmat)
-{
-//
-// Return refraction index for given photon energy and material
-//
- TFluka* fluka = (TFluka*) gMC;
- TGeoMaterial* material = (TGeoMaterial*) (fluka->GetFlukaMaterials())->At(fluka->GetMaterialIndex(mmat));
- TFlukaCerenkov* cerenkov = dynamic_cast<TFlukaCerenkov*> (material->GetCerenkovProperties());
- Double_t y = (cerenkov->GetRefractionIndexByWaveLength(wvlngt));
- return (y);
-}
-}
+++ /dev/null
-#include <Riostream.h>
-#include "TVirtualMCApplication.h"
-
-#include "TFluka.h"
-#include "TFlukaCodes.h"
-
-#ifndef WIN32
-# define sodraw sodraw_
-#else
-# define sodraw SODRAW
-#endif
-extern "C" {
-void sodraw()
-{
- ((TFluka*) gMC)->SetCaller(kSODRAW);
- ((TFluka*) gMC)->SetIcode((FlukaProcessCode_t)0);
- (TVirtualMCApplication::Instance())->Stepping();
-} // end of sodraw
-} // end of extern "C"
-
+++ /dev/null
-// Fortran
-#include "TCallf77.h"
-
-// Fluka commons
-#include "Fdblprc.h" //(DBLPRC) fluka common
-#include "Fdimpar.h" //(DIMPAR) fluka parameters
-#include "Fsourcm.h" //(EPISOR) fluka common
-#include "Fflkstk.h" //(FLKSTK) fluka common
-#include "Fsumcou.h" //(SUMCOU) fluka common
-#include "Fpaprop.h" //(PAPROP) fluka common
-#include "Fltclcm.h" //(LTCLCM) fluka common
-#include "Fopphst.h" //(OPPHST) fluka common
-#include "Fioiocm.h" //(IOIOCM) fluka common
-#include "Fbeamcm.h" //(BEAMCM) fluka common
-//Virutal MC
-#include "TFluka.h"
-#include "TFlukaIon.h"
-
-#include "TVirtualMCStack.h"
-//#include "TVirtualMCApplication.h"
-
-#include "TParticle.h"
-#include "TVector3.h"
-
-//Other
-#include <Riostream.h>
-
-#ifndef WIN32
-# define source source_
-# define geocrs geocrs_
-# define georeg georeg_
-# define geohsm geohsm_
-# define soevsv soevsv_
-# define dcdion dcdion_
-# define setion setion_
-# define stisbm stisbm_
-#else
-# define source SOURCE
-# define geocrs GEOCRS
-# define georeg GEOREG
-# define geohsm GEOHSM
-# define soevsv SOEVSV
-# define dcdion DCDION
-# define setion SETION
-# define stisbm STISBM
-#endif
-extern "C" {
- //
- // Prototypes for FLUKA functions
- //
- void type_of_call geocrs(Double_t &, Double_t &, Double_t &);
- void type_of_call georeg(Double_t &, Double_t &, Double_t &,
- Int_t &, Int_t &);
- void type_of_call geohsm(Int_t &, Int_t &, Int_t &, Int_t &);
- void type_of_call soevsv();
- void type_of_call dcdion(Int_t &);
- void type_of_call setion(Int_t &);
- void type_of_call stisbm(Int_t &, Int_t &, Int_t &);
-
- /*
- *----------------------------------------------------------------------*
- * *
- * Created on 07 january 1990 by Alfredo Ferrari & Paola Sala *
- * Infn - Milan *
- * *
- * Last change on 21-jun-98 by Alfredo Ferrari *
- * *
- * C++ version on 27-sep-02 by Isidro Gonzalez *
- * *
- * This is just an example of a possible user written source routine. *
- * note that the beam card still has some meaning - in the scoring the *
- * maximum momentum used in deciding the binning is taken from the *
- * beam momentum. Other beam card parameters are obsolete. *
- * *
- *----------------------------------------------------------------------*/
-
- void source(Int_t& nomore) {
-// Get the pointer to TFluka
- TFluka* fluka = (TFluka*)gMC;
-
- Int_t verbosityLevel = fluka->GetVerbosityLevel();
- Bool_t debug = (verbosityLevel>=3)?kTRUE:kFALSE;
- if (debug) {
- cout << "==> source(" << nomore << ")" << endl;
- cout << "\t* SOURCM.lsouit = " << (SOURCM.lsouit?'T':'F') << endl;
- }
-
- static Bool_t lfirst = true;
- static Bool_t particleIsPrimary = true;
- static Bool_t lastParticleWasPrimary = true;
-
- nomore = 0;
-
-
-// Get the stack
- TVirtualMCStack* cppstack = fluka->GetStack();
-
- TParticle* particle;
- Int_t itrack = -1;
- Int_t nprim = cppstack->GetNprimary();
-// Get the next particle from the stack
- particle = cppstack->PopNextTrack(itrack);
- fluka->SetTrackIsNew(kTRUE);
- if (itrack == (nprim - 1)) lfirst = true;
-// Is this a secondary not handled by Fluka, i.e. a particle added by user action ?
- lastParticleWasPrimary = particleIsPrimary;
-
- if (itrack >= nprim) {
- particleIsPrimary = kFALSE;
- } else {
- particleIsPrimary = kTRUE;
- }
-
- if (lfirst) {
- SOURCM.tkesum = zerzer;
- lfirst = false;
- SOURCM.lussrc = true;
- } else {
-//
-// Post-track actions for primary track
-//
- if (particleIsPrimary) {
- TVirtualMCApplication::Instance()->PostTrack();
- TVirtualMCApplication::Instance()->FinishPrimary();
- if ((itrack%10)==0)
- cout << "=== TRACKING PRIMARY "<< itrack <<" ===" << endl;
- //printf("=== TRACKING PRIMARY %d ===\n", itrack);
- }
- }
-
- // Exit if itrack is negative (-1). Set lsouit to false to mark last track for this event
-
- if (itrack<0) {
- nomore = 1;
- SOURCM.lsouit = false;
- if (debug) {
- cout << "\t* SOURCM.lsouit = " << (SOURCM.lsouit?'T':'F') << endl;
- cout << "\t* No more particles. Exiting..." << endl;
- cout << "<== source(" << nomore << ")" << endl;
- }
- return;
- }
-
- //
- // Handle user event abortion
- if (fluka->EventIsStopped()) {
- printf("Event has been stopped by user !");
- fluka->SetStopEvent(kFALSE);
- nomore = 1;
- SOURCM.lsouit = false;
- return;
- }
-
- //Get some info about the particle and print it
- //
- //pdg code
- Int_t pdg = particle->GetPdgCode();
- TVector3 polarisation;
- particle->GetPolarisation(polarisation);
- if (debug) {
- cout << "\t* Particle " << itrack << " retrieved..." << endl;
- cout << "\t\t+ Name = " << particle->GetName() << endl;
- cout << "\t\t+ PDG/Fluka code = " << pdg
- << " / " << fluka->IdFromPDG(pdg) << endl;
- cout << "\t\t+ P = ("
- << particle->Px() << " , "
- << particle->Py() << " , "
- << particle->Pz() << " ) --> "
- << particle->P() << " GeV "
- << particle->Energy() << " GeV "
- << particle->GetMass() << " GeV " << endl;
- }
- /* Npflka is the stack counter: of course any time source is called it
- * must be =0
- */
- /* Cosines (tx,ty,tz)*/
- Double_t cosx = particle->Px()/particle->P();
- Double_t cosy = particle->Py()/particle->P();
- Double_t cosxy = cosx * cosx + cosy * cosy;
- Double_t cosz;
-
- if (cosxy < 1.) {
- cosz = TMath::Sqrt(oneone - cosxy);
- } else {
- cosx /= TMath::Sqrt(cosxy);
- cosy /= TMath::Sqrt(cosxy);
- cosz = 0.;
- }
-
-
-
- if (particle->Pz() < 0.) cosz = -cosz;
-
- if (pdg != 50000050 && pdg != 50000051) {
- FLKSTK.npflka++;
- Int_t ifl = fluka-> IdFromPDG(pdg);
- Int_t ionid;
-
- if (ifl == -2) {
- Int_t ia = TFlukaIon::GetA(pdg);
- Int_t iz = TFlukaIon::GetZ(pdg);
- Int_t is = TFlukaIon::GetIsomerNumber(pdg);
-
- if (is == 0) {
- IOIOCM.iproa = ia;
- IOIOCM.iproz = iz;
- BEAMCM.ijhion = iz * 1000 + ia;
- BEAMCM.ijhion = 100 * BEAMCM.ijhion + 30;
- ionid = BEAMCM.ijhion;
- dcdion(ionid);
- setion(ionid);
- FLKSTK.iloflk[FLKSTK.npflka] = ionid;
- FLKSTK.lraddc[FLKSTK.npflka] = 0;
- } else {
- BEAMCM.lrdbea = 1;
- stisbm(ia, iz, is);
- BEAMCM.ijhion = iz * 1000 + ia;
- BEAMCM.ijhion = 100 * BEAMCM.ijhion + 30;
- ionid = BEAMCM.ijhion;
- dcdion(ionid);
- setion(ionid);
- FLKSTK.iloflk[FLKSTK.npflka] = ionid;
- FLKSTK.lraddc[FLKSTK.npflka] = 1;
- }
- } else {
- FLKSTK.iloflk[FLKSTK.npflka] = ifl;
- FLKSTK.lraddc[FLKSTK.npflka] = 0;
- ionid = ifl;
- }
-
- /* Wtflk is the weight of the particle*/
- FLKSTK.wtflk[FLKSTK.npflka] = oneone;
- SUMCOU.weipri += FLKSTK.wtflk[FLKSTK.npflka];
-
- FLKSTK.loflk[FLKSTK.npflka] = 1;
-
- /* User dependent flag:*/
- FLKSTK.louse[FLKSTK.npflka] = 0;
-
- /* User dependent spare variables:*/
- Int_t ispr = 0;
- for (ispr = 0; ispr < mkbmx1; ispr++)
- FLKSTK.sparek[FLKSTK.npflka][ispr] = zerzer;
-
- /* User dependent spare flags:*/
- for (ispr = 0; ispr < mkbmx2; ispr++)
- FLKSTK.ispark[FLKSTK.npflka][ispr] = 0;
-
- /* Save the track number of the stack particle:*/
- FLKSTK.ispark[FLKSTK.npflka][mkbmx2-1] = itrack;
- FLKSTK.nparma++;
- FLKSTK.numpar[FLKSTK.npflka] = FLKSTK.nparma;
- FLKSTK.nevent[FLKSTK.npflka] = 0;
- FLKSTK.dfnear[FLKSTK.npflka] = +zerzer;
-
- /* Particle age (s)*/
- FLKSTK.agestk[FLKSTK.npflka] = +zerzer;
- FLKSTK.cmpath[FLKSTK.npflka] = +zerzer;
- FLKSTK.aknshr[FLKSTK.npflka] = -twotwo;
-
- /* Group number for "low" energy neutrons, set to 0 anyway*/
- FLKSTK.igroup[FLKSTK.npflka] = 0;
-
- /* Kinetic energy */
- Double_t p = particle->P();
-// Double_t mass = PAPROP.am[ifl + 6];
- Double_t mass = PAPROP.am[ionid + 6];
- FLKSTK.tkeflk[FLKSTK.npflka] = TMath::Sqrt( p * p + mass * mass) - mass;
- /* Particle momentum*/
- FLKSTK.pmoflk [FLKSTK.npflka] = p;
-
- FLKSTK.txflk [FLKSTK.npflka] = cosx;
- FLKSTK.tyflk [FLKSTK.npflka] = cosy;
- FLKSTK.tzflk [FLKSTK.npflka] = cosz;
-
- /* Polarization cosines:*/
- if (polarisation.Mag()) {
- Double_t cospolx = polarisation.Px() / polarisation.Mag();
- Double_t cospoly = polarisation.Py() / polarisation.Mag();
- Double_t cospolz = sqrt(oneone - cospolx * cospolx - cospoly * cospoly);
- FLKSTK.txpol [FLKSTK.npflka] = cospolx;
- FLKSTK.typol [FLKSTK.npflka] = cospoly;
- FLKSTK.tzpol [FLKSTK.npflka] = cospolz;
- }
- else {
- FLKSTK.txpol [FLKSTK.npflka] = -twotwo;
- FLKSTK.typol [FLKSTK.npflka] = +zerzer;
- FLKSTK.tzpol [FLKSTK.npflka] = +zerzer;
- }
-
- /* Particle coordinates*/
- // Vertext coordinates;
- FLKSTK.xflk [FLKSTK.npflka] = particle->Vx();
- FLKSTK.yflk [FLKSTK.npflka] = particle->Vy();
- FLKSTK.zflk [FLKSTK.npflka] = particle->Vz();
-
- /* Calculate the total kinetic energy of the primaries: don't change*/
- Int_t st_ilo = FLKSTK.iloflk[FLKSTK.npflka];
- if ( st_ilo != 0 )
- SOURCM.tkesum +=
- ((FLKSTK.tkeflk[FLKSTK.npflka] + PAPROP.amdisc[st_ilo+6])
- * FLKSTK.wtflk[FLKSTK.npflka]);
- else
- SOURCM.tkesum += (FLKSTK.tkeflk[FLKSTK.npflka] * FLKSTK.wtflk[FLKSTK.npflka]);
-
- /* Here we ask for the region number of the hitting point.
- * NRGFLK (LFLKSTK) = ...
- * The following line makes the starting region search much more
- * robust if particles are starting very close to a boundary:
- */
- geocrs( FLKSTK.txflk[FLKSTK.npflka],
- FLKSTK.tyflk[FLKSTK.npflka],
- FLKSTK.tzflk[FLKSTK.npflka] );
-
- Int_t idisc;
-
- georeg ( FLKSTK.xflk[FLKSTK.npflka],
- FLKSTK.yflk[FLKSTK.npflka],
- FLKSTK.zflk[FLKSTK.npflka],
- FLKSTK.nrgflk[FLKSTK.npflka],
- idisc);//<-- dummy return variable not used
- /* Do not change these cards:*/
- Int_t igeohsm1 = 1;
- Int_t igeohsm2 = -11;
- geohsm ( FLKSTK.nhspnt[FLKSTK.npflka], igeohsm1, igeohsm2, LTCLCM.mlattc );
- FLKSTK.nlattc[FLKSTK.npflka] = LTCLCM.mlattc;
- soevsv();
- } else {
- //
- // Next particle is optical photon
- //
- OPPHST.lstopp++;
- OPPHST.donear [OPPHST.lstopp - 1] = 0.;
-
- OPPHST.xoptph [OPPHST.lstopp - 1] = particle->Vx();
- OPPHST.yoptph [OPPHST.lstopp - 1] = particle->Vy();
- OPPHST.zoptph [OPPHST.lstopp - 1] = particle->Vz();
-
- OPPHST.txopph [OPPHST.lstopp - 1] = cosx;
- OPPHST.tyopph [OPPHST.lstopp - 1] = cosy;
- OPPHST.tzopph [OPPHST.lstopp - 1] = cosz;
-
-
- if (polarisation.Mag()) {
- Double_t cospolx = polarisation.Px() / polarisation.Mag();
- Double_t cospoly = polarisation.Py() / polarisation.Mag();
- Double_t cospolz = sqrt(oneone - cospolx * cospolx - cospoly * cospoly);
- OPPHST.txpopp [OPPHST.lstopp - 1] = cospolx;
- OPPHST.typopp [OPPHST.lstopp - 1] = cospoly;
- OPPHST.tzpopp [OPPHST.lstopp - 1] = cospolz;
- }
- else {
- OPPHST.txpopp [OPPHST.lstopp - 1] = -twotwo;
- OPPHST.typopp [OPPHST.lstopp - 1] = +zerzer;
- OPPHST.tzpopp [OPPHST.lstopp - 1] = +zerzer;
- }
-
- geocrs( OPPHST.txopph[OPPHST.lstopp - 1],
- OPPHST.tyopph[OPPHST.lstopp - 1],
- OPPHST.tzopph[OPPHST.lstopp - 1] );
-
- Int_t idisc;
-
- georeg ( OPPHST.xoptph[OPPHST.lstopp - 1],
- OPPHST.yoptph[OPPHST.lstopp - 1],
- OPPHST.zoptph[OPPHST.lstopp - 1],
- OPPHST.nregop[OPPHST.lstopp - 1],
- idisc);//<-- dummy return variable not used
-
- OPPHST.wtopph [OPPHST.lstopp - 1] = particle->GetWeight();
- OPPHST.poptph [OPPHST.lstopp - 1] = particle->P();
- OPPHST.agopph [OPPHST.lstopp - 1] = particle->T();
- OPPHST.cmpopp [OPPHST.lstopp - 1] = +zerzer;
- OPPHST.loopph [OPPHST.lstopp - 1] = 0;
- OPPHST.louopp [OPPHST.lstopp - 1] = itrack;
- OPPHST.nlatop [OPPHST.lstopp - 1] = LTCLCM.mlattc;
- }
-
-//
-// Pre-track actions at for primary tracks
-//
- if (particleIsPrimary) {
- fluka->SetCaller(kSODRAW);
- TVirtualMCApplication::Instance()->BeginPrimary();
- TVirtualMCApplication::Instance()->PreTrack();
- }
-//
- if (debug) cout << "<== source(" << nomore << ")" << endl;
- }
-}
+++ /dev/null
-#include <Riostream.h>
-#ifndef WIN32
-# define stupre stupre_
-#else
-# define stupre STUPRE
-#endif
-//
-// Fluka include
-#include "Fdimpar.h" //(DIMPAR) fluka include
-
-// Fluka commons
-#include "Fdblprc.h" //(DBLPRC) fluka common
-#include "Femfstk.h" //(EMFSTK) fluka common
-#include "Fevtflg.h" //(EVTFLG) fluka common
-#include "Fpaprop.h" //(PAPROP) fluka common
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Femfrgn.h" //(EFMRGN) fluka common
-
-//Virtual MC
-#include "TFluka.h"
-#include "TFlukaCodes.h"
-#include "TVirtualMCStack.h"
-#include "TVirtualMCApplication.h"
-#include "TParticle.h"
-#include "TVector3.h"
-
-extern "C" {
-void stupre()
-{
-//*----------------------------------------------------------------------*
-//* *
-//* SeT User PRoperties for Emf particles *
-//* *
-//*----------------------------------------------------------------------*
-// Get the pointer to the VMC
- TFluka* fluka = (TFluka*) gMC;
- static Double_t emassmev = PAPROP.am[kFLUKAelectron + 6] * 1000.;
-
- Int_t lbhabh = 0;
- if (EVTFLG.ldltry == 1) {
- if (EMFSTK.ichemf[EMFSTK.npemf-1] * EMFSTK.ichemf[EMFSTK.npemf-2] < 0) lbhabh = 1;
- }
-
-// mkbmx1 = dimension for kwb real spare array in fluka stack in DIMPAR
-// mkbmx2 = dimension for kwb int. spare array in fluka stack in DIMPAR
-// EMFSTK.espark = spare real variables available for
-// EMFSTK.iespak = spare integer variables available for
-// TRACKR.spausr = user defined spare variables for the current particle
-// TRACKR.ispusr = user defined spare flags for the current particle
-// EMFSTK.louemf = user flag
-// TRACKR.llouse = user defined flag for the current particle
-
- Int_t npnw, ispr;
- for (npnw = EMFSTK.npstrt-1; npnw <= EMFSTK.npemf-1; npnw++) {
-
- for (ispr = 0; ispr <= mkbmx1-1; ispr++)
- EMFSTK.espark[npnw][ispr] = TRACKR.spausr[ispr];
-
- for (ispr = 0; ispr <= mkbmx2-1; ispr++)
- EMFSTK.iespak[npnw][ispr] = TRACKR.ispusr[ispr];
-
- EMFSTK.louemf[npnw] = TRACKR.llouse;
- }
-
-
- Int_t verbosityLevel = fluka->GetVerbosityLevel();
- Bool_t debug = (verbosityLevel>=3)?kTRUE:kFALSE;
-
- fluka->SetTrackIsNew(kTRUE);
-
-// Get the stack produced from the generator
- TVirtualMCStack* cppstack = fluka->GetStack();
-
-// EVTFLG.ntrcks = track number
-// Increment the track number and put it into the last flag
-
- Int_t kp;
-
- for (kp = EMFSTK.npstrt - 1; kp <= EMFSTK.npemf - 1; kp++) {
-
-// Check transport cut first
- Int_t ireg = EMFSTK.iremf[kp];
- Double_t cut = (TMath::Abs(EMFSTK.ichemf[kp]) == 1) ? EMFRGN.elethr[ireg-1] : EMFRGN.phothr[ireg-1];
- Double_t e = EMFSTK.etemf[kp];
-
- if ((e < cut)
- && (
- (EMFSTK.ichemf[kp] == 0) ||
- (EMFSTK.ichemf[kp] == -1) ||
- (EMFSTK.ichemf[kp] == 1 && EMFRGN.phothr[ireg-1] > emassmev)
- )
- )
- {
- EMFSTK.iespak[kp][mkbmx2-1] = TRACKR.ispusr[mkbmx2-1];
- EMFSTK.iespak[kp][mkbmx2-2] = 0;
- EMFSTK.iespak[kp][mkbmx2-3] = TRACKR.jtrack;
- EMFSTK.irlatt[kp] = TRACKR.lt1trk;
- continue;
- }
-
-// Save the parent track number and reset it at each loop
- Int_t done = 0;
- Int_t parent = TRACKR.ispusr[mkbmx2-1];
- Int_t flukaid = 0;
-
-// Identify particle type
- if (EMFSTK.ichemf[kp] == -1) flukaid = kFLUKAelectron;
- else if (EMFSTK.ichemf[kp] == 0) flukaid = kFLUKAphoton;
- else if (EMFSTK.ichemf[kp] == 1) flukaid = kFLUKApositron;
-
-
- e *= emvgev;
- Int_t pdg = fluka->PDGFromId(flukaid);
- Double_t p = sqrt(e * e - PAPROP.am[flukaid+6] * PAPROP.am[flukaid+6]);
- Double_t px = p * EMFSTK.uemf[kp];
- Double_t py = p * EMFSTK.vemf[kp];
- Double_t pz = p * EMFSTK.wemf[kp];
- Double_t tof = EMFSTK.agemf[kp];
- Double_t polx = EMFSTK.upol[kp];
- Double_t poly = EMFSTK.vpol[kp];
- Double_t polz = EMFSTK.wpol[kp];
- Double_t vx = EMFSTK.xemf[kp];
- Double_t vy = EMFSTK.yemf[kp];
- Double_t vz = EMFSTK.zemf[kp];
- Double_t weight = EMFSTK.wtemf[kp];
-
- Int_t ntr;
- TMCProcess mech;
- Int_t is = 0;
-
-//* case of no parent left (pair, photoelectric, annihilation):
-//* all secondaries are true
- if ((EVTFLG.lpairp == 1) || (EVTFLG.lphoel == 1) ||
- (EVTFLG.lannfl == 1) || (EVTFLG.lannrs == 1)) {
-
- if (EVTFLG.lpairp == 1) mech = kPPair;
- else if (EVTFLG.lphoel == 1) mech = kPPhotoelectric;
- else mech = kPAnnihilation;
- cppstack->PushTrack(done, parent, pdg,
- px, py, pz, e, vx, vy, vz, tof,
- polx, poly, polz, mech, ntr, weight, is);
- if (debug) cout << endl << " !!! stupre (PAIR, ..) : ntr=" << ntr << " pdg " << pdg << " parent=" << parent << " energy " << e-PAPROP.am[flukaid+6] << endl;
-
- EMFSTK.iespak[kp][mkbmx2-1] = ntr;
- EMFSTK.iespak[kp][mkbmx2-2] = 0;
- } // end of lpairp, lphoel, lannfl, lannrs
-
-//* Compton: secondary is true only if charged (e+, e-)
- else if ((EVTFLG.lcmptn == 1)) {
-
- if (EMFSTK.ichemf[kp] != 0) {
- mech = kPCompton;
- cppstack->PushTrack(done, parent, pdg,
- px, py, pz, e, vx, vy, vz, tof,
- polx, poly, polz, mech, ntr, weight, is);
- if (debug) cout << endl << " !!! stupre (COMPTON) : ntr=" << ntr << " pdg " << pdg << " parent=" << parent << endl;
- EMFSTK.iespak[kp][mkbmx2-1] = ntr;
- EMFSTK.iespak[kp][mkbmx2-2] = 0;
- } else {
- fluka->SetPint(px, py, pz, e);
- }
- } // end of lcmptn
-
-//* Bremsstrahlung: true secondary only if charge = 0 (photon)
- else if ((EVTFLG.lbrmsp == 1)) {
- if (EMFSTK.ichemf[kp] == 0) {
- mech = kPBrem;
- cppstack->PushTrack(done, parent, pdg,
- px, py, pz, e, vx, vy, vz, tof,
- polx, poly, polz, mech, ntr, weight, is);
- if (debug) cout << endl << " !!! stupre (BREMS) : ntr=" << ntr << " pdg " << pdg << " parent=" << parent << endl;
- EMFSTK.iespak[kp][mkbmx2-1] = ntr;
- EMFSTK.iespak[kp][mkbmx2-2] = 0;
- } else {
- fluka->SetPint(px, py, pz, e);
- }
-
- } // end of lbrmsp
-
-//* Delta ray: If Bhabha, true secondary only if negative (electron)
- else if ((EVTFLG.ldltry == 1)) {
- if (lbhabh == 1) {
- if (EMFSTK.ichemf[kp] == -1) {
- mech = kPDeltaRay;
- cppstack->PushTrack(done, parent, pdg,
- px, py, pz, e, vx, vy, vz, tof,
- polx, poly, polz, mech, ntr, weight, is);
- EMFSTK.iespak[kp][mkbmx2-1] = ntr;
- EMFSTK.iespak[kp][mkbmx2-2] = 0;
- if (debug) cout << endl << " !!! stupre (BHABA) : ntr=" << ntr << " pdg " << pdg << " parent=" << parent << endl;
- } else {
- fluka->SetPint(px, py, pz, e);
- }
- } // lbhabh == 1
-
-//* Delta ray: Otherwise Moller: true secondary is the electron with
-//* lower energy, which has been put higher in the stack
- else if (kp == EMFSTK.npemf-1) {
- mech = kPDeltaRay;
- cppstack->PushTrack(done, parent, pdg,
- px, py, pz, e, vx, vy, vz, tof,
- polx, poly, polz, mech, ntr, weight, is);
- if (debug) cout << endl << " !!! stupre (Moller) : ntr=" << ntr << " pdg " << pdg << " parent=" << parent << endl;
- EMFSTK.iespak[kp][mkbmx2-1] = ntr;
- EMFSTK.iespak[kp][mkbmx2-2] = 0;
- } else {
- fluka->SetPint(px, py, pz, e);
- }
- } // end of ldltry
-
- } // end of loop
-} // end of stupre
-} // end of extern "C"
-
+++ /dev/null
-#include <Riostream.h>
-#include "TCallf77.h" //For the fortran calls
-#ifndef WIN32
-# define stuprf stuprf_
-# define usrdci usrdci_
-#else
-# define stuprf STUPRF
-# define usrdci USRDCI
-#endif
-//
-// Fluka include
-#include "Fdimpar.h" //(DIMPAR) fluka include
-// Fluka commons
-#include "Fdblprc.h" //(DBLPRC) fluka common
-#include "Fevtflg.h" //(EVTFLG) fluka common
-#include "Fpaprop.h" //(PAPROP) fluka common
-#include "Fflkstk.h" //(FLKSTK) fluka common
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Fgenstk.h" //(GENSTK) fluka common
-#include "Ffheavy.h" //(FHEAVY) fluka common
-
-
-//Virtual MC
-#include "TFluka.h"
-#include "TFlukaIon.h"
-#include "TVirtualMCStack.h"
-#include "TVirtualMCApplication.h"
-#include "TParticle.h"
-#include "TVector3.h"
-
-extern "C" {
-
- void type_of_call usrdci(int&, int&, int&, int&);
-
- void stuprf(Int_t& /*ij*/, Int_t& /*mreg*/,
- Double_t& xx, Double_t& yy, Double_t& zz,
- Int_t& numsec, Int_t& npprmr)
-{
-//*----------------------------------------------------------------------*
-//* *
-//* SeT User PRoperties for Fluka particles *
-//* *
-//*----------------------------------------------------------------------*
-// Get the pointer to the VMC
- TFluka* fluka = (TFluka*) gMC;
-
-// FLKSTK.npflka = stack pointer
-// FLKSTK.louse = user flag
-// TRACKR.llouse = user defined flag for the current particle
-
- FLKSTK.louse[FLKSTK.npflka] = TRACKR.llouse;
-
-// mkbmx1 = dimension for kwb real spare array in fluka stack in DIMPAR
-// mkbmx2 = dimension for kwb int. spare array in fluka stack in DIMPAR
-// FLKSTK.sparek = spare real variables available for k.w.burn
-// FLKSTK.ispark = spare integer variables available for k.w.burn
-// TRACKR.spausr = user defined spare variables for the current particle
-// TRACKR.ispusr = user defined spare flags for the current particle
- Int_t ispr;
- if (numsec <= npprmr) {
- for (ispr = 0; ispr <= mkbmx1 - 1; ispr++) {
- FLKSTK.sparek[FLKSTK.npflka][ispr] = TRACKR.spausr[ispr];
- }
- for (ispr = 0; ispr <= mkbmx2 - 1; ispr++) {
- FLKSTK.ispark[FLKSTK.npflka][ispr] = TRACKR.ispusr[ispr];
- }
- }
-
- // save parent info
- FLKSTK.ispark[FLKSTK.npflka][mkbmx2 - 3] = TRACKR.jtrack; // fluka particle id
- FLKSTK.ispark[FLKSTK.npflka][mkbmx2 - 4] = TRACKR.ispusr[mkbmx2 - 1]; // current track number
- FLKSTK.ispark[FLKSTK.npflka][mkbmx2 - 5] = npprmr; // flag npprmr>0
-
-
- Int_t verbosityLevel = fluka->GetVerbosityLevel();
- Bool_t debug = (verbosityLevel>=3)? kTRUE:kFALSE;
-
- fluka->SetTrackIsNew(kTRUE);
-// TVirtualMC* fluka = TFluka::GetMC();
-// Get the stack produced from the generator
- TVirtualMCStack* cppstack = fluka->GetStack();
-
-// EVTFLG.ntrcks = track number
-// Increment the track number and put it into the last flag
-// was numsec -1
-// clarify with Alberto
-
-// npprmr > 0, the secondary being loaded is actually still the interacting
-// particle (it can happen in some biasing situations)
-
- if (numsec > npprmr) {
-// Now call the PushTrack(...)
- Int_t done = 0;
-
- Int_t parent = TRACKR.ispusr[mkbmx2-1];
- Int_t kpart = GENSTK.kpart[numsec-1];
- Int_t pdg;
- Int_t a = 1;
- Int_t z = 1;
- Int_t ism = 0;
- if (kpart < -6) {
-// kpart = -kpart;
-// z = kpart / 100000;
-// a = kpart - z * 100000;
-// a /= 100;
- usrdci(kpart, a, z, ism);
- pdg = TFlukaIon::GetIonPdg(z, a);
- TFlukaIon::AddIon(a, z);
- } else {
- pdg = fluka->PDGFromId(kpart);
- }
-
- Double_t px = GENSTK.plr[numsec-1] * GENSTK.cxr[numsec-1];
- Double_t py = GENSTK.plr[numsec-1] * GENSTK.cyr[numsec-1];
- Double_t pz = GENSTK.plr[numsec-1] * GENSTK.czr[numsec-1];
- Double_t e;
-
- if (a == 1) {
- e = GENSTK.tki[numsec-1] + PAPROP.am[GENSTK.kpart[numsec-1]+6];
- } else {
- e = GENSTK.tki[numsec-1] + Double_t(a) * 0.93149 + 8.071e-3;
- }
-
-
- Double_t vx = xx;
- Double_t vy = yy;
- Double_t vz = zz;
-
- Double_t tof = TRACKR.atrack;
- Double_t polx = GENSTK.cxrpol[numsec-1];
- Double_t poly = GENSTK.cyrpol[numsec-1];
- Double_t polz = GENSTK.czrpol[numsec-1];
-
- TMCProcess mech = kPHadronic;
- if (EVTFLG.ldecay == 1) {
- mech = kPDecay;
- if (debug) cout << endl << "Decay" << endl;
- FLKSTK.nlattc[FLKSTK.npflka] = TRACKR.lt1trk;
- } else if (EVTFLG.ldltry == 1) {
- mech = kPDeltaRay;
- if( fluka->GetIcode() == kKASHEA ) {
- // For all interactions secondaries are put on GENSTK common (kp=1,np)
- // but for KASHEA delta ray generation where only the secondary elec-
- // tron is present and stacked on FLKSTK common for kp=lstack
- pdg = fluka->PDGFromId( FLKSTK.iloflk[FLKSTK.npflka] );
- px = FLKSTK.pmoflk[FLKSTK.npflka] * FLKSTK.txflk[FLKSTK.npflka];
- py = FLKSTK.pmoflk[FLKSTK.npflka] * FLKSTK.tyflk[FLKSTK.npflka];
- pz = FLKSTK.pmoflk[FLKSTK.npflka] * FLKSTK.tzflk[FLKSTK.npflka];
- e = FLKSTK.tkeflk[FLKSTK.npflka] + PAPROP.am[FLKSTK.iloflk[FLKSTK.npflka]+6];
- polx = FLKSTK.txpol[FLKSTK.npflka];
- poly = FLKSTK.typol[FLKSTK.npflka];
- polz = FLKSTK.tzpol[FLKSTK.npflka];
- if (debug) cout << endl << "Delta Ray from KASHEA...." << " pdg from FLKSTK=" << pdg << endl;
- } else {
- if (debug) cout << endl << "Delta Ray" << endl;
- }
- } else if (EVTFLG.lpairp == 1) {
- mech = kPPair;
- if (debug) cout << endl << "Pair Production" << endl;
- } else if (EVTFLG.lbrmsp == 1) {
- mech = kPBrem;
- if (debug) cout << endl << "Bremsstrahlung" << endl;
- }
-
- Double_t weight = GENSTK.wei[numsec-1];
- Int_t is = 0;
- Int_t ntr;
- //
- // Save particle in VMC stack
- cppstack->PushTrack(done, parent, pdg,
- px, py, pz, e,
- vx, vy, vz, tof,
- polx, poly, polz,
- mech, ntr, weight, is);
- if (debug) {
-
- cout << endl << " !!! stuprf: ntr=" << ntr << " pdg " << pdg << " parent=" << parent
- << " parent_pdg="<< fluka->PDGFromId(TRACKR.jtrack) << " numsec "
- << numsec << " npprmr " << npprmr << " icode=" << fluka->GetIcode()
- << "kin. energy [keV] = " << GENSTK.tki[numsec-1] * 1.e6 << endl << endl;
-
- }
-
-
-//
-// Save current track number
- FLKSTK.ispark[FLKSTK.npflka][mkbmx2-1] = ntr;
- FLKSTK.ispark[FLKSTK.npflka][mkbmx2-2] = 0;
- } // end of if (numsec > npprmr)
-// else {
-// if(debug) {
-// cout << endl << " !!! stuprf: skipping pushtrack track=" << TRACKR.ispusr[mkbmx2-1]
-// << " pdg " << fluka->PDGFromId(TRACKR.jtrack) << " numsec=" << numsec<< " npprmr=" << npprmr
-// << " GENSTK pdg=" << fluka->PDGFromId(GENSTK.kpart[numsec-1]) << endl;
-// }
-// }
-} // end of stuprf
-
-} // end of extern "C"
-
+++ /dev/null
-#include <Riostream.h>
-#include "TVirtualMCApplication.h"
-#include "TFluka.h"
-#include "TFlukaCodes.h"
-#include <TLorentzVector.h>
-#include "Fdimpar.h" //(DIMPAR) fluka include
-#include "Ftrackr.h" //(TRACKR) fluka common
-#include "Fltclcm.h" //(LTCLCM) fluka common
-#include "Femfstk.h" //(EMFSTK) fluka common
-#include "Fflkstk.h" //(FLKSTK) fluka common
-#ifndef WIN32
-# define usdraw usdraw_
-#else
-# define usdraw USDRAW
-#endif
-
-#include "TGeoManager.h" // <- delete
-
-extern "C" {
-void usdraw(Int_t& icode, Int_t& mreg,
- Double_t& xsco, Double_t& ysco, Double_t& zsco)
-{
- TFluka *fluka = (TFluka*)gMC;
- // nothing to do if particle inside dummy region
- if (mreg == fluka->GetDummyRegion()) return;
- Int_t verbosityLevel = fluka->GetVerbosityLevel();
- Bool_t debug = (verbosityLevel >= 3)? kTRUE : kFALSE;
- fluka->SetCaller(kUSDRAW);
- fluka->SetIcode((FlukaProcessCode_t) icode);
-
-//
-// Catch paused tracks
-//
- if (icode/100 == kEMFSCO) {
- for (Int_t npnw = EMFSTK.npstrt-1; npnw <= EMFSTK.npemf-1; npnw++) {
- if (EMFSTK.iespak[npnw][mkbmx2-1] == TRACKR.ispusr[mkbmx2 - 1] ) {
- EMFSTK.iespak[npnw][mkbmx2 - 2] = 1;
-// Save properties at point where particle disappears in case this is only an interruption
- TLorentzVector p;
- gMC->TrackMomentum(p);
- EMFSTK.espark[npnw][0] = xsco; // x
- EMFSTK.espark[npnw][1] = ysco; // y
- EMFSTK.espark[npnw][2] = zsco; // z
- EMFSTK.espark[npnw][3] = gMC->TrackTime(); // t
- EMFSTK.espark[npnw][4] = p[0]; // px
- EMFSTK.espark[npnw][5] = p[1]; // py
- EMFSTK.espark[npnw][6] = p[2]; // pz
- EMFSTK.espark[npnw][7] = p[3]; // e
- EMFSTK.espark[npnw][8] = gMC->TrackLength(); // Length
- } // Track found in stack
- } // Loop over emf stack
- } // Electromagnetic process
-
- if (icode == kKASKADdray || icode == kKASKADpair || icode == kKASKADbrems) {
- TRACKR.ispusr[mkbmx2-2] = 1;
- TLorentzVector p;
- gMC->TrackMomentum(p);
- TRACKR.spausr[0] = xsco; // x
- TRACKR.spausr[1] = ysco; // y
- TRACKR.spausr[2] = zsco; // z
- TRACKR.spausr[3] = gMC->TrackTime(); // t
- TRACKR.spausr[4] = p[0]; // px
- TRACKR.spausr[5] = p[1]; // py
- TRACKR.spausr[6] = p[2]; // pz
- TRACKR.spausr[7] = p[3]; // e
- TRACKR.spausr[8] = gMC->TrackLength(); // Length
- }
-
- //
- //
- Int_t mlttc = TRACKR.lt1trk; //LTCLCM.mlatm1;
- fluka->SetMreg(mreg, mlttc);
- fluka->SetXsco(xsco);
- fluka->SetYsco(ysco);
- fluka->SetZsco(zsco);
-
- // check region lattice consistency (debug Ernesto)
- // *****************************************************
- Int_t nodeId;
- Int_t volId = fluka->CurrentVolID(nodeId);
- Int_t crtlttc = gGeoManager->GetCurrentNodeId()+1;
- if(verbosityLevel>=3 && mreg != volId && !gGeoManager->IsOutside() ) {
- cout << " usdraw: track=" << TRACKR.ispusr[mkbmx2-1] << " pdg=" << fluka->PDGFromId(TRACKR.jtrack)
- << " icode=" << icode << " gNstep=" << fluka->GetNstep() << endl
- << " fluka mreg=" << mreg << " mlttc=" << mlttc << endl
- << " TGeo volId=" << volId << " crtlttc=" << crtlttc << endl
- << " common TRACKR lt1trk=" << TRACKR.lt1trk << " lt2trk=" << TRACKR.lt2trk << endl
- << " common LTCLCM newlat=" << LTCLCM.newlat << " mlatld=" << LTCLCM.mlatld << endl
- << " mlatm1=" << LTCLCM.mlatm1 << " mltsen=" << LTCLCM.mltsen << endl
- << " mltsm1=" << LTCLCM.mltsm1 << " mlattc=" << LTCLCM.mlattc << endl;
- if( mlttc == crtlttc ) cout << " *************************************************************" << endl;
- }
- // *****************************************************
-
- if (debug) printf("USDRAW: Number of track segments:%6d %6d icode=%d tof=%10.3e track=%d pdg=%d mreg=%d\n",
- TRACKR.ntrack, TRACKR.mtrack, icode, TRACKR.atrack, TRACKR.ispusr[mkbmx2-1], fluka->PDGFromId(TRACKR.jtrack), mreg );
-
- TVirtualMCStack* cppstack = fluka->GetStack();
- cppstack->SetCurrentTrack( TRACKR.ispusr[mkbmx2-1] );
-
- (TVirtualMCApplication::Instance())->Stepping();
- fluka->SetTrackIsNew(kFALSE);
-
-
-} // end of usdraw
-} // end of extern "C"
-
git://git.uio.no / u / mrichter / AliRoot.git / commitdiff