Geant4_10
dpm25eva.f
Go to the documentation of this file.
1 *
2 *=== evevap ===========================================================*
3 *
4  SUBROUTINE evevap ( WEE )
5  IMPLICIT DOUBLE PRECISION (a-h,o-z)
6  RETURN
7 *=== End of subroutine Evevap =========================================*
8  END
9 * *
10 *=== eberttp ===========================================================*
11 * *
12 C SUBROUTINE BERTTP
13 C RETURN
14 C END
15 * *
16 *=== sincini ===========================================================*
17 * *
18 C SUBROUTINE INCINI
19 C RETURN
20 *=== End of subroutine incini =========================================*
21 C END
22 *
23 
24 C eva2he ===========================================================*
25 * *
26 C SUBROUTINE EVA2HE(MO,IREJ)
27 C RETURN
28 C END
29 
30 C energy===========================================================
31 C DOUBLE PRECISION FUNCTION ENERGY(AI,AIZ)
32 C ENERGY=0.D0
33 C RETURN
34 C END
35 *=== raco =============================================================*
36 *
37  SUBROUTINE raco (WX,WY,WZ)
38 
39 C INCLUDE '(DBLPRC)'
40 *$ CREATE DBLPRC.ADD
41  IMPLICIT DOUBLE PRECISION (a-h,o-z)
42  parameter( kalgnm = 2 )
43  parameter( anglgb = 5.0d-16 )
44  parameter( anglsq = 2.5d-31 )
45  parameter( axcssv = 0.2d+16 )
46  parameter( andrfl = 1.0d-38 )
47  parameter( avrflw = 1.0d+38 )
48  parameter( ainfnt = 1.0d+30 )
49  parameter( azrzrz = 1.0d-30 )
50  parameter( einfnt = +69.07755278982137 d+00 )
51  parameter( ezrzrz = -69.07755278982137 d+00 )
52  parameter( onemns = 0.999999999999999 d+00 )
53  parameter( onepls = 1.000000000000001 d+00 )
54  parameter( csnnrm = 2.0d-15 )
55  parameter( dmxtrn = 1.0d+08 )
56  parameter( zerzer = 0.d+00 )
57  parameter( oneone = 1.d+00 )
58  parameter( twotwo = 2.d+00 )
59  parameter( thrthr = 3.d+00 )
60  parameter( foufou = 4.d+00 )
61  parameter( fivfiv = 5.d+00 )
62  parameter( sixsix = 6.d+00 )
63  parameter( sevsev = 7.d+00 )
64  parameter( eigeig = 8.d+00 )
65  parameter( aninen = 9.d+00 )
66  parameter( tenten = 10.d+00 )
67  parameter( hlfhlf = 0.5d+00 )
68  parameter( onethi = oneone / thrthr )
69  parameter( twothi = twotwo / thrthr )
70  parameter( onefou = oneone / foufou )
71  parameter( thrtwo = thrthr / twotwo )
72  parameter( pipipi = 3.141592653589793238462643383279d+00 )
73  parameter( twopip = 6.283185307179586476925286766559d+00 )
74  parameter( pip5o2 = 7.853981633974483096156608458199d+00 )
75  parameter( pipisq = 9.869604401089358618834490999876d+00 )
76  parameter( pihalf = 1.570796326794896619231321691640d+00 )
77  parameter( erfa00 = 0.886226925452758013649083741671d+00 )
78  parameter( eneper = 2.718281828459045235360287471353d+00 )
79  parameter( sqrent = 1.648721270700128146848650787814d+00 )
80  parameter( sqrsix = 2.449489742783178098197284074706d+00 )
81  parameter( sqrsev = 2.645751311064590590501615753639d+00 )
82  parameter( sqrt12 = 3.464101615137754587054892683012d+00 )
83  parameter( clight = 2.99792458 d+10 )
84  parameter( avogad = 6.0221367 d+23 )
85  parameter( boltzm = 1.380658 d-23 )
86  parameter( amelgr = 9.1093897 d-28 )
87  parameter( plckbr = 1.05457266 d-27 )
88  parameter( elccgs = 4.8032068 d-10 )
89  parameter( elcmks = 1.60217733 d-19 )
90  parameter( amugrm = 1.6605402 d-24 )
91  parameter( ammumu = 0.113428913 d+00 )
92  parameter( amprmu = 1.007276470 d+00 )
93  parameter( amnemu = 1.008664904 d+00 )
94  parameter( alpfsc = 7.2973530791728595 d-03 )
95  parameter( fscto2 = 5.3251361962113614 d-05 )
96  parameter( fscto3 = 3.8859399018437826 d-07 )
97  parameter( fscto4 = 2.8357075508200407 d-09 )
98  parameter( plabrc = 0.197327053 d+00 )
99  parameter( amelct = 0.51099906 d-03 )
100  parameter( amugev = 0.93149432 d+00 )
101  parameter( ammuon = 0.105658389 d+00 )
102  parameter( amprtn = 0.93827231 d+00 )
103  parameter( amntrn = 0.93956563 d+00 )
104  parameter( amdeut = 1.87561339 d+00 )
105  parameter( cougfm = elccgs * elccgs / elcmks * 1.d-07 * 1.d+13
106  & * 1.d-09 )
107  parameter( rclsel = 2.8179409183694872 d-13 )
108  parameter( bltzmn = 8.617385 d-14 )
109  parameter( gevmev = 1.0 d+03 )
110  parameter( emvgev = 1.0 d-03 )
111  parameter( algvmv = 6.90775527898214 d+00 )
112  parameter( raddeg = 180.d+00 / pipipi )
113  parameter( degrad = pipipi / 180.d+00 )
114  LOGICAL lgbias, lgbana
115  COMMON / global / lgbias, lgbana
116 C INCLUDE '(DIMPAR)'
117 *$ CREATE DIMPAR.ADD
118  parameter( mxxrgn = 5000 )
119  parameter( mxxmdf = 56 )
120  parameter( mxxmde = 50 )
121  parameter( mfstck = 1000 )
122  parameter( mestck = 100 )
123  parameter( nallwp = 39 )
124  parameter( mpdpdx = 8 )
125  parameter( icomax = 180 )
126  parameter( nstbis = 304 )
127  parameter( idmaxp = 210 )
128  parameter( idmxdc = 620 )
129  parameter( mkbmx1 = 1 )
130  parameter( mkbmx2 = 1 )
131 C INCLUDE '(IOUNIT)'
132 *$ CREATE IOUNIT.ADD
133  parameter( lunin = 5 )
134  parameter( lunout = 6 )
135  parameter( lunerr = 15 )
136  parameter( lunber = 14 )
137  parameter( lunech = 8 )
138  parameter( lunflu = 13 )
139  parameter( lungeo = 16 )
140  parameter( lunpgs = 12 )
141  parameter( lunran = 2 )
142  parameter( lunxsc = 9 )
143  parameter( lundet = 17 )
144  parameter( lunray = 10 )
145  parameter( lunrdb = 1 )
146 C********************************************************************
147 C VERSION JUNE 81 BY PERTTI AARNIO
148 C LAST CHANGE 22. JUNE 81 BY PERTTI AARNIO
149 C HELSINKI UNIVERSITY OF
150 C TECHNOLOGY, FINLAND
151 C
152 C
153 C SUBROUTINE OF FLUKA TO GIVE THE DIRECTION COSINES OF RANDOM
154 C UNIFORM (ISOTROPIC) DIRECTION IN THREE DIMENSIONAL SPACE.
155 C********************************************************************
156 C
157  10 CONTINUE
158  x=twotwo*rndm(x)-oneone
159  y=rndm(y)
160  x2=x*x
161  y2=y*y
162  IF ( x2+y2 .GT. oneone ) go to 10
163  cfe=(x2-y2)/(x2+y2)
164  sfe=twotwo*x*y/(x2+y2)
165 * z = 1/2 [ 1 + cos (theta) ]
166  z =rndm(z)
167 * 1/2 sin (theta)
168  wz=sqrt(z*(oneone-z))
169  wx=twotwo*wz*cfe
170  wy=twotwo*wz*sfe
171  wz=twotwo*z-oneone
172  RETURN
173  END
174 
175 C SUBROUTINE HISTOG(I)
176 C RETURN
177 C END
178  SUBROUTINE stalin
179  RETURN
180  END
181  SUBROUTINE frbkin(L,LP)
182  IMPLICIT DOUBLE PRECISION (a-h,o-z)
183  LOGICAL l,lp
184  RETURN
185  END
frbkin
subroutine frbkin(L, LP)
Definition: dpm25eva.f:181
z
Double_t z
Definition: plot.C:279
y2
Double_t y2[nxs]
Definition: Style.C:21
x2
Double_t x2[nxs]
Definition: Style.C:19
d
Float_t d
Definition: plot.C:237
rndm
DOUBLE PRECISION function rndm(RDUMMY)
Definition: dpm25nulib.f:1460
evevap
subroutine evevap(WEE)
Definition: dpm25eva.f:4
stalin
subroutine stalin
Definition: dpm25eva.f:178
a
G4double a
Definition: TRTMaterials.hh:39
y
Double_t y
Definition: plot.C:279
x
Double_t x
Definition: plot.C:279
c2_factory::sqrt
static c2_sqrt_p< float_type > & sqrt()
make a *new object
Definition: c2_factory.hh:142
raco
subroutine raco(WX, WY, WZ)
Definition: dpm25eva.f:37
Generated on Sat Dec 14 2013 14:33:14 for Geant4_10 by   doxygen 1.8.5