| Geant4 Cross Reference |
1 //
2 // ********************************************************************
3 // * License and Disclaimer *
4 // * *
5 // * The Geant4 software is copyright of the Copyright Holders of *
6 // * the Geant4 Collaboration. It is provided under the terms and *
7 // * conditions of the Geant4 Software License, included in the file *
8 // * LICENSE and available at http://cern.ch/geant4/license . These *
9 // * include a list of copyright holders. *
10 // * *
11 // * Neither the authors of this software system, nor their employing *
12 // * institutes,nor the agencies providing financial support for this *
13 // * work make any representation or warranty, express or implied, *
14 // * regarding this software system or assume any liability for its *
15 // * use. Please see the license in the file LICENSE and URL above *
16 // * for the full disclaimer and the limitation of liability. *
17 // * *
18 // * This code implementation is the result of the scientific and *
19 // * technical work of the GEANT4 collaboration. *
20 // * By using, copying, modifying or distributing the software (or *
21 // * any work based on the software) you agree to acknowledge its *
22 // * use in resulting scientific publications, and indicate your *
23 // * acceptance of all terms of the Geant4 Software license. *
24 // ********************************************************************
25 //
26 // ABLAXX statistical de-excitation model
27 // Jose Luis Rodriguez, UDC (translation from ABLA07 and contact person)
28 // Pekka Kaitaniemi, HIP (initial translation of ablav3p)
29 // Aleksandra Kelic, GSI (ABLA07 code)
30 // Davide Mancusi, CEA (contact person INCL)
31 // Aatos Heikkinen, HIP (project coordination)
32 //
33
34 #include "globals.hh"
35 #include <cmath>
36 #include <memory>
37 #include <time.h>
38
39 #include "G4Abla.hh"
40 #include "G4AblaDataDefs.hh"
41 #include "G4AblaDataFile.hh"
42 #include "G4AblaRandom.hh"
43
44 G4Abla::G4Abla(G4VarNtp* aVarntp)
45 {
46 verboseLevel = 0;
47 ilast = 0;
48 varntp = static_cast<G4VarNtp*>(aVarntp); // Output data structure
49
50 verboseLevel = 0;
51 gammaemission = 0; // 0 presaddle, 1 postsaddle
52 T_freeze_out_in = T_freeze_out = 0.;
53 Ainit = 0;
54 Zinit = 0;
55 Sinit = 0;
56 IEV_TAB_SSC = 0;
57
58 ald = std::make_unique<G4Ald>();
59 ec2sub = std::make_unique<G4Ec2sub>();
60 ecld = std::make_unique<G4Ecld>();
61 masses = std::make_unique<G4Mexp>();
62 fb = std::make_unique<G4Fb>();
63 fiss = std::make_unique<G4Fiss>();
64 opt = std::make_unique<G4Opt>();
65 }
66
67 void G4Abla::setVerboseLevel(G4int level) { verboseLevel = level; }
68
69 // Main interface to the evaporation without lambda evaporation
70 void G4Abla::DeexcitationAblaxx(G4int nucleusA,
71 G4int nucleusZ,
72 G4double excitationEnergy,
73 G4double angularMomentum,
74 G4double momX,
75 G4double momY,
76 G4double momZ,
77 G4int eventnumber)
78 {
79 DeexcitationAblaxx(nucleusA, nucleusZ, excitationEnergy, angularMomentum, momX, momY, momZ, eventnumber, 0);
80 }
81
82 // Main interface to the evaporation with lambda emission
83 void G4Abla::DeexcitationAblaxx(G4int nucleusA,
84 G4int nucleusZ,
85 G4double excitationEnergy,
86 G4double angularMomentum,
87 G4double momX,
88 G4double momY,
89 G4double momZ,
90 G4int eventnumber,
91 G4int nucleusS)
92 {
93
94 const G4double amu = 931.4940; // MeV/C^2
95 const G4double C = 29.9792458; // cm/ns
96
97 SetParametersG4(nucleusZ, nucleusA);
98
99 mult10:
100 G4int IS = 0;
101
102 varntp->clear(); // Clean up an initialize ABLA output.
103
104 if (nucleusS > 0)
105 nucleusS = 0; // S=1 from INCL ????
106
107 G4int NbLam0 = std::abs(nucleusS);
108
109 Ainit = -1 * nucleusA;
110 Zinit = -1 * nucleusZ;
111 Sinit = -1 * nucleusS;
112
113 G4double aff = 0.0;
114 G4double zff = 0.0;
115 G4int ZFP1 = 0, AFP1 = 0, AFPIMF = 0, ZFPIMF = 0, ZFP2 = 0, AFP2 = 0, SFP1 = 0, SFP2 = 0, SFPIMF = 0;
116 G4double vx_eva = 0.0, vy_eva = 0.0, vz_eva = 0.0;
117 G4double VX_PREF = 0., VY_PREF = 0., VZ_PREF = 00, VP1X, VP1Y, VP1Z, VXOUT, VYOUT, VZOUT, V_CM[3], VFP1_CM[3],
118 VFP2_CM[3], VIMF_CM[3], VX2OUT, VY2OUT, VZ2OUT;
119 G4double zf = 0.0, af = 0.0, mtota = 0.0, tkeimf = 0.0, jprf0 = 0.;
120 G4int ff = 0, afpnew = 0, zfpnew = 0, aprfp = 0, zprfp = 0, IOUNSTABLE = 0, ILOOP = 0, IEV_TAB = 0,
121 IEV_TAB_TEMP = 0;
122 G4int fimf = 0, INMIN = 0, INMAX = 0;
123 G4int ftype = 0; //,ftype1=0;
124 G4int inum = eventnumber;
125 G4int inttype = 0;
126 opt->optimfallowed = 1;
127
128 if (fiss->zt > 56)
129 {
130 fiss->ifis = 1;
131 }
132 else
133 {
134 fiss->ifis = 0;
135 }
136
137 if (NbLam0 > 0)
138 {
139 opt->nblan0 = NbLam0;
140 }
141
142 G4double aprf = (G4double)nucleusA;
143 G4double zprf = (G4double)nucleusZ;
144 G4double ee = excitationEnergy;
145 G4double jprf = angularMomentum; // actually root-mean-squared
146
147 G4double pxrem = momX;
148 G4double pyrem = momY;
149 G4double pzrem = momZ;
150 G4double zimf, aimf;
151
152 gammaemission = 0;
153 G4double T_init = 0., T_diff = 0., a_tilda = 0., a_tilda_BU = 0., EE_diff = 0., EINCL = 0., A_FINAL = 0.,
154 Z_FINAL = 0., E_FINAL = 0.;
155
156 G4double A_diff = 0., ASLOPE1, ASLOPE2, A_ACC, ABU_SLOPE, ABU_SUM = 0., AMEM = 0., ZMEM = 0., EMEM = 0., JMEM = 0.,
157 PX_BU_SUM = 0.0, PY_BU_SUM = 0.0, PZ_BU_SUM = 0.0, ETOT_SUM = 0., P_BU_SUM = 0., ZBU_SUM = 0.,
158 Z_Breakup_sum = 0., A_Breakup, Z_Breakup, N_Breakup, G_SYMM, CZ, Sigma_Z, Z_Breakup_Mean, ZTEMP = 0.,
159 ATEMP = 0.;
160
161 G4double ETOT_PRF = 0.0, PXPRFP = 0., PYPRFP = 0., PZPRFP = 0., PPRFP = 0., VX1_BU = 0., VY1_BU = 0., VZ1_BU = 0.,
162 VBU2 = 0., GAMMA_REL = 1.0, Eexc_BU_SUM = 0., VX_BU_SUM = 0., VY_BU_SUM = 0., VZ_BU_SUM = 0.,
163 E_tot_BU = 0., EKIN_BU = 0., ZIMFBU = 0., AIMFBU = 0., ZFFBU = 0., AFFBU = 0., AFBU = 0., ZFBU = 0.,
164 EEBU = 0., TKEIMFBU = 0., vx_evabu = 0., vy_evabu = 0., vz_evabu = 0., Bvalue_BU = 0., P_BU = 0.,
165 ETOT_BU = 1., PX_BU = 0., PY_BU = 0., PZ_BU = 0., VX2_BU = 0., VY2_BU = 0., VZ2_BU = 0.;
166
167 G4int ABU_DIFF, ZBU_DIFF, NBU_DIFF;
168 G4int INEWLOOP = 0, ILOOPBU = 0;
169
170 G4double BU_TAB_TEMP[indexpart][6], BU_TAB_TEMP1[indexpart][6];
171 G4double EV_TAB_TEMP[indexpart][6], EV_TEMP[indexpart][6];
172 G4int IMEM_BU[indexpart], IMEM = 0;
173
174 if (nucleusA < 1)
175 {
176 std::cout << "Error - Remnant with a mass number A below 1." << std::endl;
177 // INCL_ERROR("Remnant with a mass number A below 1.");
178 return;
179 }
180
181 for (G4int j = 0; j < 3; j++)
182 {
183 V_CM[j] = 0.;
184 VFP1_CM[j] = 0.;
185 VFP2_CM[j] = 0.;
186 VIMF_CM[j] = 0.;
187 }
188
189 for (G4int I1 = 0; I1 < indexpart; I1++)
190 {
191 for (G4int I2 = 0; I2 < 12; I2++)
192 BU_TAB[I1][I2] = 0.0;
193 for (G4int I2 = 0; I2 < 6; I2++)
194 {
195 BU_TAB_TEMP[I1][I2] = 0.0;
196 BU_TAB_TEMP1[I1][I2] = 0.0;
197 EV_TAB_TEMP[I1][I2] = 0.0;
198 EV_TAB[I1][I2] = 0.0;
199 EV_TAB_SSC[I1][I2] = 0.0;
200 EV_TEMP[I1][I2] = 0.0;
201 }
202 }
203
204 G4int idebug = 0;
205 if (idebug == 1)
206 {
207 zprf = 81.;
208 aprf = 201.;
209 // ee = 86.5877686;
210 ee = 100.0;
211 jprf = 10.;
212 zf = 0.;
213 af = 0.;
214 mtota = 0.;
215 ff = 1;
216 inttype = 0;
217 // inum = 2;
218 }
219 //
220 G4double AAINCL = aprf;
221 G4double ZAINCL = zprf;
222 EINCL = ee;
223 //
224 // Velocity after the first stage of reaction (INCL)
225 // For coupling with INCL, comment the lines below, and use output
226 // of INCL as pxincl, pyincl,pzincl
227 //
228 G4double pincl = std::sqrt(pxrem * pxrem + pyrem * pyrem + pzrem * pzrem);
229 // PPRFP is in MeV/c
230 G4double ETOT_incl = std::sqrt(pincl * pincl + (AAINCL * amu) * (AAINCL * amu));
231 G4double VX_incl = C * pxrem / ETOT_incl;
232 G4double VY_incl = C * pyrem / ETOT_incl;
233 G4double VZ_incl = C * pzrem / ETOT_incl;
234 //
235 // Multiplicity in the break-up event
236 G4int IMULTBU = 0;
237 G4int IMULTIFR = 0;
238 G4int I_Breakup = 0;
239 G4int NbLamprf = 0;
240 IEV_TAB = 0;
241
242 /*
243 C Set maximum temperature for sequential decay (evaporation)
244 C Remove additional energy by simultaneous break up
245 C (vaporisation or multi-fragmentation)
246
247 C Idea: If the temperature of the projectile spectator exceeds
248 c the limiting temperature T_freeze_out, the additional
249 C energy which is present in the spectator is used for
250 C a stage of simultaneous break up. It is either the
251 C simultaneous emission of a gaseous phase or the simultaneous
252 C emission of several intermediate-mass fragments. Only one
253 C piece of the projectile spectator (assumed to be the largest
254 C one) is kept track.
255
256 C MVR, KHS, October 2001
257 C KHS, AK 2007 - Masses from the power low; slope parameter dependent
258 on C energy per nucleon; symmtery-energy coeff.
259 dependent on C energy per nucleon.
260
261 c Clear BU_TAB (array of multifragmentation products)
262 */
263 if (T_freeze_out_in >= 0.0)
264 {
265 T_freeze_out = T_freeze_out_in;
266 }
267 else
268 {
269 T_freeze_out = max(9.33 * std::exp(-0.00282 * AAINCL), 5.5);
270 // ! See: J. Natowitz et al, PRC65 (2002) 034618
271 // T_freeze_out=DMAX1(9.0D0*DEXP(-0.001D0*AAABRA),
272 // & 5.5D0)
273 }
274 //
275 a_tilda = ald->av * aprf + ald->as * std::pow(aprf, 2.0 / 3.0) + ald->ak * std::pow(aprf, 1.0 / 3.0);
276
277 T_init = std::sqrt(EINCL / a_tilda);
278
279 T_diff = T_init - T_freeze_out;
280
281 if (T_diff > 0.1 && zprf > 2. && (aprf - zprf) > 0.)
282 {
283 // T_Diff is set to be larger than 0.1 MeV in order to avoid strange cases
284 // for which T_Diff is of the order of 1.e-3 and less.
285 varntp->kfis = 10;
286
287 for (G4int i = 0; i < 5; i++)
288 {
289 EE_diff = EINCL - a_tilda * T_freeze_out * T_freeze_out;
290 // Energy removed 10*5/T_init per nucleon removed in
291 // simultaneous breakup adjusted to frag. xsections 238U
292 // (1AGeV) + Pb data, KHS Dec. 2005
293 // This should maybe be re-checked, in a meanwhile several things in
294 // break-up description have changed (AK).
295
296 A_diff = dint(EE_diff / (8.0 * 5.0 / T_freeze_out));
297
298 if (A_diff > AAINCL)
299 A_diff = AAINCL;
300
301 A_FINAL = AAINCL - A_diff;
302
303 a_tilda =
304 ald->av * A_FINAL + ald->as * std::pow(A_FINAL, 2.0 / 3.0) + ald->ak * std::pow(A_FINAL, 1.0 / 3.0);
305 E_FINAL = a_tilda * T_freeze_out * T_freeze_out;
306
307 if (A_FINAL < 4.0)
308 { // To avoid numerical problems
309 EE_diff = EINCL - E_FINAL;
310 A_FINAL = 1.0;
311 Z_FINAL = 1.0;
312 E_FINAL = 0.0;
313 goto mul4325;
314 }
315 }
316 mul4325:
317 // The idea is similar to Z determination of multifragment - Z of "heavy"
318 // partner is not fixed by the A/Z of the prefragment, but randomly picked
319 // from Gaussian Z_FINAL_MEAN = dint(zprf * A_FINAL / (aprf));
320
321 Z_FINAL = dint(zprf * A_FINAL / (aprf));
322
323 if (E_FINAL < 0.0)
324 E_FINAL = 0.0;
325
326 aprf = A_FINAL;
327 zprf = Z_FINAL;
328 ee = E_FINAL;
329
330 A_diff = AAINCL - aprf;
331
332 // Creation of multifragmentation products by breakup
333 if (A_diff <= 1.0)
334 {
335 aprf = AAINCL;
336 zprf = ZAINCL;
337 ee = EINCL;
338 IMULTIFR = 0;
339 goto mult7777;
340 }
341 else if (A_diff > 1.0)
342 {
343
344 A_ACC = 0.0;
345 // Energy-dependence of the slope parameter, acc. to A. Botvina, fits also
346 // to exp. data (see e.g. Sfienti et al, NPA 2007)
347 ASLOPE1 = -2.400; // e*/a=7 -2.4
348 ASLOPE2 = -1.200; // e*/a=3 -1.2
349
350 a_tilda = ald->av * AAINCL + ald->as * std::pow(AAINCL, 2.0 / 3.0) + ald->ak * std::pow(AAINCL, 1.0 / 3.0);
351
352 E_FINAL = a_tilda * T_freeze_out * T_freeze_out;
353
354 ABU_SLOPE = (ASLOPE1 - ASLOPE2) / 4.0 * (E_FINAL / AAINCL) + ASLOPE1 - (ASLOPE1 - ASLOPE2) * 7.0 / 4.0;
355
356 // Botvina et al, PRC 74 (2006) 044609, fig. 5 for B0=18 MeV
357 // ABU_SLOPE = 5.57489D0-2.08149D0*(E_FINAL/AAABRA)+
358 // & 0.3552D0*(E_FINAL/AAABRA)**2-0.024927D0*(E_FINAL/AAABRA)**3+
359 // & 7.268D-4*(E_FINAL/AAABRA)**4
360 // They fit with A**(-tau) and here is done A**(tau)
361 // ABU_SLOPE = ABU_SLOPE*(-1.D0)
362
363 // ABU_SLOPE = -2.60D0
364 // print*,ABU_SLOPE,(E_FINAL/AAABRA)
365
366 if (ABU_SLOPE > -1.01)
367 ABU_SLOPE = -1.01;
368
369 I_Breakup = 0;
370 Z_Breakup_sum = Z_FINAL;
371 ABU_SUM = 0.0;
372 ZBU_SUM = 0.0;
373
374 for (G4int i = 0; i < 100; i++)
375 {
376 IS = 0;
377 mult4326:
378 A_Breakup = dint(G4double(IPOWERLIMHAZ(ABU_SLOPE, 1, idnint(A_diff))));
379 // Power law with exponent ABU_SLOPE
380 IS = IS + 1;
381 if (IS > 100)
382 {
383 std::cout << "WARNING: IPOWERLIMHAZ CALLED MORE THAN 100 TIMES WHEN "
384 "CALCULATING A_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED: "
385 << A_Breakup << std::endl;
386 goto mult10;
387 }
388
389 if (A_Breakup > AAINCL)
390 goto mult4326;
391
392 if (A_Breakup <= 0.0)
393 {
394 std::cout << "A_BREAKUP <= 0 " << std::endl;
395 goto mult10;
396 }
397
398 A_ACC = A_ACC + A_Breakup;
399
400 if (A_ACC <= A_diff)
401 {
402
403 Z_Breakup_Mean = dint(A_Breakup * ZAINCL / AAINCL);
404
405 Z_Breakup_sum = Z_Breakup_sum + Z_Breakup_Mean;
406 //
407 // See G.A. Souliotis et al, PRC 75 (2007) 011601R (Fig. 2)
408 G_SYMM = 34.2281 - 5.14037 * E_FINAL / AAINCL;
409 if (E_FINAL / AAINCL < 2.0)
410 G_SYMM = 25.0;
411 if (E_FINAL / AAINCL > 4.0)
412 G_SYMM = 15.0;
413
414 // G_SYMM = 23.6;
415
416 G_SYMM = 25.0; // 25
417 CZ = 2.0 * G_SYMM * 4.0 / A_Breakup;
418 // 2*CZ=d^2(Esym)/dZ^2, Esym=Gamma*(A-2Z)**2/A
419 // gamma = 23.6D0 is the symmetry-energy coefficient
420 G4int IIS = 0;
421 Sigma_Z = std::sqrt(T_freeze_out / CZ);
422
423 IS = 0;
424 mult4333:
425 Z_Breakup = dint(G4double(gausshaz(1, Z_Breakup_Mean, Sigma_Z)));
426 IS = IS + 1;
427 //
428 if (IS > 100)
429 {
430 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN "
431 "CALCULATING Z_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE "
432 "DICED: "
433 << A_Breakup << " " << Z_Breakup << std::endl;
434 goto mult10;
435 }
436
437 if (Z_Breakup < 0.0)
438 goto mult4333;
439 if ((A_Breakup - Z_Breakup) < 0.0)
440 goto mult4333;
441 if ((A_Breakup - Z_Breakup) == 0.0 && Z_Breakup != 1.0)
442 goto mult4333;
443
444 if (Z_Breakup >= ZAINCL)
445 {
446 IIS = IIS + 1;
447 if (IIS > 10)
448 {
449 std::cout << "Z_BREAKUP RESAMPLED MORE THAN 10 TIMES; EVENT WILL "
450 "BE RESAMPLED AGAIN "
451 << std::endl;
452 goto mult10;
453 }
454 goto mult4333;
455 }
456
457 // *** Find the limits that fragment is bound :
458 isostab_lim(idnint(Z_Breakup), &INMIN, &INMAX);
459 // INMIN = MAX(1,INMIN-2)
460 if (Z_Breakup > 2.0)
461 {
462 if (idnint(A_Breakup - Z_Breakup) < INMIN || idnint(A_Breakup - Z_Breakup) > (INMAX + 5))
463 {
464 // PRINT*,'N_Breakup >< NMAX',
465 // & IDNINT(Z_Breakup),IDNINT(A_Breakup-Z_Breakup),INMIN,INMAX
466 goto mult4343;
467 }
468 }
469
470 mult4343:
471
472 // We consider all products, also nucleons created in the break-up
473 // I_Breakup = I_Breakup + 1;// moved below
474
475 N_Breakup = A_Breakup - Z_Breakup;
476 BU_TAB[I_Breakup][0] = dint(Z_Breakup); // Mass of break-up product
477 BU_TAB[I_Breakup][1] = dint(A_Breakup); // Z of break-up product
478 ABU_SUM = ABU_SUM + BU_TAB[i][1];
479 ZBU_SUM = ZBU_SUM + BU_TAB[i][0];
480 //
481 // Break-up products are given zero angular momentum (simplification)
482 BU_TAB[I_Breakup][3] = 0.0;
483 I_Breakup = I_Breakup + 1;
484 IMULTBU = IMULTBU + 1;
485 }
486 else
487 {
488 // There are A_DIFF - A_ACC nucleons lost by breakup, but they do
489 // not end up in multifragmentation products. This is a deficiency
490 // of the Monte-Carlo method applied above to determine the sizes
491 // of the fragments according to the power law.
492 // print*,'Deficiency',IDNINT(A_DIFF-A_ACC)
493
494 goto mult4327;
495 } // if(A_ACC<=A_diff)
496 } // for
497 // mult4327:
498 // IMULTIFR = 1;
499 } // if(A_diff>1.0)
500 mult4327:
501 IMULTIFR = 1;
502
503 // "Missing" A and Z picked from the power law:
504 ABU_DIFF = idnint(ABU_SUM + aprf - AAINCL);
505 ZBU_DIFF = idnint(ZBU_SUM + zprf - ZAINCL);
506 NBU_DIFF = idnint((ABU_SUM - ZBU_SUM) + (aprf - zprf) - (AAINCL - ZAINCL));
507 //
508 if (IMULTBU > 200)
509 std::cout << "WARNING - MORE THAN 200 BU " << IMULTBU << std::endl;
510
511 if (IMULTBU < 1)
512 std::cout << "WARNING - LESS THAN 1 BU " << IMULTBU << std::endl;
513 //,AABRA,ZABRA,IDNINT(APRF),IDNINT(ZPRF),ABU_DIFF,ZBU_DIFF
514
515 G4int IPROBA = 0;
516 for (G4int i = 0; i < IMULTBU; i++)
517 IMEM_BU[i] = 0;
518
519 while (NBU_DIFF != 0 && ZBU_DIFF != 0)
520 {
521 // (APRF,ZPRF) is also inlcuded in this game, as from time to time the
522 // program is entering into endless loop, as it can not find proper
523 // nucleus for adapting A and Z.
524 IS = 0;
525 mult5555:
526 G4double RHAZ = G4AblaRandom::flat() * G4double(IMULTBU);
527 IPROBA = IPROBA + 1;
528 IS = IS + 1;
529 if (IS > 100)
530 {
531 std::cout << "WARNING: HAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING "
532 "N_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED."
533 << std::endl;
534 goto mult10;
535 }
536 G4int IEL = G4int(RHAZ);
537 if (IMEM_BU[IEL] == 1)
538 goto mult5555;
539 if (!(IEL < 200))
540 std::cout << "5555:" << IEL << RHAZ << IMULTBU << std::endl;
541 if (IEL < 0)
542 std::cout << "5555:" << IEL << RHAZ << IMULTBU << std::endl;
543 if (IEL <= IMULTBU)
544 {
545 N_Breakup = dint(BU_TAB[IEL][1] - BU_TAB[IEL][0] - DSIGN(1.0, G4double(NBU_DIFF)));
546 }
547 else if (IEL > IMULTBU)
548 {
549 N_Breakup = dint(aprf - zprf - DSIGN(1.0, G4double(NBU_DIFF)));
550 }
551 if (N_Breakup < 0.0)
552 {
553 IMEM_BU[IEL] = 1;
554 goto mult5555;
555 }
556 if (IEL <= IMULTBU)
557 {
558 ZTEMP = dint(BU_TAB[IEL][0] - DSIGN(1.0, G4double(ZBU_DIFF)));
559 }
560 else if (IEL > IMULTBU)
561 {
562 ZTEMP = dint(zprf - DSIGN(1.0, G4double(ZBU_DIFF)));
563 }
564 if (ZTEMP < 0.0)
565 {
566 IMEM_BU[IEL] = 1;
567 goto mult5555;
568 }
569 if (ZTEMP < 1.0 && N_Breakup < 1.0)
570 {
571 IMEM_BU[IEL] = 1;
572 goto mult5555;
573 }
574 // Nuclei with A=Z and Z>1 are allowed in this stage, as otherwise,
575 // for more central collisions there is not enough mass which can be
576 // shufeled in order to conserve A and Z. These are mostly nuclei with
577 // Z=2 and in less extent 3, 4 or 5.
578 // IF(ZTEMP.GT.1.D0 .AND. N_Breakup.EQ.0.D0) THEN
579 // GOTO 5555
580 // ENDIF
581 if (IEL <= IMULTBU)
582 {
583 BU_TAB[IEL][0] = dint(ZTEMP);
584 BU_TAB[IEL][1] = dint(ZTEMP + N_Breakup);
585 }
586 else if (IEL > IMULTBU)
587 {
588 zprf = dint(ZTEMP);
589 aprf = dint(ZTEMP + N_Breakup);
590 }
591 NBU_DIFF = NBU_DIFF - ISIGN(1, NBU_DIFF);
592 ZBU_DIFF = ZBU_DIFF - ISIGN(1, ZBU_DIFF);
593 } // while
594
595 IPROBA = 0;
596 for (G4int i = 0; i < IMULTBU; i++)
597 IMEM_BU[i] = 0;
598
599 if (NBU_DIFF != 0 && ZBU_DIFF == 0)
600 {
601 while (NBU_DIFF > 0 || NBU_DIFF < 0)
602 {
603 IS = 0;
604 mult5556:
605 G4double RHAZ = G4AblaRandom::flat() * G4double(IMULTBU);
606 IS = IS + 1;
607 if (IS > 100)
608 {
609 std::cout << "WARNING: HAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING "
610 "N_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED."
611 << std::endl;
612 goto mult10;
613 }
614 G4int IEL = G4int(RHAZ);
615 if (IMEM_BU[IEL] == 1)
616 goto mult5556;
617 // IPROBA = IPROBA + 1;
618 if (IPROBA > IMULTBU + 1 && NBU_DIFF > 0)
619 {
620 std::cout << "###',IPROBA,IMULTBU,NBU_DIFF,ZBU_DIFF,T_freeze_out" << std::endl;
621 IPROBA = IPROBA + 1;
622 if (IEL <= IMULTBU)
623 {
624 BU_TAB[IEL][1] = dint(BU_TAB[IEL][1] - G4double(NBU_DIFF));
625 }
626 else
627 {
628 if (IEL > IMULTBU)
629 aprf = dint(aprf - G4double(NBU_DIFF));
630 }
631 goto mult5432;
632 }
633 if (!(IEL < 200))
634 std::cout << "5556:" << IEL << RHAZ << IMULTBU << std::endl;
635 if (IEL < 0)
636 std::cout << "5556:" << IEL << RHAZ << IMULTBU << std::endl;
637 if (IEL <= IMULTBU)
638 {
639 N_Breakup = dint(BU_TAB[IEL][1] - BU_TAB[IEL][0] - DSIGN(1.0, G4double(NBU_DIFF)));
640 }
641 else if (IEL > IMULTBU)
642 {
643 N_Breakup = dint(aprf - zprf - DSIGN(1.0, G4double(NBU_DIFF)));
644 }
645 if (N_Breakup < 0.0)
646 {
647 IMEM_BU[IEL] = 1;
648 goto mult5556;
649 }
650 if (IEL <= IMULTBU)
651 {
652 ATEMP = dint(BU_TAB[IEL][0] + N_Breakup);
653 }
654 else if (IEL > IMULTBU)
655 {
656 ATEMP = dint(zprf + N_Breakup);
657 }
658 if ((ATEMP - N_Breakup) < 1.0 && N_Breakup < 1.0)
659 {
660 IMEM_BU[IEL] = 1;
661 goto mult5556;
662 }
663 // IF((ATEMP - N_Breakup).GT.1.D0 .AND.
664 // & N_Breakup.EQ.0.D0) THEN
665 // IMEM_BU(IEL) = 1
666 // GOTO 5556
667 // ENDIF
668 if (IEL <= IMULTBU)
669 BU_TAB[IEL][1] = dint(BU_TAB[IEL][0] + N_Breakup);
670 else if (IEL > IMULTBU)
671 aprf = dint(zprf + N_Breakup);
672 //
673 NBU_DIFF = NBU_DIFF - ISIGN(1, NBU_DIFF);
674 } // while(NBU_DIFF > 0 || NBU_DIFF < 0)
675
676 IPROBA = 0;
677 for (G4int i = 0; i < IMULTBU; i++)
678 IMEM_BU[i] = 0;
679 }
680 else
681 { // if(NBU_DIFF != 0 && ZBU_DIFF == 0)
682 if (ZBU_DIFF != 0 && NBU_DIFF == 0)
683 {
684 while (ZBU_DIFF > 0 || ZBU_DIFF < 0)
685 {
686 IS = 0;
687 mult5557:
688 G4double RHAZ = G4AblaRandom::flat() * G4double(IMULTBU);
689 IS = IS + 1;
690 if (IS > 100)
691 {
692 std::cout << "WARNING: HAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING "
693 "N_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED."
694 << std::endl;
695 goto mult10;
696 }
697 G4int IEL = G4int(RHAZ);
698 if (IMEM_BU[IEL] == 1)
699 goto mult5557;
700 // IPROBA = IPROBA + 1;
701 if (IPROBA > IMULTBU + 1 && ZBU_DIFF > 0)
702 {
703 std::cout << "###',IPROBA,IMULTBU,NBU_DIFF,ZBU_DIFF,T_freeze_out" << std::endl;
704 IPROBA = IPROBA + 1;
705 if (IEL <= IMULTBU)
706 {
707 N_Breakup = dint(BU_TAB[IEL][1] - BU_TAB[IEL][0]);
708 BU_TAB[IEL][0] = dint(BU_TAB[IEL][0] - G4double(ZBU_DIFF));
709 BU_TAB[IEL][1] = dint(BU_TAB[IEL][0] + N_Breakup);
710 }
711 else
712 {
713 if (IEL > IMULTBU)
714 {
715 N_Breakup = aprf - zprf;
716 zprf = dint(zprf - G4double(ZBU_DIFF));
717 aprf = dint(zprf + N_Breakup);
718 }
719 }
720 goto mult5432;
721 }
722 if (!(IEL < 200))
723 std::cout << "5557:" << IEL << RHAZ << IMULTBU << std::endl;
724 if (IEL < 0)
725 std::cout << "5557:" << IEL << RHAZ << IMULTBU << std::endl;
726 if (IEL <= IMULTBU)
727 {
728 N_Breakup = dint(BU_TAB[IEL][1] - BU_TAB[IEL][0]);
729 ZTEMP = dint(BU_TAB[IEL][0] - DSIGN(1.0, G4double(ZBU_DIFF)));
730 }
731 else if (IEL > IMULTBU)
732 {
733 N_Breakup = dint(aprf - zprf);
734 ZTEMP = dint(zprf - DSIGN(1.0, G4double(ZBU_DIFF)));
735 }
736 ATEMP = dint(ZTEMP + N_Breakup);
737 if (ZTEMP < 0.0)
738 {
739 IMEM_BU[IEL] = 1;
740 goto mult5557;
741 }
742 if ((ATEMP - ZTEMP) < 0.0)
743 {
744 IMEM_BU[IEL] = 1;
745 goto mult5557;
746 }
747 if ((ATEMP - ZTEMP) < 1.0 && ZTEMP < 1.0)
748 {
749 IMEM_BU[IEL] = 1;
750 goto mult5557;
751 }
752 if (IEL <= IMULTBU)
753 {
754 BU_TAB[IEL][0] = dint(ZTEMP);
755 BU_TAB[IEL][1] = dint(ZTEMP + N_Breakup);
756 }
757 else
758 {
759 if (IEL > IMULTBU)
760 {
761 zprf = dint(ZTEMP);
762 aprf = dint(ZTEMP + N_Breakup);
763 }
764 }
765 ZBU_DIFF = ZBU_DIFF - ISIGN(1, ZBU_DIFF);
766 } // while
767 } // if(ZBU_DIFF != 0 && NBU_DIFF == 0)
768 } // if(NBU_DIFF != 0 && ZBU_DIFF == 0)
769
770 mult5432:
771 // Looking for the heaviest fragment among all multifragmentation events,
772 // and "giving" excitation energy to fragments
773 ZMEM = 0.0;
774
775 for (G4int i = 0; i < IMULTBU; i++)
776 {
777 // For particles with Z>2 we calculate excitation energy from freeze-out
778 // temperature.
779 // For particels with Z<3 we assume that they form a gas, and that
780 // temperature results in kinetic energy (which is sampled from Maxwell
781 // distribution with T=Tfreeze-out) and not excitation energy.
782 if (BU_TAB[i][0] > 2.0)
783 {
784 a_tilda_BU = ald->av * BU_TAB[i][1] + ald->as * std::pow(BU_TAB[i][1], 2.0 / 3.0) +
785 ald->ak * std::pow(BU_TAB[i][1], 1.0 / 3.0);
786 BU_TAB[i][2] = a_tilda_BU * T_freeze_out * T_freeze_out; // E* of break-up product
787 }
788 else
789 {
790 BU_TAB[i][2] = 0.0;
791 }
792 //
793 if (BU_TAB[i][0] > ZMEM)
794 {
795 IMEM = i;
796 ZMEM = BU_TAB[i][0];
797 AMEM = BU_TAB[i][1];
798 EMEM = BU_TAB[i][2];
799 JMEM = BU_TAB[i][3];
800 }
801 } // for IMULTBU
802
803 if (zprf < ZMEM)
804 {
805 BU_TAB[IMEM][0] = zprf;
806 BU_TAB[IMEM][1] = aprf;
807 BU_TAB[IMEM][2] = ee;
808 BU_TAB[IMEM][3] = jprf;
809 zprf = ZMEM;
810 aprf = AMEM;
811 aprfp = idnint(aprf);
812 zprfp = idnint(zprf);
813 ee = EMEM;
814 jprf = JMEM;
815 }
816
817 // Just for checking:
818 ABU_SUM = aprf;
819 ZBU_SUM = zprf;
820 for (G4int i = 0; i < IMULTBU; i++)
821 {
822 ABU_SUM = ABU_SUM + BU_TAB[i][1];
823 ZBU_SUM = ZBU_SUM + BU_TAB[i][0];
824 }
825 ABU_DIFF = idnint(ABU_SUM - AAINCL);
826 ZBU_DIFF = idnint(ZBU_SUM - ZAINCL);
827 //
828 if (ABU_DIFF != 0 || ZBU_DIFF != 0)
829 std::cout << "Problem of mass in BU " << ABU_DIFF << " " << ZBU_DIFF << std::endl;
830 PX_BU_SUM = 0.0;
831 PY_BU_SUM = 0.0;
832 PZ_BU_SUM = 0.0;
833 // Momenta of break-up products are calculated. They are all given in the
834 // rest frame of the primary prefragment (i.e. after incl): Goldhaber model
835 // **************************************** "Heavy" residue
836 AMOMENT(AAINCL, aprf, 1, &PXPRFP, &PYPRFP, &PZPRFP);
837 PPRFP = std::sqrt(PXPRFP * PXPRFP + PYPRFP * PYPRFP + PZPRFP * PZPRFP);
838 // ********************************************************
839 // PPRFP is in MeV/c
840 ETOT_PRF = std::sqrt(PPRFP * PPRFP + (aprf * amu) * (aprf * amu));
841 VX_PREF = C * PXPRFP / ETOT_PRF;
842 VY_PREF = C * PYPRFP / ETOT_PRF;
843 VZ_PREF = C * PZPRFP / ETOT_PRF;
844
845 // Contribution from Coulomb repulsion ********************
846 tke_bu(zprf, aprf, ZAINCL, AAINCL, &VX1_BU, &VY1_BU, &VZ1_BU);
847
848 // Lorentz kinematics
849 // VX_PREF = VX_PREF + VX1_BU
850 // VY_PREF = VY_PREF + VY1_BU
851 // VZ_PREF = VZ_PREF + VZ1_BU
852 // Lorentz transformation
853 lorentz_boost(VX1_BU, VY1_BU, VZ1_BU, VX_PREF, VY_PREF, VZ_PREF, &VXOUT, &VYOUT, &VZOUT);
854
855 VX_PREF = VXOUT;
856 VY_PREF = VYOUT;
857 VZ_PREF = VZOUT;
858
859 // Total momentum: Goldhaber + Coulomb
860 VBU2 = VX_PREF * VX_PREF + VY_PREF * VY_PREF + VZ_PREF * VZ_PREF;
861 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C * C));
862 ETOT_PRF = aprf * amu / GAMMA_REL;
863 PXPRFP = ETOT_PRF * VX_PREF / C;
864 PYPRFP = ETOT_PRF * VY_PREF / C;
865 PZPRFP = ETOT_PRF * VZ_PREF / C;
866
867 // ********************************************************
868 // Momentum: Total width of abrasion and breakup assumed to be given
869 // by Fermi momenta of nucleons
870 // *****************************************
871
872 PX_BU_SUM = PXPRFP;
873 PY_BU_SUM = PYPRFP;
874 PZ_BU_SUM = PZPRFP;
875
876 Eexc_BU_SUM = ee;
877 Bvalue_BU = eflmac(idnint(aprf), idnint(zprf), 1, 0);
878
879 for (I_Breakup = 0; I_Breakup < IMULTBU; I_Breakup++)
880 {
881 // For bu products:
882 Bvalue_BU = Bvalue_BU + eflmac(idnint(BU_TAB[I_Breakup][1]), idnint(BU_TAB[I_Breakup][0]), 1, 0);
883 Eexc_BU_SUM = Eexc_BU_SUM + BU_TAB[I_Breakup][2];
884
885 AMOMENT(AAINCL, BU_TAB[I_Breakup][1], 1, &PX_BU, &PY_BU, &PZ_BU);
886 P_BU = std::sqrt(PX_BU * PX_BU + PY_BU * PY_BU + PZ_BU * PZ_BU);
887 // *******************************************************
888 // PPRFP is in MeV/c
889 ETOT_BU = std::sqrt(P_BU * P_BU + (BU_TAB[I_Breakup][1] * amu) * (BU_TAB[I_Breakup][1] * amu));
890 BU_TAB[I_Breakup][4] = C * PX_BU / ETOT_BU; // Velocity in x
891 BU_TAB[I_Breakup][5] = C * PY_BU / ETOT_BU; // Velocity in y
892 BU_TAB[I_Breakup][6] = C * PZ_BU / ETOT_BU; // Velocity in z
893 // Contribution from Coulomb repulsion:
894 tke_bu(BU_TAB[I_Breakup][0], BU_TAB[I_Breakup][1], ZAINCL, AAINCL, &VX2_BU, &VY2_BU, &VZ2_BU);
895 // Lorentz kinematics
896 // BU_TAB(I_Breakup,5) = BU_TAB(I_Breakup,5) + VX2_BU ! velocity
897 // change by Coulomb repulsion BU_TAB(I_Breakup,6) =
898 // BU_TAB(I_Breakup,6) + VY2_BU BU_TAB(I_Breakup,7) =
899 // BU_TAB(I_Breakup,7) + VZ2_BU
900 // Lorentz transformation
901 lorentz_boost(VX2_BU,
902 VY2_BU,
903 VZ2_BU,
904 BU_TAB[I_Breakup][4],
905 BU_TAB[I_Breakup][5],
906 BU_TAB[I_Breakup][6],
907 &VXOUT,
908 &VYOUT,
909 &VZOUT);
910
911 BU_TAB[I_Breakup][4] = VXOUT;
912 BU_TAB[I_Breakup][5] = VYOUT;
913 BU_TAB[I_Breakup][6] = VZOUT;
914
915 // Total momentum: Goldhaber + Coulomb
916 VBU2 = BU_TAB[I_Breakup][4] * BU_TAB[I_Breakup][4] + BU_TAB[I_Breakup][5] * BU_TAB[I_Breakup][5] +
917 BU_TAB[I_Breakup][6] * BU_TAB[I_Breakup][6];
918 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C * C));
919 ETOT_BU = BU_TAB[I_Breakup][1] * amu / GAMMA_REL;
920 PX_BU = ETOT_BU * BU_TAB[I_Breakup][4] / C;
921 PY_BU = ETOT_BU * BU_TAB[I_Breakup][5] / C;
922 PZ_BU = ETOT_BU * BU_TAB[I_Breakup][6] / C;
923
924 PX_BU_SUM = PX_BU_SUM + PX_BU;
925 PY_BU_SUM = PY_BU_SUM + PY_BU;
926 PZ_BU_SUM = PZ_BU_SUM + PZ_BU;
927
928 } // for I_Breakup
929
930 // In the frame of source (i.e. prefragment after abrasion or INCL)
931 P_BU_SUM = std::sqrt(PX_BU_SUM * PX_BU_SUM + PY_BU_SUM * PY_BU_SUM + PZ_BU_SUM * PZ_BU_SUM);
932 // ********************************************************
933 // PPRFP is in MeV/c
934 ETOT_SUM = std::sqrt(P_BU_SUM * P_BU_SUM + (AAINCL * amu) * (AAINCL * amu));
935
936 VX_BU_SUM = C * PX_BU_SUM / ETOT_SUM;
937 VY_BU_SUM = C * PY_BU_SUM / ETOT_SUM;
938 VZ_BU_SUM = C * PZ_BU_SUM / ETOT_SUM;
939
940 // Lorentz kinematics - DM 17/5/2010
941 // VX_PREF = VX_PREF - VX_BU_SUM
942 // VY_PREF = VY_PREF - VY_BU_SUM
943 // VZ_PREF = VZ_PREF - VZ_BU_SUM
944 // Lorentz transformation
945 lorentz_boost(-VX_BU_SUM, -VY_BU_SUM, -VZ_BU_SUM, VX_PREF, VY_PREF, VZ_PREF, &VXOUT, &VYOUT, &VZOUT);
946
947 VX_PREF = VXOUT;
948 VY_PREF = VYOUT;
949 VZ_PREF = VZOUT;
950
951 VBU2 = VX_PREF * VX_PREF + VY_PREF * VY_PREF + VZ_PREF * VZ_PREF;
952 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C * C));
953 ETOT_PRF = aprf * amu / GAMMA_REL;
954 PXPRFP = ETOT_PRF * VX_PREF / C;
955 PYPRFP = ETOT_PRF * VY_PREF / C;
956 PZPRFP = ETOT_PRF * VZ_PREF / C;
957
958 PX_BU_SUM = 0.0;
959 PY_BU_SUM = 0.0;
960 PZ_BU_SUM = 0.0;
961
962 PX_BU_SUM = PXPRFP;
963 PY_BU_SUM = PYPRFP;
964 PZ_BU_SUM = PZPRFP;
965 E_tot_BU = ETOT_PRF;
966
967 EKIN_BU = aprf * amu / GAMMA_REL - aprf * amu;
968
969 for (I_Breakup = 0; I_Breakup < IMULTBU; I_Breakup++)
970 {
971 // Lorentz kinematics - DM 17/5/2010
972 // BU_TAB(I_Breakup,5) = BU_TAB(I_Breakup,5) - VX_BU_SUM
973 // BU_TAB(I_Breakup,6) = BU_TAB(I_Breakup,6) - VY_BU_SUM
974 // BU_TAB(I_Breakup,7) = BU_TAB(I_Breakup,7) - VZ_BU_SUM
975 // Lorentz transformation
976 lorentz_boost(-VX_BU_SUM,
977 -VY_BU_SUM,
978 -VZ_BU_SUM,
979 BU_TAB[I_Breakup][4],
980 BU_TAB[I_Breakup][5],
981 BU_TAB[I_Breakup][6],
982 &VXOUT,
983 &VYOUT,
984 &VZOUT);
985
986 BU_TAB[I_Breakup][4] = VXOUT;
987 BU_TAB[I_Breakup][5] = VYOUT;
988 BU_TAB[I_Breakup][6] = VZOUT;
989
990 VBU2 = BU_TAB[I_Breakup][4] * BU_TAB[I_Breakup][4] + BU_TAB[I_Breakup][5] * BU_TAB[I_Breakup][5] +
991 BU_TAB[I_Breakup][6] * BU_TAB[I_Breakup][6];
992 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C * C));
993
994 ETOT_BU = BU_TAB[I_Breakup][1] * amu / GAMMA_REL;
995
996 EKIN_BU = EKIN_BU + BU_TAB[I_Breakup][1] * amu / GAMMA_REL - BU_TAB[I_Breakup][1] * amu;
997
998 PX_BU = ETOT_BU * BU_TAB[I_Breakup][4] / C;
999 PY_BU = ETOT_BU * BU_TAB[I_Breakup][5] / C;
1000 PZ_BU = ETOT_BU * BU_TAB[I_Breakup][6] / C;
1001 E_tot_BU = E_tot_BU + ETOT_BU;
1002
1003 PX_BU_SUM = PX_BU_SUM + PX_BU;
1004 PY_BU_SUM = PY_BU_SUM + PY_BU;
1005 PZ_BU_SUM = PZ_BU_SUM + PZ_BU;
1006 } // for I_Breakup
1007
1008 if (std::abs(PX_BU_SUM) > 10. || std::abs(PY_BU_SUM) > 10. || std::abs(PZ_BU_SUM) > 10.)
1009 {
1010
1011 // In the frame of source (i.e. prefragment after INCL)
1012 P_BU_SUM = std::sqrt(PX_BU_SUM * PX_BU_SUM + PY_BU_SUM * PY_BU_SUM + PZ_BU_SUM * PZ_BU_SUM);
1013 // ********************************************************
1014 // PPRFP is in MeV/c
1015 ETOT_SUM = std::sqrt(P_BU_SUM * P_BU_SUM + (AAINCL * amu) * (AAINCL * amu));
1016
1017 VX_BU_SUM = C * PX_BU_SUM / ETOT_SUM;
1018 VY_BU_SUM = C * PY_BU_SUM / ETOT_SUM;
1019 VZ_BU_SUM = C * PZ_BU_SUM / ETOT_SUM;
1020
1021 // Lorentz kinematics
1022 // VX_PREF = VX_PREF - VX_BU_SUM
1023 // VY_PREF = VY_PREF - VY_BU_SUM
1024 // VZ_PREF = VZ_PREF - VZ_BU_SUM
1025 // Lorentz transformation
1026 lorentz_boost(-VX_BU_SUM, -VY_BU_SUM, -VZ_BU_SUM, VX_PREF, VY_PREF, VZ_PREF, &VXOUT, &VYOUT, &VZOUT);
1027
1028 VX_PREF = VXOUT;
1029 VY_PREF = VYOUT;
1030 VZ_PREF = VZOUT;
1031
1032 VBU2 = VX_PREF * VX_PREF + VY_PREF * VY_PREF + VZ_PREF * VZ_PREF;
1033 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C * C));
1034 ETOT_PRF = aprf * amu / GAMMA_REL;
1035 PXPRFP = ETOT_PRF * VX_PREF / C;
1036 PYPRFP = ETOT_PRF * VY_PREF / C;
1037 PZPRFP = ETOT_PRF * VZ_PREF / C;
1038
1039 PX_BU_SUM = 0.0;
1040 PY_BU_SUM = 0.0;
1041 PZ_BU_SUM = 0.0;
1042
1043 PX_BU_SUM = PXPRFP;
1044 PY_BU_SUM = PYPRFP;
1045 PZ_BU_SUM = PZPRFP;
1046 E_tot_BU = ETOT_PRF;
1047
1048 EKIN_BU = aprf * amu / GAMMA_REL - aprf * amu;
1049
1050 for (I_Breakup = 0; I_Breakup < IMULTBU; I_Breakup++)
1051 {
1052 // Lorentz kinematics - DM 17/5/2010
1053 // BU_TAB(I_Breakup,5) = BU_TAB(I_Breakup,5) - VX_BU_SUM
1054 // BU_TAB(I_Breakup,6) = BU_TAB(I_Breakup,6) - VY_BU_SUM
1055 // BU_TAB(I_Breakup,7) = BU_TAB(I_Breakup,7) - VZ_BU_SUM
1056 // Lorentz transformation
1057 lorentz_boost(-VX_BU_SUM,
1058 -VY_BU_SUM,
1059 -VZ_BU_SUM,
1060 BU_TAB[I_Breakup][4],
1061 BU_TAB[I_Breakup][5],
1062 BU_TAB[I_Breakup][6],
1063 &VXOUT,
1064 &VYOUT,
1065 &VZOUT);
1066
1067 BU_TAB[I_Breakup][4] = VXOUT;
1068 BU_TAB[I_Breakup][5] = VYOUT;
1069 BU_TAB[I_Breakup][6] = VZOUT;
1070
1071 VBU2 = BU_TAB[I_Breakup][4] * BU_TAB[I_Breakup][4] + BU_TAB[I_Breakup][5] * BU_TAB[I_Breakup][5] +
1072 BU_TAB[I_Breakup][6] * BU_TAB[I_Breakup][6];
1073 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C * C));
1074
1075 ETOT_BU = BU_TAB[I_Breakup][1] * amu / GAMMA_REL;
1076
1077 EKIN_BU = EKIN_BU + BU_TAB[I_Breakup][1] * amu / GAMMA_REL - BU_TAB[I_Breakup][1] * amu;
1078
1079 PX_BU = ETOT_BU * BU_TAB[I_Breakup][4] / C;
1080 PY_BU = ETOT_BU * BU_TAB[I_Breakup][5] / C;
1081 PZ_BU = ETOT_BU * BU_TAB[I_Breakup][6] / C;
1082 E_tot_BU = E_tot_BU + ETOT_BU;
1083
1084 PX_BU_SUM = PX_BU_SUM + PX_BU;
1085 PY_BU_SUM = PY_BU_SUM + PY_BU;
1086 PZ_BU_SUM = PZ_BU_SUM + PZ_BU;
1087 } // for I_Breakup
1088 } // if DABS(PX_BU_SUM).GT.10.d0
1089 //
1090 // Find the limits that fragment is bound - only done for neutrons and
1091 // LCPs and for nuclei with A=Z, for other nuclei it will be done after
1092 // decay:
1093
1094 INEWLOOP = 0;
1095 for (G4int i = 0; i < IMULTBU; i++)
1096 {
1097 if (BU_TAB[i][0] < 3.0 || BU_TAB[i][0] == BU_TAB[i][1])
1098 {
1099 unstable_nuclei(idnint(BU_TAB[i][1]),
1100 idnint(BU_TAB[i][0]),
1101 &afpnew,
1102 &zfpnew,
1103 IOUNSTABLE,
1104 BU_TAB[i][4],
1105 BU_TAB[i][5],
1106 BU_TAB[i][6],
1107 &VP1X,
1108 &VP1Y,
1109 &VP1Z,
1110 BU_TAB_TEMP,
1111 &ILOOP);
1112
1113 if (IOUNSTABLE > 0)
1114 {
1115 // Properties of "heavy fragment":
1116 BU_TAB[i][1] = G4double(afpnew);
1117 BU_TAB[i][0] = G4double(zfpnew);
1118 BU_TAB[i][4] = VP1X;
1119 BU_TAB[i][5] = VP1Y;
1120 BU_TAB[i][6] = VP1Z;
1121
1122 // Properties of "light" fragments:
1123 for (int IJ = 0; IJ < ILOOP; IJ++)
1124 {
1125 BU_TAB[IMULTBU + INEWLOOP + IJ][0] = BU_TAB_TEMP[IJ][0];
1126 BU_TAB[IMULTBU + INEWLOOP + IJ][1] = BU_TAB_TEMP[IJ][1];
1127 BU_TAB[IMULTBU + INEWLOOP + IJ][4] = BU_TAB_TEMP[IJ][2];
1128 BU_TAB[IMULTBU + INEWLOOP + IJ][5] = BU_TAB_TEMP[IJ][3];
1129 BU_TAB[IMULTBU + INEWLOOP + IJ][6] = BU_TAB_TEMP[IJ][4];
1130 BU_TAB[IMULTBU + INEWLOOP + IJ][2] = 0.0;
1131 BU_TAB[IMULTBU + INEWLOOP + IJ][3] = 0.0;
1132 } // for ILOOP
1133
1134 INEWLOOP = INEWLOOP + ILOOP;
1135
1136 } // if IOUNSTABLE.GT.0
1137 } // if BU_TAB[I_Breakup][0]<3.0
1138 } // for IMULTBU
1139
1140 // Increased array of BU_TAB
1141 IMULTBU = IMULTBU + INEWLOOP;
1142 // Evaporation from multifragmentation products
1143 opt->optimfallowed = 1; // IMF is allowed
1144 fiss->ifis = 0; // fission is not allowed
1145 gammaemission = 0;
1146 ILOOPBU = 0;
1147
1148 // Arrays for lambda emission from breakup fragments
1149 G4double* problamb;
1150 problamb = new G4double[IMULTBU];
1151 G4double sumN = aprf - zprf;
1152 for (G4int i = 0; i < IMULTBU; i++)
1153 sumN = sumN + BU_TAB[i][1] - BU_TAB[i][0];
1154
1155 for (G4int i = 0; i < IMULTBU; i++)
1156 {
1157 problamb[i] = (BU_TAB[i][1] - BU_TAB[i][0]) / sumN;
1158 }
1159 G4int* Nblamb;
1160 Nblamb = new G4int[IMULTBU];
1161 for (G4int i = 0; i < IMULTBU; i++)
1162 Nblamb[i] = 0;
1163 for (G4int j = 0; j < NbLam0;)
1164 {
1165 G4double probtotal = (aprf - zprf) / sumN;
1166 G4double ran = G4AblaRandom::flat();
1167 // Lambdas in the heavy breakup fragment
1168 if (ran <= probtotal)
1169 {
1170 NbLamprf++;
1171 goto directlamb0;
1172 }
1173 for (G4int i = 0; i < IMULTBU; i++)
1174 {
1175 // Lambdas in the light breakup residues
1176 if (probtotal < ran && ran <= probtotal + problamb[i])
1177 {
1178 Nblamb[i] = Nblamb[i] + 1;
1179 goto directlamb0;
1180 }
1181 probtotal = probtotal + problamb[i];
1182 }
1183 directlamb0:
1184 j++;
1185 }
1186 //
1187 for (G4int i = 0; i < IMULTBU; i++)
1188 {
1189 EEBU = BU_TAB[i][2];
1190 BU_TAB[i][10] = BU_TAB[i][6];
1191 G4double jprfbu = BU_TAB[i][9];
1192 if (BU_TAB[i][0] > 2.0)
1193 {
1194 G4int nbl = Nblamb[i];
1195 evapora(BU_TAB[i][0],
1196 BU_TAB[i][1],
1197 &EEBU,
1198 0.0,
1199 &ZFBU,
1200 &AFBU,
1201 &mtota,
1202 &vz_evabu,
1203 &vx_evabu,
1204 &vy_evabu,
1205 &ff,
1206 &fimf,
1207 &ZIMFBU,
1208 &AIMFBU,
1209 &TKEIMFBU,
1210 &jprfbu,
1211 &inttype,
1212 &inum,
1213 EV_TEMP,
1214 &IEV_TAB_TEMP,
1215 &nbl);
1216
1217 Nblamb[i] = nbl;
1218 BU_TAB[i][9] = jprfbu;
1219
1220 // Velocities of evaporated particles (in the frame of the primary
1221 // prefragment)
1222 for (G4int IJ = 0; IJ < IEV_TAB_TEMP; IJ++)
1223 {
1224 EV_TAB[IJ + IEV_TAB][0] = EV_TEMP[IJ][0];
1225 EV_TAB[IJ + IEV_TAB][1] = EV_TEMP[IJ][1];
1226 EV_TAB[IJ + IEV_TAB][5] = EV_TEMP[IJ][5];
1227 // Lorentz kinematics
1228 // DO IK = 3, 5, 1
1229 // EV_TAB(IJ+IEV_TAB,IK) = EV_TEMP(IJ,IK) +
1230 // BU_TAB(I,IK+2) ENDDO
1231 // Lorentz transformation
1232 lorentz_boost(BU_TAB[i][4],
1233 BU_TAB[i][5],
1234 BU_TAB[i][6],
1235 EV_TEMP[IJ][2],
1236 EV_TEMP[IJ][3],
1237 EV_TEMP[IJ][4],
1238 &VXOUT,
1239 &VYOUT,
1240 &VZOUT);
1241 EV_TAB[IJ + IEV_TAB][2] = VXOUT;
1242 EV_TAB[IJ + IEV_TAB][3] = VYOUT;
1243 EV_TAB[IJ + IEV_TAB][4] = VZOUT;
1244 }
1245 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1246
1247 // All velocities in the frame of the "primary" prefragment (after INC)
1248 // Lorentz kinematics
1249 // BU_TAB(I,5) = BU_TAB(I,5) + VX_EVABU
1250 // BU_TAB(I,6) = BU_TAB(I,6) + VY_EVABU
1251 // BU_TAB(I,7) = BU_TAB(I,7) + VZ_EVABU
1252 // Lorentz transformation
1253 lorentz_boost(
1254 vx_evabu, vy_evabu, vz_evabu, BU_TAB[i][4], BU_TAB[i][5], BU_TAB[i][6], &VXOUT, &VYOUT, &VZOUT);
1255 BU_TAB[i][4] = VXOUT;
1256 BU_TAB[i][5] = VYOUT;
1257 BU_TAB[i][6] = VZOUT;
1258
1259 if (fimf == 0)
1260 {
1261 BU_TAB[i][7] = dint(ZFBU);
1262 BU_TAB[i][8] = dint(AFBU);
1263 BU_TAB[i][11] = nbl;
1264 } // if fimf==0
1265
1266 if (fimf == 1)
1267 {
1268 // PRINT*,'IMF EMISSION FROM BU PRODUCTS'
1269 // IMF emission: Heavy partner is not allowed to fission or to emitt
1270 // IMF.
1271 // double FEE = EEBU;
1272 G4int FFBU1 = 0;
1273 G4int FIMFBU1 = 0;
1274 opt->optimfallowed = 0; // IMF is not allowed
1275 fiss->ifis = 0; // fission is not allowed
1276 // Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
1277 G4double EkinR1 = TKEIMFBU * AIMFBU / (AFBU + AIMFBU);
1278 G4double EkinR2 = TKEIMFBU * AFBU / (AFBU + AIMFBU);
1279 G4double V1 = std::sqrt(EkinR1 / AFBU) * 1.3887;
1280 G4double V2 = std::sqrt(EkinR2 / AIMFBU) * 1.3887;
1281 G4double VZ1_IMF = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
1282 G4double VPERP1 = std::sqrt(V1 * V1 - VZ1_IMF * VZ1_IMF);
1283 G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
1284 G4double VX1_IMF = VPERP1 * std::sin(ALPHA1);
1285 G4double VY1_IMF = VPERP1 * std::cos(ALPHA1);
1286 G4double VX2_IMF = -VX1_IMF / V1 * V2;
1287 G4double VY2_IMF = -VY1_IMF / V1 * V2;
1288 G4double VZ2_IMF = -VZ1_IMF / V1 * V2;
1289
1290 G4double EEIMFP = EEBU * AFBU / (AFBU + AIMFBU);
1291 G4double EEIMF = EEBU * AIMFBU / (AFBU + AIMFBU);
1292
1293 // Decay of heavy partner
1294 G4double IINERTTOT =
1295 0.40 * 931.490 * 1.160 * 1.160 * (std::pow(AIMFBU, 5.0 / 3.0) + std::pow(AFBU, 5.0 / 3.0)) +
1296 931.490 * 1.160 * 1.160 * AIMFBU * AFBU / (AIMFBU + AFBU) *
1297 (std::pow(AIMFBU, 1. / 3.) + std::pow(AFBU, 1. / 3.)) *
1298 (std::pow(AIMFBU, 1. / 3.) + std::pow(AFBU, 1. / 3.));
1299
1300 G4double JPRFHEAVY =
1301 BU_TAB[i][9] * 0.4 * 931.49 * 1.16 * 1.16 * std::pow(AFBU, 5.0 / 3.0) / IINERTTOT;
1302 G4double JPRFLIGHT =
1303 BU_TAB[i][9] * 0.4 * 931.49 * 1.16 * 1.16 * std::pow(AIMFBU, 5.0 / 3.0) / IINERTTOT;
1304
1305 // Lorentz kinematics
1306 // BU_TAB(I,5) = BU_TAB(I,5) + VX1_IMF
1307 // BU_TAB(I,6) = BU_TAB(I,6) + VY1_IMF
1308 // BU_TAB(I,7) = BU_TAB(I,7) + VZ1_IMF
1309 // Lorentz transformation
1310 lorentz_boost(
1311 VX1_IMF, VY1_IMF, VZ1_IMF, BU_TAB[i][4], BU_TAB[i][5], BU_TAB[i][6], &VXOUT, &VYOUT, &VZOUT);
1312 BU_TAB[i][4] = VXOUT;
1313 BU_TAB[i][5] = VYOUT;
1314 BU_TAB[i][6] = VZOUT;
1315
1316 G4double vx1ev_imf = 0., vy1ev_imf = 0., vz1ev_imf = 0., zdummy = 0., adummy = 0., tkedummy = 0.,
1317 jprf1 = 0.;
1318
1319 // Lambda particles
1320 G4int NbLamH = 0;
1321 G4int NbLamimf = 0;
1322 G4double pbH = (AFBU - ZFBU) / (AFBU - ZFBU + AIMFBU - ZIMFBU);
1323 for (G4int j = 0; j < nbl; j++)
1324 {
1325 if (G4AblaRandom::flat() < pbH)
1326 {
1327 NbLamH++;
1328 }
1329 else
1330 {
1331 NbLamimf++;
1332 }
1333 }
1334 // Decay of IMF's partner:
1335 evapora(ZFBU,
1336 AFBU,
1337 &EEIMFP,
1338 JPRFHEAVY,
1339 &ZFFBU,
1340 &AFFBU,
1341 &mtota,
1342 &vz1ev_imf,
1343 &vx1ev_imf,
1344 &vy1ev_imf,
1345 &FFBU1,
1346 &FIMFBU1,
1347 &zdummy,
1348 &adummy,
1349 &tkedummy,
1350 &jprf1,
1351 &inttype,
1352 &inum,
1353 EV_TEMP,
1354 &IEV_TAB_TEMP,
1355 &NbLamH);
1356
1357 for (G4int IJ = 0; IJ < IEV_TAB_TEMP; IJ++)
1358 {
1359 EV_TAB[IJ + IEV_TAB][0] = EV_TEMP[IJ][0];
1360 EV_TAB[IJ + IEV_TAB][1] = EV_TEMP[IJ][1];
1361 EV_TAB[IJ + IEV_TAB][5] = EV_TEMP[IJ][5];
1362 // Lorentz kinematics
1363 // DO IK = 3, 5, 1
1364 // EV_TAB(IJ+IEV_TAB,IK) = EV_TEMP(IJ,IK) +
1365 // BU_TAB(I,IK+2) ENDDO
1366 // Lorentz transformation
1367 lorentz_boost(BU_TAB[i][4],
1368 BU_TAB[i][5],
1369 BU_TAB[i][6],
1370 EV_TEMP[IJ][2],
1371 EV_TEMP[IJ][3],
1372 EV_TEMP[IJ][4],
1373 &VXOUT,
1374 &VYOUT,
1375 &VZOUT);
1376 EV_TAB[IJ + IEV_TAB][2] = VXOUT;
1377 EV_TAB[IJ + IEV_TAB][3] = VYOUT;
1378 EV_TAB[IJ + IEV_TAB][4] = VZOUT;
1379 }
1380 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1381
1382 BU_TAB[i][7] = dint(ZFFBU);
1383 BU_TAB[i][8] = dint(AFFBU);
1384 BU_TAB[i][11] = NbLamH;
1385 // Lorentz kinematics
1386 // BU_TAB(I,5) = BU_TAB(I,5) + vx1ev_imf
1387 // BU_TAB(I,6) = BU_TAB(I,6) + vy1ev_imf
1388 // BU_TAB(I,7) = BU_TAB(I,7) + vz1ev_imf
1389 lorentz_boost(vx1ev_imf,
1390 vy1ev_imf,
1391 vz1ev_imf,
1392 BU_TAB[i][4],
1393 BU_TAB[i][5],
1394 BU_TAB[i][6],
1395 &VXOUT,
1396 &VYOUT,
1397 &VZOUT);
1398 BU_TAB[i][4] = VXOUT;
1399 BU_TAB[i][5] = VYOUT;
1400 BU_TAB[i][6] = VZOUT;
1401 // For IMF - fission and IMF emission are not allowed
1402 G4int FFBU2 = 0;
1403 G4int FIMFBU2 = 0;
1404 opt->optimfallowed = 0; // IMF is not allowed
1405 fiss->ifis = 0; // fission is not allowed
1406 // Decay of IMF
1407 G4double zffimf, affimf, zdummy1, adummy1, tkedummy1, jprf2, vx2ev_imf, vy2ev_imf, vz2ev_imf;
1408
1409 evapora(ZIMFBU,
1410 AIMFBU,
1411 &EEIMF,
1412 JPRFLIGHT,
1413 &zffimf,
1414 &affimf,
1415 &mtota,
1416 &vz2ev_imf,
1417 &vx2ev_imf,
1418 &vy2ev_imf,
1419 &FFBU2,
1420 &FIMFBU2,
1421 &zdummy1,
1422 &adummy1,
1423 &tkedummy1,
1424 &jprf2,
1425 &inttype,
1426 &inum,
1427 EV_TEMP,
1428 &IEV_TAB_TEMP,
1429 &NbLamimf);
1430
1431 for (G4int IJ = 0; IJ < IEV_TAB_TEMP; IJ++)
1432 {
1433 EV_TAB[IJ + IEV_TAB][0] = EV_TEMP[IJ][0];
1434 EV_TAB[IJ + IEV_TAB][1] = EV_TEMP[IJ][1];
1435 EV_TAB[IJ + IEV_TAB][5] = EV_TEMP[IJ][5];
1436 // Lorentz kinematics
1437 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + BU_TAB(I,5)
1438 // +VX2_IMF EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) +
1439 // BU_TAB(I,6) +VY2_IMF EV_TAB(IJ+IEV_TAB,5) =
1440 // EV_TEMP(IJ,5) + BU_TAB(I,7) +VZ2_IMF
1441 // Lorentz transformation
1442 lorentz_boost(BU_TAB[i][4],
1443 BU_TAB[i][5],
1444 BU_TAB[i][6],
1445 EV_TEMP[IJ][2],
1446 EV_TEMP[IJ][3],
1447 EV_TEMP[IJ][4],
1448 &VXOUT,
1449 &VYOUT,
1450 &VZOUT);
1451 lorentz_boost(VX2_IMF, VY2_IMF, VZ2_IMF, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
1452 EV_TAB[IJ + IEV_TAB][2] = VX2OUT;
1453 EV_TAB[IJ + IEV_TAB][3] = VY2OUT;
1454 EV_TAB[IJ + IEV_TAB][4] = VZ2OUT;
1455 }
1456 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1457
1458 BU_TAB[IMULTBU + ILOOPBU][0] = BU_TAB[i][0];
1459 BU_TAB[IMULTBU + ILOOPBU][1] = BU_TAB[i][1];
1460 BU_TAB[IMULTBU + ILOOPBU][2] = BU_TAB[i][2];
1461 BU_TAB[IMULTBU + ILOOPBU][3] = BU_TAB[i][3];
1462 BU_TAB[IMULTBU + ILOOPBU][7] = dint(zffimf);
1463 BU_TAB[IMULTBU + ILOOPBU][8] = dint(affimf);
1464 BU_TAB[IMULTBU + ILOOPBU][11] = NbLamimf;
1465 // Lorentz transformation
1466 lorentz_boost(
1467 VX2_IMF, VY2_IMF, VZ2_IMF, BU_TAB[i][4], BU_TAB[i][5], BU_TAB[i][6], &VXOUT, &VYOUT, &VZOUT);
1468 lorentz_boost(vx2ev_imf, vy2ev_imf, vz2ev_imf, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
1469 BU_TAB[IMULTBU + ILOOPBU][4] = VX2OUT;
1470 BU_TAB[IMULTBU + ILOOPBU][5] = VY2OUT;
1471 BU_TAB[IMULTBU + ILOOPBU][6] = VZ2OUT;
1472 ILOOPBU = ILOOPBU + 1;
1473 } // if fimf==1
1474 }
1475 else
1476 { // if BU_TAB(I,1).GT.2.D0
1477 // BU_TAB[i][0] = BU_TAB[i][0];
1478 // BU_TAB[i][1] = BU_TAB[i][1];
1479 // BU_TAB[i][2] = BU_TAB[i][2];
1480 // BU_TAB[i][3] = BU_TAB[i][3];
1481 BU_TAB[i][7] = BU_TAB[i][0];
1482 BU_TAB[i][8] = BU_TAB[i][1];
1483 // BU_TAB[i][4] = BU_TAB[i][4];
1484 // BU_TAB[i][5] = BU_TAB[i][5];
1485 // BU_TAB[i][6] = BU_TAB[i][6];
1486 BU_TAB[i][11] = Nblamb[i];
1487 } // if BU_TAB(I,1).GT.2.D0
1488 } // for IMULTBU
1489
1490 IMULTBU = IMULTBU + ILOOPBU;
1491 //
1492 // RESOLVE UNSTABLE NUCLEI
1493 //
1494 INEWLOOP = 0;
1495 ABU_SUM = 0.0;
1496 ZBU_SUM = 0.0;
1497 //
1498 for (G4int i = 0; i < IMULTBU; i++)
1499 {
1500 ABU_SUM = ABU_SUM + BU_TAB[i][8];
1501 ZBU_SUM = ZBU_SUM + BU_TAB[i][7];
1502 unstable_nuclei(idnint(BU_TAB[i][8]),
1503 idnint(BU_TAB[i][7]),
1504 &afpnew,
1505 &zfpnew,
1506 IOUNSTABLE,
1507 BU_TAB[i][4],
1508 BU_TAB[i][5],
1509 BU_TAB[i][6],
1510 &VP1X,
1511 &VP1Y,
1512 &VP1Z,
1513 BU_TAB_TEMP1,
1514 &ILOOP);
1515
1516 // From now on, all neutrons and LCP created in above subroutine are part
1517 // of the
1518 // BU_TAB array (see below - Properties of "light" fragments). Therefore,
1519 // NEVA, PEVA ... are not needed any more in the break-up stage.
1520
1521 if (IOUNSTABLE > 0)
1522 {
1523 // Properties of "heavy fragment":
1524 ABU_SUM = ABU_SUM + G4double(afpnew) - BU_TAB[i][8];
1525 ZBU_SUM = ZBU_SUM + G4double(zfpnew) - BU_TAB[i][7];
1526 BU_TAB[i][8] = G4double(afpnew);
1527 BU_TAB[i][7] = G4double(zfpnew);
1528 BU_TAB[i][4] = VP1X;
1529 BU_TAB[i][5] = VP1Y;
1530 BU_TAB[i][6] = VP1Z;
1531
1532 // Properties of "light" fragments:
1533 for (G4int IJ = 0; IJ < ILOOP; IJ++)
1534 {
1535 BU_TAB[IMULTBU + INEWLOOP + IJ][7] = BU_TAB_TEMP1[IJ][0];
1536 BU_TAB[IMULTBU + INEWLOOP + IJ][8] = BU_TAB_TEMP1[IJ][1];
1537 BU_TAB[IMULTBU + INEWLOOP + IJ][4] = BU_TAB_TEMP1[IJ][2];
1538 BU_TAB[IMULTBU + INEWLOOP + IJ][5] = BU_TAB_TEMP1[IJ][3];
1539 BU_TAB[IMULTBU + INEWLOOP + IJ][6] = BU_TAB_TEMP1[IJ][4];
1540 BU_TAB[IMULTBU + INEWLOOP + IJ][2] = 0.0;
1541 BU_TAB[IMULTBU + INEWLOOP + IJ][3] = 0.0;
1542 BU_TAB[IMULTBU + INEWLOOP + IJ][0] = BU_TAB[i][0];
1543 BU_TAB[IMULTBU + INEWLOOP + IJ][1] = BU_TAB[i][1];
1544 BU_TAB[IMULTBU + INEWLOOP + IJ][11] = BU_TAB[i][11];
1545 ABU_SUM = ABU_SUM + BU_TAB[IMULTBU + INEWLOOP + IJ][8];
1546 ZBU_SUM = ZBU_SUM + BU_TAB[IMULTBU + INEWLOOP + IJ][7];
1547 } // for ILOOP
1548
1549 INEWLOOP = INEWLOOP + ILOOP;
1550 } // if(IOUNSTABLE>0)
1551 } // for IMULTBU unstable
1552
1553 // Increased array of BU_TAB
1554 IMULTBU = IMULTBU + INEWLOOP;
1555
1556 // Transform all velocities into the rest frame of the projectile
1557 lorentz_boost(VX_incl, VY_incl, VZ_incl, VX_PREF, VY_PREF, VZ_PREF, &VXOUT, &VYOUT, &VZOUT);
1558 VX_PREF = VXOUT;
1559 VY_PREF = VYOUT;
1560 VZ_PREF = VZOUT;
1561
1562 for (G4int i = 0; i < IMULTBU; i++)
1563 {
1564 lorentz_boost(VX_incl, VY_incl, VZ_incl, BU_TAB[i][4], BU_TAB[i][5], BU_TAB[i][6], &VXOUT, &VYOUT, &VZOUT);
1565 BU_TAB[i][4] = VXOUT;
1566 BU_TAB[i][5] = VYOUT;
1567 BU_TAB[i][6] = VZOUT;
1568 }
1569 for (G4int i = 0; i < IEV_TAB; i++)
1570 {
1571 lorentz_boost(VX_incl, VY_incl, VZ_incl, EV_TAB[i][2], EV_TAB[i][3], EV_TAB[i][4], &VXOUT, &VYOUT, &VZOUT);
1572 EV_TAB[i][2] = VXOUT;
1573 EV_TAB[i][3] = VYOUT;
1574 EV_TAB[i][4] = VZOUT;
1575 }
1576 if (IMULTBU > 200)
1577 std::cout << "IMULTBU>200 " << IMULTBU << std::endl;
1578 delete[] problamb;
1579 delete[] Nblamb;
1580 } // if(T_diff>0.1)
1581 // End of multi-fragmentation
1582 mult7777:
1583
1584 // Start basic de-excitation of fragments
1585 aprfp = idnint(aprf);
1586 zprfp = idnint(zprf);
1587
1588 if (IMULTIFR == 0)
1589 {
1590 // These momenta are in the frame of the projectile (or target in case of
1591 // direct kinematics)
1592 VX_PREF = VX_incl;
1593 VY_PREF = VY_incl;
1594 VZ_PREF = VZ_incl;
1595 }
1596 // Lambdas after multi-fragmentation
1597 if (IMULTIFR == 1)
1598 {
1599 NbLam0 = NbLamprf;
1600 }
1601 //
1602 // CALL THE EVAPORATION SUBROUTINE
1603 //
1604 opt->optimfallowed = 1; // IMF is allowed
1605 fiss->ifis = 1; // fission is allowed
1606 fimf = 0;
1607 ff = 0;
1608
1609 // To spare computing time; these events in any case cannot decay
1610 // IF(ZPRFP.LE.2.AND.ZPRFP.LT.APRFP)THEN FIXME: <= or <
1611 if (zprfp <= 2 && zprfp < aprfp)
1612 {
1613 zf = zprf;
1614 af = aprf;
1615 ee = 0.0;
1616 ff = 0;
1617 fimf = 0;
1618 ftype = 0;
1619 aimf = 0.0;
1620 zimf = 0.0;
1621 tkeimf = 0.0;
1622 vx_eva = 0.0;
1623 vy_eva = 0.0;
1624 vz_eva = 0.0;
1625 jprf0 = jprf;
1626 goto a1972;
1627 }
1628
1629 // if(ZPRFP.LE.2.AND.ZPRFP.EQ.APRFP)
1630 if (zprfp <= 2 && zprfp == aprfp)
1631 {
1632 unstable_nuclei(aprfp,
1633 zprfp,
1634 &afpnew,
1635 &zfpnew,
1636 IOUNSTABLE,
1637 VX_PREF,
1638 VY_PREF,
1639 VZ_PREF,
1640 &VP1X,
1641 &VP1Y,
1642 &VP1Z,
1643 EV_TAB_TEMP,
1644 &ILOOP);
1645 af = G4double(afpnew);
1646 zf = G4double(zfpnew);
1647 VX_PREF = VP1X;
1648 VY_PREF = VP1Y;
1649 VZ_PREF = VP1Z;
1650 for (G4int I = 0; I < ILOOP; I++)
1651 {
1652 for (G4int IJ = 0; IJ < 6; IJ++)
1653 EV_TAB[I + IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1654 }
1655 IEV_TAB = IEV_TAB + ILOOP;
1656 ee = 0.0;
1657 ff = 0;
1658 fimf = 0;
1659 ftype = 0;
1660 aimf = 0.0;
1661 zimf = 0.0;
1662 tkeimf = 0.0;
1663 vx_eva = 0.0;
1664 vy_eva = 0.0;
1665 vz_eva = 0.0;
1666 jprf0 = jprf;
1667 goto a1972;
1668 }
1669
1670 // IF(ZPRFP.EQ.APRFP)THEN
1671 if (zprfp == aprfp)
1672 {
1673 unstable_nuclei(aprfp,
1674 zprfp,
1675 &afpnew,
1676 &zfpnew,
1677 IOUNSTABLE,
1678 VX_PREF,
1679 VY_PREF,
1680 VZ_PREF,
1681 &VP1X,
1682 &VP1Y,
1683 &VP1Z,
1684 EV_TAB_TEMP,
1685 &ILOOP);
1686 af = G4double(afpnew);
1687 zf = G4double(zfpnew);
1688 VX_PREF = VP1X;
1689 VY_PREF = VP1Y;
1690 VZ_PREF = VP1Z;
1691 for (G4int I = 0; I < ILOOP; I++)
1692 {
1693 for (G4int IJ = 0; IJ < 6; IJ++)
1694 EV_TAB[I + IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1695 }
1696 IEV_TAB = IEV_TAB + ILOOP;
1697 ee = 0.0;
1698 ff = 0;
1699 fimf = 0;
1700 ftype = 0;
1701 aimf = 0.0;
1702 zimf = 0.0;
1703 tkeimf = 0.0;
1704 vx_eva = 0.0;
1705 vy_eva = 0.0;
1706 vz_eva = 0.0;
1707 jprf0 = jprf;
1708 goto a1972;
1709 }
1710 //
1711 evapora(zprf,
1712 aprf,
1713 &ee,
1714 jprf,
1715 &zf,
1716 &af,
1717 &mtota,
1718 &vz_eva,
1719 &vx_eva,
1720 &vy_eva,
1721 &ff,
1722 &fimf,
1723 &zimf,
1724 &aimf,
1725 &tkeimf,
1726 &jprf0,
1727 &inttype,
1728 &inum,
1729 EV_TEMP,
1730 &IEV_TAB_TEMP,
1731 &NbLam0);
1732 //
1733 for (G4int IJ = 0; IJ < IEV_TAB_TEMP; IJ++)
1734 {
1735 EV_TAB[IJ + IEV_TAB][0] = EV_TEMP[IJ][0];
1736 EV_TAB[IJ + IEV_TAB][1] = EV_TEMP[IJ][1];
1737 EV_TAB[IJ + IEV_TAB][5] = EV_TEMP[IJ][5];
1738 //
1739 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1740 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1741 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1742 // Lorentz transformation
1743 lorentz_boost(
1744 VX_PREF, VY_PREF, VZ_PREF, EV_TEMP[IJ][2], EV_TEMP[IJ][3], EV_TEMP[IJ][4], &VXOUT, &VYOUT, &VZOUT);
1745 EV_TAB[IJ + IEV_TAB][2] = VXOUT;
1746 EV_TAB[IJ + IEV_TAB][3] = VYOUT;
1747 EV_TAB[IJ + IEV_TAB][4] = VZOUT;
1748 }
1749 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1750
1751 a1972:
1752
1753 // vi_pref - velocity of the prefragment; vi_eva - recoil due to evaporation
1754 lorentz_boost(VX_PREF, VY_PREF, VZ_PREF, vx_eva, vy_eva, vz_eva, &VXOUT, &VYOUT, &VZOUT);
1755 V_CM[0] = VXOUT;
1756 V_CM[1] = VYOUT;
1757 V_CM[2] = VZOUT;
1758 //
1759 if (ff == 0 && fimf == 0)
1760 {
1761 // Evaporation of neutrons and LCP; no IMF, no fission
1762 ftype = 0;
1763 ZFP1 = idnint(zf);
1764 AFP1 = idnint(af);
1765 SFP1 = NbLam0;
1766 AFPIMF = 0;
1767 ZFPIMF = 0;
1768 SFPIMF = 0;
1769 ZFP2 = 0;
1770 AFP2 = 0;
1771 SFP2 = 0;
1772 VFP1_CM[0] = V_CM[0];
1773 VFP1_CM[1] = V_CM[1];
1774 VFP1_CM[2] = V_CM[2];
1775 for (G4int j = 0; j < 3; j++)
1776 {
1777 VIMF_CM[j] = 0.0;
1778 VFP2_CM[j] = 0.0;
1779 }
1780 }
1781 //
1782 if (ff == 1 && fimf == 0)
1783 ftype = 1; // fission
1784 if (ff == 0 && fimf == 1)
1785 ftype = 2; // IMF emission
1786 //
1787 // AFP,ZFP IS THE FINAL FRAGMENT IF NO FISSION OR IMF EMISSION OCCURS
1788 // IN CASE OF FISSION IT IS THE NUCLEUS THAT UNDERGOES FISSION OR IMF
1789 //
1790
1791 //***************** FISSION ***************************************
1792 //
1793 if (ftype == 1)
1794 {
1795 varntp->kfis = 1;
1796 if (NbLam0 > 0)
1797 varntp->kfis = 20;
1798 // ftype1=0;
1799
1800 G4int IEV_TAB_FIS = 0, imode = 0;
1801
1802 G4double vx1_fission = 0., vy1_fission = 0., vz1_fission = 0.;
1803 G4double vx2_fission = 0., vy2_fission = 0., vz2_fission = 0.;
1804 G4double vx_eva_sc = 0., vy_eva_sc = 0., vz_eva_sc = 0.;
1805
1806 fission(af,
1807 zf,
1808 ee,
1809 jprf0,
1810 &vx1_fission,
1811 &vy1_fission,
1812 &vz1_fission,
1813 &vx2_fission,
1814 &vy2_fission,
1815 &vz2_fission,
1816 &ZFP1,
1817 &AFP1,
1818 &SFP1,
1819 &ZFP2,
1820 &AFP2,
1821 &SFP2,
1822 &imode,
1823 &vx_eva_sc,
1824 &vy_eva_sc,
1825 &vz_eva_sc,
1826 EV_TEMP,
1827 &IEV_TAB_FIS,
1828 &NbLam0);
1829
1830 for (G4int IJ = 0; IJ < IEV_TAB_FIS; IJ++)
1831 {
1832 EV_TAB[IJ + IEV_TAB][0] = EV_TEMP[IJ][0];
1833 EV_TAB[IJ + IEV_TAB][1] = EV_TEMP[IJ][1];
1834 EV_TAB[IJ + IEV_TAB][5] = EV_TEMP[IJ][5];
1835 // Lorentz kinematics
1836 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1837 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1838 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1839 // Lorentz transformation
1840 lorentz_boost(
1841 V_CM[0], V_CM[1], V_CM[2], EV_TEMP[IJ][2], EV_TEMP[IJ][3], EV_TEMP[IJ][4], &VXOUT, &VYOUT, &VZOUT);
1842 EV_TAB[IJ + IEV_TAB][2] = VXOUT;
1843 EV_TAB[IJ + IEV_TAB][3] = VYOUT;
1844 EV_TAB[IJ + IEV_TAB][4] = VZOUT;
1845 }
1846 IEV_TAB = IEV_TAB + IEV_TAB_FIS;
1847
1848 // if(imode==1) ftype1 = 1; // S1 mode
1849 // if(imode==2) ftype1 = 2; // S2 mode
1850
1851 AFPIMF = 0;
1852 ZFPIMF = 0;
1853 SFPIMF = 0;
1854
1855 // VX_EVA_SC,VY_EVA_SC,VZ_EVA_SC - recoil due to particle emisison
1856 // between saddle and scission
1857 // Lorentz kinematics
1858 // VFP1_CM(1) = V_CM(1) + VX1_FISSION + VX_EVA_SC ! Velocity of FF1
1859 // in x VFP1_CM(2) = V_CM(2) + VY1_FISSION + VY_EVA_SC ! Velocity of
1860 // FF1 in y VFP1_CM(3) = V_CM(3) + VZ1_FISSION + VZ_EVA_SC ! Velocity
1861 // of FF1 in x
1862 lorentz_boost(vx1_fission, vy1_fission, vz1_fission, V_CM[0], V_CM[1], V_CM[2], &VXOUT, &VYOUT, &VZOUT);
1863 lorentz_boost(vx_eva_sc, vy_eva_sc, vz_eva_sc, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
1864 VFP1_CM[0] = VX2OUT;
1865 VFP1_CM[1] = VY2OUT;
1866 VFP1_CM[2] = VZ2OUT;
1867
1868 // Lorentz kinematics
1869 // VFP2_CM(1) = V_CM(1) + VX2_FISSION + VX_EVA_SC ! Velocity of FF2
1870 // in x VFP2_CM(2) = V_CM(2) + VY2_FISSION + VY_EVA_SC ! Velocity of
1871 // FF2 in y VFP2_CM(3) = V_CM(3) + VZ2_FISSION + VZ_EVA_SC ! Velocity
1872 // of FF2 in x
1873 lorentz_boost(vx2_fission, vy2_fission, vz2_fission, V_CM[0], V_CM[1], V_CM[2], &VXOUT, &VYOUT, &VZOUT);
1874 lorentz_boost(vx_eva_sc, vy_eva_sc, vz_eva_sc, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
1875 VFP2_CM[0] = VX2OUT;
1876 VFP2_CM[1] = VY2OUT;
1877 VFP2_CM[2] = VZ2OUT;
1878
1879 //************** IMF EMISSION
1880 //************************************************
1881 //
1882 }
1883 else if (ftype == 2)
1884 {
1885 // IMF emission: Heavy partner is allowed to fission and to emitt IMF, but
1886 // ONLY once.
1887 G4int FF11 = 0;
1888 G4int FIMF11 = 0;
1889 opt->optimfallowed = 1; // IMF is allowed
1890 fiss->ifis = 1; // fission is allowed
1891 // Lambda particles
1892 G4int NbLamH = 0;
1893 G4int NbLamimf = 0;
1894 G4double pbH = (af - zf) / (af - zf + aimf - zimf);
1895 // double pbL = aimf / (af+aimf);
1896 for (G4int i = 0; i < NbLam0; i++)
1897 {
1898 if (G4AblaRandom::flat() < pbH)
1899 {
1900 NbLamH++;
1901 }
1902 else
1903 {
1904 NbLamimf++;
1905 }
1906 }
1907 //
1908 // Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
1909 G4double EkinR1 = tkeimf * aimf / (af + aimf);
1910 G4double EkinR2 = tkeimf * af / (af + aimf);
1911 G4double V1 = std::sqrt(EkinR1 / af) * 1.3887;
1912 G4double V2 = std::sqrt(EkinR2 / aimf) * 1.3887;
1913 G4double VZ1_IMF = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
1914 G4double VPERP1 = std::sqrt(V1 * V1 - VZ1_IMF * VZ1_IMF);
1915 G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
1916 G4double VX1_IMF = VPERP1 * std::sin(ALPHA1);
1917 G4double VY1_IMF = VPERP1 * std::cos(ALPHA1);
1918 G4double VX2_IMF = -VX1_IMF / V1 * V2;
1919 G4double VY2_IMF = -VY1_IMF / V1 * V2;
1920 G4double VZ2_IMF = -VZ1_IMF / V1 * V2;
1921
1922 G4double EEIMFP = ee * af / (af + aimf);
1923 G4double EEIMF = ee * aimf / (af + aimf);
1924
1925 // Decay of heavy partner
1926 G4double IINERTTOT = 0.40 * 931.490 * 1.160 * 1.160 * (std::pow(aimf, 5.0 / 3.0) + std::pow(af, 5.0 / 3.0)) +
1927 931.490 * 1.160 * 1.160 * aimf * af / (aimf + af) *
1928 (std::pow(aimf, 1. / 3.) + std::pow(af, 1. / 3.)) *
1929 (std::pow(aimf, 1. / 3.) + std::pow(af, 1. / 3.));
1930
1931 G4double JPRFHEAVY = jprf0 * 0.4 * 931.49 * 1.16 * 1.16 * std::pow(af, 5.0 / 3.0) / IINERTTOT;
1932 G4double JPRFLIGHT = jprf0 * 0.4 * 931.49 * 1.16 * 1.16 * std::pow(aimf, 5.0 / 3.0) / IINERTTOT;
1933 if (af < 2.0)
1934 std::cout << "RN117-4,AF,ZF,EE,JPRFheavy" << std::endl;
1935
1936 G4double vx1ev_imf = 0., vy1ev_imf = 0., vz1ev_imf = 0., zdummy = 0., adummy = 0., tkedummy = 0., jprf1 = 0.;
1937
1938 evapora(zf,
1939 af,
1940 &EEIMFP,
1941 JPRFHEAVY,
1942 &zff,
1943 &aff,
1944 &mtota,
1945 &vz1ev_imf,
1946 &vx1ev_imf,
1947 &vy1ev_imf,
1948 &FF11,
1949 &FIMF11,
1950 &zdummy,
1951 &adummy,
1952 &tkedummy,
1953 &jprf1,
1954 &inttype,
1955 &inum,
1956 EV_TEMP,
1957 &IEV_TAB_TEMP,
1958 &NbLamH);
1959
1960 for (G4int IJ = 0; IJ < IEV_TAB_TEMP; IJ++)
1961 {
1962 EV_TAB[IJ + IEV_TAB][0] = EV_TEMP[IJ][0];
1963 EV_TAB[IJ + IEV_TAB][1] = EV_TEMP[IJ][1];
1964 EV_TAB[IJ + IEV_TAB][5] = EV_TEMP[IJ][5];
1965 //
1966 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1967 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1968 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1969 // Lorentz transformation
1970 lorentz_boost(
1971 V_CM[0], V_CM[1], V_CM[2], EV_TEMP[IJ][2], EV_TEMP[IJ][3], EV_TEMP[IJ][4], &VXOUT, &VYOUT, &VZOUT);
1972 lorentz_boost(vx1ev_imf, vy1ev_imf, vz1ev_imf, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
1973 EV_TAB[IJ + IEV_TAB][2] = VX2OUT;
1974 EV_TAB[IJ + IEV_TAB][3] = VY2OUT;
1975 EV_TAB[IJ + IEV_TAB][4] = VZ2OUT;
1976 }
1977 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1978
1979 // For IMF - fission and IMF emission are not allowed
1980 G4int FF22 = 0;
1981 G4int FIMF22 = 0;
1982 opt->optimfallowed = 0; // IMF is not allowed
1983 fiss->ifis = 0; // fission is not allowed
1984
1985 // Decay of IMF
1986 G4double zffimf, affimf, zdummy1 = 0., adummy1 = 0., tkedummy1 = 0., jprf2, vx2ev_imf, vy2ev_imf, vz2ev_imf;
1987
1988 evapora(zimf,
1989 aimf,
1990 &EEIMF,
1991 JPRFLIGHT,
1992 &zffimf,
1993 &affimf,
1994 &mtota,
1995 &vz2ev_imf,
1996 &vx2ev_imf,
1997 &vy2ev_imf,
1998 &FF22,
1999 &FIMF22,
2000 &zdummy1,
2001 &adummy1,
2002 &tkedummy1,
2003 &jprf2,
2004 &inttype,
2005 &inum,
2006 EV_TEMP,
2007 &IEV_TAB_TEMP,
2008 &NbLamimf);
2009
2010 for (G4int IJ = 0; IJ < IEV_TAB_TEMP; IJ++)
2011 {
2012 EV_TAB[IJ + IEV_TAB][0] = EV_TEMP[IJ][0];
2013 EV_TAB[IJ + IEV_TAB][1] = EV_TEMP[IJ][1];
2014 EV_TAB[IJ + IEV_TAB][5] = EV_TEMP[IJ][5];
2015 //
2016 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
2017 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
2018 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
2019 // Lorentz transformation
2020 lorentz_boost(
2021 V_CM[0], V_CM[1], V_CM[2], EV_TEMP[IJ][2], EV_TEMP[IJ][3], EV_TEMP[IJ][4], &VXOUT, &VYOUT, &VZOUT);
2022 lorentz_boost(VX2_IMF, VY2_IMF, VZ2_IMF, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2023 EV_TAB[IJ + IEV_TAB][2] = VX2OUT;
2024 EV_TAB[IJ + IEV_TAB][3] = VY2OUT;
2025 EV_TAB[IJ + IEV_TAB][4] = VZ2OUT;
2026 }
2027 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
2028 // As IMF is not allowed to emit IMF, adummy1=zdummy1=0
2029
2030 AFPIMF = idnint(affimf);
2031 ZFPIMF = idnint(zffimf);
2032 SFPIMF = NbLamimf;
2033
2034 // vi1_imf, vi2_imf - velocities of imf and partner from TKE;
2035 // vi1ev_imf, vi2_imf - recoil of partner and imf due to evaporation
2036 // Lorentz kinematics - DM 18/5/2010
2037 // VIMF_CM(1) = V_CM(1) + VX2_IMF + VX2EV_IMF
2038 // VIMF_CM(2) = V_CM(2) + VY2_IMF + VY2EV_IMF
2039 // VIMF_CM(3) = V_CM(3) + VZ2_IMF + VZ2EV_IMF
2040 lorentz_boost(VX2_IMF, VY2_IMF, VZ2_IMF, V_CM[0], V_CM[1], V_CM[2], &VXOUT, &VYOUT, &VZOUT);
2041 lorentz_boost(vx2ev_imf, vy2ev_imf, vz2ev_imf, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2042 VIMF_CM[0] = VX2OUT;
2043 VIMF_CM[1] = VY2OUT;
2044 VIMF_CM[2] = VZ2OUT;
2045 // Lorentz kinematics
2046 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
2047 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
2048 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
2049 lorentz_boost(VX1_IMF, VY1_IMF, VZ1_IMF, V_CM[0], V_CM[1], V_CM[2], &VXOUT, &VYOUT, &VZOUT);
2050 lorentz_boost(vx1ev_imf, vy1ev_imf, vz1ev_imf, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2051 VFP1_CM[0] = VX2OUT;
2052 VFP1_CM[1] = VY2OUT;
2053 VFP1_CM[2] = VZ2OUT;
2054
2055 if (FF11 == 0 && FIMF11 == 0)
2056 {
2057 // heavy partner deexcites by emission of light particles
2058 AFP1 = idnint(aff);
2059 ZFP1 = idnint(zff);
2060 SFP1 = NbLamH;
2061 ZFP2 = 0;
2062 AFP2 = 0;
2063 SFP2 = 0;
2064 ftype = 2;
2065 AFPIMF = idnint(affimf);
2066 ZFPIMF = idnint(zffimf);
2067 SFPIMF = NbLamimf;
2068 for (G4int I = 0; I < 3; I++)
2069 VFP2_CM[I] = 0.0;
2070 }
2071 else if (FF11 == 1 && FIMF11 == 0)
2072 {
2073 // Heavy partner fissions
2074 varntp->kfis = 1;
2075 if (NbLam0 > 0)
2076 varntp->kfis = 20;
2077 //
2078 opt->optimfallowed = 0; // IMF is not allowed
2079 fiss->ifis = 0; // fission is not allowed
2080 //
2081 zf = zff;
2082 af = aff;
2083 ee = EEIMFP;
2084 // ftype1=0;
2085 ftype = 21;
2086
2087 G4int IEV_TAB_FIS = 0, imode = 0;
2088
2089 G4double vx1_fission = 0., vy1_fission = 0., vz1_fission = 0.;
2090 G4double vx2_fission = 0., vy2_fission = 0., vz2_fission = 0.;
2091 G4double vx_eva_sc = 0., vy_eva_sc = 0., vz_eva_sc = 0.;
2092
2093 fission(af,
2094 zf,
2095 ee,
2096 jprf1,
2097 &vx1_fission,
2098 &vy1_fission,
2099 &vz1_fission,
2100 &vx2_fission,
2101 &vy2_fission,
2102 &vz2_fission,
2103 &ZFP1,
2104 &AFP1,
2105 &SFP1,
2106 &ZFP2,
2107 &AFP2,
2108 &SFP2,
2109 &imode,
2110 &vx_eva_sc,
2111 &vy_eva_sc,
2112 &vz_eva_sc,
2113 EV_TEMP,
2114 &IEV_TAB_FIS,
2115 &NbLamH);
2116
2117 for (int IJ = 0; IJ < IEV_TAB_FIS; IJ++)
2118 {
2119 EV_TAB[IJ + IEV_TAB][0] = EV_TEMP[IJ][0];
2120 EV_TAB[IJ + IEV_TAB][1] = EV_TEMP[IJ][1];
2121 EV_TAB[IJ + IEV_TAB][5] = EV_TEMP[IJ][5];
2122 // Lorentz kinematics
2123 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
2124 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
2125 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
2126 // Lorentz transformation
2127 lorentz_boost(VFP1_CM[0],
2128 VFP1_CM[1],
2129 VFP1_CM[2],
2130 EV_TEMP[IJ][2],
2131 EV_TEMP[IJ][3],
2132 EV_TEMP[IJ][4],
2133 &VXOUT,
2134 &VYOUT,
2135 &VZOUT);
2136 EV_TAB[IJ + IEV_TAB][2] = VXOUT;
2137 EV_TAB[IJ + IEV_TAB][3] = VYOUT;
2138 EV_TAB[IJ + IEV_TAB][4] = VZOUT;
2139 }
2140 IEV_TAB = IEV_TAB + IEV_TAB_FIS;
2141
2142 // if(imode==1) ftype1 = 1; // S1 mode
2143 // if(imode==2) ftype1 = 2; // S2 mode
2144
2145 // Lorentz kinematics
2146 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF + VX1_FISSION +
2147 // & VX_EVA_SC ! Velocity of FF1 in x
2148 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF + VY1_FISSION +
2149 // & VY_EVA_SC ! Velocity of FF1 in y
2150 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF + VZ1_FISSION +
2151 // & VZ_EVA_SC ! Velocity of FF1 in x
2152 lorentz_boost(VX1_IMF, VY1_IMF, VZ1_IMF, V_CM[0], V_CM[1], V_CM[2], &VXOUT, &VYOUT, &VZOUT);
2153 lorentz_boost(vx1ev_imf, vy1ev_imf, vz1ev_imf, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2154 lorentz_boost(vx1_fission, vy1_fission, vz1_fission, VX2OUT, VY2OUT, VZ2OUT, &VXOUT, &VYOUT, &VZOUT);
2155 lorentz_boost(vx_eva_sc, vy_eva_sc, vz_eva_sc, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2156 VFP1_CM[0] = VX2OUT;
2157 VFP1_CM[1] = VY2OUT;
2158 VFP1_CM[2] = VZ2OUT;
2159
2160 // Lorentz kinematics
2161 // VFP2_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF + VX2_FISSION +
2162 // & VX_EVA_SC ! Velocity of FF2 in x
2163 // VFP2_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF + VY2_FISSION +
2164 // & VY_EVA_SC ! Velocity of FF2 in y
2165 // VFP2_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF + VZ2_FISSION +
2166 // & VZ_EVA_SC ! Velocity of FF2 in x
2167 lorentz_boost(VX1_IMF, VY1_IMF, VZ1_IMF, V_CM[0], V_CM[1], V_CM[2], &VXOUT, &VYOUT, &VZOUT);
2168 lorentz_boost(vx1ev_imf, vy1ev_imf, vz1ev_imf, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2169 lorentz_boost(vx2_fission, vy2_fission, vz2_fission, VX2OUT, VY2OUT, VZ2OUT, &VXOUT, &VYOUT, &VZOUT);
2170 lorentz_boost(vx_eva_sc, vy_eva_sc, vz_eva_sc, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2171 VFP2_CM[0] = VX2OUT;
2172 VFP2_CM[1] = VY2OUT;
2173 VFP2_CM[2] = VZ2OUT;
2174 }
2175 else if (FF11 == 0 && FIMF11 == 1)
2176 {
2177 // Heavy partner emits imf, consequtive imf emission or fission is not
2178 // allowed
2179 opt->optimfallowed = 0; // IMF is not allowed
2180 fiss->ifis = 0; // fission is not allowed
2181 //
2182 zf = zff;
2183 af = aff;
2184 ee = EEIMFP;
2185 aimf = adummy;
2186 zimf = zdummy;
2187 tkeimf = tkedummy;
2188 FF11 = 0;
2189 FIMF11 = 0;
2190 ftype = 22;
2191 // Lambda particles
2192 G4int NbLamH1 = 0;
2193 G4int NbLamimf1 = 0;
2194 G4double pbH1 = (af - zf) / (af - zf + aimf - zimf);
2195 for (G4int i = 0; i < NbLamH; i++)
2196 {
2197 if (G4AblaRandom::flat() < pbH1)
2198 {
2199 NbLamH1++;
2200 }
2201 else
2202 {
2203 NbLamimf1++;
2204 }
2205 }
2206 //
2207 // Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
2208 EkinR1 = tkeimf * aimf / (af + aimf);
2209 EkinR2 = tkeimf * af / (af + aimf);
2210 V1 = std::sqrt(EkinR1 / af) * 1.3887;
2211 V2 = std::sqrt(EkinR2 / aimf) * 1.3887;
2212 G4double VZ1_IMFS = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
2213 VPERP1 = std::sqrt(V1 * V1 - VZ1_IMFS * VZ1_IMFS);
2214 ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
2215 G4double VX1_IMFS = VPERP1 * std::sin(ALPHA1);
2216 G4double VY1_IMFS = VPERP1 * std::cos(ALPHA1);
2217 G4double VX2_IMFS = -VX1_IMFS / V1 * V2;
2218 G4double VY2_IMFS = -VY1_IMFS / V1 * V2;
2219 G4double VZ2_IMFS = -VZ1_IMFS / V1 * V2;
2220
2221 EEIMFP = ee * af / (af + aimf);
2222 EEIMF = ee * aimf / (af + aimf);
2223
2224 // Decay of heavy partner
2225 IINERTTOT = 0.40 * 931.490 * 1.160 * 1.160 * (std::pow(aimf, 5.0 / 3.0) + std::pow(af, 5.0 / 3.0)) +
2226 931.490 * 1.160 * 1.160 * aimf * af / (aimf + af) *
2227 (std::pow(aimf, 1. / 3.) + std::pow(af, 1. / 3.)) *
2228 (std::pow(aimf, 1. / 3.) + std::pow(af, 1. / 3.));
2229
2230 JPRFHEAVY = jprf1 * 0.4 * 931.49 * 1.16 * 1.16 * std::pow(af, 5.0 / 3.0) / IINERTTOT;
2231 JPRFLIGHT = jprf1 * 0.4 * 931.49 * 1.16 * 1.16 * std::pow(aimf, 5.0 / 3.0) / IINERTTOT;
2232
2233 G4double zffs = 0., affs = 0., vx1ev_imfs = 0., vy1ev_imfs = 0., vz1ev_imfs = 0., jprf3 = 0.;
2234
2235 evapora(zf,
2236 af,
2237 &EEIMFP,
2238 JPRFHEAVY,
2239 &zffs,
2240 &affs,
2241 &mtota,
2242 &vz1ev_imfs,
2243 &vx1ev_imfs,
2244 &vy1ev_imfs,
2245 &FF11,
2246 &FIMF11,
2247 &zdummy,
2248 &adummy,
2249 &tkedummy,
2250 &jprf3,
2251 &inttype,
2252 &inum,
2253 EV_TEMP,
2254 &IEV_TAB_TEMP,
2255 &NbLamH1);
2256
2257 for (G4int IJ = 0; IJ < IEV_TAB_TEMP; IJ++)
2258 {
2259 EV_TAB[IJ + IEV_TAB][0] = EV_TEMP[IJ][0];
2260 EV_TAB[IJ + IEV_TAB][1] = EV_TEMP[IJ][1];
2261 EV_TAB[IJ + IEV_TAB][5] = EV_TEMP[IJ][5];
2262 //
2263 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
2264 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
2265 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
2266 // Lorentz transformation
2267 lorentz_boost(VFP1_CM[0],
2268 VFP1_CM[1],
2269 VFP1_CM[2],
2270 EV_TEMP[IJ][2],
2271 EV_TEMP[IJ][3],
2272 EV_TEMP[IJ][4],
2273 &VXOUT,
2274 &VYOUT,
2275 &VZOUT);
2276 lorentz_boost(vx1ev_imfs, vy1ev_imfs, vz1ev_imfs, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2277 EV_TAB[IJ + IEV_TAB][2] = VX2OUT;
2278 EV_TAB[IJ + IEV_TAB][3] = VY2OUT;
2279 EV_TAB[IJ + IEV_TAB][4] = VZ2OUT;
2280 }
2281 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
2282
2283 // For IMF - fission and IMF emission are not allowed
2284 opt->optimfallowed = 0; // IMF is not allowed
2285 fiss->ifis = 0; // fission is not allowed
2286 //
2287 FF22 = 0;
2288 FIMF22 = 0;
2289 // Decay of "second" IMF
2290 G4double zffimfs = 0., affimfs = 0., vx2ev_imfs = 0., vy2ev_imfs = 0., vz2ev_imfs = 0., jprf4 = 0.;
2291
2292 evapora(zimf,
2293 aimf,
2294 &EEIMF,
2295 JPRFLIGHT,
2296 &zffimfs,
2297 &affimfs,
2298 &mtota,
2299 &vz2ev_imfs,
2300 &vx2ev_imfs,
2301 &vy2ev_imfs,
2302 &FF22,
2303 &FIMF22,
2304 &zdummy1,
2305 &adummy1,
2306 &tkedummy1,
2307 &jprf4,
2308 &inttype,
2309 &inum,
2310 EV_TEMP,
2311 &IEV_TAB_TEMP,
2312 &NbLamimf1);
2313
2314 for (G4int IJ = 0; IJ < IEV_TAB_TEMP; IJ++)
2315 {
2316 EV_TAB[IJ + IEV_TAB][0] = EV_TEMP[IJ][0];
2317 EV_TAB[IJ + IEV_TAB][1] = EV_TEMP[IJ][1];
2318 EV_TAB[IJ + IEV_TAB][5] = EV_TEMP[IJ][5];
2319 //
2320 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
2321 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
2322 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
2323 // Lorentz transformation
2324 lorentz_boost(VFP1_CM[0],
2325 VFP1_CM[1],
2326 VFP1_CM[2],
2327 EV_TEMP[IJ][2],
2328 EV_TEMP[IJ][3],
2329 EV_TEMP[IJ][4],
2330 &VXOUT,
2331 &VYOUT,
2332 &VZOUT);
2333 lorentz_boost(vx2ev_imfs, vy2ev_imfs, vz2ev_imfs, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2334 EV_TAB[IJ + IEV_TAB][2] = VX2OUT;
2335 EV_TAB[IJ + IEV_TAB][3] = VY2OUT;
2336 EV_TAB[IJ + IEV_TAB][4] = VZ2OUT;
2337 }
2338 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
2339
2340 AFP1 = idnint(affs);
2341 ZFP1 = idnint(zffs);
2342 SFP1 = NbLamH1;
2343 ZFP2 = idnint(zffimfs);
2344 AFP2 = idnint(affimfs);
2345 SFP2 = NbLamimf1;
2346
2347 // Velocity of final heavy residue
2348 // Lorentz kinematics
2349 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
2350 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
2351 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
2352 lorentz_boost(VX1_IMF, VY1_IMF, VZ1_IMF, V_CM[0], V_CM[1], V_CM[2], &VXOUT, &VYOUT, &VZOUT);
2353 lorentz_boost(vx1ev_imf, vy1ev_imf, vz1ev_imf, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2354 lorentz_boost(VX1_IMFS, VY1_IMFS, VZ1_IMFS, VX2OUT, VY2OUT, VZ2OUT, &VXOUT, &VYOUT, &VZOUT);
2355 lorentz_boost(vx1ev_imfs, vy1ev_imfs, vz1ev_imfs, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2356 VFP1_CM[0] = VX2OUT;
2357 VFP1_CM[1] = VY2OUT;
2358 VFP1_CM[2] = VZ2OUT;
2359
2360 // Velocity of the second IMF
2361 // Lorentz kinematics
2362 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
2363 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
2364 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
2365 lorentz_boost(VX1_IMF, VY1_IMF, VZ1_IMF, V_CM[0], V_CM[1], V_CM[2], &VXOUT, &VYOUT, &VZOUT);
2366 lorentz_boost(vx1ev_imf, vy1ev_imf, vz1ev_imf, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2367 lorentz_boost(VX2_IMFS, VY2_IMFS, VZ2_IMFS, VX2OUT, VY2OUT, VZ2OUT, &VXOUT, &VYOUT, &VZOUT);
2368 lorentz_boost(vx2ev_imfs, vy2ev_imfs, vz2ev_imfs, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
2369 VFP2_CM[0] = VX2OUT;
2370 VFP2_CM[1] = VY2OUT;
2371 VFP2_CM[2] = VZ2OUT;
2372 } // second decay
2373 } // if(ftype == 2)
2374
2375 // Only evaporation of light particles
2376 if (ftype != 1 && ftype != 21)
2377 {
2378
2379 // ----------- RESOLVE UNSTABLE NUCLEI
2380 IOUNSTABLE = 0;
2381
2382 unstable_nuclei(AFP1,
2383 ZFP1,
2384 &afpnew,
2385 &zfpnew,
2386 IOUNSTABLE,
2387 VFP1_CM[0],
2388 VFP1_CM[1],
2389 VFP1_CM[2],
2390 &VP1X,
2391 &VP1Y,
2392 &VP1Z,
2393 EV_TAB_TEMP,
2394 &ILOOP);
2395
2396 if (IOUNSTABLE == 1)
2397 {
2398 AFP1 = afpnew;
2399 ZFP1 = zfpnew;
2400 VFP1_CM[0] = VP1X;
2401 VFP1_CM[1] = VP1Y;
2402 VFP1_CM[2] = VP1Z;
2403 for (G4int I = 0; I < ILOOP; I++)
2404 {
2405 for (G4int IJ = 0; IJ < 5; IJ++)
2406 EV_TAB[I + IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2407 }
2408 IEV_TAB = IEV_TAB + ILOOP;
2409 }
2410
2411 if (ftype > 1)
2412 {
2413 IOUNSTABLE = 0;
2414
2415 unstable_nuclei(AFPIMF,
2416 ZFPIMF,
2417 &afpnew,
2418 &zfpnew,
2419 IOUNSTABLE,
2420 VIMF_CM[0],
2421 VIMF_CM[1],
2422 VIMF_CM[2],
2423 &VP1X,
2424 &VP1Y,
2425 &VP1Z,
2426 EV_TAB_TEMP,
2427 &ILOOP);
2428
2429 if (IOUNSTABLE == 1)
2430 {
2431 AFPIMF = afpnew;
2432 ZFPIMF = zfpnew;
2433 VIMF_CM[0] = VP1X;
2434 VIMF_CM[1] = VP1Y;
2435 VIMF_CM[2] = VP1Z;
2436 for (G4int I = 0; I < ILOOP; I++)
2437 {
2438 for (G4int IJ = 0; IJ < 5; IJ++)
2439 EV_TAB[I + IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2440 }
2441 IEV_TAB = IEV_TAB + ILOOP;
2442 }
2443
2444 if (ftype > 2)
2445 {
2446 IOUNSTABLE = 0;
2447
2448 unstable_nuclei(AFP2,
2449 ZFP2,
2450 &afpnew,
2451 &zfpnew,
2452 IOUNSTABLE,
2453 VFP2_CM[0],
2454 VFP2_CM[1],
2455 VFP2_CM[2],
2456 &VP1X,
2457 &VP1Y,
2458 &VP1Z,
2459 EV_TAB_TEMP,
2460 &ILOOP);
2461
2462 if (IOUNSTABLE == 1)
2463 {
2464 AFP2 = afpnew;
2465 ZFP2 = zfpnew;
2466 VFP2_CM[0] = VP1X;
2467 VFP2_CM[1] = VP1Y;
2468 VFP2_CM[2] = VP1Z;
2469 for (G4int I = 0; I < ILOOP; I++)
2470 {
2471 for (G4int IJ = 0; IJ < 5; IJ++)
2472 EV_TAB[I + IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2473 }
2474 IEV_TAB = IEV_TAB + ILOOP;
2475 }
2476 } // ftype>2
2477 } // ftype>1
2478 }
2479
2480 // For the case of fission:
2481 if (ftype == 1 || ftype == 21)
2482 {
2483 // ----------- RESOLVE UNSTABLE NUCLEI
2484 IOUNSTABLE = 0;
2485 // ----------- Fragment 1
2486 unstable_nuclei(AFP1,
2487 ZFP1,
2488 &afpnew,
2489 &zfpnew,
2490 IOUNSTABLE,
2491 VFP1_CM[0],
2492 VFP1_CM[1],
2493 VFP1_CM[2],
2494 &VP1X,
2495 &VP1Y,
2496 &VP1Z,
2497 EV_TAB_TEMP,
2498 &ILOOP);
2499
2500 if (IOUNSTABLE == 1)
2501 {
2502 AFP1 = afpnew;
2503 ZFP1 = zfpnew;
2504 VFP1_CM[0] = VP1X;
2505 VFP1_CM[1] = VP1Y;
2506 VFP1_CM[2] = VP1Z;
2507 for (G4int I = 0; I < ILOOP; I++)
2508 {
2509 for (G4int IJ = 0; IJ < 5; IJ++)
2510 EV_TAB[I + IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2511 }
2512 IEV_TAB = IEV_TAB + ILOOP;
2513 }
2514
2515 IOUNSTABLE = 0;
2516 // ----------- Fragment 2
2517 unstable_nuclei(AFP2,
2518 ZFP2,
2519 &afpnew,
2520 &zfpnew,
2521 IOUNSTABLE,
2522 VFP2_CM[0],
2523 VFP2_CM[1],
2524 VFP2_CM[2],
2525 &VP1X,
2526 &VP1Y,
2527 &VP1Z,
2528 EV_TAB_TEMP,
2529 &ILOOP);
2530
2531 if (IOUNSTABLE == 1)
2532 {
2533 AFP2 = afpnew;
2534 ZFP2 = zfpnew;
2535 VFP2_CM[0] = VP1X;
2536 VFP2_CM[1] = VP1Y;
2537 VFP2_CM[2] = VP1Z;
2538 for (G4int I = 0; I < ILOOP; I++)
2539 {
2540 for (G4int IJ = 0; IJ < 5; IJ++)
2541 EV_TAB[I + IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2542 }
2543 IEV_TAB = IEV_TAB + ILOOP;
2544 }
2545
2546 if (ftype == 21)
2547 {
2548 IOUNSTABLE = 0;
2549 // ----------- Fragment IMF
2550 unstable_nuclei(AFPIMF,
2551 ZFPIMF,
2552 &afpnew,
2553 &zfpnew,
2554 IOUNSTABLE,
2555 VIMF_CM[0],
2556 VIMF_CM[1],
2557 VIMF_CM[2],
2558 &VP1X,
2559 &VP1Y,
2560 &VP1Z,
2561 EV_TAB_TEMP,
2562 &ILOOP);
2563
2564 if (IOUNSTABLE == 1)
2565 {
2566 AFPIMF = afpnew;
2567 ZFPIMF = zfpnew;
2568 VIMF_CM[0] = VP1X;
2569 VIMF_CM[1] = VP1Y;
2570 VIMF_CM[2] = VP1Z;
2571 for (G4int I = 0; I < ILOOP; I++)
2572 {
2573 for (G4int IJ = 0; IJ < 5; IJ++)
2574 EV_TAB[I + IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2575 }
2576 IEV_TAB = IEV_TAB + ILOOP;
2577 }
2578 } // ftype=21
2579 }
2580
2581 // Cross check
2582 if ((ftype == 1 || ftype == 21) && (AFP2 <= 0 || AFP1 <= 0 || ZFP2 <= 0 || ZFP1 <= 0))
2583 {
2584 std::cout << "ZFP1:" << ZFP1 << std::endl;
2585 std::cout << "AFP1:" << AFP1 << std::endl;
2586 std::cout << "ZFP2:" << ZFP2 << std::endl;
2587 std::cout << "AFP2:" << AFP2 << std::endl;
2588 }
2589
2590 // Put heavy residues in the EV_TAB array
2591 EV_TAB[IEV_TAB][0] = ZFP1;
2592 EV_TAB[IEV_TAB][1] = AFP1;
2593 EV_TAB[IEV_TAB][5] = SFP1;
2594 EV_TAB[IEV_TAB][2] = VFP1_CM[0];
2595 EV_TAB[IEV_TAB][3] = VFP1_CM[1];
2596 EV_TAB[IEV_TAB][4] = VFP1_CM[2];
2597 IEV_TAB = IEV_TAB + 1;
2598
2599 if (AFP2 > 0)
2600 {
2601 EV_TAB[IEV_TAB][0] = ZFP2;
2602 EV_TAB[IEV_TAB][1] = AFP2;
2603 EV_TAB[IEV_TAB][5] = SFP2;
2604 EV_TAB[IEV_TAB][2] = VFP2_CM[0];
2605 EV_TAB[IEV_TAB][3] = VFP2_CM[1];
2606 EV_TAB[IEV_TAB][4] = VFP2_CM[2];
2607 IEV_TAB = IEV_TAB + 1;
2608 }
2609
2610 if (AFPIMF > 0)
2611 {
2612 EV_TAB[IEV_TAB][0] = ZFPIMF;
2613 EV_TAB[IEV_TAB][1] = AFPIMF;
2614 EV_TAB[IEV_TAB][5] = SFPIMF;
2615 EV_TAB[IEV_TAB][2] = VIMF_CM[0];
2616 EV_TAB[IEV_TAB][3] = VIMF_CM[1];
2617 EV_TAB[IEV_TAB][4] = VIMF_CM[2];
2618 IEV_TAB = IEV_TAB + 1;
2619 }
2620 // Put the array of particles in the root file of INCL
2621 FillData(IMULTBU, IEV_TAB);
2622 return;
2623 }
2624
2625 // Evaporation code
2626 void G4Abla::initEvapora()
2627 {
2628
2629 // 40 C BFPRO,SNPRO,SPPRO,SHELL
2630 // 41 C
2631 // 42 C AP,ZP,AT,ZT - PROJECTILE AND TARGET MASSES
2632 // 43 C EAP,BETA - BEAM ENERGY PER NUCLEON, V/C
2633 // 44 C BMAXNUC - MAX. IMPACT PARAMETER FOR NUCL. REAC.
2634 // 45 C CRTOT,CRNUC - TOTAL AND NUCLEAR REACTION CROSS SECTION
2635 // 46 C R_0,R_P,R_T, - RADIUS PARAMETER, PROJECTILE+ TARGET RADII
2636 // 47 C IMAX,IRNDM,PI - MAXIMUM NUMBER OF EVENTS, DUMMY, 3.141...
2637 // 48 C BFPRO - FISSION BARRIER OF THE PROJECTILE
2638 // 49 C SNPRO - NEUTRON SEPARATION ENERGY OF THE
2639 // PROJECTILE 50 C SPPRO - PROTON " " " " "
2640 // 51 C SHELL - GROUND STATE SHELL CORRECTION
2641 // 52
2642 // C---------------------------------------------------------------------
2643 // 53 C
2644 // 54 C ENERGIES WIDTHS AND CROSS SECTIONS FOR EM EXCITATION
2645 // 55 C COMMON /EMDPAR/ EGDR,EGQR,FWHMGDR,FWHMGQR,CREMDE1,CREMDE2,
2646 // 56 C AE1,BE1,CE1,AE2,BE2,CE2,SR1,SR2,XR
2647 // 57 C
2648 // 58 C EGDR,EGQR - MEAN ENERGY OF GDR AND GQR
2649 // 59 C FWHMGDR,FWHMGQR - FWHM OF GDR, GQR
2650 // 60 C CREMDE1,CREMDE2 - EM CROSS SECTION FOR E1 AND E2
2651 // 61 C AE1,BE1,CE1 - ARRAYS TO CALCULATE
2652 // 62 C AE2,BE2,CE2 - THE EXCITATION ENERGY AFTER E.M. EXC.
2653 // 63 C SR1,SR2,XR - WITH MONTE CARLO
2654 // 64
2655 // C---------------------------------------------------------------------
2656 // 65 C
2657 // 66 C DEFORMATIONS AND G.S. SHELL EFFECTS
2658 // 67 C COMMON /ECLD/ ECGNZ,ECFNZ,VGSLD,ALPHA
2659 // 68 C
2660 // 69 C ECGNZ - GROUND STATE SHELL CORR. FRLDM FOR A SPHERICAL
2661 // G.S.
2662 // 70 C ECFNZ - SHELL CORRECTION FOR THE SADDLE POINT (NOW: == 0)
2663 // 71 C VGSLD - DIFFERENCE BETWEEN DEFORMED G.S. AND LDM VALUE
2664 // 72 C ALPHA - ALPHA GROUND STATE DEFORMATION (THIS IS NOT
2665 // BETA2!) 73 C BETA2 = SQRT(5/(4PI)) * ALPHA 74
2666 // C---------------------------------------------------------------------
2667 // 75 C
2668 // 76 C ARRAYS FOR EXCITATION ENERGY BY STATISTICAL HOLE ENERY
2669 // MODEL 77 C COMMON /EENUC/ SHE, XHE 78 C 79 C SHE,
2670 // XHE - ARRAYS TO CALCULATE THE EXC. ENERGY AFTER 80 C ABRASION BY
2671 // THE STATISTICAL HOLE ENERGY MODEL 81
2672 // C---------------------------------------------------------------------
2673 // 82 C
2674 // 83 C G.S. SHELL EFFECT
2675 // 84 C COMMON /EC2SUB/ ECNZ
2676 // 85 C
2677 // 86 C ECNZ G.S. SHELL EFFECT FOR THE MASSES (IDENTICAL TO ECGNZ)
2678 // 87
2679 // C---------------------------------------------------------------------
2680 //
2681
2682 G4double MN = 939.5653301;
2683 G4double MP = 938.7829835;
2684
2685 G4AblaDataFile* dataInterface = new G4AblaDataFile();
2686 if (dataInterface->readData() == true)
2687 {
2688 if (verboseLevel > 0)
2689 {
2690 // G4cout <<"G4Abla: Datafiles read successfully." << G4endl;
2691 }
2692 }
2693 else
2694 {
2695 // G4Exception("ERROR: Failed to read datafiles.");
2696 }
2697
2698 for (G4int z = 0; z < 99; z++)
2699 { // do 30 z = 0,98,1
2700 for (G4int n = 0; n < 154; n++)
2701 { // do 31 n = 0,153,1
2702 ecld->ecfnz[n][z] = 0.e0;
2703 ec2sub->ecnz[n][z] = dataInterface->getEcnz(n, z);
2704 ecld->ecgnz[n][z] = dataInterface->getEcnz(n, z);
2705 ecld->alpha[n][z] = dataInterface->getAlpha(n, z);
2706 ecld->vgsld[n][z] = dataInterface->getVgsld(n, z);
2707 ecld->rms[n][z] = dataInterface->getRms(n, z);
2708 }
2709 }
2710
2711 for (G4int iz = 0; iz < zcolsbeta; iz++)
2712 for (G4int in = 0; in < nrowsbeta; in++)
2713 {
2714 ecld->beta2[in][iz] = dataInterface->getBeta2(in, iz);
2715 ecld->beta4[in][iz] = dataInterface->getBeta4(in, iz);
2716 }
2717
2718 G4double mfrldm[lprows][lpcols];
2719 // For 2 < Z < 12 we take "experimental" shell corrections instead of
2720 // calculated Read FRLDM tables
2721 for (G4int i = 1; i < lpcols; i++)
2722 {
2723 for (G4int j = 1; j < lprows; j++)
2724 {
2725 if (dataInterface->getMexpID(j, i) == 1)
2726 {
2727 masses->mexpiop[j][i] = 1;
2728 }
2729 else
2730 {
2731 masses->mexpiop[j][i] = 0;
2732 }
2733 // LD masses (even-odd effect is later considered according to Ignatyuk)
2734 if (i == 0 && j == 0)
2735 mfrldm[j][i] = 0.;
2736 else
2737 mfrldm[j][i] = MP * i + MN * j + eflmac(i + j, i, 1, 0);
2738 }
2739 }
2740
2741 for (G4int i = 0; i < lpcols; i++)
2742 for (G4int j = 0; j < lprows; j++)
2743 masses->massexp[j][i] = dataInterface->getMexp(j, i);
2744
2745 G4double e0 = 0.;
2746 for (G4int i = 1; i < lpcols; i++)
2747 {
2748 for (G4int j = 1; j < lprows; j++)
2749 {
2750 masses->bind[j][i] = 0.;
2751 if (masses->mexpiop[j][i] == 1)
2752 {
2753 if (j < 30)
2754 {
2755
2756 ec2sub->ecnz[j][i] = 0.0;
2757 ecld->ecgnz[j][i] = ec2sub->ecnz[j][i];
2758 masses->bind[j][i] = dataInterface->getMexp(j, i) - MP * i - MN * j;
2759 ecld->vgsld[j][i] = 0.;
2760
2761 e0 = 0.;
2762 }
2763 else
2764 {
2765 // For these nuclei, we take "experimental" ground-state shell
2766 // corrections
2767 //
2768 // Parametrization of CT model by Ignatyuk; note that E0 is shifted to
2769 // correspond to pairing shift in Fermi-gas model (there, energy is
2770 // shifted taking odd-odd nuclei as bassis)
2771 G4double para = 0.;
2772 parite(j + i, ¶);
2773 if (para < 0.0)
2774 {
2775 // e-o, o-e
2776 e0 = 0.285 + 11.17 * std::pow(j + i, -0.464) - 0.390 - 0.00058 * (j + i);
2777 }
2778 else
2779 {
2780 G4double parz = 0.;
2781 parite(i, &parz);
2782 if (parz > 0.0)
2783 {
2784 // e-e
2785 e0 = 22.34 * std::pow(j + i, -0.464) - 0.235;
2786 }
2787 else
2788 {
2789 // o-o
2790 //
2791 //
2792 e0 = 0.0;
2793 }
2794 }
2795 //
2796 if ((j == i) && mod(j, 2) == 1 && mod(i, 2) == 1)
2797 {
2798 e0 = e0 - 30.0 * (1.0 / G4double(j + i));
2799 }
2800
2801 G4double delta_tot = ec2sub->ecnz[j][i] - ecld->vgsld[j][i];
2802 ec2sub->ecnz[j][i] = dataInterface->getMexp(j, i) - (mfrldm[j][i] - e0);
2803
2804 ecld->vgsld[j][i] = max(0.0, ec2sub->ecnz[j][i] - delta_tot);
2805 ecld->ecgnz[j][i] = ec2sub->ecnz[j][i];
2806
2807 } // if j
2808 } // if mexpiop
2809 }
2810 }
2811 //
2812 delete dataInterface;
2813 }
2814
2815 void G4Abla::SetParametersG4(G4int z, G4int a)
2816 {
2817 // A and Z for the target
2818 fiss->at = a;
2819 fiss->zt = z;
2820
2821 // switch-fission.1=on.0=off
2822 fiss->ifis = 1;
2823
2824 // shell+pairing.0-1-2-3
2825 fiss->optshp = 3;
2826 if (fiss->zt < 84 && fiss->zt > 60)
2827 fiss->optshp = 1;
2828
2829 // optemd =0,1 0 no emd, 1 incl. emd
2830 opt->optemd = 1;
2831 // read(10,*,iostat=io) dum(10),optcha
2832 opt->optcha = 1;
2833
2834 // shell+pairing.0-1-2-3 for IMFs
2835 opt->optshpimf = 0;
2836 opt->optimfallowed = 1;
2837
2838 // collective enhancement switched on 1 or off 0 in densn (qr=val or =1.)
2839 fiss->optcol = 1;
2840 if (fiss->zt <= 28)
2841 {
2842 fiss->optcol = 0;
2843 fiss->optshp = 0;
2844 opt->optshpimf = 1;
2845 }
2846 else if (fiss->zt <= 58)
2847 {
2848 fiss->optcol = 0;
2849 fiss->optshp = 1;
2850 opt->optshpimf = 3;
2851 }
2852 // collective enhancement parameters
2853 fiss->ucr = 40.;
2854 fiss->dcr = 10.;
2855
2856 // switch for temperature constant model (CTM)
2857 fiss->optct = 1;
2858
2859 ald->optafan = 0;
2860
2861 // nuclear.viscosity.(beta)
2862 fiss->bet = 4.5;
2863 fiss->bethyp = 28.0;
2864 fiss->optxfis = 3;
2865
2866 // Level density parameters
2867 ald->av = 0.0730;
2868 ald->as = 0.0950;
2869 ald->ak = 0.0000;
2870
2871 // Multi-fragmentation
2872 T_freeze_out_in = -6.5;
2873 }
2874
2875 void G4Abla::SetParameters()
2876 {
2877 /*
2878 C IFIS = INTEGER SWITCH FOR FISSION
2879 C OPTSHP = INTEGER SWITCH FOR SHELL CORRECTION IN MASSES/ENERGY
2880 C =0 NO MICROSCOPIC CORRECTIONS IN MASSES AND ENERGY
2881 C =1 SHELL , NO PAIRING CORRECTION
2882 C =2 PAIRING, NO SHELL CORRECTION
2883 C =3 SHELL AND PAIRING CORRECTION IN MASSES AND ENERGY
2884 C OPTCOL =0,1 COLLECTIVE ENHANCEMENT SWITCHED ON 1 OR OFF 0 IN DENSN
2885 C OPTAFAN=0,1 SWITCH FOR AF/AN = 1 IN DENSNIV 0 AF/AN>1 1 AF/AN=1
2886 C BET = REAL REDUCED FRICTION COEFFICIENT / 10**(+21) S**(-1)
2887 C OPTXFIS= INTEGER 0,1,2 FOR MYERS & SWIATECKI, DAHLINGER, ANDREYEV
2888 C FISSILITY PARAMETER.
2889 C
2890 C NUCLEAR LEVEL DENSITIES:
2891 C AV = REAL KOEFFICIENTS FOR CALCULATION OF A(TILDE)
2892 C AS = REAL LEVEL DENSITY PARAMETER
2893 C AK = REAL
2894 */
2895
2896 // switch-fission.1=on.0=off
2897 fiss->ifis = 1;
2898
2899 // shell+pairing.0-1-2-3
2900 fiss->optshp = 3;
2901 if (fiss->zt < 84 && fiss->zt > 56)
2902 fiss->optshp = 1;
2903
2904 // optemd =0,1 0 no emd, 1 incl. emd
2905 opt->optemd = 1;
2906 // read(10,*,iostat=io) dum(10),optcha
2907 opt->optcha = 1;
2908
2909 // shell+pairing.0-1-2-3 for IMFs
2910 opt->optshpimf = 0;
2911 opt->optimfallowed = 1;
2912
2913 // nuclear.viscosity.(beta)
2914 fiss->bet = 4.5;
2915
2916 // collective enhancement switched on 1 or off 0 in densn (qr=val or =1.)
2917 fiss->optcol = 1;
2918 if (fiss->zt <= 56)
2919 {
2920 fiss->optcol = 0;
2921 fiss->optshp = 3;
2922 }
2923 // collective enhancement parameters
2924 fiss->ucr = 40.;
2925 fiss->dcr = 10.;
2926
2927 // switch for temperature constant model (CTM)
2928 fiss->optct = 1;
2929
2930 ald->optafan = 0;
2931
2932 ald->av = 0.0730;
2933 ald->as = 0.0950;
2934 ald->ak = 0.0000;
2935
2936 fiss->optxfis = 3;
2937
2938 // Multi-fragmentation
2939 T_freeze_out_in = -6.5;
2940 }
2941
2942 void G4Abla::mglw(G4double a, G4double z, G4double* el)
2943 {
2944 // MODEL DE LA GOUTTE LIQUIDE DE C. F. WEIZSACKER.
2945 // USUALLY AN OBSOLETE OPTION
2946
2947 G4double xv = 0.0, xs = 0.0, xc = 0.0, xa = 0.0;
2948
2949 if ((a <= 0.01) || (z < 0.01))
2950 {
2951 (*el) = 1.0e38;
2952 }
2953 else
2954 {
2955 xv = -15.56 * a;
2956 xs = 17.23 * std::pow(a, (2.0 / 3.0));
2957
2958 if (a > 1.0)
2959 {
2960 xc = 0.7 * z * (z - 1.0) * std::pow((a - 1.0), (-1.e0 / 3.e0));
2961 }
2962 else
2963 {
2964 xc = 0.0;
2965 }
2966 }
2967
2968 xa = 23.6 * (std::pow((a - 2.0 * z), 2) / a);
2969 (*el) = xv + xs + xc + xa;
2970 return;
2971 }
2972
2973 void G4Abla::mglms(G4double a, G4double z, G4int refopt4, G4double* el)
2974 {
2975 // USING FUNCTION EFLMAC(IA,IZ,0)
2976 //
2977 // REFOPT4 = 0 : WITHOUT MICROSCOPIC CORRECTIONS
2978 // REFOPT4 = 1 : WITH SHELL CORRECTION
2979 // REFOPT4 = 2 : WITH PAIRING CORRECTION
2980 // REFOPT4 = 3 : WITH SHELL- AND PAIRING CORRECTION
2981
2982 // 1839
2983 // C-----------------------------------------------------------------------
2984 // 1840 C A1 LOCAL MASS NUMBER (INTEGER VARIABLE OF A)
2985 // 1841 C Z1 LOCAL NUCLEAR CHARGE (INTEGER VARIABLE OF Z)
2986 // 1842 C REFOPT4 OPTION, SPECIFYING THE MASS FORMULA (SEE
2987 // ABOVE) 1843 C A MASS NUMBER 1844 C Z
2988 // NUCLEAR CHARGE 1845 C DEL PAIRING CORRECTION 1846
2989 // C EL BINDING ENERGY 1847 C ECNZ( , ) TABLE OF
2990 // SHELL CORRECTIONS 1848
2991 // C-----------------------------------------------------------------------
2992 // 1849 C
2993 G4int a1 = idnint(a);
2994 G4int z1 = idnint(z);
2995 G4int n1 = a1 - z1;
2996
2997 if ((a1 <= 0) || (z1 <= 0) || ((a1 - z1) <= 0))
2998 { // then
2999 // modif pour recuperer une masse p et n correcte:
3000 (*el) = 1.e38;
3001 return;
3002 // goto mglms50;
3003 }
3004 else
3005 {
3006 // binding energy incl. pairing contr. is calculated from
3007 // function eflmac
3008 (*el) = eflmac(a1, z1, 0, refopt4);
3009
3010 if (refopt4 > 0)
3011 {
3012 if (refopt4 != 2)
3013 {
3014 (*el) = (*el) + ec2sub->ecnz[a1 - z1][z1];
3015 }
3016 }
3017
3018 if (z1 >= 90)
3019 {
3020 if (n1 <= 145)
3021 {
3022 (*el) = (*el) + (12.552 - 0.1436 * z1);
3023 }
3024 else
3025 {
3026 if (n1 > 145 && n1 <= 152)
3027 {
3028 (*el) = (*el) + ((152.4 - 1.77 * z1) + (-0.972 + 0.0113 * z1) * n1);
3029 }
3030 }
3031 }
3032 }
3033 return;
3034 }
3035
3036 G4double G4Abla::spdef(G4int a, G4int z, G4int optxfis)
3037 {
3038
3039 // INPUT: A,Z,OPTXFIS MASS AND CHARGE OF A NUCLEUS,
3040 // OPTION FOR FISSILITY
3041 // OUTPUT: SPDEF
3042
3043 // ALPHA2 SADDLE POINT DEF. COHEN&SWIATECKI ANN.PHYS. 22 (1963) 406
3044 // RANGING FROM FISSILITY X=0.30 TO X=1.00 IN STEPS OF 0.02
3045
3046 G4int index = 0;
3047 G4double x = 0.0, v = 0.0, dx = 0.0;
3048
3049 const G4int alpha2Size = 37;
3050 // The value 0.0 at alpha2[0] added by PK.
3051 G4double alpha2[alpha2Size] = { 0.0, 2.5464e0, 2.4944e0, 2.4410e0, 2.3915e0, 2.3482e0, 2.3014e0, 2.2479e0,
3052 2.1982e0, 2.1432e0, 2.0807e0, 2.0142e0, 1.9419e0, 1.8714e0, 1.8010e0, 1.7272e0,
3053 1.6473e0, 1.5601e0, 1.4526e0, 1.3164e0, 1.1391e0, 0.9662e0, 0.8295e0, 0.7231e0,
3054 0.6360e0, 0.5615e0, 0.4953e0, 0.4354e0, 0.3799e0, 0.3274e0, 0.2779e0, 0.2298e0,
3055 0.1827e0, 0.1373e0, 0.0901e0, 0.0430e0, 0.0000e0 };
3056
3057 dx = 0.02;
3058 x = fissility(a, z, 0, 0., 0., optxfis);
3059
3060 v = (x - 0.3) / dx + 1.0;
3061 index = idnint(v);
3062
3063 if (index < 1)
3064 {
3065 return (alpha2[1]);
3066 }
3067
3068 if (index == 36)
3069 {
3070 return (alpha2[36]);
3071 }
3072 else
3073 {
3074 return (alpha2[index] + (alpha2[index + 1] - alpha2[index]) / dx * (x - (0.3e0 + dx * (index - 1))));
3075 }
3076
3077 return alpha2[0]; // The algorithm is not supposed to reach this point.
3078 }
3079
3080 G4double G4Abla::fissility(G4int a, G4int z, G4int ny, G4double sn, G4double slam, G4int optxfis)
3081 {
3082 // CALCULATION OF FISSILITY PARAMETER
3083 //
3084 // INPUT: A,Z INTEGER MASS & CHARGE OF NUCLEUS
3085 // OPTXFIS = 0 : MYERS, SWIATECKI
3086 // 1 : DAHLINGER
3087 // 2 : ANDREYEV
3088
3089 G4double aa = 0.0, zz = 0.0, i = 0.0, z2a, C_S, R, W, G, G1, G2, A_CC;
3090 G4double fissilityResult = 0.0;
3091
3092 aa = G4double(a);
3093 zz = G4double(z);
3094 i = G4double(a - 2 * z) / aa;
3095 z2a = zz * zz / aa - ny * (1115. - 939. + sn - slam) / (0.7053 * std::pow(a, 2. / 3.));
3096
3097 // myers & swiatecki droplet modell
3098 if (optxfis == 0)
3099 { // then
3100 fissilityResult = std::pow(zz, 2) / aa / 50.8830e0 / (1.0e0 - 1.7826e0 * std::pow(i, 2));
3101 }
3102
3103 if (optxfis == 1)
3104 {
3105 // dahlinger fit:
3106 fissilityResult = std::pow(zz, 2) / aa *
3107 std::pow((49.22e0 * (1.e0 - 0.3803e0 * std::pow(i, 2) - 20.489e0 * std::pow(i, 4))), (-1));
3108 }
3109
3110 if (optxfis == 2)
3111 {
3112 // dubna fit:
3113 fissilityResult = std::pow(zz, 2) / aa / (48.e0 * (1.e0 - 17.22e0 * std::pow(i, 4)));
3114 }
3115
3116 if (optxfis == 3)
3117 {
3118 // Fissiilty is calculated according to FRLDM, see Sierk, PRC 1984.
3119 C_S = 21.13 * (1.0 - 2.3 * i * i);
3120 R = 1.16 * std::pow(aa, 1.0 / 3.0);
3121 W = 0.704 / R;
3122 G1 = 1.0 - 15.0 / 8.0 * W + 21.0 / 8.0 * W * W * W;
3123 G2 = 1.0 + 9.0 / 2.0 * W + 7.0 * W * W + 7.0 / 2.0 * W * W * W;
3124 G = 1.0 - 5.0 * W * W * (G1 - 3.0 / 4.0 * G2 * std::exp(-2.0 / W));
3125 A_CC = 3.0 / 5.0 * 1.44 * G / 1.16;
3126 fissilityResult = z2a * A_CC / (2.0 * C_S);
3127 }
3128
3129 if (fissilityResult > 1.0)
3130 {
3131 fissilityResult = 1.0;
3132 }
3133
3134 if (fissilityResult < 0.0)
3135 {
3136 fissilityResult = 0.0;
3137 }
3138
3139 return fissilityResult;
3140 }
3141
3142 void G4Abla::evapora(G4double zprf,
3143 G4double aprf,
3144 G4double* ee_par,
3145 G4double jprf_par,
3146 G4double* zf_par,
3147 G4double* af_par,
3148 G4double* mtota_par,
3149 G4double* vleva_par,
3150 G4double* vxeva_par,
3151 G4double* vyeva_par,
3152 G4int* ff_par,
3153 G4int* fimf_par,
3154 G4double* fzimf,
3155 G4double* faimf,
3156 G4double* tkeimf_par,
3157 G4double* jprfout,
3158 G4int* inttype_par,
3159 G4int* inum_par,
3160 G4double EV_TEMP[indexpart][6],
3161 G4int* iev_tab_temp_par,
3162 G4int* NbLam0_par)
3163 {
3164 G4double zf = zprf;
3165 G4double af = aprf;
3166 G4double ee = (*ee_par);
3167 G4double jprf = dint(jprf_par);
3168 G4double mtota = (*mtota_par);
3169 G4double vleva = 0.;
3170 G4double vxeva = 0.;
3171 G4double vyeva = 0.;
3172 G4int ff = (*ff_par);
3173 G4int fimf = (*fimf_par);
3174 G4double tkeimf = (*tkeimf_par);
3175 G4int inttype = (*inttype_par);
3176 G4int inum = (*inum_par);
3177 G4int NbLam0 = (*NbLam0_par);
3178
3179 // 533 C
3180 // 534 C INPUT:
3181 // 535 C
3182 // 536 C ZPRF, APRF, EE(EE IS MODIFIED!), JPRF
3183 // 537 C
3184 // 538 C PROJECTILE AND TARGET PARAMETERS + CROSS SECTIONS
3185 // 539 C COMMON /ABRAMAIN/
3186 // AP,ZP,AT,ZT,EAP,BETA,BMAXNUC,CRTOT,CRNUC, 540 C R_0,R_P,R_T,
3187 // IMAX,IRNDM,PI, 541 C BFPRO,SNPRO,SPPRO,SHELL
3188 // 542 C
3189 // 543 C AP,ZP,AT,ZT - PROJECTILE AND TARGET MASSES
3190 // 544 C EAP,BETA - BEAM ENERGY PER NUCLEON, V/C
3191 // 545 C BMAXNUC - MAX. IMPACT PARAMETER FOR NUCL. REAC.
3192 // 546 C CRTOT,CRNUC - TOTAL AND NUCLEAR REACTION CROSS SECTION
3193 // 547 C R_0,R_P,R_T, - RADIUS PARAMETER, PROJECTILE+ TARGET RADII
3194 // 548 C IMAX,IRNDM,PI - MAXIMUM NUMBER OF EVENTS, DUMMY, 3.141...
3195 // 549 C BFPRO - FISSION BARRIER OF THE PROJECTILE
3196 // 550 C SNPRO - NEUTRON SEPARATION ENERGY OF THE
3197 // PROJECTILE 551 C SPPRO - PROTON " " " " "
3198 // 552 C SHELL - GROUND STATE SHELL CORRECTION
3199 // 553 C
3200 // 554
3201 // C---------------------------------------------------------------------
3202 // 555 C FISSION BARRIERS
3203 // 556 C COMMON /FB/ EFA
3204 // 557 C EFA - ARRAY OF FISSION BARRIERS
3205 // 558
3206 // C---------------------------------------------------------------------
3207 // 559 C OUTPUT:
3208 // 560 C ZF, AF, MTOTA, PLEVA, PTEVA, FF, INTTYPE, INUM
3209 // 561 C
3210 // 562 C ZF,AF - CHARGE AND MASS OF FINAL FRAGMENT AFTER
3211 // EVAPORATION 563 C MTOTA _ NUMBER OF EVAPORATED ALPHAS 564 C
3212 // PLEVA,PXEVA,PYEVA - MOMENTUM RECOIL BY EVAPORATION 565 C INTTYPE -
3213 // TYPE OF REACTION 0/1 NUCLEAR OR ELECTROMAGNETIC 566 C FF - 0/1
3214 // NO FISSION / FISSION EVENT 567 C INUM - EVENTNUMBER 568 C
3215 // ____________________________________________________________________ 569
3216 // C / 570 C / CALCUL DE LA MASSE ET CHARGE FINALES D'UNE CHAINE
3217 // D'EVAPORATION 571 C /
3218 // 572 C / PROCEDURE FOR CALCULATING THE FINAL MASS AND CHARGE VALUES
3219 // OF A
3220 // 573 C / SPECIFIC EVAPORATION CHAIN, STARTING POINT DEFINED BY
3221 // (APRF, ZPRF, 574 C / EE) 575 C / On ajoute les 3
3222 // composantes de l'impulsion (PXEVA,PYEVA,PLEVA)
3223 // 576 C / (actuellement PTEVA n'est pas correct; mauvaise
3224 // norme...) 577 C
3225 // /____________________________________________________________________
3226 // 578 C
3227 // 612 C
3228 // 613
3229 // C-----------------------------------------------------------------------
3230 // 614 C IRNDM DUMMY ARGUMENT FOR RANDOM-NUMBER
3231 // FUNCTION 615 C SORTIE LOCAL HELP VARIABLE TO END THE
3232 // EVAPORATION CHAIN 616 C ZF NUCLEAR CHARGE OF THE
3233 // FRAGMENT 617 C ZPRF NUCLEAR CHARGE OF THE
3234 // PREFRAGMENT 618 C AF MASS NUMBER OF THE FRAGMENT 619
3235 // C APRF MASS NUMBER OF THE PREFRAGMENT
3236 // 620 C EPSILN ENERGY BURNED IN EACH EVAPORATION STEP
3237 // 621 C MALPHA LOCAL MASS CONTRIBUTION TO MTOTA IN EACH
3238 // EVAPORATION 622 C STEP 623 C EE
3239 // EXCITATION ENERGY (VARIABLE) 624 C PROBP PROTON
3240 // EMISSION PROBABILITY 625 C PROBN NEUTRON EMISSION
3241 // PROBABILITY 626 C PROBA ALPHA-PARTICLE EMISSION
3242 // PROBABILITY 627 C PTOTL TOTAL EMISSION PROBABILITY 628
3243 // C E LOWEST PARTICLE-THRESHOLD ENERGY 629 C SN
3244 // NEUTRON SEPARATION ENERGY 630 C SBP PROTON
3245 // SEPARATION ENERGY PLUS EFFECTIVE COULOMB 631 C BARRIER 632 C SBA
3246 // ALPHA-PARTICLE SEPARATION ENERGY PLUS EFFECTIVE 633 C COULOMB
3247 // BARRIER 634 C BP EFFECTIVE PROTON COULOMB BARRIER
3248 // 635 C BA EFFECTIVE ALPHA COULOMB BARRIER
3249 // 636 C MTOTA TOTAL MASS OF THE EVAPORATED ALPHA
3250 // PARTICLES 637 C X UNIFORM RANDOM NUMBER FOR
3251 // NUCLEAR CHARGE
3252 // 638 C AMOINS LOCAL MASS NUMBER OF EVAPORATED PARTICLE
3253 // 639 C ZMOINS LOCAL NUCLEAR CHARGE OF EVAPORATED PARTICLE
3254 // 640 C ECP KINETIC ENERGY OF PROTON WITHOUT COULOMB
3255 // 641 C REPULSION
3256 // 642 C ECN KINETIC ENERGY OF NEUTRON
3257 // 643 C ECA KINETIC ENERGY OF ALPHA PARTICLE WITHOUT
3258 // COULOMB 644 C REPULSION 645 C PLEVA
3259 // TRANSVERSAL RECOIL MOMENTUM OF EVAPORATION 646 C PTEVA LONGITUDINAL
3260 // RECOIL MOMENTUM OF EVAPORATION 647 C FF FISSION
3261 // FLAG 648 C INTTYPE INTERACTION TYPE FLAG
3262 // 649 C RNDX RECOIL MOMENTUM IN X-DIRECTION IN A
3263 // SINGLE STEP 650 C RNDY RECOIL MOMENTUM IN Y-DIRECTION
3264 // IN A SINGLE STEP 651 C RNDZ RECOIL MOMENTUM IN
3265 // Z-DIRECTION IN A SINGLE STEP
3266 // 652 C RNDN NORMALIZATION OF RECOIL MOMENTUM FOR
3267 // EACH STEP 653
3268 // C-----------------------------------------------------------------------
3269 // 654 C
3270 //
3271 G4double epsiln = 0.0, probp = 0.0, probd = 0.0, probt = 0.0, probn = 0.0, probhe = 0.0, proba = 0.0, probg = 0.0,
3272 probimf = 0.0, problamb0 = 0.0, ptotl = 0.0, e = 0.0, tcn = 0.0;
3273 G4double sn = 0.0, sbp = 0.0, sbd = 0.0, sbt = 0.0, sbhe = 0.0, sba = 0.0, x = 0.0, amoins = 0.0, zmoins = 0.0,
3274 sp = 0.0, sd = 0.0, st = 0.0, she = 0.0, sa = 0.0, slamb0 = 0.0;
3275 G4double ecn = 0.0, ecp = 0.0, ecd = 0.0, ect = 0.0, eche = 0.0, eca = 0.0, ecg = 0.0, eclamb0 = 0.0, bp = 0.0,
3276 bd = 0.0, bt = 0.0, bhe = 0.0, ba = 0.0;
3277 G4double zimf = 0.0, aimf = 0.0, bimf = 0.0, sbimf = 0.0, timf = 0.0;
3278 G4int itest = 0, sortie = 0;
3279 G4double probf = 0.0;
3280 G4double ctet1 = 0.0, stet1 = 0.0, phi1 = 0.0;
3281 G4double rnd = 0.0;
3282 G4double ef = 0.0;
3283 G4double ts1 = 0.0;
3284 G4int fgamma = 0, gammadecay = 0, flamb0decay = 0;
3285 G4double pc = 0.0, malpha = 0.0;
3286 G4double jprfn = 0.0, jprfp = 0.0, jprfd = 0.0, jprft = 0.0, jprfhe = 0.0, jprfa = 0.0, jprflamb0 = 0.0;
3287 G4double tsum = 0.0;
3288 G4int twon;
3289
3290 const G4double c = 29.9792458;
3291 const G4double mu = 931.494;
3292 const G4double mu2 = 931.494 * 931.494;
3293
3294 G4double pleva = 0.0;
3295 G4double pxeva = 0.0;
3296 G4double pyeva = 0.0;
3297 G4int IEV_TAB_TEMP = 0;
3298
3299 for (G4int I1 = 0; I1 < indexpart; I1++)
3300 for (G4int I2 = 0; I2 < 6; I2++)
3301 EV_TEMP[I1][I2] = 0.0;
3302 //
3303 ff = 0;
3304 itest = 0;
3305 //
3306 evapora10:
3307 //
3308 // calculation of the probabilities for the different decay channels
3309 // plus separation energies and kinetic energies of the particles
3310 //
3311 if (ee < 0. || zf < 3.)
3312 goto evapora100;
3313 direct(zf,
3314 af,
3315 ee,
3316 jprf,
3317 &probp,
3318 &probd,
3319 &probt,
3320 &probn,
3321 &probhe,
3322 &proba,
3323 &probg,
3324 &probimf,
3325 &probf,
3326 &problamb0,
3327 &ptotl,
3328 &sn,
3329 &sbp,
3330 &sbd,
3331 &sbt,
3332 &sbhe,
3333 &sba,
3334 &slamb0,
3335 &ecn,
3336 &ecp,
3337 &ecd,
3338 &ect,
3339 &eche,
3340 &eca,
3341 &ecg,
3342 &eclamb0,
3343 &bp,
3344 &bd,
3345 &bt,
3346 &bhe,
3347 &ba,
3348 &sp,
3349 &sd,
3350 &st,
3351 &she,
3352 &sa,
3353 &ef,
3354 &ts1,
3355 inttype,
3356 inum,
3357 itest,
3358 &sortie,
3359 &tcn,
3360 &jprfn,
3361 &jprfp,
3362 &jprfd,
3363 &jprft,
3364 &jprfhe,
3365 &jprfa,
3366 &jprflamb0,
3367 &tsum,
3368 NbLam0);
3369 //
3370 // HERE THE FINAL STEPS OF THE EVAPORATION ARE CALCULATED
3371 //
3372 if (ptotl == 0.0)
3373 goto evapora100;
3374
3375 e = dmin1(sba, sbhe, dmin1(sbt, sbhe, dmin1(sn, sbp, sbd)));
3376
3377 if (e > 1e30)
3378 std::cout << "ERROR AT THE EXIT OF EVAPORA,E>1.D30,AF=" << af << " ZF=" << zf << std::endl;
3379
3380 if (sortie == 1)
3381 {
3382 if (probn != 0.0)
3383 {
3384 amoins = 1.0;
3385 zmoins = 0.0;
3386 epsiln = sn + ecn;
3387 pc = std::sqrt(std::pow((1.0 + (ecn) / 9.3956e2), 2.) - 1.0) * 9.3956e2;
3388 malpha = 0.0;
3389 fgamma = 0;
3390 fimf = 0;
3391 flamb0decay = 0;
3392 gammadecay = 0;
3393 }
3394 else if (probp != 0.0)
3395 {
3396 amoins = 1.0;
3397 zmoins = 1.0;
3398 epsiln = sp + ecp;
3399 pc = std::sqrt(std::pow((1.0 + ecp / 9.3827e2), 2.) - 1.0) * 9.3827e2;
3400 malpha = 0.0;
3401 fgamma = 0;
3402 fimf = 0;
3403 flamb0decay = 0;
3404 gammadecay = 0;
3405 }
3406 else if (probd != 0.0)
3407 {
3408 amoins = 2.0;
3409 zmoins = 1.0;
3410 epsiln = sd + ecd;
3411 pc = std::sqrt(std::pow((1.0 + ecd / 1.875358e3), 2) - 1.0) * 1.875358e3;
3412 malpha = 0.0;
3413 fgamma = 0;
3414 fimf = 0;
3415 flamb0decay = 0;
3416 gammadecay = 0;
3417 }
3418 else if (probt != 0.0)
3419 {
3420 amoins = 3.0;
3421 zmoins = 1.0;
3422 epsiln = st + ect;
3423 pc = std::sqrt(std::pow((1.0 + ect / 2.80828e3), 2) - 1.0) * 2.80828e3;
3424 malpha = 0.0;
3425 fgamma = 0;
3426 fimf = 0;
3427 flamb0decay = 0;
3428 gammadecay = 0;
3429 }
3430 else if (probhe != 0.0)
3431 {
3432 amoins = 3.0;
3433 zmoins = 2.0;
3434 epsiln = she + eche;
3435 pc = std::sqrt(std::pow((1.0 + eche / 2.80826e3), 2) - 1.0) * 2.80826e3;
3436 malpha = 0.0;
3437 fgamma = 0;
3438 fimf = 0;
3439 flamb0decay = 0;
3440 gammadecay = 0;
3441 }
3442 else
3443 {
3444 if (proba != 0.0)
3445 {
3446 amoins = 4.0;
3447 zmoins = 2.0;
3448 epsiln = sa + eca;
3449 pc = std::sqrt(std::pow((1.0 + eca / 3.72834e3), 2) - 1.0) * 3.72834e3;
3450 malpha = 4.0;
3451 fgamma = 0;
3452 fimf = 0;
3453 flamb0decay = 0;
3454 gammadecay = 0;
3455 }
3456 }
3457 goto direct99;
3458 }
3459
3460 // here the normal evaporation cascade starts
3461
3462 // random number for the evaporation
3463 x = G4AblaRandom::flat() * ptotl;
3464
3465 itest = 0;
3466 if (x < proba)
3467 {
3468 // alpha evaporation
3469 amoins = 4.0;
3470 zmoins = 2.0;
3471 epsiln = sa + eca;
3472 pc = std::sqrt(std::pow((1.0 + eca / 3.72834e3), 2) - 1.0) * 3.72834e3;
3473 malpha = 4.0;
3474 fgamma = 0;
3475 fimf = 0;
3476 ff = 0;
3477 flamb0decay = 0;
3478 gammadecay = 0;
3479 jprf = jprfa;
3480 }
3481 else if (x < proba + probhe)
3482 {
3483 // He3 evaporation
3484 amoins = 3.0;
3485 zmoins = 2.0;
3486 epsiln = she + eche;
3487 pc = std::sqrt(std::pow((1.0 + eche / 2.80826e3), 2) - 1.0) * 2.80826e3;
3488 malpha = 0.0;
3489 fgamma = 0;
3490 fimf = 0;
3491 ff = 0;
3492 flamb0decay = 0;
3493 gammadecay = 0;
3494 jprf = jprfhe;
3495 }
3496 else if (x < proba + probhe + probt)
3497 {
3498 // triton evaporation
3499 amoins = 3.0;
3500 zmoins = 1.0;
3501 epsiln = st + ect;
3502 pc = std::sqrt(std::pow((1.0 + ect / 2.80828e3), 2) - 1.0) * 2.80828e3;
3503 malpha = 0.0;
3504 fgamma = 0;
3505 fimf = 0;
3506 ff = 0;
3507 flamb0decay = 0;
3508 gammadecay = 0;
3509 jprf = jprft;
3510 }
3511 else if (x < proba + probhe + probt + probd)
3512 {
3513 // deuteron evaporation
3514 amoins = 2.0;
3515 zmoins = 1.0;
3516 epsiln = sd + ecd;
3517 pc = std::sqrt(std::pow((1.0 + ecd / 1.875358e3), 2) - 1.0) * 1.875358e3;
3518 malpha = 0.0;
3519 fgamma = 0;
3520 fimf = 0;
3521 ff = 0;
3522 flamb0decay = 0;
3523 gammadecay = 0;
3524 jprf = jprfd;
3525 }
3526 else if (x < proba + probhe + probt + probd + probp)
3527 {
3528 // proton evaporation
3529 amoins = 1.0;
3530 zmoins = 1.0;
3531 epsiln = sp + ecp;
3532 pc = std::sqrt(std::pow((1.0 + ecp / 9.3827e2), 2) - 1.0) * 9.3827e2;
3533 malpha = 0.0;
3534 fgamma = 0;
3535 fimf = 0;
3536 ff = 0;
3537 flamb0decay = 0;
3538 gammadecay = 0;
3539 jprf = jprfp;
3540 }
3541 else if (x < proba + probhe + probt + probd + probp + probn)
3542 {
3543 // neutron evaporation
3544 amoins = 1.0;
3545 zmoins = 0.0;
3546 epsiln = sn + ecn;
3547 pc = std::sqrt(std::pow((1.0 + (ecn) / 9.3956e2), 2.) - 1.0) * 9.3956e2;
3548 malpha = 0.0;
3549 fgamma = 0;
3550 fimf = 0;
3551 ff = 0;
3552 flamb0decay = 0;
3553 gammadecay = 0;
3554 jprf = jprfn;
3555 }
3556 else if (x < proba + probhe + probt + probd + probp + probn + problamb0)
3557 {
3558 // lambda0 evaporation
3559 amoins = 1.0;
3560 zmoins = 0.0;
3561 epsiln = slamb0 + eclamb0;
3562 pc = std::sqrt(std::pow((1.0 + (eclamb0) / 11.1568e2), 2.) - 1.0) * 11.1568e2;
3563 malpha = 0.0;
3564 fgamma = 0;
3565 fimf = 0;
3566 ff = 0;
3567 flamb0decay = 1;
3568 opt->nblan0 = opt->nblan0 - 1;
3569 NbLam0 = NbLam0 - 1;
3570 gammadecay = 0;
3571 jprf = jprflamb0;
3572 }
3573 else if (x < proba + probhe + probt + probd + probp + probn + problamb0 + probg)
3574 {
3575 // gamma evaporation
3576 amoins = 0.0;
3577 zmoins = 0.0;
3578 epsiln = ecg;
3579 pc = ecg;
3580 malpha = 0.0;
3581 flamb0decay = 0;
3582 gammadecay = 1;
3583 // Next IF command is to shorten the calculations when gamma-emission is the
3584 // only possible channel
3585 if (probp == 0.0 && probn == 0.0 && probd == 0.0 && probt == 0.0 && proba == 0.0 && probhe == 0.0 &&
3586 problamb0 == 0.0 && probimf == 0.0 && probf == 0.0)
3587 fgamma = 1;
3588 fimf = 0;
3589 ff = 0;
3590 }
3591 else if (x < proba + probhe + probt + probd + probp + probn + problamb0 + probg + probimf)
3592 {
3593 // imf evaporation
3594 // AIMF and ZIMF obtained from complete procedure (integration over all
3595 // possible Gamma(IMF) and then randomly picked
3596
3597 G4int iloop = 0;
3598 dir1973:
3599 imf(af, zf, tcn, ee, &zimf, &aimf, &bimf, &sbimf, &timf, jprf);
3600 iloop++;
3601 if (iloop > 100)
3602 std::cout << "Problem in EVAPORA: IMF called > 100 times" << std::endl;
3603 if (zimf >= (zf - 2.0))
3604 goto dir1973;
3605 if (zimf > zf / 2.0)
3606 {
3607 zimf = zf - zimf;
3608 aimf = af - aimf;
3609 }
3610 // These cases should in principle never happen
3611 if (zimf == 0.0 || aimf == 0.0 || sbimf > ee)
3612 std::cout << "warning: Look in EVAPORA CALL IMF" << std::endl;
3613
3614 // I sample the total kinetic energy consumed by the system of two nuclei
3615 // from the distribution determined with the temperature at saddle point
3616 // TKEIMF is the kinetic energy in the centre of mass of IMF and its partner
3617
3618 G4int ii = 0;
3619 dir1235:
3620 tkeimf = fmaxhaz(timf);
3621 ii++;
3622 if (ii > 100)
3623 {
3624 tkeimf = min(2.0 * timf, ee - sbimf);
3625 goto dir1000;
3626 }
3627 if (tkeimf <= 0.0)
3628 goto dir1235;
3629 if (tkeimf > (ee - sbimf) && timf > 0.5)
3630 goto dir1235;
3631 dir1000:
3632 tkeimf = tkeimf + bimf;
3633
3634 amoins = aimf;
3635 zmoins = zimf;
3636 epsiln = (sbimf - bimf) + tkeimf;
3637 pc = 0.0;
3638 malpha = 0.0;
3639 fgamma = 0;
3640 fimf = 1;
3641 ff = 0;
3642 flamb0decay = 0;
3643 gammadecay = 0;
3644 }
3645 else
3646 {
3647 // fission
3648 // in case of fission-events the fragment nucleus is the mother nucleus
3649 // before fission occurs with excitation energy above the fis.- barrier.
3650 // fission fragment mass distribution is calulated in subroutine fisdis
3651
3652 amoins = 0.0;
3653 zmoins = 0.0;
3654 epsiln = ef;
3655 //
3656 malpha = 0.0;
3657 pc = 0.0;
3658 ff = 1;
3659 fimf = 0;
3660 fgamma = 0;
3661 flamb0decay = 0;
3662 gammadecay = 0;
3663 }
3664 //
3665 direct99:
3666 if (ee <= 0.01)
3667 ee = 0.01;
3668 // Davide Mancusi (DM) - 2010
3669 if (gammadecay == 1 && ee < (epsiln + 0.010))
3670 {
3671 epsiln = ee - 0.010;
3672 // fgamma = 1;
3673 }
3674
3675 if (epsiln < 0.0)
3676 {
3677 std::cout << "***WARNING epsilon<0***" << std::endl;
3678 // epsiln=0.;
3679 // PRINT*,IDECAYMODE,IDNINT(AF),IDNINT(ZF),EE,EPSILN
3680 }
3681 // calculation of the daughter nucleus
3682 af = af - amoins;
3683 zf = zf - zmoins;
3684 ee = ee - epsiln;
3685 if (ee <= 0.01)
3686 ee = 0.01;
3687 mtota = mtota + malpha;
3688
3689 // if(amoins==2 && zmoins==0)std::cout << ee << std::endl;
3690
3691 secondneutron:
3692 if (amoins == 2 && zmoins == 0)
3693 {
3694 twon = 1;
3695 amoins = 1;
3696 }
3697 else
3698 {
3699 twon = 0;
3700 }
3701
3702 // Determination of x,y,z components of momentum from known emission momentum
3703 // PC
3704 if (ff == 0 && fimf == 0)
3705 {
3706 //
3707 if (flamb0decay == 1)
3708 {
3709 EV_TEMP[IEV_TAB_TEMP][0] = 0.;
3710 EV_TEMP[IEV_TAB_TEMP][1] = -2;
3711 EV_TEMP[IEV_TAB_TEMP][5] = 1.;
3712 }
3713 else
3714 {
3715 EV_TEMP[IEV_TAB_TEMP][0] = zmoins;
3716 EV_TEMP[IEV_TAB_TEMP][1] = amoins;
3717 EV_TEMP[IEV_TAB_TEMP][5] = 0.;
3718 }
3719 rnd = G4AblaRandom::flat();
3720 ctet1 = 2.0 * rnd - 1.0; // z component: uniform probability between -1 and 1
3721 stet1 = std::sqrt(1.0 - std::pow(ctet1, 2)); // component perpendicular to z
3722 rnd = G4AblaRandom::flat();
3723 phi1 = rnd * 2.0 * 3.141592654; // angle in x-y plane: uniform probability
3724 // between 0 and 2*pi
3725 G4double xcv = stet1 * std::cos(phi1); // x component
3726 G4double ycv = stet1 * std::sin(phi1); // y component
3727 G4double zcv = ctet1; // z component
3728 // In the CM system
3729 if (gammadecay == 0)
3730 {
3731 // Light particle
3732 G4double ETOT_LP = std::sqrt(pc * pc + amoins * amoins * mu2);
3733 if (flamb0decay == 1)
3734 ETOT_LP = std::sqrt(pc * pc + 1115.683 * 1115.683);
3735 EV_TEMP[IEV_TAB_TEMP][2] = c * pc * xcv / ETOT_LP;
3736 EV_TEMP[IEV_TAB_TEMP][3] = c * pc * ycv / ETOT_LP;
3737 EV_TEMP[IEV_TAB_TEMP][4] = c * pc * zcv / ETOT_LP;
3738 }
3739 else
3740 {
3741 // gamma ray
3742 EV_TEMP[IEV_TAB_TEMP][2] = pc * xcv;
3743 EV_TEMP[IEV_TAB_TEMP][3] = pc * ycv;
3744 EV_TEMP[IEV_TAB_TEMP][4] = pc * zcv;
3745 }
3746 G4double VXOUT = 0., VYOUT = 0., VZOUT = 0.;
3747 lorentz_boost(vxeva,
3748 vyeva,
3749 vleva,
3750 EV_TEMP[IEV_TAB_TEMP][2],
3751 EV_TEMP[IEV_TAB_TEMP][3],
3752 EV_TEMP[IEV_TAB_TEMP][4],
3753 &VXOUT,
3754 &VYOUT,
3755 &VZOUT);
3756 EV_TEMP[IEV_TAB_TEMP][2] = VXOUT;
3757 EV_TEMP[IEV_TAB_TEMP][3] = VYOUT;
3758 EV_TEMP[IEV_TAB_TEMP][4] = VZOUT;
3759 // Heavy residue
3760 if (gammadecay == 0)
3761 {
3762 G4double v2 = std::pow(EV_TEMP[IEV_TAB_TEMP][2], 2.) + std::pow(EV_TEMP[IEV_TAB_TEMP][3], 2.) +
3763 std::pow(EV_TEMP[IEV_TAB_TEMP][4], 2.);
3764 G4double gamma = 1.0 / std::sqrt(1.0 - v2 / (c * c));
3765 G4double etot_lp = amoins * mu * gamma;
3766 pxeva = pxeva - EV_TEMP[IEV_TAB_TEMP][2] * etot_lp / c;
3767 pyeva = pyeva - EV_TEMP[IEV_TAB_TEMP][3] * etot_lp / c;
3768 pleva = pleva - EV_TEMP[IEV_TAB_TEMP][4] * etot_lp / c;
3769 }
3770 else
3771 {
3772 // in case of gammas, EV_TEMP contains momentum components and not
3773 // velocity
3774 pxeva = pxeva - EV_TEMP[IEV_TAB_TEMP][2];
3775 pyeva = pyeva - EV_TEMP[IEV_TAB_TEMP][3];
3776 pleva = pleva - EV_TEMP[IEV_TAB_TEMP][4];
3777 }
3778 G4double pteva = std::sqrt(pxeva * pxeva + pyeva * pyeva);
3779 // To be checked:
3780 G4double etot = std::sqrt(pleva * pleva + pteva * pteva + af * af * mu2);
3781 vxeva = c * pxeva / etot; // recoil velocity components of residue due to evaporation
3782 vyeva = c * pyeva / etot;
3783 vleva = c * pleva / etot;
3784 IEV_TAB_TEMP = IEV_TAB_TEMP + 1;
3785 }
3786
3787 if (twon == 1)
3788 {
3789 goto secondneutron;
3790 }
3791
3792 // condition for end of evaporation
3793 if (zf < 3. || (ff == 1) || (fgamma == 1) || (fimf == 1))
3794 {
3795 goto evapora100;
3796 }
3797 goto evapora10;
3798
3799 evapora100:
3800 (*zf_par) = zf;
3801 (*af_par) = af;
3802 (*ee_par) = ee;
3803 (*faimf) = aimf;
3804 (*fzimf) = zimf;
3805 (*jprfout) = jprf;
3806 (*tkeimf_par) = tkeimf;
3807 (*mtota_par) = mtota;
3808 (*vleva_par) = vleva;
3809 (*vxeva_par) = vxeva;
3810 (*vyeva_par) = vyeva;
3811 (*ff_par) = ff;
3812 (*fimf_par) = fimf;
3813 (*inttype_par) = inttype;
3814 (*iev_tab_temp_par) = IEV_TAB_TEMP;
3815 (*inum_par) = inum;
3816 (*NbLam0_par) = NbLam0;
3817 return;
3818 }
3819
3820 void G4Abla::direct(G4double zprf,
3821 G4double a,
3822 G4double ee,
3823 G4double jprf,
3824 G4double* probp_par,
3825 G4double* probd_par,
3826 G4double* probt_par,
3827 G4double* probn_par,
3828 G4double* probhe_par,
3829 G4double* proba_par,
3830 G4double* probg_par,
3831 G4double* probimf_par,
3832 G4double* probf_par,
3833 G4double* problamb0_par,
3834 G4double* ptotl_par,
3835 G4double* sn_par,
3836 G4double* sbp_par,
3837 G4double* sbd_par,
3838 G4double* sbt_par,
3839 G4double* sbhe_par,
3840 G4double* sba_par,
3841 G4double* slamb0_par,
3842 G4double* ecn_par,
3843 G4double* ecp_par,
3844 G4double* ecd_par,
3845 G4double* ect_par,
3846 G4double* eche_par,
3847 G4double* eca_par,
3848 G4double* ecg_par,
3849 G4double* eclamb0_par,
3850 G4double* bp_par,
3851 G4double* bd_par,
3852 G4double* bt_par,
3853 G4double* bhe_par,
3854 G4double* ba_par,
3855 G4double* sp_par,
3856 G4double* sd_par,
3857 G4double* st_par,
3858 G4double* she_par,
3859 G4double* sa_par,
3860 G4double* ef_par,
3861 G4double* ts1_par,
3862 G4int,
3863 G4int inum,
3864 G4int itest,
3865 G4int* sortie,
3866 G4double* tcn,
3867 G4double* jprfn_par,
3868 G4double* jprfp_par,
3869 G4double* jprfd_par,
3870 G4double* jprft_par,
3871 G4double* jprfhe_par,
3872 G4double* jprfa_par,
3873 G4double* jprflamb0_par,
3874 G4double* tsum_par,
3875 G4int NbLam0)
3876 {
3877 G4double probp = (*probp_par);
3878 G4double probd = (*probd_par);
3879 G4double probt = (*probt_par);
3880 G4double probn = (*probn_par);
3881 G4double probhe = (*probhe_par);
3882 G4double proba = (*proba_par);
3883 G4double probg = (*probg_par);
3884 G4double probimf = (*probimf_par);
3885 G4double probf = (*probf_par);
3886 G4double problamb0 = (*problamb0_par);
3887 G4double ptotl = (*ptotl_par);
3888 G4double sn = (*sn_par);
3889 G4double sp = (*sp_par);
3890 G4double sd = (*sd_par);
3891 G4double st = (*st_par);
3892 G4double she = (*she_par);
3893 G4double sa = (*sa_par);
3894 G4double slamb0 = 0.0;
3895 G4double sbp = (*sbp_par);
3896 G4double sbd = (*sbd_par);
3897 G4double sbt = (*sbt_par);
3898 G4double sbhe = (*sbhe_par);
3899 G4double sba = (*sba_par);
3900 G4double ecn = (*ecn_par);
3901 G4double ecp = (*ecp_par);
3902 G4double ecd = (*ecd_par);
3903 G4double ect = (*ect_par);
3904 G4double eche = (*eche_par);
3905 G4double eca = (*eca_par);
3906 G4double ecg = (*ecg_par);
3907 G4double eclamb0 = (*eclamb0_par);
3908 G4double bp = (*bp_par);
3909 G4double bd = (*bd_par);
3910 G4double bt = (*bt_par);
3911 G4double bhe = (*bhe_par);
3912 G4double ba = (*ba_par);
3913 G4double tsum = (*tsum_par);
3914
3915 // CALCULATION OF PARTICLE-EMISSION PROBABILITIES & FISSION /
3916 // BASED ON THE SIMPLIFIED FORMULAS FOR THE DECAY WIDTH BY /
3917 // MORETTO, ROCHESTER MEETING TO AVOID COMPUTING TIME /
3918 // INTENSIVE INTEGRATION OF THE LEVEL DENSITIES /
3919 // USES EFFECTIVE COULOMB BARRIERS AND AN AVERAGE KINETIC ENERGY/
3920 // OF THE EVAPORATED PARTICLES /
3921 // COLLECTIVE ENHANCMENT OF THE LEVEL DENSITY IS INCLUDED /
3922 // DYNAMICAL HINDRANCE OF FISSION IS INCLUDED BY A STEP FUNCTION/
3923 // APPROXIMATION. SEE A.R. JUNGHANS DIPLOMA THESIS /
3924 // SHELL AND PAIRING STRUCTURES IN THE LEVEL DENSITY IS INCLUDED/
3925
3926 // INPUT:
3927 // ZPRF,A,EE CHARGE, MASS, EXCITATION ENERGY OF COMPOUND
3928 // NUCLEUS
3929 // JPRF ROOT-MEAN-SQUARED ANGULAR MOMENTUM
3930
3931 // DEFORMATIONS AND G.S. SHELL EFFECTS
3932 // COMMON /ECLD/ ECGNZ,ECFNZ,VGSLD,ALPHA
3933
3934 // ECGNZ - GROUND STATE SHELL CORR. FRLDM FOR A SPHERICAL G.S.
3935 // ECFNZ - SHELL CORRECTION FOR THE SADDLE POINT (NOW: == 0)
3936 // VGSLD - DIFFERENCE BETWEEN DEFORMED G.S. AND LDM VALUE
3937 // ALPHA - ALPHA GROUND STATE DEFORMATION (THIS IS NOT BETA2!)
3938 // BETA2 = SQRT((4PI)/5) * ALPHA
3939
3940 // OPTIONS AND PARAMETERS FOR FISSION CHANNEL
3941 // COMMON /FISS/ AKAP,BET,HOMEGA,KOEFF,IFIS,
3942 // OPTSHP,OPTXFIS,OPTLES,OPTCOL
3943 //
3944 // AKAP - HBAR**2/(2* MN * R_0**2) = 10 MEV, R_0 = 1.4 FM
3945 // BET - REDUCED NUCLEAR FRICTION COEFFICIENT IN (10**21 S**-1)
3946 // HOMEGA - CURVATURE OF THE FISSION BARRIER = 1 MEV
3947 // KOEFF - COEFFICIENT FOR THE LD FISSION BARRIER == 1.0
3948 // IFIS - 0/1 FISSION CHANNEL OFF/ON
3949 // OPTSHP - INTEGER SWITCH FOR SHELL CORRECTION IN MASSES/ENERGY
3950 // = 0 NO MICROSCOPIC CORRECTIONS IN MASSES AND ENERGY
3951 // = 1 SHELL , NO PAIRING
3952 // = 2 PAIRING, NO SHELL
3953 // = 3 SHELL AND PAIRING
3954 // OPTCOL - 0/1 COLLECTIVE ENHANCEMENT SWITCHED ON/OFF
3955 // OPTXFIS- 0,1,2 FOR MYERS & SWIATECKI, DAHLINGER, ANDREYEV
3956 // FISSILITY PARAMETER.
3957 // OPTLES - CONSTANT TEMPERATURE LEVEL DENSITY FOR A,Z > TH-224
3958 // OPTCOL - 0/1 COLLECTIVE ENHANCEMENT OFF/ON
3959
3960 // LEVEL DENSITY PARAMETERS
3961 // COMMON /ALD/ AV,AS,AK,OPTAFAN
3962 // AV,AS,AK - VOLUME,SURFACE,CURVATURE DEPENDENCE OF THE
3963 // LEVEL DENSITY PARAMETER
3964 // OPTAFAN - 0/1 AF/AN >=1 OR AF/AN ==1
3965 // RECOMMENDED IS OPTAFAN = 0
3966
3967 // FISSION BARRIERS
3968 // COMMON /FB/ EFA
3969 // EFA - ARRAY OF FISSION BARRIERS
3970
3971 // OUTPUT: PROBN,PROBP,PROBA,PROBF,PTOTL:
3972 // - EMISSION PROBABILITIES FOR N EUTRON, P ROTON, A LPHA
3973 // PARTICLES, F ISSION AND NORMALISATION
3974 // SN,SBP,SBA: SEPARATION ENERGIES N P A
3975 // INCLUDING EFFECTIVE BARRIERS
3976 // ECN,ECP,ECA,BP,BA
3977 // - AVERAGE KINETIC ENERGIES (2*T) AND EFFECTIVE BARRIERS
3978
3979 G4double bk = 0.0;
3980 G4double bksp = 0.0;
3981 G4double bc = 0.0;
3982 G4int afp = 0;
3983 G4double het = 0.0;
3984 G4double at = 0.0;
3985 G4double bs = 0.0;
3986 G4double bssp = 0.0;
3987 G4double bshell = 0.0;
3988 G4double cf = 0.0;
3989 G4double defbet = 0.0;
3990 G4double densa = 0.0;
3991 G4double denshe = 0.0;
3992 G4double densg = 0.0;
3993 G4double densn = 0.0;
3994 G4double densp = 0.0;
3995 G4double densd = 0.0;
3996 G4double denst = 0.0;
3997 G4double denslamb0 = 0.0;
3998 G4double eer = 0.0;
3999 G4double ecor = 0.0;
4000 G4double ef = 0.0;
4001 G4double ft = 0.0;
4002 G4double timf = 0.0;
4003 G4double qr = 0.0;
4004 G4double qrcn = 0.0;
4005 G4double omegap = 0.0;
4006 G4double omegad = 0.0;
4007 G4double omegat = 0.0;
4008 G4double omegahe = 0.0;
4009 G4double omegaa = 0.0;
4010 G4double ga = 0.0;
4011 G4double ghe = 0.0;
4012 G4double gf = 0.0;
4013 G4double gff = 0.0;
4014 G4double gn = 0.0;
4015 G4double gp = 0.0;
4016 G4double gd = 0.0;
4017 G4double gt = 0.0;
4018 G4double gg = 0.0;
4019 G4double glamb0 = 0.0;
4020 G4double gimf = 0.0;
4021 G4double gimf3 = 0.0;
4022 G4double gimf5 = 0.0;
4023 G4double bimf = 0.0;
4024 G4double bsimf = 0.0;
4025 G4double sbimf = 0.0;
4026 G4double densimf = 0.0;
4027 G4double defbetimf = 0.0;
4028 G4double b_imf = 0.0;
4029 G4double a_imf = 0.0;
4030 G4double omegaimf = 0.0;
4031 G4int izimf = 0;
4032 G4double zimf = 0.0;
4033 G4double gsum = 0.0;
4034 G4double gtotal = 0.0;
4035 G4double hbar = 6.582122e-22;
4036 G4double emin = 0.0;
4037 G4int il = 0;
4038 G4int choice_fisspart = 0;
4039 G4double t_lapse = 0.0;
4040 G4int imaxwell = 0;
4041 G4int in = 0;
4042 G4int iz = 0;
4043 G4int ind = 0;
4044 G4int izd = 0;
4045 G4int j = 0;
4046 G4int k = 0;
4047 G4double ma1z = 0.0;
4048 G4double mazz = 0.0;
4049 G4double ma2z = 0.0;
4050 G4double ma1z1 = 0.0;
4051 G4double ma2z1 = 0.0;
4052 G4double ma3z1 = 0.0;
4053 G4double ma3z2 = 0.0;
4054 G4double ma4z2 = 0.0;
4055 G4double maz = 0.0;
4056 G4double nt = 0.0;
4057 G4double pi = 3.1415926535;
4058 G4double pt = 0.0;
4059 G4double dt = 0.0;
4060 G4double tt = 0.0;
4061 G4double lamb0t = 0.0;
4062 G4double gtemp = 0.0;
4063 G4double rdt = 0.0;
4064 G4double rtt = 0.0;
4065 G4double rat = 0.0;
4066 G4double rhet = 0.0;
4067 G4double refmod = 0.0;
4068 G4double rnt = 0.0;
4069 G4double rpt = 0.0;
4070 G4double rlamb0t = 0.0;
4071 G4double sbfis = 1.e40;
4072 G4double segs = 0.0;
4073 G4double selmax = 0.0;
4074 G4double tauc = 0.0;
4075 G4double temp = 0.0;
4076 G4double ts1 = 0.0;
4077 G4double xx = 0.0;
4078 G4double y = 0.0;
4079 G4double k1 = 0.0;
4080 G4double omegasp = 0.0;
4081 G4double homegasp = 0.0;
4082 G4double omegags = 0.0;
4083 G4double homegags = 0.0;
4084 G4double pa = 0.0;
4085 G4double gamma = 0.0;
4086 G4double gfactor = 0.0;
4087 G4double bscn;
4088 G4double bkcn;
4089 G4double bccn;
4090 G4double ftcn = 0.0;
4091 G4double mfcd;
4092 G4double jprfn = jprf;
4093 G4double jprfp = jprf;
4094 G4double jprfd = jprf;
4095 G4double jprft = jprf;
4096 G4double jprfhe = jprf;
4097 G4double jprfa = jprf;
4098 G4double jprflamb0 = jprf;
4099 G4double djprf = 0.0;
4100 G4double dlout = 0.0;
4101 G4double sdlout = 0.0;
4102 G4double iinert = 0.0;
4103 G4double erot = 0.0;
4104 G4double erotn = 0.0;
4105 G4double erotp = 0.0;
4106 G4double erotd = 0.0;
4107 G4double erott = 0.0;
4108 G4double erothe = 0.0;
4109 G4double erota = 0.0;
4110 G4double erotlamb0 = 0.0;
4111 G4double erotcn = 0.0;
4112 // G4double ecorcn=0.0;
4113 G4double imfarg = 0.0;
4114 G4double width_imf = 0.0;
4115 G4int IDjprf = 0;
4116 G4int fimf_allowed = opt->optimfallowed;
4117
4118 if (itest == 1)
4119 {
4120 }
4121 // Switch to calculate Maxwellian distribution of kinetic energies
4122 imaxwell = 1;
4123 *sortie = 0;
4124
4125 // just a change of name until the end of this subroutine
4126 eer = ee;
4127 if (inum == 1)
4128 {
4129 ilast = 1;
4130 }
4131 // calculation of masses
4132 // refmod = 1 ==> myers,swiatecki model
4133 // refmod = 0 ==> weizsaecker model
4134 refmod = 1; // Default = 1
4135 //
4136 if (refmod == 1)
4137 {
4138 mglms(a, zprf, fiss->optshp, &maz);
4139 mglms(a - 1.0, zprf, fiss->optshp, &ma1z);
4140 mglms(a - 2.0, zprf, fiss->optshp, &ma2z);
4141 mglms(a - 1.0, zprf - 1.0, fiss->optshp, &ma1z1);
4142 mglms(a - 2.0, zprf - 1.0, fiss->optshp, &ma2z1);
4143 mglms(a - 3.0, zprf - 1.0, fiss->optshp, &ma3z1);
4144 mglms(a - 3.0, zprf - 2.0, fiss->optshp, &ma3z2);
4145 mglms(a - 4.0, zprf - 2.0, fiss->optshp, &ma4z2);
4146 }
4147 else
4148 {
4149 mglw(a, zprf, &maz);
4150 mglw(a - 1.0, zprf, &ma1z);
4151 mglw(a - 1.0, zprf - 1.0, &ma1z1);
4152 mglw(a - 2.0, zprf - 1.0, &ma2z1);
4153 mglw(a - 3.0, zprf - 1.0, &ma3z1);
4154 mglw(a - 3.0, zprf - 2.0, &ma3z2);
4155 mglw(a - 4.0, zprf - 2.0, &ma4z2);
4156 }
4157
4158 if ((a - 1.) == 3.0 && (zprf - 1.0) == 2.0)
4159 ma1z1 = -7.7181660;
4160 if ((a - 1.) == 4.0 && (zprf - 1.0) == 2.0)
4161 ma1z1 = -28.295992;
4162
4163 // separation energies
4164 sn = ma1z - maz;
4165 sp = ma1z1 - maz;
4166 sd = ma2z1 - maz - 2.2246;
4167 st = ma3z1 - maz - 8.481977;
4168 she = ma3z2 - maz - 7.7181660;
4169 sa = ma4z2 - maz - 28.295992;
4170 //
4171 if (NbLam0 > 1)
4172 {
4173 sn = gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 1., zprf, NbLam0);
4174 sp = gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 1., zprf - 1., NbLam0);
4175 sd = gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 2., zprf - 1., NbLam0);
4176 st = gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 3., zprf - 1., NbLam0);
4177 she = gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 3., zprf - 2., NbLam0);
4178 sa = gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 4., zprf - 2., NbLam0);
4179 slamb0 = gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 1., zprf, NbLam0 - 1);
4180 }
4181 if (NbLam0 == 1)
4182 {
4183 G4double deltasn = sn - (gethyperbinding(a, zprf, 0) - gethyperbinding(a - 1., zprf, 0));
4184 G4double deltasp = sp - (gethyperbinding(a, zprf, 0) - gethyperbinding(a - 1., zprf - 1, 0));
4185 G4double deltasd = sd - (gethyperbinding(a, zprf, 0) - gethyperbinding(a - 2., zprf - 1, 0));
4186 G4double deltast = st - (gethyperbinding(a, zprf, 0) - gethyperbinding(a - 3., zprf - 1, 0));
4187 G4double deltashe = she - (gethyperbinding(a, zprf, 0) - gethyperbinding(a - 3., zprf - 2, 0));
4188 G4double deltasa = sa - (gethyperbinding(a, zprf, 0) - gethyperbinding(a - 4., zprf - 2, 0));
4189
4190 sn = deltasn + gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 1., zprf, NbLam0);
4191 sp = deltasp + gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 1., zprf - 1., NbLam0);
4192 sd = deltasd + gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 2., zprf - 1., NbLam0);
4193 st = deltast + gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 3., zprf - 1., NbLam0);
4194 she = deltashe + gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 3., zprf - 2., NbLam0);
4195 sa = deltasa + gethyperbinding(a, zprf, NbLam0) - gethyperbinding(a - 4., zprf - 2., NbLam0);
4196 slamb0 = gethyperseparation(a, zprf, NbLam0);
4197 }
4198
4199 // coulomb barriers
4200 // Proton
4201 if (zprf <= 1.0e0 || a <= 1.0e0 || (a - zprf) < 0.0)
4202 {
4203 sbp = 1.0e75;
4204 bp = 1.0e75;
4205 }
4206 else
4207 {
4208 barrs(idnint(zprf - 1.), idnint(a - 1.), 1, 1, &bp, &omegap);
4209 bp = max(bp, 0.1);
4210 sbp = sp + bp;
4211 }
4212
4213 // Deuteron
4214 if (zprf <= 1.0e0 || a <= 2.0e0 || (a - zprf) < 1.0)
4215 {
4216 sbd = 1.0e75;
4217 bd = 1.0e75;
4218 }
4219 else
4220 {
4221 barrs(idnint(zprf - 1.), idnint(a - 2.), 1, 2, &bd, &omegad);
4222 bd = max(bd, 0.1);
4223 sbd = sd + bd;
4224 }
4225
4226 // Triton
4227 if (zprf <= 1.0e0 || a <= 3.0e0 || (a - zprf) < 2.0)
4228 {
4229 sbt = 1.0e75;
4230 bt = 1.0e75;
4231 }
4232 else
4233 {
4234 barrs(idnint(zprf - 1.), idnint(a - 3.), 1, 3, &bt, &omegat);
4235 bt = max(bt, 0.1);
4236 sbt = st + bt;
4237 }
4238
4239 // Alpha
4240 if (a - 4.0 <= 0.0 || zprf <= 2.0 || (a - zprf) < 2.0)
4241 {
4242 sba = 1.0e+75;
4243 ba = 1.0e+75;
4244 }
4245 else
4246 {
4247 barrs(idnint(zprf - 2.), idnint(a - 4.), 2, 4, &ba, &omegaa);
4248 ba = max(ba, 0.1);
4249 sba = sa + ba;
4250 }
4251
4252 // He3
4253 if (a - 3.0 <= 0.0 || zprf <= 2.0 || (a - zprf) < 1.0)
4254 {
4255 sbhe = 1.0e+75;
4256 bhe = 1.0e+75;
4257 }
4258 else
4259 {
4260 barrs(idnint(zprf - 2.), idnint(a - 3.), 2, 3, &bhe, &omegahe);
4261 bhe = max(bhe, 0.1);
4262 sbhe = she + bhe;
4263 }
4264
4265 // Dealing with particle-unbound systems
4266 emin = dmin1(sba, sbhe, dmin1(sbt, sbhe, dmin1(sn, sbp, sbd)));
4267
4268 if (emin <= 0.0)
4269 {
4270 *sortie = 1;
4271 unbound(sn,
4272 sp,
4273 sd,
4274 st,
4275 she,
4276 sa,
4277 bp,
4278 bd,
4279 bt,
4280 bhe,
4281 ba,
4282 &probf,
4283 &probn,
4284 &probp,
4285 &probd,
4286 &probt,
4287 &probhe,
4288 &proba,
4289 &probimf,
4290 &probg,
4291 &ecn,
4292 &ecp,
4293 &ecd,
4294 &ect,
4295 &eche,
4296 &eca);
4297 goto direct70;
4298 }
4299 //
4300 k = idnint(zprf);
4301 j = idnint(a - zprf);
4302 if (fiss->ifis > 0)
4303 {
4304 // now ef is calculated from efa that depends on the subroutine
4305 // barfit which takes into account the modification on the ang. mom.
4306 // note *** shell correction (ecgnz)
4307 il = idnint(jprf);
4308 barfit(k, k + j, il, &sbfis, &segs, &selmax);
4309 if ((fiss->optshp == 1) || (fiss->optshp == 3))
4310 {
4311 ef = G4double(sbfis) - ecld->ecgnz[j][k];
4312 // JLRS - Nov 2016 - Corrected values of fission barriers for actinides
4313 if (k == 90)
4314 {
4315 if (mod(j, 2) == 1)
4316 {
4317 ef = ef * (4.5114 - 2.2687 * (a - zprf) / zprf);
4318 }
4319 else
4320 {
4321 ef = ef * (3.3931 - 1.5338 * (a - zprf) / zprf);
4322 }
4323 }
4324 if (k == 92)
4325 {
4326 if ((a - zprf) / zprf > 1.52)
4327 ef = ef * (1.1222 - 0.10886 * (a - zprf) / zprf) - 0.1;
4328 }
4329 if (k >= 94 && k <= 98 && j < 158)
4330 { // Data in this range have been
4331 // tested e-e
4332 if (mod(j, 2) == 0 && mod(k, 2) == 0)
4333 {
4334 if (k >= 94)
4335 {
4336 ef = ef - (11.54108 * (a - zprf) / zprf - 18.074);
4337 }
4338 }
4339 // O-O
4340 if (mod(j, 2) == 1 && mod(k, 2) == 1)
4341 {
4342 if (k >= 95)
4343 {
4344 ef = ef - (14.567 * (a - zprf) / zprf - 23.266);
4345 }
4346 }
4347 // Odd A
4348 if (mod(j, 2) == 0 && mod(k, 2) == 1)
4349 {
4350 if (j >= 144)
4351 {
4352 ef = ef - (13.662 * (a - zprf) / zprf - 21.656);
4353 }
4354 }
4355
4356 if (mod(j, 2) == 1 && mod(k, 2) == 0)
4357 {
4358 if (j >= 144)
4359 {
4360 ef = ef - (13.662 * (a - zprf) / zprf - 21.656);
4361 }
4362 }
4363 }
4364 }
4365 else
4366 {
4367 ef = G4double(sbfis);
4368 }
4369 //
4370 // TO AVOID NEGATIVE VALUES FOR IMPOSSIBLE NUCLEI
4371 // THE FISSION BARRIER IS SET TO ZERO IF SMALLER THAN ZERO.
4372 //
4373 if (ef < 0.0)
4374 ef = 0.0;
4375 fb->efa[j][k] = ef;
4376 //
4377 // Hyper-fission barrier
4378 //
4379 if (NbLam0 > 0)
4380 {
4381 ef = ef + 0.51 * (1115. - 938. + sn - slamb0) / std::pow(a, 2. / 3.);
4382 }
4383 //
4384 // Set fission barrier
4385 //
4386 (*ef_par) = ef;
4387 //
4388 // calculation of surface and curvature integrals needed to
4389 // to calculate the level density parameter at the saddle point
4390 xx = fissility((k + j), k, NbLam0, sn, slamb0, fiss->optxfis);
4391 y = 1.00 - xx;
4392 if (y < 0.0)
4393 y = 0.0;
4394 if (y > 1.0)
4395 y = 1.0;
4396 bssp = bipol(1, y);
4397 bksp = bipol(2, y);
4398 }
4399 else
4400 {
4401 ef = 1.0e40;
4402 sbfis = 1.0e40;
4403 bssp = 1.0;
4404 bksp = 1.0;
4405 }
4406 //
4407 // COMPOUND NUCLEUS LEVEL DENSITY
4408 //
4409 // AK 2007 - Now DENSNIV called with correct BS, BK
4410
4411 afp = idnint(a);
4412 iz = idnint(zprf);
4413 in = afp - iz;
4414 bshell = ecld->ecgnz[in][iz] - ecld->vgsld[in][iz];
4415 defbet = ecld->beta2[in][iz];
4416
4417 iinert = 0.4 * 931.49 * 1.16 * 1.16 * std::pow(a, 5.0 / 3.0) * (1.0 + 0.5 * std::sqrt(5. / (4. * pi)) * defbet);
4418 erot = jprf * jprf * 197.328 * 197.328 / (2. * iinert);
4419 erotcn = erot;
4420
4421 bsbkbc(a, zprf, &bscn, &bkcn, &bccn);
4422
4423 // if(ee > erot+emin){
4424 densniv(
4425 a, zprf, ee, 0.0, &densg, bshell, bscn, bkcn, &temp, fiss->optshp, fiss->optcol, defbet, &ecor, jprf, 0, &qrcn);
4426 ftcn = temp;
4427 /*
4428 //ecorcn = ecor;
4429 }else{
4430 // If EE < EROT, only gamma emission can take place
4431 probf = 0.0;
4432 probp = 0.0;
4433 probd = 0.0;
4434 probt = 0.0;
4435 probn = 0.0;
4436 probhe = 0.0;
4437 proba = 0.0;
4438 probg = 1.0;
4439 probimf = 0.0;
4440 //c JLRS 03/2017 - Added this calculation
4441 //C According to A. Ignatyuk, GG :
4442 //C Here BS=BK=1, as this was assumed in the parameterization
4443 pa = (ald->av)*a + (ald->as)*std::pow(a,2./3.) +
4444 (ald->ak)*std::pow(a,1./3.); gamma = 2.5 * pa * std::pow(a,-4./3.); gfactor
4445 = 1.+gamma*ecld->ecgnz[in][iz]; if(gfactor<=0.){ gfactor = 0.0;
4446 }
4447 //
4448 gtemp = 17.60/(std::pow(a,0.699) * std::sqrt(gfactor));
4449 ecg = 4.0 * gtemp;
4450 //
4451 goto direct70;
4452 }
4453 */
4454
4455 // ---------------------------------------------------------------
4456 // LEVEL DENSITIES AND TEMPERATURES OF THE FINAL STATES
4457 // ---------------------------------------------------------------
4458 //
4459 // MVR - in case of charged particle emission temperature
4460 // comes from random kinetic energy from a Maxwelliam distribution
4461 // if option imaxwell = 1 (otherwise E=2T)
4462 //
4463 // AK - LEVEL DENSITY AND TEMPERATURE AT THE SADDLE POINT -> now calculated
4464 // in the subroutine FISSION_WIDTH
4465 //
4466 //
4467 // LEVEL DENSITY AND TEMPERATURE IN THE NEUTRON DAUGHTER
4468 //
4469 // KHS, AK 2007 - Reduction of angular momentum due to orbital angular
4470 // momentum of emitted fragment JLRS Nov-2016 - Added these caculations in
4471 // abla++
4472
4473 if (in >= 2)
4474 {
4475 ind = idnint(a) - idnint(zprf) - 1;
4476 izd = idnint(zprf);
4477 if (jprf > 0.10)
4478 {
4479 lorb(a, a - 1., jprf, ee - sn, &dlout, &sdlout);
4480 djprf = gausshaz(1, dlout, sdlout);
4481 if (IDjprf == 1)
4482 djprf = 0.0;
4483 jprfn = jprf + djprf;
4484 jprfn = dint(std::abs(jprfn)); // The nucleus just turns the other way around
4485 }
4486 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
4487 defbet = ecld->beta2[ind][izd];
4488
4489 iinert =
4490 0.4 * 931.49 * 1.16 * 1.16 * std::pow(a - 1., 5.0 / 3.0) * (1.0 + 0.5 * std::sqrt(5. / (4. * pi)) * defbet);
4491 erotn = jprfn * jprfn * 197.328 * 197.328 / (2. * iinert);
4492 bsbkbc(a - 1., zprf, &bs, &bk, &bc);
4493
4494 // level density and temperature in the neutron daughter
4495 densniv(a - 1.0,
4496 zprf,
4497 ee,
4498 sn,
4499 &densn,
4500 bshell,
4501 bs,
4502 bk,
4503 &temp,
4504 fiss->optshp,
4505 fiss->optcol,
4506 defbet,
4507 &ecor,
4508 jprfn,
4509 0,
4510 &qr);
4511 nt = temp;
4512 ecn = 0.0;
4513 if (densn > 0.)
4514 {
4515 G4int IS = 0;
4516 if (imaxwell == 1)
4517 {
4518 rnt = nt;
4519 dir1234:
4520 ecn = fvmaxhaz_neut(rnt);
4521 IS++;
4522 if (IS > 100)
4523 {
4524 std::cout << "WARNING: FVMAXHAZ_NEUT CALLED MORE THAN 100 TIMES" << std::endl;
4525 goto exi1000;
4526 }
4527 if (ecn > (ee - sn))
4528 {
4529 if ((ee - sn) < rnt)
4530 ecn = ee - sn;
4531 else
4532 goto dir1234;
4533 }
4534 if (ecn <= 0.0)
4535 goto dir1234;
4536 }
4537 else
4538 {
4539 ecn = 2.0 * nt;
4540 }
4541 }
4542 }
4543 else
4544 {
4545 densn = 0.0;
4546 ecn = 0.0;
4547 nt = 0.0;
4548 }
4549 exi1000:
4550
4551 // LEVEL DENSITY AND TEMPERATURE IN THE PROTON DAUGHTER
4552 //
4553 // Reduction of angular momentum due to orbital angular momentum of emitted
4554 // fragment
4555 if (iz >= 2)
4556 {
4557 ind = idnint(a) - idnint(zprf);
4558 izd = idnint(zprf) - 1;
4559 if (jprf > 0.10)
4560 {
4561 lorb(a, a - 1., jprf, ee - sbp, &dlout, &sdlout);
4562 djprf = gausshaz(1, dlout, sdlout);
4563 if (IDjprf == 1)
4564 djprf = 0.0;
4565 jprfp = jprf + djprf;
4566 jprfp = dint(std::abs(jprfp)); // The nucleus just turns the other way around
4567 }
4568 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
4569 defbet = ecld->beta2[ind][izd];
4570
4571 iinert =
4572 0.4 * 931.49 * 1.16 * 1.16 * std::pow(a - 1., 5.0 / 3.0) * (1.0 + 0.5 * std::sqrt(5. / (4. * pi)) * defbet);
4573 erotp = jprfp * jprfp * 197.328 * 197.328 / (2. * iinert);
4574
4575 bsbkbc(a - 1., zprf - 1., &bs, &bk, &bc);
4576
4577 // level density and temperature in the proton daughter
4578 densniv(a - 1.0,
4579 zprf - 1.0,
4580 ee,
4581 sbp,
4582 &densp,
4583 bshell,
4584 bs,
4585 bk,
4586 &temp,
4587 fiss->optshp,
4588 fiss->optcol,
4589 defbet,
4590 &ecor,
4591 jprfp,
4592 0,
4593 &qr);
4594 pt = temp;
4595 ecp = 0.;
4596 if (densp > 0.)
4597 {
4598 G4int IS = 0;
4599 if (imaxwell == 1)
4600 {
4601 rpt = pt;
4602 dir1235:
4603 ecp = fvmaxhaz(rpt);
4604 IS++;
4605 if (IS > 100)
4606 {
4607 std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
4608 goto exi1001;
4609 }
4610 if (ecp > (ee - sbp))
4611 {
4612 if ((ee - sbp) < rpt)
4613 ecp = ee - sbp;
4614 else
4615 goto dir1235;
4616 }
4617 if (ecp <= 0.0)
4618 goto dir1235;
4619 ecp = ecp + bp;
4620 }
4621 else
4622 {
4623 ecp = 2.0 * pt + bp;
4624 }
4625 }
4626 }
4627 else
4628 {
4629 densp = 0.0;
4630 ecp = 0.0;
4631 pt = 0.0;
4632 }
4633 exi1001:
4634
4635 // FINAL LEVEL DENSITY AND TEMPERATURE AFTER DEUTERON EMISSION
4636 //
4637 // Reduction of angular momentum due to orbital angular momentum of emitted
4638 // fragment
4639 if ((in >= 2) && (iz >= 2))
4640 {
4641 ind = idnint(a) - idnint(zprf) - 1;
4642 izd = idnint(zprf) - 1;
4643 if (jprf > 0.10)
4644 {
4645 lorb(a, a - 2., jprf, ee - sbd, &dlout, &sdlout);
4646 djprf = gausshaz(1, dlout, sdlout);
4647 if (IDjprf == 1)
4648 djprf = 0.0;
4649 jprfd = jprf + djprf;
4650 jprfd = dint(std::abs(jprfd)); // The nucleus just turns the other way around
4651 }
4652 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
4653 defbet = ecld->beta2[ind][izd];
4654
4655 iinert =
4656 0.4 * 931.49 * 1.16 * 1.16 * std::pow(a - 2., 5.0 / 3.0) * (1.0 + 0.5 * std::sqrt(5. / (4. * pi)) * defbet);
4657 erotd = jprfd * jprfd * 197.328 * 197.328 / (2. * iinert);
4658
4659 bsbkbc(a - 2., zprf - 1., &bs, &bk, &bc);
4660
4661 // level density and temperature in the deuteron daughter
4662 densniv(a - 2.0,
4663 zprf - 1.0e0,
4664 ee,
4665 sbd,
4666 &densd,
4667 bshell,
4668 bs,
4669 bk,
4670 &temp,
4671 fiss->optshp,
4672 fiss->optcol,
4673 defbet,
4674 &ecor,
4675 jprfd,
4676 0,
4677 &qr);
4678
4679 dt = temp;
4680 ecd = 0.0;
4681 if (densd > 0.)
4682 {
4683 G4int IS = 0;
4684 if (imaxwell == 1)
4685 {
4686 rdt = dt;
4687 dir1236:
4688 ecd = fvmaxhaz(rdt);
4689 IS++;
4690 if (IS > 100)
4691 {
4692 std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
4693 goto exi1002;
4694 }
4695 if (ecd > (ee - sbd))
4696 {
4697 if ((ee - sbd) < rdt)
4698 ecd = ee - sbd;
4699 else
4700 goto dir1236;
4701 }
4702 if (ecd <= 0.0)
4703 goto dir1236;
4704 ecd = ecd + bd;
4705 }
4706 else
4707 {
4708 ecd = 2.0 * dt + bd;
4709 }
4710 }
4711 }
4712 else
4713 {
4714 densd = 0.0;
4715 ecd = 0.0;
4716 dt = 0.0;
4717 }
4718 exi1002:
4719
4720 // FINAL LEVEL DENSITY AND TEMPERATURE AFTER TRITON EMISSION
4721 //
4722 // Reduction of angular momentum due to orbital angular momentum of emitted
4723 // fragment
4724 if ((in >= 3) && (iz >= 2))
4725 {
4726 ind = idnint(a) - idnint(zprf) - 2;
4727 izd = idnint(zprf) - 1;
4728 if (jprf > 0.10)
4729 {
4730 lorb(a, a - 3., jprf, ee - sbt, &dlout, &sdlout);
4731 djprf = gausshaz(1, dlout, sdlout);
4732 if (IDjprf == 1)
4733 djprf = 0.0;
4734 jprft = jprf + djprf;
4735 jprft = dint(std::abs(jprft)); // The nucleus just turns the other way around
4736 }
4737 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
4738 defbet = ecld->beta2[ind][izd];
4739
4740 iinert =
4741 0.4 * 931.49 * 1.16 * 1.16 * std::pow(a - 3., 5.0 / 3.0) * (1.0 + 0.5 * std::sqrt(5. / (4. * pi)) * defbet);
4742 erott = jprft * jprft * 197.328 * 197.328 / (2. * iinert);
4743
4744 bsbkbc(a - 3., zprf - 1., &bs, &bk, &bc);
4745
4746 // level density and temperature in the triton daughter
4747 densniv(a - 3.0,
4748 zprf - 1.0,
4749 ee,
4750 sbt,
4751 &denst,
4752 bshell,
4753 bs,
4754 bk,
4755 &temp,
4756 fiss->optshp,
4757 fiss->optcol,
4758 defbet,
4759 &ecor,
4760 jprft,
4761 0,
4762 &qr);
4763
4764 tt = temp;
4765 ect = 0.;
4766 if (denst > 0.)
4767 {
4768 G4int IS = 0;
4769 if (imaxwell == 1)
4770 {
4771 rtt = tt;
4772 dir1237:
4773 ect = fvmaxhaz(rtt);
4774 IS++;
4775 if (IS > 100)
4776 {
4777 std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
4778 goto exi1003;
4779 }
4780 if (ect > (ee - sbt))
4781 {
4782 if ((ee - sbt) < rtt)
4783 ect = ee - sbt;
4784 else
4785 goto dir1237;
4786 }
4787 if (ect <= 0.0)
4788 goto dir1237;
4789 ect = ect + bt;
4790 }
4791 else
4792 {
4793 ect = 2.0 * tt + bt;
4794 }
4795 }
4796 }
4797 else
4798 {
4799 denst = 0.0;
4800 ect = 0.0;
4801 tt = 0.0;
4802 }
4803 exi1003:
4804
4805 // LEVEL DENSITY AND TEMPERATURE IN THE ALPHA DAUGHTER
4806 //
4807 // Reduction of angular momentum due to orbital angular momentum of emitted
4808 // fragment
4809 if ((in >= 3) && (iz >= 3))
4810 {
4811 ind = idnint(a) - idnint(zprf) - 2;
4812 izd = idnint(zprf) - 2;
4813 if (jprf > 0.10)
4814 {
4815 lorb(a, a - 4., jprf, ee - sba, &dlout, &sdlout);
4816 djprf = gausshaz(1, dlout, sdlout);
4817 if (IDjprf == 1)
4818 djprf = 0.0;
4819 jprfa = jprf + djprf;
4820 jprfa = dint(std::abs(jprfa)); // The nucleus just turns the other way around
4821 }
4822 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
4823 defbet = ecld->beta2[ind][izd];
4824
4825 iinert =
4826 0.4 * 931.49 * 1.16 * 1.16 * std::pow(a - 4., 5.0 / 3.0) * (1.0 + 0.5 * std::sqrt(5. / (4. * pi)) * defbet);
4827 erota = jprfa * jprfa * 197.328 * 197.328 / (2. * iinert);
4828
4829 bsbkbc(a - 4., zprf - 2., &bs, &bk, &bc);
4830
4831 // level density and temperature in the alpha daughter
4832 densniv(a - 4.0,
4833 zprf - 2.0,
4834 ee,
4835 sba,
4836 &densa,
4837 bshell,
4838 bs,
4839 bk,
4840 &temp,
4841 fiss->optshp,
4842 fiss->optcol,
4843 defbet,
4844 &ecor,
4845 jprfa,
4846 0,
4847 &qr);
4848
4849 at = temp;
4850 eca = 0.0;
4851 if (densa > 0.)
4852 {
4853 G4int IS = 0;
4854 if (imaxwell == 1)
4855 {
4856 rat = at;
4857 dir1238:
4858 eca = fvmaxhaz(rat);
4859 IS++;
4860 if (IS > 100)
4861 {
4862 std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
4863 goto exi1004;
4864 }
4865 if (eca > (ee - sba))
4866 {
4867 if ((ee - sba) < rat)
4868 eca = ee - sba;
4869 else
4870 goto dir1238;
4871 }
4872 if (eca <= 0.0)
4873 goto dir1238;
4874 eca = eca + ba;
4875 }
4876 else
4877 {
4878 eca = 2.0 * at + ba;
4879 }
4880 }
4881 }
4882 else
4883 {
4884 densa = 0.0;
4885 eca = 0.0;
4886 at = 0.0;
4887 }
4888 exi1004:
4889
4890 // FINAL LEVEL DENSITY AND TEMPERATURE AFTER 3HE EMISSION
4891 //
4892 // Reduction of angular momentum due to orbital angular momentum of emitted
4893 // fragment
4894 if ((in >= 2) && (iz >= 3))
4895 {
4896 ind = idnint(a) - idnint(zprf) - 1;
4897 izd = idnint(zprf) - 2;
4898 if (jprf > 0.10)
4899 {
4900 lorb(a, a - 3., jprf, ee - sbhe, &dlout, &sdlout);
4901 djprf = gausshaz(1, dlout, sdlout);
4902 if (IDjprf == 1)
4903 djprf = 0.0;
4904 jprfhe = jprf + djprf;
4905 jprfhe = dint(std::abs(jprfhe)); // The nucleus just turns the other way around
4906 }
4907 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
4908 defbet = ecld->beta2[ind][izd];
4909
4910 iinert =
4911 0.4 * 931.49 * 1.16 * 1.16 * std::pow(a - 3., 5.0 / 3.0) * (1.0 + 0.5 * std::sqrt(5. / (4. * pi)) * defbet);
4912 erothe = jprfhe * jprfhe * 197.328 * 197.328 / (2. * iinert);
4913
4914 bsbkbc(a - 3., zprf - 2., &bs, &bk, &bc);
4915
4916 // level density and temperature in the he3 daughter
4917 densniv(a - 3.0,
4918 zprf - 2.0,
4919 ee,
4920 sbhe,
4921 &denshe,
4922 bshell,
4923 bs,
4924 bk,
4925 &temp,
4926 fiss->optshp,
4927 fiss->optcol,
4928 defbet,
4929 &ecor,
4930 jprfhe,
4931 0,
4932 &qr);
4933
4934 het = temp;
4935 eche = 0.0;
4936 if (denshe > 0.)
4937 {
4938 G4int IS = 0;
4939 if (imaxwell == 1)
4940 {
4941 rhet = het;
4942 dir1239:
4943 eche = fvmaxhaz(rhet);
4944 IS++;
4945 if (IS > 100)
4946 {
4947 std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
4948 goto exi1005;
4949 }
4950 if (eche > (ee - sbhe))
4951 {
4952 if ((ee - sbhe) < rhet)
4953 eche = ee - sbhe;
4954 else
4955 goto dir1239;
4956 }
4957 if (eche <= 0.0)
4958 goto dir1239;
4959 eche = eche + bhe;
4960 }
4961 else
4962 {
4963 eche = 2.0 * het + bhe;
4964 }
4965 }
4966 }
4967 else
4968 {
4969 denshe = 0.0;
4970 eche = 0.0;
4971 het = 0.0;
4972 }
4973 exi1005:
4974
4975 // LEVEL DENSITY AND TEMPERATURE IN THE LAMBDA0 DAUGHTER
4976 //
4977 // - Reduction of angular momentum due to orbital angular momentum of emitted
4978 // fragment JLRS Jun-2017 - Added these caculations in abla++
4979
4980 if (in >= 2 && NbLam0 > 0)
4981 {
4982 ind = idnint(a) - idnint(zprf) - 1;
4983 izd = idnint(zprf);
4984 if (jprf > 0.10)
4985 {
4986 lorb(a, a - 1., jprf, ee - slamb0, &dlout, &sdlout);
4987 djprf = gausshaz(1, dlout, sdlout);
4988 if (IDjprf == 1)
4989 djprf = 0.0;
4990 jprflamb0 = jprf + djprf;
4991 jprflamb0 = dint(std::abs(jprflamb0)); // The nucleus just turns the other way around
4992 }
4993 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
4994 defbet = ecld->beta2[ind][izd];
4995
4996 iinert =
4997 0.4 * 931.49 * 1.16 * 1.16 * std::pow(a - 1., 5.0 / 3.0) * (1.0 + 0.5 * std::sqrt(5. / (4. * pi)) * defbet);
4998 erotlamb0 = jprflamb0 * jprflamb0 * 197.328 * 197.328 / (2. * iinert);
4999 bsbkbc(a - 1., zprf, &bs, &bk, &bc);
5000
5001 // level density and temperature in the neutron daughter
5002 densniv(a - 1.0,
5003 zprf,
5004 ee,
5005 slamb0,
5006 &denslamb0,
5007 bshell,
5008 bs,
5009 bk,
5010 &temp,
5011 fiss->optshp,
5012 fiss->optcol,
5013 defbet,
5014 &ecor,
5015 jprflamb0,
5016 0,
5017 &qr);
5018 lamb0t = temp;
5019 eclamb0 = 0.0;
5020 if (denslamb0 > 0.)
5021 {
5022 G4int IS = 0;
5023 if (imaxwell == 1)
5024 {
5025 rlamb0t = lamb0t;
5026 dir1240:
5027 eclamb0 = fvmaxhaz_neut(rlamb0t);
5028 IS++;
5029 if (IS > 100)
5030 {
5031 std::cout << "WARNING: FVMAXHAZ_NEUT CALLED MORE THAN 100 TIMES" << std::endl;
5032 goto exi1006;
5033 }
5034 if (eclamb0 > (ee - slamb0))
5035 {
5036 if ((ee - slamb0) < rlamb0t)
5037 eclamb0 = ee - slamb0;
5038 else
5039 goto dir1240;
5040 }
5041 if (eclamb0 <= 0.0)
5042 goto dir1240;
5043 }
5044 else
5045 {
5046 eclamb0 = 2.0 * lamb0t;
5047 }
5048 }
5049 }
5050 else
5051 {
5052 denslamb0 = 0.0;
5053 eclamb0 = 0.0;
5054 lamb0t = 0.0;
5055 }
5056 exi1006:
5057
5058 // Decay widths for particles
5059 if (densg > 0.)
5060 {
5061 //
5062 // CALCULATION OF THE PARTIAL DECAY WIDTH
5063 // USED FOR BOTH THE TIME SCALE AND THE EVAPORATION DECAY WIDTH
5064 //
5065 // AKAP = HBAR**2/(2* MN * R_0**2) = 10 MEV *** input param ***
5066 //
5067 // AK, KHS 2005 - Energy-dependen inverse cross sections included, influence
5068 // of
5069 // Coulomb barrier for LCP, tunnelling for LCP
5070 // JLRS 2017 - Implementation in abla++
5071
5072 if (densn <= 0.0)
5073 {
5074 gn = 0.0;
5075 }
5076 else
5077 {
5078 gn = width(a, zprf, 1.0, 0.0, nt, 0.0, sn, ee - erotn) * densn / densg;
5079 }
5080 if (densp <= 0.0)
5081 {
5082 gp = 0.0;
5083 }
5084 else
5085 {
5086 gp = width(a, zprf, 1.0, 1.0, pt, bp, sbp, ee - erotp) * densp / densg * pen(a, 1.0, omegap, pt);
5087 }
5088 if (densd <= 0.0)
5089 {
5090 gd = 0.0;
5091 }
5092 else
5093 {
5094 gd = width(a, zprf, 2.0, 1.0, dt, bd, sbd, ee - erotd) * densd / densg * pen(a, 2.0, omegad, dt);
5095 }
5096 if (denst <= 0.0)
5097 {
5098 gt = 0.0;
5099 }
5100 else
5101 {
5102 gt = width(a, zprf, 3.0, 1.0, tt, bt, sbt, ee - erott) * denst / densg * pen(a, 3.0, omegat, tt);
5103 }
5104 if (denshe <= 0.0)
5105 {
5106 ghe = 0.0;
5107 }
5108 else
5109 {
5110 ghe = width(a, zprf, 3.0, 2.0, het, bhe, sbhe, ee - erothe) * denshe / densg * pen(a, 3.0, omegahe, het);
5111 }
5112 if (densa <= 0.0)
5113 {
5114 ga = 0.0;
5115 }
5116 else
5117 {
5118 ga = width(a, zprf, 4.0, 2.0, at, ba, sba, ee - erota) * densa / densg * pen(a, 4.0, omegaa, at);
5119 }
5120 if (denslamb0 <= 0.0)
5121 {
5122 glamb0 = 0.0;
5123 }
5124 else
5125 {
5126 glamb0 = width(a, zprf, 1.0, -2.0, lamb0t, 0.0, slamb0, ee - erotlamb0) * denslamb0 / densg;
5127 }
5128
5129 // **************************
5130 // * Treatment of IMFs *
5131 // * KHS, AK, MVR 2005-2006 *
5132 // **************************
5133
5134 G4int izcn = 0, incn = 0, inmin = 0, inmax = 0, inmi = 0, inma = 0;
5135 G4double aimf, mares, maimf;
5136
5137 if (fimf_allowed == 0 || zprf <= 5.0 || a <= 7.0)
5138 {
5139 gimf = 0.0;
5140 }
5141 else
5142 {
5143 // Estimate the total decay width for IMFs (Z >= 3)
5144 // By using the logarithmic slope between GIMF3 and GIMF5
5145
5146 mglms(a, zprf, opt->optshpimf, &mazz);
5147
5148 gimf3 = 0.0;
5149 zimf = 3.0;
5150 izimf = 3;
5151 // *** Find the limits that both IMF and partner are bound :
5152 izcn = idnint(zprf); // Z of CN
5153 incn = idnint(a) - izcn; // N of CN
5154
5155 isostab_lim(izimf, &inmin,
5156 &inmax); // Bound isotopes for IZIMF from INMIN to INIMFMA
5157 isostab_lim(izcn - izimf,
5158 &inmi,
5159 &inma); // Daughter nucleus after IMF emission,
5160 // limits of bound isotopes
5161 inmin = max(inmin, incn - inma); // Both IMF and daughter must be bound
5162 inmax = min(inmax, incn - inmi); // "
5163
5164 inmax = max(inmax, inmin); // In order to keep the variables below
5165
5166 for (G4int iaimf = izimf + inmin; iaimf <= izimf + inmax; iaimf++)
5167 {
5168 aimf = G4double(iaimf);
5169 if (aimf >= a || zimf >= zprf)
5170 {
5171 width_imf = 0.0;
5172 }
5173 else
5174 {
5175 // Q-values
5176 mglms(a - aimf, zprf - zimf, opt->optshpimf, &mares);
5177 mglms(aimf, zimf, opt->optshpimf, &maimf);
5178 // Bass barrier
5179 barrs(idnint(zprf - zimf), idnint(a - aimf), izimf, idnint(aimf), &bimf, &omegaimf);
5180 sbimf = maimf + mares - mazz + bimf + getdeltabinding(a, NbLam0);
5181 // Rotation energy
5182 defbetimf = ecld->beta2[idnint(aimf - zimf)][idnint(zimf)] +
5183 ecld->beta2[idnint(a - aimf - zprf + zimf)][idnint(zprf - zimf)];
5184
5185 iinert = 0.40 * 931.490 * 1.160 * 1.160 * std::pow(a, 5.0 / 3.0) *
5186 (std::pow(aimf, 5.0 / 3.0) + std::pow(a - aimf, 5.0 / 3.0)) +
5187 931.490 * 1.160 * 1.160 * aimf * (a - aimf) / a *
5188 (std::pow(aimf, 1.0 / 3.0) + std::pow(a - aimf, 1.0 / 3.0)) *
5189 (std::pow(aimf, 1.0 / 3.0) + std::pow(a - aimf, 1.0 / 3.0));
5190
5191 erot = jprf * jprf * 197.328 * 197.328 / (2.0 * iinert);
5192
5193 // Width
5194 if (densg == 0.0 || ee < (sbimf + erot))
5195 {
5196 width_imf = 0.0;
5197 }
5198 else
5199 {
5200 // To take into account that at the barrier the system is deformed:
5201 // BSIMF = ((A-AIMF)**(2.D0/3.D0) +
5202 // AIMF**(2.D0/3.D0))/A**(2.D0/3.D0)
5203 bsimf = bscn;
5204 densniv(
5205 a, zprf, ee, sbimf, &densimf, 0.0, bsimf, 1.0, &timf, 0, 0, defbetimf, &ecor, jprf, 2, &qr);
5206
5207 imfarg = (sbimf + erotcn - erot) / timf;
5208 if (imfarg > 200.0)
5209 imfarg = 200.0;
5210
5211 // For IMF - The available phase space is given by the level
5212 // densities in CN at the barrier; applaying MOrretto ->
5213 // G=WIDTH*ro_CN(E-SBIMF)/ro_CN(E). Constant temperature
5214 // approximation: ro(E+dE)/ro(E)=exp(dE/T) Ratio DENSIMF/DENSCN is
5215 // included to take into account that at the barrier system is
5216 // deformed. If (above) BSIMF = 1 no deformation is considered and
5217 // this ratio is equal to 1.
5218 width_imf = 0.0;
5219 //
5220 width_imf =
5221 width(a, zprf, aimf, zimf, timf, bimf, sbimf, ee - erot) * std::exp(-imfarg) * qr / qrcn;
5222 } // if densg
5223 } // if aimf
5224 gimf3 = gimf3 + width_imf;
5225 } // for IAIMF
5226
5227 // zimf = 5
5228 gimf5 = 0.0;
5229 zimf = 5.0;
5230 izimf = 5;
5231 // *** Find the limits that both IMF and partner are bound :
5232 izcn = idnint(zprf); // Z of CN
5233 incn = idnint(a) - izcn; // N of CN
5234
5235 isostab_lim(izimf, &inmin,
5236 &inmax); // Bound isotopes for IZIMF from INMIN to INIMFMA
5237 isostab_lim(izcn - izimf,
5238 &inmi,
5239 &inma); // Daughter nucleus after IMF emission,
5240 // limits of bound isotopes
5241 inmin = max(inmin, incn - inma); // Both IMF and daughter must be bound
5242 inmax = min(inmax, incn - inmi); // "
5243
5244 inmax = max(inmax, inmin); // In order to keep the variables below
5245
5246 for (G4int iaimf = izimf + inmin; iaimf <= izimf + inmax; iaimf++)
5247 {
5248 aimf = G4double(iaimf);
5249 if (aimf >= a || zimf >= zprf)
5250 {
5251 width_imf = 0.0;
5252 }
5253 else
5254 {
5255 // Q-values
5256 mglms(a - aimf, zprf - zimf, opt->optshpimf, &mares);
5257 mglms(aimf, zimf, opt->optshpimf, &maimf);
5258 // Bass barrier
5259 barrs(idnint(zprf - zimf), idnint(a - aimf), izimf, idnint(aimf), &bimf, &omegaimf);
5260 sbimf = maimf + mares - mazz + bimf + getdeltabinding(a, NbLam0);
5261 // Rotation energy
5262 defbetimf = ecld->beta2[idnint(aimf - zimf)][idnint(zimf)] +
5263 ecld->beta2[idnint(a - aimf - zprf + zimf)][idnint(zprf - zimf)];
5264
5265 iinert = 0.40 * 931.490 * 1.160 * 1.160 * std::pow(a, 5.0 / 3.0) *
5266 (std::pow(aimf, 5.0 / 3.0) + std::pow(a - aimf, 5.0 / 3.0)) +
5267 931.490 * 1.160 * 1.160 * aimf * (a - aimf) / a *
5268 (std::pow(aimf, 1.0 / 3.0) + std::pow(a - aimf, 1.0 / 3.0)) *
5269 (std::pow(aimf, 1.0 / 3.0) + std::pow(a - aimf, 1.0 / 3.0));
5270
5271 erot = jprf * jprf * 197.328 * 197.328 / (2.0 * iinert);
5272 //
5273 // Width
5274 if (densg == 0.0 || ee < (sbimf + erot))
5275 {
5276 width_imf = 0.0;
5277 }
5278 else
5279 {
5280 // To take into account that at the barrier the system is deformed:
5281 // BSIMF = ((A-AIMF)**(2.D0/3.D0) +
5282 // AIMF**(2.D0/3.D0))/A**(2.D0/3.D0)
5283 bsimf = bscn;
5284 densniv(
5285 a, zprf, ee, sbimf, &densimf, 0.0, bsimf, 1.0, &timf, 0, 0, defbetimf, &ecor, jprf, 2, &qr);
5286 //
5287 imfarg = (sbimf + erotcn - erot) / timf;
5288 if (imfarg > 200.0)
5289 imfarg = 200.0;
5290 //
5291 // For IMF - The available phase space is given by the level
5292 // densities in CN at the barrier; applaying MOrretto ->
5293 // G=WIDTH*ro_CN(E-SBIMF)/ro_CN(E). Constant temperature
5294 // approximation: ro(E+dE)/ro(E)=exp(dE/T) Ratio DENSIMF/DENSCN is
5295 // included to take into account that at the barrier system is
5296 // deformed. If (above) BSIMF = 1 no deformation is considered and
5297 // this ratio is equal to 1.
5298 width_imf = 0.0;
5299 width_imf = width(a, zprf, aimf, zimf, timf, bimf, sbimf, ee - erot) * std::exp(-imfarg) * qr /
5300 qrcn; //*densimf/densg;
5301 } // if densg
5302 } // if aimf
5303 gimf5 = gimf5 + width_imf;
5304 } // for IAIMF
5305 // It is assumed that GIMFi = A_IMF*ZIMF**B_IMF; to get the total GIMF one
5306 // integrates Int(A_IMF*ZIMF**B_IMF)(3->ZPRF)
5307
5308 if (gimf3 <= 0.0 || gimf5 <= 0.0)
5309 {
5310 gimf = 0.0;
5311 b_imf = -100.0;
5312 a_imf = 0.0;
5313 }
5314 else
5315 {
5316 //
5317 b_imf = (std::log10(gimf3) - std::log10(gimf5)) / (std::log10(3.0) - std::log10(5.0));
5318 //
5319 if (b_imf >= -1.01)
5320 b_imf = -1.01;
5321 if (b_imf <= -100.0)
5322 {
5323 b_imf = -100.0;
5324 a_imf = 0.0;
5325 gimf = 0.0;
5326 goto direct2007;
5327 }
5328 //
5329 a_imf = gimf3 / std::pow(3.0, b_imf);
5330 gimf = a_imf * (std::pow(zprf, b_imf + 1.0) - std::pow(3.0, b_imf + 1.0)) / (b_imf + 1.0);
5331 }
5332
5333 direct2007:
5334 if (gimf < 1.e-10)
5335 gimf = 0.0;
5336 } // if fimf_allowed
5337 //
5338 // c JLRS 2016 - Added this calculation
5339 // C AK 2004 - Gamma width
5340 // C According to A. Ignatyuk, GG :
5341 // C Here BS=BK=1, as this was assumed in the parameterization
5342 pa = (ald->av) * a + (ald->as) * std::pow(a, 2. / 3.) + (ald->ak) * std::pow(a, 1. / 3.);
5343 gamma = 2.5 * pa * std::pow(a, -4. / 3.);
5344 gfactor = 1. + gamma * ecld->ecgnz[in][iz];
5345 if (gfactor <= 0.)
5346 {
5347 gfactor = 0.0;
5348 }
5349 //
5350 gtemp = 17.60 / (std::pow(a, 0.699) * std::sqrt(gfactor));
5351 //
5352 // C If one switches gammas off, one should also switch off tunneling
5353 // through the fission barrier.
5354 gg = 0.624e-9 * std::pow(a, 1.6) * std::pow(gtemp, 5.);
5355 // gammaemission==1
5356 // C For fission fragments, GG is ~ 2 times larger than for
5357 // c "oridnary" nuclei (A. Ignatyuk, private communication).
5358 if (gammaemission == 1)
5359 {
5360 gg = 2.0 * gg;
5361 }
5362 ecg = 4.0 * gtemp;
5363 //
5364 //
5365 gsum = ga + ghe + gd + gt + gp + gn + gimf + gg + glamb0;
5366
5367 // std::cout << gn << " " << gd << " " << gp << std::endl;
5368
5369 if (gsum > 0.0)
5370 {
5371 ts1 = hbar / gsum;
5372 }
5373 else
5374 {
5375 ts1 = 1.0e99;
5376 goto direct69;
5377 }
5378 //
5379 // Case of nuclei below Businaro-Gallone mass asymmetry point
5380 if (fiss->ifis == 0 || (zprf * zprf / a <= 22.74 && zprf < 60.))
5381 {
5382 goto direct69;
5383 }
5384 //
5385 // Calculation of the fission decay width
5386 // Deformation is calculated using the fissility
5387 //
5388 defbet = y;
5389 fission_width(zprf, a, ee, bssp, bksp, ef, y, &gf, &temp, jprf, 0, 1, fiss->optcol, fiss->optshp, densg);
5390 ft = temp;
5391 //
5392 // Case of very heavy nuclei that have no fission barrier
5393 // For them fission is the only decay channel available
5394 if (ef <= 0.0)
5395 {
5396 probf = 1.0;
5397 probp = 0.0;
5398 probd = 0.0;
5399 probt = 0.0;
5400 probn = 0.0;
5401 probhe = 0.0;
5402 proba = 0.0;
5403 probg = 0.0;
5404 probimf = 0.0;
5405 problamb0 = 0.0;
5406 goto direct70;
5407 }
5408
5409 if (fiss->bet <= 0.)
5410 {
5411 gtotal = ga + ghe + gp + gd + gt + gn + gg + gimf + gf + glamb0;
5412 if (gtotal <= 0.0)
5413 {
5414 probf = 0.0;
5415 probp = 0.0;
5416 probd = 0.0;
5417 probt = 0.0;
5418 probn = 0.0;
5419 probhe = 0.0;
5420 proba = 0.0;
5421 probg = 0.0;
5422 probimf = 0.0;
5423 problamb0 = 0.0;
5424 goto direct70;
5425 }
5426 else
5427 {
5428 probf = gf / gtotal;
5429 probn = gn / gtotal;
5430 probp = gp / gtotal;
5431 probd = gd / gtotal;
5432 probt = gt / gtotal;
5433 probhe = ghe / gtotal;
5434 proba = ga / gtotal;
5435 probg = gg / gtotal;
5436 probimf = gimf / gtotal;
5437 problamb0 = glamb0 / gtotal;
5438 goto direct70;
5439 }
5440 }
5441 }
5442 else
5443 {
5444 goto direct69;
5445 }
5446 //
5447 if (inum > ilast)
5448 { // new event means reset the time scale
5449 tsum = 0.;
5450 }
5451 //
5452 // kramers factor for the dynamical hindrances of fission
5453 fomega_sp(a, y, &mfcd, &omegasp, &homegasp);
5454 cf = cram((NbLam0 > 0 ? fiss->bethyp : fiss->bet), homegasp);
5455 //
5456 // We calculate the transient time
5457 fomega_gs(a, zprf, &k1, &omegags, &homegags);
5458 tauc = tau((NbLam0 > 0 ? fiss->bethyp : fiss->bet), homegags, ef, ft);
5459 gf = gf * cf;
5460 //
5461 /*
5462 c The subroutine part_fiss calculates the fission width GFF that corresponds
5463 to the time c dependence of the probability distribution obtained by solving
5464 the FOKKER-PLANCK eq c using a nucleus potential that is approximated by a
5465 parabola. It also gives the c decay time for this step T_LAPSE that includes
5466 all particle decay channels and the c fission channel. And it decides whether
5467 the nucleus decays by particle evaporation c CHOICE_FISSPART = 1 or fission
5468 CHOICE_FISSPART = 2
5469 */
5470 //
5471 part_fiss((NbLam0 > 0 ? fiss->bethyp : fiss->bet), gsum, gf, y, tauc, ts1, tsum, &choice_fisspart, zprf, a, ft, &t_lapse, &gff);
5472 gf = gff;
5473 //
5474 // We accumulate in TSUM the mean decay for this step including all particle
5475 // decay channels and fission
5476 tsum = tsum + t_lapse;
5477
5478 // If fission occurs
5479 if (choice_fisspart == 2)
5480 {
5481 probf = 1.0;
5482 probp = 0.0;
5483 probd = 0.0;
5484 probt = 0.0;
5485 probn = 0.0;
5486 probhe = 0.0;
5487 proba = 0.0;
5488 probg = 0.0;
5489 probimf = 0.0;
5490 problamb0 = 0.0;
5491 goto direct70;
5492 }
5493 else
5494 {
5495 // If particle evaporation occurs
5496 // The probabilities for the different decays are calculated taking into
5497 // account the fission width GFF that corresponds to this step
5498
5499 gtotal = ga + ghe + gp + gd + gt + gn + gimf + gg + glamb0;
5500 if (gtotal <= 0.0)
5501 {
5502 probf = 0.0;
5503 probp = 0.0;
5504 probd = 0.0;
5505 probt = 0.0;
5506 probn = 0.0;
5507 probhe = 0.0;
5508 proba = 0.0;
5509 probg = 0.0;
5510 probimf = 0.0;
5511 problamb0 = 0.0;
5512 goto direct70;
5513 }
5514 else
5515 {
5516 probf = 0.0;
5517 probn = gn / gtotal;
5518 probp = gp / gtotal;
5519 probd = gd / gtotal;
5520 probt = gt / gtotal;
5521 probhe = ghe / gtotal;
5522 proba = ga / gtotal;
5523 probg = gg / gtotal;
5524 probimf = gimf / gtotal;
5525 problamb0 = glamb0 / gtotal;
5526 goto direct70;
5527 }
5528 }
5529 //
5530 direct69:
5531 gtotal = ga + ghe + gp + gd + gt + gn + gg + gimf + glamb0;
5532 if (gtotal <= 0.0)
5533 {
5534 probf = 0.0;
5535 probp = 0.0;
5536 probd = 0.0;
5537 probt = 0.0;
5538 probn = 0.0;
5539 probhe = 0.0;
5540 proba = 0.0;
5541 probg = 0.0;
5542 probimf = 0.0;
5543 problamb0 = 0.0;
5544 }
5545 else
5546 {
5547 probf = 0.0;
5548 probn = gn / gtotal;
5549 probp = gp / gtotal;
5550 probd = gd / gtotal;
5551 probt = gt / gtotal;
5552 probhe = ghe / gtotal;
5553 proba = ga / gtotal;
5554 probg = gg / gtotal;
5555 probimf = gimf / gtotal;
5556 problamb0 = glamb0 / gtotal;
5557 }
5558
5559 direct70:
5560 ptotl = probp + probd + probt + probn + probhe + proba + probg + probimf + probf + problamb0;
5561 //
5562 ee = eer;
5563 ilast = inum;
5564
5565 // Return values:
5566 (*probp_par) = probp;
5567 (*probd_par) = probd;
5568 (*probt_par) = probt;
5569 (*probn_par) = probn;
5570 (*probhe_par) = probhe;
5571 (*proba_par) = proba;
5572 (*probg_par) = probg;
5573 (*probimf_par) = probimf;
5574 (*problamb0_par) = problamb0;
5575 (*probf_par) = probf;
5576 (*ptotl_par) = ptotl;
5577 (*sn_par) = sn;
5578 (*sp_par) = sp;
5579 (*sd_par) = sd;
5580 (*st_par) = st;
5581 (*she_par) = she;
5582 (*sa_par) = sa;
5583 (*slamb0_par) = slamb0;
5584 (*sbp_par) = sbp;
5585 (*sbd_par) = sbd;
5586 (*sbt_par) = sbt;
5587 (*sbhe_par) = sbhe;
5588 (*sba_par) = sba;
5589 (*ecn_par) = ecn;
5590 (*ecp_par) = ecp;
5591 (*ecd_par) = ecd;
5592 (*ect_par) = ect;
5593 (*eche_par) = eche;
5594 (*eca_par) = eca;
5595 (*ecg_par) = ecg;
5596 (*eclamb0_par) = eclamb0;
5597 (*bp_par) = bp;
5598 (*bd_par) = bd;
5599 (*bt_par) = bt;
5600 (*bhe_par) = bhe;
5601 (*ba_par) = ba;
5602 (*tcn) = ftcn;
5603 (*ts1_par) = ts1;
5604 (*jprfn_par) = jprfn;
5605 (*jprfp_par) = jprfp;
5606 (*jprfd_par) = jprfd;
5607 (*jprft_par) = jprft;
5608 (*jprfhe_par) = jprfhe;
5609 (*jprfa_par) = jprfa;
5610 (*jprflamb0_par) = jprflamb0;
5611 (*tsum_par) = tsum;
5612 return;
5613 }
5614
5615 void G4Abla::densniv(G4double a,
5616 G4double z,
5617 G4double ee,
5618 G4double esous,
5619 G4double* dens,
5620 G4double bshell,
5621 G4double bsin,
5622 G4double bkin,
5623 G4double* temp,
5624 G4int optshp,
5625 G4int optcol,
5626 G4double defbet,
5627 G4double* ecor,
5628 G4double jprf,
5629 G4int ifis,
5630 G4double* qr)
5631 {
5632 // 1498 C
5633 // 1499 C INPUT:
5634 // 1500 C A,EE,ESOUS,OPTSHP,BS,BK,BSHELL,DEFBET
5635 // 1501 C
5636 // 1502 C LEVEL DENSITY PARAMETERS
5637 // 1503 C COMMON /ALD/ AV,AS,AK,OPTAFAN
5638 // 1504 C AV,AS,AK - VOLUME,SURFACE,CURVATURE DEPENDENCE OF THE
5639 // 1505 C LEVEL DENSITY PARAMETER
5640 // 1506 C OPTAFAN - 0/1 AF/AN >=1 OR AF/AN ==1
5641 // 1507 C RECOMMENDED IS OPTAFAN = 0
5642 // 1508
5643 // C---------------------------------------------------------------------
5644 // 1509 C OUTPUT: DENS,TEMP
5645 // 1510 C
5646 // 1511 C
5647 // ____________________________________________________________________ 1512
5648 // C / 1513 C / PROCEDURE FOR CALCULATING THE STATE DENSITY OF A
5649 // COMPOUND NUCLEUS 1514 C
5650 // /____________________________________________________________________
5651 // 1515 C
5652 // 1516 INTEGER AFP,IZ,OPTSHP,OPTCOL,J,OPTAFAN
5653 // 1517 REAL*8
5654 // A,EE,ESOUS,DENS,E,Y0,Y1,Y2,Y01,Y11,Y21,PA,BS,BK,TEMP 1518
5655 // C=====INSERTED BY KUDYAEV===============================================
5656 // 1519 COMMON /ALD/ AV,AS,AK,OPTAFAN
5657 // 1520 REAL*8
5658 // ECR,ER,DELTAU,Z,DELTPP,PARA,PARZ,FE,HE,ECOR,ECOR1,Pi6
5659 // 1521 REAL*8
5660 // BSHELL,DELTA0,AV,AK,AS,PONNIV,PONFE,DEFBET,QR,SIG,FP 1522
5661 // C=======================================================================
5662 // 1523 C
5663 // 1524 C
5664 // 1525
5665 // C-----------------------------------------------------------------------
5666 // 1526 C A MASS NUMBER OF THE DAUGHTER NUCLEUS
5667 // 1527 C EE EXCITATION ENERGY OF THE MOTHER NUCLEUS
5668 // 1528 C ESOUS SEPARATION ENERGY PLUS EFFECTIVE COULOMB
5669 // BARRIER
5670 // 1529 C DENS STATE DENSITY OF DAUGHTER NUCLEUS AT
5671 // EE-ESOUS-EC 1530 C BSHELL SHELL CORRECTION 1531 C TEMP
5672 // NUCLEAR TEMPERATURE 1532 C E LOCAL EXCITATION ENERGY OF THE
5673 // DAUGHTER NUCLEUS 1533 C E1 LOCAL HELP VARIABLE
5674 // 1534 C Y0,Y1,Y2,Y01,Y11,Y21
5675 // 1535 C LOCAL HELP VARIABLES
5676 // 1536 C PA LOCAL STATE-DENSITY PARAMETER
5677 // 1537 C EC KINETIC ENERGY OF EMITTED PARTICLE
5678 // WITHOUT 1538 C COULOMB REPULSION 1539 C IDEN
5679 // FAKTOR FOR SUBSTRACTING KINETIC ENERGY IDEN*TEMP 1540 C DELTA0
5680 // PAIRING GAP 12 FOR GROUND STATE 1541 C 14 FOR
5681 // SADDLE POINT 1542 C EITERA HELP VARIABLE FOR
5682 // TEMPERATURE ITERATION 1543
5683 // C-----------------------------------------------------------------------
5684 // 1544 C
5685 // 1545 C
5686 G4double delta0 = 0.0;
5687 G4double deltau = 0.0;
5688 G4double deltpp = 0.0;
5689 G4double e = 0.0;
5690 G4double e0 = 0.0;
5691 G4double ecor1 = 0.0;
5692 G4double ecr = 10.0;
5693 G4double fe = 0.0;
5694 G4double he = 0.0;
5695 G4double pa = 0.0;
5696 G4double para = 0.0;
5697 G4double parz = 0.0;
5698 G4double ponfe = 0.0;
5699 G4double ponniv = 0.0;
5700 G4double fqr = 1.0;
5701 G4double y01 = 0.0;
5702 G4double y11 = 0.0;
5703 G4double y2 = 0.0;
5704 G4double y21 = 0.0;
5705 G4double y1 = 0.0;
5706 G4double y0 = 0.0;
5707 G4double fnorm = 0.0;
5708 G4double fp_per = 0.;
5709 G4double fp_par = 0.;
5710 G4double sig_per = 0.;
5711 G4double sig_par = 0.;
5712 G4double sigma2;
5713 G4double jfact = 1.;
5714 G4double erot = 0.;
5715 G4double fdens = 0.;
5716 G4double fecor = 0.;
5717 G4double BSHELLCT = 0.;
5718 G4double gamma = 0.;
5719 G4double ftemp = 0.0;
5720 G4double tempct = 0.0;
5721 G4double densfm = 0.0;
5722 G4double densct = 0.0;
5723 G4double ein = 0.;
5724 G4double elim;
5725 G4double tfm;
5726 G4double bs = bsin;
5727 G4double bk = bkin;
5728 G4int IPARITE;
5729 G4int IOPTCT = fiss->optct;
5730 //
5731 G4double pi6 = std::pow(3.1415926535, 2) / 6.0;
5732 G4double pi = 3.1415926535;
5733 //
5734 G4int afp = idnint(a);
5735 G4int iz = idnint(z);
5736 G4int in = afp - iz;
5737 //
5738 if (ifis != 1)
5739 {
5740 BSHELLCT = ecld->ecgnz[in][iz];
5741 }
5742 else
5743 {
5744 BSHELLCT = 0.0;
5745 }
5746 if (afp <= 20)
5747 BSHELLCT = 0.0;
5748 //
5749 parite(a, ¶);
5750 if (para < 0.0)
5751 {
5752 // Odd A
5753 IPARITE = 1;
5754 }
5755 else
5756 {
5757 // Even A
5758 parite(z, &parz);
5759 if (parz > 0.0)
5760 {
5761 // Even Z, even N
5762 IPARITE = 2;
5763 }
5764 else
5765 {
5766 // Odd Z, odd N
5767 IPARITE = 0;
5768 }
5769 }
5770 //
5771 ein = ee - esous;
5772 //
5773 if (ein > 1.e30)
5774 {
5775 fdens = 0.0;
5776 ftemp = 0.5;
5777 goto densniv100;
5778 }
5779 //
5780 e = ee - esous;
5781 //
5782 if (e < 0.0 && ifis != 1)
5783 { // TUNNELING
5784 fdens = 0.0;
5785 densfm = 0.0;
5786 densct = 0.0;
5787 if (ald->optafan == 1)
5788 {
5789 pa = (ald->av) * a + (ald->as) * std::pow(a, (2.e0 / 3.e0)) + (ald->ak) * std::pow(a, (1.e0 / 3.e0));
5790 }
5791 else
5792 {
5793 pa = (ald->av) * a + (ald->as) * bsin * std::pow(a, (2.e0 / 3.e0)) +
5794 (ald->ak) * bkin * std::pow(a, (1.e0 / 3.e0));
5795 }
5796 gamma = 2.5 * pa * std::pow(a, -4.0 / 3.0);
5797 fecor = 0.0;
5798 goto densniv100;
5799 }
5800 //
5801 if (ifis == 0 && bs != 1.0)
5802 {
5803 // - With increasing excitation energy system in getting less and less
5804 // deformed:
5805 G4double ponq = (e - 100.0) / 5.0;
5806 if (ponq > 700.0)
5807 ponq = 700.0;
5808 bs = 1.0 / (1.0 + std::exp(-ponq)) + 1.0 / (1.0 + std::exp(ponq)) * bsin;
5809 bk = 1.0 / (1.0 + std::exp(-ponq)) + 1.0 / (1.0 + std::exp(ponq)) * bkin;
5810 }
5811 //
5812 // level density parameter
5813 if (ald->optafan == 1)
5814 {
5815 pa = (ald->av) * a + (ald->as) * std::pow(a, (2.e0 / 3.e0)) + (ald->ak) * std::pow(a, (1.e0 / 3.e0));
5816 }
5817 else
5818 {
5819 pa = (ald->av) * a + (ald->as) * bs * std::pow(a, (2.e0 / 3.e0)) + (ald->ak) * bk * std::pow(a, (1.e0 / 3.e0));
5820 }
5821 //
5822 gamma = 2.5 * pa * std::pow(a, -4.0 / 3.0);
5823 //
5824 // AK - 2009 - trial, in order to have transition to constant-temperature
5825 // approach Idea - at the phase transition superfluid-normal fluid, TCT =
5826 // TEMP, and this determines critical energy for pairing.
5827 if (a > 0.0)
5828 {
5829 ecr = pa * 17.60 / (std::pow(a, 0.699) * std::sqrt(1.0 + gamma * BSHELLCT)) * 17.60 /
5830 (std::pow(a, 0.699) * std::sqrt(1.0 + gamma * BSHELLCT));
5831 }
5832
5833 // pairing corrections
5834 if (ifis == 1)
5835 {
5836 delta0 = 14;
5837 }
5838 else
5839 {
5840 delta0 = 12;
5841 }
5842
5843 // shell corrections
5844 if (optshp > 0)
5845 {
5846 deltau = bshell;
5847 if (optshp == 2)
5848 {
5849 deltau = 0.0;
5850 }
5851 if (optshp >= 2)
5852 {
5853 // pairing energy shift with condensation energy a.r.j. 10.03.97
5854 // deltpp = -0.25e0* (delta0/pow(sqrt(a),2)) * pa /pi6
5855 // + 2.e0*delta0/sqrt(a);
5856 deltpp = -0.25e0 * std::pow((delta0 / std::sqrt(a)), 2) * pa / pi6 + 22.34e0 * std::pow(a, -0.464) - 0.235;
5857 // Odd A
5858 if (IPARITE == 1)
5859 {
5860 // e = e - delta0/sqrt(a);
5861 e = e - (0.285 + 11.17 * std::pow(a, -0.464) - 0.390 - 0.00058 * a); //-30./a;//FIXME
5862 }
5863 // Even Z, even N
5864 if (IPARITE == 2)
5865 {
5866 e = e - (22.34 * std::pow(a, -0.464) - 0.235); //-30./a;//FIXME
5867 }
5868 // Odd Z, odd N
5869 if (IPARITE == 0)
5870 {
5871 if (in == iz)
5872 {
5873 // e = e;
5874 }
5875 else
5876 {
5877 // e = e-30./a;
5878 }
5879 }
5880 }
5881 else
5882 {
5883 deltpp = 0.0;
5884 }
5885 }
5886 else
5887 {
5888 deltau = 0.0;
5889 deltpp = 0.0;
5890 }
5891
5892 if (e < 0.0)
5893 {
5894 e = 0.0;
5895 ftemp = 0.5;
5896 }
5897
5898 // washing out is made stronger
5899 ponfe = -2.5 * pa * e * std::pow(a, (-4.0 / 3.0));
5900
5901 if (ponfe < -700.0)
5902 {
5903 ponfe = -700.0;
5904 }
5905 fe = 1.0 - std::exp(ponfe);
5906 if (e < ecr)
5907 {
5908 // priv. comm. k.-h. schmidt
5909 he = 1.0 - std::pow((1.0 - e / ecr), 2);
5910 }
5911 else
5912 {
5913 he = 1.0;
5914 }
5915 // Excitation energy corrected for pairing and shell effects
5916 // washing out with excitation energy is included.
5917 fecor = e + deltau * fe + deltpp * he;
5918 if (fecor <= 0.1)
5919 {
5920 fecor = 0.1;
5921 }
5922 // iterative procedure according to grossjean and feldmeier
5923 // to avoid the singularity e = 0
5924 if (ee < 5.0)
5925 {
5926 y1 = std::sqrt(pa * fecor);
5927 for (G4int j = 0; j < 5; j++)
5928 {
5929 y2 = pa * fecor * (1.e0 - std::exp(-y1));
5930 y1 = std::sqrt(y2);
5931 }
5932 y0 = pa / y1;
5933 ftemp = 1.0 / y0;
5934 fdens = std::exp(y0 * fecor) /
5935 (std::pow((std::pow(fecor, 3) * y0), 0.5) * std::pow((1.0 - 0.5 * y0 * fecor * std::exp(-y1)), 0.5)) *
5936 std::exp(y1) * (1.0 - std::exp(-y1)) * 0.1477045;
5937 if (fecor < 1.0)
5938 {
5939 ecor1 = 1.0;
5940 y11 = std::sqrt(pa * ecor1);
5941 for (G4int j = 0; j < 7; j++)
5942 {
5943 y21 = pa * ecor1 * (1.0 - std::exp(-y11));
5944 y11 = std::sqrt(y21);
5945 }
5946
5947 y01 = pa / y11;
5948 fdens = fdens * std::pow((y01 / y0), 1.5);
5949 ftemp = ftemp * std::pow((y01 / y0), 1.5);
5950 }
5951 }
5952 else
5953 {
5954 ponniv = 2.0 * std::sqrt(pa * fecor);
5955 if (ponniv > 700.0)
5956 {
5957 ponniv = 700.0;
5958 }
5959 // fermi gas state density
5960 fdens = 0.1477045 * std::exp(ponniv) / (std::pow(pa, 0.25) * std::pow(fecor, 1.25));
5961 ftemp = std::sqrt(fecor / pa);
5962 }
5963 //
5964 densfm = fdens;
5965 tfm = ftemp;
5966 //
5967 if (IOPTCT == 0)
5968 goto densniv100;
5969 tempct = 17.60 / (std::pow(a, 0.699) * std::sqrt(1. + gamma * BSHELLCT));
5970 // tempct = 1.0 / ( (0.0570 + 0.00193*BSHELLCT) * pow(a,0.6666667)); // from
5971 // PRC 80 (2009) 054310
5972
5973 // - CONSTANT-TEMPERATURE LEVEL DENSITY PARAMETER (ONLY AT LOW ENERGIES)
5974 if (e < 30.)
5975 {
5976 if (a > 0.0)
5977 {
5978 if (optshp >= 2)
5979 {
5980 // Parametrization of CT model by Ignatyuk; note that E0 is shifted to
5981 // correspond to pairing shift in Fermi-gas model (there, energy is
5982 // shifted taking odd-odd nuclei
5983 // as bassis)
5984 // e-o, o-e
5985 if (IPARITE == 1)
5986 {
5987 e0 = 0.285 + 11.17 * std::pow(a, -0.464) - 0.390 - 0.00058 * a;
5988 }
5989 // e-e
5990 if (IPARITE == 2)
5991 {
5992 e0 = 22.34 * std::pow(a, -0.464) - 0.235;
5993 }
5994 // o-o
5995 if (IPARITE == 0)
5996 {
5997 e0 = 0.0;
5998 }
5999
6000 ponniv = (ein - e0) / tempct;
6001 if (ifis != 1)
6002 ponniv = max(0.0, (ein - e0) / tempct);
6003 if (ponniv > 700.0)
6004 {
6005 ponniv = 700.0;
6006 }
6007 densct = std::exp(ponniv) / tempct * std::exp(0.079 * BSHELLCT / tempct);
6008
6009 elim = ein;
6010
6011 if (elim >= ecr && densfm <= densct)
6012 {
6013 fdens = densfm;
6014 // IREGCT = 0;
6015 }
6016 else
6017 {
6018 fdens = densct;
6019 // IREGCT = 1;
6020 // ecor = min(ein-e0,0.10);
6021 }
6022 if (elim >= ecr && tfm >= tempct)
6023 {
6024 ftemp = tfm;
6025 }
6026 else
6027 {
6028 ftemp = tempct;
6029 }
6030 }
6031 else
6032 {
6033 // Case of no pairing considered
6034 // ETEST = PA * TEMPCT**2
6035 ponniv = (ein) / tempct;
6036 if (ponniv > 700.0)
6037 {
6038 ponniv = 700.0;
6039 }
6040 densct = std::exp(ponniv) / tempct;
6041
6042 if (ein >= ecr && densfm <= densct)
6043 {
6044 fdens = densfm;
6045 ftemp = tfm;
6046 // IREGCT = 0;
6047 }
6048 else
6049 {
6050 fdens = densct;
6051 ftemp = tempct;
6052 // ECOR = DMIN1(EIN,0.1D0)
6053 }
6054
6055 if (ein >= ecr && tfm >= tempct)
6056 {
6057 ftemp = tfm;
6058 }
6059 else
6060 {
6061 ftemp = tempct;
6062 }
6063 }
6064 }
6065 }
6066
6067 densniv100:
6068
6069 if (fdens == 0.0)
6070 {
6071 if (a > 0.0)
6072 {
6073 // Parametrization of CT model by Ignatyuk done for masses > 20
6074 ftemp = 17.60 / (std::pow(a, 0.699) * std::sqrt(1.0 + gamma * BSHELLCT));
6075 // ftemp = 1.0 / ( (0.0570 + 0.00193*BSHELLCT) * pow(a,0.6666667)); //
6076 // from PRC 80 (2009) 054310
6077 }
6078 else
6079 {
6080 ftemp = 0.5;
6081 }
6082 }
6083 //
6084 // spin cutoff parameter
6085 /*
6086 C PERPENDICULAR AND PARALLEL MOMENT OF INERTIA
6087 c fnorm = R0*M0/hbar**2 = 1.16fm*931.49MeV/c**2 /(6.582122e-22 MeVs)**2 and is
6088 c in units 1/MeV
6089 */
6090 fnorm = std::pow(1.16, 2) * 931.49 * 1.e-2 / (9.0 * std::pow(6.582122, 2));
6091
6092 if (ifis == 0 || ifis == 2)
6093 {
6094 /*
6095 C GROUND STATE:
6096 C FP_PER ~ 1+0.5*alpha2, FP_PAR ~ 1-alpha2 (Hasse & Myers, Geom. relat.
6097 macr. nucl. phys.) C alpha2 = sqrt(5/(4*pi))*beta2
6098 */
6099 fp_per = 0.4 * std::pow(a, 5.0 / 3.0) * fnorm * (1.0 + 0.50 * defbet * std::sqrt(5.0 / (4.0 * pi)));
6100 fp_par = 0.40 * std::pow(a, 5.0 / 3.0) * fnorm * (1.0 - defbet * std::sqrt(5.0 / (4.0 * pi)));
6101 }
6102 else
6103 {
6104 if (ifis == 1)
6105 {
6106 /*
6107 C SADDLE POINT
6108 C See Hasse&Myer, p. 100
6109 C Perpendicular moment of inertia
6110 */
6111 fp_per = 2.0 / 5.0 * std::pow(a, 5.0 / 3.0) * fnorm *
6112 (1.0 + 7.0 / 6.0 * defbet * (1.0 + 1396.0 / 255.0 * defbet));
6113 // Parallel moment of inertia
6114 fp_par = 2.0 / 5.0 * std::pow(a, 5.0 / 3.0) * fnorm *
6115 (1.0 - 7.0 / 3.0 * defbet * (1.0 - 389.0 / 255.0 * defbet));
6116 }
6117 else
6118 {
6119 if (ifis == 20)
6120 {
6121 // IMF - two fragments in contact; it is asumed that both are spherical.
6122 // See Hasse&Myers, p.106
6123 // Here, DEFBET = R1/R2, where R1 and R2 are radii of IMF and its
6124 // partner Perpendicular moment of inertia
6125 fp_per = 0.4 * std::pow(a, 5.0 / 3.0) * fnorm * 3.50 * (1.0 + std::pow(defbet, 5.)) /
6126 std::pow(1.0 + defbet * defbet * defbet, 5.0 / 3.0);
6127 fp_par = 0.4 * std::pow(a, 5.0 / 3.0) * fnorm * (1.0 + std::pow(defbet, 5.0)) /
6128 std::pow(1.0 + defbet * defbet * defbet, 5.0 / 3.0);
6129 }
6130 }
6131 }
6132 if (fp_par < 0.0)
6133 fp_par = 0.0;
6134 if (fp_per < 0.0)
6135 fp_per = 0.0;
6136 //
6137 sig_per = std::sqrt(fp_per * ftemp);
6138 sig_par = std::sqrt(fp_par * ftemp);
6139 //
6140 sigma2 = sig_per * sig_per + sig_par * sig_par;
6141 jfact = (2. * jprf + 1.) * std::exp(-1. * jprf * (jprf + 1.0) / (2.0 * sigma2)) /
6142 (std::sqrt(8.0 * 3.1415) * std::pow(sigma2, 1.5));
6143 erot = jprf * jprf / (2.0 * std::sqrt(fp_par * fp_par + fp_per * fp_per));
6144 //
6145 // collective enhancement
6146 if (optcol == 1)
6147 {
6148 qrot(z, a, defbet, sig_per, fecor - erot, &fqr);
6149 }
6150 else
6151 {
6152 fqr = 1.0;
6153 }
6154 //
6155 fdens = fdens * fqr * jfact;
6156 //
6157 if (fdens < 1e-300)
6158 fdens = 0.0;
6159 //
6160 *dens = fdens;
6161 *ecor = fecor;
6162 *temp = ftemp;
6163 *qr = fqr;
6164 }
6165
6166 void G4Abla::qrot(G4double z, G4double a, G4double bet, G4double sig, G4double u, G4double* qr)
6167 {
6168 /*
6169 C QROT INCLUDING DAMPING
6170 C
6171 C INPUT: Z,A,DEFBET,SIG,U
6172 C
6173 C OUTPUT: QR - COLLECTIVE ENHANCEMENT FACTOR
6174 C
6175 C SEE JUNGHANS ET AL., NUCL. PHYS. A 629 (1998) 635
6176 C
6177 C
6178 C FR(U) EXPONENTIAL FUNCTION TO DEFINE DAMPING
6179 C UCR CRITICAL ENERGY FOR DAMPING
6180 C DCR WIDTH OF DAMPING
6181 C DEFBET BETA-DEFORMATION !
6182 C SIG PERPENDICULAR SPIN CUTOFF FACTOR
6183 C U ENERGY
6184 C QR COEFFICIENT OF COLLECTIVE ENHANCEMENT
6185 C A MASS NUMBER
6186 C Z CHARGE NUMBER
6187 C
6188 */
6189 // JLRS: July 2016: new values for the collective parameters
6190 //
6191
6192 G4double ucr = fiss->ucr; // Critical energy for damping.
6193 G4double dcr = fiss->dcr; // Width of damping.
6194 G4double ponq = 0.0, dn = 0.0, n = 0.0, dz = 0.0;
6195 G4int distn, distz, ndist, zdist;
6196 G4int nmn[8] = { 2, 8, 14, 20, 28, 50, 82, 126 };
6197 G4int nmz[8] = { 2, 8, 14, 20, 28, 50, 82, 126 };
6198 //
6199 sig = sig * sig;
6200 //
6201 if (std::abs(bet) <= 0.15)
6202 {
6203 goto qrot10;
6204 }
6205 else
6206 {
6207 goto qrot11;
6208 }
6209 //
6210 qrot10:
6211 n = a - z;
6212 distn = 10000000;
6213 distz = 10000000;
6214
6215 for (G4int i = 0; i < 8; i++)
6216 {
6217 ndist = std::fabs(idnint(n) - nmn[i]);
6218 if (ndist < distn)
6219 distn = ndist;
6220 zdist = std::fabs(idnint(z) - nmz[i]);
6221 if (zdist < distz)
6222 distz = zdist;
6223 }
6224
6225 dz = G4float(distz);
6226 dn = G4float(distn);
6227
6228 bet = 0.022 + 0.003 * dn + 0.002 * dz;
6229
6230 sig = 75.0 * std::pow(bet, 2.) * sig;
6231
6232 // NO VIBRATIONAL ENHANCEMENT
6233 qrot11:
6234 ponq = (u - ucr) / dcr;
6235
6236 if (ponq > 700.0)
6237 {
6238 ponq = 700.0;
6239 }
6240 if (sig < 1.0)
6241 {
6242 sig = 1.0;
6243 }
6244 (*qr) = 1.0 / (1.0 + std::exp(ponq)) * (sig - 1.0) + 1.0;
6245
6246 if ((*qr) < 1.0)
6247 {
6248 (*qr) = 1.0;
6249 }
6250
6251 return;
6252 }
6253
6254 void G4Abla::lpoly(G4double x, G4int n, G4double pl[])
6255 {
6256 // THIS SUBROUTINE CALCULATES THE ORDINARY LEGENDRE POLYNOMIALS OF
6257 // ORDER 0 TO N-1 OF ARGUMENT X AND STORES THEM IN THE VECTOR PL.
6258 // THEY ARE CALCULATED BY RECURSION RELATION FROM THE FIRST TWO
6259 // POLYNOMIALS.
6260 // WRITTEN BY A.J.SIERK LANL T-9 FEBRUARY, 1984
6261 // NOTE: PL AND X MUST BE DOUBLE PRECISION ON 32-BIT COMPUTERS!
6262
6263 pl[0] = 1.0;
6264 pl[1] = x;
6265
6266 for (G4int i = 2; i < n; i++)
6267 {
6268 pl[i] = ((2 * G4double(i + 1) - 3.0) * x * pl[i - 1] - (G4double(i + 1) - 2.0) * pl[i - 2]) /
6269 (G4double(i + 1) - 1.0);
6270 }
6271 }
6272
6273 G4double G4Abla::eflmac(G4int ia, G4int iz, G4int flag, G4int optshp)
6274 {
6275 // CHANGED TO CALCULATE TOTAL BINDING ENERGY INSTEAD OF MASS EXCESS.
6276 // SWITCH FOR PAIRING INCLUDED AS WELL.
6277 // BINDING = EFLMAC(IA,IZ,0,OPTSHP)
6278 // FORTRAN TRANSCRIPT OF /U/GREWE/LANG/EEX/FRLDM.C
6279 // A.J. 15.07.96
6280
6281 // this function will calculate the liquid-drop nuclear mass for spheri
6282 // configuration according to the preprint NUCLEAR GROUND-STATE
6283 // MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
6284 // All constants are taken from this publication for consistency.
6285
6286 // Parameters:
6287 // a: nuclear mass number
6288 // z: nuclear charge
6289 // flag: 0 - return mass excess
6290 // otherwise - return pairing (= -1/2 dpn + 1/2 (Dp + Dn))
6291
6292 G4double eflmacResult = 0.0;
6293
6294 if (ia == 0)
6295 return eflmacResult;
6296
6297 G4int in = 0;
6298 G4double z = 0.0, n = 0.0, a = 0.0, av = 0.0, as = 0.0;
6299 G4double a0 = 0.0, c1 = 0.0, c4 = 0.0, b1 = 0.0, b3 = 0.0;
6300 G4double ff = 0.0, ca = 0.0, w = 0.0, efl = 0.0;
6301 G4double r0 = 0.0, kf = 0.0, ks = 0.0;
6302 G4double kv = 0.0, rp = 0.0, ay = 0.0, aden = 0.0, x0 = 0.0, y0 = 0.0;
6303 G4double esq = 0.0, ael = 0.0, i = 0.0, e0 = 0.0;
6304 G4double pi = 3.141592653589793238e0;
6305
6306 // fundamental constants
6307 // electronic charge squared
6308 esq = 1.4399764;
6309
6310 // constants from considerations other than nucl. masses
6311 // electronic binding
6312 ael = 1.433e-5;
6313
6314 // proton rms radius
6315 rp = 0.8;
6316
6317 // nuclear radius constant
6318 r0 = 1.16;
6319
6320 // range of yukawa-plus-expon. potential
6321 ay = 0.68;
6322
6323 // range of yukawa function used to generate
6324 // nuclear charge distribution
6325 aden = 0.70;
6326
6327 // wigner constant
6328 w = 30.0;
6329
6330 // adjusted parameters
6331 // volume energy
6332 av = 16.00126;
6333
6334 // volume asymmetry
6335 kv = 1.92240;
6336
6337 // surface energy
6338 as = 21.18466;
6339
6340 // surface asymmetry
6341 ks = 2.345;
6342 // a^0 constant
6343 a0 = 2.615;
6344
6345 // charge asymmetry
6346 ca = 0.10289;
6347
6348 z = G4double(iz);
6349 a = G4double(ia);
6350 in = ia - iz;
6351 n = G4double(in);
6352
6353 if (flag == 1)
6354 {
6355 goto eflmac311;
6356 }
6357
6358 if (iz < 13 && in < 3)
6359 {
6360 if (masses->mexpiop[in][iz] == 1)
6361 {
6362 return masses->bind[in][iz];
6363 }
6364 }
6365
6366 eflmac311:
6367
6368 c1 = 3.0 / 5.0 * esq / r0;
6369 c4 = 5.0 / 4.0 * std::pow((3.0 / (2.0 * pi)), (2.0 / 3.0)) * c1;
6370 kf = std::pow((9.0 * pi * z / (4.0 * a)), (1.0 / 3.0)) / r0;
6371
6372 ff = -1.0 / 8.0 * rp * rp * esq / std::pow(r0, 3) *
6373 (145.0 / 48.0 - 327.0 / 2880.0 * std::pow(kf, 2) * std::pow(rp, 2) +
6374 1527.0 / 1209600.0 * std::pow(kf, 4) * std::pow(rp, 4));
6375 i = (n - z) / a;
6376
6377 x0 = r0 * std::pow(a, (1.0 / 3.0)) / ay;
6378 y0 = r0 * std::pow(a, (1.0 / 3.0)) / aden;
6379
6380 b1 = 1.0 - 3.0 / (std::pow(x0, 2)) + (1.0 + x0) * (2.0 + 3.0 / x0 + 3.0 / std::pow(x0, 2)) * std::exp(-2.0 * x0);
6381
6382 b3 = 1.0 - 5.0 / std::pow(y0, 2) *
6383 (1.0 - 15.0 / (8.0 * y0) + 21.0 / (8.0 * std::pow(y0, 3)) -
6384 3.0 / 4.0 * (1.0 + 9.0 / (2.0 * y0) + 7.0 / std::pow(y0, 2) + 7.0 / (2.0 * std::pow(y0, 3))) *
6385 std::exp(-2.0 * y0));
6386
6387 // now calculation of total binding energy a.j. 16.7.96
6388
6389 efl = -1.0 * av * (1.0 - kv * i * i) * a + as * (1.0 - ks * i * i) * b1 * std::pow(a, (2.0 / 3.0)) + a0 +
6390 c1 * z * z * b3 / std::pow(a, (1.0 / 3.0)) - c4 * std::pow(z, (4.0 / 3.0)) / std::pow(a, (1.e0 / 3.e0)) +
6391 ff * std::pow(z, 2) / a - ca * (n - z) - ael * std::pow(z, (2.39e0));
6392
6393 efl = efl + w * std::abs(i);
6394
6395 // pairing is made optional
6396 if (optshp >= 2)
6397 {
6398 // average pairing
6399 if (in == iz && (mod(in, 2) == 1) && (mod(iz, 2) == 1) && in > 0.)
6400 {
6401 efl = efl + w / a;
6402 }
6403
6404 // AK 2008 - Parametrization of CT model by Ignatyuk;
6405 // The following part has been introduced in order to have correspondance
6406 // between pairing in masses and level densities;
6407 // AK 2010 note that E0 is shifted to correspond to pairing shift in
6408 // Fermi-gas model (there, energy is shifted taking odd-odd nuclei
6409 // as bassis)
6410
6411 G4double para = 0.;
6412 parite(a, ¶);
6413
6414 if (para < 0.0)
6415 {
6416 // e-o, o-e
6417 e0 = 0.285 + 11.17 * std::pow(a, -0.464) - 0.390 - 0.00058 * (a);
6418 }
6419 else
6420 {
6421 G4double parz = 0.;
6422 parite(z, &parz);
6423 if (parz > 0.0)
6424 {
6425 // e-e
6426 e0 = 22.34 * std::pow(a, -0.464) - 0.235;
6427 }
6428 else
6429 {
6430 // o-o
6431 e0 = 0.0;
6432 }
6433 }
6434 efl = efl - e0;
6435 // end if for pairing term
6436 }
6437
6438 eflmacResult = efl;
6439
6440 return eflmacResult;
6441 }
6442
6443 void G4Abla::appariem(G4double a, G4double z, G4double* del)
6444 {
6445 // CALCUL DE LA CORRECTION, DUE A L'APPARIEMENT, DE L'ENERGIE DE
6446 // LIAISON D'UN NOYAU
6447 // PROCEDURE FOR CALCULATING THE PAIRING CORRECTION TO THE BINDING
6448 // ENERGY OF A SPECIFIC NUCLEUS
6449
6450 G4double para = 0.0, parz = 0.0;
6451 // A MASS NUMBER
6452 // Z NUCLEAR CHARGE
6453 // PARA HELP VARIABLE FOR PARITY OF A
6454 // PARZ HELP VARIABLE FOR PARITY OF Z
6455 // DEL PAIRING CORRECTION
6456
6457 parite(a, ¶);
6458
6459 if (para < 0.0)
6460 {
6461 (*del) = 0.0;
6462 }
6463 else
6464 {
6465 parite(z, &parz);
6466 if (parz > 0.0)
6467 {
6468 (*del) = -12.0 / std::sqrt(a);
6469 }
6470 else
6471 {
6472 (*del) = 12.0 / std::sqrt(a);
6473 }
6474 }
6475 }
6476
6477 void G4Abla::parite(G4double n, G4double* par)
6478 {
6479 // CALCUL DE LA PARITE DU NOMBRE N
6480 //
6481 // PROCEDURE FOR CALCULATING THE PARITY OF THE NUMBER N.
6482 // RETURNS -1 IF N IS ODD AND +1 IF N IS EVEN
6483
6484 G4double n1 = 0.0, n2 = 0.0, n3 = 0.0;
6485
6486 // N NUMBER TO BE TESTED
6487 // N1,N2 HELP VARIABLES
6488 // PAR HELP VARIABLE FOR PARITY OF N
6489
6490 n3 = G4double(idnint(n));
6491 n1 = n3 / 2.0;
6492 n2 = n1 - dint(n1);
6493
6494 if (n2 > 0.0)
6495 {
6496 (*par) = -1.0;
6497 }
6498 else
6499 {
6500 (*par) = 1.0;
6501 }
6502 }
6503
6504 G4double G4Abla::tau(G4double bet, G4double homega, G4double ef, G4double t)
6505 {
6506 // INPUT : BET, HOMEGA, EF, T
6507 // OUTPUT: TAU - RISE TIME IN WHICH THE FISSION WIDTH HAS REACHED
6508 // 90 PERCENT OF ITS FINAL VALUE
6509 //
6510 // BETA - NUCLEAR VISCOSITY
6511 // HOMEGA - CURVATURE OF POTENTIAL
6512 // EF - FISSION BARRIER
6513 // T - NUCLEAR TEMPERATURE
6514
6515 G4double tauResult = 0.0;
6516
6517 G4double tlim = 8.e0 * ef;
6518 if (t > tlim)
6519 {
6520 t = tlim;
6521 }
6522 //
6523 if (bet / (std::sqrt(2.0) * 10.0 * (homega / 6.582122)) <= 1.0)
6524 {
6525 tauResult = std::log(10.0 * ef / t) / (bet * 1.0e21);
6526 }
6527 else
6528 {
6529 tauResult = std::log(10.0 * ef / t) / (2.0 * std::pow((10.0 * homega / 6.582122), 2)) * (bet * 1.0e-21);
6530 } // end if
6531
6532 return tauResult;
6533 }
6534
6535 G4double G4Abla::cram(G4double bet, G4double homega)
6536 {
6537 // INPUT : BET, HOMEGA NUCLEAR VISCOSITY + CURVATURE OF POTENTIAL
6538 // OUTPUT: KRAMERS FAKTOR - REDUCTION OF THE FISSION PROBABILITY
6539 // INDEPENDENT OF EXCITATION ENERGY
6540
6541 G4double rel = bet / (20.0 * homega / 6.582122);
6542 G4double cramResult = std::sqrt(1.0 + std::pow(rel, 2)) - rel;
6543 // limitation introduced 6.1.2000 by khs
6544
6545 if (cramResult > 1.0)
6546 {
6547 cramResult = 1.0;
6548 }
6549
6550 return cramResult;
6551 }
6552
6553 G4double G4Abla::bipol(G4int iflag, G4double y)
6554 {
6555 // CALCULATION OF THE SURFACE BS OR CURVATURE BK OF A NUCLEUS
6556 // RELATIVE TO THE SPHERICAL CONFIGURATION
6557 // BASED ON MYERS, DROPLET MODEL FOR ARBITRARY SHAPES
6558
6559 // INPUT: IFLAG - 0/1 BK/BS CALCULATION
6560 // Y - (1 - X) COMPLEMENT OF THE FISSILITY
6561
6562 // LINEAR INTERPOLATION OF BS BK TABLE
6563
6564 G4int i = 0;
6565
6566 G4double bipolResult = 0.0;
6567
6568 const G4int bsbkSize = 54;
6569
6570 G4double bk[bsbkSize] = {
6571 0.0, 1.00000, 1.00087, 1.00352, 1.00799, 1.01433, 1.02265, 1.03306, 1.04576, 1.06099, 1.07910,
6572 1.10056, 1.12603, 1.15651, 1.19348, 1.23915, 1.29590, 1.35951, 1.41013, 1.44103, 1.46026, 1.47339,
6573 1.48308, 1.49068, 1.49692, 1.50226, 1.50694, 1.51114, 1.51502, 1.51864, 1.52208, 1.52539, 1.52861,
6574 1.53177, 1.53490, 1.53803, 1.54117, 1.54473, 1.54762, 1.55096, 1.55440, 1.55798, 1.56173, 1.56567,
6575 1.56980, 1.57413, 1.57860, 1.58301, 1.58688, 1.58688, 1.58688, 1.58740, 1.58740, 0.0
6576 }; // Zeroes at bk[0], and at
6577 // the end added by PK
6578
6579 G4double bs[bsbkSize] = { 0.0, 1.00000, 1.00086, 1.00338, 1.00750, 1.01319, 1.02044, 1.02927, 1.03974,
6580 1.05195, 1.06604, 1.08224, 1.10085, 1.12229, 1.14717, 1.17623, 1.20963, 1.24296,
6581 1.26532, 1.27619, 1.28126, 1.28362, 1.28458, 1.28477, 1.28450, 1.28394, 1.28320,
6582 1.28235, 1.28141, 1.28042, 1.27941, 1.27837, 1.27732, 1.27627, 1.27522, 1.27418,
6583 1.27314, 1.27210, 1.27108, 1.27006, 1.26906, 1.26806, 1.26707, 1.26610, 1.26514,
6584 1.26418, 1.26325, 1.26233, 1.26147, 1.26147, 1.26147, 1.25992, 1.25992, 0.0 };
6585
6586 i = idint(y / (2.0e-02)) + 1;
6587
6588 if ((i + 1) >= bsbkSize)
6589 {
6590 if (verboseLevel > 2)
6591 {
6592 // G4cout <<"G4Abla error: index " << i + 1 << " is greater than array
6593 // size permits." << G4endl;
6594 }
6595 bipolResult = 0.0;
6596 }
6597 else
6598 {
6599 if (iflag == 1)
6600 {
6601 bipolResult = bs[i] + (bs[i + 1] - bs[i]) / 2.0e-02 * (y - 2.0e-02 * (i - 1));
6602 }
6603 else
6604 {
6605 bipolResult = bk[i] + (bk[i + 1] - bk[i]) / 2.0e-02 * (y - 2.0e-02 * (i - 1));
6606 }
6607 }
6608
6609 return bipolResult;
6610 }
6611
6612 void G4Abla::fomega_sp(G4double AF, G4double Y, G4double* MFCD, G4double* sOMEGA, G4double* sHOMEGA)
6613 {
6614 /*
6615 c Y 1 - Fissility
6616 c OMEGA Frequency at the ground state, in units 1.e-21 s
6617 */
6618 G4double OMEGA, HOMEGA, ES0, MR02;
6619
6620 ES0 = 20.760 * std::pow(AF, 2.0 / 3.0);
6621 // In units 1.e-42 MeVs**2; r0 = 1.175e-15 m,
6622 // u=931.49MeV/c**2=103.4MeV*s**2/m**2 divided by 1.e-4 to go from 1.e-46
6623 // to 1.e-42
6624 MR02 = std::pow(AF, 5.0 / 3.0) * 1.0340 * 0.010 * 1.175 * 1.175;
6625 // Determination of the inertia of the fission collective degree of freedom
6626 (*MFCD) = MR02 * 3.0 / 10.0 * (1.0 + 3.0 * Y);
6627 // Omega at saddle
6628 OMEGA = std::sqrt(ES0 / MR02) * std::sqrt(8.0 / 3.0 * Y * (1.0 + 304.0 * Y / 255.0));
6629 //
6630 HOMEGA = 6.58122 * OMEGA / 10.0;
6631 //
6632 (*sOMEGA) = OMEGA;
6633 (*sHOMEGA) = HOMEGA;
6634 //
6635 return;
6636 }
6637
6638 void G4Abla::fomega_gs(G4double AF, G4double ZF, G4double* K1, G4double* sOMEGA, G4double* sHOMEGA)
6639 {
6640 /*
6641 c Y 1 - Fissility
6642 c OMEGA Frequency at the ground state, in units 1.e-21 s
6643 */
6644 G4double OMEGA, HOMEGA, MR02, MINERT, C, fk1;
6645 //
6646 MR02 = std::pow(AF, 5.0 / 3.0) * 1.0340 * 0.01 * 1.175 * 1.175;
6647 MINERT = 3. * MR02 / 10.0;
6648 C = 17.9439 * (1. - 1.7826 * std::pow((AF - 2.0 * ZF) / AF, 2));
6649 fk1 = 0.4 * C * std::pow(AF, 2.0 / 3.0) - 0.1464 * std::pow(ZF, 2) / std::pow(AF, 1. / 3.);
6650 OMEGA = std::sqrt(fk1 / MINERT);
6651 HOMEGA = 6.58122 * OMEGA / 10.0;
6652 //
6653 (*K1) = fk1;
6654 (*sOMEGA) = OMEGA;
6655 (*sHOMEGA) = HOMEGA;
6656 //
6657 return;
6658 }
6659
6660 void G4Abla::barrs(G4int Z1, G4int A1, G4int Z2, G4int A2, G4double* sBARR, G4double* sOMEGA)
6661 { /*
6662 C AK 2004 - Barriers for LCP and IMF are calculated now
6663 according to the C Bass model (Nucl. Phys. A (1974))
6664 C KHS 2007 - To speed up, barriers are read from tabels; in
6665 case thermal C expansion is considered, barriers
6666 are calculated. C INPUT: C EA - Excitation energy per
6667 nucleon C Z11, A11 - Charge and mass of daughter nucleus C
6668 Z22, A22 - Charge and mass of LCP or IMF
6669 C
6670 C OUTPUT:
6671 C BARR - Barrier
6672 C OMEGA - Curvature of the potential
6673 C
6674 C BASS MODEL NPA 1974 - used only if expansion is considered
6675 (OPTEXP=1) C or one wants this model
6676 explicitly (OPTBAR=1) C October 2011 - AK - new
6677 parametrization of the barrier and its position, C see W.W. Qu
6678 et al., NPA 868 (2011) 1; this is now C default option
6679 (OPTBAR=0)
6680 c
6681 c November 2016 - JLRS - Added this function from abla07v4
6682 c
6683 */
6684 G4double BARR, OMEGA, RMAX;
6685 RMAX = 1.1 * (ecld->rms[A1 - Z1][Z1] + ecld->rms[A2 - Z2][Z2]) + 2.8;
6686 BARR = 1.345 * Z1 * Z2 / RMAX;
6687 // C Omega according to Avishai:
6688 OMEGA = 4.5 / 197.3287;
6689
6690 // if(Z1<60){
6691 // if(Z2==1 && A2==2) BARR = BARR * 1.1;
6692 // if(Z2==1 && A2==3) BARR = BARR * 1.1;
6693 // if(Z2==2 && A2==3) BARR = BARR * 1.3;
6694 // if(Z2==2 && A2==4) BARR = BARR * 1.1;
6695 // }
6696
6697 (*sOMEGA) = OMEGA;
6698 (*sBARR) = BARR;
6699 //
6700 return;
6701 }
6702
6703 void G4Abla::barfit(G4int iz, G4int ia, G4int il, G4double* sbfis, G4double* segs, G4double* selmax)
6704 {
6705 // 2223 C VERSION FOR 32BIT COMPUTER
6706 // 2224 C THIS SUBROUTINE RETURNS THE BARRIER HEIGHT BFIS, THE
6707 // 2225 C GROUND-STATE ENERGY SEGS, IN MEV, AND THE ANGULAR MOMENTUM
6708 // 2226 C AT WHICH THE FISSION BARRIER DISAPPEARS, LMAX, IN UNITS OF
6709 // 2227 C H-BAR, WHEN CALLED WITH INTEGER AGUMENTS IZ, THE ATOMIC
6710 // 2228 C NUMBER, IA, THE ATOMIC MASS NUMBER, AND IL, THE ANGULAR
6711 // 2229 C MOMENTUM IN UNITS OF H-BAR. (PLANCK'S CONSTANT DIVIDED BY
6712 // 2230 C 2*PI).
6713 // 2231 C
6714 // 2232 C THE FISSION BARRIER FO IL = 0 IS CALCULATED FROM A 7TH
6715 // 2233 C ORDER FIT IN TWO VARIABLES TO 638 CALCULATED FISSION
6716 // 2234 C BARRIERS FOR Z VALUES FROM 20 TO 110. THESE 638 BARRIERS
6717 // ARE 2235 C FIT WITH AN RMS DEVIATION OF 0.10 MEV BY THIS 49-PARAMETER
6718 // 2236 C FUNCTION.
6719 // 2237 C IF BARFIT IS CALLED WITH (IZ,IA) VALUES OUTSIDE THE RANGE
6720 // OF 2238 C THE BARRIER HEIGHT IS SET TO 0.0, AND A MESSAGE IS PRINTED
6721 // 2239 C ON THE DEFAULT OUTPUT FILE.
6722 // 2240 C
6723 // 2241 C FOR IL VALUES NOT EQUAL TO ZERO, THE VALUES OF L AT
6724 // WHICH 2242 C THE BARRIER IS 80% AND 20% OF THE L=0 VALUE ARE
6725 // RESPECTIVELY
6726 // 2243 C FIT TO 20-PARAMETER FUNCTIONS OF Z AND A, OVER A MORE
6727 // 2244 C RESTRICTED RANGE OF A VALUES, THAN IS THE CASE FOR L = 0.
6728 // 2245 C THE VALUE OF L WHERE THE BARRIER DISAPPEARS, LMAX IS FIT
6729 // TO 2246 C A 24-PARAMETER FUNCTION OF Z AND A, WITH THE SAME RANGE OF
6730 // 2247 C Z AND A VALUES AS L-80 AND L-20.
6731 // 2248 C ONCE AGAIN, IF AN (IZ,IA) PAIR IS OUTSIDE OF THE RANGE
6732 // OF 2249 C VALIDITY OF THE FIT, THE BARRIER VALUE IS SET TO 0.0 AND A
6733 // 2250 C MESSAGE IS PRINTED. THESE THREE VALUES (BFIS(L=0),L-80,
6734 // AND 2251 C L-20) AND THE CONSTRINTS OF BFIS = 0 AND D(BFIS)/DL = 0 AT
6735 // 2252 C L = LMAX AND L=0 LEAD TO A FIFTH-ORDER FIT TO BFIS(L) FOR
6736 // 2253 C L>L-20. THE FIRST THREE CONSTRAINTS LEAD TO A THIRD-ORDER
6737 // FIT 2254 C FOR THE REGION L < L-20. 2255 C 2256 C THE
6738 // GROUND STATE ENERGIES ARE CALCULATED FROM A 2257 C 120-PARAMETER FIT
6739 // IN Z, A, AND L TO 214 GROUND-STATE ENERGIES 2258 C FOR 36 DIFFERENT Z
6740 // AND A VALUES.
6741 // 2259 C (THE RANGE OF Z AND A IS THE SAME AS FOR L-80, L-20, AND
6742 // 2260 C L-MAX)
6743 // 2261 C
6744 // 2262 C THE CALCULATED BARRIERS FROM WHICH THE FITS WERE MADE
6745 // WERE 2263 C CALCULATED IN 1983-1984 BY A. J. SIERK OF LOS
6746 // ALAMOS 2264 C NATIONAL LABORATORY GROUP T-9, USING
6747 // YUKAWA-PLUS-EXPONENTIAL
6748 // 2265 C G4DOUBLE FOLDED NUCLEAR ENERGY, EXACT COULOMB DIFFUSENESS
6749 // 2266 C CORRECTIONS, AND DIFFUSE-MATTER MOMENTS OF INERTIA.
6750 // 2267 C THE PARAMETERS OF THE MODEL R-0 = 1.16 FM, AS 21.13 MEV,
6751 // 2268 C KAPPA-S = 2.3, A = 0.68 FM.
6752 // 2269 C THE DIFFUSENESS OF THE MATTER AND CHARGE DISTRIBUTIONS
6753 // USED 2270 C CORRESPONDS TO A SURFACE DIFFUSENESS PARAMETER
6754 // (DEFINED BY 2271 C MYERS) OF 0.99 FM. THE CALCULATED BARRIERS FOR L =
6755 // 0 ARE 2272 C ACCURATE TO A LITTLE LESS THAN 0.1 MEV; THE OUTPUT
6756 // FROM 2273 C THIS SUBROUTINE IS A LITTLE LESS ACCURATE. WORST
6757 // ERRORS MAY BE
6758 // 2274 C AS LARGE AS 0.5 MEV; CHARACTERISTIC UNCERTAINY IS IN THE
6759 // RANGE
6760 // 2275 C OF 0.1-0.2 MEV. THE RMS DEVIATION OF THE GROUND-STATE FIT
6761 // 2276 C FROM THE 214 INPUT VALUES IS 0.20 MEV. THE MAXIMUM ERROR
6762 // 2277 C OCCURS FOR LIGHT NUCLEI IN THE REGION WHERE THE GROUND
6763 // STATE
6764 // 2278 C IS PROLATE, AND MAY BE GREATER THAN 1.0 MEV FOR VERY
6765 // NEUTRON
6766 // 2279 C DEFICIENT NUCLEI, WITH L NEAR LMAX. FOR MOST NUCLEI LIKELY
6767 // TO 2280 C BE ENCOUNTERED IN REAL EXPERIMENTS, THE MAXIMUM ERROR IS
6768 // 2281 C CLOSER TO 0.5 MEV, AGAIN FOR LIGHT NUCLEI AND L NEAR LMAX.
6769 // 2282 C
6770 // 2283 C WRITTEN BY A. J. SIERK, LANL T-9
6771 // 2284 C VERSION 1.0 FEBRUARY, 1984
6772 // 2285 C
6773 // 2286 C THE FOLLOWING IS NECESSARY FOR 32-BIT MACHINES LIKE DEC
6774 // VAX, 2287 C IBM, ETC
6775
6776 G4double pa[7], pz[7], pl[10];
6777 for (G4int init_i = 0; init_i < 7; init_i++)
6778 {
6779 pa[init_i] = 0.0;
6780 pz[init_i] = 0.0;
6781 }
6782 for (G4int init_i = 0; init_i < 10; init_i++)
6783 {
6784 pl[init_i] = 0.0;
6785 }
6786
6787 G4double a = 0.0, z = 0.0, amin = 0.0, amax = 0.0, amin2 = 0.0;
6788 G4double amax2 = 0.0, aa = 0.0, zz = 0.0, bfis = 0.0;
6789 G4double bfis0 = 0.0, ell = 0.0, el = 0.0, egs = 0.0, el80 = 0.0, el20 = 0.0;
6790 G4double elmax = 0.0, sel80 = 0.0, sel20 = 0.0, x = 0.0, y = 0.0, q = 0.0, qa = 0.0, qb = 0.0;
6791 G4double aj = 0.0, ak = 0.0, a1 = 0.0, a2 = 0.0;
6792
6793 G4int i = 0, j = 0, k = 0, m = 0;
6794 G4int l = 0;
6795
6796 G4double emncof[4][5] = { { -9.01100e+2, -1.40818e+3, 2.77000e+3, -7.06695e+2, 8.89867e+2 },
6797 { 1.35355e+4, -2.03847e+4, 1.09384e+4, -4.86297e+3, -6.18603e+2 },
6798 { -3.26367e+3, 1.62447e+3, 1.36856e+3, 1.31731e+3, 1.53372e+2 },
6799 { 7.48863e+3, -1.21581e+4, 5.50281e+3, -1.33630e+3, 5.05367e-2 } };
6800
6801 G4double elmcof[4][5] = { { 1.84542e+3, -5.64002e+3, 5.66730e+3, -3.15150e+3, 9.54160e+2 },
6802 { -2.24577e+3, 8.56133e+3, -9.67348e+3, 5.81744e+3, -1.86997e+3 },
6803 { 2.79772e+3, -8.73073e+3, 9.19706e+3, -4.91900e+3, 1.37283e+3 },
6804 { -3.01866e+1, 1.41161e+3, -2.85919e+3, 2.13016e+3, -6.49072e+2 } };
6805
6806 G4double emxcof[4][6] = { { 9.43596e4, -2.241997e5, 2.223237e5, -1.324408e5, 4.68922e4, -8.83568e3 },
6807 { -1.655827e5, 4.062365e5, -4.236128e5, 2.66837e5, -9.93242e4, 1.90644e4 },
6808 { 1.705447e5, -4.032e5, 3.970312e5, -2.313704e5, 7.81147e4, -1.322775e4 },
6809 { -9.274555e4, 2.278093e5, -2.422225e5, 1.55431e5, -5.78742e4, 9.97505e3 } };
6810
6811 G4double elzcof[7][7] = {
6812 { 5.11819909e+5, -1.30303186e+6, 1.90119870e+6, -1.20628242e+6, 5.68208488e+5, 5.48346483e+4, -2.45883052e+4 },
6813 { -1.13269453e+6, 2.97764590e+6, -4.54326326e+6, 3.00464870e+6, -1.44989274e+6, -1.02026610e+5, 6.27959815e+4 },
6814 { 1.37543304e+6, -3.65808988e+6, 5.47798999e+6, -3.78109283e+6, 1.84131765e+6, 1.53669695e+4, -6.96817834e+4 },
6815 { -8.56559835e+5, 2.48872266e+6, -4.07349128e+6, 3.12835899e+6, -1.62394090e+6, 1.19797378e+5, 4.25737058e+4 },
6816 { 3.28723311e+5, -1.09892175e+6, 2.03997269e+6, -1.77185718e+6, 9.96051545e+5, -1.53305699e+5, -1.12982954e+4 },
6817 { 4.15850238e+4, 7.29653408e+4, -4.93776346e+5, 6.01254680e+5, -4.01308292e+5, 9.65968391e+4, -3.49596027e+3 },
6818 { -1.82751044e+5, 3.91386300e+5, -3.03639248e+5, 1.15782417e+5, -4.24399280e+3, -6.11477247e+3, 3.66982647e+2 }
6819 };
6820
6821 const G4int sizex = 5;
6822 const G4int sizey = 6;
6823 const G4int sizez = 4;
6824
6825 G4double egscof[sizey][sizey][sizez];
6826
6827 G4double egs1[sizey][sizex] = { { 1.927813e5, 7.666859e5, 6.628436e5, 1.586504e5, -7.786476e3 },
6828 { -4.499687e5, -1.784644e6, -1.546968e6, -4.020658e5, -3.929522e3 },
6829 { 4.667741e5, 1.849838e6, 1.641313e6, 5.229787e5, 5.928137e4 },
6830 { -3.017927e5, -1.206483e6, -1.124685e6, -4.478641e5, -8.682323e4 },
6831 { 1.226517e5, 5.015667e5, 5.032605e5, 2.404477e5, 5.603301e4 },
6832 { -1.752824e4, -7.411621e4, -7.989019e4, -4.175486e4, -1.024194e4 } };
6833
6834 G4double egs2[sizey][sizex] = { { -6.459162e5, -2.903581e6, -3.048551e6, -1.004411e6, -6.558220e4 },
6835 { 1.469853e6, 6.564615e6, 6.843078e6, 2.280839e6, 1.802023e5 },
6836 { -1.435116e6, -6.322470e6, -6.531834e6, -2.298744e6, -2.639612e5 },
6837 { 8.665296e5, 3.769159e6, 3.899685e6, 1.520520e6, 2.498728e5 },
6838 { -3.302885e5, -1.429313e6, -1.512075e6, -6.744828e5, -1.398771e5 },
6839 { 4.958167e4, 2.178202e5, 2.400617e5, 1.167815e5, 2.663901e4 } };
6840
6841 G4double egs3[sizey][sizex] = { { 3.117030e5, 1.195474e6, 9.036289e5, 6.876190e4, -6.814556e4 },
6842 { -7.394913e5, -2.826468e6, -2.152757e6, -2.459553e5, 1.101414e5 },
6843 { 7.918994e5, 3.030439e6, 2.412611e6, 5.228065e5, 8.542465e3 },
6844 { -5.421004e5, -2.102672e6, -1.813959e6, -6.251700e5, -1.184348e5 },
6845 { 2.370771e5, 9.459043e5, 9.026235e5, 4.116799e5, 1.001348e5 },
6846 { -4.227664e4, -1.738756e5, -1.795906e5, -9.292141e4, -2.397528e4 } };
6847
6848 G4double egs4[sizey][sizex] = { { -1.072763e5, -5.973532e5, -6.151814e5, 7.371898e4, 1.255490e5 },
6849 { 2.298769e5, 1.265001e6, 1.252798e6, -2.306276e5, -2.845824e5 },
6850 { -2.093664e5, -1.100874e6, -1.009313e6, 2.705945e5, 2.506562e5 },
6851 { 1.274613e5, 6.190307e5, 5.262822e5, -1.336039e5, -1.115865e5 },
6852 { -5.715764e4, -2.560989e5, -2.228781e5, -3.222789e3, 1.575670e4 },
6853 { 1.189447e4, 5.161815e4, 4.870290e4, 1.266808e4, 2.069603e3 } };
6854
6855 for (i = 0; i < sizey; i++)
6856 {
6857 for (j = 0; j < sizex; j++)
6858 {
6859 egscof[i][j][0] = egs1[i][j];
6860 egscof[i][j][1] = egs2[i][j];
6861 egscof[i][j][2] = egs3[i][j];
6862 egscof[i][j][3] = egs4[i][j];
6863 }
6864 }
6865
6866 // the program starts here
6867 if (iz < 19 || iz > 122)
6868 {
6869 goto barfit900;
6870 }
6871
6872 if (iz > 122 && il > 0)
6873 {
6874 goto barfit902;
6875 }
6876
6877 z = G4double(iz);
6878 a = G4double(ia);
6879 el = G4double(il);
6880 amin = 1.2e0 * z + 0.01e0 * z * z;
6881 amax = 5.8e0 * z - 0.024e0 * z * z;
6882
6883 if (a < amin || a > amax)
6884 {
6885 goto barfit910;
6886 }
6887
6888 // angul.mom.zero barrier
6889 aa = 2.5e-3 * a;
6890 zz = 1.0e-2 * z;
6891 ell = 1.0e-2 * el;
6892 bfis0 = 0.0;
6893 lpoly(zz, 7, pz);
6894 lpoly(aa, 7, pa);
6895
6896 for (i = 0; i < 7; i++)
6897 { // do 10 i=1,7
6898 for (j = 0; j < 7; j++)
6899 { // do 10 j=1,7
6900 bfis0 = bfis0 + elzcof[j][i] * pz[i] * pa[j];
6901 }
6902 }
6903
6904 bfis = bfis0;
6905
6906 (*sbfis) = bfis;
6907 egs = 0.0;
6908 (*segs) = egs;
6909
6910 // values of l at which the barrier
6911 // is 20%(el20) and 80%(el80) of l=0 value
6912 amin2 = 1.4e0 * z + 0.009e0 * z * z;
6913 amax2 = 20.e0 + 3.0e0 * z;
6914
6915 if ((a < amin2 - 5.e0 || a > amax2 + 10.e0) && il > 0)
6916 {
6917 goto barfit920;
6918 }
6919
6920 lpoly(zz, 5, pz);
6921 lpoly(aa, 4, pa);
6922 el80 = 0.0;
6923 el20 = 0.0;
6924 elmax = 0.0;
6925
6926 for (i = 0; i < 4; i++)
6927 {
6928 for (j = 0; j < 5; j++)
6929 {
6930 el80 = el80 + elmcof[i][j] * pz[j] * pa[i];
6931 el20 = el20 + emncof[i][j] * pz[j] * pa[i];
6932 }
6933 }
6934
6935 sel80 = el80;
6936 sel20 = el20;
6937
6938 // value of l (elmax) where barrier disapp.
6939 lpoly(zz, 6, pz);
6940 lpoly(ell, 9, pl);
6941
6942 for (i = 0; i < 4; i++)
6943 { // do 30 i= 1,4
6944 for (j = 0; j < 6; j++)
6945 { // do 30 j=1,6
6946 elmax = elmax + emxcof[i][j] * pz[j] * pa[i];
6947 }
6948 }
6949
6950 (*selmax) = elmax;
6951
6952 // value of barrier at ang.mom. l
6953 if (il < 1)
6954 {
6955 return;
6956 }
6957
6958 x = sel20 / (*selmax);
6959 y = sel80 / (*selmax);
6960
6961 if (el <= sel20)
6962 {
6963 // low l
6964 q = 0.2 / (std::pow(sel20, 2) * std::pow(sel80, 2) * (sel20 - sel80));
6965 qa = q * (4.0 * std::pow(sel80, 3) - std::pow(sel20, 3));
6966 qb = -q * (4.0 * std::pow(sel80, 2) - std::pow(sel20, 2));
6967 bfis = bfis * (1.0 + qa * std::pow(el, 2) + qb * std::pow(el, 3));
6968 }
6969 else
6970 {
6971 // high l
6972 aj = (-20.0 * std::pow(x, 5) + 25.e0 * std::pow(x, 4) - 4.0) * std::pow((y - 1.0), 2) * y * y;
6973 ak = (-20.0 * std::pow(y, 5) + 25.0 * std::pow(y, 4) - 1.0) * std::pow((x - 1.0), 2) * x * x;
6974 q = 0.2 / (std::pow((y - x) * ((1.0 - x) * (1.0 - y) * x * y), 2));
6975 qa = q * (aj * y - ak * x);
6976 qb = -q * (aj * (2.0 * y + 1.0) - ak * (2.0 * x + 1.0));
6977 z = el / (*selmax);
6978 a1 = 4.0 * std::pow(z, 5) - 5.0 * std::pow(z, 4) + 1.0;
6979 a2 = qa * (2.e0 * z + 1.e0);
6980 bfis = bfis * (a1 + (z - 1.e0) * (a2 + qb * z) * z * z * (z - 1.e0));
6981 }
6982
6983 if (bfis <= 0.0)
6984 {
6985 bfis = 0.0;
6986 }
6987
6988 if (el > (*selmax))
6989 {
6990 bfis = 0.0;
6991 }
6992 (*sbfis) = bfis;
6993
6994 // now calculate rotating ground state energy
6995 if (el > (*selmax))
6996 {
6997 return;
6998 }
6999
7000 for (k = 0; k < 4; k++)
7001 {
7002 for (l = 0; l < 6; l++)
7003 {
7004 for (m = 0; m < 5; m++)
7005 {
7006 egs = egs + egscof[l][m][k] * pz[l] * pa[k] * pl[2 * m];
7007 }
7008 }
7009 }
7010
7011 (*segs) = egs;
7012 if ((*segs) < 0.0)
7013 {
7014 (*segs) = 0.0;
7015 }
7016
7017 return;
7018
7019 barfit900: // continue
7020 (*sbfis) = 0.0;
7021 // for z<19 sbfis set to 1.0e3
7022 if (iz < 19)
7023 {
7024 (*sbfis) = 1.0e3;
7025 }
7026 (*segs) = 0.0;
7027 (*selmax) = 0.0;
7028 return;
7029
7030 barfit902:
7031 (*sbfis) = 0.0;
7032 (*segs) = 0.0;
7033 (*selmax) = 0.0;
7034 return;
7035
7036 barfit910:
7037 (*sbfis) = 0.0;
7038 (*segs) = 0.0;
7039 (*selmax) = 0.0;
7040 return;
7041
7042 barfit920:
7043 (*sbfis) = 0.0;
7044 (*segs) = 0.0;
7045 (*selmax) = 0.0;
7046 return;
7047 }
7048
7049 G4double G4Abla::erf(G4double x)
7050 {
7051 G4double ferf;
7052
7053 if (x < 0.)
7054 {
7055 ferf = -gammp(0.5, x * x);
7056 }
7057 else
7058 {
7059 ferf = gammp(0.5, x * x);
7060 ;
7061 }
7062 return ferf;
7063 }
7064
7065 G4double G4Abla::gammp(G4double a, G4double x)
7066 {
7067 G4double fgammp;
7068 G4double gammcf, gamser, gln = 0.;
7069
7070 if (x < 0.0 || a <= 0.0)
7071 std::cout << "G4Abla::gammp = bad arguments in gammp" << std::endl;
7072 if (x < a + 1.)
7073 {
7074 gser(&gamser, a, x, gln);
7075 fgammp = gamser;
7076 }
7077 else
7078 {
7079 gcf(&gammcf, a, x, gln);
7080 fgammp = 1. - gammcf;
7081 }
7082 return fgammp;
7083 }
7084
7085 void G4Abla::gcf(G4double* gammcf, G4double a, G4double x, G4double gln)
7086 {
7087 G4double fgammcf, del;
7088 G4double eps = 3e-7;
7089 G4double fpmin = 1e-30;
7090 G4int itmax = 100;
7091 G4double an, b, c, d, h;
7092
7093 gln = gammln(a);
7094 b = x + 1. - a;
7095 c = 1. / fpmin;
7096 d = 1. / b;
7097 h = d;
7098 for (G4int i = 1; i <= itmax; i++)
7099 {
7100 an = -i * (i - a);
7101 b = b + 2.;
7102 d = an * d + b;
7103 if (std::fabs(d) < fpmin)
7104 d = fpmin;
7105 c = b + an / c;
7106 if (std::fabs(c) < fpmin)
7107 c = fpmin;
7108 d = 1.0 / d;
7109 del = d * c;
7110 h = h * del;
7111 if (std::fabs(del - 1.) < eps)
7112 goto dir1;
7113 }
7114 std::cout << "a too large, ITMAX too small in gcf" << std::endl;
7115 dir1:
7116 fgammcf = std::exp(-x + a * std::log(x) - gln) * h;
7117 (*gammcf) = fgammcf;
7118 return;
7119 }
7120
7121 void G4Abla::gser(G4double* gamser, G4double a, G4double x, G4double gln)
7122 {
7123 G4double fgamser, ap, sum, del;
7124 G4double eps = 3e-7;
7125 G4int itmax = 100;
7126
7127 gln = gammln(a);
7128 if (x <= 0.)
7129 {
7130 if (x < 0.)
7131 std::cout << "G4Abla::gser = x < 0 in gser" << std::endl;
7132 (*gamser) = 0.0;
7133 return;
7134 }
7135 ap = a;
7136 sum = 1. / a;
7137 del = sum;
7138 for (G4int n = 0; n < itmax; n++)
7139 {
7140 ap = ap + 1.;
7141 del = del * x / ap;
7142 sum = sum + del;
7143 if (std::fabs(del) < std::fabs(sum) * eps)
7144 goto dir1;
7145 }
7146 std::cout << "a too large, ITMAX too small in gser" << std::endl;
7147 dir1:
7148 fgamser = sum * std::exp(-x + a * std::log(x) - gln);
7149 (*gamser) = fgamser;
7150 return;
7151 }
7152
7153 G4double G4Abla::gammln(G4double xx)
7154 {
7155 G4double fgammln, x, ser, tmp, y;
7156 G4double cof[6] = { 76.18009172947146, -86.50532032941677, 24.01409824083091,
7157 -1.231739572450155, 0.1208650973866179e-2, -0.5395239384953e-5 };
7158 G4double stp = 2.5066282746310005;
7159
7160 x = xx;
7161 y = x;
7162 tmp = x + 5.5;
7163 tmp = (x + 0.5) * std::log(tmp) - tmp;
7164 ser = 1.000000000190015;
7165 for (G4int j = 0; j < 6; j++)
7166 {
7167 y = y + 1.;
7168 ser = ser + cof[j] / y;
7169 }
7170
7171 return fgammln = tmp + std::log(stp * ser / x);
7172 }
7173
7174 G4double G4Abla::fd(G4double E)
7175 {
7176 // DISTRIBUTION DE MAXWELL
7177
7178 return (E * std::exp(-E));
7179 }
7180
7181 G4double G4Abla::f(G4double E)
7182 {
7183 // FONCTION INTEGRALE DE FD(E)
7184 return (1.0 - (E + 1.0) * std::exp(-E));
7185 }
7186
7187 G4double G4Abla::fmaxhaz(G4double x)
7188 {
7189 return (-x * std::log(G4AblaRandom::flat()) - x * std::log(G4AblaRandom::flat()) -
7190 x * std::log(G4AblaRandom::flat()));
7191 }
7192
7193 G4double G4Abla::fmaxhaz_old(G4double T)
7194 {
7195 // tirage aleatoire dans une maxwellienne
7196 // t : temperature
7197 //
7198 // declaration des variables
7199 //
7200
7201 const G4int pSize = 101;
7202 G4double p[pSize];
7203
7204 // ial generateur pour le cascade (et les iy pour eviter les correlations)
7205 G4int i = 0;
7206 G4int itest = 0;
7207 // programme principal
7208
7209 // calcul des p(i) par approximation de newton
7210 p[pSize - 1] = 8.0;
7211 G4double x = 0.1;
7212 G4double x1 = 0.0;
7213 G4double y = 0.0;
7214
7215 if (itest == 1)
7216 {
7217 goto fmaxhaz120;
7218 }
7219
7220 for (i = 1; i <= 99; i++)
7221 {
7222 fmaxhaz20:
7223 x1 = x - (f(x) - G4double(i) / 100.0) / fd(x);
7224 x = x1;
7225 if (std::fabs(f(x) - G4double(i) / 100.0) < 1e-5)
7226 {
7227 goto fmaxhaz100;
7228 }
7229 goto fmaxhaz20;
7230 fmaxhaz100:
7231 p[i] = x;
7232 } // end do
7233
7234 // itest = 1;
7235 itest = 0;
7236 // tirage aleatoire et calcul du x correspondant
7237 // par regression lineaire
7238 fmaxhaz120:
7239 y = G4AblaRandom::flat();
7240 i = nint(y * 100);
7241
7242 // 2590 c ici on evite froidement les depassements de tableaux....(a.b.
7243 // 3/9/99)
7244 if (i == 0)
7245 {
7246 goto fmaxhaz120;
7247 }
7248
7249 if (i == 1)
7250 {
7251 x = p[i] * y * 100;
7252 }
7253 else
7254 {
7255 x = (p[i] - p[i - 1]) * (y * 100 - i) + p[i];
7256 }
7257
7258 return (x * T);
7259 }
7260
7261 void G4Abla::guet(G4double* x_par, G4double* z_par, G4double* find_par)
7262 {
7263 // TABLE DE MASSES ET FORMULE DE MASSE TIRE DU PAPIER DE BRACK-GUET
7264 // Gives the theoritical value for mass excess...
7265 // Revisee pour x, z flottants 25/4/2002
7266
7267 // real*8 x,z
7268 // dimension q(0:50,0:70)
7269 G4double x = (*x_par);
7270 G4double z = (*z_par);
7271 G4double find = (*find_par);
7272
7273 const G4int qrows = 50;
7274 const G4int qcols = 70;
7275 G4double q[qrows][qcols];
7276 for (G4int init_i = 0; init_i < qrows; init_i++)
7277 {
7278 for (G4int init_j = 0; init_j < qcols; init_j++)
7279 {
7280 q[init_i][init_j] = 0.0;
7281 }
7282 }
7283
7284 G4int ix = G4int(std::floor(x + 0.5));
7285 G4int iz = G4int(std::floor(z + 0.5));
7286 G4double zz = iz;
7287 G4double xx = ix;
7288 find = 0.0;
7289 G4double avol = 15.776;
7290 G4double asur = -17.22;
7291 G4double ac = -10.24;
7292 G4double azer = 8.0;
7293 G4double xjj = -30.03;
7294 G4double qq = -35.4;
7295 G4double c1 = -0.737;
7296 G4double c2 = 1.28;
7297
7298 if (ix <= 7)
7299 {
7300 q[0][1] = 939.50;
7301 q[1][1] = 938.21;
7302 q[1][2] = 1876.1;
7303 q[1][3] = 2809.39;
7304 q[2][4] = 3728.34;
7305 q[2][3] = 2809.4;
7306 q[2][5] = 4668.8;
7307 q[2][6] = 5606.5;
7308 q[3][5] = 4669.1;
7309 q[3][6] = 5602.9;
7310 q[3][7] = 6535.27;
7311 q[4][6] = 5607.3;
7312 q[4][7] = 6536.1;
7313 q[5][7] = 6548.3;
7314 find = q[iz][ix];
7315 }
7316 else
7317 {
7318 G4double xneu = xx - zz;
7319 G4double si = (xneu - zz) / xx;
7320 G4double x13 = std::pow(xx, .333);
7321 G4double ee1 = c1 * zz * zz / x13;
7322 G4double ee2 = c2 * zz * zz / xx;
7323 G4double aux = 1. + (9. * xjj / 4. / qq / x13);
7324 G4double ee3 = xjj * xx * si * si / aux;
7325 G4double ee4 = avol * xx + asur * (std::pow(xx, .666)) + ac * x13 + azer;
7326 G4double tota = ee1 + ee2 + ee3 + ee4;
7327 find = 939.55 * xneu + 938.77 * zz - tota;
7328 }
7329
7330 (*x_par) = x;
7331 (*z_par) = z;
7332 (*find_par) = find;
7333 }
7334 //
7335
7336 void G4Abla::FillData(G4int IMULTBU, G4int IEV_TAB)
7337 {
7338
7339 const G4double c = 29.9792458;
7340 const G4double fmp = 938.27231, fmn = 939.56563, fml = 1115.683;
7341
7342 varntp->ntrack = IMULTBU + IEV_TAB;
7343
7344 for (G4int i = 0; i < IMULTBU; i++)
7345 {
7346
7347 G4int iz = nint(BU_TAB[i][7]);
7348 G4int ia = nint(BU_TAB[i][8]);
7349 G4int is = nint(BU_TAB[i][11]);
7350
7351 Ainit = Ainit + ia;
7352 Zinit = Zinit + iz;
7353 Sinit = Sinit - is;
7354
7355 varntp->zvv.push_back(iz);
7356 varntp->avv.push_back(ia);
7357 varntp->svv.push_back(-1 * is);
7358 varntp->itypcasc.push_back(0);
7359
7360 G4double v2 = BU_TAB[i][4] * BU_TAB[i][4] + BU_TAB[i][5] * BU_TAB[i][5] + BU_TAB[i][6] * BU_TAB[i][6];
7361 G4double gamma = std::sqrt(1.0 - v2 / (c * c));
7362 G4double avvmass = iz * fmp + (ia - iz - is) * fmn + is * fml + eflmac(ia, iz, 0, 3);
7363 G4double etot = avvmass / gamma;
7364 varntp->pxlab.push_back(etot * BU_TAB[i][4] / c);
7365 varntp->pylab.push_back(etot * BU_TAB[i][5] / c);
7366 varntp->pzlab.push_back(etot * BU_TAB[i][6] / c);
7367 varntp->enerj.push_back(etot - avvmass);
7368 }
7369
7370 for (G4int i = 0; i < IEV_TAB; i++)
7371 {
7372
7373 G4int iz = nint(EV_TAB[i][0]);
7374 G4int ia = nint(EV_TAB[i][1]);
7375 G4int is = EV_TAB[i][5];
7376
7377 varntp->itypcasc.push_back(0);
7378
7379 if (ia > 0)
7380 { // normal particles
7381 varntp->zvv.push_back(iz);
7382 varntp->avv.push_back(ia);
7383 varntp->svv.push_back(-1 * is);
7384 Ainit = Ainit + ia;
7385 Zinit = Zinit + iz;
7386 Sinit = Sinit - is;
7387 G4double v2 = EV_TAB[i][2] * EV_TAB[i][2] + EV_TAB[i][3] * EV_TAB[i][3] + EV_TAB[i][4] * EV_TAB[i][4];
7388 G4double gamma = std::sqrt(1.0 - v2 / (c * c));
7389 G4double avvmass = iz * fmp + (ia - iz - is) * fmn + is * fml + eflmac(ia, iz, 0, 3);
7390 G4double etot = avvmass / gamma;
7391 varntp->pxlab.push_back(etot * EV_TAB[i][2] / c);
7392 varntp->pylab.push_back(etot * EV_TAB[i][3] / c);
7393 varntp->pzlab.push_back(etot * EV_TAB[i][4] / c);
7394 varntp->enerj.push_back(etot - avvmass);
7395 }
7396 else if (ia == -2)
7397 { // lambda0
7398 varntp->zvv.push_back(0);
7399 varntp->avv.push_back(1);
7400 varntp->svv.push_back(-1);
7401 Ainit = Ainit + 1;
7402 Sinit = Sinit - 1;
7403 G4double v2 = EV_TAB[i][2] * EV_TAB[i][2] + EV_TAB[i][3] * EV_TAB[i][3] + EV_TAB[i][4] * EV_TAB[i][4];
7404 G4double gamma = std::sqrt(1.0 - v2 / (c * c));
7405 G4double avvmass = fml;
7406 G4double etot = avvmass / gamma;
7407 varntp->pxlab.push_back(etot * EV_TAB[i][2] / c);
7408 varntp->pylab.push_back(etot * EV_TAB[i][3] / c);
7409 varntp->pzlab.push_back(etot * EV_TAB[i][4] / c);
7410 varntp->enerj.push_back(etot - avvmass);
7411 }
7412 else
7413 { // photons
7414 varntp->zvv.push_back(iz);
7415 varntp->avv.push_back(ia);
7416 varntp->svv.push_back(0);
7417 Ainit = Ainit + ia;
7418 Zinit = Zinit + iz;
7419 Sinit = Sinit - is;
7420 varntp->pxlab.push_back(EV_TAB[i][2]);
7421 varntp->pylab.push_back(EV_TAB[i][3]);
7422 varntp->pzlab.push_back(EV_TAB[i][4]);
7423 varntp->enerj.push_back(
7424 std::sqrt(EV_TAB[i][2] * EV_TAB[i][2] + EV_TAB[i][3] * EV_TAB[i][3] + EV_TAB[i][4] * EV_TAB[i][4]));
7425 }
7426 }
7427 //
7428 return;
7429 }
7430
7431 // Utilities
7432
7433 G4double G4Abla::min(G4double a, G4double b)
7434 {
7435 if (a < b)
7436 {
7437 return a;
7438 }
7439 else
7440 {
7441 return b;
7442 }
7443 }
7444
7445 G4int G4Abla::min(G4int a, G4int b)
7446 {
7447 if (a < b)
7448 {
7449 return a;
7450 }
7451 else
7452 {
7453 return b;
7454 }
7455 }
7456
7457 G4double G4Abla::max(G4double a, G4double b)
7458 {
7459 if (a > b)
7460 {
7461 return a;
7462 }
7463 else
7464 {
7465 return b;
7466 }
7467 }
7468
7469 G4int G4Abla::max(G4int a, G4int b)
7470 {
7471 if (a > b)
7472 {
7473 return a;
7474 }
7475 else
7476 {
7477 return b;
7478 }
7479 }
7480
7481 G4double G4Abla::DSIGN(G4double a, G4double b)
7482 {
7483 // A function that assigns the sign of the second argument to the
7484 // absolute value of the first
7485
7486 if (b >= 0)
7487 {
7488 return std::abs(a);
7489 }
7490 else
7491 {
7492 return -1.0 * std::abs(a);
7493 }
7494 return 0;
7495 }
7496
7497 G4int G4Abla::ISIGN(G4int a, G4int b)
7498 {
7499 // A function that assigns the sign of the second argument to the
7500 // absolute value of the first
7501
7502 if (b >= 0)
7503 {
7504 return std::abs(a);
7505 }
7506 else
7507 {
7508 return -1 * std::abs(a);
7509 }
7510 return 0;
7511 }
7512
7513 G4int G4Abla::nint(G4double number)
7514 {
7515 G4double intpart = 0.0;
7516 G4double fractpart = 0.0;
7517 fractpart = std::modf(number, &intpart);
7518 if (number == 0)
7519 {
7520 return 0;
7521 }
7522 if (number > 0)
7523 {
7524 if (fractpart < 0.5)
7525 {
7526 return G4int(std::floor(number));
7527 }
7528 else
7529 {
7530 return G4int(std::ceil(number));
7531 }
7532 }
7533 if (number < 0)
7534 {
7535 if (fractpart < -0.5)
7536 {
7537 return G4int(std::floor(number));
7538 }
7539 else
7540 {
7541 return G4int(std::ceil(number));
7542 }
7543 }
7544
7545 return G4int(std::floor(number));
7546 }
7547
7548 G4int G4Abla::secnds(G4int x)
7549 {
7550 time_t mytime;
7551 tm* mylocaltime;
7552
7553 time(&mytime);
7554 mylocaltime = localtime(&mytime);
7555
7556 if (x == 0)
7557 {
7558 return (mylocaltime->tm_hour * 60 * 60 + mylocaltime->tm_min * 60 + mylocaltime->tm_sec);
7559 }
7560 else
7561 {
7562 return G4int(mytime - x);
7563 }
7564 }
7565
7566 G4int G4Abla::mod(G4int a, G4int b)
7567 {
7568 if (b != 0)
7569 {
7570 return a % b;
7571 }
7572 else
7573 {
7574 return 0;
7575 }
7576 }
7577
7578 G4double G4Abla::dint(G4double x)
7579 {
7580 G4double value = 0.0;
7581 /*
7582 if(a < 0.0) {
7583 value = double(std::ceil(a));
7584 }
7585 else {
7586 value = double(std::floor(a));
7587 }
7588 */
7589 if (x - std::floor(x) <= std::ceil(x) - x)
7590 value = G4double(std::floor(x));
7591 else
7592 value = G4double(std::ceil(x));
7593
7594 return value;
7595 }
7596
7597 G4int G4Abla::idint(G4double x)
7598 {
7599 G4int value = 0;
7600 if (x - std::floor(x) <= std::ceil(x) - x)
7601 value = G4int(std::floor(x));
7602 else
7603 value = G4int(std::ceil(x));
7604
7605 return value;
7606 }
7607
7608 G4int G4Abla::idnint(G4double x)
7609 {
7610 if (x - std::floor(x) <= std::ceil(x) - x)
7611 return G4int(std::floor(x));
7612 else
7613 return G4int(std::ceil(x));
7614 }
7615
7616 G4double G4Abla::dmin1(G4double a, G4double b, G4double c)
7617 {
7618 if (a < b && a < c)
7619 {
7620 return a;
7621 }
7622 if (b < a && b < c)
7623 {
7624 return b;
7625 }
7626 if (c < a && c < b)
7627 {
7628 return c;
7629 }
7630 return a;
7631 }
7632
7633 G4double G4Abla::utilabs(G4double a) { return std::abs(a); }
7634
7635 G4double G4Abla::width(G4double AMOTHER,
7636 G4double ZMOTHER,
7637 G4double APART,
7638 G4double ZPART,
7639 G4double TEMP,
7640 G4double B1,
7641 G4double SB1,
7642 G4double EXC)
7643 {
7644 /*
7645 * Implemented by JLRS for Abla c++: 06/11/2016
7646 *
7647 C Last update:
7648 C 28/10/13 - JLRS - from abrablav4 (AK)
7649 */
7650 G4int IZPART, IAPART, NMOTHER;
7651 G4double B, HBAR, PI, RGEOM, MPART, SB;
7652 G4double BKONST, C, C2, G, APARTNER, MU;
7653 G4double INT1, INT2, INT3, AKONST, EARG, R0, MPARTNER;
7654 G4double AEXP;
7655 G4double ARG;
7656 G4double PAR_A1 = 0., PAR_B1 = 0., FACT = 1.;
7657 G4double fwidth = 0.;
7658 G4int idlamb0 = 0;
7659 PI = 3.141592654;
7660
7661 if (ZPART == -2.)
7662 {
7663 ZPART = 0.;
7664 idlamb0 = 1;
7665 }
7666
7667 IZPART = idnint(ZPART);
7668 IAPART = idnint(APART);
7669
7670 B = B1;
7671 SB = SB1;
7672 NMOTHER = idnint(AMOTHER - ZMOTHER);
7673
7674 PAR_A1 = 0.0;
7675 PAR_B1 = 0.0;
7676
7677 if (SB > EXC)
7678 {
7679 return fwidth = 0.0;
7680 }
7681 else
7682 {
7683 // in MeV*s
7684 HBAR = 6.582122e-22;
7685 // HBAR2 = HBAR * HBAR
7686 // in m/s
7687 C = 2.99792458e8;
7688 C2 = C * C;
7689 APARTNER = AMOTHER - APART;
7690 MPARTNER = APARTNER * 931.49 / C2;
7691
7692 // g=(2s+1)
7693 if (IAPART == 1 && IZPART == 0)
7694 {
7695 G = 2.0;
7696 MPART = 939.56 / C2;
7697 if (idlamb0 == 1)
7698 MPART = 1115.683 / C2;
7699 }
7700 else
7701 {
7702 if (IAPART == 1 && IZPART == 1)
7703 {
7704 G = 2.0;
7705 MPART = 938.27 / C2;
7706 }
7707 else
7708 {
7709 if (IAPART == 2 && IZPART == 0)
7710 {
7711 G = 1.0;
7712 MPART = 2. * 939.56 / C2;
7713 }
7714 else
7715 {
7716 if (IAPART == 2 && IZPART == 1)
7717 {
7718 G = 3.0;
7719 MPART = 1876.10 / C2;
7720 }
7721 else
7722 {
7723 if (IAPART == 3 && IZPART == 1)
7724 {
7725 G = 2.0;
7726 MPART = 2809.39 / C2;
7727 }
7728 else
7729 {
7730 if (IAPART == 3 && IZPART == 2)
7731 {
7732 G = 2.0;
7733 MPART = 2809.37 / C2;
7734 }
7735 else
7736 {
7737 if (IAPART == 4 && IZPART == 2)
7738 {
7739 G = 1.0;
7740 MPART = 3728.35 / C2;
7741 }
7742 else
7743 {
7744 // IMF
7745 G = 1.0;
7746 MPART = APART * 931.49 / C2;
7747 }
7748 }
7749 }
7750 }
7751 }
7752 }
7753 } // end g
7754
7755 // Relative mass in MeV*s^2/m^2
7756 MU = MPARTNER * MPART / (MPARTNER + MPART);
7757 // in m
7758 R0 = 1.16e-15;
7759
7760 RGEOM = R0 * (std::pow(APART, 1.0 / 3.0) + std::pow(AMOTHER - APART, 1.0 / 3.0));
7761
7762 // in m*sqrt(MeV)
7763 AKONST = HBAR * std::sqrt(1.0 / MU);
7764
7765 // in 1/(MeV*m^2)
7766 BKONST = MPART / (PI * PI * HBAR * HBAR);
7767 //
7768 // USING ANALYTICAL APPROXIMATION
7769
7770 INT1 = 2.0 * std::pow(TEMP, 3.) / (2.0 * TEMP + B);
7771
7772 ARG = std::sqrt(B / TEMP);
7773 EARG = (erf(ARG) - 1.0);
7774 if (std::abs(EARG) < 1.e-9)
7775 EARG = 0.0;
7776 if (B == 0.0)
7777 {
7778 INT2 = 0.5 * std::sqrt(PI) * std::pow(TEMP, 3.0 / 2.0);
7779 }
7780 else
7781 {
7782 AEXP = B / TEMP;
7783 if (AEXP > 700.0)
7784 AEXP = 700.0;
7785 INT2 = (2.0 * B * B + TEMP * B) / std::sqrt(B) +
7786 std::exp(AEXP) * std::sqrt(PI / (4.0 * TEMP)) * (4.0 * B * B + 4.0 * B * TEMP - TEMP * TEMP) * EARG;
7787 if (INT2 < 0.0)
7788 INT2 = 0.0;
7789 // For very low temperatures when EARG=0, INT2 get unreasonably high
7790 // values comming from the first term. Therefore, for these cases INT2 is
7791 // set to 0.
7792 if (EARG == 0.0)
7793 INT2 = 0.0;
7794 } // if B
7795
7796 INT3 = 2.0 * TEMP * TEMP * TEMP / (2.0 * TEMP * TEMP + 4.0 * B * TEMP + B * B);
7797
7798 if (IZPART < -1.0 && ZMOTHER < 151.0)
7799 {
7800 // IF(IZPART.LT.1)THEN
7801 // For neutrons, the width is given by a mean value between geometrical
7802 // and QM values; Only QM contribution (Rgeom -> Rgeom + Rlamda) seems to
7803 // be too strong for neutrons
7804 fwidth = PI * BKONST * G *
7805 std::sqrt((RGEOM * RGEOM * INT1 + 2.0 * AKONST * RGEOM * INT2 + AKONST * AKONST * INT3) * RGEOM *
7806 RGEOM * INT1);
7807 }
7808 else
7809 {
7810 fwidth = PI * BKONST * G * (RGEOM * RGEOM * INT1 + 2.0 * AKONST * RGEOM * INT2 + AKONST * AKONST * INT3);
7811 }
7812
7813 // To correct for too high values of analytical width compared to
7814 // numerical solution for energies close to the particle threshold:
7815 if (IZPART < 3.0)
7816 {
7817 if (AMOTHER < 155.0)
7818 {
7819 PAR_A1 = std::exp(2.302585 * 0.2083 * std::exp(-0.01548472 * AMOTHER)) - 0.05;
7820 PAR_B1 = 0.59939389 + 0.00915657 * AMOTHER;
7821 }
7822 else
7823 {
7824 if (AMOTHER > 154.0 && AMOTHER < 195.0)
7825 {
7826 PAR_A1 = 1.0086961 - 8.629e-5 * AMOTHER;
7827 PAR_B1 = 1.5329331 + 0.00302074 * AMOTHER;
7828 }
7829 else
7830 {
7831 if (AMOTHER > 194.0 && AMOTHER < 208.0)
7832 {
7833 PAR_A1 = 9.8356347 - 0.09294663 * AMOTHER + 2.441e-4 * AMOTHER * AMOTHER;
7834 PAR_B1 = 7.7701987 - 0.02897401 * AMOTHER;
7835 }
7836 else
7837 {
7838 if (AMOTHER > 207.0 && AMOTHER < 228.0)
7839 {
7840 PAR_A1 = 15.107385 - 0.12414415 * AMOTHER + 2.7222e-4 * AMOTHER * AMOTHER;
7841 PAR_B1 = -64.078009 + 0.56813179 * AMOTHER - 0.00121078 * AMOTHER * AMOTHER;
7842 }
7843 else
7844 {
7845 if (AMOTHER > 227.0)
7846 {
7847 if (mod(NMOTHER, 2) == 0 && NMOTHER > 147.)
7848 {
7849 PAR_A1 = 2.0 * (0.9389118 + 6.4559e-5 * AMOTHER);
7850 }
7851 else
7852 {
7853 if (mod(NMOTHER, 2) == 1)
7854 PAR_A1 = 3.0 * (0.9389118 + 6.4559e-5 * AMOTHER);
7855 }
7856 PAR_B1 = 2.1507177 + 0.00146119 * AMOTHER;
7857 }
7858 }
7859 }
7860 }
7861 }
7862 FACT = std::exp((2.302585 * PAR_A1 * std::exp(-PAR_B1 * (EXC - SB))));
7863 if (FACT < 1.0)
7864 FACT = 1.0;
7865 if (IZPART < -1. && ZMOTHER < 151.0)
7866 {
7867 // IF(IZPART.LT.1)THEN
7868 fwidth = fwidth / std::sqrt(FACT);
7869 }
7870 else
7871 {
7872 fwidth = fwidth / FACT;
7873 }
7874 } // if IZPART<3.0
7875
7876 if (fwidth <= 0.0)
7877 {
7878 std::cout << "LOOK IN PARTICLE_WIDTH!" << std::endl;
7879 std::cout << "ACN,APART :" << AMOTHER << APART << std::endl;
7880 std::cout << "EXC,TEMP,B,SB :" << EXC << " " << TEMP << " " << B << " " << SB << std::endl;
7881 std::cout << "INTi, i=1-3 :" << INT1 << " " << INT2 << " " << INT3 << std::endl;
7882 std::cout << " " << std::endl;
7883 }
7884
7885 } // if SB>EXC
7886 return fwidth;
7887 }
7888
7889 G4double G4Abla::pen(G4double A, G4double ap, G4double omega, G4double T)
7890 {
7891 // JLRS: 06/11/2016
7892 // CORRECTIONS FOR BARRIER PENETRATION
7893 // AK, KHS 2005 - Energy-dependen inverse cross sections included, influence
7894 // of
7895 // Coulomb barrier for LCP, tunnelling for LCP
7896
7897 G4double fpen = 0., MU, HO;
7898
7899 // REDUCED MASSES (IN MeV/C**2)
7900 MU = (A - ap) * ap / A;
7901
7902 // ENERGY OF THE INVERSE PARABOLA AT THE POTENTIAL BARRIER (hbar*omega);
7903 // HERE hbar = 197.3287 fm*MeV/c, omega is in c/fm
7904 HO = 197.3287 * omega;
7905
7906 if (T <= 0.0)
7907 {
7908 fpen = 0.0;
7909 }
7910 else
7911 {
7912 fpen = std::pow(10.0, 4.e-4 * std::pow(T / (HO * HO * std::pow(MU, 0.25)), -4.3 / 2.3026));
7913 }
7914
7915 return fpen;
7916 }
7917
7918 void G4Abla::bsbkbc(G4double A, G4double Z, G4double* BS, G4double* BK, G4double* BC)
7919 {
7920 // Calculate BS and BK needed for a level-density parameter:
7921 // BETA2 and BETA4 = quadrupole and hexadecapole deformation
7922
7923 G4double PI = 3.14159265;
7924 G4int IZ = idnint(Z);
7925 G4int IN = idnint(A - Z);
7926 // alphaN = sqrt(2*N/(4*pi))*BetaN
7927 G4double ALPHA2 = std::sqrt(5.0 / (4.0 * PI)) * ecld->beta2[IN][IZ];
7928 G4double ALPHA4 = std::sqrt(9.0 / (4.0 * PI)) * ecld->beta4[IN][IZ];
7929
7930 (*BS) = 1.0 + 0.4 * ALPHA2 * ALPHA2 - 4.0 / 105.0 * ALPHA2 * ALPHA2 * ALPHA2 -
7931 66.0 / 175.0 * ALPHA2 * ALPHA2 * ALPHA2 * ALPHA2 - 4.0 / 35.0 * ALPHA2 * ALPHA2 * ALPHA4 + ALPHA4 * ALPHA4;
7932
7933 (*BK) = 1.0 + 0.4 * ALPHA2 * ALPHA2 + 16.0 / 105.0 * ALPHA2 * ALPHA2 * ALPHA2 -
7934 82.0 / 175.0 * ALPHA2 * ALPHA2 * ALPHA2 * ALPHA2 + 2.0 / 35.0 * ALPHA2 * ALPHA2 * ALPHA4 + ALPHA4 * ALPHA4;
7935
7936 (*BC) = 0.0;
7937
7938 return;
7939 }
7940
7941 G4double G4Abla::fvmaxhaz(G4double T)
7942 {
7943 // Random generator according to a distribution similar to a
7944 // Maxwell distribution with quantum-mech. x-section for charged particles
7945 // according to KHS
7946 // Y = X**(1.5E0) / (B+X) * EXP(-X/T) (approximation:)
7947
7948 return (
7949 3.0 * T *
7950 std::pow(-1. * std::log(G4AblaRandom::flat()) * std::log(G4AblaRandom::flat()) * std::log(G4AblaRandom::flat()),
7951 0.333333));
7952 }
7953
7954 G4double
7955 G4Abla::func_trans(G4double TIME, G4double ZF, G4double AF, G4double bet, G4double Y, G4double FT, G4double T_0)
7956 {
7957 /*
7958 c This function determines the fission width as a function o time
7959 c according to the analytical solution of the FPE for the probability
7960 distribution c at the barrier when the nucleus potential is aproximated by a
7961 parabolic c potential. It is taken from S. Chandrasekhar, Rev. Mod. Phys. 15
7962 (1943) 1
7963 c
7964 c***********************INPUT PARAMETERS*********************************
7965 c Time Time at which we evaluate the fission width
7966 c ZF Z of nucleus
7967 C AF A of nucleus
7968 c BET Reduced dissipation coefficient
7969 c FT Nuclear temperature
7970 C**************************************************************************
7971 C********************************OUTPUT***********************************
7972 C Fission decay width at the corresponding time of the decay cascade
7973 C*************************************************************************
7974 c****************************OTHER VARIABLES******************************
7975 C SIGMA_SQR Square of the width of the prob. distribution
7976 C XB Deformation of the nucleus at the saddle point
7977 c NORM Normalization factor of the probability distribution
7978 c W Probability distribution at the saddle deformation XB
7979 c W_INFIN Probability distr. at XB at infinite time
7980 c MFCD Mass of the fission collective degree of freedom
7981 C*************************************************************************
7982 */
7983 G4double PI = 3.14159;
7984 G4double DEFO_INIT, OMEGA, HOMEGA, OMEGA_GS, HOMEGA_GS, K1, MFCD;
7985 G4double BET1, XACT, SIGMA_SQR, W_EXP, XB, NORM, SIGMA_SQR_INF, W_INFIN, W;
7986 G4double FUNC_TRANS, LOG_SLOPE_INF, LOG_SLOPE_ABS;
7987 //
7988 // Influence of initial deformation
7989 // Initial alpha2 deformation (GS)
7990 DEFO_INIT = std::sqrt(5.0 / (4.0 * PI)) * ecld->beta2[fiss->at - fiss->zt][fiss->zt];
7991 //
7992 fomega_sp(AF, Y, &MFCD, &OMEGA, &HOMEGA);
7993 fomega_gs(AF, ZF, &K1, &OMEGA_GS, &HOMEGA_GS);
7994 //
7995 // Determination of the square of the width of the probability distribution
7996 // For the overdamped regime BET**2 > 4*OMEGA**2
7997 if ((bet * bet) > 4.0 * OMEGA_GS * OMEGA_GS)
7998 {
7999 BET1 = std::sqrt(bet * bet - 4.0 * OMEGA_GS * OMEGA_GS);
8000 //
8001 // REMEMBER THAT HOMEGA IS ACTUALLY HBAR*HOMEGA1=1MeV
8002 // SO THAT HOMEGA1 = HOMEGA/HBAR
8003 //
8004 SIGMA_SQR =
8005 (FT / K1) *
8006 (1.0 -
8007 ((2.0 * bet * bet / (BET1 * BET1) *
8008 (0.5 * (std::exp(0.50 * (BET1 - bet) * 1.e21 * TIME) - std::exp(0.5 * (-BET1 - bet) * 1.e21 * TIME))) *
8009 (0.5 * (std::exp(0.50 * (BET1 - bet) * 1.e21 * TIME) - std::exp(0.5 * (-BET1 - bet) * 1.e21 * TIME)))) +
8010 (bet / BET1 * 0.50 * (std::exp((BET1 - bet) * 1.e21 * TIME) - std::exp((-BET1 - bet) * 1.e21 * TIME))) +
8011 1. * std::exp(-bet * 1.e21 * TIME)));
8012 //
8013 // Evolution of the mean x-value (KHS March 2006)
8014 XACT = DEFO_INIT * std::exp(-0.5 * (bet - BET1) * 1.e21 * (TIME - T_0));
8015 //
8016 }
8017 else
8018 {
8019 // For the underdamped regime BET**2 < 4*HOMEGA**2 BET1 becomes a complex
8020 // number and the expression with sinh and cosh can be transformed in one
8021 // with sin and cos
8022 BET1 = std::sqrt(4.0 * OMEGA_GS * OMEGA_GS - bet * bet);
8023 SIGMA_SQR = FT / K1 *
8024 (1. - std::exp(-1.0 * bet * 1.e21 * TIME) *
8025 (bet * bet / (BET1 * BET1) * (1. - std::cos(BET1 * 1.e21 * TIME)) +
8026 bet / BET1 * std::sin(BET1 * 1.e21 * TIME) + 1.0));
8027 XACT = DEFO_INIT * std::cos(0.5 * BET1 * 1.e21 * (TIME - T_0)) * std::exp(-bet * 1.e21 * (TIME - T_0));
8028 }
8029
8030 // Determination of the deformation at the saddle point according to
8031 // "Geometrical relationships of Macroscopic Nucl. Phys." from Hass and Myers
8032 // page 100 This corresponds to alpha2 deformation.
8033 XB = 7. / 3. * Y - 938. / 765. * Y * Y + 9.499768 * Y * Y * Y - 8.050944 * Y * Y * Y * Y;
8034 //
8035 // Determination of the probability distribution at the saddle deformation
8036 //
8037 if (SIGMA_SQR > 0.0)
8038 {
8039 NORM = 1. / std::sqrt(2. * PI * SIGMA_SQR);
8040 //
8041 W_EXP = -1. * (XB - XACT) * (XB - XACT) / (2.0 * SIGMA_SQR);
8042 if (W_EXP < (-708.0))
8043 W_EXP = -708.0;
8044 W = NORM * std::exp(W_EXP) * FT / (K1 * SIGMA_SQR);
8045 }
8046 else
8047 {
8048 W = 0.0;
8049 }
8050 //
8051 // Determination of the fission decay width, we assume we are in the
8052 // overdamped regime
8053 //
8054 SIGMA_SQR_INF = FT / K1;
8055 W_EXP = -XB * XB / (2.0 * SIGMA_SQR_INF);
8056 if (W_EXP < (-708.0))
8057 W_EXP = -708.0;
8058 W_INFIN = std::exp(W_EXP) / std::sqrt(2.0 * PI * SIGMA_SQR_INF);
8059 FUNC_TRANS = W / W_INFIN;
8060 //
8061 // Correction for the variation of the mean velocity at the fission barrier
8062 // (see B. Jurado et al, Nucl. Phys. A747, p. 14)
8063 //
8064 LOG_SLOPE_INF = cram(bet, HOMEGA) * bet * MFCD * OMEGA / FT;
8065 LOG_SLOPE_ABS = (XB - XACT) / SIGMA_SQR - XB / SIGMA_SQR_INF + cram(bet, HOMEGA) * bet * MFCD * OMEGA / FT;
8066 //
8067 FUNC_TRANS = FUNC_TRANS * LOG_SLOPE_ABS / LOG_SLOPE_INF;
8068 //
8069 return FUNC_TRANS;
8070 }
8071
8072 void G4Abla::part_fiss(G4double BET,
8073 G4double GP,
8074 G4double GF,
8075 G4double Y,
8076 G4double TAUF,
8077 G4double TS1,
8078 G4double TSUM,
8079 G4int* CHOICE,
8080 G4double ZF,
8081 G4double AF,
8082 G4double FT,
8083 G4double* T_LAPSE,
8084 G4double* GF_LOC)
8085 {
8086 /*
8087 C THIS SUBROUTINE IS AIMED TO CHOOSE BETWEEN PARTICLE EMISSION
8088 C AND FISSION
8089 C WE USE MONTE-CARLO METHODS AND SAMPLE TIME BETWEEN T=0 AND T=1.5*TAUF
8090 c TO SIMULATE THE TRANSIENT TIME WITH 30 STEPS (0.05*TAUF EACH)
8091 C FOR t>1.5*TAUF , GF=CONSTANT=ASYMPTOTICAL VALUE (INCLUDING KRAMERS
8092 FACTOR)
8093 c------------------------------------------------------------------------
8094 c Modifications introduced by BEATRIZ JURADO 18/10/01:
8095 c 1. Now this subrutine is included in the rutine direct
8096 c 2. TSUM does not include the current particle decay time
8097 C 3. T_LAPSE is the time until decay, taken as an output variable
8098 C 4. GF_LOC is also taken as an output variable
8099 C 5. BET (Diss. Coeff.) and HOMEGA (Frequency at the ground state
8100 c are included as input variables because they are needed for FUNC_TRANS
8101 C-----------------------------------------------------------------------
8102 C ON INPUT:
8103 C GP Partial particle decay width
8104 C GF Asymptotic value of Gamma-f, including Kramers
8105 factor C AF Mass number of nucleus C TAUF
8106 Transient time C TS1 Partial particle decay time for the
8107 next step C TSUM Total sum of partial particle decay
8108 times, including C the next expected one, which
8109 is in competition C with fission now C ZF
8110 Z of nucleus C AF A of nucleus
8111 C-----------------------------------------------------------------------
8112 C ON OUTPUT:
8113 C CHOICE Key for decay mode: 0 = no decay (only internal)
8114 C 1 = evaporation
8115 C 2 = fission
8116 C-----------------------------------------------------------------------
8117 C VARIABLES:
8118 C GP Partial particle decay width
8119 C GF Asymptotic value of Gamma-f, including Kramers
8120 factor C TAUF Transient time C TS1 Partial particle
8121 decay time C TSUM Total sum of partial particle decay
8122 times C CHOICE Key for decay mode C ZF Z of nucleus
8123 C AF A of nucleus
8124 C FT Used for Fermi function in FUNC_TRANS
8125 C STEP_LENGTH Step in time to sample different decays
8126 C BEGIN_TIME Total sum of partial particle decay times,
8127 excluding C the next expected one, which is in
8128 competition C with fission now C LOC_TIME_BEGIN
8129 Begin of time interval considered in one step C LOC_TIME_END End
8130 of time interval considered in one step C GF_LOC In-grow
8131 function for fission width, c normalized to
8132 asymptotic value C TS2 Effective partial fission decay
8133 time in one time step C HBAR hbar C T_LAPSE
8134 Effective decay time in one time step C REAC_PROB Reaction
8135 probability in one time step C X Help variable for
8136 random generator
8137 C------------------------------------------------------------------------
8138 */
8139 G4double K1, OMEGA, HOMEGA, t_0, STEP_LENGTH, LOC_TIME_BEGIN, LOC_TIME_END = 0., BEGIN_TIME = 0., FISS_PROB, X, TS2,
8140 LAMBDA, REAC_PROB;
8141 G4double HBAR = 6.582122e-22;
8142 G4int fchoice = 0;
8143 G4double fGF_LOC = 0., fT_LAPSE = 0.;
8144 //
8145 if (GF <= 0.0)
8146 {
8147 *CHOICE = 1;
8148 *T_LAPSE = TS1;
8149 *GF_LOC = 0.0;
8150 goto direct107;
8151 }
8152 //
8153 fomega_gs(AF, ZF, &K1, &OMEGA, &HOMEGA);
8154 //
8155 // ****************************************************************
8156 // Calculation of the shift in time due to the initial conditions
8157 //
8158 // Overdamped regime
8159 if (BET * BET > 4.0 * OMEGA * OMEGA)
8160 {
8161 // REMEMBER THAT HOMEGA IS ACTUALLY HBAR*HOMEGA1=1MeV
8162 // SO THAT HOMEGA1 = HOMEGA/HBAR
8163 // Additional factor 1/16 proposed by KHS on 14/7/2010. Takes into
8164 // account the fact that the curvature of the potential is ~16 times
8165 // larger than what predicted by the liquid drop model, because of
8166 // shell effects.
8167 t_0 = BET * 1.e21 * HBAR * HBAR / (4. * HOMEGA * FT) / 16.;
8168 }
8169 else
8170 {
8171 // Underdamped regime
8172 if (((2. * FT - HOMEGA / 16.) > 0.000001) && BET > 0.0)
8173 {
8174 // Additional factor 1/16 proposed by KHS on 14/7/2010. Takes into
8175 // account the fact that the curvature of the potential is ~16 times
8176 // larger than what predicted by the liquid drop model, because of
8177 // shell effects.
8178 t_0 = (std::log(2. * FT / (2. * FT - HOMEGA / 16.))) / (BET * 1.e21);
8179 }
8180 else
8181 {
8182 // Neglect fission transients if the time shift t_0 is too
8183 // large. Suppresses large, spurious fission cross section at very
8184 // low excitation energy in p+Ta.
8185 //
8186 fchoice = 0;
8187 goto direct106;
8188 }
8189 }
8190 // ********************************************************************+
8191 fchoice = 0;
8192 STEP_LENGTH = 1.5 * TAUF / 50.;
8193 //
8194 // AT FIRST WE CACULATE THE REAL CURRENT TIME
8195 // TSUM includes only the time elapsed in the previous steps
8196 //
8197 BEGIN_TIME = TSUM + t_0;
8198 //
8199 if (BEGIN_TIME < 0.0)
8200 std::cout << "CURRENT TIME < 0" << BEGIN_TIME << std::endl;
8201 //
8202 if (BEGIN_TIME < 1.50 * TAUF)
8203 {
8204 LOC_TIME_BEGIN = BEGIN_TIME;
8205 //
8206 while ((LOC_TIME_BEGIN < 1.5 * TAUF) && fchoice == 0)
8207 {
8208
8209 LOC_TIME_END = LOC_TIME_BEGIN + STEP_LENGTH;
8210 //
8211 // NOW WE ESTIMATE THE MEAN VALUE OF THE FISSION WIDTH WITHIN THE SMALL
8212 // INTERVAL
8213 fGF_LOC = (func_trans(LOC_TIME_BEGIN, ZF, AF, BET, Y, FT, t_0) +
8214 func_trans(LOC_TIME_END, ZF, AF, BET, Y, FT, t_0)) /
8215 2.0;
8216 //
8217 fGF_LOC = fGF_LOC * GF;
8218
8219 // TS2 IS THE MEAN DECAY TIME OF THE FISSION CHANNEL
8220 if (fGF_LOC > 0.0)
8221 {
8222 TS2 = HBAR / fGF_LOC;
8223 }
8224 else
8225 {
8226 TS2 = 0.0;
8227 }
8228 //
8229 if (TS2 > 0.0)
8230 {
8231 LAMBDA = 1.0 / TS1 + 1.0 / TS2;
8232 }
8233 else
8234 {
8235 LAMBDA = 1.0 / TS1;
8236 }
8237 //
8238 // This is the probability to survive the decay at this step
8239 REAC_PROB = std::exp(-1.0 * STEP_LENGTH * LAMBDA);
8240 // I GENERATE A RANDOM NUMBER
8241 X = G4AblaRandom::flat();
8242 if (X > REAC_PROB)
8243 {
8244 // THEN THE EVAPORATION OR FISSION HAS OCCURED
8245 FISS_PROB = fGF_LOC / (fGF_LOC + GP);
8246 X = G4AblaRandom::flat();
8247 // WRITE(6,*)'X=',X
8248 if (X < FISS_PROB)
8249 {
8250 // FISSION OCCURED
8251 fchoice = 2;
8252 }
8253 else
8254 {
8255 // EVAPORATION OCCURED
8256 fchoice = 1;
8257 }
8258 } // if x
8259 LOC_TIME_BEGIN = LOC_TIME_END;
8260 } // while
8261 // Take the real decay time of this decay step
8262 fT_LAPSE = LOC_TIME_END - BEGIN_TIME;
8263 } // if BEGIN_TIME
8264 //
8265 // NOW, IF NOTHING HAPPENED DURING TRANSIENT TIME
8266 direct106:
8267 if (fchoice == 0)
8268 {
8269 fGF_LOC = GF;
8270 FISS_PROB = GF / (GF + GP);
8271
8272 // Added for cases where already at the beginning BEGIN_TIME > 1.5d0*TAUF
8273 if (GF > 0.0)
8274 {
8275 TS2 = HBAR / GF;
8276 }
8277 else
8278 {
8279 TS2 = 0.0;
8280 }
8281
8282 if (TS2 > 0.0)
8283 {
8284 LAMBDA = 1. / TS1 + 1. / TS2;
8285 }
8286 else
8287 {
8288 LAMBDA = 1. / TS1;
8289 }
8290 //
8291 X = G4AblaRandom::flat();
8292
8293 if (X < FISS_PROB)
8294 {
8295 // FISSION OCCURED
8296 fchoice = 2;
8297 }
8298 else
8299 {
8300 // EVAPORATION OCCURED
8301 fchoice = 1;
8302 }
8303 //
8304 // TIRAGE ALEATOIRE DANS UNE EXPONENTIELLLE : Y=EXP(-X/T)
8305 // EXPOHAZ=-T*LOG(HAZ(K))
8306 fT_LAPSE = fT_LAPSE - 1.0 / LAMBDA * std::log(G4AblaRandom::flat());
8307 }
8308 //
8309 direct107:
8310
8311 (*T_LAPSE) = fT_LAPSE;
8312 (*GF_LOC) = fGF_LOC;
8313 (*CHOICE) = fchoice;
8314 return;
8315 }
8316
8317 G4double G4Abla::tunnelling(G4double A,
8318 G4double ZPRF,
8319 G4double Y,
8320 G4double EE,
8321 G4double EF,
8322 G4double TEMP,
8323 G4double DENSG,
8324 G4double DENSF,
8325 G4double ENH_FACT)
8326 {
8327 // Subroutine to caluclate fission width with included effects
8328 // of tunnelling through the fission barrier
8329
8330 G4double PI = 3.14159;
8331 G4int IZ, IN;
8332 G4double MFCD, OMEGA, HOMEGA1, HOMEGA2 = 0., GFTUN;
8333 G4double E1, E2, EXP_FACT, CORR_FUNCT, FACT1, FACT2, FACT3;
8334
8335 IZ = idnint(ZPRF);
8336 IN = idnint(A - ZPRF);
8337
8338 // For low energies system "sees" LD barrier
8339 fomega_sp(A, Y, &MFCD, &OMEGA, &HOMEGA1);
8340
8341 if (mod(IN, 2) == 0 && mod(IZ, 2) == 0)
8342 { // e-e
8343 // Due to pairing gap, even-even nuclei cannot tunnel for excitation energy
8344 // lower than pairing gap (no levels at which system can be)
8345 EE = EE - 12.0 / std::sqrt(A);
8346 HOMEGA2 = 1.04;
8347 }
8348
8349 if (mod(IN, 2) == 1 && mod(IZ, 2) == 1)
8350 { // o-o
8351 HOMEGA2 = 0.65;
8352 }
8353
8354 if (mod(IN, 2) == 1 && mod(IZ, 2) == 0)
8355 { // o-e
8356 HOMEGA2 = 0.8;
8357 }
8358
8359 if (mod(IN, 2) == 0 && mod(IZ, 2) == 1)
8360 { // e-0
8361 HOMEGA2 = 0.8;
8362 }
8363
8364 E1 = EF + HOMEGA1 / 2.0 / PI * std::log(HOMEGA1 * (2.0 * PI + HOMEGA2) / 4.0 / PI / PI);
8365
8366 E2 = EF + HOMEGA2 / (2.0 * PI) * std::log(1.0 + 2.0 * PI / HOMEGA2);
8367
8368 // AKH May 2013 - Due to approximations in the analytical integration, at
8369 // energies just above barrier Pf was to low, at energies below barrier it was
8370 // somewhat higher. LInes below are supposed to correct for this. Factor 0.20
8371 // in EXP_FACT comes from the slope of the Pf(Eexc) (Gavron's data) around
8372 // fission barrier.
8373 EXP_FACT = (EE - EF) / (HOMEGA2 / (2.0 * PI));
8374 if (EXP_FACT > 700.0)
8375 EXP_FACT = 700.0;
8376 CORR_FUNCT = HOMEGA1 * (1.0 - 1.0 / (1.0 + std::exp(EXP_FACT)));
8377 if (mod(IN, 2) == 0 && mod(IZ, 2) == 0)
8378 {
8379 CORR_FUNCT = HOMEGA1 * (1.0 - 1.0 / (1.0 + std::exp(EXP_FACT)));
8380 }
8381
8382 FACT1 = HOMEGA1 / (2.0 * PI * TEMP + HOMEGA1);
8383 FACT2 = (2.0 * PI / (2.0 * PI + HOMEGA2) - HOMEGA1 * (2.0 * PI + HOMEGA2) / 4.0 / PI / PI) / (E2 - E1);
8384 FACT3 = HOMEGA2 / (2.0 * PI * TEMP - HOMEGA2);
8385
8386 if (EE < E1)
8387 {
8388 GFTUN = FACT1 *
8389 (std::exp(EE / TEMP) * std::exp(2.0 * PI * (EE - EF) / HOMEGA1) - std::exp(-2.0 * PI * EF / HOMEGA1));
8390 }
8391 else
8392 {
8393 if (EE >= E1 && EE < E2)
8394 {
8395 GFTUN = std::exp(EE / TEMP) * (0.50 + FACT2 * (EE - EF - TEMP)) -
8396 std::exp(E1 / TEMP) * (0.5 + FACT2 * (E1 - EF - TEMP)) +
8397 FACT1 * (std::exp(E1 / TEMP) * std::exp(2.0 * PI * (E1 - EF) / HOMEGA1) -
8398 std::exp(-2.0 * PI * EF / HOMEGA1));
8399 }
8400 else
8401 {
8402 GFTUN = std::exp(EE / TEMP) * (1.0 + FACT3 * std::exp(-2.0 * PI * (EE - EF) / HOMEGA2)) -
8403 std::exp(E2 / TEMP) * (1.0 + FACT3 * std::exp(-2.0 * PI * (E2 - EF) / HOMEGA2)) +
8404 std::exp(E2 / TEMP) * (0.5 + FACT2 * (E2 - EF - TEMP)) -
8405 std::exp(E1 / TEMP) * (0.5 + FACT2 * (E1 - EF - TEMP)) +
8406 FACT1 * (std::exp(E1 / TEMP) * std::exp(2.0 * PI * (E1 - EF) / HOMEGA1) -
8407 std::exp(-2.0 * PI * EF / HOMEGA1));
8408 }
8409 }
8410 GFTUN = GFTUN / std::exp(EE / TEMP) * DENSF * ENH_FACT / DENSG / 2.0 / PI;
8411 GFTUN = GFTUN * CORR_FUNCT;
8412 return GFTUN;
8413 }
8414
8415 void G4Abla::fission_width(G4double ZPRF,
8416 G4double A,
8417 G4double EE,
8418 G4double BS,
8419 G4double BK,
8420 G4double EF,
8421 G4double Y,
8422 G4double* GF,
8423 G4double* TEMP,
8424 G4double JPR,
8425 G4int IEROT,
8426 G4int FF_ALLOWED,
8427 G4int OPTCOL,
8428 G4int OPTSHP,
8429 G4double DENSG)
8430 {
8431 //
8432 G4double FNORM, MASS_ASYM_SADD_B, FP_PER, FP_PAR, SIG_PER_SP, SIG_PAR_SP;
8433 G4double Z2OVERA, ftemp, fgf, DENSF, ECOR, EROT, qr;
8434 G4double DCR, UCR, ENH_FACTA, ENH_FACTB, ENH_FACT, PONFE;
8435 G4double PI = 3.14159;
8436
8437 DCR = fiss->dcr;
8438 UCR = fiss->ucr;
8439 Z2OVERA = ZPRF * ZPRF / A;
8440
8441 // Nuclei below Businaro-Gallone point do not go through fission
8442 if ((ZPRF <= 55.0) || (FF_ALLOWED == 0))
8443 {
8444 (*GF) = 0.0;
8445 (*TEMP) = 0.5;
8446 return;
8447 }
8448
8449 // Level density above SP
8450 // Saddle-point deformation is defbet as above. But, FP_PER and FP_PAR
8451 // are calculated for fission in DENSNIV acc to Myers and Hasse, and their
8452 // parametrization is done as function of y
8453 densniv(A, ZPRF, EE, EF, &DENSF, 0.0, BS, BK, &ftemp, OPTSHP, 0, Y, &ECOR, JPR, 1, &qr);
8454
8455 if (OPTCOL == 0)
8456 {
8457 fgf = DENSF / DENSG / PI / 2.0 * ftemp;
8458 (*TEMP) = ftemp;
8459 (*GF) = fgf;
8460 return;
8461 }
8462
8463 // FP = 2/5*M0*R0**2/HBAR**2 * A**(5/3) * (1 + DEFBET/3)
8464 // FP is used to calculate the spin-cutoff parameter SIG=FP*TEMP/hbar**2;
8465 // hbar**2 is, therefore, included in FP in order to avoid problems with large
8466 // exponents The factor fnorm inlcudes then R0, M0 and hbar**2 - fnorm =
8467 // R0*M0/hbar**2 = 1.2fm*931.49MeV/c**2 /(6.582122e-22 MeVs)**2 and is in
8468 // units 1/MeV
8469 FNORM = 1.2 * 1.2 * 931.49 * 1.e-2 / (9.0 * 6.582122 * 6.582122);
8470 // FP_PER ~ 1+7*y/6, FP_PAR ~ 1-7*y/3 (Hasse & Myers, Geom. relat. macr. nucl.
8471 // phys.) Perpendicular moment of inertia
8472 FP_PER = 2.0 / 5.0 * std::pow(A, 5.0 / 3.0) * FNORM * (1. + 7.0 / 6.0 * Y * (1.0 + 1396.0 / 255. * Y));
8473
8474 // AK - Jan 2011 - following line is needed, as for these nuclei it seems that
8475 // FP_PER calculated according to above formula has too large values, leading
8476 // to too large ENH_FACT
8477 if (Z2OVERA <= 30.0)
8478 FP_PER = 6.50;
8479
8480 // Parallel moment of inertia
8481 FP_PAR = 2.0 / 5.0 * std::pow(A, 5.0 / 3.0) * FNORM * (1.0 - 7.0 / 3.0 * Y * (1.0 - 389.0 / 255.0 * Y));
8482 if (FP_PAR < 0.0)
8483 FP_PAR = 0.0;
8484
8485 EROT = JPR * JPR / (2.0 * std::sqrt(FP_PAR * FP_PAR + FP_PER * FP_PER));
8486 if (IEROT == 1)
8487 EROT = 0.0;
8488
8489 // Perpendicular spin cut-off parameter
8490 SIG_PER_SP = std::sqrt(FP_PER * ftemp);
8491
8492 if (SIG_PER_SP < 1.0)
8493 SIG_PER_SP = 1.0;
8494
8495 // Parallel spin cut-off parameter
8496 SIG_PAR_SP = std::sqrt(FP_PAR * ftemp);
8497 ENH_FACT = 1.0;
8498 //
8499 if (A > 223.0)
8500 {
8501 MASS_ASYM_SADD_B = 2.0;
8502 }
8503 else
8504 {
8505 MASS_ASYM_SADD_B = 1.0;
8506 }
8507
8508 // actinides with low barriers
8509 if (Z2OVERA > 35. && Z2OVERA <= (110. * 110. / 298.0))
8510 {
8511 // Barrier A is axial asymmetric
8512 ENH_FACTA = std::sqrt(8.0 * PI) * SIG_PER_SP * SIG_PER_SP * SIG_PAR_SP;
8513 // Barrier B is axial symmetric
8514 ENH_FACTB = MASS_ASYM_SADD_B * SIG_PER_SP * SIG_PER_SP;
8515 // Total enhancement
8516 ENH_FACT = ENH_FACTA * ENH_FACTB / (ENH_FACTA + ENH_FACTB);
8517 }
8518 else
8519 {
8520 // nuclei with high fission barriers (only barrier B plays a role, axial
8521 // symmetric)
8522 if (Z2OVERA <= 35.)
8523 {
8524 ENH_FACT = MASS_ASYM_SADD_B * SIG_PER_SP * SIG_PER_SP;
8525 }
8526 else
8527 {
8528 // super-heavy nuclei (only barrier A plays a role, axial asymmetric)
8529 ENH_FACT = std::sqrt(8.0 * PI) * SIG_PER_SP * SIG_PER_SP * SIG_PAR_SP;
8530 }
8531 }
8532
8533 // Fading-out with excitation energy above the saddle point:
8534 PONFE = (ECOR - UCR - EROT) / DCR;
8535 if (PONFE > 700.)
8536 PONFE = 700.0;
8537 // Fading-out according to Junghans:
8538 ENH_FACT = 1.0 / (1.0 + std::exp(PONFE)) * ENH_FACT + 1.0;
8539
8540 if (ENH_FACT < 1.0)
8541 ENH_FACT = 1.0;
8542 fgf = DENSF / DENSG / PI / 2.0 * ftemp * ENH_FACT;
8543
8544 // Tunneling
8545 if (EE < EF)
8546 {
8547 fgf = tunnelling(A, ZPRF, Y, EE, EF, ftemp, DENSG, DENSF, ENH_FACT);
8548 }
8549 //
8550 (*GF) = fgf;
8551 (*TEMP) = ftemp;
8552 return;
8553 }
8554
8555 void G4Abla::lorb(G4double AMOTHER,
8556 G4double ADAUGHTER,
8557 G4double LMOTHER,
8558 G4double EEFINAL,
8559 G4double* LORBITAL,
8560 G4double* SIGMA_LORBITAL)
8561 {
8562
8563 G4double AFRAGMENT, S4FINAL, ALEVDENS;
8564 G4double THETA_MOTHER, THETA_ORBITAL;
8565
8566 /*
8567 C Values on input:
8568 C AMOTHER mass of mother nucleus
8569 C ADAUGHTER mass of daughter fragment
8570 C LMOTHER angular momentum of mother (may be real)
8571 C EEFINAL excitation energy after emission
8572 C (sum of daughter and fragment)
8573 C
8574 C Values on output:
8575 C LORBITAL mean value of orbital angular momentum
8576 C (assumed to be fully aligned with LMOTHER)
8577 C SIGMA_LORBITAL standard deviation of the orbital angular momentum
8578 */
8579 if (EEFINAL <= 0.01)
8580 EEFINAL = 0.01;
8581 AFRAGMENT = AMOTHER - ADAUGHTER;
8582 ALEVDENS = 0.073 * AMOTHER + 0.095 * std::pow(AMOTHER, 2.0 / 3.0);
8583 S4FINAL = ALEVDENS * EEFINAL;
8584 if (S4FINAL <= 0.0 || S4FINAL > 100000.)
8585 {
8586 std::cout << "S4FINAL:" << S4FINAL << ALEVDENS << EEFINAL << idnint(AMOTHER) << idnint(AFRAGMENT) << std::endl;
8587 }
8588 THETA_MOTHER = 0.0111 * std::pow(AMOTHER, 1.66667);
8589 THETA_ORBITAL = 0.0323 / std::pow(AMOTHER, 2.) *
8590 std::pow(std::pow(AFRAGMENT, 0.33333) + std::pow(ADAUGHTER, 0.33333), 2.) * AFRAGMENT * ADAUGHTER *
8591 (AFRAGMENT + ADAUGHTER);
8592
8593 *LORBITAL = -1. * THETA_ORBITAL * (LMOTHER / THETA_MOTHER + std::sqrt(S4FINAL) / (ALEVDENS * LMOTHER));
8594
8595 *SIGMA_LORBITAL = std::sqrt(std::sqrt(S4FINAL) * THETA_ORBITAL / ALEVDENS);
8596
8597 return;
8598 }
8599
8600 // Random generator according to a distribution similar to a
8601 // Maxwell distribution with quantum-mech. x-section for neutrons according to
8602 // KHS
8603 // Y = SQRT(X) * EXP(-X/T) (approximation:)
8604 G4double G4Abla::fvmaxhaz_neut(G4double x)
8605 {
8606
8607 return (2.0 * x * std::sqrt(std::log(G4AblaRandom::flat()) * std::log(G4AblaRandom::flat())));
8608 }
8609
8610 void G4Abla::imf(G4double ACN,
8611 G4double ZCN,
8612 G4double TEMP,
8613 G4double EE,
8614 G4double* ZIMF,
8615 G4double* AIMF,
8616 G4double* BIMF,
8617 G4double* SBIMF,
8618 G4double* TIMF,
8619 G4double JPRF)
8620 {
8621 // input variables (compound nucleus) Acn, Zcn, Temp, EE
8622 // output variable (IMF) Zimf,Aimf,Bimf,Sbimf,IRNDM
8623 //
8624 // SBIMF = separation energy + coulomb barrier
8625 //
8626 // SDW(Z) is the sum over all isotopes for a given Z of the decay widths
8627 // DW(Z,A) is the decay width of a certain nuclide
8628 //
8629 // Last update:
8630 // 28/10/13 - JLRS - from abrablav4 (AK)
8631 // 13/11/16 - JLRS - Included this function in Abla++
8632
8633 G4int IZIMFMAX = 0;
8634 G4int iz = 0, in = 0, IZIMF = 0, INMI = 0, INMA = 0, IZCN = 0, INCN = 0, INIMFMI = 0, INIMFMA = 0, ILIMMAX = 0,
8635 INNMAX = 0, INMIN = 0, IAIMF = 0, IZSTOP = 3, IZMEM = 0, IA = 0, INMINMEM = 0, INMAXMEM = 0, IIA = 0;
8636 G4double BS = 0, BK = 0, BC = 0, BSHELL = 0, DEFBET = 0, DEFBETIMF = 0, EROT = 0, MAIMF = 0, MAZ = 0, MARES = 0,
8637 AIMF_1, OMEGAP = 0, fBIMF = 0.0, BSIMF = 0, A1PAR = 0, A2PAR = 0, SUM_A, EEDAUG;
8638 G4double DENSCN = 0, TEMPCN = 0, ECOR = 0, IINERT = 0, EROTCN = 0, WIDTH_IMF = 0.0, WIDTH1 = 0, IMFARG = 0, QR = 0,
8639 QRCN = 0, DENSIMF = 0, fTIMF = 0, fZIMF = 0, fAIMF = 0.0, NIMF = 0, fSBIMF = 0;
8640 G4double PI = 3.141592653589793238;
8641 G4double ZIMF_1 = 0.0;
8642 G4double SDWprevious = 0, SUMDW_TOT = 0, SUM_Z = 0, X = 0, SUMDW_N_TOT = 0, XX = 0;
8643 G4double SDW[98];
8644 G4double DW[98][251];
8645 G4double BBIMF[98][251];
8646 G4double SSBIMF[98][251];
8647 G4int OPTSHPIMF = opt->optshpimf;
8648
8649 // Initialization
8650 for (G4int ia = 0; ia < 98; ia++)
8651 for (G4int ib = 0; ib < 251; ib++)
8652 {
8653 BBIMF[ia][ib] = 0.0;
8654 SSBIMF[ia][ib] = 0.0;
8655 }
8656
8657 // take the half of the CN and transform it in integer (floor it)
8658 IZIMFMAX = idnint(ZCN / 2.0);
8659
8660 if (IZIMFMAX < 3)
8661 {
8662 std::cout << "CHARGE_IMF line 46" << std::endl;
8663 std::cout << "Problem: IZIMFMAX < 3 " << std::endl;
8664 std::cout << "ZCN,IZIMFMAX," << ZCN << "," << IZIMFMAX << std::endl;
8665 }
8666
8667 iz = idnint(ZCN);
8668 in = idnint(ACN) - iz;
8669 BSHELL = ecld->ecgnz[in][iz] - ecld->vgsld[in][iz];
8670 DEFBET = ecld->beta2[in][iz];
8671
8672 bsbkbc(ACN, ZCN, &BS, &BK, &BC);
8673
8674 densniv(ACN, ZCN, EE, 0.0, &DENSCN, BSHELL, BS, BK, &TEMPCN, 0, 0, DEFBET, &ECOR, JPRF, 0, &QRCN);
8675
8676 IINERT = 0.4 * 931.49 * 1.16 * 1.16 * std::pow(ACN, 5.0 / 3.0) * (1.0 + 0.5 * std::sqrt(5. / (4. * PI)) * DEFBET);
8677 EROTCN = JPRF * JPRF * 197.328 * 197.328 / (2. * IINERT);
8678 //
8679 for (IZIMF = 3; IZIMF <= IZIMFMAX; IZIMF++)
8680 {
8681
8682 SDW[IZIMF] = 0.0;
8683 ZIMF_1 = 1.0 * IZIMF;
8684
8685 // *** Find the limits that both IMF and partner are bound :
8686
8687 isostab_lim(IZIMF, &INIMFMI,
8688 &INIMFMA); // Bound isotopes for IZIMF from INMIN to INIMFMA
8689 // Idea - very proton-rich nuclei can live long enough to evaporate IMF
8690 // before decaying:
8691 INIMFMI = max(1, INIMFMI - 2);
8692
8693 IZCN = idnint(ZCN); // Z of CN
8694 INCN = idnint(ACN) - IZCN; // N of CN
8695
8696 isostab_lim(IZCN - IZIMF,
8697 &INMI,
8698 &INMA); // Daughter nucleus after IMF emission,
8699 // limits of bound isotopes
8700 INMI = max(1, INMI - 2);
8701 INMIN = max(INIMFMI, INCN - INMA); // Both IMF and daughter must be bound
8702 INNMAX = min(INIMFMA, INCN - INMI); // "
8703
8704 ILIMMAX = max(INNMAX, INMIN); // In order to keep the variables below
8705 // ***
8706
8707 for (G4int INIMF = INMIN; INIMF <= ILIMMAX; INIMF++)
8708 { // Range of possible IMF isotopes
8709 IAIMF = IZIMF + INIMF;
8710 DW[IZIMF][IAIMF] = 0.0;
8711 AIMF_1 = 1.0 * (IAIMF);
8712
8713 // Q-values
8714 mglms(ACN - AIMF_1, ZCN - ZIMF_1, OPTSHPIMF, &MARES);
8715 mglms(AIMF_1, ZIMF_1, OPTSHPIMF, &MAIMF);
8716 mglms(ACN, ZCN, OPTSHPIMF, &MAZ);
8717
8718 // Barrier
8719 if (ACN <= AIMF_1)
8720 {
8721 SSBIMF[IZIMF][IAIMF] = 1.e37;
8722 }
8723 else
8724 {
8725 barrs(idnint(ZCN - ZIMF_1), idnint(ACN - AIMF_1), idnint(ZIMF_1), idnint(AIMF_1), &fBIMF, &OMEGAP);
8726 SSBIMF[IZIMF][IAIMF] = MAIMF + MARES - MAZ + fBIMF;
8727 BBIMF[IZIMF][IAIMF] = fBIMF;
8728 }
8729
8730 // ***** Width *********************
8731 DEFBETIMF = ecld->beta2[idnint(AIMF_1 - ZIMF_1)][idnint(ZIMF_1)] +
8732 ecld->beta2[idnint(ACN - AIMF_1 - ZCN + ZIMF_1)][idnint(ZCN - ZIMF_1)];
8733
8734 IINERT = 0.40 * 931.490 * 1.160 * 1.160 * std::pow(ACN, 5.0 / 3.0) *
8735 (std::pow(AIMF_1, 5.0 / 3.0) + std::pow(ACN - AIMF_1, 5.0 / 3.0)) +
8736 931.490 * 1.160 * 1.160 * AIMF_1 * (ACN - AIMF_1) / ACN *
8737 (std::pow(AIMF_1, 1.0 / 3.0) + std::pow(ACN - AIMF_1, 1.0 / 3.0)) *
8738 (std::pow(AIMF_1, 1.0 / 3.0) + std::pow(ACN - AIMF_1, 1.0 / 3.0));
8739
8740 EROT = JPRF * JPRF * 197.328 * 197.328 / (2.0 * IINERT);
8741
8742 // IF(IEROT.EQ.1) EROT = 0.D0
8743 if (EE < (SSBIMF[IZIMF][IAIMF] + EROT) || DENSCN <= 0.0)
8744 {
8745 WIDTH_IMF = 0.0;
8746 // PRINT*,IDNINT(ACN),IDNINT(ZCN),IZIMF,IAIMF
8747 }
8748 else
8749 {
8750 // here the temperature at "saddle point" is used
8751 // Increase of the level densitiy at the barrier due to deformation; see
8752 // comment in ABLA
8753 // BSIMF = ((ACN-AIMF_1)**(2.D0/3.D0) + AIMF_1**(2.D0/3.D0))/
8754 // & ACN**(2.D0/3.D0)
8755 BSIMF = BS;
8756 densniv(ACN,
8757 ZCN,
8758 EE,
8759 SSBIMF[IZIMF][IAIMF],
8760 &DENSIMF,
8761 0.0,
8762 BSIMF,
8763 1.0,
8764 &fTIMF,
8765 0,
8766 0,
8767 DEFBETIMF,
8768 &ECOR,
8769 JPRF,
8770 2,
8771 &QR);
8772 IMFARG = (SSBIMF[IZIMF][IAIMF] + EROTCN - EROT) / fTIMF;
8773 if (IMFARG > 200.0)
8774 IMFARG = 200.0;
8775
8776 WIDTH1 = width(ACN, ZCN, AIMF_1, ZIMF_1, fTIMF, fBIMF, SSBIMF[IZIMF][IAIMF], EE - EROT);
8777
8778 WIDTH_IMF = WIDTH1 * std::exp(-IMFARG) * QR / QRCN;
8779
8780 if (WIDTH_IMF <= 0.0)
8781 {
8782 std::cout << "GAMMA_IMF=0 -> LOOK IN GAMMA_IMF CALCULATIONS!" << std::endl;
8783 std::cout << "ACN,ZCN,AIMF,ZIMF:" << idnint(ACN) << "," << idnint(ZCN) << "," << idnint(AIMF_1)
8784 << "," << idnint(ZIMF_1) << std::endl;
8785 std::cout << "SSBIMF,TIMF :" << SSBIMF[IZIMF][IAIMF] << "," << fTIMF << std::endl;
8786 std::cout << "DEXP(-IMFARG) = " << std::exp(-IMFARG) << std::endl;
8787 std::cout << "WIDTH1 =" << WIDTH1 << std::endl;
8788 }
8789 } // if ee
8790
8791 SDW[IZIMF] = SDW[IZIMF] + WIDTH_IMF;
8792
8793 DW[IZIMF][IAIMF] = WIDTH_IMF;
8794
8795 } // for INIMF
8796 } // for IZIMF
8797 // End loop to calculate the decay widths ************************
8798 // ***************************************************************
8799
8800 // Loop to calculate where the gamma of IMF has the minimum ******
8801 SDWprevious = 1.e20;
8802 IZSTOP = 0;
8803
8804 for (G4int III_ZIMF = 3; III_ZIMF <= IZIMFMAX; III_ZIMF++)
8805 {
8806
8807 if (SDW[III_ZIMF] == 0.0)
8808 {
8809 IZSTOP = III_ZIMF - 1;
8810 goto imfs30;
8811 }
8812
8813 if (SDW[III_ZIMF] > SDWprevious)
8814 {
8815 IZSTOP = III_ZIMF - 1;
8816 goto imfs30;
8817 }
8818 else
8819 {
8820 SDWprevious = SDW[III_ZIMF];
8821 }
8822
8823 } // for III_ZIMF
8824
8825 imfs30:
8826
8827 if (IZSTOP <= 6)
8828 {
8829 IZSTOP = IZIMFMAX;
8830 goto imfs15;
8831 }
8832
8833 A1PAR = std::log10(SDW[IZSTOP] / SDW[IZSTOP - 2]) / std::log10((1.0 * IZSTOP) / (1.0 * IZSTOP - 2.0));
8834 A2PAR = std::log10(SDW[IZSTOP]) - A1PAR * std::log10(1.0 * (IZSTOP));
8835 if (A2PAR > 0.)
8836 A2PAR = -1. * A2PAR;
8837 if (A1PAR > 0.)
8838 A1PAR = -1. * A1PAR;
8839
8840 // End loop to calculate where gamma of IMF has the minimum
8841
8842 for (G4int II_ZIMF = IZSTOP; II_ZIMF <= IZIMFMAX; II_ZIMF++)
8843 {
8844 SDW[II_ZIMF] = std::pow(10.0, A2PAR) * std::pow(1.0 * II_ZIMF, A1PAR); // Power-low
8845 if (SDW[II_ZIMF] < 0.0)
8846 SDW[II_ZIMF] = 0.0;
8847 }
8848
8849 imfs15:
8850
8851 // Sum of all decay widths (for normalisation)
8852 SUMDW_TOT = 0.0;
8853 for (G4int I_ZIMF = 3; I_ZIMF <= IZIMFMAX; I_ZIMF++)
8854 {
8855 SUMDW_TOT = SUMDW_TOT + SDW[I_ZIMF];
8856 }
8857 if (SUMDW_TOT <= 0.0)
8858 {
8859 std::cout << "*********************" << std::endl;
8860 std::cout << "IMF function" << std::endl;
8861 std::cout << "SUM of decay widths = " << SUMDW_TOT << " IZIMFMAX = " << IZIMFMAX << std::endl;
8862 std::cout << "IZSTOP = " << IZSTOP << std::endl;
8863 }
8864
8865 // End of Sum of all decay widths (for normalisation)
8866
8867 // Loop to sample the nuclide that is emitted ********************
8868 // ------- sample Z -----------
8869 imfs10:
8870 X = haz(1) * SUMDW_TOT;
8871
8872 // IF(X.EQ.0.D0) PRINT*,'WARNING: X=0',XRNDM,SUMDW_TOT
8873 SUM_Z = 0.0;
8874 fZIMF = 0.0;
8875 IZMEM = 0;
8876
8877 for (G4int IZ = 3; IZ <= IZIMFMAX; IZ++)
8878 {
8879 SUM_Z = SUM_Z + SDW[IZ];
8880 if (X < SUM_Z)
8881 {
8882 fZIMF = 1.0 * IZ;
8883 IZMEM = IZ;
8884 goto imfs20;
8885 }
8886 } // for IZ
8887
8888 imfs20:
8889
8890 // ------- sample N -----------
8891
8892 isostab_lim(IZMEM, &INMINMEM, &INMAXMEM);
8893 INMINMEM = max(1, INMINMEM - 2);
8894
8895 isostab_lim(IZCN - IZMEM, &INMI,
8896 &INMA); // Daughter nucleus after IMF emission,
8897 INMI = max(1, INMI - 2);
8898 // limits of bound isotopes
8899
8900 INMINMEM = max(INMINMEM, INCN - INMA); // Both IMF and daughter must be bound
8901 INMAXMEM = min(INMAXMEM, INCN - INMI); // "
8902
8903 INMAXMEM = max(INMINMEM, INMAXMEM);
8904
8905 IA = 0;
8906 SUMDW_N_TOT = 0.0;
8907 for (G4int IIINIMF = INMINMEM; IIINIMF <= INMAXMEM; IIINIMF++)
8908 {
8909 IA = IZMEM + IIINIMF;
8910 if (IZMEM >= 3 && IZMEM <= 95 && IA >= 4 && IA <= 250)
8911 {
8912 SUMDW_N_TOT = SUMDW_N_TOT + DW[IZMEM][IA];
8913 }
8914 else
8915 {
8916 std::cout << "CHARGE IMF OUT OF RANGE" << IZMEM << ", " << IA << ", " << idnint(ACN) << ", " << idnint(ZCN)
8917 << ", " << TEMP << std::endl;
8918 }
8919 }
8920
8921 XX = haz(1) * SUMDW_N_TOT;
8922 IIA = 0;
8923 SUM_A = 0.0;
8924 for (G4int IINIMF = INMINMEM; IINIMF <= INMAXMEM; IINIMF++)
8925 {
8926 IIA = IZMEM + IINIMF;
8927 // SUM_A = SUM_A + DW[IZ][IIA]; //FIXME
8928 SUM_A = SUM_A + DW[IZMEM][IIA];
8929 if (XX < SUM_A)
8930 {
8931 fAIMF = G4double(IIA);
8932 goto imfs25;
8933 }
8934 }
8935
8936 imfs25:
8937 // CHECK POINT 1
8938 NIMF = fAIMF - fZIMF;
8939
8940 if ((ACN - ZCN - NIMF) <= 0.0 || (ZCN - fZIMF) <= 0.0)
8941 {
8942 std::cout << "IMF Partner unstable:" << std::endl;
8943 std::cout << "System: Acn,Zcn,NCN:" << std::endl;
8944 std::cout << idnint(ACN) << ", " << idnint(ZCN) << ", " << idnint(ACN - ZCN) << std::endl;
8945 std::cout << "IMF: A,Z,N:" << std::endl;
8946 std::cout << idnint(fAIMF) << ", " << idnint(fZIMF) << ", " << idnint(fAIMF - fZIMF) << std::endl;
8947 std::cout << "Partner: A,Z,N:" << std::endl;
8948 std::cout << idnint(ACN - fAIMF) << ", " << idnint(ZCN - fZIMF) << ", " << idnint(ACN - ZCN - NIMF)
8949 << std::endl;
8950 std::cout << "----nmin,nmax" << INMINMEM << ", " << INMAXMEM << std::endl;
8951 std::cout << "----- warning: Zimf=" << fZIMF << " Aimf=" << fAIMF << std::endl;
8952 std::cout << "----- look in subroutine IMF" << std::endl;
8953 std::cout << "ACN,ZCN,ZIMF,AIMF,temp,EE,JPRF::" << ACN << ", " << ZCN << ", " << fZIMF << ", " << fAIMF << ", "
8954 << TEMP << ", " << EE << ", " << JPRF << std::endl;
8955 std::cout << "-IZSTOP,IZIMFMAX:" << IZSTOP << ", " << IZIMFMAX << std::endl;
8956 std::cout << "----X,SUM_Z,SUMDW_TOT:" << X << ", " << SUM_Z << ", " << SUMDW_TOT << std::endl;
8957 // for(int III_ZIMF=3;III_ZIMF<=IZIMFMAX;III_ZIMF++)
8958 // std::cout << "-**Z,SDW:" << III_ZIMF << ", " << SDW[III_ZIMF] <<
8959 // std::endl;
8960
8961 goto imfs10;
8962 }
8963 if (fZIMF >= ZCN || fAIMF >= ACN || fZIMF <= 2 || fAIMF <= 3)
8964 {
8965 std::cout << "----nmin,nmax" << INMINMEM << ", " << INMAXMEM << std::endl;
8966 std::cout << "----- warning: Zimf=" << fZIMF << " Aimf=" << fAIMF << std::endl;
8967 std::cout << "----- look in subroutine IMF" << std::endl;
8968 std::cout << "ACN,ZCN,ZIMF,AIMF,temp,EE,JPRF:" << ACN << ", " << ZCN << ", " << fZIMF << ", " << fAIMF << ", "
8969 << TEMP << ", " << EE << ", " << JPRF << std::endl;
8970 std::cout << "-IZSTOP,IZIMFMAX:" << IZSTOP << ", " << IZIMFMAX << std::endl;
8971 std::cout << "----X,SUM_Z,SUMDW_TOT:" << X << ", " << SUM_Z << ", " << SUMDW_TOT << std::endl;
8972 for (int III_ZIMF = 3; III_ZIMF <= IZIMFMAX; III_ZIMF++)
8973 std::cout << "-**Z,SDW:" << III_ZIMF << ", " << SDW[III_ZIMF] << std::endl;
8974
8975 fZIMF = 3.0; // provisorisch AK
8976 fAIMF = 4.0;
8977 }
8978
8979 // Characteristics of selected IMF (AIMF, ZIMF, BIMF, SBIMF, TIMF)
8980 fSBIMF = SSBIMF[idnint(fZIMF)][idnint(fAIMF)];
8981 fBIMF = BBIMF[idnint(fZIMF)][idnint(fAIMF)];
8982
8983 if ((ZCN - fZIMF) <= 0.0)
8984 std::cout << "CHARGE_IMF ZIMF > ZCN" << std::endl;
8985 if ((ACN - fAIMF) <= 0.0)
8986 std::cout << "CHARGE_IMF AIMF > ACN" << std::endl;
8987
8988 BSHELL = ecld->ecgnz[idnint(ACN - ZCN - NIMF)][idnint(ZCN - fZIMF)] -
8989 ecld->vgsld[idnint(ACN - ZCN - NIMF)][idnint(ZCN - fZIMF)];
8990
8991 DEFBET = ecld->beta2[idnint(ACN - ZCN - NIMF)][idnint(ZCN - fZIMF)];
8992 EEDAUG = (EE - fSBIMF) * (ACN - fAIMF) / ACN;
8993 bsbkbc(ACN - fAIMF, ZCN - fZIMF, &BS, &BK, &BC);
8994 densniv(ACN - fAIMF, ZCN - fZIMF, EEDAUG, 0.0, &DENSIMF, BSHELL, BS, BK, &fTIMF, 0, 0, DEFBET, &ECOR, 0.0, 0, &QR);
8995
8996 if (fSBIMF > EE)
8997 {
8998 std::cout << "----- warning: EE=" << EE << ","
8999 << " S+Bimf=" << fSBIMF << std::endl;
9000 std::cout << "----- look in subroutine IMF" << std::endl;
9001 std::cout << "IMF will be resampled" << std::endl;
9002 goto imfs10;
9003 }
9004 (*ZIMF) = fZIMF;
9005 (*AIMF) = fAIMF;
9006 (*SBIMF) = fSBIMF;
9007 (*BIMF) = fBIMF;
9008 (*TIMF) = fTIMF;
9009 return;
9010 }
9011
9012 void G4Abla::isostab_lim(G4int z, G4int* nmin, G4int* nmax)
9013 {
9014
9015 G4int VISOSTAB[191][2] = {
9016 { 0, 7 }, { 1, 8 }, { 1, 9 }, { 2, 12 }, { 2, 14 }, { 2, 16 }, { 3, 18 }, { 4, 22 },
9017 { 6, 22 }, { 6, 28 }, { 7, 28 }, { 7, 30 }, { 8, 28 }, { 8, 36 }, { 10, 38 }, { 10, 40 },
9018 { 11, 38 }, { 10, 42 }, { 13, 50 }, { 14, 50 }, { 15, 52 }, { 16, 52 }, { 17, 54 }, { 18, 54 },
9019 { 19, 60 }, { 19, 62 }, { 21, 64 }, { 20, 66 }, { 23, 66 }, { 24, 70 }, { 25, 70 }, { 26, 74 },
9020 { 27, 78 }, { 29, 82 }, { 33, 82 }, { 31, 82 }, { 35, 82 }, { 34, 84 }, { 40, 84 }, { 36, 86 },
9021 { 40, 92 }, { 38, 96 }, { 42, 102 }, { 42, 102 }, { 44, 102 }, { 42, 106 }, { 47, 112 }, { 44, 114 },
9022 { 49, 116 }, { 46, 118 }, { 52, 120 }, { 52, 124 }, { 55, 126 }, { 54, 126 }, { 57, 126 }, { 57, 126 },
9023 { 60, 126 }, { 58, 130 }, { 62, 132 }, { 60, 140 }, { 67, 138 }, { 64, 142 }, { 67, 144 }, { 68, 146 },
9024 { 70, 148 }, { 70, 152 }, { 73, 152 }, { 72, 154 }, { 75, 156 }, { 77, 162 }, { 79, 164 }, { 78, 164 },
9025 { 82, 166 }, { 80, 166 }, { 85, 168 }, { 83, 176 }, { 87, 178 }, { 88, 178 }, { 91, 182 }, { 90, 184 },
9026 { 96, 184 }, { 95, 184 }, { 99, 184 }, { 98, 184 }, { 105, 194 }, { 102, 194 }, { 108, 196 }, { 106, 198 },
9027 { 115, 204 }, { 110, 206 }, { 119, 210 }, { 114, 210 }, { 124, 210 }, { 117, 212 }, { 130, 212 }
9028 };
9029
9030 if (z < 0)
9031 {
9032 *nmin = 0;
9033 *nmax = 0;
9034 }
9035 else
9036 {
9037 if (z == 0)
9038 {
9039 *nmin = 1;
9040 *nmax = 1;
9041 // AK (Dez2010) - Just to avoid numerical problems
9042 }
9043 else
9044 {
9045 if (z > 95)
9046 {
9047 *nmin = 130;
9048 *nmax = 200;
9049 }
9050 else
9051 {
9052 *nmin = VISOSTAB[z - 1][0];
9053 *nmax = VISOSTAB[z - 1][1];
9054 }
9055 }
9056 }
9057
9058 return;
9059 }
9060
9061 void G4Abla::evap_postsaddle(G4double A,
9062 G4double Z,
9063 G4double EXC,
9064 G4double* E_scission_post,
9065 G4double* A_scission,
9066 G4double* Z_scission,
9067 G4double& vx_eva,
9068 G4double& vy_eva,
9069 G4double& vz_eva,
9070 G4int* NbLam0_par)
9071 {
9072
9073 // AK 2006 - Now in case of fission deexcitation between saddle and scission
9074 // is explicitly calculated. Langevin calculations made by P.
9075 // Nadtochy used to parametrise saddle-to-scission time
9076
9077 G4double af, zf, ee;
9078 G4double epsiln = 0.0, probp = 0.0, probd = 0.0, probt = 0.0, probn = 0.0, probhe = 0.0, proba = 0.0, probg = 0.0,
9079 probimf = 0.0, problamb0 = 0.0, ptotl = 0.0, tcn = 0.0;
9080 G4double sn = 0.0, sbp = 0.0, sbd = 0.0, sbt = 0.0, sbhe = 0.0, sba = 0.0, x = 0.0, amoins = 0.0, zmoins = 0.0,
9081 sp = 0.0, sd = 0.0, st = 0.0, she = 0.0, sa = 0.0, slamb0 = 0.0;
9082 G4double ecn = 0.0, ecp = 0.0, ecd = 0.0, ect = 0.0, eche = 0.0, eca = 0.0, ecg = 0.0, eclamb0 = 0.0, bp = 0.0,
9083 bd = 0.0, bt = 0.0, bhe = 0.0, ba = 0.0;
9084
9085 G4double xcv = 0., ycv = 0., zcv = 0., VXOUT = 0., VYOUT = 0., VZOUT = 0.;
9086
9087 G4double jprfn = 0.0, jprfp = 0.0, jprfd = 0.0, jprft = 0.0, jprfhe = 0.0, jprfa = 0.0, jprflamb0 = 0.0;
9088 G4double ctet1 = 0.0, stet1 = 0.0, phi1 = 0.0;
9089 G4double rnd = 0.0;
9090
9091 G4int itest = 0, sortie = 0;
9092 G4double probf = 0.0;
9093
9094 G4double ef = 0.0;
9095 G4double pc = 0.0;
9096
9097 G4double time, tauf, tau0, a0, a1, emin, ts1, tsum = 0.;
9098 G4int inttype = 0, inum = 0, gammadecay = 0, flamb0decay = 0;
9099 G4double pleva = 0.0;
9100 G4double pxeva = 0.0;
9101 G4double pyeva = 0.0;
9102 G4double pteva = 0.0;
9103 G4double etot = 0.0;
9104 G4int NbLam0 = (*NbLam0_par);
9105
9106 const G4double c = 29.9792458;
9107 const G4double mu = 931.494;
9108 const G4double mu2 = 931.494 * 931.494;
9109
9110 vx_eva = 0.;
9111 vy_eva = 0.;
9112 vz_eva = 0.;
9113 IEV_TAB_SSC = 0;
9114
9115 af = dint(A);
9116 zf = dint(Z);
9117 ee = EXC;
9118
9119 fiss->ifis = 0;
9120 opt->optimfallowed = 0;
9121 gammaemission = 0;
9122 // Initialsation
9123 time = 0.0;
9124
9125 // in sec
9126 tau0 = 1.0e-21;
9127 a0 = 0.66482503 - 3.4678935 * std::exp(-0.0104002 * ee);
9128 a1 = 5.6846e-04 + 0.00574515 * std::exp(-0.01114307 * ee);
9129 tauf = (a0 + a1 * zf * zf / std::pow(af, 0.3333333)) * tau0;
9130 //
9131 post10:
9132 direct(zf,
9133 af,
9134 ee,
9135 0.,
9136 &probp,
9137 &probd,
9138 &probt,
9139 &probn,
9140 &probhe,
9141 &proba,
9142 &probg,
9143 &probimf,
9144 &probf,
9145 &problamb0,
9146 &ptotl,
9147 &sn,
9148 &sbp,
9149 &sbd,
9150 &sbt,
9151 &sbhe,
9152 &sba,
9153 &slamb0,
9154 &ecn,
9155 &ecp,
9156 &ecd,
9157 &ect,
9158 &eche,
9159 &eca,
9160 &ecg,
9161 &eclamb0,
9162 &bp,
9163 &bd,
9164 &bt,
9165 &bhe,
9166 &ba,
9167 &sp,
9168 &sd,
9169 &st,
9170 &she,
9171 &sa,
9172 &ef,
9173 &ts1,
9174 inttype,
9175 inum,
9176 itest,
9177 &sortie,
9178 &tcn,
9179 &jprfn,
9180 &jprfp,
9181 &jprfd,
9182 &jprft,
9183 &jprfhe,
9184 &jprfa,
9185 &jprflamb0,
9186 &tsum,
9187 NbLam0); //:::FIXME::: Call
9188 //
9189 // HERE THE FINAL STEPS OF THE EVAPORATION ARE CALCULATED
9190 //
9191 if (ptotl <= 0.)
9192 goto post100;
9193
9194 emin = dmin1(sba, sbhe, dmin1(sbt, sbhe, dmin1(sn, sbp, sbd)));
9195
9196 if (emin > 1e30)
9197 std::cout << "ERROR AT THE EXIT OF EVAPORA,E>1.D30,AF" << std::endl;
9198
9199 if (sortie == 1)
9200 {
9201 if (probn != 0.0)
9202 {
9203 amoins = 1.0;
9204 zmoins = 0.0;
9205 epsiln = sn + ecn;
9206 pc = std::sqrt(std::pow((1.0 + ecn / 9.3956e2), 2.) - 1.0) * 9.3956e2;
9207 gammadecay = 0;
9208 flamb0decay = 0;
9209 }
9210 else if (probp != 0.0)
9211 {
9212 amoins = 1.0;
9213 zmoins = 1.0;
9214 epsiln = sp + ecp;
9215 pc = std::sqrt(std::pow((1.0 + ecp / 9.3827e2), 2.) - 1.0) * 9.3827e2;
9216 gammadecay = 0;
9217 flamb0decay = 0;
9218 }
9219 else if (probd != 0.0)
9220 {
9221 amoins = 2.0;
9222 zmoins = 1.0;
9223 epsiln = sd + ecd;
9224 pc = std::sqrt(std::pow((1.0 + ecd / 1.875358e3), 2) - 1.0) * 1.875358e3;
9225 gammadecay = 0;
9226 flamb0decay = 0;
9227 }
9228 else if (probt != 0.0)
9229 {
9230 amoins = 3.0;
9231 zmoins = 1.0;
9232 epsiln = st + ect;
9233 pc = std::sqrt(std::pow((1.0 + ect / 2.80828e3), 2) - 1.0) * 2.80828e3;
9234 gammadecay = 0;
9235 flamb0decay = 0;
9236 }
9237 else if (probhe != 0.0)
9238 {
9239 amoins = 3.0;
9240 zmoins = 2.0;
9241 epsiln = she + eche;
9242 pc = std::sqrt(std::pow((1.0 + eche / 2.80826e3), 2) - 1.0) * 2.80826e3;
9243 gammadecay = 0;
9244 flamb0decay = 0;
9245 }
9246 else
9247 {
9248 if (proba != 0.0)
9249 {
9250 amoins = 4.0;
9251 zmoins = 2.0;
9252 epsiln = sa + eca;
9253 pc = std::sqrt(std::pow((1.0 + eca / 3.72834e3), 2) - 1.0) * 3.72834e3;
9254 gammadecay = 0;
9255 flamb0decay = 0;
9256 }
9257 }
9258 goto post99;
9259 }
9260
9261 // IRNDM = IRNDM+1;
9262 //
9263 // HERE THE NORMAL EVAPORATION CASCADE STARTS
9264 // RANDOM NUMBER FOR THE EVAPORATION
9265
9266 // random number for the evaporation
9267 x = G4AblaRandom::flat() * ptotl;
9268
9269 itest = 0;
9270 if (x < proba)
9271 {
9272 // alpha evaporation
9273 amoins = 4.0;
9274 zmoins = 2.0;
9275 epsiln = sa + eca;
9276 pc = std::sqrt(std::pow((1.0 + eca / 3.72834e3), 2) - 1.0) * 3.72834e3;
9277 gammadecay = 0;
9278 flamb0decay = 0;
9279 }
9280 else if (x < proba + probhe)
9281 {
9282 // He3 evaporation
9283 amoins = 3.0;
9284 zmoins = 2.0;
9285 epsiln = she + eche;
9286 pc = std::sqrt(std::pow((1.0 + eche / 2.80826e3), 2) - 1.0) * 2.80826e3;
9287 gammadecay = 0;
9288 flamb0decay = 0;
9289 }
9290 else if (x < proba + probhe + probt)
9291 {
9292 // triton evaporation
9293 amoins = 3.0;
9294 zmoins = 1.0;
9295 epsiln = st + ect;
9296 pc = std::sqrt(std::pow((1.0 + ect / 2.80828e3), 2) - 1.0) * 2.80828e3;
9297 gammadecay = 0;
9298 flamb0decay = 0;
9299 }
9300 else if (x < proba + probhe + probt + probd)
9301 {
9302 // deuteron evaporation
9303 amoins = 2.0;
9304 zmoins = 1.0;
9305 epsiln = sd + ecd;
9306 pc = std::sqrt(std::pow((1.0 + ecd / 1.875358e3), 2) - 1.0) * 1.875358e3;
9307 gammadecay = 0;
9308 flamb0decay = 0;
9309 }
9310 else if (x < proba + probhe + probt + probd + probp)
9311 {
9312 // proton evaporation
9313 amoins = 1.0;
9314 zmoins = 1.0;
9315 epsiln = sp + ecp;
9316 pc = std::sqrt(std::pow((1.0 + ecp / 9.3827e2), 2) - 1.0) * 9.3827e2;
9317 gammadecay = 0;
9318 flamb0decay = 0;
9319 }
9320 else if (x < proba + probhe + probt + probd + probp + probn)
9321 {
9322 // neutron evaporation
9323 amoins = 1.0;
9324 zmoins = 0.0;
9325 epsiln = sn + ecn;
9326 pc = std::sqrt(std::pow((1.0 + ecn / 9.3956e2), 2.) - 1.0) * 9.3956e2;
9327 gammadecay = 0;
9328 flamb0decay = 0;
9329 }
9330 else if (x < proba + probhe + probt + probd + probp + probn + problamb0)
9331 {
9332 // lambda0 evaporation
9333 amoins = 1.0;
9334 zmoins = 0.0;
9335 epsiln = slamb0 + eclamb0;
9336 pc = std::sqrt(std::pow((1.0 + (eclamb0) / 11.1568e2), 2.) - 1.0) * 11.1568e2;
9337 opt->nblan0 = opt->nblan0 - 1;
9338 NbLam0 = NbLam0 - 1;
9339 gammadecay = 0;
9340 flamb0decay = 1;
9341 }
9342 else if (x < proba + probhe + probt + probd + probp + probn + problamb0 + probg)
9343 {
9344 // gamma evaporation
9345 amoins = 0.0;
9346 zmoins = 0.0;
9347 epsiln = ecg;
9348 pc = ecg;
9349 gammadecay = 1;
9350 flamb0decay = 0;
9351 if (probp == 0.0 && probn == 0.0 && probd == 0.0 && probt == 0.0 && proba == 0.0 && probhe == 0.0 &&
9352 problamb0 == 0.0 && probimf == 0.0 && probf == 0.0)
9353 {
9354 // ee = ee-epsiln;
9355 // if(ee<=0.01) ee = 0.010;
9356 goto post100;
9357 }
9358 }
9359
9360 // CALCULATION OF THE DAUGHTER NUCLEUS
9361 //
9362 post99:
9363
9364 if (gammadecay == 1 && ee <= 0.01 + epsiln)
9365 {
9366 epsiln = ee - 0.01;
9367 time = tauf + 1.;
9368 }
9369
9370 af = af - amoins;
9371 zf = zf - zmoins;
9372 ee = ee - epsiln;
9373
9374 if (ee <= 0.01)
9375 ee = 0.010;
9376
9377 if (af < 2.5)
9378 goto post100;
9379
9380 time = time + ts1;
9381
9382 // Determination of x,y,z components of momentum from known emission momentum
9383 if (flamb0decay == 1)
9384 {
9385 EV_TAB_SSC[IEV_TAB_SSC][0] = 0.;
9386 EV_TAB_SSC[IEV_TAB_SSC][1] = -2.;
9387 EV_TAB_SSC[IEV_TAB_SSC][5] = 1.;
9388 }
9389 else
9390 {
9391 EV_TAB_SSC[IEV_TAB_SSC][0] = zmoins;
9392 EV_TAB_SSC[IEV_TAB_SSC][1] = amoins;
9393 EV_TAB_SSC[IEV_TAB_SSC][5] = 0.;
9394 }
9395
9396 rnd = G4AblaRandom::flat();
9397 ctet1 = 2.0 * rnd - 1.0; // z component: uniform probability between -1 and 1
9398 stet1 = std::sqrt(1.0 - std::pow(ctet1, 2)); // component perpendicular to z
9399 rnd = G4AblaRandom::flat();
9400 phi1 = rnd * 2.0 * 3.141592654; // angle in x-y plane: uniform probability between 0 and 2*pi
9401 xcv = stet1 * std::cos(phi1); // x component
9402 ycv = stet1 * std::sin(phi1); // y component
9403 zcv = ctet1; // z component
9404 // In the CM system
9405 if (gammadecay == 0)
9406 {
9407 // Light particle
9408 G4double ETOT_LP = std::sqrt(pc * pc + amoins * amoins * mu2);
9409 if (flamb0decay == 1)
9410 ETOT_LP = std::sqrt(pc * pc + 1115.683 * 1115.683);
9411 EV_TAB_SSC[IEV_TAB_SSC][2] = c * pc * xcv / ETOT_LP;
9412 EV_TAB_SSC[IEV_TAB_SSC][3] = c * pc * ycv / ETOT_LP;
9413 EV_TAB_SSC[IEV_TAB_SSC][4] = c * pc * zcv / ETOT_LP;
9414 }
9415 else
9416 {
9417 // gamma ray
9418 EV_TAB_SSC[IEV_TAB_SSC][2] = pc * xcv;
9419 EV_TAB_SSC[IEV_TAB_SSC][3] = pc * ycv;
9420 EV_TAB_SSC[IEV_TAB_SSC][4] = pc * zcv;
9421 }
9422 lorentz_boost(vx_eva,
9423 vy_eva,
9424 vz_eva,
9425 EV_TAB_SSC[IEV_TAB_SSC][2],
9426 EV_TAB_SSC[IEV_TAB_SSC][3],
9427 EV_TAB_SSC[IEV_TAB_SSC][4],
9428 &VXOUT,
9429 &VYOUT,
9430 &VZOUT);
9431 EV_TAB_SSC[IEV_TAB_SSC][2] = VXOUT;
9432 EV_TAB_SSC[IEV_TAB_SSC][3] = VYOUT;
9433 EV_TAB_SSC[IEV_TAB_SSC][4] = VZOUT;
9434
9435 // Heavy residue
9436 if (gammadecay == 0)
9437 {
9438 G4double v2 = std::pow(EV_TAB_SSC[IEV_TAB_SSC][2], 2.) + std::pow(EV_TAB_SSC[IEV_TAB_SSC][3], 2.) +
9439 std::pow(EV_TAB_SSC[IEV_TAB_SSC][4], 2.);
9440 G4double gamma = 1.0 / std::sqrt(1.0 - v2 / (c * c));
9441 G4double etot_lp = amoins * mu * gamma;
9442 pxeva = pxeva - EV_TAB_SSC[IEV_TAB_SSC][2] * etot_lp / c;
9443 pyeva = pyeva - EV_TAB_SSC[IEV_TAB_SSC][3] * etot_lp / c;
9444 pleva = pleva - EV_TAB_SSC[IEV_TAB_SSC][4] * etot_lp / c;
9445 }
9446 else
9447 {
9448 // in case of gammas, EV_TEMP contains momentum components and not velocity
9449 pxeva = pxeva - EV_TAB_SSC[IEV_TAB_SSC][2];
9450 pyeva = pyeva - EV_TAB_SSC[IEV_TAB_SSC][3];
9451 pleva = pleva - EV_TAB_SSC[IEV_TAB_SSC][4];
9452 }
9453 pteva = std::sqrt(pxeva * pxeva + pyeva * pyeva);
9454 // To be checked:
9455 etot = std::sqrt(pleva * pleva + pteva * pteva + af * af * mu2);
9456 vx_eva = c * pxeva / etot; // recoil velocity components of residue due to evaporation
9457 vy_eva = c * pyeva / etot;
9458 vz_eva = c * pleva / etot;
9459
9460 IEV_TAB_SSC = IEV_TAB_SSC + 1;
9461
9462 if (time < tauf)
9463 goto post10;
9464 //
9465 post100:
9466 //
9467 *A_scission = af;
9468 *Z_scission = zf;
9469 *E_scission_post = ee;
9470 *NbLam0_par = NbLam0;
9471 return;
9472 }
9473
9474 G4double G4Abla::getdeltabinding(G4double A, G4int H)
9475 {
9476 if (A < 1.)
9477 return (1. * H) / A * (10.68 * A - 21.27 * std::pow(A, 2. / 3.)) * 10.;
9478 return (1. * H) / A * (10.68 * A - 21.27 * std::pow(A, 2. / 3.));
9479 }
9480
9481 G4double G4Abla::gethyperseparation(G4double A, G4double Z, G4int ny)
9482 {
9483 if (A < 1.)
9484 return 1.e38;
9485 // For light nuclei we take experimental values
9486 // Journal of Physics G, Nucl Part Phys 32,363 (2006)
9487 if (ny == 1)
9488 {
9489 if (Z == 1 && A == 4)
9490 return 2.04;
9491 else if (Z == 2 && A == 4)
9492 return 2.39;
9493 else if (Z == 2 && A == 5)
9494 return 3.12;
9495 else if (Z == 2 && A == 6)
9496 return 4.18;
9497 else if (Z == 2 && A == 7)
9498 return 5.23;
9499 else if (Z == 2 && A == 8)
9500 return 7.16;
9501 else if (Z == 3 && A == 6)
9502 return 4.50;
9503 else if (Z == 3 && A == 7)
9504 return 5.58;
9505 else if (Z == 3 && A == 8)
9506 return 6.80;
9507 else if (Z == 3 && A == 9)
9508 return 8.50;
9509 else if (Z == 4 && A == 7)
9510 return 5.16;
9511 else if (Z == 4 && A == 8)
9512 return 6.84;
9513 else if (Z == 4 && A == 9)
9514 return 6.71;
9515 else if (Z == 4 && A == 10)
9516 return 9.11;
9517 else if (Z == 5 && A == 9)
9518 return 8.29;
9519 else if (Z == 5 && A == 10)
9520 return 9.01;
9521 else if (Z == 5 && A == 11)
9522 return 10.29;
9523 else if (Z == 5 && A == 12)
9524 return 11.43;
9525 else if (Z == 6 && A == 12)
9526 return 10.95;
9527 else if (Z == 6 && A == 13)
9528 return 11.81;
9529 else if (Z == 6 && A == 14)
9530 return 12.50;
9531 else if (Z == 7 && A == 14)
9532 return 12.17;
9533 else if (Z == 7 && A == 15)
9534 return 13.59;
9535 else if (Z == 8 && A == 16)
9536 return 12.50;
9537 else if (Z == 8 && A == 17)
9538 return 13.59;
9539 else if (Z == 14 && A == 28)
9540 return 16.0;
9541 else if (Z == 39 && A == 89)
9542 return 22.1;
9543 else if (Z == 57 && A == 139)
9544 return 23.8;
9545 else if (Z == 82 && A == 208)
9546 return 26.5;
9547 } // ny==1
9548 // For other nuclei we take Bethe-Weizsacker mass formula
9549 return gethyperbinding(A, Z, ny) - gethyperbinding(A - 1., Z, ny - 1);
9550 }
9551
9552 G4double G4Abla::gethyperbinding(G4double A, G4double Z, G4int ny)
9553 {
9554 //
9555 // Bethe-Weizsacker mass formula
9556 // Journal of Physics G, Nucl Part Phys 32,363 (2006)
9557 //
9558 if (A < 2 || Z < 2)
9559 return 0.;
9560 G4double N = A - Z - 1. * ny;
9561 G4double be = 0., my = 1115.683, av = 15.77, as = 18.34, ac = 0.71, asym = 23.21, k = 17., c = 30., D = 0.;
9562 if (mod(N, 2) == 1 && mod(Z, 2) == 1)
9563 D = -12. / std::sqrt(A);
9564 if (mod(N, 2) == 0 && mod(Z, 2) == 0)
9565 D = 12. / std::sqrt(A);
9566 //
9567 G4double deltanew = (1. - std::exp(-1. * A / c)) * D;
9568 //
9569 be = av * A - as * std::pow(A, 2. / 3.) - ac * Z * (Z - 1.) / std::pow(A, 1. / 3.) -
9570 asym * (N - Z) * (N - Z) / ((1. + std::exp(-1. * A / k)) * A) + deltanew +
9571 ny * (0.0335 * my - 26.7 - 48.7 / std::pow(A, 2.0 / 3.0));
9572 return be;
9573 }
9574
9575 void G4Abla::unbound(G4double SN,
9576 G4double SP,
9577 G4double SD,
9578 G4double ST,
9579 G4double SHE,
9580 G4double SA,
9581 G4double BP,
9582 G4double BD,
9583 G4double BT,
9584 G4double BHE,
9585 G4double BA,
9586 G4double* PROBF,
9587 G4double* PROBN,
9588 G4double* PROBP,
9589 G4double* PROBD,
9590 G4double* PROBT,
9591 G4double* PROBHE,
9592 G4double* PROBA,
9593 G4double* PROBIMF,
9594 G4double* PROBG,
9595 G4double* ECN,
9596 G4double* ECP,
9597 G4double* ECD,
9598 G4double* ECT,
9599 G4double* ECHE,
9600 G4double* ECA)
9601 {
9602 G4double SBP = SP + BP;
9603 G4double SBD = SD + BD;
9604 G4double SBT = ST + BT;
9605 G4double SBHE = SHE + BHE;
9606 G4double SBA = SA + BA;
9607
9608 G4double e = dmin1(SBP, SBD, SBT);
9609 e = dmin1(SBHE, SN, e);
9610 e = dmin1(SBHE, SBA, e);
9611 //
9612 if (SN == e)
9613 {
9614 *ECN = (-1.0) * SN;
9615 *ECP = 0.0;
9616 *ECD = 0.0;
9617 *ECT = 0.0;
9618 *ECHE = 0.0;
9619 *ECA = 0.0;
9620 *PROBN = 1.0;
9621 *PROBP = 0.0;
9622 *PROBD = 0.0;
9623 *PROBT = 0.0;
9624 *PROBHE = 0.0;
9625 *PROBA = 0.0;
9626 *PROBIMF = 0.0;
9627 *PROBF = 0.0;
9628 *PROBG = 0.0;
9629 }
9630 else if (SBP == e)
9631 {
9632 *ECN = 0.0;
9633 *ECP = (-1.0) * SP + BP;
9634 *ECD = 0.0;
9635 *ECT = 0.0;
9636 *ECHE = 0.0;
9637 *ECA = 0.0;
9638 *PROBN = 0.0;
9639 *PROBP = 1.0;
9640 *PROBD = 0.0;
9641 *PROBT = 0.0;
9642 *PROBHE = 0.0;
9643 *PROBA = 0.0;
9644 *PROBIMF = 0.0;
9645 *PROBF = 0.0;
9646 *PROBG = 0.0;
9647 }
9648 else if (SBD == e)
9649 {
9650 *ECN = 0.0;
9651 *ECD = (-1.0) * SD + BD;
9652 *ECP = 0.0;
9653 *ECT = 0.0;
9654 *ECHE = 0.0;
9655 *ECA = 0.0;
9656 *PROBN = 0.0;
9657 *PROBP = 0.0;
9658 *PROBD = 1.0;
9659 *PROBT = 0.0;
9660 *PROBHE = 0.0;
9661 *PROBA = 0.0;
9662 *PROBIMF = 0.0;
9663 *PROBF = 0.0;
9664 *PROBG = 0.0;
9665 }
9666 else if (SBT == e)
9667 {
9668 *ECN = 0.0;
9669 *ECT = (-1.0) * ST + BT;
9670 *ECD = 0.0;
9671 *ECP = 0.0;
9672 *ECHE = 0.0;
9673 *ECA = 0.0;
9674 *PROBN = 0.0;
9675 *PROBP = 0.0;
9676 *PROBD = 0.0;
9677 *PROBT = 1.0;
9678 *PROBHE = 0.0;
9679 *PROBA = 0.0;
9680 *PROBIMF = 0.0;
9681 *PROBF = 0.0;
9682 *PROBG = 0.0;
9683 }
9684 else if (SBHE == e)
9685 {
9686 *ECN = 0.0;
9687 *ECHE = (-1.0) * SHE + BHE;
9688 *ECD = 0.0;
9689 *ECT = 0.0;
9690 *ECP = 0.0;
9691 *ECA = 0.0;
9692 *PROBN = 0.0;
9693 *PROBP = 0.0;
9694 *PROBD = 0.0;
9695 *PROBT = 0.0;
9696 *PROBHE = 1.0;
9697 *PROBA = 0.0;
9698 *PROBIMF = 0.0;
9699 *PROBF = 0.0;
9700 *PROBG = 0.0;
9701 }
9702 else
9703 {
9704 if (SBA == e)
9705 {
9706 *ECN = 0.0;
9707 *ECA = (-1.0) * SA + BA;
9708 *ECD = 0.0;
9709 *ECT = 0.0;
9710 *ECHE = 0.0;
9711 *ECP = 0.0;
9712 *PROBN = 0.0;
9713 *PROBP = 0.0;
9714 *PROBD = 0.0;
9715 *PROBT = 0.0;
9716 *PROBHE = 0.0;
9717 *PROBA = 1.0;
9718 *PROBIMF = 0.0;
9719 *PROBF = 0.0;
9720 *PROBG = 0.0;
9721 }
9722 }
9723
9724 return;
9725 }
9726
9727 void G4Abla::fissionDistri(G4double& A,
9728 G4double& Z,
9729 G4double& E,
9730 G4double& a1,
9731 G4double& z1,
9732 G4double& e1,
9733 G4double& v1,
9734 G4double& a2,
9735 G4double& z2,
9736 G4double& e2,
9737 G4double& v2,
9738 G4double& vx_eva_sc,
9739 G4double& vy_eva_sc,
9740 G4double& vz_eva_sc,
9741 G4int* NbLam0_par)
9742 {
9743
9744 /*
9745 Last update:
9746
9747 21/01/17 - J.L.R.S. - Implementation of this fission model in C++
9748
9749
9750 Authors: K.-H. Schmidt, A. Kelic, M. V. Ricciardi,J. Benlliure, and
9751 J.L.Rodriguez-Sanchez(1995 - 2017)
9752
9753 On input: A, Z, E (mass, atomic number and exc. energy of compound nucleus
9754 before fission)
9755 On output: Ai, Zi, Ei (mass, atomic number and (absolute) exc. energy of
9756 fragment 1 and 2 after fission)
9757
9758 */
9759 /* This program calculates isotopic distributions of fission fragments */
9760 /* with a semiempirical model */
9761 /* The width and eventually a shift in N/Z (polarization) follows the */
9762 /* following rules: */
9763 /* */
9764 /* The line N/Z following UCD has an angle of atan(Zcn/Ncn) */
9765 /* to the horizontal axis on a chart of nuclides. */
9766 /* (For 238U the angle is 32.2 deg.) */
9767 /* */
9768 /* The following relations hold: (from Armbruster)
9769 c
9770 c sigma(N) (A=const) = sigma(Z) (A=const)
9771 c sigma(A) (N=const) = sigma(Z) (N=const)
9772 c sigma(A) (Z=const) = sigma(N) (Z=const)
9773 c
9774 c From this we get:
9775 c sigma(Z) (N=const) * N = sigma(N) (Z=const) * Z
9776 c sigma(A) (Z=const) = sigma(Z) (A=const) * A/Z
9777 c sigma(N) (Z=const) = sigma(Z) (A=const) * A/Z
9778 c Z*sigma(N) (Z=const) = N*sigma(Z) (N=const) = A*sigma(Z) (A=const) */
9779 //
9780
9781 /* Model parameters:
9782 C These parameters have been adjusted to the compound nucleus 238U.
9783 c For the fission of another compound nucleus, it might be
9784 c necessary to slightly adjust some parameter values.
9785 c The most important ones are
9786 C Delta_U1_shell_max and
9787 c Delta_u2_shell.
9788 */
9789 G4double Nheavy1_in; // 'position of shell for Standard 1'
9790 Nheavy1_in = 83.0;
9791
9792 G4double Zheavy1_in; // 'position of shell for Standard 1'
9793 Zheavy1_in = 50.0;
9794
9795 G4double Nheavy2; // 'position of heavy peak valley 2'
9796 Nheavy2 = 89.0;
9797
9798 G4double Delta_U1_shell_max; // 'Shell effect for valley 1'
9799 Delta_U1_shell_max = -2.45;
9800
9801 G4double U1NZ_SLOPE; // Reduction of shell effect with distance to 132Sn
9802 U1NZ_SLOPE = 0.2;
9803
9804 G4double Delta_U2_shell; // 'Shell effect for valley 2'
9805 Delta_U2_shell = -2.45;
9806
9807 G4double X_s2s; // 'Ratio (C_sad/C_scis) of curvature of potential'
9808 X_s2s = 0.8;
9809
9810 G4double hbom1, hbom2, hbom3; // 'Curvature of potential at saddle'
9811 hbom1 = 0.2; // hbom1 is hbar * omega1 / (2 pi) !!!
9812 hbom2 = 0.2; // hbom2 is hbar * omega2 / (2 pi) !!!
9813 hbom3 = 0.2; // hbom3 is hbar * omega3 / (2 pi) !!!
9814
9815 G4double Fwidth_asymm1, Fwidth_asymm2, Fwidth_symm;
9816 // 'Factors for widths of distr. valley 1 and 2'
9817 Fwidth_asymm1 = 0.65;
9818 Fwidth_asymm2 = 0.65;
9819 Fwidth_symm = 1.16;
9820
9821 G4double xLevdens; // 'Parameter x: a = A/x'
9822 xLevdens = 10.75;
9823 // The value of 1/0.093 = 10.75 is consistent with the
9824 // systematics of the mass widths of Ref. (RuI97).
9825
9826 G4double FGAMMA; // 'Factor to gamma'
9827 FGAMMA = 1.; // Theoretical expectation, not adjusted to data.
9828 // Additional factor to attenuation coefficient of shell effects
9829 // with increasing excitation energy
9830
9831 G4double FGAMMA1; // 'Factor to gamma_heavy1'
9832 FGAMMA1 = 2.;
9833 // Adjusted to reduce the weight of Standard 1 with increasing
9834 // excitation energies, as required by experimental data.
9835
9836 G4double FREDSHELL;
9837 FREDSHELL = 0.;
9838 // Adjusted to the reduced attenuation of shells in the superfluid region.
9839 // If FGAMMA is modified,
9840 // FGAMMA * FREADSHELL should remain constant (0.65) to keep
9841 // the attenuation of the shell effects below the critical
9842 // pairing energy ECRIT unchanged, which has been carefully
9843 // adjusted to the mass yields of Vives and Zoeller in this
9844 // energy range. A high value of FGAMMA leads ot a stronger
9845 // attenuation of shell effects above the superfluid region.
9846
9847 G4double Ecrit;
9848 Ecrit = 5.;
9849 // The value of ECRIT determines the transition from a weak
9850 // decrease of the shell effect below ECRIT to a stronger
9851 // decrease above the superfluid range.
9852 const G4double d = 2.0; // 'Surface distance of scission configuration'
9853 // d = 2.0;
9854 // Charge polarisation from Wagemanns p. 397:
9855 G4double cpol1; // Charge polarisation standard I
9856 cpol1 = 0.35; // calculated internally with shells
9857 G4double cpol2; // Charge polarisation standard II
9858 cpol2 = 0.; // calculated internally from LDM
9859 G4double Friction_factor;
9860 Friction_factor = 1.0;
9861 G4double Nheavy1; // position of valley St 1 in Z and N
9862 G4double Delta_U1, Delta_U2; // used shell effects
9863 G4double cN_asymm1_shell, cN_asymm2_shell;
9864 G4double gamma, gamma_heavy1, gamma_heavy2; // fading of shells
9865 G4double E_saddle_scission; // friction from saddle to scission
9866 G4double Ysymm = 0.; // Yield of symmetric mode
9867 G4double Yasymm1 = 0.; // Yield of asymmetric mode 1
9868 G4double Yasymm2 = 0.; // Yield of asymmetric mode 2
9869 G4double Nheavy1_eff; // Effective position of valley 1
9870 G4double Nheavy2_eff; // Effective position of valley 2
9871 G4double eexc1_saddle; // Excitation energy above saddle 1
9872 G4double eexc2_saddle; // Excitation energy above saddle 2
9873 G4double EEXC_MAX; // Excitation energy above lowest saddle
9874 G4double r_e_o; // Even-odd effect in Z
9875 G4double cN_symm; // Curvature of symmetric valley
9876 G4double CZ; // Curvature of Z distribution for fixed A
9877 G4double Nheavy2_NZ; // Position of Shell 2, combined N and Z
9878 G4double N;
9879 G4double Aheavy1, Aheavy2;
9880 G4double Sasymm1 = 0., Sasymm2 = 0., Ssymm = 0., Ysum = 0., Yasymm = 0.;
9881 G4double Ssymm_mode1, Ssymm_mode2;
9882 G4double wNasymm1_saddle, wNasymm2_saddle, wNsymm_saddle;
9883 G4double wNasymm2_scission, wNsymm_scission;
9884 G4double wNasymm1, wNasymm2, wNsymm;
9885 G4int imode;
9886 G4double rmode;
9887 G4double ZA1width;
9888 G4double N1r, N2r, A1r, N1, N2;
9889 G4double Zsymm, Nsymm;
9890 G4double N1mean, N1width;
9891 G4double dUeff;
9892 /* effective shell effect at lowest barrier */
9893 G4double Eld;
9894 /* Excitation energy with respect to ld barrier */
9895 G4double re1, re2, re3;
9896 G4double eps1, eps2;
9897 G4double Z1UCD, Z2UCD;
9898 G4double beta = 0., beta1 = 0., beta2 = 0.;
9899 // double betacomplement;
9900 G4double DN1_POL;
9901 /* shift of most probable neutron number for given Z,
9902 according to polarization */
9903 G4int i_help;
9904 G4double A_levdens;
9905 /* level-density parameter */
9906 // double A_levdens_light1,A_levdens_light2;
9907 G4double A_levdens_heavy1, A_levdens_heavy2;
9908
9909 G4double R0 = 1.16;
9910
9911 G4double epsilon_1_saddle, epsilon0_1_saddle;
9912 G4double epsilon_2_saddle, epsilon0_2_saddle, epsilon_symm_saddle;
9913 G4double epsilon_1_scission; //,epsilon0_1_scission;
9914 G4double epsilon_2_scission; //,epsilon0_2_scission;
9915 G4double epsilon_symm_scission;
9916 /* modified energy */
9917 G4double E_eff1_saddle, E_eff2_saddle;
9918 G4double Epot0_mode1_saddle, Epot0_mode2_saddle, Epot0_symm_saddle;
9919 G4double Epot_mode1_saddle, Epot_mode2_saddle, Epot_symm_saddle;
9920 G4double E_defo, E_defo1, E_defo2, E_scission_pre = 0., E_scission_post;
9921 G4double E_asym;
9922 G4double E1exc = 0., E2exc = 0.;
9923 G4double E1exc_sigma, E2exc_sigma;
9924 G4double TKER;
9925 G4double EkinR1, EkinR2;
9926 G4double MassCurv_scis, MassCurv_sadd;
9927 G4double cN_symm_sadd;
9928 G4double Nheavy1_shell, Nheavy2_shell;
9929 G4double wNasymm1_scission;
9930 G4double Aheavy1_eff, Aheavy2_eff;
9931 G4double Z1rr, Z1r;
9932 G4double E_HELP;
9933 G4double Z_scission, N_scission, A_scission;
9934 G4double Z2_over_A_eff;
9935 G4double beta1gs = 0., beta2gs = 0., betags = 0.;
9936 G4double sigZmin; // 'Minimum neutron width for constant Z'
9937 G4double DSN132, Delta_U1_shell, E_eff0_saddle; //,e_scission;
9938 G4int NbLam0 = (*NbLam0_par);
9939 //
9940 sigZmin = 0.5;
9941 N = A - Z; /* neutron number of the fissioning nucleus */
9942 //
9943 cN_asymm1_shell = 0.700 * N / Z;
9944 cN_asymm2_shell = 0.040 * N / Z;
9945
9946 //*********************************************************************
9947
9948 DSN132 = Nheavy1_in - N / Z * Zheavy1_in;
9949 Aheavy1 = Nheavy1_in + Zheavy1_in + 0.340 * DSN132;
9950 /* Neutron number of valley Standard 1 */
9951 /* It is assumed that the 82-neutron shell effect is stronger than
9952 c the 50-proton shell effect. Therefore, the deviation in N/Z of
9953 c the fissioning nucleus from the N/Z of 132Sn will
9954 c change the position of the combined shell in mass. For neutron-
9955 c deficient fissioning nuclei, the mass will increase and vice
9956 c versa. */
9957
9958 Delta_U1_shell = Delta_U1_shell_max + U1NZ_SLOPE * std::abs(DSN132);
9959 Delta_U1_shell = min(0., Delta_U1_shell);
9960 /* Empirical reduction of shell effect with distance in N/Z of CN to 132Sn */
9961 /* Fits (239U,n)f and 226Th e.-m.-induced fission */
9962
9963 Nheavy1 = N / A * Aheavy1; /* UCD */
9964 Aheavy2 = Nheavy2 * A / N;
9965
9966 Zsymm = Z / 2.0; /* proton number in symmetric fission (centre) */
9967 Nsymm = N / 2.0;
9968 A_levdens = A / xLevdens;
9969 gamma = A_levdens / (0.40 * std::pow(A, 1.3333)) * FGAMMA;
9970 A_levdens_heavy1 = Aheavy1 / xLevdens;
9971 gamma_heavy1 = A_levdens_heavy1 / (0.40 * std::pow(Aheavy1, 1.3333)) * FGAMMA * FGAMMA1;
9972 A_levdens_heavy2 = Aheavy2 / xLevdens;
9973 gamma_heavy2 = A_levdens_heavy2 / (0.40 * std::pow(Aheavy2, 1.3333)) * FGAMMA;
9974
9975 // Energy dissipated from saddle to scission
9976 // F. Rejmund et al., Nucl. Phys. A 678 (2000) 215, fig. 4 b */
9977 E_saddle_scission = (-24. + 0.02227 * Z * Z / std::pow(A, 0.33333)) * Friction_factor;
9978 E_saddle_scission = max(0.0, E_saddle_scission);
9979
9980 // Fit to experimental result on curvature of potential at saddle
9981 // Parametrization of T. Enqvist according to Mulgin et al. 1998
9982 // MassCurv taken at scission. */
9983
9984 Z2_over_A_eff = Z * Z / A;
9985
9986 if (Z2_over_A_eff < 34.0)
9987 MassCurv_scis = std::pow(10., -1.093364 + 0.082933 * Z2_over_A_eff - 0.0002602 * Z2_over_A_eff * Z2_over_A_eff);
9988 else
9989 MassCurv_scis = std::pow(10., 3.053536 - 0.056477 * Z2_over_A_eff + 0.0002454 * Z2_over_A_eff * Z2_over_A_eff);
9990
9991 // to do:
9992 // fix the X with the channel intensities of 226Th (KHS at SEYSSINS,1998)
9993 // replace then (all) cN_symm by cN_symm_saddle (at least for Yields)
9994 MassCurv_sadd = X_s2s * MassCurv_scis;
9995
9996 cN_symm = 8.0 / std::pow(N, 2.) * MassCurv_scis;
9997 cN_symm_sadd = 8.0 / std::pow(N, 2.) * MassCurv_sadd;
9998
9999 Nheavy1_shell = Nheavy1;
10000
10001 if (E < 100.0)
10002 Nheavy1_eff = (cN_symm_sadd * Nsymm +
10003 cN_asymm1_shell * Uwash(E / A * Aheavy1, Ecrit, FREDSHELL, gamma_heavy1) * Nheavy1_shell) /
10004 (cN_symm_sadd + cN_asymm1_shell * Uwash(E / A * Aheavy1, Ecrit, FREDSHELL, gamma_heavy1));
10005 else
10006 Nheavy1_eff = (cN_symm_sadd * Nsymm + cN_asymm1_shell * Nheavy1_shell) / (cN_symm_sadd + cN_asymm1_shell);
10007
10008 /* Position of Standard II defined by neutron shell */
10009 Nheavy2_NZ = Nheavy2;
10010 Nheavy2_shell = Nheavy2_NZ;
10011 if (E < 100.)
10012 Nheavy2_eff = (cN_symm_sadd * Nsymm +
10013 cN_asymm2_shell * Uwash(E / A * Aheavy2, Ecrit, FREDSHELL, gamma_heavy2) * Nheavy2_shell) /
10014 (cN_symm_sadd + cN_asymm2_shell * Uwash(E / A * Aheavy2, Ecrit, FREDSHELL, gamma_heavy2));
10015 else
10016 Nheavy2_eff = (cN_symm_sadd * Nsymm + cN_asymm2_shell * Nheavy2_shell) / (cN_symm_sadd + cN_asymm2_shell);
10017
10018 Delta_U1 = Delta_U1_shell + (Nheavy1_shell - Nheavy1_eff) * (Nheavy1_shell - Nheavy1_eff) *
10019 cN_asymm1_shell; /* shell effect in valley of mode 1 */
10020 Delta_U1 = min(Delta_U1, 0.0);
10021 Delta_U2 = Delta_U2_shell + (Nheavy2_shell - Nheavy2_eff) * (Nheavy2_shell - Nheavy2_eff) *
10022 cN_asymm2_shell; /* shell effect in valley of mode 2 */
10023 Delta_U2 = min(Delta_U2, 0.0);
10024
10025 // liquid drop energies at the centres of the different shell effects
10026 // with respect to liquid drop at symmetry
10027 Epot0_mode1_saddle = (Nheavy1_eff - Nsymm) * (Nheavy1_eff - Nsymm) * cN_symm_sadd;
10028 Epot0_mode2_saddle = (Nheavy2_eff - Nsymm) * (Nheavy2_eff - Nsymm) * cN_symm_sadd;
10029 Epot0_symm_saddle = 0.0;
10030
10031 // energies including shell effects at the centres of the different
10032 // shell effects with respect to liquid drop at symmetry */
10033 Epot_mode1_saddle = Epot0_mode1_saddle + Delta_U1;
10034 Epot_mode2_saddle = Epot0_mode2_saddle + Delta_U2;
10035 Epot_symm_saddle = Epot0_symm_saddle;
10036
10037 // minimum of potential with respect to ld potential at symmetry
10038 dUeff = min(Epot_mode1_saddle, Epot_mode2_saddle);
10039 dUeff = min(dUeff, Epot_symm_saddle);
10040 dUeff = dUeff - Epot_symm_saddle;
10041
10042 Eld = E + dUeff;
10043 // E = energy above lowest effective barrier
10044 // Eld = energy above liquid-drop barrier
10045 // Due to this treatment the energy E on input means the excitation
10046 // energy above the lowest saddle. */
10047
10048 // excitation energies at saddle modes 1 and 2 without shell effect */
10049 epsilon0_1_saddle = Eld - Epot0_mode1_saddle;
10050 epsilon0_2_saddle = Eld - Epot0_mode2_saddle;
10051
10052 // excitation energies at saddle modes 1 and 2 with shell effect */
10053 epsilon_1_saddle = Eld - Epot_mode1_saddle;
10054 epsilon_2_saddle = Eld - Epot_mode2_saddle;
10055
10056 epsilon_symm_saddle = Eld - Epot_symm_saddle;
10057 // epsilon_symm_saddle = Eld - dUeff;
10058
10059 eexc1_saddle = epsilon_1_saddle;
10060 eexc2_saddle = epsilon_2_saddle;
10061
10062 // EEXC_MAX is energy above the lowest saddle */
10063 EEXC_MAX = max(eexc1_saddle, eexc2_saddle);
10064 EEXC_MAX = max(EEXC_MAX, Eld);
10065
10066 // excitation energy at scission */
10067 epsilon_1_scission = Eld + E_saddle_scission - Epot_mode1_saddle;
10068 epsilon_2_scission = Eld + E_saddle_scission - Epot_mode2_saddle;
10069
10070 // excitation energy of symmetric fragment at scission */
10071 epsilon_symm_scission = Eld + E_saddle_scission - Epot_symm_saddle;
10072
10073 // calculate widhts at the saddle
10074 E_eff1_saddle =
10075 epsilon0_1_saddle - Delta_U1 * Uwash(epsilon_1_saddle / A * Aheavy1, Ecrit, FREDSHELL, gamma_heavy1);
10076
10077 if (E_eff1_saddle < A_levdens * hbom1 * hbom1)
10078 E_eff1_saddle = A_levdens * hbom1 * hbom1;
10079
10080 wNasymm1_saddle = std::sqrt(
10081 0.50 * std::sqrt(1.0 / A_levdens * E_eff1_saddle) /
10082 (cN_asymm1_shell * Uwash(epsilon_1_saddle / A * Aheavy1, Ecrit, FREDSHELL, gamma_heavy1) + cN_symm_sadd));
10083
10084 E_eff2_saddle =
10085 epsilon0_2_saddle - Delta_U2 * Uwash(epsilon_2_saddle / A * Aheavy2, Ecrit, FREDSHELL, gamma_heavy2);
10086
10087 if (E_eff2_saddle < A_levdens * hbom2 * hbom2)
10088 E_eff2_saddle = A_levdens * hbom2 * hbom2;
10089
10090 wNasymm2_saddle = std::sqrt(
10091 0.50 * std::sqrt(1.0 / A_levdens * E_eff2_saddle) /
10092 (cN_asymm2_shell * Uwash(epsilon_2_saddle / A * Aheavy2, Ecrit, FREDSHELL, gamma_heavy2) + cN_symm_sadd));
10093
10094 E_eff0_saddle = epsilon_symm_saddle;
10095 if (E_eff0_saddle < A_levdens * hbom3 * hbom3)
10096 E_eff0_saddle = A_levdens * hbom3 * hbom3;
10097
10098 wNsymm_saddle = std::sqrt(0.50 * std::sqrt(1.0 / A_levdens * E_eff0_saddle) / cN_symm_sadd);
10099
10100 if (epsilon_symm_scission > 0.0)
10101 {
10102 E_HELP = max(E_saddle_scission, epsilon_symm_scission);
10103 wNsymm_scission = std::sqrt(0.50 * std::sqrt(1.0 / A_levdens * (E_HELP)) / cN_symm);
10104 }
10105 else
10106 {
10107 wNsymm_scission = std::sqrt(0.50 * std::sqrt(1.0 / A_levdens * E_saddle_scission) / cN_symm);
10108 }
10109
10110 // Calculate widhts at the scission point:
10111 // fits of ref. Beizin 1991 (Plots by Sergei Zhdanov)
10112
10113 if (E_saddle_scission == 0.0)
10114 {
10115 wNasymm1_scission = wNasymm1_saddle;
10116 wNasymm2_scission = wNasymm2_saddle;
10117 }
10118 else
10119 {
10120 if (Nheavy1_eff > 75.0)
10121 {
10122 wNasymm1_scission = std::sqrt(21.0) * N / A;
10123 wNasymm2_scission = max(12.8 - 1.0 * (92.0 - Nheavy2_eff), 1.0) * N / A;
10124 }
10125 else
10126 {
10127 wNasymm1_scission = wNasymm1_saddle;
10128 wNasymm2_scission = wNasymm2_saddle;
10129 }
10130 }
10131
10132 wNasymm1_scission = max(wNasymm1_scission, wNasymm1_saddle);
10133 wNasymm2_scission = max(wNasymm2_scission, wNasymm2_saddle);
10134
10135 wNasymm1 = wNasymm1_scission * Fwidth_asymm1;
10136 wNasymm2 = wNasymm2_scission * Fwidth_asymm2;
10137 wNsymm = wNsymm_scission * Fwidth_symm;
10138
10139 // mass and charge of fragments using UCD, needed for level densities
10140 Aheavy1_eff = Nheavy1_eff * A / N;
10141 Aheavy2_eff = Nheavy2_eff * A / N;
10142
10143 A_levdens_heavy1 = Aheavy1_eff / xLevdens;
10144 A_levdens_heavy2 = Aheavy2_eff / xLevdens;
10145 gamma_heavy1 = A_levdens_heavy1 / (0.40 * std::pow(Aheavy1_eff, 1.3333)) * FGAMMA * FGAMMA1;
10146 gamma_heavy2 = A_levdens_heavy2 / (0.40 * std::pow(Aheavy2_eff, 1.3333)) * FGAMMA;
10147
10148 if (epsilon_symm_saddle < A_levdens * hbom3 * hbom3)
10149 Ssymm = 2.0 * std::sqrt(A_levdens * A_levdens * hbom3 * hbom3) +
10150 (epsilon_symm_saddle - A_levdens * hbom3 * hbom3) / hbom3;
10151 else
10152 Ssymm = 2.0 * std::sqrt(A_levdens * epsilon_symm_saddle);
10153
10154 Ysymm = 1.0;
10155
10156 if (epsilon0_1_saddle < A_levdens * hbom1 * hbom1)
10157 Ssymm_mode1 = 2.0 * std::sqrt(A_levdens * A_levdens * hbom1 * hbom1) +
10158 (epsilon0_1_saddle - A_levdens * hbom1 * hbom1) / hbom1;
10159 else
10160 Ssymm_mode1 = 2.0 * std::sqrt(A_levdens * epsilon0_1_saddle);
10161
10162 if (epsilon0_2_saddle < A_levdens * hbom2 * hbom2)
10163 Ssymm_mode2 = 2.0 * std::sqrt(A_levdens * A_levdens * hbom2 * hbom2) +
10164 (epsilon0_2_saddle - A_levdens * hbom2 * hbom2) / hbom2;
10165 else
10166 Ssymm_mode2 = 2.0 * std::sqrt(A_levdens * epsilon0_2_saddle);
10167
10168 if (epsilon0_1_saddle - Delta_U1 * Uwash(epsilon_1_saddle / A * Aheavy1, Ecrit, FREDSHELL, gamma_heavy1) <
10169 A_levdens * hbom1 * hbom1)
10170 Sasymm1 =
10171 2.0 * std::sqrt(A_levdens * A_levdens * hbom1 * hbom1) +
10172 (epsilon0_1_saddle - Delta_U1 * Uwash(epsilon_1_saddle / A * Aheavy1, Ecrit, FREDSHELL, gamma_heavy1) -
10173 A_levdens * hbom1 * hbom1) /
10174 hbom1;
10175 else
10176 Sasymm1 = 2.0 * std::sqrt(A_levdens *
10177 (epsilon0_1_saddle -
10178 Delta_U1 * Uwash(epsilon_1_saddle / A * Aheavy1, Ecrit, FREDSHELL, gamma_heavy1)));
10179
10180 if (epsilon0_2_saddle - Delta_U2 * Uwash(epsilon_2_saddle / A * Aheavy2, Ecrit, FREDSHELL, gamma_heavy2) <
10181 A_levdens * hbom2 * hbom2)
10182 Sasymm2 =
10183 2.0 * std::sqrt(A_levdens * A_levdens * hbom2 * hbom2) +
10184 (epsilon0_1_saddle - Delta_U1 * Uwash(epsilon_2_saddle / A * Aheavy2, Ecrit, FREDSHELL, gamma_heavy2) -
10185 A_levdens * hbom2 * hbom2) /
10186 hbom2;
10187 else
10188 Sasymm2 = 2.0 * std::sqrt(A_levdens *
10189 (epsilon0_2_saddle -
10190 Delta_U2 * Uwash(epsilon_2_saddle / A * Aheavy2, Ecrit, FREDSHELL, gamma_heavy2)));
10191
10192 Yasymm1 = (std::exp(Sasymm1 - Ssymm) - std::exp(Ssymm_mode1 - Ssymm)) * wNasymm1_saddle / wNsymm_saddle * 2.0;
10193
10194 Yasymm2 = (std::exp(Sasymm2 - Ssymm) - std::exp(Ssymm_mode2 - Ssymm)) * wNasymm2_saddle / wNsymm_saddle * 2.0;
10195
10196 Ysum = Ysymm + Yasymm1 + Yasymm2; /* normalize */
10197
10198 if (Ysum > 0.00)
10199 {
10200 Ysymm = Ysymm / Ysum;
10201 Yasymm1 = Yasymm1 / Ysum;
10202 Yasymm2 = Yasymm2 / Ysum;
10203 Yasymm = Yasymm1 + Yasymm2;
10204 }
10205 else
10206 {
10207 Ysymm = 0.0;
10208 Yasymm1 = 0.0;
10209 Yasymm2 = 0.0;
10210 // search minimum threshold and attribute all events to this mode */
10211 if ((epsilon_symm_saddle < epsilon_1_saddle) && (epsilon_symm_saddle < epsilon_2_saddle))
10212 Ysymm = 1.0;
10213 else if (epsilon_1_saddle < epsilon_2_saddle)
10214 Yasymm1 = 1.0;
10215 else
10216 Yasymm2 = 1.0;
10217 }
10218 // even-odd effect
10219 // Parametrization from Rejmund et al.
10220 if (mod(Z, 2.0) == 0)
10221 r_e_o = std::pow(10.0, -0.0170 * (E_saddle_scission + Eld) * (E_saddle_scission + Eld));
10222 else
10223 r_e_o = 0.0;
10224
10225 /* -------------------------------------------------------
10226 c selecting the fission mode using the yields at scission
10227 c -------------------------------------------------------
10228 c random decision: symmetric or asymmetric
10229 c IMODE = 1 means asymmetric fission, mode 1
10230 c IMODE = 2 means asymmetric fission, mode 2
10231 c IMODE = 3 means symmetric fission
10232 c testcase: 238U, E*= 6 MeV : 6467 8781 4752 (20000)
10233 c 127798 176480 95722 (400000)
10234 c 319919 440322 239759 (1000000)
10235 c E*=12 MeV : 153407 293063 553530 (1000000) */
10236
10237 fiss321: // rmode = DBLE(HAZ(k))
10238 rmode = G4AblaRandom::flat();
10239 if (rmode < Yasymm1)
10240 imode = 1;
10241 else if ((rmode > Yasymm1) && (rmode < Yasymm))
10242 imode = 2;
10243 else
10244 imode = 3;
10245
10246 // determine parameters of the neutron distribution of each mode
10247 // at scission
10248
10249 if (imode == 1)
10250 {
10251 N1mean = Nheavy1_eff;
10252 N1width = wNasymm1;
10253 }
10254 else
10255 {
10256 if (imode == 2)
10257 {
10258 N1mean = Nheavy2_eff;
10259 N1width = wNasymm2;
10260 }
10261 else
10262 {
10263 // if( imode == 3 ) then
10264 N1mean = Nsymm;
10265 N1width = wNsymm;
10266 }
10267 }
10268
10269 // N2mean needed by CZ below
10270 // N2mean = N - N1mean;
10271
10272 // fission mode found, then the determination of the
10273 // neutron numbers N1 and N2 at scission by randon decision
10274 N1r = 1.0;
10275 N2r = 1.0;
10276 while (N1r < 5.0 || N2r < 5.0)
10277 {
10278 // N1r = DBLE(GaussHaz(k,sngl(N1mean), sngl(N1width) ))
10279 // N1r = N1mean+G4AblaRandom::gaus(N1width);//
10280 N1r = gausshaz(0, N1mean, N1width);
10281 N2r = N - N1r;
10282 }
10283
10284 // --------------------------------------------------
10285 // first approximation of fission fragments using UCD at saddle
10286 // --------------------------------------------------
10287 Z1UCD = Z / N * N1r;
10288 Z2UCD = Z / N * N2r;
10289 A1r = A / N * N1r;
10290 //
10291 // --------------------------
10292 // deformations: starting ...
10293 // -------------------------- */
10294 if (imode == 1)
10295 {
10296 // --- N = 82 */
10297 E_scission_pre = max(epsilon_1_scission, 1.0);
10298 // ! Eexc at scission, neutron evaporation from saddle to scission not
10299 // considered */
10300 if (N1mean > N * 0.50)
10301 {
10302 beta1 = 0.0; /* 1. fragment is spherical */
10303 beta2 = 0.55; /* 2. fragment is deformed 0.5*/
10304 }
10305 else
10306 {
10307 beta1 = 0.55; /* 1. fragment is deformed 0.5*/
10308 beta2 = 0.00; /* 2. fragment is spherical */
10309 }
10310 }
10311 if (imode == 2)
10312 {
10313 // --- N appr. 86 */
10314 E_scission_pre = max(epsilon_2_scission, 1.0);
10315 if (N1mean > N * 0.50)
10316 {
10317 beta1 = (N1r - 92.0) * 0.030 + 0.60;
10318
10319 beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
10320 beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
10321
10322 beta1 = max(beta1, beta1gs);
10323 beta2 = 1.0 - beta1;
10324 beta2 = max(beta2, beta2gs);
10325 }
10326 else
10327 {
10328
10329 beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
10330 beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
10331
10332 beta2 = (N2r - 92.0) * 0.030 + 0.60;
10333 beta2 = max(beta2, beta2gs);
10334 beta1 = 1.0 - beta2;
10335 beta1 = max(beta1, beta1gs);
10336 }
10337 }
10338 beta = 0.0;
10339 if (imode == 3)
10340 {
10341 // if( imode >0 ){
10342 // --- Symmetric fission channel
10343 // the fit function for beta is the deformation for optimum energy
10344 // at the scission point, d = 2
10345 // beta : deformation of symmetric fragments
10346 // beta1 : deformation of first fragment
10347 // beta2 : deformation of second fragment
10348 betags = ecld->beta2[idint(Nsymm)][idint(Zsymm)];
10349 beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
10350 beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
10351 beta = max(0.177963 + 0.0153241 * Zsymm - 1.62037e-4 * Zsymm * Zsymm, betags);
10352 beta1 = max(0.177963 + 0.0153241 * Z1UCD - 1.62037e-4 * Z1UCD * Z1UCD, beta1gs);
10353 beta2 = max(0.177963 + 0.0153241 * Z2UCD - 1.62037e-4 * Z2UCD * Z2UCD, beta2gs);
10354
10355 E_asym = frldm(Z1UCD, N1r, beta1) + frldm(Z2UCD, N2r, beta2) +
10356 ecoul(Z1UCD, N1r, beta1, Z2UCD, N2r, beta2, 2.0) - 2.0 * frldm(Zsymm, Nsymm, beta) -
10357 ecoul(Zsymm, Nsymm, beta, Zsymm, Nsymm, beta, 2.0);
10358 E_scission_pre = max(epsilon_symm_scission - E_asym, 1.);
10359 }
10360 // -----------------------
10361 // ... end of deformations
10362 // -----------------------
10363
10364 // ------------------------------------------
10365 // evaporation from saddle to scission ...
10366 // ------------------------------------------
10367 if (E_scission_pre > 5. && NbLam0 < 1)
10368 {
10369 evap_postsaddle(
10370 A, Z, E_scission_pre, &E_scission_post, &A_scission, &Z_scission, vx_eva_sc, vy_eva_sc, vz_eva_sc, &NbLam0);
10371 N_scission = A_scission - Z_scission;
10372 }
10373 else
10374 {
10375 A_scission = A;
10376 Z_scission = Z;
10377 E_scission_post = E_scission_pre;
10378 N_scission = A_scission - Z_scission;
10379 }
10380 // ---------------------------------------------------
10381 // second approximation of fission fragments using UCD
10382 // --------------------------------------------------- */
10383 //
10384 N1r = N1r * N_scission / N;
10385 N2r = N2r * N_scission / N;
10386 Z1UCD = Z1UCD * Z_scission / Z;
10387 Z2UCD = Z2UCD * Z_scission / Z;
10388 A1r = Z1UCD + N1r;
10389
10390 // ---------------------------------------------------------
10391 // determination of the charge and mass of the fragments ...
10392 // ---------------------------------------------------------
10393
10394 // - CZ is the curvature of charge distribution for fixed mass,
10395 // common to all modes, gives the width of the charge distribution.
10396 // The physics picture behind is that the division of the
10397 // fissioning nucleus in N and Z is slow when mass transport from
10398 // one nascent fragment to the other is concerned but fast when the
10399 // N/Z degree of freedom is concernded. In addition, the potential
10400 // minima in direction of mass transport are broad compared to the
10401 // potential minimum in N/Z direction.
10402 // The minima in direction of mass transport are calculated
10403 // by the liquid-drop (LD) potential (for superlong mode),
10404 // by LD + N=82 shell (for standard 1 mode) and
10405 // by LD + N=86 shell (for standard 2 mode).
10406 // Since the variation of N/Z is fast, it can quickly adjust to
10407 // the potential and is thus determined close to scission.
10408 // Thus, we calculate the mean N/Z and its width for fixed mass
10409 // at scission.
10410 // For the SL mode, the mean N/Z is calculated by the
10411 // minimum of the potential at scission as a function of N/Z for
10412 // fixed mass.
10413 // For the S1 and S2 modes, this correlation is imposed by the
10414 // empirical charge polarisation.
10415 // For the SL mode, the fluctuation in this width is calculated
10416 // from the curvature of the potential at scission as a function
10417 // of N/Z. This value is also used for the widths of S1 and S2.
10418
10419 // Polarisation assumed for standard I and standard II:
10420 // Z - Zucd = cpol (for A = const);
10421 // from this we get (see remarks above)
10422 // Z - Zucd = Acn/Ncn * cpol (for N = const) */
10423 //
10424 CZ = (frldm(Z1UCD - 1.0, N1r + 1.0, beta1) + frldm(Z2UCD + 1.0, N2r - 1.0, beta2) +
10425 frldm(Z1UCD + 1.0, N1r - 1.0, beta1) + frldm(Z2UCD - 1.0, N2r + 1.0, beta2) +
10426 ecoul(Z1UCD - 1.0, N1r + 1.0, beta1, Z2UCD + 1.0, N2r - 1.0, beta2, 2.0) +
10427 ecoul(Z1UCD + 1.0, N1r - 1.0, beta1, Z2UCD - 1.0, N2r + 1.0, beta2, 2.0) -
10428 2.0 * ecoul(Z1UCD, N1r, beta1, Z2UCD, N2r, beta2, 2.0) - 2.0 * frldm(Z1UCD, N1r, beta1) -
10429 2.0 * frldm(Z2UCD, N2r, beta2)) *
10430 0.50;
10431 //
10432 if (1.0 / A_levdens * E_scission_post < 0.0)
10433 std::cout << "DSQRT 1 < 0" << A_levdens << " " << E_scission_post << std::endl;
10434
10435 if (0.50 * std::sqrt(1.0 / A_levdens * E_scission_post) / CZ < 0.0)
10436 {
10437 std::cout << "DSQRT 2 < 0 " << CZ << std::endl;
10438 std::cout << "This event was not considered" << std::endl;
10439 goto fiss321;
10440 }
10441
10442 ZA1width = std::sqrt(0.5 * std::sqrt(1.0 / A_levdens * E_scission_post) / CZ);
10443
10444 // Minimum width in N/Z imposed.
10445 // Value of minimum width taken from 235U(nth,f) data
10446 // sigma_Z(A=const) = 0.4 to 0.5 (from Lang paper Nucl Phys. A345 (1980)
10447 // 34) sigma_N(Z=const) = 0.45 * A/Z (= 1.16 for 238U)
10448 // therefore: SIGZMIN = 1.16
10449 // Physics; variation in N/Z for fixed A assumed.
10450 // Thermal energy at scission is reduced by
10451 // pre-scission neutron evaporation"
10452
10453 ZA1width = max(ZA1width, sigZmin);
10454
10455 if (imode == 1 && cpol1 != 0.0)
10456 {
10457 // --- asymmetric fission, mode 1 */
10458 G4int IS = 0;
10459 fiss2801:
10460 Z1rr = Z1UCD - cpol1 * A_scission / N_scission;
10461 // Z1r = DBLE(GaussHaz(k,sngl(Z1rr), sngl(ZA1width) ));
10462 // Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);//
10463 Z1r = gausshaz(0, Z1rr, ZA1width);
10464 IS = IS + 1;
10465 if (IS > 100)
10466 {
10467 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN "
10468 "CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED"
10469 << std::endl;
10470 Z1r = Z1rr;
10471 }
10472 if ((utilabs(Z1rr - Z1r) > 3.0 * ZA1width) || Z1r < 1.0)
10473 goto fiss2801;
10474 N1r = A1r - Z1r;
10475 }
10476 else
10477 {
10478 if (imode == 2 && cpol2 != 0.0)
10479 {
10480 // --- asymmetric fission, mode 2 */
10481 G4int IS = 0;
10482 fiss2802:
10483 Z1rr = Z1UCD - cpol2 * A_scission / N_scission;
10484 // Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);//
10485 Z1r = gausshaz(0, Z1rr, ZA1width);
10486 IS = IS + 1;
10487 if (IS > 100)
10488 {
10489 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN "
10490 "CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED"
10491 << std::endl;
10492 Z1r = Z1rr;
10493 }
10494 if ((utilabs(Z1rr - Z1r) > 3.0 * ZA1width) || Z1r < 1.0)
10495 goto fiss2802;
10496 N1r = A1r - Z1r;
10497 }
10498 else
10499 {
10500 // Otherwise do; /* Imode = 3 in any case; imode = 1 and 2 for CPOL =
10501 // 0 */
10502 // and symmetric case */
10503 // We treat a simultaneous split in Z and N to determine
10504 // polarisation */
10505
10506 re1 = frldm(Z1UCD - 1.0, N1r + 1.0, beta1) + frldm(Z2UCD + 1.0, N2r - 1.0, beta2) +
10507 ecoul(Z1UCD - 1.0, N1r + 1.0, beta1, Z2UCD + 1.0, N2r - 1.0, beta2, d); /* d = 2 fm */
10508 re2 = frldm(Z1UCD, N1r, beta1) + frldm(Z2UCD, N2r, beta2) +
10509 ecoul(Z1UCD, N1r, beta1, Z2UCD, N2r, beta2, d); /* d = 2 fm */
10510 re3 = frldm(Z1UCD + 1.0, N1r - 1.0, beta1) + frldm(Z2UCD - 1.0, N2r + 1.0, beta2) +
10511 ecoul(Z1UCD + 1.0, N1r - 1.0, beta1, Z2UCD - 1.0, N2r + 1.0, beta2, d); /* d = 2 fm */
10512 eps2 = (re1 - 2.0 * re2 + re3) / 2.0;
10513 eps1 = (re3 - re1) / 2.0;
10514 DN1_POL = -eps1 / (2.0 * eps2);
10515 //
10516 Z1rr = Z1UCD + DN1_POL;
10517
10518 // Polarization of Standard 1 from shell effects around 132Sn
10519 if (imode == 1)
10520 {
10521 if (Z1rr > 50.0)
10522 {
10523 DN1_POL = DN1_POL - 0.6 * Uwash(E_scission_post, Ecrit, FREDSHELL, gamma);
10524 Z1rr = Z1UCD + DN1_POL;
10525 if (Z1rr < 50.)
10526 Z1rr = 50.0;
10527 }
10528 else
10529 {
10530 DN1_POL = DN1_POL + 0.60 * Uwash(E_scission_post, Ecrit, FREDSHELL, gamma);
10531 Z1rr = Z1UCD + DN1_POL;
10532 if (Z1rr > 50.0)
10533 Z1rr = 50.0;
10534 }
10535 }
10536
10537 G4int IS = 0;
10538 fiss2803:
10539 // Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);
10540 Z1r = gausshaz(0, Z1rr, ZA1width);
10541 IS = IS + 1;
10542 if (IS > 100)
10543 {
10544 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN "
10545 "CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED"
10546 << std::endl;
10547 Z1r = Z1rr;
10548 }
10549
10550 if ((utilabs(Z1rr - Z1r) > 3.0 * ZA1width) || (Z1r < 1.0))
10551 goto fiss2803;
10552 N1r = A1r - Z1r;
10553 }
10554 }
10555
10556 // ------------------------------------------
10557 // Integer proton number with even-odd effect
10558 // ------------------------------------------
10559 even_odd(Z1r, r_e_o, i_help);
10560
10561 z1 = G4double(i_help);
10562 z2 = dint(Z_scission) - z1;
10563 N1 = dint(N1r);
10564 N2 = dint(N_scission) - N1;
10565 a1 = z1 + N1;
10566 a2 = z2 + N2;
10567
10568 if ((z1 < 0) || (z2 < 0) || (a1 < 0) || (a2 < 0))
10569 {
10570 std::cout << " -------------------------------" << std::endl;
10571 std::cout << " Z, A, N : " << Z << " " << A << " " << N << std::endl;
10572 std::cout << z1 << " " << z2 << " " << a1 << " " << a2 << std::endl;
10573 std::cout << E_scission_post << " " << A_levdens << " " << CZ << std::endl;
10574
10575 std::cout << " -------------------------------" << std::endl;
10576 }
10577
10578 // -----------------------
10579 // excitation energies ...
10580 // -----------------------
10581 //
10582 if (imode == 1)
10583 {
10584 // ---- N = 82
10585 if (N1mean > N * 0.50)
10586 {
10587 // (a) 1. fragment is spherical and 2. fragment is deformed */
10588 E_defo = 0.0;
10589 beta2gs = ecld->beta2[idint(N2)][idint(z2)];
10590 if (beta2 < beta2gs)
10591 beta2 = beta2gs;
10592 E1exc = E_scission_pre * a1 / A + E_defo;
10593 E_defo = frldm(z2, N2, beta2) - frldm(z2, N2, beta2gs);
10594 E2exc = E_scission_pre * a2 / A + E_defo;
10595 }
10596 else
10597 {
10598 // (b) 1. fragment is deformed and 2. fragment is spherical */
10599 beta1gs = ecld->beta2[idint(N1)][idint(z1)];
10600 if (beta1 < beta1gs)
10601 beta1 = beta1gs;
10602 E_defo = frldm(z1, N1, beta1) - frldm(z1, N1, beta1gs);
10603 E1exc = E_scission_pre * a1 / A + E_defo;
10604 E_defo = 0.0;
10605 E2exc = E_scission_pre * a2 / A + E_defo;
10606 }
10607 }
10608
10609 if (imode == 2)
10610 {
10611 // --- N appr. 86 */
10612 if (N1mean > N * 0.5)
10613 {
10614 /* 2. fragment is spherical */
10615 beta1gs = ecld->beta2[idint(N1)][idint(z1)];
10616 if (beta1 < beta1gs)
10617 beta1 = beta1gs;
10618 E_defo = frldm(z1, N1, beta1) - frldm(z1, N1, beta1gs);
10619 E1exc = E_scission_pre * a1 / A + E_defo;
10620 beta2gs = ecld->beta2[idint(N2)][idint(z2)];
10621 if (beta2 < beta2gs)
10622 beta2 = beta2gs;
10623 E_defo = frldm(z2, N2, beta2) - frldm(z2, N2, beta2gs);
10624 E2exc = E_scission_pre * a2 / A + E_defo;
10625 }
10626 else
10627 {
10628 /* 1. fragment is spherical */
10629 beta2gs = ecld->beta2[idint(N2)][idint(z2)];
10630 if (beta2 < beta2gs)
10631 beta2 = beta2gs;
10632 E_defo = frldm(z2, N2, beta2) - frldm(z2, N2, beta2gs);
10633 E2exc = E_scission_pre * a2 / A + E_defo;
10634 beta1gs = ecld->beta2[idint(N1)][idint(z1)];
10635 if (beta1 < beta1gs)
10636 beta1 = beta1gs;
10637 E_defo = frldm(z1, N1, beta1) - frldm(z1, N1, beta1gs);
10638 E1exc = E_scission_pre * a1 / A + E_defo;
10639 }
10640 }
10641
10642 if (imode == 3)
10643 {
10644 // --- Symmetric fission channel
10645 beta1gs = ecld->beta2[idint(N1)][idint(z1)];
10646 if (beta1 < beta1gs)
10647 beta1 = beta1gs;
10648 beta2gs = ecld->beta2[idint(N2)][idint(z2)];
10649 if (beta2 < beta2gs)
10650 beta2 = beta2gs;
10651 E_defo1 = frldm(z1, N1, beta1) - frldm(z1, N1, beta1gs);
10652 E_defo2 = frldm(z2, N2, beta2) - frldm(z2, N2, beta2gs);
10653 E1exc = E_scission_pre * a1 / A + E_defo1;
10654 E2exc = E_scission_pre * a2 / A + E_defo2;
10655 }
10656
10657 // pre-neutron-emission total kinetic energy */
10658 TKER = (z1 * z2 * 1.440) / (R0 * std::pow(a1, 0.333330) * (1.0 + 2.0 / 3.0 * beta1) +
10659 R0 * std::pow(a2, 0.333330) * (1.0 + 2.0 / 3.0 * beta2) + 2.0);
10660 // Pre-neutron-emission kinetic energies of the fragments */
10661 EkinR1 = TKER * a2 / A;
10662 EkinR2 = TKER * a1 / A;
10663 v1 = std::sqrt(EkinR1 / a1) * 1.3887;
10664 v2 = std::sqrt(EkinR2 / a2) * 1.3887;
10665
10666 // Extracted from Lang et al. Nucl. Phys. A 345 (1980) 34 */
10667 E1exc_sigma = 5.50;
10668 E2exc_sigma = 5.50;
10669
10670 fis987:
10671 // e1 = E1exc+G4AblaRandom::gaus(E1exc_sigma);//
10672 e1 = gausshaz(0, E1exc, E1exc_sigma);
10673 if (e1 < 0.)
10674 goto fis987;
10675 fis988:
10676 // e2 = E2exc+G4AblaRandom::gaus(E2exc_sigma);//
10677 e2 = gausshaz(0, E2exc, E2exc_sigma);
10678 if (e2 < 0.)
10679 goto fis988;
10680
10681 (*NbLam0_par) = NbLam0;
10682 return;
10683 }
10684
10685 void G4Abla::even_odd(G4double r_origin, G4double r_even_odd, G4int& i_out)
10686 {
10687 // Procedure to calculate I_OUT from R_IN in a way that
10688 // on the average a flat distribution in R_IN results in a
10689 // fluctuating distribution in I_OUT with an even-odd effect as
10690 // given by R_EVEN_ODD
10691
10692 // /* ------------------------------------------------------------ */
10693 // /* EXAMPLES : */
10694 // /* ------------------------------------------------------------ */
10695 // /* If R_EVEN_ODD = 0 : */
10696 // /* CEIL(R_IN) ---- */
10697 // /* */
10698 // /* R_IN -> */
10699 // /* (somewhere in between CEIL(R_IN) and FLOOR(R_IN)) */ */
10700 // /* */
10701 // /* FLOOR(R_IN) ---- --> I_OUT */
10702 // /* ------------------------------------------------------------ */
10703 // /* If R_EVEN_ODD > 0 : */
10704 // /* The interval for the above treatment is */
10705 // /* larger for FLOOR(R_IN) = even and */
10706 // /* smaller for FLOOR(R_IN) = odd */
10707 // /* For R_EVEN_ODD < 0 : just opposite treatment */
10708 // /* ------------------------------------------------------------ */
10709
10710 // /* ------------------------------------------------------------ */
10711 // /* On input: R_ORIGIN nuclear charge (real number) */
10712 // /* R_EVEN_ODD requested even-odd effect */
10713 // /* Intermediate quantity: R_IN = R_ORIGIN + 0.5 */
10714 // /* On output: I_OUT nuclear charge (integer) */
10715 // /* ------------------------------------------------------------ */
10716
10717 // G4double R_ORIGIN,R_IN,R_EVEN_ODD,R_REST,R_HELP;
10718 G4double r_in = 0.0, r_rest = 0.0, r_help = 0.0;
10719 G4double r_floor = 0.0;
10720 G4double r_middle = 0.0;
10721 // G4int I_OUT,N_FLOOR;
10722 G4int n_floor = 0;
10723
10724 r_in = r_origin + 0.5;
10725 r_floor = (G4double)((G4int)(r_in));
10726 if (r_even_odd < 0.001)
10727 {
10728 i_out = (G4int)(r_floor);
10729 }
10730 else
10731 {
10732 r_rest = r_in - r_floor;
10733 r_middle = r_floor + 0.5;
10734 n_floor = (G4int)(r_floor);
10735 if (n_floor % 2 == 0)
10736 {
10737 // even before modif.
10738 r_help = r_middle + (r_rest - 0.5) * (1.0 - r_even_odd);
10739 }
10740 else
10741 {
10742 // odd before modification
10743 r_help = r_middle + (r_rest - 0.5) * (1.0 + r_even_odd);
10744 }
10745 i_out = (G4int)(r_help);
10746 }
10747 }
10748
10749 double G4Abla::umass(G4double z, G4double n, G4double beta)
10750 {
10751 // liquid-drop mass, Myers & Swiatecki, Lysekil, 1967
10752 // pure liquid drop, without pairing and shell effects
10753
10754 // On input: Z nuclear charge of nucleus
10755 // N number of neutrons in nucleus
10756 // beta deformation of nucleus
10757 // On output: binding energy of nucleus
10758
10759 G4double a = 0.0, fumass = 0.0;
10760 G4double alpha = 0.0;
10761 G4double xcom = 0.0, xvs = 0.0, xe = 0.0;
10762 const G4double pi = 3.1416;
10763
10764 a = n + z;
10765 alpha = (std::sqrt(5.0 / (4.0 * pi))) * beta;
10766
10767 xcom = 1.0 - 1.7826 * ((a - 2.0 * z) / a) * ((a - 2.0 * z) / a);
10768 // factor for asymmetry dependence of surface and volume term
10769 xvs = -xcom * (15.4941 * a - 17.9439 * std::pow(a, 2.0 / 3.0) * (1.0 + 0.4 * alpha * alpha));
10770 // sum of volume and surface energy
10771 xe = z * z * (0.7053 / (std::pow(a, 1.0 / 3.0)) * (1.0 - 0.2 * alpha * alpha) - 1.1529 / a);
10772 fumass = xvs + xe;
10773
10774 return fumass;
10775 }
10776
10777 double G4Abla::ecoul(G4double z1, G4double n1, G4double beta1, G4double z2, G4double n2, G4double beta2, G4double d)
10778 {
10779 // Coulomb potential between two nuclei
10780 // surfaces are in a distance of d
10781 // in a tip to tip configuration
10782
10783 // approximate formulation
10784 // On input: Z1 nuclear charge of first nucleus
10785 // N1 number of neutrons in first nucleus
10786 // beta1 deformation of first nucleus
10787 // Z2 nuclear charge of second nucleus
10788 // N2 number of neutrons in second nucleus
10789 // beta2 deformation of second nucleus
10790 // d distance of surfaces of the nuclei
10791
10792 // G4double Z1,N1,beta1,Z2,N2,beta2,d,ecoul;
10793 G4double fecoul = 0;
10794 G4double dtot = 0;
10795 const G4double r0 = 1.16;
10796
10797 dtot = r0 * (std::pow((z1 + n1), 1.0 / 3.0) * (1.0 + 0.6666667 * beta1) +
10798 std::pow((z2 + n2), 1.0 / 3.0) * (1.0 + 0.6666667 * beta2)) +
10799 d;
10800 fecoul = z1 * z2 * 1.44 / dtot;
10801
10802 return fecoul;
10803 }
10804
10805 G4double G4Abla::Uwash(G4double E, G4double Ecrit, G4double Freduction, G4double gamma)
10806 {
10807 // E excitation energy
10808 // Ecrit critical pairing energy
10809 // Freduction reduction factor for shell washing in superfluid region
10810 G4double R_wash, uwash;
10811 if (E < Ecrit)
10812 R_wash = std::exp(-E * Freduction * gamma);
10813 else
10814 R_wash = std::exp(-Ecrit * Freduction * gamma - (E - Ecrit) * gamma);
10815
10816 uwash = R_wash;
10817 return uwash;
10818 }
10819
10820 G4double G4Abla::frldm(G4double z, G4double n, G4double beta)
10821 {
10822
10823 // Liquid-drop mass, Myers & Swiatecki, Lysekil, 1967
10824 // pure liquid drop, without pairing and shell effects
10825 //
10826 // On input: Z nuclear charge of nucleus
10827 // N number of neutrons in nucleus
10828 // beta deformation of nucleus
10829 // On output: binding energy of nucleus
10830 // The idea is to use FRLDM model for beta=0 and using Lysekil
10831 // model to get the deformation energy
10832
10833 G4double a;
10834 a = n + z;
10835 return eflmac_profi(a, z) + umass(z, n, beta) - umass(z, n, 0.0);
10836 }
10837
10838 //**********************************************************************
10839 // *
10840 // * this function will calculate the liquid-drop nuclear mass for spheri
10841 // * configuration according to the preprint NUCLEAR GROUND-STATE
10842 // * MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
10843 // * All constants are taken from this publication for consistency.
10844 // *
10845 // * Parameters:
10846 // * a: nuclear mass number
10847 // * z: nuclear charge
10848 // **********************************************************************
10849
10850 G4double G4Abla::eflmac_profi(G4double ia, G4double iz)
10851 {
10852 // CHANGED TO CALCULATE TOTAL BINDING ENERGY INSTEAD OF MASS EXCESS.
10853 // SWITCH FOR PAIRING INCLUDED AS WELL.
10854 // BINDING = EFLMAC(IA,IZ,0,OPTSHP)
10855 // FORTRAN TRANSCRIPT OF /U/GREWE/LANG/EEX/FRLDM.C
10856 // A.J. 15.07.96
10857
10858 // this function will calculate the liquid-drop nuclear mass for spheri
10859 // configuration according to the preprint NUCLEAR GROUND-STATE
10860 // MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
10861 // All constants are taken from this publication for consistency.
10862
10863 // Parameters:
10864 // a: nuclear mass number
10865 // z: nuclear charge
10866
10867 G4double eflmacResult = 0.0;
10868
10869 G4int in = 0;
10870 G4double z = 0.0, n = 0.0, a = 0.0, av = 0.0, as = 0.0;
10871 G4double a0 = 0.0, c1 = 0.0, c4 = 0.0, b1 = 0.0, b3 = 0.0;
10872 G4double ff = 0.0, ca = 0.0, w = 0.0, efl = 0.0;
10873 G4double r0 = 0.0, kf = 0.0, ks = 0.0;
10874 G4double kv = 0.0, rp = 0.0, ay = 0.0, aden = 0.0, x0 = 0.0, y0 = 0.0;
10875 G4double esq = 0.0, ael = 0.0, i = 0.0;
10876 G4double pi = 3.141592653589793238e0;
10877
10878 // fundamental constants
10879 // electronic charge squared
10880 esq = 1.4399764;
10881
10882 // constants from considerations other than nucl. masses
10883 // electronic binding
10884 ael = 1.433e-5;
10885
10886 // proton rms radius
10887 rp = 0.8;
10888
10889 // nuclear radius constant
10890 r0 = 1.16;
10891
10892 // range of yukawa-plus-expon. potential
10893 ay = 0.68;
10894
10895 // range of yukawa function used to generate
10896 // nuclear charge distribution
10897 aden = 0.70;
10898
10899 // wigner constant
10900 w = 30.0;
10901
10902 // adjusted parameters
10903 // volume energy
10904 av = 16.00126;
10905
10906 // volume asymmetry
10907 kv = 1.92240;
10908
10909 // surface energy
10910 as = 21.18466;
10911
10912 // surface asymmetry
10913 ks = 2.345;
10914 // a^0 constant
10915 a0 = 2.615;
10916
10917 // charge asymmetry
10918 ca = 0.10289;
10919
10920 z = G4double(iz);
10921 a = G4double(ia);
10922 in = ia - iz;
10923 n = G4double(in);
10924
10925 c1 = 3.0 / 5.0 * esq / r0;
10926 c4 = 5.0 / 4.0 * std::pow((3.0 / (2.0 * pi)), (2.0 / 3.0)) * c1;
10927 kf = std::pow((9.0 * pi * z / (4.0 * a)), (1.0 / 3.0)) / r0;
10928
10929 ff = -1.0 / 8.0 * rp * rp * esq / std::pow(r0, 3) *
10930 (145.0 / 48.0 - 327.0 / 2880.0 * std::pow(kf, 2) * std::pow(rp, 2) +
10931 1527.0 / 1209600.0 * std::pow(kf, 4) * std::pow(rp, 4));
10932
10933 i = (n - z) / a;
10934
10935 x0 = r0 * std::pow(a, (1.0 / 3.0)) / ay;
10936 y0 = r0 * std::pow(a, (1.0 / 3.0)) / aden;
10937
10938 b1 = 1.0 - 3.0 / (std::pow(x0, 2)) + (1.0 + x0) * (2.0 + 3.0 / x0 + 3.0 / std::pow(x0, 2)) * std::exp(-2.0 * x0);
10939
10940 b3 = 1.0 - 5.0 / std::pow(y0, 2) *
10941 (1.0 - 15.0 / (8.0 * y0) + 21.0 / (8.0 * std::pow(y0, 3)) -
10942 3.0 / 4.0 * (1.0 + 9.0 / (2.0 * y0) + 7.0 / std::pow(y0, 2) + 7.0 / (2.0 * std::pow(y0, 3))) *
10943 std::exp(-2.0 * y0));
10944
10945 // now calculation of total binding energy
10946
10947 efl = -1.0 * av * (1.0 - kv * i * i) * a + as * (1.0 - ks * i * i) * b1 * std::pow(a, (2.0 / 3.0)) + a0 +
10948 c1 * z * z * b3 / std::pow(a, (1.0 / 3.0)) - c4 * std::pow(z, (4.0 / 3.0)) / std::pow(a, (1.e0 / 3.e0)) +
10949 ff * std::pow(z, 2) / a - ca * (n - z) - ael * std::pow(z, (2.39e0));
10950
10951 efl = efl + w * utilabs(i);
10952
10953 eflmacResult = efl;
10954
10955 return eflmacResult;
10956 }
10957 //
10958 //
10959 //
10960 void G4Abla::unstable_nuclei(G4int AFP,
10961 G4int ZFP,
10962 G4int* AFPNEW,
10963 G4int* ZFPNEW,
10964 G4int& IOUNSTABLE,
10965 G4double VX,
10966 G4double VY,
10967 G4double VZ,
10968 G4double* VP1X,
10969 G4double* VP1Y,
10970 G4double* VP1Z,
10971 G4double BU_TAB_TEMP[indexpart][6],
10972 G4int* ILOOP)
10973 {
10974 //
10975 G4int INMIN, INMAX, NDIF = 0, IMEM;
10976 G4int NEVA = 0, PEVA = 0;
10977 G4double VP2X, VP2Y, VP2Z;
10978
10979 *AFPNEW = AFP;
10980 *ZFPNEW = ZFP;
10981 IOUNSTABLE = 0;
10982 *ILOOP = 0;
10983 IMEM = 0;
10984 for (G4int i = 0; i < indexpart; i++)
10985 {
10986 BU_TAB_TEMP[i][0] = 0.0;
10987 BU_TAB_TEMP[i][1] = 0.0;
10988 BU_TAB_TEMP[i][2] = 0.0;
10989 BU_TAB_TEMP[i][3] = 0.0;
10990 BU_TAB_TEMP[i][4] = 0.0;
10991 // BU_TAB_TEMP[i][5] = 0.0;
10992 }
10993 *VP1X = 0.0;
10994 *VP1Y = 0.0;
10995 *VP1Z = 0.0;
10996
10997 if (AFP == 0 && ZFP == 0)
10998 {
10999 // PRINT*,'UNSTABLE NUCLEI, AFP=0, ZFP=0'
11000 return;
11001 }
11002 if ((AFP == 1 && ZFP == 0) || (AFP == 1 && ZFP == 1) || (AFP == 2 && ZFP == 1) || (AFP == 3 && ZFP == 1) ||
11003 (AFP == 3 && ZFP == 2) || (AFP == 4 && ZFP == 2) || (AFP == 6 && ZFP == 2) || (AFP == 8 && ZFP == 2))
11004 {
11005 *VP1X = VX;
11006 *VP1Y = VY;
11007 *VP1Z = VZ;
11008 return;
11009 }
11010
11011 if ((AFP - ZFP) == 0 && ZFP > 1)
11012 {
11013 for (G4int I = 0; I <= AFP - 2; I++)
11014 {
11015 unstable_tke(G4double(AFP - I),
11016 G4double(AFP - I),
11017 G4double(AFP - I - 1),
11018 G4double(AFP - I - 1),
11019 VX,
11020 VY,
11021 VZ,
11022 &(*VP1X),
11023 &(*VP1Y),
11024 &(*VP1Z),
11025 &VP2X,
11026 &VP2Y,
11027 &VP2Z);
11028 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11029 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11030 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11031 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11032 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11033 *ILOOP = *ILOOP + 1;
11034 VX = *VP1X;
11035 VY = *VP1Y;
11036 VZ = *VP1Z;
11037 }
11038 // PEVA = PEVA + ZFP - 1;
11039 AFP = 1;
11040 ZFP = 1;
11041 IOUNSTABLE = 1;
11042 }
11043 //
11044 //*** Find the limits nucleus is bound :
11045 isostab_lim(ZFP, &INMIN, &INMAX);
11046 NDIF = AFP - ZFP;
11047 if (NDIF < INMIN)
11048 {
11049 // Proton unbound
11050 IOUNSTABLE = 1;
11051 for (G4int I = 1; I <= 10; I++)
11052 {
11053 isostab_lim(ZFP - I, &INMIN, &INMAX);
11054 if (INMIN <= NDIF)
11055 {
11056 IMEM = I;
11057 ZFP = ZFP - I;
11058 AFP = ZFP + NDIF;
11059 PEVA = I;
11060 goto u10;
11061 }
11062 }
11063 //
11064 u10:
11065 for (G4int I = 0; I < IMEM; I++)
11066 {
11067 unstable_tke(G4double(NDIF + ZFP + IMEM - I),
11068 G4double(ZFP + IMEM - I),
11069 G4double(NDIF + ZFP + IMEM - I - 1),
11070 G4double(ZFP + IMEM - I - 1),
11071 VX,
11072 VY,
11073 VZ,
11074 &(*VP1X),
11075 &(*VP1Y),
11076 &(*VP1Z),
11077 &VP2X,
11078 &VP2Y,
11079 &VP2Z);
11080 BU_TAB_TEMP[I + 1 + *ILOOP][0] = 1.0;
11081 BU_TAB_TEMP[I + 1 + *ILOOP][1] = 1.0;
11082 BU_TAB_TEMP[I + 1 + *ILOOP][2] = VP2X;
11083 BU_TAB_TEMP[I + 1 + *ILOOP][3] = VP2Y;
11084 BU_TAB_TEMP[I + 1 + *ILOOP][4] = VP2Z;
11085 VX = *VP1X;
11086 VY = *VP1Y;
11087 VZ = *VP1Z;
11088 }
11089 *ILOOP = *ILOOP + IMEM;
11090 }
11091 if (NDIF > INMAX)
11092 {
11093 // Neutron unbound
11094 NEVA = NDIF - INMAX;
11095 AFP = ZFP + INMAX;
11096 IOUNSTABLE = 1;
11097 for (G4int I = 0; I < NEVA; I++)
11098 {
11099 unstable_tke(G4double(ZFP + NDIF - I),
11100 G4double(ZFP),
11101 G4double(ZFP + NDIF - I - 1),
11102 G4double(ZFP),
11103 VX,
11104 VY,
11105 VZ,
11106 &(*VP1X),
11107 &(*VP1Y),
11108 &(*VP1Z),
11109 &VP2X,
11110 &VP2Y,
11111 &VP2Z);
11112
11113 BU_TAB_TEMP[*ILOOP][0] = 0.0;
11114 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11115 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11116 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11117 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11118 *ILOOP = *ILOOP + 1;
11119 VX = *VP1X;
11120 VY = *VP1Y;
11121 VZ = *VP1Z;
11122 }
11123 }
11124
11125 if ((AFP >= 2) && (ZFP == 0))
11126 {
11127 for (G4int I = 0; I <= AFP - 2; I++)
11128 {
11129 unstable_tke(G4double(AFP - I),
11130 G4double(ZFP),
11131 G4double(AFP - I - 1),
11132 G4double(ZFP),
11133 VX,
11134 VY,
11135 VZ,
11136 &(*VP1X),
11137 &(*VP1Y),
11138 &(*VP1Z),
11139 &VP2X,
11140 &VP2Y,
11141 &VP2Z);
11142
11143 BU_TAB_TEMP[*ILOOP][0] = 0.0;
11144 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11145 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11146 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11147 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11148 *ILOOP = *ILOOP + 1;
11149 VX = *VP1X;
11150 VY = *VP1Y;
11151 VZ = *VP1Z;
11152 }
11153
11154 // NEVA = NEVA + (AFP - 1);
11155 AFP = 1;
11156 ZFP = 0;
11157 IOUNSTABLE = 1;
11158 }
11159 if (AFP < ZFP)
11160 {
11161 std::cout << "WARNING - BU UNSTABLE: AF < ZF" << std::endl;
11162 AFP = 0;
11163 ZFP = 0;
11164 IOUNSTABLE = 1;
11165 }
11166 if ((AFP >= 4) && (ZFP == 1))
11167 {
11168 // Heavy residue is treated as 3H and the rest of mass is emitted as
11169 // neutrons:
11170 for (G4int I = 0; I < AFP - 3; I++)
11171 {
11172 unstable_tke(G4double(AFP - I),
11173 G4double(ZFP),
11174 G4double(AFP - I - 1),
11175 G4double(ZFP),
11176 VX,
11177 VY,
11178 VZ,
11179 &(*VP1X),
11180 &(*VP1Y),
11181 &(*VP1Z),
11182 &VP2X,
11183 &VP2Y,
11184 &VP2Z);
11185
11186 BU_TAB_TEMP[*ILOOP][0] = 0.0;
11187 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11188 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11189 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11190 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11191 *ILOOP = *ILOOP + 1;
11192 VX = *VP1X;
11193 VY = *VP1Y;
11194 VZ = *VP1Z;
11195 }
11196
11197 // NEVA = NEVA + (AFP - 3);
11198 AFP = 3;
11199 ZFP = 1;
11200 IOUNSTABLE = 1;
11201 }
11202
11203 if ((AFP == 4) && (ZFP == 3))
11204 {
11205 // 4Li -> 3He + p ->
11206 AFP = 3;
11207 ZFP = 2;
11208 // PEVA = PEVA + 1;
11209 IOUNSTABLE = 1;
11210 unstable_tke(4.0, 3.0, 3.0, 2.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11211
11212 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11213 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11214 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11215 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11216 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11217 *ILOOP = *ILOOP + 1;
11218 }
11219 if ((AFP == 5) && (ZFP == 2))
11220 {
11221 // 5He -> 4He + n ->
11222 AFP = 4;
11223 ZFP = 2;
11224 // NEVA = NEVA + 1;
11225 IOUNSTABLE = 1;
11226 unstable_tke(5.0, 2.0, 4.0, 2.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11227 BU_TAB_TEMP[*ILOOP][0] = 0.0;
11228 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11229 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11230 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11231 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11232 *ILOOP = *ILOOP + 1;
11233 }
11234
11235 if ((AFP == 5) && (ZFP == 3))
11236 {
11237 // 5Li -> 4He + p
11238 AFP = 4;
11239 ZFP = 2;
11240 // PEVA = PEVA + 1;
11241 IOUNSTABLE = 1;
11242 unstable_tke(5.0, 3.0, 4.0, 2.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11243 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11244 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11245 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11246 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11247 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11248 *ILOOP = *ILOOP + 1;
11249 }
11250
11251 if ((AFP == 6) && (ZFP == 4))
11252 {
11253 // 6Be -> 4He + 2p (velocity in two steps: 6Be->5Li->4He)
11254 AFP = 4;
11255 ZFP = 2;
11256 // PEVA = PEVA + 2;
11257 IOUNSTABLE = 1;
11258 // 6Be -> 5Li + p
11259 unstable_tke(6.0, 4.0, 5.0, 3.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11260 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11261 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11262 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11263 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11264 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11265 *ILOOP = *ILOOP + 1;
11266 VX = *VP1X;
11267 VY = *VP1Y;
11268 VZ = *VP1Z;
11269
11270 // 5Li -> 4He + p
11271 unstable_tke(5.0, 3.0, 4.0, 2.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11272 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11273 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11274 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11275 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11276 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11277 *ILOOP = *ILOOP + 1;
11278 }
11279 if ((AFP == 7) && (ZFP == 2))
11280 {
11281 // 7He -> 6He + n
11282 AFP = 6;
11283 ZFP = 2;
11284 // NEVA = NEVA + 1;
11285 IOUNSTABLE = 1;
11286 unstable_tke(7.0, 2.0, 6.0, 2.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11287 BU_TAB_TEMP[*ILOOP][0] = 0.0;
11288 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11289 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11290 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11291 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11292 *ILOOP = *ILOOP + 1;
11293 }
11294
11295 if ((AFP == 7) && (ZFP == 5))
11296 {
11297 // 7B -> 6Be + p -> 4He + 3p
11298 for (int I = 0; I <= AFP - 5; I++)
11299 {
11300 unstable_tke(double(AFP - I),
11301 double(ZFP - I),
11302 double(AFP - I - 1),
11303 double(ZFP - I - 1),
11304 VX,
11305 VY,
11306 VZ,
11307 &(*VP1X),
11308 &(*VP1Y),
11309 &(*VP1Z),
11310 &VP2X,
11311 &VP2Y,
11312 &VP2Z);
11313 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11314 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11315 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11316 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11317 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11318 *ILOOP = *ILOOP + 1;
11319 VX = *VP1X;
11320 VY = *VP1Y;
11321 VZ = *VP1Z;
11322 }
11323
11324 AFP = 4;
11325 ZFP = 2;
11326 // PEVA = PEVA + 3;
11327 IOUNSTABLE = 1;
11328 }
11329 if ((AFP == 8) && (ZFP == 4))
11330 {
11331 // 8Be -> 4He + 4He
11332 AFP = 4;
11333 ZFP = 2;
11334 IOUNSTABLE = 1;
11335 unstable_tke(8.0, 4.0, 4.0, 2.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11336 BU_TAB_TEMP[*ILOOP][0] = 2.0;
11337 BU_TAB_TEMP[*ILOOP][1] = 4.0;
11338 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11339 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11340 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11341 *ILOOP = *ILOOP + 1;
11342 }
11343 if ((AFP == 8) && (ZFP == 6))
11344 {
11345 // 8C -> 2p + 6Be
11346 AFP = 6;
11347 ZFP = 4;
11348 // PEVA = PEVA + 2;
11349 IOUNSTABLE = 1;
11350
11351 unstable_tke(8.0, 6.0, 7.0, 5.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11352 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11353 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11354 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11355 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11356 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11357 *ILOOP = *ILOOP + 1;
11358 VX = *VP1X;
11359 VY = *VP1Y;
11360 VZ = *VP1Z;
11361
11362 unstable_tke(7.0, 5.0, 6.0, 4.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11363 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11364 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11365 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11366 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11367 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11368 *ILOOP = *ILOOP + 1;
11369 VX = *VP1X;
11370 VY = *VP1Y;
11371 VZ = *VP1Z;
11372 }
11373
11374 if ((AFP == 9) && (ZFP == 2))
11375 {
11376 // 9He -> 8He + n
11377 AFP = 8;
11378 ZFP = 2;
11379 // NEVA = NEVA + 1;
11380 IOUNSTABLE = 1;
11381
11382 unstable_tke(9.0, 2.0, 8.0, 2.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11383 BU_TAB_TEMP[*ILOOP][0] = 0.0;
11384 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11385 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11386 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11387 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11388 *ILOOP = *ILOOP + 1;
11389 VX = *VP1X;
11390 VY = *VP1Y;
11391 VZ = *VP1Z;
11392 }
11393
11394 if ((AFP == 9) && (ZFP == 5))
11395 {
11396 // 9B -> 4He + 4He + p ->
11397 AFP = 4;
11398 ZFP = 2;
11399 // PEVA = PEVA + 1;
11400 IOUNSTABLE = 1;
11401 unstable_tke(9.0, 5.0, 8.0, 4.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11402 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11403 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11404 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11405 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11406 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11407 *ILOOP = *ILOOP + 1;
11408 VX = *VP1X;
11409 VY = *VP1Y;
11410 VZ = *VP1Z;
11411
11412 unstable_tke(8.0, 4.0, 4.0, 2.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11413 BU_TAB_TEMP[*ILOOP][0] = 2.0;
11414 BU_TAB_TEMP[*ILOOP][1] = 4.0;
11415 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11416 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11417 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11418 *ILOOP = *ILOOP + 1;
11419 VX = *VP1X;
11420 VY = *VP1Y;
11421 VZ = *VP1Z;
11422 }
11423
11424 if ((AFP == 10) && (ZFP == 2))
11425 {
11426 // 10He -> 8He + 2n
11427 AFP = 8;
11428 ZFP = 2;
11429 // NEVA = NEVA + 2;
11430 IOUNSTABLE = 1;
11431 // 10He -> 9He + n
11432 unstable_tke(10.0, 2.0, 9.0, 2.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11433 BU_TAB_TEMP[*ILOOP][0] = 0.0;
11434 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11435 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11436 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11437 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11438 *ILOOP = *ILOOP + 1;
11439 VX = *VP1X;
11440 VY = *VP1Y;
11441 VZ = *VP1Z;
11442
11443 // 9He -> 8He + n
11444 unstable_tke(9.0, 2.0, 8.0, 2.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11445 BU_TAB_TEMP[*ILOOP][0] = 0.0;
11446 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11447 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11448 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11449 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11450 *ILOOP = *ILOOP + 1;
11451 VX = *VP1X;
11452 VY = *VP1Y;
11453 VZ = *VP1Z;
11454 }
11455 if ((AFP == 10) && (ZFP == 3))
11456 {
11457 // 10Li -> 9Li + n ->
11458 AFP = 9;
11459 ZFP = 3;
11460 // NEVA = NEVA + 1;
11461 IOUNSTABLE = 1;
11462 unstable_tke(10.0, 3.0, 9.0, 3.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11463 BU_TAB_TEMP[*ILOOP][0] = 0.0;
11464 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11465 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11466 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11467 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11468 *ILOOP = *ILOOP + 1;
11469 VX = *VP1X;
11470 VY = *VP1Y;
11471 VZ = *VP1Z;
11472 }
11473 if ((AFP == 10) && (ZFP == 7))
11474 {
11475 // 10N -> 9C + p ->
11476 AFP = 9;
11477 ZFP = 6;
11478 // PEVA = PEVA + 1;
11479 IOUNSTABLE = 1;
11480 unstable_tke(10.0, 7.0, 9.0, 6.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11481 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11482 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11483 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11484 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11485 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11486 *ILOOP = *ILOOP + 1;
11487 VX = *VP1X;
11488 VY = *VP1Y;
11489 VZ = *VP1Z;
11490 }
11491
11492 if ((AFP == 11) && (ZFP == 7))
11493 {
11494 // 11N -> 10C + p ->
11495 AFP = 10;
11496 ZFP = 6;
11497 // PEVA = PEVA + 1;
11498 IOUNSTABLE = 1;
11499 unstable_tke(11.0, 7.0, 10.0, 6.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11500 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11501 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11502 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11503 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11504 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11505 *ILOOP = *ILOOP + 1;
11506 VX = *VP1X;
11507 VY = *VP1Y;
11508 VZ = *VP1Z;
11509 }
11510 if ((AFP == 12) && (ZFP == 8))
11511 {
11512 // 12O -> 10C + 2p ->
11513 AFP = 10;
11514 ZFP = 6;
11515 // PEVA = PEVA + 2;
11516 IOUNSTABLE = 1;
11517
11518 unstable_tke(12.0, 8.0, 11.0, 7.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11519 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11520 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11521 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11522 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11523 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11524 *ILOOP = *ILOOP + 1;
11525 VX = *VP1X;
11526 VY = *VP1Y;
11527 VZ = *VP1Z;
11528
11529 unstable_tke(11.0, 7.0, 10.0, 6.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11530 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11531 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11532 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11533 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11534 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11535 *ILOOP = *ILOOP + 1;
11536 VX = *VP1X;
11537 VY = *VP1Y;
11538 VZ = *VP1Z;
11539 }
11540 if ((AFP == 15) && (ZFP == 9))
11541 {
11542 // 15F -> 14O + p ->
11543 AFP = 14;
11544 ZFP = 8;
11545 // PEVA = PEVA + 1;
11546 IOUNSTABLE = 1;
11547 unstable_tke(15.0, 9.0, 14.0, 8.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11548 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11549 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11550 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11551 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11552 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11553 *ILOOP = *ILOOP + 1;
11554 VX = *VP1X;
11555 VY = *VP1Y;
11556 VZ = *VP1Z;
11557 }
11558
11559 if ((AFP == 16) && (ZFP == 9))
11560 {
11561 // 16F -> 15O + p ->
11562 AFP = 15;
11563 ZFP = 8;
11564 // PEVA = PEVA + 1;
11565 IOUNSTABLE = 1;
11566 unstable_tke(16.0, 9.0, 15.0, 8.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11567 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11568 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11569 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11570 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11571 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11572 *ILOOP = *ILOOP + 1;
11573 VX = *VP1X;
11574 VY = *VP1Y;
11575 VZ = *VP1Z;
11576 }
11577
11578 if ((AFP == 16) && (ZFP == 10))
11579 {
11580 // 16Ne -> 14O + 2p ->
11581 AFP = 14;
11582 ZFP = 8;
11583 // PEVA = PEVA + 2;
11584 IOUNSTABLE = 1;
11585 unstable_tke(16.0, 10.0, 15.0, 9.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11586 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11587 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11588 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11589 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11590 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11591 *ILOOP = *ILOOP + 1;
11592 VX = *VP1X;
11593 VY = *VP1Y;
11594 VZ = *VP1Z;
11595
11596 unstable_tke(15.0, 9.0, 14.0, 8.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11597 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11598 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11599 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11600 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11601 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11602 *ILOOP = *ILOOP + 1;
11603 VX = *VP1X;
11604 VY = *VP1Y;
11605 VZ = *VP1Z;
11606 }
11607 if ((AFP == 18) && (ZFP == 11))
11608 {
11609 // 18Na -> 17Ne + p ->
11610 AFP = 17;
11611 ZFP = 10;
11612 // PEVA = PEVA + 1;
11613 IOUNSTABLE = 1;
11614 unstable_tke(18.0, 11.0, 17.0, 10.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11615 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11616 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11617 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11618 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11619 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11620 *ILOOP = *ILOOP + 1;
11621 VX = *VP1X;
11622 VY = *VP1Y;
11623 VZ = *VP1Z;
11624 }
11625 if ((AFP == 19) && (ZFP == 11))
11626 {
11627 // 19Na -> 18Ne + p ->
11628 AFP = 18;
11629 ZFP = 10;
11630 // PEVA = PEVA + 1;
11631 IOUNSTABLE = 1;
11632 unstable_tke(19.0, 11.0, 18.0, 10.0, VX, VY, VZ, &(*VP1X), &(*VP1Y), &(*VP1Z), &VP2X, &VP2Y, &VP2Z);
11633 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11634 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11635 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11636 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11637 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11638 *ILOOP = *ILOOP + 1;
11639 VX = *VP1X;
11640 VY = *VP1Y;
11641 VZ = *VP1Z;
11642 }
11643 if (ZFP >= 4 && (AFP - ZFP) == 1)
11644 {
11645 // Heavy residue is treated as 3He
11646 NEVA = AFP - 3;
11647 PEVA = ZFP - 2;
11648
11649 for (G4int I = 0; I < NEVA; I++)
11650 {
11651 unstable_tke(G4double(AFP - I),
11652 G4double(ZFP),
11653 G4double(AFP - I - 1),
11654 G4double(ZFP),
11655 VX,
11656 VY,
11657 VZ,
11658 &(*VP1X),
11659 &(*VP1Y),
11660 &(*VP1Z),
11661 &VP2X,
11662 &VP2Y,
11663 &VP2Z);
11664 BU_TAB_TEMP[*ILOOP][0] = 0.0;
11665 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11666 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11667 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11668 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11669 *ILOOP = *ILOOP + 1;
11670 VX = *VP1X;
11671 VY = *VP1Y;
11672 VZ = *VP1Z;
11673 }
11674 for (G4int I = 0; I < PEVA; I++)
11675 {
11676 unstable_tke(G4double(AFP - NEVA - I),
11677 G4double(ZFP - I),
11678 G4double(AFP - NEVA - I - 1),
11679 G4double(ZFP - I - 1),
11680 VX,
11681 VY,
11682 VZ,
11683 &(*VP1X),
11684 &(*VP1Y),
11685 &(*VP1Z),
11686 &VP2X,
11687 &VP2Y,
11688 &VP2Z);
11689 BU_TAB_TEMP[*ILOOP][0] = 1.0;
11690 BU_TAB_TEMP[*ILOOP][1] = 1.0;
11691 BU_TAB_TEMP[*ILOOP][2] = VP2X;
11692 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
11693 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
11694 *ILOOP = *ILOOP + 1;
11695 VX = *VP1X;
11696 VY = *VP1Y;
11697 VZ = *VP1Z;
11698 }
11699
11700 AFP = 3;
11701 ZFP = 2;
11702 IOUNSTABLE = 1;
11703 }
11704 //
11705 *AFPNEW = AFP;
11706 *ZFPNEW = ZFP;
11707 return;
11708 }
11709
11710 //
11711 //
11712 void G4Abla::unstable_tke(G4double ain,
11713 G4double zin,
11714 G4double anew,
11715 G4double znew,
11716 G4double vxin,
11717 G4double vyin,
11718 G4double vzin,
11719 G4double* v1x,
11720 G4double* v1y,
11721 G4double* v1z,
11722 G4double* v2x,
11723 G4double* v2y,
11724 G4double* v2z)
11725 {
11726 //
11727 G4double EKIN_P1 = 0., ekin_tot = 0.;
11728 G4double PX1, PX2, PY1, PY2, PZ1, PZ2, PTOT;
11729 G4double RNDT, CTET1, STET1, RNDP, PHI1, ETOT_P1, ETOT_P2;
11730 G4double MASS, MASS1, MASS2;
11731 G4double vxout = 0., vyout = 0., vzout = 0.;
11732 G4int iain, izin, ianew, iznew, inin, innew;
11733 //
11734 G4double C = 29.97924580; // cm/ns
11735 G4double AMU = 931.4940; // MeV/C^2
11736 //
11737 iain = idnint(ain);
11738 izin = idnint(zin);
11739 inin = iain - izin;
11740 ianew = idnint(anew);
11741 iznew = idnint(znew);
11742 innew = ianew - iznew;
11743 //
11744 if (ain == 0)
11745 return;
11746 //
11747 if (izin > 12)
11748 {
11749 mglms(ain, zin, 3, &MASS);
11750 mglms(anew, znew, 3, &MASS1);
11751 mglms(ain - anew, zin - znew, 3, &MASS2);
11752 ekin_tot = MASS - MASS1 - MASS2;
11753 }
11754 else
11755 {
11756 // ekin_tot =
11757 // MEXP(ININ,IZIN)-(MEXP(INNEW,IZNEW)+MEXP(ININ-INNEW,IZIN-IZNEW));
11758 ekin_tot =
11759 masses->massexp[inin][izin] - (masses->massexp[innew][iznew] + masses->massexp[inin - innew][izin - iznew]);
11760 if (izin > 12)
11761 std::cout << "*** ZIN > 12 ***" << izin << std::endl;
11762 }
11763
11764 if (ekin_tot < 0.00)
11765 {
11766 // if( iain.ne.izin .and. izin.ne.0 ){
11767 // print *,"Negative Q-value in UNSTABLE_TKE"
11768 // print *,"ekin_tot=",ekin_tot
11769 // print *,"ain,zin=",ain,zin,MEXP(ININ,IZIN)
11770 // print *,"anew,znew=",anew,znew,MEXP(INNEW,IZNEW)
11771 // print *
11772 // }
11773 ekin_tot = 0.0;
11774 }
11775 //
11776 EKIN_P1 = ekin_tot * (ain - anew) / ain;
11777 ETOT_P1 = EKIN_P1 + anew * AMU;
11778 PTOT = anew * AMU * std::sqrt((EKIN_P1 / (anew * AMU) + 1.0) * (EKIN_P1 / (anew * AMU) + 1.0) - 1.0); // MeV/C
11779 //
11780 RNDT = G4AblaRandom::flat();
11781 CTET1 = 2.0 * RNDT - 1.0;
11782 STET1 = std::sqrt(1.0 - CTET1 * CTET1);
11783 RNDP = G4AblaRandom::flat();
11784 PHI1 = RNDP * 2.0 * 3.141592654;
11785 PX1 = PTOT * STET1 * std::cos(PHI1);
11786 PY1 = PTOT * STET1 * std::sin(PHI1);
11787 PZ1 = PTOT * CTET1;
11788 *v1x = C * PX1 / ETOT_P1;
11789 *v1y = C * PY1 / ETOT_P1;
11790 *v1z = C * PZ1 / ETOT_P1;
11791 lorentz_boost(vxin, vyin, vzin, *v1x, *v1y, *v1z, &vxout, &vyout, &vzout);
11792 *v1x = vxout;
11793 *v1y = vyout;
11794 *v1z = vzout;
11795 //
11796 PX2 = -PX1;
11797 PY2 = -PY1;
11798 PZ2 = -PZ1;
11799 ETOT_P2 = (ekin_tot - EKIN_P1) + (ain - anew) * AMU;
11800 *v2x = C * PX2 / ETOT_P2;
11801 *v2y = C * PY2 / ETOT_P2;
11802 *v2z = C * PZ2 / ETOT_P2;
11803 lorentz_boost(vxin, vyin, vzin, *v2x, *v2y, *v2z, &vxout, &vyout, &vzout);
11804 *v2x = vxout;
11805 *v2y = vyout;
11806 *v2z = vzout;
11807 //
11808 return;
11809 }
11810 //
11811 //**************************************************************************
11812 //
11813 void G4Abla::lorentz_boost(G4double VXRIN,
11814 G4double VYRIN,
11815 G4double VZRIN,
11816 G4double VXIN,
11817 G4double VYIN,
11818 G4double VZIN,
11819 G4double* VXOUT,
11820 G4double* VYOUT,
11821 G4double* VZOUT)
11822 {
11823 //
11824 // Calculate velocities of a given fragment from frame 1 into frame 2.
11825 // Frame 1 is moving with velocity v=(vxr,vyr,vzr) relative to frame 2.
11826 // Velocity of the fragment in frame 1 -> vxin,vyin,vzin
11827 // Velocity of the fragment in frame 2 -> vxout,vyout,vzout
11828 //
11829 G4double VXR, VYR, VZR;
11830 G4double GAMMA, VR, C, CC, DENO, VXNOM, VYNOM, VZNOM;
11831 //
11832 C = 29.9792458; // cm/ns
11833 CC = C * C;
11834 //
11835 // VXR,VYR,VZR are velocities of frame 1 relative to frame 2; to go from 1 to
11836 // 2 we need to multiply them by -1
11837 VXR = -1.0 * VXRIN;
11838 VYR = -1.0 * VYRIN;
11839 VZR = -1.0 * VZRIN;
11840 //
11841 VR = std::sqrt(VXR * VXR + VYR * VYR + VZR * VZR);
11842 if (VR < 1e-9)
11843 {
11844 *VXOUT = VXIN;
11845 *VYOUT = VYIN;
11846 *VZOUT = VZIN;
11847 return;
11848 }
11849 GAMMA = 1.0 / std::sqrt(1.0 - VR * VR / CC);
11850 DENO = 1.0 - VXR * VXIN / CC - VYR * VYIN / CC - VZR * VZIN / CC;
11851
11852 // X component
11853 VXNOM = -GAMMA * VXR + (1.0 + (GAMMA - 1.0) * VXR * VXR / (VR * VR)) * VXIN +
11854 (GAMMA - 1.0) * VXR * VYR / (VR * VR) * VYIN + (GAMMA - 1.0) * VXR * VZR / (VR * VR) * VZIN;
11855
11856 *VXOUT = VXNOM / (GAMMA * DENO);
11857
11858 // Y component
11859 VYNOM = -GAMMA * VYR + (1.0 + (GAMMA - 1.0) * VYR * VYR / (VR * VR)) * VYIN +
11860 (GAMMA - 1.0) * VXR * VYR / (VR * VR) * VXIN + (GAMMA - 1.0) * VYR * VZR / (VR * VR) * VZIN;
11861
11862 *VYOUT = VYNOM / (GAMMA * DENO);
11863
11864 // Z component
11865 VZNOM = -GAMMA * VZR + (1.0 + (GAMMA - 1.0) * VZR * VZR / (VR * VR)) * VZIN +
11866 (GAMMA - 1.0) * VXR * VZR / (VR * VR) * VXIN + (GAMMA - 1.0) * VYR * VZR / (VR * VR) * VYIN;
11867
11868 *VZOUT = VZNOM / (GAMMA * DENO);
11869
11870 return;
11871 }
11872
11873 void G4Abla::fission(G4double AF,
11874 G4double ZF,
11875 G4double EE,
11876 G4double JPRF,
11877 G4double* VX1_FISSION_par,
11878 G4double* VY1_FISSION_par,
11879 G4double* VZ1_FISSION_par,
11880 G4double* VX2_FISSION_par,
11881 G4double* VY2_FISSION_par,
11882 G4double* VZ2_FISSION_par,
11883 G4int* ZFP1,
11884 G4int* AFP1,
11885 G4int* SFP1,
11886 G4int* ZFP2,
11887 G4int* AFP2,
11888 G4int* SFP2,
11889 G4int* imode_par,
11890 G4double* VX_EVA_SC_par,
11891 G4double* VY_EVA_SC_par,
11892 G4double* VZ_EVA_SC_par,
11893 G4double EV_TEMP[indexpart][6],
11894 G4int* IEV_TAB_FIS_par,
11895 G4int* NbLam0_par)
11896 {
11897 ///
11898 G4double EFF1 = 0., EFF2 = 0., VFF1 = 0., VFF2 = 0., AF1 = 0., ZF1 = 0., AF2 = 0., ZF2 = 0., AFF1 = 0., ZFF1 = 0.,
11899 AFF2 = 0., ZFF2 = 0., vz1_eva = 0., vx1_eva = 0., vy1_eva = 0., vz2_eva = 0., vx2_eva = 0., vy2_eva = 0.,
11900 vx_eva_sc = 0., vy_eva_sc = 0., vz_eva_sc = 0., VXOUT = 0., VYOUT = 0., VZOUT = 0., VX2OUT = 0.,
11901 VY2OUT = 0., VZ2OUT = 0.;
11902 G4int IEV_TAB_FIS = 0, IEV_TAB_TEMP = 0;
11903 G4double EV_TEMP1[indexpart][6], EV_TEMP2[indexpart][6], mtota = 0.;
11904 G4int inttype = 0, inum = 0;
11905 IEV_TAB_SSC = 0;
11906 (*imode_par) = 0;
11907 G4int NbLam0 = (*NbLam0_par);
11908
11909 for (G4int I1 = 0; I1 < indexpart; I1++)
11910 for (G4int I2 = 0; I2 < 6; I2++)
11911 {
11912 EV_TEMP[I1][I2] = 0.0;
11913 EV_TEMP1[I1][I2] = 0.0;
11914 EV_TEMP2[I1][I2] = 0.0;
11915 }
11916
11917 G4double et = EE - JPRF * JPRF * 197. * 197. / (2. * 0.4 * 931. * std::pow(AF, 5.0 / 3.0) * 1.16 * 1.16);
11918
11919 fissionDistri(AF, ZF, et, AF1, ZF1, EFF1, VFF1, AF2, ZF2, EFF2, VFF2, vx_eva_sc, vy_eva_sc, vz_eva_sc, &NbLam0);
11920
11921 // Lambda particles
11922 G4int NbLam1 = 0;
11923 G4int NbLam2 = 0;
11924 G4double pbH = (AF1 - ZF1) / (AF1 - ZF1 + AF2 - ZF2);
11925 for (G4int i = 0; i < NbLam0; i++)
11926 {
11927 if (G4AblaRandom::flat() < pbH)
11928 {
11929 NbLam1++;
11930 }
11931 else
11932 {
11933 NbLam2++;
11934 }
11935 }
11936 // Copy of the evaporated particles from saddle to scission
11937 for (G4int IJ = 0; IJ < IEV_TAB_SSC; IJ++)
11938 {
11939 EV_TEMP[IJ][0] = EV_TAB_SSC[IJ][0];
11940 EV_TEMP[IJ][1] = EV_TAB_SSC[IJ][1];
11941 EV_TEMP[IJ][2] = EV_TAB_SSC[IJ][2];
11942 EV_TEMP[IJ][3] = EV_TAB_SSC[IJ][3];
11943 EV_TEMP[IJ][4] = EV_TAB_SSC[IJ][4];
11944 EV_TEMP[IJ][5] = EV_TAB_SSC[IJ][5];
11945 }
11946 IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_SSC;
11947
11948 // Velocities
11949 G4double VZ1_FISSION = (2.0 * G4AblaRandom::flat() - 1.0) * VFF1;
11950 G4double VPERP1 = std::sqrt(VFF1 * VFF1 - VZ1_FISSION * VZ1_FISSION);
11951 G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
11952 G4double VX1_FISSION = VPERP1 * std::sin(ALPHA1);
11953 G4double VY1_FISSION = VPERP1 * std::cos(ALPHA1);
11954 G4double VX2_FISSION = -VX1_FISSION / VFF1 * VFF2;
11955 G4double VY2_FISSION = -VY1_FISSION / VFF1 * VFF2;
11956 G4double VZ2_FISSION = -VZ1_FISSION / VFF1 * VFF2;
11957 //
11958 // Fission fragment 1
11959 if ((ZF1 <= 0.0) || (AF1 <= 0.0) || (AF1 < ZF1))
11960 {
11961 std::cout << "F1 unphysical: " << ZF << " " << AF << " " << EE << " " << ZF1 << " " << AF1 << std::endl;
11962 }
11963 else
11964 {
11965 // fission and IMF emission are not allowed
11966 opt->optimfallowed = 0; // IMF is not allowed
11967 fiss->ifis = 0; // fission is not allowed
11968 gammaemission = 1;
11969 G4int FF11 = 0, FIMF11 = 0;
11970 G4double ZIMFF1 = 0., AIMFF1 = 0., TKEIMF1 = 0., JPRFOUT = 0.;
11971 //
11972 evapora(ZF1,
11973 AF1,
11974 &EFF1,
11975 0.,
11976 &ZFF1,
11977 &AFF1,
11978 &mtota,
11979 &vz1_eva,
11980 &vx1_eva,
11981 &vy1_eva,
11982 &FF11,
11983 &FIMF11,
11984 &ZIMFF1,
11985 &AIMFF1,
11986 &TKEIMF1,
11987 &JPRFOUT,
11988 &inttype,
11989 &inum,
11990 EV_TEMP1,
11991 &IEV_TAB_TEMP,
11992 &NbLam1);
11993
11994 for (G4int IJ = 0; IJ < IEV_TAB_TEMP; IJ++)
11995 {
11996 EV_TEMP[IJ + IEV_TAB_FIS][0] = EV_TEMP1[IJ][0];
11997 EV_TEMP[IJ + IEV_TAB_FIS][1] = EV_TEMP1[IJ][1];
11998 // Lorentz kinematics
11999 // EV_TEMP(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
12000 // EV_TEMP(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
12001 // EV_TEMP(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
12002 // Lorentz transformation
12003 lorentz_boost(VX1_FISSION,
12004 VY1_FISSION,
12005 VZ1_FISSION,
12006 EV_TEMP1[IJ][2],
12007 EV_TEMP1[IJ][3],
12008 EV_TEMP1[IJ][4],
12009 &VXOUT,
12010 &VYOUT,
12011 &VZOUT);
12012 lorentz_boost(vx_eva_sc, vy_eva_sc, vz_eva_sc, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
12013 EV_TEMP[IJ + IEV_TAB_FIS][2] = VX2OUT;
12014 EV_TEMP[IJ + IEV_TAB_FIS][3] = VY2OUT;
12015 EV_TEMP[IJ + IEV_TAB_FIS][4] = VZ2OUT;
12016 //
12017 }
12018 IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_TEMP;
12019 }
12020 //
12021 // Fission fragment 2
12022 if ((ZF2 <= 0.0) || (AF2 <= 0.0) || (AF2 < ZF2))
12023 {
12024 std::cout << "F2 unphysical: " << ZF << " " << AF << " " << EE << " " << ZF2 << " " << AF2 << std::endl;
12025 }
12026 else
12027 {
12028 // fission and IMF emission are not allowed
12029 opt->optimfallowed = 0; // IMF is not allowed
12030 fiss->ifis = 0; // fission is not allowed
12031 gammaemission = 1;
12032 G4int FF22 = 0, FIMF22 = 0;
12033 G4double ZIMFF2 = 0., AIMFF2 = 0., TKEIMF2 = 0., JPRFOUT = 0.;
12034 //
12035 evapora(ZF2,
12036 AF2,
12037 &EFF2,
12038 0.,
12039 &ZFF2,
12040 &AFF2,
12041 &mtota,
12042 &vz2_eva,
12043 &vx2_eva,
12044 &vy2_eva,
12045 &FF22,
12046 &FIMF22,
12047 &ZIMFF2,
12048 &AIMFF2,
12049 &TKEIMF2,
12050 &JPRFOUT,
12051 &inttype,
12052 &inum,
12053 EV_TEMP2,
12054 &IEV_TAB_TEMP,
12055 &NbLam2);
12056
12057 for (G4int IJ = 0; IJ < IEV_TAB_TEMP; IJ++)
12058 {
12059 EV_TEMP[IJ + IEV_TAB_FIS][0] = EV_TEMP2[IJ][0];
12060 EV_TEMP[IJ + IEV_TAB_FIS][1] = EV_TEMP2[IJ][1];
12061 // Lorentz kinematics
12062 // EV_TEMP(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
12063 // EV_TEMP(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
12064 // EV_TEMP(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
12065 // Lorentz transformation
12066 lorentz_boost(VX2_FISSION,
12067 VY2_FISSION,
12068 VZ2_FISSION,
12069 EV_TEMP2[IJ][2],
12070 EV_TEMP2[IJ][3],
12071 EV_TEMP2[IJ][4],
12072 &VXOUT,
12073 &VYOUT,
12074 &VZOUT);
12075 lorentz_boost(vx_eva_sc, vy_eva_sc, vz_eva_sc, VXOUT, VYOUT, VZOUT, &VX2OUT, &VY2OUT, &VZ2OUT);
12076 EV_TEMP[IJ + IEV_TAB_FIS][2] = VX2OUT;
12077 EV_TEMP[IJ + IEV_TAB_FIS][3] = VY2OUT;
12078 EV_TEMP[IJ + IEV_TAB_FIS][4] = VZ2OUT;
12079 //
12080 }
12081 IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_TEMP;
12082 }
12083 //
12084 // Lorentz kinematics
12085 // vx1_fission = vx1_fission + vx1_eva
12086 // vy1_fission = vy1_fission + vy1_eva
12087 // vz1_fission = vz1_fission + vz1_eva
12088 // vx2_fission = vx2_fission + vx2_eva
12089 // vy2_fission = vy2_fission + vy2_eva
12090 // vz2_fission = vz2_fission + vz2_eva
12091 // The v_eva_sc contribution is considered in the calling subroutine
12092 // Lorentz transformations
12093 lorentz_boost(vx1_eva, vy1_eva, vz1_eva, VX1_FISSION, VY1_FISSION, VZ1_FISSION, &VXOUT, &VYOUT, &VZOUT);
12094 VX1_FISSION = VXOUT;
12095 VY1_FISSION = VYOUT;
12096 VZ1_FISSION = VZOUT;
12097 lorentz_boost(vx2_eva, vy2_eva, vz2_eva, VX2_FISSION, VY2_FISSION, VZ2_FISSION, &VXOUT, &VYOUT, &VZOUT);
12098 VX2_FISSION = VXOUT;
12099 VY2_FISSION = VYOUT;
12100 VZ2_FISSION = VZOUT;
12101 //
12102 (*ZFP1) = idnint(ZFF1);
12103 (*AFP1) = idnint(AFF1);
12104 (*SFP1) = NbLam1;
12105 (*VX1_FISSION_par) = VX1_FISSION;
12106 (*VY1_FISSION_par) = VY1_FISSION;
12107 (*VZ1_FISSION_par) = VZ1_FISSION;
12108 (*VX_EVA_SC_par) = vx_eva_sc;
12109 (*VY_EVA_SC_par) = vy_eva_sc;
12110 (*VZ_EVA_SC_par) = vz_eva_sc;
12111 (*ZFP2) = idnint(ZFF2);
12112 (*AFP2) = idnint(AFF2);
12113 (*SFP2) = NbLam2;
12114 (*VX2_FISSION_par) = VX2_FISSION;
12115 (*VY2_FISSION_par) = VY2_FISSION;
12116 (*VZ2_FISSION_par) = VZ2_FISSION;
12117 (*IEV_TAB_FIS_par) = IEV_TAB_FIS;
12118 (*NbLam0_par) = NbLam1 + NbLam2;
12119 if (NbLam0 > (NbLam1 + NbLam2))
12120 varntp->kfis = 25;
12121 return;
12122 }
12123 //*************************************************************************
12124 //
12125 void G4Abla::tke_bu(G4double Z, G4double A, G4double ZALL, G4double AAL, G4double* VX, G4double* VY, G4double* VZ)
12126 {
12127
12128 G4double V_over_V0, R0, RALL, RHAZ, R, TKE, Ekin, V, VPERP, ALPHA1;
12129
12130 V_over_V0 = 6.0;
12131 R0 = 1.16;
12132
12133 if (Z < 1.0)
12134 {
12135 *VX = 0.0;
12136 *VY = 0.0;
12137 *VZ = 0.0;
12138 return;
12139 }
12140
12141 RALL = R0 * std::pow(V_over_V0, 1.0 / 3.0) * std::pow(AAL, 1.0 / 3.0);
12142 RHAZ = G4double(haz(1));
12143 R = std::pow(RHAZ, 1.0 / 3.0) * RALL;
12144 TKE = 1.44 * Z * ZALL * R * R * (1.0 - A / AAL) * (1.0 - A / AAL) / std::pow(RALL, 3.0);
12145
12146 Ekin = TKE * (AAL - A) / AAL;
12147 // print*,'!!!',IDNINT(AAl),IDNINT(A),IDNINT(ZALL),IDNINT(Z)
12148 V = std::sqrt(Ekin / A) * 1.3887;
12149 *VZ = (2.0 * G4double(haz(1)) - 1.0) * V;
12150 VPERP = std::sqrt(V * V - (*VZ) * (*VZ));
12151 ALPHA1 = G4double(haz(1)) * 2.0 * 3.142;
12152 *VX = VPERP * std::sin(ALPHA1);
12153 *VY = VPERP * std::cos(ALPHA1);
12154 return;
12155 }
12156
12157 G4double G4Abla::haz(G4int k)
12158 {
12159 // const G4int pSize = 110;
12160 // static G4ThreadLocal G4double p[pSize];
12161 static G4ThreadLocal G4int ix = 0;
12162 static G4ThreadLocal G4double x = 0.0, y = 0.0;
12163 // k =< -1 on initialise
12164 // k = -1 c'est reproductible
12165 // k < -1 || k > -1 ce n'est pas reproductible
12166 /*
12167 // Zero is invalid random seed. Set proper value from our random seed
12168 collection: if(ix == 0) {
12169 // ix = hazard->ial;
12170 }
12171 */
12172 if (k <= -1)
12173 { // then
12174 if (k == -1)
12175 { // then
12176 ix = 0;
12177 }
12178 else
12179 {
12180 x = 0.0;
12181 y = secnds(G4int(x));
12182 ix = G4int(y * 100 + 43543000);
12183 if (mod(ix, 2) == 0)
12184 {
12185 ix = ix + 1;
12186 }
12187 }
12188 }
12189
12190 return G4AblaRandom::flat();
12191 }
12192
12193 // Random generator according to the
12194 // powerfunction y = x**(lambda) in the range from xmin to xmax
12195 // xmin, xmax and y are integers.
12196 // lambda must be different from -1 !
12197 G4int G4Abla::IPOWERLIMHAZ(G4double lambda, G4int xmin, G4int xmax)
12198 {
12199 G4double y, l_plus, rxmin, rxmax;
12200 l_plus = lambda + 1.;
12201 rxmin = G4double(xmin) - 0.5;
12202 rxmax = G4double(xmax) + 0.5;
12203 // y=(HAZ(k)*(rxmax**l_plus-rxmin**l_plus)+
12204 // rxmin**l_plus)**(1.E0/l_plus)
12205 y = std::pow(G4AblaRandom::flat() * (std::pow(rxmax, l_plus) - std::pow(rxmin, l_plus)) + std::pow(rxmin, l_plus),
12206 1.0 / l_plus);
12207 return nint(y);
12208 }
12209
12210 void G4Abla::AMOMENT(G4double AABRA, G4double APRF, G4int IMULTIFR, G4double* PX, G4double* PY, G4double* PZ)
12211 {
12212
12213 G4int ISIGOPT = 0;
12214 G4double GOLDHA_BU = 0., GOLDHA = 0.;
12215 G4double PI = 3.141592653589793;
12216 // nu = 1.d0
12217
12218 // G4double BETAP = sqrt(1.0 - 1.0/sqrt(1.0+EAP/931.494));
12219 // G4double GAMMAP = 1.0 / sqrt(1. - BETAP*BETAP);
12220 // G4double FACT_PROJ = (GAMMAP + 1.) / (BETAP * GAMMAP);
12221
12222 // G4double R = 1.160 * pow(APRF,1.0/3.0);
12223
12224 // G4double RNDT = double(haz(1));
12225 // G4double CTET = 2.0*RNDT-1.0;
12226 // G4double TETA = acos(CTET);
12227 // G4double RNDP = double(haz(1));
12228 // G4double PHI = RNDP*2.0*PI;
12229 // G4double STET = sqrt(1.0-CTET*CTET);
12230 // RX = R * STET * DCOS(PHI)
12231 // RY = R * STET * DSIN(PHI)
12232 // RZ = R * CTET
12233
12234 // G4double RZ = 0.0;
12235 // G4double RY = R * sin(PHI);
12236 // G4double RX = R * cos(PHI);
12237
12238 // In MeV/C
12239 G4double V0_over_VBU = 1.0 / 6.0;
12240 G4double SIGMA_0 = 118.50;
12241 G4double Efermi = 5.0 * SIGMA_0 * SIGMA_0 / (2.0 * 931.4940);
12242
12243 if (IMULTIFR == 1)
12244 {
12245 if (ISIGOPT == 0)
12246 {
12247 // "Fermi model" picture:
12248 // Influence of expansion:
12249 SIGMA_0 = SIGMA_0 * std::pow(V0_over_VBU, 1.0 / 3.0);
12250 // To take into account the influence of thermal motion of nucleons (see
12251 // W. Bauer, PRC 51 (1995) 803)
12252 // Efermi = 5.D0 * SIGMA_0 * SIGMA_0 / (2.D0 * 931.49D0)
12253
12254 GOLDHA_BU = SIGMA_0 * std::sqrt((APRF * (AABRA - APRF)) / (AABRA - 1.0));
12255 GOLDHA =
12256 GOLDHA_BU * std::sqrt(1.0 + 5.0 * PI * PI / 12.0 * (T_freeze_out / Efermi) * (T_freeze_out / Efermi));
12257 // PRINT*,'AFTER BU fermi:',IDNINT(AABRA),IDNINT(APRF),GOLDHA,
12258 // & GOLDHA_BU
12259 }
12260 else
12261 {
12262 // Thermal equilibrium picture (<=> to Boltzmann distribution in momentum
12263 // with sigma2=M*T) The factor (AABRA-APRF)/AP comes from momentum
12264 // conservation:
12265 GOLDHA_BU = std::sqrt(APRF * T_freeze_out * 931.494 * (AABRA - APRF) / AABRA);
12266 GOLDHA = GOLDHA_BU;
12267 // PRINT*,'AFTER BU therm:',IDNINT(AABRA),IDNINT(APRF),GOLDHA,
12268 // & GOLDHA_BU
12269 }
12270 }
12271 else
12272 {
12273 GOLDHA = SIGMA_0 * std::sqrt((APRF * (AABRA - APRF)) / (AABRA - 1.0));
12274 }
12275
12276 G4int IS = 0;
12277 mom123:
12278 *PX = G4double(gausshaz(1, 0.0, GOLDHA));
12279 IS = IS + 1;
12280 if (IS > 100)
12281 {
12282 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN "
12283 "CALCULATING PX IN Rn07.FOR. A VALUE WILL BE FORCED."
12284 << std::endl;
12285 *PX = (AABRA - 1.0) * 931.4940;
12286 }
12287 if (std::abs(*PX) >= AABRA * 931.494)
12288 {
12289 // PRINT*,'VX > C',PX,IDNINT(APRF)
12290 goto mom123;
12291 }
12292 IS = 0;
12293 mom456:
12294 *PY = G4double(gausshaz(1, 0.0, GOLDHA));
12295 IS = IS + 1;
12296 if (IS > 100)
12297 {
12298 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN "
12299 "CALCULATING PY IN Rn07.FOR. A VALUE WILL BE FORCED."
12300 << std::endl;
12301 *PY = (AABRA - 1.0) * 931.4940;
12302 }
12303 if (std::abs(*PY) >= AABRA * 931.494)
12304 {
12305 // PRINT*,'VX > C',PX,IDNINT(APRF)
12306 goto mom456;
12307 }
12308 IS = 0;
12309 mom789:
12310 *PZ = G4double(gausshaz(1, 0.0, GOLDHA));
12311 IS = IS + 1;
12312 if (IS > 100)
12313 {
12314 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN "
12315 "CALCULATING PZ IN Rn07.FOR. A VALUE WILL BE FORCED."
12316 << std::endl;
12317 *PZ = (AABRA - 1.0) * 931.4940;
12318 }
12319 if (std::abs(*PZ) >= AABRA * 931.494)
12320 {
12321 // PRINT*,'VX > C',PX,IDNINT(APRF)
12322 goto mom789;
12323 }
12324 return;
12325 }
12326
12327 G4double G4Abla::gausshaz(G4int k, G4double xmoy, G4double sig)
12328 {
12329 // Gaussian random numbers:
12330
12331 // 1005 C*** TIRAGE ALEATOIRE DANS UNE GAUSSIENNE DE LARGEUR SIG ET
12332 // MOYENNE XMOY
12333 static G4ThreadLocal G4int iset = 0;
12334 static G4ThreadLocal G4double v1, v2, r, fac, gset, fgausshaz;
12335
12336 if (iset == 0)
12337 { // then
12338 do
12339 {
12340 v1 = 2.0 * haz(k) - 1.0;
12341 v2 = 2.0 * haz(k) - 1.0;
12342 r = std::pow(v1, 2) + std::pow(v2, 2);
12343 } while (r >= 1);
12344
12345 fac = std::sqrt(-2. * std::log(r) / r);
12346 gset = v1 * fac;
12347 fgausshaz = v2 * fac * sig + xmoy;
12348 iset = 1;
12349 }
12350 else
12351 {
12352 fgausshaz = gset * sig + xmoy;
12353 iset = 0;
12354 }
12355 return fgausshaz;
12356 }
12357