]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/fluka/incini.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Default compile option changed to -g (Alpha)
[u/mrichter/AliRoot.git] / GEANT321 / fluka / incini.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:19:57 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.43 by S.Giani
11*-- Author :
12*=== incini ===========================================================*
13* *
14 SUBROUTINE INCINI
15
16#include "geant321/dblprc.inc"
17#include "geant321/dimpar.inc"
18#include "geant321/iounit.inc"
19*
20*----------------------------------------------------------------------*
21* *
22* Created on 10 june 1990 by Alfredo Ferrari & Paola Sala *
23* Infn - Milan *
24* *
25* Last change on 14-apr-93 by Alfredo Ferrari *
26* *
27* *
28*----------------------------------------------------------------------*
29*
30 PARAMETER ( PI = PIPIPI )
31#include "geant321/fheavy.inc"
32#include "geant321/inpdat2.inc"
33#include "geant321/inpflg.inc"
34#include "geant321/nucdat.inc"
35#include "geant321/parevt.inc"
36 COMMON / FKNUCO / HELP (2), HHLP (2), FTVTH (2), FINCX (2),
37 & EKPOLD (2), BBOLD, ZZOLD, SQROLD, ASEASQ,
38 & FSPRED, FEX0RD
39 BBOLD = - 1.D+10
40 ZZOLD = - 1.D+10
41 SQROLD = - 1.D+10
42 APFRMX = PLABRC * ( 9.D+00 * PI / 8.D+00 )**0.3333333333333333D+00
43 & / R0NUCL
44 AMNUCL (1) = AMPROT
45 AMNUCL (2) = AMNEUT
46 AMNUSQ (1) = AMPROT * AMPROT
47 AMNUSQ (2) = AMNEUT * AMNEUT
48 AMNHLP = 0.5D+00 * ( AMNUCL (1) + AMNUCL (2) )
49 ASQHLP = AMNHLP**2
50* ASQHLP = 0.5D+00 * ( AMNUSQ (1) + AMNUSQ (2) )
51 AEFRMX = SQRT ( ASQHLP + APFRMX**2 ) - AMNHLP
52 AEFRMA = 0.3D+00 * APFRMX**2 / AMNHLP * ( 1.D+00 - APFRMX**2 /
53 & ( 5.6D+00 * ASQHLP ) )
54 AV0WEL = AEFRMX + EBNDAV
55 EBNDNG (1) = EBNDAV
56 EBNDNG (2) = EBNDAV
57 AEXC12 = 0.001D+00 * FKENER ( ONEONE*12, SIXSIX )
58 CEXC12 = 0.001D+00 * ENRG ( ONEONE*12, SIXSIX )
59 AMMC12 = 12.D+00 * AMUAMU + AEXC12
60 AMNC12 = AMMC12 - 6.D+00 * AMELEC +
61 & FERTHO * 6.D+00**EXPEBN
62 AEXO16 = 0.001D+00 * FKENER ( ONEONE*16, EIGEIG )
63 CEXO16 = 0.001D+00 * ENRG ( ONEONE*16, EIGEIG )
64 AMMO16 = 16.D+00 * AMUAMU + AEXO16
65 AMNO16 = AMMO16 - 8.D+00 * AMELEC +
66 & FERTHO * 8.D+00**EXPEBN
67 AEXS28 = 0.001D+00 * FKENER ( ONEONE*28, ONEONE*14 )
68 CEXS28 = 0.001D+00 * ENRG ( ONEONE*28, ONEONE*14 )
69 AMMS28 = 28.D+00 * AMUAMU + AEXS28
70 AMNS28 = AMMS28 - 14.D+00 * AMELEC +
71 & FERTHO * 14.D+00**EXPEBN
72 AEXC40 = 0.001D+00 * FKENER ( ONEONE*40, ONEONE*20 )
73 CEXC40 = 0.001D+00 * ENRG ( ONEONE*40, ONEONE*20 )
74 AMMC40 = 40.D+00 * AMUAMU + AEXC40
75 AMNC40 = AMMC40 - 20.D+00 * AMELEC +
76 & FERTHO * 20.D+00**EXPEBN
77 AEXF56 = 0.001D+00 * FKENER ( ONEONE*56, ONEONE*26 )
78 CEXF56 = 0.001D+00 * ENRG ( ONEONE*56, ONEONE*26 )
79 AMMF56 = 56.D+00 * AMUAMU + AEXF56
80 AMNF56 = AMMF56 - 26.D+00 * AMELEC +
81 & FERTHO * 26.D+00**EXPEBN
82 AEX107 = 0.001D+00 * FKENER ( ONEONE*107, ONEONE*47 )
83 CEX107 = 0.001D+00 * ENRG ( ONEONE*107, ONEONE*47 )
84 AMM107 = 107.D+00 * AMUAMU + AEX107
85 AMN107 = AMM107 - 47.D+00 * AMELEC +
86 & FERTHO * 47.D+00**EXPEBN
87 AEX132 = 0.001D+00 * FKENER ( ONEONE*132, ONEONE*54 )
88 CEX132 = 0.001D+00 * ENRG ( ONEONE*132, ONEONE*54 )
89 AMM132 = 132.D+00 * AMUAMU + AEX132
90 AMN132 = AMM132 - 54.D+00 * AMELEC +
91 & FERTHO * 54.D+00**EXPEBN
92 AEX181 = 0.001D+00 * FKENER ( ONEONE*181, ONEONE*73 )
93 CEX181 = 0.001D+00 * ENRG ( ONEONE*181, ONEONE*73 )
94 AMM181 = 181.D+00 * AMUAMU + AEX181
95 AMN181 = AMM181 - 73.D+00 * AMELEC +
96 & FERTHO * 73.D+00**EXPEBN
97 AEX208 = 0.001D+00 * FKENER ( ONEONE*208, ONEONE*82 )
98 CEX208 = 0.001D+00 * ENRG ( ONEONE*208, ONEONE*82 )
99 AMM208 = 208.D+00 * AMUAMU + AEX208
100 AMN208 = AMM208 - 82.D+00 * AMELEC +
101 & FERTHO * 82.D+00**EXPEBN
102 AEX238 = 0.001D+00 * FKENER ( ONEONE*238, ONEONE*92 )
103 CEX238 = 0.001D+00 * ENRG ( ONEONE*238, ONEONE*92 )
104 AMM238 = 238.D+00 * AMUAMU + AEX238
105 AMN238 = AMM238 - 92.D+00 * AMELEC +
106 & FERTHO * 92.D+00**EXPEBN
107#if defined(CERNLIB_FDEBUG)
108 WRITE ( LUNOUT,* )
109 WRITE ( LUNOUT,* )
110 WRITE ( LUNOUT,* )' **** Maximum Fermi momentum : ',REAL(APFRMX),
111 & ' GeV/c ****'
112 WRITE ( LUNOUT,* )
113 WRITE ( LUNOUT,* )' **** Maximum Fermi energy : ',REAL(AEFRMX),
114 & ' GeV ****'
115 WRITE ( LUNOUT,* )
116 WRITE ( LUNOUT,* )' **** Average Fermi energy : ',REAL(AEFRMA),
117 & ' GeV ****'
118 WRITE ( LUNOUT,* )
119 WRITE ( LUNOUT,* )' **** Average binding energy : ',REAL(EBNDAV),
120 & ' GeV ****'
121 WRITE ( LUNOUT,* )
122 WRITE ( LUNOUT,* )' **** Nuclear well depth : ',REAL(AV0WEL),
123 & ' GeV ****'
124 WRITE ( LUNOUT,* )
125 WRITE ( LUNOUT,* )' **** Excess mass for 12-C : ',REAL(AEXC12),
126 & ' GeV ****'
127 WRITE ( LUNOUT,* )
128 WRITE ( LUNOUT,* )' **** Cameron E. m. for 12-C : ',REAL(CEXC12),
129 & ' GeV ****'
130 WRITE ( LUNOUT,* )
131 WRITE ( LUNOUT,* )' **** Atomic mass for 12-C : ',REAL(AMMC12),
132 & ' GeV ****'
133 WRITE ( LUNOUT,* )
134 WRITE ( LUNOUT,* )' **** Nuclear mass for 12-C : ',REAL(AMNC12),
135 & ' GeV ****'
136 WRITE ( LUNOUT,* )
137 WRITE ( LUNOUT,* )' **** Excess mass for 16-O : ',REAL(AEXO16),
138 & ' GeV ****'
139 WRITE ( LUNOUT,* )
140 WRITE ( LUNOUT,* )' **** Cameron E. m. for 16-O : ',REAL(CEXO16),
141 & ' GeV ****'
142 WRITE ( LUNOUT,* )
143 WRITE ( LUNOUT,* )' **** Atomic mass for 16-O : ',REAL(AMMO16),
144 & ' GeV ****'
145 WRITE ( LUNOUT,* )
146 WRITE ( LUNOUT,* )' **** Nuclear mass for 16-O : ',REAL(AMNO16),
147 & ' GeV ****'
148 WRITE ( LUNOUT,* )
149 WRITE ( LUNOUT,* )' **** Excess mass for 40-Ca : ',REAL(AEXC40),
150 & ' GeV ****'
151 WRITE ( LUNOUT,* )
152 WRITE ( LUNOUT,* )' **** Cameron E. m. for 40-Ca : ',REAL(CEXC40),
153 & ' GeV ****'
154 WRITE ( LUNOUT,* )
155 WRITE ( LUNOUT,* )' **** Atomic mass for 40-Ca : ',REAL(AMMC40),
156 & ' GeV ****'
157 WRITE ( LUNOUT,* )
158 WRITE ( LUNOUT,* )' **** Nuclear mass for 40-Ca : ',REAL(AMNC40),
159 & ' GeV ****'
160 WRITE ( LUNOUT,* )
161 WRITE ( LUNOUT,* )' **** Excess mass for 56-Fe : ',REAL(AEXF56),
162 & ' GeV ****'
163 WRITE ( LUNOUT,* )
164 WRITE ( LUNOUT,* )' **** Cameron E. m. for 56-Fe : ',REAL(CEXF56),
165 & ' GeV ****'
166 WRITE ( LUNOUT,* )
167 WRITE ( LUNOUT,* )' **** Atomic mass for 56-Fe : ',REAL(AMMF56),
168 & ' GeV ****'
169 WRITE ( LUNOUT,* )
170 WRITE ( LUNOUT,* )' **** Nuclear mass for 56-Fe : ',REAL(AMNF56),
171 & ' GeV ****'
172 WRITE ( LUNOUT,* )
173 WRITE ( LUNOUT,* )' **** Excess mass for 107-Ag: ',REAL(AEX107),
174 & ' GeV ****'
175 WRITE ( LUNOUT,* )
176 WRITE ( LUNOUT,* )' **** Cameron E. m. for 107-Ag: ',REAL(CEX107),
177 & ' GeV ****'
178 WRITE ( LUNOUT,* )
179 WRITE ( LUNOUT,* )' **** Atomic mass for 107-Ag: ',REAL(AMM107),
180 & ' GeV ****'
181 WRITE ( LUNOUT,* )
182 WRITE ( LUNOUT,* )' **** Nuclear mass for 107-Ag: ',REAL(AMN107),
183 & ' GeV ****'
184 WRITE ( LUNOUT,* )
185 WRITE ( LUNOUT,* )' **** Excess mass for 132-Xe: ',REAL(AEX132),
186 & ' GeV ****'
187 WRITE ( LUNOUT,* )
188 WRITE ( LUNOUT,* )' **** Cameron E. m. for 132-Xe: ',REAL(CEX132),
189 & ' GeV ****'
190 WRITE ( LUNOUT,* )
191 WRITE ( LUNOUT,* )' **** Atomic mass for 132-Xe: ',REAL(AMM132),
192 & ' GeV ****'
193 WRITE ( LUNOUT,* )
194 WRITE ( LUNOUT,* )' **** Nuclear mass for 132-Xe: ',REAL(AMN132),
195 & ' GeV ****'
196 WRITE ( LUNOUT,* )
197 WRITE ( LUNOUT,* )' **** Excess mass for 181-Ta: ',REAL(AEX181),
198 & ' GeV ****'
199 WRITE ( LUNOUT,* )
200 WRITE ( LUNOUT,* )' **** Cameron E. m. for 181-Ta: ',REAL(CEX181),
201 & ' GeV ****'
202 WRITE ( LUNOUT,* )
203 WRITE ( LUNOUT,* )' **** Atomic mass for 181-Ta: ',REAL(AMM181),
204 & ' GeV ****'
205 WRITE ( LUNOUT,* )
206 WRITE ( LUNOUT,* )' **** Nuclear mass for 181-Ta: ',REAL(AMN181),
207 & ' GeV ****'
208 WRITE ( LUNOUT,* )
209 WRITE ( LUNOUT,* )' **** Excess mass for 208-Pb: ',REAL(AEX208),
210 & ' GeV ****'
211 WRITE ( LUNOUT,* )
212 WRITE ( LUNOUT,* )' **** Cameron E. m. for 208-Pb: ',REAL(CEX208),
213 & ' GeV ****'
214 WRITE ( LUNOUT,* )
215 WRITE ( LUNOUT,* )' **** Atomic mass for 208-Pb: ',REAL(AMM208),
216 & ' GeV ****'
217 WRITE ( LUNOUT,* )
218 WRITE ( LUNOUT,* )' **** Nuclear mass for 208-Pb: ',REAL(AMN208),
219 & ' GeV ****'
220 WRITE ( LUNOUT,* )
221 WRITE ( LUNOUT,* )' **** Excess mass for 238-U : ',REAL(AEX238),
222 & ' GeV ****'
223 WRITE ( LUNOUT,* )
224 WRITE ( LUNOUT,* )' **** Cameron E. m. for 238-U : ',REAL(CEX238),
225 & ' GeV ****'
226 WRITE ( LUNOUT,* )
227 WRITE ( LUNOUT,* )' **** Atomic mass for 238-U : ',REAL(AMM238),
228 & ' GeV ****'
229 WRITE ( LUNOUT,* )
230 WRITE ( LUNOUT,* )' **** Nuclear mass for 238-U : ',REAL(AMN238),
231 & ' GeV ****'
232 WRITE ( LUNOUT,* )
233#endif
234 AMHEAV (1) = AMUAMU + 1.D-03 * FKENER ( ONEONE, ZERZER )
235 AMHEAV (2) = AMUAMU + 1.D-03 * FKENER ( ONEONE, ONEONE )
236 AMHEAV (3) = 2.D+00 * AMUAMU + 1.D-03 * FKENER ( TWOTWO, ONEONE )
237 AMHEAV (4) = 3.D+00 * AMUAMU + 1.D-03 * FKENER ( THRTHR, ONEONE )
238 AMHEAV (5) = 3.D+00 * AMUAMU + 1.D-03 * FKENER ( THRTHR, TWOTWO )
239 AMHEAV (6) = 4.D+00 * AMUAMU + 1.D-03 * FKENER ( FOUFOU, TWOTWO )
240 ELBNDE (0) = 0.D+00
241 DO 2000 IZ = 1, 100
242 ELBNDE ( IZ ) = FERTHO * IZ **EXPEBN
2432000 CONTINUE
244 IF ( LEVPRT ) THEN
245#if defined(CERNLIB_FDEBUG)
246 WRITE ( LUNOUT, * )' **** Evaporation from residual nucleus',
247 & ' activated **** '
248 IF ( LDEEXG ) WRITE ( LUNOUT, * )' **** Deexcitation gamma',
249 & ' production activated **** '
250 IF ( LHEAVY ) WRITE ( LUNOUT, * )' **** Evaporated "heavies"',
251 & ' transport activated **** '
252 IF ( IFISS .GT. 0 )
253 & WRITE ( LUNOUT, * )' **** High Energy fission ',
254 & ' requested & activated **** '
255#endif
256 ELSE
257 LDEEXG = .FALSE.
258 LHEAVY = .FALSE.
259 IFISS = 0
260 END IF
261 RETURN
262*=== End of subroutine incini =========================================*
263 END