Geant4-11
G4Abla.cc
Go to the documentation of this file.
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, GSI (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#define ABLAXX_IN_GEANT4_MODE 1
35
36#include "globals.hh"
37#include <time.h>
38#include <cmath>
39
40#include "G4Abla.hh"
41#include "G4AblaDataFile.hh"
42#include "G4AblaRandom.hh"
43#ifdef ABLAXX_IN_GEANT4_MODE
44G4Abla::G4Abla(G4Volant *aVolant, G4VarNtp *aVarntp)
45#else
47#endif
48{
49#ifndef ABLAXX_IN_GEANT4_MODE
50 theConfig = config;
51#endif
52 verboseLevel = 0;
53 ilast = 0;
54 volant = aVolant; // ABLA internal particle data
55 volant->iv = 0;
56 varntp = aVarntp; // Output data structure
57 varntp->ntrack = 0;
58
59 verboseLevel = 0;
60 gammaemission= 0;// 0 presaddle, 1 postsaddle
61 T_freeze_out = 0.;
62 Ainit=0;
63 Zinit=0;
64 Sinit=0;
65
66 pace = new G4Pace();
67 ald = new G4Ald();
68 eenuc = new G4Eenuc();
69 ec2sub = new G4Ec2sub();
70 ecld = new G4Ecld();
71 masses = new G4Mexp();
72 fb = new G4Fb();
73 fiss = new G4Fiss();
74 opt = new G4Opt();
75}
76
78{
79 verboseLevel = level;
80}
81
83{
84 delete pace;
85 delete ald;
86 delete eenuc;
87 delete ec2sub;
88 delete ecld;
89 delete masses;
90 delete fb;
91 delete fiss;
92 delete opt;
93}
94
95// Main interface to the evaporation without lambda evaporation
96void G4Abla::DeexcitationAblaxx(G4int nucleusA, G4int nucleusZ, G4double excitationEnergy, G4double angularMomentum, G4double momX, G4double momY, G4double momZ, G4int eventnumber)
97{
98 DeexcitationAblaxx(nucleusA,nucleusZ,excitationEnergy,angularMomentum,momX,momY,momZ,eventnumber,0);
99}
100
101// Main interface to the evaporation with lambda emission
102void G4Abla::DeexcitationAblaxx(G4int nucleusA, G4int nucleusZ, G4double excitationEnergy, G4double angularMomentum, G4double momX, G4double momY, G4double momZ, G4int eventnumber, G4int nucleusS)
103{
104
105 const G4double amu = 931.4940; // MeV/C^2
106 const G4double C = 29.9792458; // cm/ns
107
108 SetParametersG4(nucleusZ, nucleusA);
109
110 mult10:
111 G4int IS = 0;
112
113 if(nucleusS>0)nucleusS=0;// S=1 from INCL ????
114
115 G4int NbLam0 = std::abs(nucleusS);
116
117 Ainit=-1*nucleusA;
118 Zinit=-1*nucleusZ;
119 Sinit=-1*nucleusS;
120
121 G4double aff = 0.0;
122 G4double zff = 0.0;
123 G4int ZFP1 = 0, AFP1 = 0, AFPIMF = 0, ZFPIMF = 0, ZFP2 = 0, AFP2 = 0, SFP1 = 0, SFP2 = 0, SFPIMF = 0;
124 G4double vx_eva = 0.0, vy_eva = 0.0, vz_eva = 0.0;
125 G4double VX_PREF=0.,VY_PREF=0.,VZ_PREF=00,VP1X,VP1Y,VP1Z,VXOUT,VYOUT,VZOUT,V_CM[3],VFP1_CM[3],VFP2_CM[3],VIMF_CM[3],VX2OUT,VY2OUT,VZ2OUT;
126 G4double zf = 0.0, af = 0.0, mtota = 0.0, tkeimf = 0.0, jprf0=0.;
127 G4int ff = 0,afpnew=0,zfpnew=0,aprfp=0,zprfp=0,IOUNSTABLE=0,ILOOP=0,IEV_TAB=0,IEV_TAB_TEMP=0;
128 G4int fimf = 0,INMIN=0,INMAX=0;
129 G4int ftype=0;//,ftype1=0;
130 G4int inum = eventnumber;
131 G4int inttype = 0;
133
134 if(fiss->zt>56){
135 fiss->ifis = 1;
136 }else {
137 fiss->ifis = 0;
138 }
139
140 if(NbLam0>0){
141 opt->nblan0 = NbLam0;
142 }
143
144 G4double aprf = (G4double) nucleusA;
145 G4double zprf = (G4double) nucleusZ;
146 G4double ee = excitationEnergy;
147 G4double jprf = angularMomentum; // actually root-mean-squared
148
149 G4double pxrem = momX;
150 G4double pyrem = momY;
151 G4double pzrem = momZ;
152 G4double zimf,aimf;
153
154 volant->clear(); // Clean up an initialize ABLA output.
155 varntp->clear(); // Clean up an initialize ABLA output.
156 varntp->ntrack = 0;
157 varntp->kfis = 0;
158 volant->iv = 0;
160 G4double T_init=0.,T_diff=0.,a_tilda=0.,a_tilda_BU=0., EE_diff=0., EINCL=0., A_FINAL=0., Z_FINAL=0., E_FINAL=0.;
161
162 G4double A_diff=0.,ASLOPE1,ASLOPE2,A_ACC,ABU_SLOPE, ABU_SUM=0., AMEM=0., ZMEM=0., EMEM=0., JMEM=0., 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.,Z_Breakup_sum=0.,A_Breakup,Z_Breakup,N_Breakup,G_SYMM,CZ,Sigma_Z,Z_Breakup_Mean,ZTEMP=0.,ATEMP=0.;
163
164 G4double ETOT_PRF=0.0,PXPRFP=0.,PYPRFP=0.,PZPRFP=0.,PPRFP=0., VX1_BU=0., VY1_BU=0., VZ1_BU=0., VBU2=0., GAMMA_REL=1.0, Eexc_BU_SUM=0., VX_BU_SUM = 0., VY_BU_SUM =0.,VZ_BU_SUM =0., E_tot_BU=0.,EKIN_BU=0.,ZIMFBU=0., AIMFBU=0., ZFFBU=0., AFFBU=0., AFBU=0., ZFBU=0., EEBU=0.,TKEIMFBU=0.,vx_evabu=0.,vy_evabu=0.,vz_evabu=0., Bvalue_BU=0.,P_BU=0.,ETOT_BU=1.,PX_BU=0.,PY_BU=0.,PZ_BU=0.,VX2_BU=0.,VY2_BU=0.,VZ2_BU=0.;
165
166 G4int ABU_DIFF,ZBU_DIFF,NBU_DIFF;
167 G4int INEWLOOP = 0, ILOOPBU=0;
168
169 G4double BU_TAB_TEMP[200][6], BU_TAB_TEMP1[200][6];
170 G4double EV_TAB_TEMP[200][6],EV_TEMP[200][6];
171 G4int IMEM_BU[200], IMEM=0;
172
173 if(nucleusA<1){
174 std::cout << "Error - Remnant with a mass number A below 1." << std::endl;
175 //INCL_ERROR("Remnant with a mass number A below 1.");
176 return;
177 }
178
179 for(G4int j=0;j<3;j++){
180 V_CM[j]=0.;
181 VFP1_CM[j]=0.;
182 VFP2_CM[j]=0.;
183 VIMF_CM[j]=0.;
184 }
185
186 for(G4int I1=0;I1<200;I1++){
187 for(G4int I2 = 0;I2<12;I2++)
188 BU_TAB[I1][I2] = 0.0;
189 for(G4int I2 = 0;I2<6;I2++){
190 BU_TAB_TEMP[I1][I2] = 0.0;
191 BU_TAB_TEMP1[I1][I2] = 0.0;
192 EV_TAB_TEMP[I1][I2] = 0.0;
193 EV_TAB[I1][I2] = 0.0;
194 EV_TAB_SSC[I1][I2] = 0.0;
195 EV_TEMP[I1][I2] = 0.0;
196 }
197 }
198
199 G4int idebug = 0;
200 if(idebug == 1) {
201 zprf = 81.;
202 aprf = 201.;
203// ee = 86.5877686;
204 ee = 100.0;
205 jprf = 10.;
206 zf = 0.;
207 af = 0.;
208 mtota = 0.;
209 ff = 1;
210 inttype = 0;
211 //inum = 2;
212 }
213//
214 G4double AAINCL = aprf;
215 G4double ZAINCL = zprf;
216 EINCL = ee;
217//
218// Velocity after the first stage of reaction (INCL)
219// For coupling with INCL, comment the lines below, and use output
220// of INCL as pxincl, pyincl,pzincl
221//
222 G4double pincl = std::sqrt(pxrem*pxrem + pyrem*pyrem + pzrem*pzrem);
223// PPRFP is in MeV/c
224 G4double ETOT_incl = std::sqrt(pincl*pincl + (AAINCL * amu)*(AAINCL * amu));
225 G4double VX_incl = C * pxrem / ETOT_incl;
226 G4double VY_incl = C * pyrem / ETOT_incl;
227 G4double VZ_incl = C * pzrem / ETOT_incl;
228//
229// Multiplicity in the break-up event
230 G4int IMULTBU = 0;
231 G4int IMULTIFR = 0;
232 G4int I_Breakup=0;
233 G4int NbLamprf= 0;
234 IEV_TAB = 0;
235/*
236C Set maximum temperature for sequential decay (evaporation)
237C Remove additional energy by simultaneous break up
238C (vaporisation or multi-fragmentation)
239
240C Idea: If the temperature of the projectile spectator exceeds
241c the limiting temperature T_freeze_out, the additional
242C energy which is present in the spectator is used for
243C a stage of simultaneous break up. It is either the
244C simultaneous emission of a gaseous phase or the simultaneous
245C emission of several intermediate-mass fragments. Only one
246C piece of the projectile spectator (assumed to be the largest
247C one) is kept track.
248
249C MVR, KHS, October 2001
250C KHS, AK 2007 - Masses from the power low; slope parameter dependent on
251C energy per nucleon; symmtery-energy coeff. dependent on
252C energy per nucleon.
253
254c Clear BU_TAB (array of multifragmentation products)
255*/
256 if(T_freeze_out_in >= 0.0){
258 }else{
259 T_freeze_out = max(9.33*std::exp(-0.00282*AAINCL),5.5);
260// ! See: J. Natowitz et al, PRC65 (2002) 034618
261// T_freeze_out=DMAX1(9.0D0*DEXP(-0.001D0*AAABRA),
262// & 5.5D0)
263 }
264//
265 a_tilda = ald->av*aprf + ald->as*std::pow(aprf,2.0/3.0) + ald->ak*std::pow(aprf,1.0/3.0);
266
267 T_init = std::sqrt(EINCL/a_tilda);
268
269 T_diff = T_init - T_freeze_out;
270
271 if(T_diff>0.1 && zprf>2. && (aprf-zprf)>0.){
272 // T_Diff is set to be larger than 0.1 MeV in order to avoid strange cases for which
273 // T_Diff is of the order of 1.e-3 and less.
274 varntp->kfis = 10;
275
276 for(G4int i=0;i<5;i++){
277 EE_diff = EINCL - a_tilda * T_freeze_out*T_freeze_out;
278// Energy removed 10*5/T_init per nucleon removed in simultaneous breakup
279// adjusted to frag. xsections 238U (1AGeV) + Pb data, KHS Dec. 2005
280// This should maybe be re-checked, in a meanwhile several things in break-up description
281// have changed (AK).
282
283 A_diff = dint(EE_diff / (8.0 * 5.0 / T_freeze_out));
284
285 if(A_diff>AAINCL) A_diff = AAINCL;
286
287 A_FINAL = AAINCL - A_diff;
288
289 a_tilda = ald->av*A_FINAL + ald->as*std::pow(A_FINAL,2.0/3.0) + ald->ak*std::pow(A_FINAL,1.0/3.0);
290 E_FINAL = a_tilda * T_freeze_out*T_freeze_out;
291
292 if(A_FINAL<4.0){ // To avoid numerical problems
293 EE_diff = EINCL - E_FINAL;
294 A_FINAL = 1.0;
295 Z_FINAL = 1.0;
296 E_FINAL = 0.0;
297 goto mul4325;
298 }
299 }
300 mul4325:
301// The idea is similar to Z determination of multifragment - Z of "heavy" partner is not
302// fixed by the A/Z of the prefragment, but randomly picked from Gaussian
303 // Z_FINAL_MEAN = dint(zprf * A_FINAL / (aprf));
304
305 Z_FINAL = dint(zprf * A_FINAL / (aprf));
306
307 if(E_FINAL<0.0) E_FINAL = 0.0;
308
309 aprf = A_FINAL;
310 zprf = Z_FINAL;
311 ee = E_FINAL;
312
313 A_diff = AAINCL - aprf;
314
315// Creation of multifragmentation products by breakup
316 if(A_diff<=1.0){
317 aprf = AAINCL;
318 zprf = ZAINCL;
319 ee = EINCL;
320 IMULTIFR = 0;
321 goto mult7777;
322 }else if(A_diff>1.0){
323
324 A_ACC = 0.0;
325// Energy-dependence of the slope parameter, acc. to A. Botvina, fits also to exp. data (see
326// e.g. Sfienti et al, NPA 2007)
327 ASLOPE1 = -2.400; // e*/a=7 -2.4
328 ASLOPE2 = -1.200; // e*/a=3 -1.2
329
330 a_tilda = ald->av*AAINCL + ald->as*std::pow(AAINCL,2.0/3.0) + ald->ak*std::pow(AAINCL,1.0/3.0);
331
332 E_FINAL = a_tilda * T_freeze_out*T_freeze_out;
333
334 ABU_SLOPE = (ASLOPE1-ASLOPE2)/4.0*(E_FINAL/AAINCL)+
335 ASLOPE1-(ASLOPE1-ASLOPE2)*7.0/4.0;
336
337// Botvina et al, PRC 74 (2006) 044609, fig. 5 for B0=18 MeV
338// ABU_SLOPE = 5.57489D0-2.08149D0*(E_FINAL/AAABRA)+
339// & 0.3552D0*(E_FINAL/AAABRA)**2-0.024927D0*(E_FINAL/AAABRA)**3+
340// & 7.268D-4*(E_FINAL/AAABRA)**4
341// They fit with A**(-tau) and here is done A**(tau)
342// ABU_SLOPE = ABU_SLOPE*(-1.D0)
343
344// ABU_SLOPE = -2.60D0
345// print*,ABU_SLOPE,(E_FINAL/AAABRA)
346
347 if(ABU_SLOPE > -1.01) ABU_SLOPE = -1.01;
348
349 I_Breakup = 0;
350 Z_Breakup_sum = Z_FINAL;
351 ABU_SUM = 0.0;
352 ZBU_SUM = 0.0;
353
354 for(G4int i=0;i<100;i++){
355 IS = 0;
356 mult4326:
357 A_Breakup = dint(G4double(IPOWERLIMHAZ(ABU_SLOPE,1,idnint(A_diff))));
358 // Power law with exponent ABU_SLOPE
359 IS = IS +1;
360 if(IS>100){
361 std::cout << "WARNING: IPOWERLIMHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING A_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED: " << A_Breakup << std::endl;
362 goto mult10;
363 }
364
365 if(A_Breakup>AAINCL) goto mult4326;
366
367 if(A_Breakup<=0.0){
368 std::cout << "A_BREAKUP <= 0 " << std::endl;
369 goto mult10;
370 }
371
372 A_ACC = A_ACC + A_Breakup;
373
374 if(A_ACC<=A_diff){
375
376 Z_Breakup_Mean = dint(A_Breakup * ZAINCL / AAINCL);
377
378 Z_Breakup_sum = Z_Breakup_sum + Z_Breakup_Mean;
379//
380// See G.A. Souliotis et al, PRC 75 (2007) 011601R (Fig. 2)
381 G_SYMM = 34.2281 - 5.14037 * E_FINAL/AAINCL;
382 if(E_FINAL/AAINCL < 2.0) G_SYMM = 25.0;
383 if(E_FINAL/AAINCL > 4.0) G_SYMM = 15.0;
384
385// G_SYMM = 23.6;
386
387 G_SYMM = 25.0; //25
388 CZ = 2.0 * G_SYMM * 4.0 / A_Breakup;
389 // 2*CZ=d^2(Esym)/dZ^2, Esym=Gamma*(A-2Z)**2/A
390 // gamma = 23.6D0 is the symmetry-energy coefficient
391 G4int IIS = 0;
392 Sigma_Z = std::sqrt(T_freeze_out/CZ);
393
394 IS = 0;
395 mult4333:
396 Z_Breakup = dint( G4double(gausshaz(1,Z_Breakup_Mean,Sigma_Z)));
397 IS = IS +1;
398//
399 if(IS>100){
400 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING Z_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED: " << A_Breakup << " " << Z_Breakup << std::endl;
401 goto mult10;
402 }
403
404 if(Z_Breakup<0.0 ) goto mult4333;
405 if((A_Breakup-Z_Breakup)<0.0) goto mult4333;
406 if((A_Breakup-Z_Breakup)==0.0 && Z_Breakup!=1.0) goto mult4333;
407
408 if(Z_Breakup>=ZAINCL){
409 IIS = IIS + 1;
410 if(IIS > 10){
411 std::cout << "Z_BREAKUP RESAMPLED MORE THAN 10 TIMES; EVENT WILL BE RESAMPLED AGAIN " << std::endl;
412 goto mult10;
413 }
414 goto mult4333;
415 }
416
417// *** Find the limits that fragment is bound :
418 isostab_lim(idnint(Z_Breakup),&INMIN,&INMAX);
419// INMIN = MAX(1,INMIN-2)
420 if(Z_Breakup > 2.0){
421 if(idnint(A_Breakup-Z_Breakup)<INMIN || idnint(A_Breakup-Z_Breakup)>(INMAX+5)){
422// PRINT*,'N_Breakup >< NMAX',
423// & IDNINT(Z_Breakup),IDNINT(A_Breakup-Z_Breakup),INMIN,INMAX
424 goto mult4343;
425 }
426 }
427
428 mult4343:
429
430// We consider all products, also nucleons created in the break-up
431// I_Breakup = I_Breakup + 1;// moved below
432
433 N_Breakup = A_Breakup - Z_Breakup;
434 BU_TAB[I_Breakup][0] = dint(Z_Breakup); // Mass of break-up product
435 BU_TAB[I_Breakup][1] = dint(A_Breakup); // Z of break-up product
436 ABU_SUM = ABU_SUM + BU_TAB[i][1];
437 ZBU_SUM = ZBU_SUM + BU_TAB[i][0];
438//
439// Break-up products are given zero angular momentum (simplification)
440 BU_TAB[I_Breakup][3] = 0.0;
441 I_Breakup = I_Breakup + 1;
442 IMULTBU = IMULTBU + 1;
443 }else{
444// There are A_DIFF - A_ACC nucleons lost by breakup, but they do not end up in multifragmentation products.
445// This is a deficiency of the Monte-Carlo method applied above to determine the sizes of the fragments
446// according to the power law.
447// print*,'Deficiency',IDNINT(A_DIFF-A_ACC)
448
449 goto mult4327;
450 }// if(A_ACC<=A_diff)
451 }//for
452 //mult4327:
453 //IMULTIFR = 1;
454 } // if(A_diff>1.0)
455 mult4327:
456 IMULTIFR = 1;
457
458// "Missing" A and Z picked from the power law:
459 ABU_DIFF = idnint(ABU_SUM+aprf-AAINCL);
460 ZBU_DIFF = idnint(ZBU_SUM+zprf-ZAINCL);
461 NBU_DIFF = idnint((ABU_SUM-ZBU_SUM)+(aprf-zprf)-(AAINCL-ZAINCL));
462//
463 if(IMULTBU > 200)
464 std::cout << "WARNING - MORE THAN 200 BU " << IMULTBU << std::endl;
465
466 if(IMULTBU < 1)
467 std::cout << "WARNING - LESS THAN 1 BU " << IMULTBU << std::endl;
468 //,AABRA,ZABRA,IDNINT(APRF),IDNINT(ZPRF),ABU_DIFF,ZBU_DIFF
469
470 G4int IPROBA = 0;
471 for(G4int i=0;i<IMULTBU;i++)
472 IMEM_BU[i] = 0;
473
474 while(NBU_DIFF!=0 && ZBU_DIFF!=0){
475// (APRF,ZPRF) is also inlcuded in this game, as from time to time the program
476// is entering into endless loop, as it can not find proper nucleus for adapting A and Z.
477 IS = 0;
478 mult5555:
479 G4double RHAZ = G4AblaRandom::flat()*G4double(IMULTBU);
480 IPROBA = IPROBA + 1;
481 IS = IS + 1;
482 if(IS>100){
483 std::cout << "WARNING: HAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING N_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED." << std::endl;
484 goto mult10;
485 }
486 G4int IEL = G4int(RHAZ);
487 if(IMEM_BU[IEL]==1) goto mult5555;
488 if(!(IEL<200))std::cout << "5555:" << IEL << RHAZ << IMULTBU << std::endl;
489 if(IEL<0)std::cout << "5555:"<< IEL << RHAZ << IMULTBU << std::endl;
490 if(IEL<=IMULTBU){
491 N_Breakup = dint(BU_TAB[IEL][1]-BU_TAB[IEL][0] - DSIGN(1.0,G4double(NBU_DIFF)));
492 }else if(IEL>IMULTBU){
493 N_Breakup = dint(aprf - zprf - DSIGN(1.0,G4double(NBU_DIFF)));
494 }
495 if(N_Breakup<0.0){
496 IMEM_BU[IEL] = 1;
497 goto mult5555;
498 }
499 if(IEL<=IMULTBU){
500 ZTEMP = dint(BU_TAB[IEL][0] - DSIGN(1.0,G4double(ZBU_DIFF)));
501 }else if(IEL>IMULTBU){
502 ZTEMP = dint(zprf - DSIGN(1.0,G4double(ZBU_DIFF)));
503 }
504 if(ZTEMP<0.0){
505 IMEM_BU[IEL] = 1;
506 goto mult5555;
507 }
508 if(ZTEMP<1.0 && N_Breakup<1.0){
509 IMEM_BU[IEL] = 1;
510 goto mult5555;
511 }
512// Nuclei with A=Z and Z>1 are allowed in this stage, as otherwise,
513// for more central collisions there is not enough mass which can be
514// shufeled in order to conserve A and Z. These are mostly nuclei with
515// Z=2 and in less extent 3, 4 or 5.
516// IF(ZTEMP.GT.1.D0 .AND. N_Breakup.EQ.0.D0) THEN
517// GOTO 5555
518// ENDIF
519 if(IEL<=IMULTBU){
520 BU_TAB[IEL][0] = dint(ZTEMP);
521 BU_TAB[IEL][1] = dint(ZTEMP + N_Breakup);
522 }else if(IEL>IMULTBU){
523 zprf = dint(ZTEMP);
524 aprf = dint(ZTEMP + N_Breakup);
525 }
526 NBU_DIFF = NBU_DIFF - ISIGN(1,NBU_DIFF);
527 ZBU_DIFF = ZBU_DIFF - ISIGN(1,ZBU_DIFF);
528 }// while
529
530 IPROBA = 0;
531 for(G4int i=0;i<IMULTBU;i++)
532 IMEM_BU[i] = 0;
533
534 if(NBU_DIFF != 0 && ZBU_DIFF == 0){
535 while(NBU_DIFF > 0 || NBU_DIFF < 0){
536 IS = 0;
537 mult5556:
538 G4double RHAZ = G4AblaRandom::flat()*G4double(IMULTBU);
539 IS = IS + 1;
540 if(IS>100){
541 std::cout << "WARNING: HAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING N_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED." << std::endl;
542 goto mult10;
543 }
544 G4int IEL = G4int(RHAZ);
545 if(IMEM_BU[IEL]==1) goto mult5556;
546// IPROBA = IPROBA + 1;
547 if(IPROBA>IMULTBU+1 && NBU_DIFF>0){
548 std::cout << "###',IPROBA,IMULTBU,NBU_DIFF,ZBU_DIFF,T_freeze_out" << std::endl;
549 IPROBA = IPROBA + 1;
550 if(IEL<=IMULTBU){
551 BU_TAB[IEL][1] = dint(BU_TAB[IEL][1]-G4double(NBU_DIFF));
552 }else{ if(IEL>IMULTBU)
553 aprf = dint(aprf - G4double(NBU_DIFF));
554 }
555 goto mult5432;
556 }
557 if(!(IEL<200))std::cout << "5556:" << IEL << RHAZ << IMULTBU << std::endl;
558 if(IEL<0)std::cout << "5556:"<< IEL << RHAZ << IMULTBU << std::endl;
559 if(IEL<=IMULTBU){
560 N_Breakup = dint(BU_TAB[IEL][1]-BU_TAB[IEL][0] - DSIGN(1.0,G4double(NBU_DIFF)));
561 }else if(IEL>IMULTBU){
562 N_Breakup = dint(aprf - zprf - DSIGN(1.0,G4double(NBU_DIFF)));
563 }
564 if(N_Breakup<0.0){
565 IMEM_BU[IEL] = 1;
566 goto mult5556;
567 }
568 if(IEL<=IMULTBU){
569 ATEMP = dint(BU_TAB[IEL][0] + N_Breakup);
570 }else if(IEL>IMULTBU){
571 ATEMP = dint(zprf + N_Breakup);
572 }
573 if((ATEMP - N_Breakup)<1.0 && N_Breakup<1.0){
574 IMEM_BU[IEL] = 1;
575 goto mult5556;
576 }
577// IF((ATEMP - N_Breakup).GT.1.D0 .AND.
578// & N_Breakup.EQ.0.D0) THEN
579// IMEM_BU(IEL) = 1
580// GOTO 5556
581// ENDIF
582 if(IEL<=IMULTBU)
583 BU_TAB[IEL][1] = dint(BU_TAB[IEL][0] + N_Breakup);
584 else if(IEL>IMULTBU)
585 aprf = dint(zprf + N_Breakup);
586//
587 NBU_DIFF = NBU_DIFF - ISIGN(1,NBU_DIFF);
588 }//while(NBU_DIFF > 0 || NBU_DIFF < 0)
589
590 IPROBA = 0;
591 for(G4int i=0;i<IMULTBU;i++)
592 IMEM_BU[i] = 0;
593
594 }else{// if(NBU_DIFF != 0 && ZBU_DIFF == 0)
595 if(ZBU_DIFF != 0 && NBU_DIFF == 0){
596 while(ZBU_DIFF > 0 || ZBU_DIFF < 0){
597 IS = 0;
598 mult5557:
599 G4double RHAZ = G4AblaRandom::flat()*G4double(IMULTBU);
600 IS = IS + 1;
601 if(IS>100){
602 std::cout << "WARNING: HAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING N_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED." << std::endl;
603 goto mult10;
604 }
605 G4int IEL = G4int(RHAZ);
606 if(IMEM_BU[IEL]==1) goto mult5557;
607 //IPROBA = IPROBA + 1;
608 if(IPROBA>IMULTBU+1 && ZBU_DIFF>0){
609 std::cout << "###',IPROBA,IMULTBU,NBU_DIFF,ZBU_DIFF,T_freeze_out" << std::endl;
610 IPROBA = IPROBA + 1;
611 if(IEL<=IMULTBU){
612 N_Breakup = dint(BU_TAB[IEL][1]-BU_TAB[IEL][0]);
613 BU_TAB[IEL][0] = dint(BU_TAB[IEL][0] - G4double(ZBU_DIFF));
614 BU_TAB[IEL][1] = dint(BU_TAB[IEL][0] + N_Breakup);
615 }else{
616 if(IEL>IMULTBU){
617 N_Breakup = aprf - zprf;
618 zprf = dint(zprf - G4double(ZBU_DIFF));
619 aprf = dint(zprf + N_Breakup);
620 }
621 }
622 goto mult5432;
623 }
624 if(!(IEL<200))std::cout << "5557:" << IEL << RHAZ << IMULTBU << std::endl;
625 if(IEL<0)std::cout << "5557:"<< IEL << RHAZ << IMULTBU << std::endl;
626 if(IEL<=IMULTBU){
627 N_Breakup = dint(BU_TAB[IEL][1]-BU_TAB[IEL][0]);
628 ZTEMP = dint(BU_TAB[IEL][0] - DSIGN(1.0,G4double(ZBU_DIFF)));
629 }else if(IEL>IMULTBU){
630 N_Breakup = dint(aprf - zprf);
631 ZTEMP = dint(zprf - DSIGN(1.0,G4double(ZBU_DIFF)));
632 }
633 ATEMP = dint(ZTEMP + N_Breakup);
634 if(ZTEMP<0.0){
635 IMEM_BU[IEL] = 1;
636 goto mult5557;
637 }
638 if((ATEMP-ZTEMP)<0.0){
639 IMEM_BU[IEL] = 1;
640 goto mult5557;
641 }
642 if((ATEMP-ZTEMP)<1.0 && ZTEMP<1.0){
643 IMEM_BU[IEL] = 1;
644 goto mult5557;
645 }
646 if(IEL<=IMULTBU){
647 BU_TAB[IEL][0] = dint(ZTEMP);
648 BU_TAB[IEL][1] = dint(ZTEMP + N_Breakup);
649 }else{
650 if(IEL>IMULTBU){
651 zprf = dint(ZTEMP);
652 aprf = dint(ZTEMP + N_Breakup);
653 }
654 }
655 ZBU_DIFF = ZBU_DIFF - ISIGN(1,ZBU_DIFF);
656 }//while
657 }//if(ZBU_DIFF != 0 && NBU_DIFF == 0)
658 }// if(NBU_DIFF != 0 && ZBU_DIFF == 0)
659
660 mult5432:
661// Looking for the heaviest fragment among all multifragmentation events, and
662// "giving" excitation energy to fragments
663 ZMEM = 0.0;
664
665 for(G4int i =0;i<IMULTBU;i++){
666//For particles with Z>2 we calculate excitation energy from freeze-out temperature.
667// For particels with Z<3 we assume that they form a gas, and that temperature results
668// in kinetic energy (which is sampled from Maxwell distribution with T=Tfreeze-out)
669// and not excitation energy.
670 if(BU_TAB[i][0]>2.0){
671 a_tilda_BU = ald->av*BU_TAB[i][1] + ald->as*std::pow(BU_TAB[i][1],2.0/3.0) + ald->ak*std::pow(BU_TAB[i][1],1.0/3.0);
672 BU_TAB[i][2] = a_tilda_BU * T_freeze_out*T_freeze_out; // E* of break-up product
673 }else{
674 BU_TAB[i][2] = 0.0;
675 }
676//
677 if(BU_TAB[i][0] > ZMEM){
678 IMEM = i;
679 ZMEM = BU_TAB[i][0];
680 AMEM = BU_TAB[i][1];
681 EMEM = BU_TAB[i][2];
682 JMEM = BU_TAB[i][3];
683 }
684 }//for IMULTBU
685
686 if(zprf < ZMEM){
687 BU_TAB[IMEM][0] = zprf;
688 BU_TAB[IMEM][1] = aprf;
689 BU_TAB[IMEM][2] = ee;
690 BU_TAB[IMEM][3] = jprf;
691 zprf = ZMEM;
692 aprf = AMEM;
693 aprfp = idnint(aprf);
694 zprfp = idnint(zprf);
695 ee = EMEM;
696 jprf = JMEM;
697 }
698
699// Just for checking:
700 ABU_SUM = aprf;
701 ZBU_SUM = zprf;
702 for(G4int i = 0;i<IMULTBU;i++){
703 ABU_SUM = ABU_SUM + BU_TAB[i][1];
704 ZBU_SUM = ZBU_SUM + BU_TAB[i][0];
705 }
706 ABU_DIFF = idnint(ABU_SUM-AAINCL);
707 ZBU_DIFF = idnint(ZBU_SUM-ZAINCL);
708//
709 if(ABU_DIFF!=0 || ZBU_DIFF!=0)
710 std::cout << "Problem of mass in BU " << ABU_DIFF << " " << ZBU_DIFF << std::endl;
711 PX_BU_SUM = 0.0;
712 PY_BU_SUM = 0.0;
713 PZ_BU_SUM = 0.0;
714// Momenta of break-up products are calculated. They are all given in the rest frame
715// of the primary prefragment (i.e. after incl):
716// Goldhaber model ****************************************
717// "Heavy" residue
718 AMOMENT(AAINCL,aprf,1,&PXPRFP,&PYPRFP,&PZPRFP);
719 PPRFP = std::sqrt(PXPRFP*PXPRFP + PYPRFP*PYPRFP + PZPRFP*PZPRFP);
720// ********************************************************
721// PPRFP is in MeV/c
722 ETOT_PRF = std::sqrt(PPRFP*PPRFP + (aprf * amu)*(aprf * amu));
723 VX_PREF = C * PXPRFP / ETOT_PRF;
724 VY_PREF = C * PYPRFP / ETOT_PRF;
725 VZ_PREF = C * PZPRFP / ETOT_PRF;
726
727// Contribution from Coulomb repulsion ********************
728 tke_bu(zprf,aprf,ZAINCL,AAINCL,&VX1_BU,&VY1_BU,&VZ1_BU);
729
730// Lorentz kinematics
731// VX_PREF = VX_PREF + VX1_BU
732// VY_PREF = VY_PREF + VY1_BU
733// VZ_PREF = VZ_PREF + VZ1_BU
734// Lorentz transformation
735 lorentz_boost(VX1_BU,VY1_BU,VZ1_BU,
736 VX_PREF,VY_PREF,VZ_PREF,
737 &VXOUT,&VYOUT,&VZOUT);
738
739 VX_PREF = VXOUT;
740 VY_PREF = VYOUT;
741 VZ_PREF = VZOUT;
742
743// Total momentum: Goldhaber + Coulomb
744 VBU2 = VX_PREF*VX_PREF + VY_PREF*VY_PREF + VZ_PREF*VZ_PREF;
745 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
746 ETOT_PRF = aprf * amu / GAMMA_REL;
747 PXPRFP = ETOT_PRF * VX_PREF / C;
748 PYPRFP = ETOT_PRF * VY_PREF / C;
749 PZPRFP = ETOT_PRF * VZ_PREF / C;
750
751// ********************************************************
752// Momentum: Total width of abrasion and breakup assumed to be given
753// by Fermi momenta of nucleons
754// *****************************************
755
756 PX_BU_SUM = PXPRFP;
757 PY_BU_SUM = PYPRFP;
758 PZ_BU_SUM = PZPRFP;
759
760 Eexc_BU_SUM = ee;
761 Bvalue_BU = eflmac(idnint(aprf),idnint(zprf),1,0);
762
763 for(I_Breakup=0;I_Breakup<IMULTBU;I_Breakup++){
764// For bu products:
765 Bvalue_BU = Bvalue_BU + eflmac(idnint(BU_TAB[I_Breakup][1]), idnint(BU_TAB[I_Breakup][0]),1,0);
766 Eexc_BU_SUM = Eexc_BU_SUM + BU_TAB[I_Breakup][2];
767
768 AMOMENT(AAINCL,BU_TAB[I_Breakup][1],1,&PX_BU,&PY_BU,&PZ_BU);
769 P_BU = std::sqrt(PX_BU*PX_BU + PY_BU*PY_BU + PZ_BU*PZ_BU);
770// *******************************************************
771// PPRFP is in MeV/c
772 ETOT_BU = std::sqrt(P_BU*P_BU + (BU_TAB[I_Breakup][1]*amu)*(BU_TAB[I_Breakup][1]*amu));
773 BU_TAB[I_Breakup][4] = C * PX_BU / ETOT_BU; // Velocity in x
774 BU_TAB[I_Breakup][5] = C * PY_BU / ETOT_BU; // Velocity in y
775 BU_TAB[I_Breakup][6] = C * PZ_BU / ETOT_BU; // Velocity in z
776// Contribution from Coulomb repulsion:
777 tke_bu(BU_TAB[I_Breakup][0],BU_TAB[I_Breakup][1],ZAINCL,AAINCL,&VX2_BU,&VY2_BU,&VZ2_BU);
778// Lorentz kinematics
779// BU_TAB(I_Breakup,5) = BU_TAB(I_Breakup,5) + VX2_BU ! velocity change by Coulomb repulsion
780// BU_TAB(I_Breakup,6) = BU_TAB(I_Breakup,6) + VY2_BU
781// BU_TAB(I_Breakup,7) = BU_TAB(I_Breakup,7) + VZ2_BU
782// Lorentz transformation
783 lorentz_boost(VX2_BU,VY2_BU,VZ2_BU,
784 BU_TAB[I_Breakup][4],BU_TAB[I_Breakup][5],BU_TAB[I_Breakup][6],
785 &VXOUT,&VYOUT,&VZOUT);
786
787 BU_TAB[I_Breakup][4] = VXOUT;
788 BU_TAB[I_Breakup][5] = VYOUT;
789 BU_TAB[I_Breakup][6] = VZOUT;
790
791// Total momentum: Goldhaber + Coulomb
792 VBU2 = BU_TAB[I_Breakup][4]*BU_TAB[I_Breakup][4] +
793 BU_TAB[I_Breakup][5]*BU_TAB[I_Breakup][5] +
794 BU_TAB[I_Breakup][6]*BU_TAB[I_Breakup][6];
795 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
796 ETOT_BU = BU_TAB[I_Breakup][1]*amu/GAMMA_REL;
797 PX_BU = ETOT_BU * BU_TAB[I_Breakup][4] / C;
798 PY_BU = ETOT_BU * BU_TAB[I_Breakup][5] / C;
799 PZ_BU = ETOT_BU * BU_TAB[I_Breakup][6] / C;
800
801 PX_BU_SUM = PX_BU_SUM + PX_BU;
802 PY_BU_SUM = PY_BU_SUM + PY_BU;
803 PZ_BU_SUM = PZ_BU_SUM + PZ_BU;
804
805 }//for I_Breakup
806
807// In the frame of source (i.e. prefragment after abrasion or INCL)
808 P_BU_SUM = std::sqrt(PX_BU_SUM*PX_BU_SUM + PY_BU_SUM*PY_BU_SUM +
809 PZ_BU_SUM*PZ_BU_SUM);
810// ********************************************************
811// PPRFP is in MeV/c
812 ETOT_SUM = std::sqrt(P_BU_SUM*P_BU_SUM +
813 (AAINCL * amu)*(AAINCL * amu));
814
815 VX_BU_SUM = C * PX_BU_SUM / ETOT_SUM;
816 VY_BU_SUM = C * PY_BU_SUM / ETOT_SUM;
817 VZ_BU_SUM = C * PZ_BU_SUM / ETOT_SUM;
818
819// Lorentz kinematics - DM 17/5/2010
820// VX_PREF = VX_PREF - VX_BU_SUM
821// VY_PREF = VY_PREF - VY_BU_SUM
822// VZ_PREF = VZ_PREF - VZ_BU_SUM
823// Lorentz transformation
824 lorentz_boost(-VX_BU_SUM,-VY_BU_SUM,-VZ_BU_SUM,
825 VX_PREF,VY_PREF,VZ_PREF,
826 &VXOUT,&VYOUT,&VZOUT);
827
828 VX_PREF = VXOUT;
829 VY_PREF = VYOUT;
830 VZ_PREF = VZOUT;
831
832 VBU2 = VX_PREF*VX_PREF + VY_PREF*VY_PREF + VZ_PREF*VZ_PREF;
833 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
834 ETOT_PRF = aprf * amu / GAMMA_REL;
835 PXPRFP = ETOT_PRF * VX_PREF / C;
836 PYPRFP = ETOT_PRF * VY_PREF / C;
837 PZPRFP = ETOT_PRF * VZ_PREF / C;
838
839 PX_BU_SUM = 0.0;
840 PY_BU_SUM = 0.0;
841 PZ_BU_SUM = 0.0;
842
843 PX_BU_SUM = PXPRFP;
844 PY_BU_SUM = PYPRFP;
845 PZ_BU_SUM = PZPRFP;
846 E_tot_BU = ETOT_PRF;
847
848 EKIN_BU = aprf * amu / GAMMA_REL - aprf * amu;
849
850 for(I_Breakup=0;I_Breakup<IMULTBU;I_Breakup++){
851// Lorentz kinematics - DM 17/5/2010
852// BU_TAB(I_Breakup,5) = BU_TAB(I_Breakup,5) - VX_BU_SUM
853// BU_TAB(I_Breakup,6) = BU_TAB(I_Breakup,6) - VY_BU_SUM
854// BU_TAB(I_Breakup,7) = BU_TAB(I_Breakup,7) - VZ_BU_SUM
855// Lorentz transformation
856 lorentz_boost(-VX_BU_SUM,-VY_BU_SUM,-VZ_BU_SUM,
857 BU_TAB[I_Breakup][4],BU_TAB[I_Breakup][5],BU_TAB[I_Breakup][6],
858 &VXOUT,&VYOUT,&VZOUT);
859
860 BU_TAB[I_Breakup][4] = VXOUT;
861 BU_TAB[I_Breakup][5] = VYOUT;
862 BU_TAB[I_Breakup][6] = VZOUT;
863
864 VBU2 = BU_TAB[I_Breakup][4]*BU_TAB[I_Breakup][4] +
865 BU_TAB[I_Breakup][5]*BU_TAB[I_Breakup][5] +
866 BU_TAB[I_Breakup][6]*BU_TAB[I_Breakup][6];
867 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
868
869 ETOT_BU = BU_TAB[I_Breakup][1]*amu/GAMMA_REL;
870
871 EKIN_BU = EKIN_BU + BU_TAB[I_Breakup][1] * amu /
872 GAMMA_REL - BU_TAB[I_Breakup][1] * amu;
873
874 PX_BU = ETOT_BU * BU_TAB[I_Breakup][4] / C;
875 PY_BU = ETOT_BU * BU_TAB[I_Breakup][5] / C;
876 PZ_BU = ETOT_BU * BU_TAB[I_Breakup][6] / C;
877 E_tot_BU = E_tot_BU + ETOT_BU;
878
879 PX_BU_SUM = PX_BU_SUM + PX_BU;
880 PY_BU_SUM = PY_BU_SUM + PY_BU;
881 PZ_BU_SUM = PZ_BU_SUM + PZ_BU;
882 }// for I_Breakup
883
884 if(std::abs(PX_BU_SUM)>10. || std::abs(PY_BU_SUM)>10. ||
885 std::abs(PZ_BU_SUM)>10.){
886
887// In the frame of source (i.e. prefragment after INCL)
888 P_BU_SUM = std::sqrt(PX_BU_SUM*PX_BU_SUM + PY_BU_SUM*PY_BU_SUM +
889 PZ_BU_SUM*PZ_BU_SUM);
890// ********************************************************
891// PPRFP is in MeV/c
892 ETOT_SUM = std::sqrt(P_BU_SUM*P_BU_SUM +
893 (AAINCL * amu)*(AAINCL * amu));
894
895 VX_BU_SUM = C * PX_BU_SUM / ETOT_SUM;
896 VY_BU_SUM = C * PY_BU_SUM / ETOT_SUM;
897 VZ_BU_SUM = C * PZ_BU_SUM / ETOT_SUM;
898
899// Lorentz kinematics
900// VX_PREF = VX_PREF - VX_BU_SUM
901// VY_PREF = VY_PREF - VY_BU_SUM
902// VZ_PREF = VZ_PREF - VZ_BU_SUM
903// Lorentz transformation
904 lorentz_boost(-VX_BU_SUM,-VY_BU_SUM,-VZ_BU_SUM,
905 VX_PREF,VY_PREF,VZ_PREF,
906 &VXOUT,&VYOUT,&VZOUT);
907
908 VX_PREF = VXOUT;
909 VY_PREF = VYOUT;
910 VZ_PREF = VZOUT;
911
912 VBU2 = VX_PREF*VX_PREF + VY_PREF*VY_PREF + VZ_PREF*VZ_PREF;
913 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
914 ETOT_PRF = aprf * amu / GAMMA_REL;
915 PXPRFP = ETOT_PRF * VX_PREF / C;
916 PYPRFP = ETOT_PRF * VY_PREF / C;
917 PZPRFP = ETOT_PRF * VZ_PREF / C;
918
919 PX_BU_SUM = 0.0;
920 PY_BU_SUM = 0.0;
921 PZ_BU_SUM = 0.0;
922
923 PX_BU_SUM = PXPRFP;
924 PY_BU_SUM = PYPRFP;
925 PZ_BU_SUM = PZPRFP;
926 E_tot_BU = ETOT_PRF;
927
928 EKIN_BU = aprf * amu / GAMMA_REL - aprf * amu;
929
930 for(I_Breakup=0;I_Breakup<IMULTBU;I_Breakup++){
931// Lorentz kinematics - DM 17/5/2010
932// BU_TAB(I_Breakup,5) = BU_TAB(I_Breakup,5) - VX_BU_SUM
933// BU_TAB(I_Breakup,6) = BU_TAB(I_Breakup,6) - VY_BU_SUM
934// BU_TAB(I_Breakup,7) = BU_TAB(I_Breakup,7) - VZ_BU_SUM
935// Lorentz transformation
936 lorentz_boost(-VX_BU_SUM,-VY_BU_SUM,-VZ_BU_SUM,
937 BU_TAB[I_Breakup][4],BU_TAB[I_Breakup][5],BU_TAB[I_Breakup][6],
938 &VXOUT,&VYOUT,&VZOUT);
939
940 BU_TAB[I_Breakup][4] = VXOUT;
941 BU_TAB[I_Breakup][5] = VYOUT;
942 BU_TAB[I_Breakup][6] = VZOUT;
943
944 VBU2 = BU_TAB[I_Breakup][4]*BU_TAB[I_Breakup][4] +
945 BU_TAB[I_Breakup][5]*BU_TAB[I_Breakup][5] +
946 BU_TAB[I_Breakup][6]*BU_TAB[I_Breakup][6];
947 GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
948
949 ETOT_BU = BU_TAB[I_Breakup][1]*amu/GAMMA_REL;
950
951 EKIN_BU = EKIN_BU + BU_TAB[I_Breakup][1] * amu /
952 GAMMA_REL - BU_TAB[I_Breakup][1] * amu;
953
954 PX_BU = ETOT_BU * BU_TAB[I_Breakup][4] / C;
955 PY_BU = ETOT_BU * BU_TAB[I_Breakup][5] / C;
956 PZ_BU = ETOT_BU * BU_TAB[I_Breakup][6] / C;
957 E_tot_BU = E_tot_BU + ETOT_BU;
958
959 PX_BU_SUM = PX_BU_SUM + PX_BU;
960 PY_BU_SUM = PY_BU_SUM + PY_BU;
961 PZ_BU_SUM = PZ_BU_SUM + PZ_BU;
962 }// for I_Breakup
963 }// if DABS(PX_BU_SUM).GT.10.d0
964//
965// Find the limits that fragment is bound - only done for neutrons and LCPs and for
966// nuclei with A=Z, for other nuclei it will be done after decay:
967
968 INEWLOOP = 0;
969 for(G4int i=0;i<IMULTBU;i++){
970 if(BU_TAB[i][0]<3.0 || BU_TAB[i][0]==BU_TAB[i][1]){
971 unstable_nuclei(idnint(BU_TAB[i][1]),idnint(BU_TAB[i][0]), &afpnew,&zfpnew,IOUNSTABLE,
972 BU_TAB[i][4], BU_TAB[i][5], BU_TAB[i][6],
973 &VP1X,&VP1Y,&VP1Z,BU_TAB_TEMP,&ILOOP);
974
975 if(IOUNSTABLE>0){
976// Properties of "heavy fragment":
977 BU_TAB[i][1] = G4double(afpnew);
978 BU_TAB[i][0] = G4double(zfpnew);
979 BU_TAB[i][4] = VP1X;
980 BU_TAB[i][5] = VP1Y;
981 BU_TAB[i][6] = VP1Z;
982
983//Properties of "light" fragments:
984 for(int IJ=0;IJ<ILOOP;IJ++){
985 BU_TAB[IMULTBU+INEWLOOP+IJ][0] = BU_TAB_TEMP[IJ][0];
986 BU_TAB[IMULTBU+INEWLOOP+IJ][1] = BU_TAB_TEMP[IJ][1];
987 BU_TAB[IMULTBU+INEWLOOP+IJ][4] = BU_TAB_TEMP[IJ][2];
988 BU_TAB[IMULTBU+INEWLOOP+IJ][5] = BU_TAB_TEMP[IJ][3];
989 BU_TAB[IMULTBU+INEWLOOP+IJ][6] = BU_TAB_TEMP[IJ][4];
990 BU_TAB[IMULTBU+INEWLOOP+IJ][2] = 0.0;
991 BU_TAB[IMULTBU+INEWLOOP+IJ][3] = 0.0;
992 }// for ILOOP
993
994 INEWLOOP = INEWLOOP + ILOOP;
995
996 }// if IOUNSTABLE.GT.0
997 }//if BU_TAB[I_Breakup][0]<3.0
998 }// for IMULTBU
999
1000// Increased array of BU_TAB
1001 IMULTBU = IMULTBU + INEWLOOP;
1002// Evaporation from multifragmentation products
1003 opt->optimfallowed = 1; // IMF is allowed
1004 fiss->ifis = 0; // fission is not allowed
1005 gammaemission=0;
1006 ILOOPBU = 0;
1007
1008// Arrays for lambda emission from breakup fragments
1009 G4double * problamb;
1010 problamb = new G4double[IMULTBU];
1011 G4double sumN = aprf - zprf;
1012 for(G4int i=0;i<IMULTBU;i++)sumN=sumN+BU_TAB[i][1]-BU_TAB[i][0];
1013
1014 for(G4int i=0;i<IMULTBU;i++){
1015 problamb[i] = (BU_TAB[i][1]-BU_TAB[i][0])/sumN;
1016 }
1017 G4int * Nblamb;
1018 Nblamb = new G4int[IMULTBU];
1019 for(G4int i=0;i<IMULTBU;i++)Nblamb[i] = 0;
1020 for(G4int j=0;j<NbLam0;){
1021 G4double probtotal = (aprf - zprf)/sumN;
1023// Lambdas in the heavy breakup fragment
1024 if(ran <= probtotal){
1025 NbLamprf++;
1026 goto directlamb0;
1027 }
1028 for(G4int i=0;i<IMULTBU;i++){
1029// Lambdas in the light breakup residues
1030 if(probtotal < ran && ran <= probtotal+problamb[i]){
1031 Nblamb[i] = Nblamb[i] + 1;
1032 goto directlamb0;
1033 }
1034 probtotal = probtotal + problamb[i];
1035 }
1036 directlamb0:
1037 j++;
1038 }
1039//
1040 for(G4int i=0;i<IMULTBU;i++){
1041 EEBU = BU_TAB[i][2];
1042 BU_TAB[i][10] = BU_TAB[i][6];
1043 G4double jprfbu = BU_TAB[i][9];
1044 if(BU_TAB[i][0]>2.0){
1045 G4int nbl = Nblamb[i];
1046 evapora(BU_TAB[i][0],BU_TAB[i][1],&EEBU,0.0, &ZFBU, &AFBU, &mtota, &vz_evabu, &vx_evabu,&vy_evabu, &ff, &fimf, &ZIMFBU, &AIMFBU,&TKEIMFBU, &jprfbu, &inttype, &inum,EV_TEMP,&IEV_TAB_TEMP,&nbl);
1047
1048 Nblamb[i] = nbl;
1049 BU_TAB[i][9] = jprfbu;
1050
1051//Velocities of evaporated particles (in the frame of the primary prefragment)
1052 for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1053 EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1054 EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1055 EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1056//Lorentz kinematics
1057// DO IK = 3, 5, 1
1058// EV_TAB(IJ+IEV_TAB,IK) = EV_TEMP(IJ,IK) + BU_TAB(I,IK+2)
1059// ENDDO
1060// Lorentz transformation
1061 lorentz_boost(BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1062 EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1063 &VXOUT,&VYOUT,&VZOUT);
1064 EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1065 EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1066 EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1067 }
1068 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1069
1070//All velocities in the frame of the "primary" prefragment (after INC)
1071// Lorentz kinematics
1072// BU_TAB(I,5) = BU_TAB(I,5) + VX_EVABU
1073// BU_TAB(I,6) = BU_TAB(I,6) + VY_EVABU
1074// BU_TAB(I,7) = BU_TAB(I,7) + VZ_EVABU
1075// Lorentz transformation
1076 lorentz_boost(vx_evabu,vy_evabu,vz_evabu,
1077 BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1078 &VXOUT,&VYOUT,&VZOUT);
1079 BU_TAB[i][4] = VXOUT;
1080 BU_TAB[i][5] = VYOUT;
1081 BU_TAB[i][6] = VZOUT;
1082
1083 if(fimf==0){
1084 BU_TAB[i][7] = dint(ZFBU);
1085 BU_TAB[i][8] = dint(AFBU);
1086 BU_TAB[i][11]= nbl;
1087 }// if fimf==0
1088
1089 if(fimf==1){
1090// PRINT*,'IMF EMISSION FROM BU PRODUCTS'
1091// IMF emission: Heavy partner is not allowed to fission or to emitt IMF.
1092 //double FEE = EEBU;
1093 G4int FFBU1 = 0;
1094 G4int FIMFBU1 = 0;
1095 opt->optimfallowed = 0; // IMF is not allowed
1096 fiss->ifis = 0; // fission is not allowed
1097// Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
1098 G4double EkinR1 = TKEIMFBU * AIMFBU / (AFBU+AIMFBU);
1099 G4double EkinR2 = TKEIMFBU * AFBU / (AFBU+AIMFBU);
1100 G4double V1 = std::sqrt(EkinR1/AFBU) * 1.3887;
1101 G4double V2 = std::sqrt(EkinR2/AIMFBU) * 1.3887;
1102 G4double VZ1_IMF = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
1103 G4double VPERP1 = std::sqrt(V1*V1 - VZ1_IMF*VZ1_IMF);
1104 G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
1105 G4double VX1_IMF = VPERP1 * std::sin(ALPHA1);
1106 G4double VY1_IMF = VPERP1 * std::cos(ALPHA1);
1107 G4double VX2_IMF = - VX1_IMF / V1 * V2;
1108 G4double VY2_IMF = - VY1_IMF / V1 * V2;
1109 G4double VZ2_IMF = - VZ1_IMF / V1 * V2;
1110
1111 G4double EEIMFP = EEBU * AFBU /(AFBU + AIMFBU);
1112 G4double EEIMF = EEBU * AIMFBU /(AFBU + AIMFBU);
1113
1114// Decay of heavy partner
1115 G4double IINERTTOT = 0.40 * 931.490 * 1.160*1.160 *( std::pow(AIMFBU,5.0/3.0) + std::pow(AFBU,5.0/3.0)) + 931.490 * 1.160*1.160*AIMFBU*AFBU/(AIMFBU+AFBU)*(std::pow(AIMFBU,1./3.) + std::pow(AFBU,1./3.))*(std::pow(AIMFBU,1./3.) + std::pow(AFBU,1./3.));
1116
1117 G4double JPRFHEAVY = BU_TAB[i][9] * 0.4 * 931.49 * 1.16*1.16 * std::pow(AFBU,5.0/3.0) / IINERTTOT;
1118 G4double JPRFLIGHT = BU_TAB[i][9] * 0.4 * 931.49 * 1.16*1.16 * std::pow(AIMFBU,5.0/3.0) / IINERTTOT;
1119
1120// Lorentz kinematics
1121// BU_TAB(I,5) = BU_TAB(I,5) + VX1_IMF
1122// BU_TAB(I,6) = BU_TAB(I,6) + VY1_IMF
1123// BU_TAB(I,7) = BU_TAB(I,7) + VZ1_IMF
1124// Lorentz transformation
1125 lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1126 BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1127 &VXOUT,&VYOUT,&VZOUT);
1128 BU_TAB[i][4] = VXOUT;
1129 BU_TAB[i][5] = VYOUT;
1130 BU_TAB[i][6] = VZOUT;
1131
1132 G4double vx1ev_imf=0., vy1ev_imf=0., vz1ev_imf=0., zdummy=0., adummy=0., tkedummy=0.,jprf1=0.;
1133
1134 // Lambda particles
1135 G4int NbLamH=0;
1136 G4int NbLamimf=0;
1137 G4double pbH = (AFBU-ZFBU) / (AFBU-ZFBU+AIMFBU-ZIMFBU);
1138 for(G4int j=0;j<nbl;j++){
1139 if(G4AblaRandom::flat()<pbH){
1140 NbLamH++;
1141 }else{
1142 NbLamimf++;
1143 }
1144 }
1145// Decay of IMF's partner:
1146 evapora(ZFBU,AFBU,&EEIMFP,JPRFHEAVY, &ZFFBU, &AFFBU, &mtota, &vz1ev_imf, &vx1ev_imf,&vy1ev_imf, &FFBU1, &FIMFBU1, &zdummy, &adummy,&tkedummy, &jprf1, &inttype, &inum,EV_TEMP,&IEV_TAB_TEMP,&NbLamH);
1147
1148 for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1149 EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1150 EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1151 EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1152//Lorentz kinematics
1153// DO IK = 3, 5, 1
1154// EV_TAB(IJ+IEV_TAB,IK) = EV_TEMP(IJ,IK) + BU_TAB(I,IK+2)
1155// ENDDO
1156// Lorentz transformation
1157 lorentz_boost(BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1158 EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1159 &VXOUT,&VYOUT,&VZOUT);
1160 EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1161 EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1162 EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1163 }
1164 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1165
1166 BU_TAB[i][7] = dint(ZFFBU);
1167 BU_TAB[i][8] = dint(AFFBU);
1168 BU_TAB[i][11]= NbLamH;
1169//Lorentz kinematics
1170// BU_TAB(I,5) = BU_TAB(I,5) + vx1ev_imf
1171// BU_TAB(I,6) = BU_TAB(I,6) + vy1ev_imf
1172// BU_TAB(I,7) = BU_TAB(I,7) + vz1ev_imf
1173 lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1174 BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1175 &VXOUT,&VYOUT,&VZOUT);
1176 BU_TAB[i][4] = VXOUT;
1177 BU_TAB[i][5] = VYOUT;
1178 BU_TAB[i][6] = VZOUT;
1179// For IMF - fission and IMF emission are not allowed
1180 G4int FFBU2 = 0;
1181 G4int FIMFBU2 = 0;
1182 opt->optimfallowed = 0; // IMF is not allowed
1183 fiss->ifis = 0; // fission is not allowed
1184// Decay of IMF
1185 G4double zffimf, affimf,zdummy1, adummy1, tkedummy1, jprf2, vx2ev_imf, vy2ev_imf, vz2ev_imf;
1186
1187 evapora(ZIMFBU,AIMFBU,&EEIMF,JPRFLIGHT, &zffimf, &affimf, &mtota, &vz2ev_imf, &vx2ev_imf,&vy2ev_imf, &FFBU2, &FIMFBU2, &zdummy1, &adummy1,&tkedummy1, &jprf2, &inttype, &inum,EV_TEMP,&IEV_TAB_TEMP,&NbLamimf);
1188
1189 for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1190 EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1191 EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1192 EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1193//Lorentz kinematics
1194// EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + BU_TAB(I,5) +VX2_IMF
1195// EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + BU_TAB(I,6) +VY2_IMF
1196// EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + BU_TAB(I,7) +VZ2_IMF
1197// Lorentz transformation
1198 lorentz_boost(BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1199 EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1200 &VXOUT,&VYOUT,&VZOUT);
1201 lorentz_boost(VX2_IMF,VY2_IMF,VZ2_IMF,
1202 VXOUT,VYOUT,VZOUT,
1203 &VX2OUT,&VY2OUT,&VZ2OUT);
1204 EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1205 EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1206 EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1207 }
1208 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1209
1210 BU_TAB[IMULTBU+ILOOPBU][0] = BU_TAB[i][0];
1211 BU_TAB[IMULTBU+ILOOPBU][1] = BU_TAB[i][1];
1212 BU_TAB[IMULTBU+ILOOPBU][2] = BU_TAB[i][2];
1213 BU_TAB[IMULTBU+ILOOPBU][3] = BU_TAB[i][3];
1214 BU_TAB[IMULTBU+ILOOPBU][7] = dint(zffimf);
1215 BU_TAB[IMULTBU+ILOOPBU][8] = dint(affimf);
1216 BU_TAB[IMULTBU+ILOOPBU][11]= NbLamimf;
1217// Lorentz transformation
1218 lorentz_boost(VX2_IMF,VY2_IMF,VZ2_IMF,
1219 BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1220 &VXOUT,&VYOUT,&VZOUT);
1221 lorentz_boost(vx2ev_imf,vy2ev_imf,vz2ev_imf,
1222 VXOUT,VYOUT,VZOUT,
1223 &VX2OUT,&VY2OUT,&VZ2OUT);
1224 BU_TAB[IMULTBU+ILOOPBU][4] = VX2OUT;
1225 BU_TAB[IMULTBU+ILOOPBU][5] = VY2OUT;
1226 BU_TAB[IMULTBU+ILOOPBU][6] = VZ2OUT;
1227 ILOOPBU = ILOOPBU + 1;
1228 }// if fimf==1
1229
1230 } else {// if BU_TAB(I,1).GT.2.D0
1231 //BU_TAB[i][0] = BU_TAB[i][0];
1232 //BU_TAB[i][1] = BU_TAB[i][1];
1233 //BU_TAB[i][2] = BU_TAB[i][2];
1234 //BU_TAB[i][3] = BU_TAB[i][3];
1235 BU_TAB[i][7] = BU_TAB[i][0];
1236 BU_TAB[i][8] = BU_TAB[i][1];
1237 //BU_TAB[i][4] = BU_TAB[i][4];
1238 //BU_TAB[i][5] = BU_TAB[i][5];
1239 //BU_TAB[i][6] = BU_TAB[i][6];
1240 BU_TAB[i][11]= Nblamb[i];
1241 }// if BU_TAB(I,1).GT.2.D0
1242 }// for IMULTBU
1243
1244 IMULTBU = IMULTBU + ILOOPBU;
1245//
1246// RESOLVE UNSTABLE NUCLEI
1247//
1248 INEWLOOP = 0;
1249 ABU_SUM = 0.0;
1250 ZBU_SUM = 0.0;
1251//
1252 for(G4int i=0;i<IMULTBU;i++){
1253 ABU_SUM = ABU_SUM + BU_TAB[i][8];
1254 ZBU_SUM = ZBU_SUM + BU_TAB[i][7];
1255 unstable_nuclei(idnint(BU_TAB[i][8]),idnint(BU_TAB[i][7]), &afpnew,&zfpnew,IOUNSTABLE,
1256 BU_TAB[i][4], BU_TAB[i][5], BU_TAB[i][6],
1257 &VP1X,&VP1Y,&VP1Z,BU_TAB_TEMP1,&ILOOP);
1258
1259//From now on, all neutrons and LCP created in above subroutine are part of the
1260// BU_TAB array (see below - Properties of "light" fragments). Therefore,
1261// NEVA, PEVA ... are not needed any more in the break-up stage.
1262
1263 if(IOUNSTABLE>0){
1264// Properties of "heavy fragment":
1265 ABU_SUM = ABU_SUM + G4double(afpnew) - BU_TAB[i][8];
1266 ZBU_SUM = ZBU_SUM + G4double(zfpnew) - BU_TAB[i][7];
1267 BU_TAB[i][8] = G4double(afpnew);
1268 BU_TAB[i][7] = G4double(zfpnew);
1269 BU_TAB[i][4] = VP1X;
1270 BU_TAB[i][5] = VP1Y;
1271 BU_TAB[i][6] = VP1Z;
1272
1273//Properties of "light" fragments:
1274 for(G4int IJ=0;IJ<ILOOP;IJ++){
1275 BU_TAB[IMULTBU+INEWLOOP+IJ][7] = BU_TAB_TEMP1[IJ][0];
1276 BU_TAB[IMULTBU+INEWLOOP+IJ][8] = BU_TAB_TEMP1[IJ][1];
1277 BU_TAB[IMULTBU+INEWLOOP+IJ][4] = BU_TAB_TEMP1[IJ][2];
1278 BU_TAB[IMULTBU+INEWLOOP+IJ][5] = BU_TAB_TEMP1[IJ][3];
1279 BU_TAB[IMULTBU+INEWLOOP+IJ][6] = BU_TAB_TEMP1[IJ][4];
1280 BU_TAB[IMULTBU+INEWLOOP+IJ][2] = 0.0;
1281 BU_TAB[IMULTBU+INEWLOOP+IJ][3] = 0.0;
1282 BU_TAB[IMULTBU+INEWLOOP+IJ][0] = BU_TAB[i][0];
1283 BU_TAB[IMULTBU+INEWLOOP+IJ][1] = BU_TAB[i][1];
1284 BU_TAB[IMULTBU+INEWLOOP+IJ][11] = BU_TAB[i][11];
1285 ABU_SUM = ABU_SUM + BU_TAB[IMULTBU+INEWLOOP+IJ][8];
1286 ZBU_SUM = ZBU_SUM + BU_TAB[IMULTBU+INEWLOOP+IJ][7];
1287 }// for ILOOP
1288
1289 INEWLOOP = INEWLOOP + ILOOP;
1290 }// if(IOUNSTABLE>0)
1291 }// for IMULTBU unstable
1292
1293// Increased array of BU_TAB
1294 IMULTBU = IMULTBU + INEWLOOP;
1295
1296// Transform all velocities into the rest frame of the projectile
1297 lorentz_boost(VX_incl,VY_incl,VZ_incl,
1298 VX_PREF,VY_PREF,VZ_PREF,
1299 &VXOUT,&VYOUT,&VZOUT);
1300 VX_PREF = VXOUT;
1301 VY_PREF = VYOUT;
1302 VZ_PREF = VZOUT;
1303
1304 for(G4int i=0;i<IMULTBU;i++){
1305 lorentz_boost(VX_incl,VY_incl,VZ_incl,
1306 BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1307 &VXOUT,&VYOUT,&VZOUT);
1308 BU_TAB[i][4] = VXOUT;
1309 BU_TAB[i][5] = VYOUT;
1310 BU_TAB[i][6] = VZOUT;
1311 }
1312 for(G4int i=0;i<IEV_TAB;i++){
1313 lorentz_boost(VX_incl,VY_incl,VZ_incl,
1314 EV_TAB[i][2],EV_TAB[i][3],EV_TAB[i][4],
1315 &VXOUT,&VYOUT,&VZOUT);
1316 EV_TAB[i][2] = VXOUT;
1317 EV_TAB[i][3] = VYOUT;
1318 EV_TAB[i][4] = VZOUT;
1319 }
1320 if(IMULTBU>200)std::cout << "IMULTBU>200 " << IMULTBU << std::endl;
1321 delete[] problamb;
1322 delete[] Nblamb;
1323 }// if(T_diff>0.1)
1324 // End of multi-fragmentation
1325 mult7777:
1326
1327// Start basic de-excitation of fragments
1328 aprfp = idnint(aprf);
1329 zprfp = idnint(zprf);
1330
1331 if(IMULTIFR == 0){
1332// These momenta are in the frame of the projectile (or target in case of direct kinematics)
1333 VX_PREF = VX_incl;
1334 VY_PREF = VY_incl;
1335 VZ_PREF = VZ_incl;
1336 }
1337// Lambdas after multi-fragmentation
1338 if(IMULTIFR == 1){
1339 NbLam0 = NbLamprf;
1340 }
1341//
1342// CALL THE EVAPORATION SUBROUTINE
1343//
1344 opt->optimfallowed = 1; // IMF is allowed
1345 fiss->ifis = 1; // fission is allowed
1346 fimf=0;
1347 ff=0;
1348
1349// To spare computing time; these events in any case cannot decay
1350// IF(ZPRFP.LE.2.AND.ZPRFP.LT.APRFP)THEN FIXME: <= or <
1351 if(zprfp<=2 && zprfp<aprfp){
1352 zf = zprf;
1353 af = aprf;
1354 ee = 0.0;
1355 ff = 0;
1356 fimf = 0;
1357 ftype = 0;
1358 aimf = 0.0;
1359 zimf = 0.0;
1360 tkeimf = 0.0;
1361 vx_eva = 0.0;
1362 vy_eva = 0.0;
1363 vz_eva = 0.0;
1364 jprf0 = jprf;
1365 goto a1972;
1366 }
1367
1368// if(ZPRFP.LE.2.AND.ZPRFP.EQ.APRFP)
1369 if(zprfp<=2 && zprfp==aprfp){
1370 unstable_nuclei(aprfp,zprfp,&afpnew,&zfpnew,IOUNSTABLE,
1371 VX_PREF, VY_PREF, VZ_PREF,
1372 &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1373 af = G4double(afpnew);
1374 zf = G4double(zfpnew);
1375 VX_PREF = VP1X;
1376 VY_PREF = VP1Y;
1377 VZ_PREF = VP1Z;
1378 for(G4int I = 0;I<ILOOP;I++){
1379 for(G4int IJ = 0; IJ<6; IJ++)
1380 EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1381 }
1382 IEV_TAB = IEV_TAB + ILOOP;
1383 ee = 0.0;
1384 ff = 0;
1385 fimf = 0;
1386 ftype = 0;
1387 aimf = 0.0;
1388 zimf = 0.0;
1389 tkeimf = 0.0;
1390 vx_eva = 0.0;
1391 vy_eva = 0.0;
1392 vz_eva = 0.0;
1393 jprf0 = jprf;
1394 goto a1972;
1395 }
1396
1397// IF(ZPRFP.EQ.APRFP)THEN
1398 if(zprfp==aprfp){
1399 unstable_nuclei(aprfp,zprfp,&afpnew,&zfpnew,IOUNSTABLE,
1400 VX_PREF, VY_PREF, VZ_PREF,
1401 &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1402 af = G4double(afpnew);
1403 zf = G4double(zfpnew);
1404 VX_PREF = VP1X;
1405 VY_PREF = VP1Y;
1406 VZ_PREF = VP1Z;
1407 for(G4int I = 0;I<ILOOP;I++){
1408 for(G4int IJ = 0; IJ<6; IJ++)
1409 EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1410 }
1411 IEV_TAB = IEV_TAB + ILOOP;
1412 ee = 0.0;
1413 ff = 0;
1414 fimf = 0;
1415 ftype = 0;
1416 aimf = 0.0;
1417 zimf = 0.0;
1418 tkeimf = 0.0;
1419 vx_eva = 0.0;
1420 vy_eva = 0.0;
1421 vz_eva = 0.0;
1422 jprf0 = jprf;
1423 goto a1972;
1424 }
1425//
1426 evapora(zprf,aprf,&ee,jprf, &zf, &af, &mtota, &vz_eva, &vx_eva, &vy_eva, &ff, &fimf, &zimf, &aimf,&tkeimf, &jprf0, &inttype, &inum,EV_TEMP,&IEV_TAB_TEMP,&NbLam0);
1427//
1428 for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1429 EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1430 EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1431 EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1432//
1433// EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1434// EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1435// EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1436// Lorentz transformation
1437 lorentz_boost(VX_PREF,VY_PREF,VZ_PREF,
1438 EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1439 &VXOUT,&VYOUT,&VZOUT);
1440 EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1441 EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1442 EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1443 }
1444 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1445
1446 a1972:
1447
1448// vi_pref - velocity of the prefragment; vi_eva - recoil due to evaporation
1449 lorentz_boost(VX_PREF,VY_PREF,VZ_PREF,
1450 vx_eva,vy_eva,vz_eva,
1451 &VXOUT,&VYOUT,&VZOUT);
1452 V_CM[0] = VXOUT;
1453 V_CM[1] = VYOUT;
1454 V_CM[2] = VZOUT;
1455//
1456 if(ff == 0 && fimf == 0){
1457// Evaporation of neutrons and LCP; no IMF, no fission
1458 ftype = 0;
1459 ZFP1 = idnint(zf);
1460 AFP1 = idnint(af);
1461 SFP1 = NbLam0;
1462 AFPIMF = 0;
1463 ZFPIMF = 0;
1464 SFPIMF = 0;
1465 ZFP2 = 0;
1466 AFP2 = 0;
1467 SFP2 = 0;
1468 VFP1_CM[0] = V_CM[0];
1469 VFP1_CM[1] = V_CM[1];
1470 VFP1_CM[2] = V_CM[2];
1471 for(G4int j=0;j<3;j++){
1472 VIMF_CM[j] = 0.0;
1473 VFP2_CM[j] = 0.0;
1474 }
1475 }
1476//
1477 if(ff == 1 && fimf == 0) ftype = 1; // fission
1478 if(ff == 0 && fimf == 1) ftype = 2; // IMF emission
1479//
1480// AFP,ZFP IS THE FINAL FRAGMENT IF NO FISSION OR IMF EMISSION OCCURS
1481// IN CASE OF FISSION IT IS THE NUCLEUS THAT UNDERGOES FISSION OR IMF
1482//
1483
1484//***************** FISSION ***************************************
1485//
1486 if(ftype == 1){
1487 varntp->kfis = 1;
1488 if(NbLam0>0)varntp->kfis = 20;
1489 // ftype1=0;
1490
1491 G4int IEV_TAB_FIS = 0,imode=0;
1492
1493 G4double vx1_fission=0.,vy1_fission=0.,vz1_fission=0.;
1494 G4double vx2_fission=0.,vy2_fission=0.,vz2_fission=0.;
1495 G4double vx_eva_sc=0.,vy_eva_sc=0.,vz_eva_sc=0.;
1496
1497 fission(af,zf,ee,jprf0,
1498 &vx1_fission,&vy1_fission,&vz1_fission,
1499 &vx2_fission,&vy2_fission,&vz2_fission,
1500 &ZFP1,&AFP1,&SFP1,&ZFP2,&AFP2,&SFP2,&imode,
1501 &vx_eva_sc,&vy_eva_sc,&vz_eva_sc,EV_TEMP,&IEV_TAB_FIS,&NbLam0);
1502
1503 for(G4int IJ = 0; IJ< IEV_TAB_FIS;IJ++){
1504 EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1505 EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1506 EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1507// Lorentz kinematics
1508// EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1509// EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1510// EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1511// Lorentz transformation
1512 lorentz_boost(V_CM[0],V_CM[1],V_CM[2],
1513 EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1514 &VXOUT,&VYOUT,&VZOUT);
1515 EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1516 EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1517 EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1518 }
1519 IEV_TAB = IEV_TAB + IEV_TAB_FIS;
1520
1521 // if(imode==1) ftype1 = 1; // S1 mode
1522 // if(imode==2) ftype1 = 2; // S2 mode
1523
1524 AFPIMF = 0;
1525 ZFPIMF = 0;
1526 SFPIMF = 0;
1527
1528// VX_EVA_SC,VY_EVA_SC,VZ_EVA_SC - recoil due to particle emisison
1529// between saddle and scission
1530// Lorentz kinematics
1531// VFP1_CM(1) = V_CM(1) + VX1_FISSION + VX_EVA_SC ! Velocity of FF1 in x
1532// VFP1_CM(2) = V_CM(2) + VY1_FISSION + VY_EVA_SC ! Velocity of FF1 in y
1533// VFP1_CM(3) = V_CM(3) + VZ1_FISSION + VZ_EVA_SC ! Velocity of FF1 in x
1534 lorentz_boost(vx1_fission,vy1_fission,vz1_fission,
1535 V_CM[0],V_CM[1],V_CM[2],
1536 &VXOUT,&VYOUT,&VZOUT);
1537 lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1538 VXOUT,VYOUT,VZOUT,
1539 &VX2OUT,&VY2OUT,&VZ2OUT);
1540 VFP1_CM[0] = VX2OUT;
1541 VFP1_CM[1] = VY2OUT;
1542 VFP1_CM[2] = VZ2OUT;
1543
1544// Lorentz kinematics
1545// VFP2_CM(1) = V_CM(1) + VX2_FISSION + VX_EVA_SC ! Velocity of FF2 in x
1546// VFP2_CM(2) = V_CM(2) + VY2_FISSION + VY_EVA_SC ! Velocity of FF2 in y
1547// VFP2_CM(3) = V_CM(3) + VZ2_FISSION + VZ_EVA_SC ! Velocity of FF2 in x
1548 lorentz_boost(vx2_fission,vy2_fission,vz2_fission,
1549 V_CM[0],V_CM[1],V_CM[2],
1550 &VXOUT,&VYOUT,&VZOUT);
1551 lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1552 VXOUT,VYOUT,VZOUT,
1553 &VX2OUT,&VY2OUT,&VZ2OUT);
1554 VFP2_CM[0] = VX2OUT;
1555 VFP2_CM[1] = VY2OUT;
1556 VFP2_CM[2] = VZ2OUT;
1557
1558//************** IMF EMISSION ************************************************
1559//
1560 }else if(ftype == 2){
1561// IMF emission: Heavy partner is allowed to fission and to emitt IMF, but ONLY once.
1562 G4int FF11 = 0;
1563 G4int FIMF11 = 0;
1564 opt->optimfallowed = 1; // IMF is allowed
1565 fiss->ifis = 1; // fission is allowed
1566// Lambda particles
1567 G4int NbLamH=0;
1568 G4int NbLamimf=0;
1569 G4double pbH = (af-zf) / (af-zf+aimf-zimf);
1570 //double pbL = aimf / (af+aimf);
1571 for(G4int i=0;i<NbLam0;i++){
1572 if(G4AblaRandom::flat()<pbH){
1573 NbLamH++;
1574 }else{
1575 NbLamimf++;
1576 }
1577 }
1578//
1579// Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
1580 G4double EkinR1 = tkeimf * aimf / (af+aimf);
1581 G4double EkinR2 = tkeimf * af / (af+aimf);
1582 G4double V1 = std::sqrt(EkinR1/af) * 1.3887;
1583 G4double V2 = std::sqrt(EkinR2/aimf) * 1.3887;
1584 G4double VZ1_IMF = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
1585 G4double VPERP1 = std::sqrt(V1*V1 - VZ1_IMF*VZ1_IMF);
1586 G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
1587 G4double VX1_IMF = VPERP1 * std::sin(ALPHA1);
1588 G4double VY1_IMF = VPERP1 * std::cos(ALPHA1);
1589 G4double VX2_IMF = - VX1_IMF / V1 * V2;
1590 G4double VY2_IMF = - VY1_IMF / V1 * V2;
1591 G4double VZ2_IMF = - VZ1_IMF / V1 * V2;
1592
1593 G4double EEIMFP = ee * af /(af + aimf);
1594 G4double EEIMF = ee * aimf /(af + aimf);
1595
1596// Decay of heavy partner
1597 G4double IINERTTOT = 0.40 * 931.490 * 1.160*1.160 *( std::pow(aimf,5.0/3.0) + std::pow(af,5.0/3.0)) + 931.490 * 1.160*1.160*aimf*af/(aimf+af)*(std::pow(aimf,1./3.) + std::pow(af,1./3.))*(std::pow(aimf,1./3.) + std::pow(af,1./3.));
1598
1599 G4double JPRFHEAVY = jprf0 * 0.4 * 931.49 * 1.16*1.16 * std::pow(af,5.0/3.0) / IINERTTOT;
1600 G4double JPRFLIGHT = jprf0 * 0.4 * 931.49 * 1.16*1.16 * std::pow(aimf,5.0/3.0) / IINERTTOT;
1601 if(af<2.0) std::cout << "RN117-4,AF,ZF,EE,JPRFheavy" << std::endl;
1602
1603 G4double vx1ev_imf=0., vy1ev_imf=0., vz1ev_imf=0., zdummy=0., adummy=0., tkedummy=0.,jprf1=0.;
1604
1605 evapora(zf,af,&EEIMFP,JPRFHEAVY, &zff, &aff, &mtota, &vz1ev_imf, &vx1ev_imf,&vy1ev_imf, &FF11, &FIMF11, &zdummy, &adummy,&tkedummy, &jprf1, &inttype, &inum,EV_TEMP,&IEV_TAB_TEMP,&NbLamH);
1606
1607 for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1608 EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1609 EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1610 EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1611//
1612// EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1613// EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1614// EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1615// Lorentz transformation
1616 lorentz_boost(V_CM[0],V_CM[1],V_CM[2],
1617 EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1618 &VXOUT,&VYOUT,&VZOUT);
1619 lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1620 VXOUT,VYOUT,VZOUT,
1621 &VX2OUT,&VY2OUT,&VZ2OUT);
1622 EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1623 EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1624 EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1625 }
1626 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1627
1628// For IMF - fission and IMF emission are not allowed
1629 G4int FF22 = 0;
1630 G4int FIMF22 = 0;
1631 opt->optimfallowed = 0; // IMF is not allowed
1632 fiss->ifis = 0; // fission is not allowed
1633
1634// Decay of IMF
1635 G4double zffimf, affimf,zdummy1=0., adummy1=0., tkedummy1=0.,jprf2,vx2ev_imf,vy2ev_imf,
1636 vz2ev_imf;
1637
1638 evapora(zimf,aimf,&EEIMF,JPRFLIGHT, &zffimf, &affimf, &mtota, &vz2ev_imf, &vx2ev_imf,&vy2ev_imf, &FF22, &FIMF22, &zdummy1, &adummy1,&tkedummy1, &jprf2, &inttype, &inum,EV_TEMP,&IEV_TAB_TEMP,&NbLamimf);
1639
1640 for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1641 EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1642 EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1643 EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1644//
1645// EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1646// EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1647// EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1648// Lorentz transformation
1649 lorentz_boost(V_CM[0],V_CM[1],V_CM[2],
1650 EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1651 &VXOUT,&VYOUT,&VZOUT);
1652 lorentz_boost(VX2_IMF,VY2_IMF,VZ2_IMF,
1653 VXOUT,VYOUT,VZOUT,
1654 &VX2OUT,&VY2OUT,&VZ2OUT);
1655 EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1656 EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1657 EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1658 }
1659 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1660// As IMF is not allowed to emit IMF, adummy1=zdummy1=0
1661
1662 AFPIMF = idnint(affimf);
1663 ZFPIMF = idnint(zffimf);
1664 SFPIMF = NbLamimf;
1665
1666// vi1_imf, vi2_imf - velocities of imf and partner from TKE;
1667// vi1ev_imf, vi2_imf - recoil of partner and imf due to evaporation
1668// Lorentz kinematics - DM 18/5/2010
1669// VIMF_CM(1) = V_CM(1) + VX2_IMF + VX2EV_IMF
1670// VIMF_CM(2) = V_CM(2) + VY2_IMF + VY2EV_IMF
1671// VIMF_CM(3) = V_CM(3) + VZ2_IMF + VZ2EV_IMF
1672 lorentz_boost(VX2_IMF,VY2_IMF,VZ2_IMF,
1673 V_CM[0],V_CM[1],V_CM[2],
1674 &VXOUT,&VYOUT,&VZOUT);
1675 lorentz_boost(vx2ev_imf,vy2ev_imf,vz2ev_imf,
1676 VXOUT,VYOUT,VZOUT,
1677 &VX2OUT,&VY2OUT,&VZ2OUT);
1678 VIMF_CM[0] = VX2OUT;
1679 VIMF_CM[1] = VY2OUT;
1680 VIMF_CM[2] = VZ2OUT;
1681// Lorentz kinematics
1682// VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
1683// VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
1684// VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
1685 lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1686 V_CM[0],V_CM[1],V_CM[2],
1687 &VXOUT,&VYOUT,&VZOUT);
1688 lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1689 VXOUT,VYOUT,VZOUT,
1690 &VX2OUT,&VY2OUT,&VZ2OUT);
1691 VFP1_CM[0] = VX2OUT;
1692 VFP1_CM[1] = VY2OUT;
1693 VFP1_CM[2] = VZ2OUT;
1694
1695 if(FF11==0 && FIMF11==0){
1696// heavy partner deexcites by emission of light particles
1697 AFP1 = idnint(aff);
1698 ZFP1 = idnint(zff);
1699 SFP1 = NbLamH;
1700 ZFP2 = 0;
1701 AFP2 = 0;
1702 SFP2 = 0;
1703 ftype = 2;
1704 AFPIMF = idnint(affimf);
1705 ZFPIMF = idnint(zffimf);
1706 SFPIMF = NbLamimf;
1707 for(G4int I=0;I<3;I++)
1708 VFP2_CM[I] = 0.0;
1709
1710
1711 } else if(FF11==1 && FIMF11==0){
1712// Heavy partner fissions
1713 varntp->kfis = 1;
1714 if(NbLam0>0)varntp->kfis = 20;
1715//
1716 opt->optimfallowed = 0; // IMF is not allowed
1717 fiss->ifis = 0; // fission is not allowed
1718//
1719 zf = zff;
1720 af = aff;
1721 ee = EEIMFP;
1722 // ftype1=0;
1723 ftype=21;
1724
1725 G4int IEV_TAB_FIS = 0,imode=0;
1726
1727 G4double vx1_fission=0.,vy1_fission=0.,vz1_fission=0.;
1728 G4double vx2_fission=0.,vy2_fission=0.,vz2_fission=0.;
1729 G4double vx_eva_sc=0.,vy_eva_sc=0.,vz_eva_sc=0.;
1730
1731 fission(af,zf,ee,jprf1,
1732 &vx1_fission,&vy1_fission,&vz1_fission,
1733 &vx2_fission,&vy2_fission,&vz2_fission,
1734 &ZFP1,&AFP1,&SFP1,&ZFP2,&AFP2,&SFP2,&imode,
1735 &vx_eva_sc,&vy_eva_sc,&vz_eva_sc,EV_TEMP,&IEV_TAB_FIS,&NbLamH);
1736
1737 for(int IJ = 0; IJ< IEV_TAB_FIS;IJ++){
1738 EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1739 EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1740 EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1741// Lorentz kinematics
1742// EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1743// EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1744// EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1745// Lorentz transformation
1746 lorentz_boost(VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1747 EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1748 &VXOUT,&VYOUT,&VZOUT);
1749 EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1750 EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1751 EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1752 }
1753 IEV_TAB = IEV_TAB + IEV_TAB_FIS;
1754
1755 // if(imode==1) ftype1 = 1; // S1 mode
1756 // if(imode==2) ftype1 = 2; // S2 mode
1757
1758// Lorentz kinematics
1759// VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF + VX1_FISSION +
1760// & VX_EVA_SC ! Velocity of FF1 in x
1761// VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF + VY1_FISSION +
1762// & VY_EVA_SC ! Velocity of FF1 in y
1763// VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF + VZ1_FISSION +
1764// & VZ_EVA_SC ! Velocity of FF1 in x
1765 lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1766 V_CM[0],V_CM[1],V_CM[2],
1767 &VXOUT,&VYOUT,&VZOUT);
1768 lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1769 VXOUT,VYOUT,VZOUT,
1770 &VX2OUT,&VY2OUT,&VZ2OUT);
1771 lorentz_boost(vx1_fission,vy1_fission,vz1_fission,
1772 VX2OUT,VY2OUT,VZ2OUT,
1773 &VXOUT,&VYOUT,&VZOUT);
1774 lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1775 VXOUT,VYOUT,VZOUT,
1776 &VX2OUT,&VY2OUT,&VZ2OUT);
1777 VFP1_CM[0] = VX2OUT;
1778 VFP1_CM[1] = VY2OUT;
1779 VFP1_CM[2] = VZ2OUT;
1780
1781// Lorentz kinematics
1782// VFP2_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF + VX2_FISSION +
1783// & VX_EVA_SC ! Velocity of FF2 in x
1784// VFP2_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF + VY2_FISSION +
1785// & VY_EVA_SC ! Velocity of FF2 in y
1786// VFP2_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF + VZ2_FISSION +
1787// & VZ_EVA_SC ! Velocity of FF2 in x
1788 lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1789 V_CM[0],V_CM[1],V_CM[2],
1790 &VXOUT,&VYOUT,&VZOUT);
1791 lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1792 VXOUT,VYOUT,VZOUT,
1793 &VX2OUT,&VY2OUT,&VZ2OUT);
1794 lorentz_boost(vx2_fission,vy2_fission,vz2_fission,
1795 VX2OUT,VY2OUT,VZ2OUT,
1796 &VXOUT,&VYOUT,&VZOUT);
1797 lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1798 VXOUT,VYOUT,VZOUT,
1799 &VX2OUT,&VY2OUT,&VZ2OUT);
1800 VFP2_CM[0] = VX2OUT;
1801 VFP2_CM[1] = VY2OUT;
1802 VFP2_CM[2] = VZ2OUT;
1803
1804 } else if(FF11==0 && FIMF11==1){
1805// Heavy partner emits imf, consequtive imf emission or fission is not allowed
1806 opt->optimfallowed = 0; // IMF is not allowed
1807 fiss->ifis = 0; // fission is not allowed
1808//
1809 zf = zff;
1810 af = aff;
1811 ee = EEIMFP;
1812 aimf = adummy;
1813 zimf = zdummy;
1814 tkeimf = tkedummy;
1815 FF11 = 0;
1816 FIMF11 = 0;
1817 ftype = 22;
1818// Lambda particles
1819 G4int NbLamH1=0;
1820 G4int NbLamimf1=0;
1821 G4double pbH1 = (af-zf) / (af-zf+aimf-zimf);
1822 for(G4int i=0;i<NbLamH;i++){
1823 if(G4AblaRandom::flat()<pbH1){
1824 NbLamH1++;
1825 }else{
1826 NbLamimf1++;
1827 }
1828 }
1829//
1830// Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
1831 EkinR1 = tkeimf * aimf / (af+aimf);
1832 EkinR2 = tkeimf * af / (af+aimf);
1833 V1 = std::sqrt(EkinR1/af) * 1.3887;
1834 V2 = std::sqrt(EkinR2/aimf) * 1.3887;
1835 G4double VZ1_IMFS = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
1836 VPERP1 = std::sqrt(V1*V1 - VZ1_IMFS*VZ1_IMFS);
1837 ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
1838 G4double VX1_IMFS = VPERP1 * std::sin(ALPHA1);
1839 G4double VY1_IMFS = VPERP1 * std::cos(ALPHA1);
1840 G4double VX2_IMFS = - VX1_IMFS / V1 * V2;
1841 G4double VY2_IMFS = - VY1_IMFS / V1 * V2;
1842 G4double VZ2_IMFS = - VZ1_IMFS / V1 * V2;
1843
1844 EEIMFP = ee * af /(af + aimf);
1845 EEIMF = ee * aimf /(af + aimf);
1846
1847// Decay of heavy partner
1848 IINERTTOT = 0.40 * 931.490 * 1.160*1.160 *( std::pow(aimf,5.0/3.0) + std::pow(af,5.0/3.0)) + 931.490 * 1.160*1.160*aimf*af/(aimf+af)*(std::pow(aimf,1./3.) + std::pow(af,1./3.))*(std::pow(aimf,1./3.) + std::pow(af,1./3.));
1849
1850 JPRFHEAVY = jprf1 * 0.4 * 931.49 * 1.16*1.16 * std::pow(af,5.0/3.0) / IINERTTOT;
1851 JPRFLIGHT = jprf1 * 0.4 * 931.49 * 1.16*1.16 * std::pow(aimf,5.0/3.0) / IINERTTOT;
1852
1853 G4double zffs=0.,affs=0.,vx1ev_imfs=0.,vy1ev_imfs=0.,vz1ev_imfs=0.,jprf3=0.;
1854
1855 evapora(zf,af,&EEIMFP,JPRFHEAVY, &zffs, &affs, &mtota, &vz1ev_imfs, &vx1ev_imfs,&vy1ev_imfs, &FF11, &FIMF11, &zdummy, &adummy,&tkedummy, &jprf3, &inttype, &inum,EV_TEMP,&IEV_TAB_TEMP,&NbLamH1);
1856
1857 for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1858 EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1859 EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1860 EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1861//
1862// EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1863// EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1864// EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1865// Lorentz transformation
1866 lorentz_boost(VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1867 EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1868 &VXOUT,&VYOUT,&VZOUT);
1869 lorentz_boost(vx1ev_imfs,vy1ev_imfs,vz1ev_imfs,
1870 VXOUT,VYOUT,VZOUT,
1871 &VX2OUT,&VY2OUT,&VZ2OUT);
1872 EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1873 EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1874 EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1875 }
1876 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1877
1878// For IMF - fission and IMF emission are not allowed
1879 opt->optimfallowed = 0; // IMF is not allowed
1880 fiss->ifis = 0; // fission is not allowed
1881//
1882 FF22 = 0;
1883 FIMF22 = 0;
1884// Decay of "second" IMF
1885 G4double zffimfs=0.,affimfs=0.,vx2ev_imfs=0.,vy2ev_imfs=0.,vz2ev_imfs=0.,jprf4=0.;
1886
1887 evapora(zimf,aimf,&EEIMF,JPRFLIGHT, &zffimfs, &affimfs, &mtota, &vz2ev_imfs, &vx2ev_imfs,&vy2ev_imfs, &FF22, &FIMF22, &zdummy1, &adummy1,&tkedummy1, &jprf4, &inttype, &inum,EV_TEMP,&IEV_TAB_TEMP,&NbLamimf1);
1888
1889 for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1890 EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1891 EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1892 EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1893//
1894// EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1895// EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1896// EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1897// Lorentz transformation
1898 lorentz_boost(VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1899 EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1900 &VXOUT,&VYOUT,&VZOUT);
1901 lorentz_boost(vx2ev_imfs,vy2ev_imfs,vz2ev_imfs,
1902 VXOUT,VYOUT,VZOUT,
1903 &VX2OUT,&VY2OUT,&VZ2OUT);
1904 EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1905 EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1906 EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1907 }
1908 IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1909
1910 AFP1 = idnint(affs);
1911 ZFP1 = idnint(zffs);
1912 SFP1 = NbLamH1;
1913 ZFP2 = idnint(zffimfs);
1914 AFP2 = idnint(affimfs);
1915 SFP2 = NbLamimf1;
1916
1917// Velocity of final heavy residue
1918// Lorentz kinematics
1919// VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
1920// VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
1921// VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
1922 lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1923 V_CM[0],V_CM[1],V_CM[2],
1924 &VXOUT,&VYOUT,&VZOUT);
1925 lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1926 VXOUT,VYOUT,VZOUT,
1927 &VX2OUT,&VY2OUT,&VZ2OUT);
1928 lorentz_boost(VX1_IMFS,VY1_IMFS,VZ1_IMFS,
1929 VX2OUT,VY2OUT,VZ2OUT,
1930 &VXOUT,&VYOUT,&VZOUT);
1931 lorentz_boost(vx1ev_imfs,vy1ev_imfs,vz1ev_imfs,
1932 VXOUT,VYOUT,VZOUT,
1933 &VX2OUT,&VY2OUT,&VZ2OUT);
1934 VFP1_CM[0] = VX2OUT;
1935 VFP1_CM[1] = VY2OUT;
1936 VFP1_CM[2] = VZ2OUT;
1937
1938// Velocity of the second IMF
1939// Lorentz kinematics
1940// VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
1941// VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
1942// VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
1943 lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1944 V_CM[0],V_CM[1],V_CM[2],
1945 &VXOUT,&VYOUT,&VZOUT);
1946 lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1947 VXOUT,VYOUT,VZOUT,
1948 &VX2OUT,&VY2OUT,&VZ2OUT);
1949 lorentz_boost(VX2_IMFS,VY2_IMFS,VZ2_IMFS,
1950 VX2OUT,VY2OUT,VZ2OUT,
1951 &VXOUT,&VYOUT,&VZOUT);
1952 lorentz_boost(vx2ev_imfs,vy2ev_imfs,vz2ev_imfs,
1953 VXOUT,VYOUT,VZOUT,
1954 &VX2OUT,&VY2OUT,&VZ2OUT);
1955 VFP2_CM[0] = VX2OUT;
1956 VFP2_CM[1] = VY2OUT;
1957 VFP2_CM[2] = VZ2OUT;
1958 }//second decay
1959 }// if(ftype == 2)
1960
1961// Only evaporation of light particles
1962 if(ftype!=1 && ftype!=21){
1963
1964// ----------- RESOLVE UNSTABLE NUCLEI
1965 IOUNSTABLE=0;
1966
1967 unstable_nuclei(AFP1,ZFP1,&afpnew,&zfpnew,IOUNSTABLE,
1968 VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1969 &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1970
1971 if(IOUNSTABLE==1){
1972 AFP1 = afpnew;
1973 ZFP1 = zfpnew;
1974 VFP1_CM[0] = VP1X;
1975 VFP1_CM[1] = VP1Y;
1976 VFP1_CM[2] = VP1Z;
1977 for(G4int I = 0;I<ILOOP;I++){
1978 for(G4int IJ = 0; IJ<5; IJ++)
1979 EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1980 }
1981 IEV_TAB = IEV_TAB + ILOOP;
1982 }
1983
1984 if(ftype>1){
1985 IOUNSTABLE=0;
1986
1987 unstable_nuclei(AFPIMF,ZFPIMF,&afpnew,&zfpnew,IOUNSTABLE,
1988 VIMF_CM[0],VIMF_CM[1],VIMF_CM[2],
1989 &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1990
1991 if(IOUNSTABLE==1){
1992 AFPIMF = afpnew;
1993 ZFPIMF = zfpnew;
1994 VIMF_CM[0] = VP1X;
1995 VIMF_CM[1] = VP1Y;
1996 VIMF_CM[2] = VP1Z;
1997 for(G4int I = 0;I<ILOOP;I++){
1998 for(G4int IJ = 0; IJ<5; IJ++)
1999 EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2000 }
2001 IEV_TAB = IEV_TAB + ILOOP;
2002 }
2003
2004 if(ftype>2){
2005 IOUNSTABLE=0;
2006
2007 unstable_nuclei(AFP2,ZFP2,&afpnew,&zfpnew,IOUNSTABLE,
2008 VFP2_CM[0],VFP2_CM[1],VFP2_CM[2],
2009 &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
2010
2011 if(IOUNSTABLE==1){
2012 AFP2 = afpnew;
2013 ZFP2 = zfpnew;
2014 VFP2_CM[0] = VP1X;
2015 VFP2_CM[1] = VP1Y;
2016 VFP2_CM[2] = VP1Z;
2017 for(G4int I = 0;I<ILOOP;I++){
2018 for(G4int IJ = 0; IJ<5; IJ++)
2019 EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2020 }
2021 IEV_TAB = IEV_TAB + ILOOP;
2022 }
2023 }// ftype>2
2024 }// ftype>1
2025 }
2026
2027
2028// For the case of fission:
2029 if(ftype==1 || ftype==21){
2030// ----------- RESOLVE UNSTABLE NUCLEI
2031 IOUNSTABLE=0;
2032// ----------- Fragment 1
2033 unstable_nuclei(AFP1,ZFP1,&afpnew,&zfpnew,IOUNSTABLE,
2034 VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
2035 &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
2036
2037 if(IOUNSTABLE==1){
2038 AFP1 = afpnew;
2039 ZFP1 = zfpnew;
2040 VFP1_CM[0] = VP1X;
2041 VFP1_CM[1] = VP1Y;
2042 VFP1_CM[2] = VP1Z;
2043 for(G4int I = 0;I<ILOOP;I++){
2044 for(G4int IJ = 0; IJ<5; IJ++)
2045 EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2046 }
2047 IEV_TAB = IEV_TAB + ILOOP;
2048 }
2049
2050 IOUNSTABLE=0;
2051// ----------- Fragment 2
2052 unstable_nuclei(AFP2,ZFP2,&afpnew,&zfpnew,IOUNSTABLE,
2053 VFP2_CM[0],VFP2_CM[1],VFP2_CM[2],
2054 &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
2055
2056 if(IOUNSTABLE==1){
2057 AFP2 = afpnew;
2058 ZFP2 = zfpnew;
2059 VFP2_CM[0] = VP1X;
2060 VFP2_CM[1] = VP1Y;
2061 VFP2_CM[2] = VP1Z;
2062 for(G4int I = 0;I<ILOOP;I++){
2063 for(G4int IJ = 0; IJ<5; IJ++)
2064 EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2065 }
2066 IEV_TAB = IEV_TAB + ILOOP;
2067 }
2068
2069 if(ftype==21){
2070 IOUNSTABLE=0;
2071// ----------- Fragment IMF
2072 unstable_nuclei(AFPIMF,ZFPIMF,&afpnew,&zfpnew,IOUNSTABLE,
2073 VIMF_CM[0],VIMF_CM[1],VIMF_CM[2],
2074 &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
2075
2076 if(IOUNSTABLE==1){
2077 AFPIMF = afpnew;
2078 ZFPIMF = zfpnew;
2079 VIMF_CM[0] = VP1X;
2080 VIMF_CM[1] = VP1Y;
2081 VIMF_CM[2] = VP1Z;
2082 for(G4int I = 0;I<ILOOP;I++){
2083 for(G4int IJ = 0; IJ<5; IJ++)
2084 EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2085 }
2086 IEV_TAB = IEV_TAB + ILOOP;
2087 }
2088 }// ftype=21
2089 }
2090
2091// Cross check
2092 if((ftype == 1 || ftype == 21) && (AFP2<=0 || AFP1<=0 || ZFP2<=0 || ZFP1<=0)){
2093 std::cout << "ZFP1:" << ZFP1 << std::endl;
2094 std::cout << "AFP1:" << AFP1 << std::endl;
2095 std::cout << "ZFP2:" << ZFP2 << std::endl;
2096 std::cout << "AFP2:" << AFP2 << std::endl;
2097 }
2098
2099// Put heavy residues in the EV_TAB array
2100 EV_TAB[IEV_TAB][0] = ZFP1;
2101 EV_TAB[IEV_TAB][1] = AFP1;
2102 EV_TAB[IEV_TAB][5] = SFP1;
2103 EV_TAB[IEV_TAB][2] = VFP1_CM[0];
2104 EV_TAB[IEV_TAB][3] = VFP1_CM[1];
2105 EV_TAB[IEV_TAB][4] = VFP1_CM[2];
2106 IEV_TAB = IEV_TAB + 1;
2107
2108 if(AFP2>0){
2109 EV_TAB[IEV_TAB][0] = ZFP2;
2110 EV_TAB[IEV_TAB][1] = AFP2;
2111 EV_TAB[IEV_TAB][5] = SFP2;
2112 EV_TAB[IEV_TAB][2] = VFP2_CM[0];
2113 EV_TAB[IEV_TAB][3] = VFP2_CM[1];
2114 EV_TAB[IEV_TAB][4] = VFP2_CM[2];
2115 IEV_TAB = IEV_TAB + 1;
2116 }
2117
2118 if(AFPIMF>0){
2119 EV_TAB[IEV_TAB][0] = ZFPIMF;
2120 EV_TAB[IEV_TAB][1] = AFPIMF;
2121 EV_TAB[IEV_TAB][5] = SFPIMF;
2122 EV_TAB[IEV_TAB][2] = VIMF_CM[0];
2123 EV_TAB[IEV_TAB][3] = VIMF_CM[1];
2124 EV_TAB[IEV_TAB][4] = VIMF_CM[2];
2125 IEV_TAB = IEV_TAB + 1;
2126 }
2127// Put the array of particles in the root file of INCL
2128 FillData(IMULTBU,IEV_TAB);
2129 return;
2130}
2131
2132// Evaporation code
2134{
2135
2136 // 40 C BFPRO,SNPRO,SPPRO,SHELL
2137 // 41 C
2138 // 42 C AP,ZP,AT,ZT - PROJECTILE AND TARGET MASSES
2139 // 43 C EAP,BETA - BEAM ENERGY PER NUCLEON, V/C
2140 // 44 C BMAXNUC - MAX. IMPACT PARAMETER FOR NUCL. REAC.
2141 // 45 C CRTOT,CRNUC - TOTAL AND NUCLEAR REACTION CROSS SECTION
2142 // 46 C R_0,R_P,R_T, - RADIUS PARAMETER, PROJECTILE+ TARGET RADII
2143 // 47 C IMAX,IRNDM,PI - MAXIMUM NUMBER OF EVENTS, DUMMY, 3.141...
2144 // 48 C BFPRO - FISSION BARRIER OF THE PROJECTILE
2145 // 49 C SNPRO - NEUTRON SEPARATION ENERGY OF THE PROJECTILE
2146 // 50 C SPPRO - PROTON " " " " "
2147 // 51 C SHELL - GROUND STATE SHELL CORRECTION
2148 // 52 C---------------------------------------------------------------------
2149 // 53 C
2150 // 54 C ENERGIES WIDTHS AND CROSS SECTIONS FOR EM EXCITATION
2151 // 55 C COMMON /EMDPAR/ EGDR,EGQR,FWHMGDR,FWHMGQR,CREMDE1,CREMDE2,
2152 // 56 C AE1,BE1,CE1,AE2,BE2,CE2,SR1,SR2,XR
2153 // 57 C
2154 // 58 C EGDR,EGQR - MEAN ENERGY OF GDR AND GQR
2155 // 59 C FWHMGDR,FWHMGQR - FWHM OF GDR, GQR
2156 // 60 C CREMDE1,CREMDE2 - EM CROSS SECTION FOR E1 AND E2
2157 // 61 C AE1,BE1,CE1 - ARRAYS TO CALCULATE
2158 // 62 C AE2,BE2,CE2 - THE EXCITATION ENERGY AFTER E.M. EXC.
2159 // 63 C SR1,SR2,XR - WITH MONTE CARLO
2160 // 64 C---------------------------------------------------------------------
2161 // 65 C
2162 // 66 C DEFORMATIONS AND G.S. SHELL EFFECTS
2163 // 67 C COMMON /ECLD/ ECGNZ,ECFNZ,VGSLD,ALPHA
2164 // 68 C
2165 // 69 C ECGNZ - GROUND STATE SHELL CORR. FRLDM FOR A SPHERICAL G.S.
2166 // 70 C ECFNZ - SHELL CORRECTION FOR THE SADDLE POINT (NOW: == 0)
2167 // 71 C VGSLD - DIFFERENCE BETWEEN DEFORMED G.S. AND LDM VALUE
2168 // 72 C ALPHA - ALPHA GROUND STATE DEFORMATION (THIS IS NOT BETA2!)
2169 // 73 C BETA2 = SQRT(5/(4PI)) * ALPHA
2170 // 74 C---------------------------------------------------------------------
2171 // 75 C
2172 // 76 C ARRAYS FOR EXCITATION ENERGY BY STATISTICAL HOLE ENERY MODEL
2173 // 77 C COMMON /EENUC/ SHE, XHE
2174 // 78 C
2175 // 79 C SHE, XHE - ARRAYS TO CALCULATE THE EXC. ENERGY AFTER
2176 // 80 C ABRASION BY THE STATISTICAL HOLE ENERGY MODEL
2177 // 81 C---------------------------------------------------------------------
2178 // 82 C
2179 // 83 C G.S. SHELL EFFECT
2180 // 84 C COMMON /EC2SUB/ ECNZ
2181 // 85 C
2182 // 86 C ECNZ G.S. SHELL EFFECT FOR THE MASSES (IDENTICAL TO ECGNZ)
2183 // 87 C---------------------------------------------------------------------
2184 //
2185
2186 G4double MN = 939.5653301;
2187 G4double MP = 938.7829835;
2188
2189#ifdef ABLAXX_IN_GEANT4_MODE
2190 G4AblaDataFile *dataInterface = new G4AblaDataFile();
2191#else
2192 G4AblaDataFile *dataInterface = new G4AblaDataFile(theConfig);
2193#endif
2194 if(dataInterface->readData() == true) {
2195 if(verboseLevel > 0) {
2196 // G4cout <<"G4Abla: Datafiles read successfully." << G4endl;
2197 }
2198 }
2199 else {
2200 // G4Exception("ERROR: Failed to read datafiles.");
2201 }
2202
2203 for(G4int z = 0; z < 99; z++) { //do 30 z = 0,98,1
2204 for(G4int n = 0; n < 154; n++) { //do 31 n = 0,153,1
2205 ecld->ecfnz[n][z] = 0.e0;
2206 ec2sub->ecnz[n][z] = dataInterface->getEcnz(n,z);
2207 ecld->ecgnz[n][z] = dataInterface->getEcnz(n,z);
2208 ecld->alpha[n][z] = dataInterface->getAlpha(n,z);
2209 ecld->vgsld[n][z] = dataInterface->getVgsld(n,z);
2210 ecld->rms[n][z] = dataInterface->getRms(n,z);
2211 }
2212 }
2213
2214 for(G4int z = 0; z < 137; z++){
2215 for(G4int n = 0; n < 251; n++){
2216 ecld->beta2[n][z] = dataInterface->getBeta2(n,z);
2217 ecld->beta4[n][z] = dataInterface->getBeta4(n,z);
2218 }
2219 }
2220
2221 for(G4int z = 0; z < 500; z++) {
2222 for(G4int a = 0; a < 500; a++) {
2223 pace->dm[z][a] = dataInterface->getPace2(z,a);
2224 }
2225 }
2226
2227
2228
2229 G4double mfrldm[154][13];
2230// For 2 < Z < 12 we take "experimental" shell corrections instead of calculated
2231// Read FRLDM tables
2232 for(G4int i=1;i<13;i++){
2233 for(G4int j=1;j<154;j++){
2234 if(dataInterface->getMexpID(j,i)==1){
2235 masses->mexpiop[j][i]=1;
2236 }else{
2237 masses->mexpiop[j][i]=0;
2238 }
2239// LD masses (even-odd effect is later considered according to Ignatyuk)
2240 if(i==0 && j==0)
2241 mfrldm[j][i] = 0.;
2242 else
2243 mfrldm[j][i] = MP*i+MN*j+eflmac(i+j,i,1,0);
2244 }
2245 }
2246
2247 G4double e0=0.;
2248 for(G4int i=1;i<13;i++){
2249 for(G4int j=1;j<154;j++){
2250 masses->bind[j][i]=0.;
2251 if(masses->mexpiop[j][i]==1){
2252 if(j<3){
2253
2254 ec2sub->ecnz[j][i] = 0.0;
2255 ecld->ecgnz[j][i] = ec2sub->ecnz[j][i];
2256 masses->bind[j][i] = dataInterface->getMexp(j,i)-MP*i -MN*j;
2257 ecld->vgsld[j][i]=0.;
2258
2259 e0=0.;
2260 }else{
2261// For these nuclei, we take "experimental" ground-state shell corrections
2262//
2263// Parametrization of CT model by Ignatyuk; note that E0 is shifted to correspond
2264// to pairing shift in Fermi-gas model (there, energy is shifted taking odd-odd nuclei as bassis)
2265 G4double para=0.;
2266 parite(j+i,&para);
2267 if(para<0.0){
2268// e-o, o-e
2269 e0 = 0.285+11.17*std::pow(j+i,-0.464) -0.390-0.00058*(j+i);
2270 }else{
2271 G4double parz=0.;
2272 parite(i,&parz);
2273 if (parz>0.0){
2274// e-e
2275 e0 = 22.34*std::pow(j+i,-0.464)-0.235;
2276 }else{
2277// o-o
2278 e0 = 0.0;
2279 }
2280 }
2281//
2282 if((j==i)&&mod(j,2)==1&&mod(i,2)==1){
2283 e0 = e0 - 30.0*(1.0/G4double(j+i));
2284 }
2285
2286 G4double delta_tot = ec2sub->ecnz[j][i] - ecld->vgsld[j][i];
2287 ec2sub->ecnz[j][i] = dataInterface->getMexp(j,i) - (mfrldm[j][i] - e0);
2288
2289 ecld->vgsld[j][i] = max(0.0,ec2sub->ecnz[j][i] - delta_tot);
2290 ecld->ecgnz[j][i] = ec2sub->ecnz[j][i];
2291
2292 }//if j
2293 }//if mexpiop
2294 }
2295 }
2296//
2297 delete dataInterface;
2298}
2299
2301{
2302 //A and Z for the target
2303 fiss->at = a;
2304 fiss->zt = z;
2305
2306 // shell+pairing.0-1-2-3 for IMFs
2307 opt->optshpimf = 0;
2308
2309 //collective enhancement switched on 1 or off 0 in densn (qr=val or =1.)
2310 fiss->optcol = 1;
2311 if(fiss->zt<83 && fiss->zt>56){
2312 fiss->optshp = 1;
2313 }
2314 if(fiss->zt<=56){
2315 fiss->optcol = 0;
2316 fiss->optshp = 3;
2317 }
2318}
2319
2321{
2322/*
2323C IFIS = INTEGER SWITCH FOR FISSION
2324C OPTSHP = INTEGER SWITCH FOR SHELL CORRECTION IN MASSES/ENERGY
2325C =0 NO MICROSCOPIC CORRECTIONS IN MASSES AND ENERGY
2326C =1 SHELL , NO PAIRING CORRECTION
2327C =2 PAIRING, NO SHELL CORRECTION
2328C =3 SHELL AND PAIRING CORRECTION IN MASSES AND ENERGY
2329C OPTCOL =0,1 COLLECTIVE ENHANCEMENT SWITCHED ON 1 OR OFF 0 IN DENSN
2330C OPTAFAN=0,1 SWITCH FOR AF/AN = 1 IN DENSNIV 0 AF/AN>1 1 AF/AN=1
2331C BET = REAL REDUCED FRICTION COEFFICIENT / 10**(+21) S**(-1)
2332C OPTXFIS= INTEGER 0,1,2 FOR MYERS & SWIATECKI, DAHLINGER, ANDREYEV
2333C FISSILITY PARAMETER.
2334C
2335C NUCLEAR LEVEL DENSITIES:
2336C AV = REAL KOEFFICIENTS FOR CALCULATION OF A(TILDE)
2337C AS = REAL LEVEL DENSITY PARAMETER
2338C AK = REAL
2339*/
2340
2341 // switch-fission.1=on.0=off
2342 fiss->ifis = 1;
2343
2344 // shell+pairing.0-1-2-3
2345 fiss->optshp = 3;
2346 if(fiss->zt<84 && fiss->zt>56)
2347 fiss->optshp = 1;
2348
2349 // optemd =0,1 0 no emd, 1 incl. emd
2350 opt->optemd = 1;
2351 // read(10,*,iostat=io) dum(10),optcha
2352 opt->optcha = 1;
2353
2354 // shell+pairing.0-1-2-3 for IMFs
2355 opt->optshpimf = 0;
2356 opt->optimfallowed = 1;
2357
2358 // nuclear.viscosity.(beta)
2359 fiss->bet = 4.5;
2360
2361 //collective enhancement switched on 1 or off 0 in densn (qr=val or =1.)
2362 fiss->optcol = 1;
2363 if(fiss->zt<=56){
2364 fiss->optcol = 0;
2365 fiss->optshp = 3;
2366 }
2367 //collective enhancement parameters
2368 fiss->ucr = 40.;
2369 fiss->dcr = 10.;
2370
2371 // switch for temperature constant model (CTM)
2372 fiss->optct = 1;
2373
2374 ald->optafan = 0;
2375
2376 ald->av = 0.0730;
2377 ald->as = 0.0950;
2378 ald->ak = 0.0000;
2379
2380 fiss->optxfis = 3;
2381
2382// Multi-fragmentation
2383 T_freeze_out_in = -6.5;
2384
2385}
2386
2388{
2389 // MODEL DE LA GOUTTE LIQUIDE DE C. F. WEIZSACKER.
2390 // USUALLY AN OBSOLETE OPTION
2391
2392 G4double xv = 0.0, xs = 0.0, xc = 0.0, xa = 0.0;
2393
2394 if ((a <= 0.01) || (z < 0.01)) {
2395 (*el) = 1.0e38;
2396 }
2397 else {
2398 xv = -15.56*a;
2399 xs = 17.23*std::pow(a,(2.0/3.0));
2400
2401 if (a > 1.0) {
2402 xc = 0.7*z*(z-1.0)*std::pow((a-1.0),(-1.e0/3.e0));
2403 }
2404 else {
2405 xc = 0.0;
2406 }
2407 }
2408
2409 xa = 23.6*(std::pow((a-2.0*z),2)/a);
2410 (*el) = xv+xs+xc+xa;
2411 return;
2412}
2413
2415{
2416 // USING FUNCTION EFLMAC(IA,IZ,0)
2417 //
2418 // REFOPT4 = 0 : WITHOUT MICROSCOPIC CORRECTIONS
2419 // REFOPT4 = 1 : WITH SHELL CORRECTION
2420 // REFOPT4 = 2 : WITH PAIRING CORRECTION
2421 // REFOPT4 = 3 : WITH SHELL- AND PAIRING CORRECTION
2422
2423 // 1839 C-----------------------------------------------------------------------
2424 // 1840 C A1 LOCAL MASS NUMBER (INTEGER VARIABLE OF A)
2425 // 1841 C Z1 LOCAL NUCLEAR CHARGE (INTEGER VARIABLE OF Z)
2426 // 1842 C REFOPT4 OPTION, SPECIFYING THE MASS FORMULA (SEE ABOVE)
2427 // 1843 C A MASS NUMBER
2428 // 1844 C Z NUCLEAR CHARGE
2429 // 1845 C DEL PAIRING CORRECTION
2430 // 1846 C EL BINDING ENERGY
2431 // 1847 C ECNZ( , ) TABLE OF SHELL CORRECTIONS
2432 // 1848 C-----------------------------------------------------------------------
2433 // 1849 C
2434 G4int a1 = idnint(a);
2435 G4int z1 = idnint(z);
2436 G4int n1 = a1-z1;
2437
2438 if ( (a1 <= 0) || (z1 <= 0) || ((a1-z1) <= 0) ) { //then
2439 // modif pour recuperer une masse p et n correcte:
2440 (*el) = 1.e38;
2441 return;
2442 // goto mglms50;
2443 }
2444 else {
2445 // binding energy incl. pairing contr. is calculated from
2446 // function eflmac
2447 (*el) = eflmac(a1,z1,0,refopt4);
2448
2449 if (refopt4 > 0) {
2450 if (refopt4 != 2) {
2451 (*el) = (*el) + ec2sub->ecnz[a1-z1][z1];
2452 }
2453 }
2454
2455 if(z1>=90){
2456 if(n1<=145){
2457 (*el) = (*el) + (12.552-0.1436*z1);
2458 }else{
2459 if(n1>145&&n1<=152){
2460 (*el) = (*el) + ((152.4-1.77*z1)+(-0.972+0.0113*z1)*n1);
2461 }
2462 }
2463 }
2464
2465 }
2466 return;
2467}
2468
2470{
2471
2472 // INPUT: A,Z,OPTXFIS MASS AND CHARGE OF A NUCLEUS,
2473 // OPTION FOR FISSILITY
2474 // OUTPUT: SPDEF
2475
2476 // ALPHA2 SADDLE POINT DEF. COHEN&SWIATECKI ANN.PHYS. 22 (1963) 406
2477 // RANGING FROM FISSILITY X=0.30 TO X=1.00 IN STEPS OF 0.02
2478
2479 G4int index = 0;
2480 G4double x = 0.0, v = 0.0, dx = 0.0;
2481
2482 const G4int alpha2Size = 37;
2483 // The value 0.0 at alpha2[0] added by PK.
2484 G4double alpha2[alpha2Size] = {0.0, 2.5464e0, 2.4944e0, 2.4410e0, 2.3915e0, 2.3482e0,
2485 2.3014e0, 2.2479e0, 2.1982e0, 2.1432e0, 2.0807e0, 2.0142e0, 1.9419e0,
2486 1.8714e0, 1.8010e0, 1.7272e0, 1.6473e0, 1.5601e0, 1.4526e0, 1.3164e0,
2487 1.1391e0, 0.9662e0, 0.8295e0, 0.7231e0, 0.6360e0, 0.5615e0, 0.4953e0,
2488 0.4354e0, 0.3799e0, 0.3274e0, 0.2779e0, 0.2298e0, 0.1827e0, 0.1373e0,
2489 0.0901e0, 0.0430e0, 0.0000e0};
2490
2491 dx = 0.02;
2492 x = fissility(a,z,0,0.,0.,optxfis);
2493
2494 v = (x - 0.3)/dx + 1.0;
2495 index = idnint(v);
2496
2497 if (index < 1) {
2498 return(alpha2[1]);
2499 }
2500
2501 if (index == 36) {
2502 return(alpha2[36]);
2503 }
2504 else {
2505 return(alpha2[index] + (alpha2[index+1] - alpha2[index]) / dx * ( x - (0.3e0 + dx*(index-1))));
2506 }
2507
2508 return alpha2[0]; // The algorithm is not supposed to reach this point.
2509}
2510
2512{
2513 // CALCULATION OF FISSILITY PARAMETER
2514 //
2515 // INPUT: A,Z INTEGER MASS & CHARGE OF NUCLEUS
2516 // OPTXFIS = 0 : MYERS, SWIATECKI
2517 // 1 : DAHLINGER
2518 // 2 : ANDREYEV
2519
2520 G4double aa = 0.0, zz = 0.0, i = 0.0,z2a,C_S,R,W,G,G1,G2,A_CC;
2521 G4double fissilityResult = 0.0;
2522
2523 aa = G4double(a);
2524 zz = G4double(z);
2525 i = G4double(a-2*z) / aa;
2526 z2a= zz*zz/aa-ny*(1115.-939.+sn-slam)/(0.7053*std::pow(a,2./3.));
2527
2528 // myers & swiatecki droplet modell
2529 if (optxfis == 0) { //then
2530 fissilityResult = std::pow(zz,2) / aa /50.8830e0 / (1.0e0 - 1.7826e0 * std::pow(i,2));
2531 }
2532
2533 if (optxfis == 1) {
2534 // dahlinger fit:
2535 fissilityResult = std::pow(zz,2) / aa * std::pow((49.22e0*(1.e0 - 0.3803e0*std::pow(i,2) - 20.489e0*std::pow(i,4))),(-1));
2536 }
2537
2538 if (optxfis == 2) {
2539 // dubna fit:
2540 fissilityResult = std::pow(zz,2) / aa /(48.e0*(1.e0 - 17.22e0*std::pow(i,4)));
2541 }
2542
2543 if (optxfis == 3) {
2544// Fissiilty is calculated according to FRLDM, see Sierk, PRC 1984.
2545 C_S = 21.13 * (1.0 - 2.3*i*i);
2546 R = 1.16 * std::pow(aa,1.0/3.0);
2547 W = 0.704/R;
2548 G1 = 1.0 - 15.0/8.0*W+21.0/8.0*W*W*W;
2549 G2 = 1.0 + 9.0/2.0*W + 7.0*W*W + 7.0/2.0*W*W*W;
2550 G = 1.0 - 5.0*W*W*(G1 - 3.0/4.0*G2*std::exp(-2.0/W));
2551 A_CC = 3.0/5.0 * 1.44 * G / 1.16;
2552 fissilityResult = z2a * A_CC/(2.0*C_S);
2553 }
2554
2555 if (fissilityResult > 1.0) {
2556 fissilityResult = 1.0;
2557 }
2558
2559 if (fissilityResult < 0.0) {
2560 fissilityResult = 0.0;
2561 }
2562
2563 return fissilityResult;
2564}
2565
2566void G4Abla::evapora(G4double zprf, G4double aprf, G4double *ee_par, G4double jprf_par,G4double *zf_par, G4double *af_par, G4double *mtota_par,G4double *vleva_par, G4double *vxeva_par, G4double *vyeva_par,
2567G4int *ff_par,G4int *fimf_par, G4double *fzimf, G4double *faimf,G4double *tkeimf_par,G4double *jprfout, G4int *inttype_par, G4int *inum_par,G4double EV_TEMP[200][6],G4int *iev_tab_temp_par, G4int *NbLam0_par)
2568{
2569 G4double zf = zprf;
2570 G4double af = aprf;
2571 G4double ee = (*ee_par);
2572 G4double jprf = dint(jprf_par);
2573 G4double mtota = (*mtota_par);
2574 G4double vleva = 0.;
2575 G4double vxeva = 0.;
2576 G4double vyeva = 0.;
2577 G4int ff = (*ff_par);
2578 G4int fimf = (*fimf_par);
2579 G4double tkeimf = (*tkeimf_par);
2580 G4int inttype = (*inttype_par);
2581 G4int inum = (*inum_par);
2582 G4int NbLam0 = (*NbLam0_par);
2583
2584 // 533 C
2585 // 534 C INPUT:
2586 // 535 C
2587 // 536 C ZPRF, APRF, EE(EE IS MODIFIED!), JPRF
2588 // 537 C
2589 // 538 C PROJECTILE AND TARGET PARAMETERS + CROSS SECTIONS
2590 // 539 C COMMON /ABRAMAIN/ AP,ZP,AT,ZT,EAP,BETA,BMAXNUC,CRTOT,CRNUC,
2591 // 540 C R_0,R_P,R_T, IMAX,IRNDM,PI,
2592 // 541 C BFPRO,SNPRO,SPPRO,SHELL
2593 // 542 C
2594 // 543 C AP,ZP,AT,ZT - PROJECTILE AND TARGET MASSES
2595 // 544 C EAP,BETA - BEAM ENERGY PER NUCLEON, V/C
2596 // 545 C BMAXNUC - MAX. IMPACT PARAMETER FOR NUCL. REAC.
2597 // 546 C CRTOT,CRNUC - TOTAL AND NUCLEAR REACTION CROSS SECTION
2598 // 547 C R_0,R_P,R_T, - RADIUS PARAMETER, PROJECTILE+ TARGET RADII
2599 // 548 C IMAX,IRNDM,PI - MAXIMUM NUMBER OF EVENTS, DUMMY, 3.141...
2600 // 549 C BFPRO - FISSION BARRIER OF THE PROJECTILE
2601 // 550 C SNPRO - NEUTRON SEPARATION ENERGY OF THE PROJECTILE
2602 // 551 C SPPRO - PROTON " " " " "
2603 // 552 C SHELL - GROUND STATE SHELL CORRECTION
2604 // 553 C
2605 // 554 C---------------------------------------------------------------------
2606 // 555 C FISSION BARRIERS
2607 // 556 C COMMON /FB/ EFA
2608 // 557 C EFA - ARRAY OF FISSION BARRIERS
2609 // 558 C---------------------------------------------------------------------
2610 // 559 C OUTPUT:
2611 // 560 C ZF, AF, MTOTA, PLEVA, PTEVA, FF, INTTYPE, INUM
2612 // 561 C
2613 // 562 C ZF,AF - CHARGE AND MASS OF FINAL FRAGMENT AFTER EVAPORATION
2614 // 563 C MTOTA _ NUMBER OF EVAPORATED ALPHAS
2615 // 564 C PLEVA,PXEVA,PYEVA - MOMENTUM RECOIL BY EVAPORATION
2616 // 565 C INTTYPE - TYPE OF REACTION 0/1 NUCLEAR OR ELECTROMAGNETIC
2617 // 566 C FF - 0/1 NO FISSION / FISSION EVENT
2618 // 567 C INUM - EVENTNUMBER
2619 // 568 C ____________________________________________________________________
2620 // 569 C /
2621 // 570 C / CALCUL DE LA MASSE ET CHARGE FINALES D'UNE CHAINE D'EVAPORATION
2622 // 571 C /
2623 // 572 C / PROCEDURE FOR CALCULATING THE FINAL MASS AND CHARGE VALUES OF A
2624 // 573 C / SPECIFIC EVAPORATION CHAIN, STARTING POINT DEFINED BY (APRF, ZPRF,
2625 // 574 C / EE)
2626 // 575 C / On ajoute les 3 composantes de l'impulsion (PXEVA,PYEVA,PLEVA)
2627 // 576 C / (actuellement PTEVA n'est pas correct; mauvaise norme...)
2628 // 577 C /____________________________________________________________________
2629 // 578 C
2630 // 612 C
2631 // 613 C-----------------------------------------------------------------------
2632 // 614 C IRNDM DUMMY ARGUMENT FOR RANDOM-NUMBER FUNCTION
2633 // 615 C SORTIE LOCAL HELP VARIABLE TO END THE EVAPORATION CHAIN
2634 // 616 C ZF NUCLEAR CHARGE OF THE FRAGMENT
2635 // 617 C ZPRF NUCLEAR CHARGE OF THE PREFRAGMENT
2636 // 618 C AF MASS NUMBER OF THE FRAGMENT
2637 // 619 C APRF MASS NUMBER OF THE PREFRAGMENT
2638 // 620 C EPSILN ENERGY BURNED IN EACH EVAPORATION STEP
2639 // 621 C MALPHA LOCAL MASS CONTRIBUTION TO MTOTA IN EACH EVAPORATION
2640 // 622 C STEP
2641 // 623 C EE EXCITATION ENERGY (VARIABLE)
2642 // 624 C PROBP PROTON EMISSION PROBABILITY
2643 // 625 C PROBN NEUTRON EMISSION PROBABILITY
2644 // 626 C PROBA ALPHA-PARTICLE EMISSION PROBABILITY
2645 // 627 C PTOTL TOTAL EMISSION PROBABILITY
2646 // 628 C E LOWEST PARTICLE-THRESHOLD ENERGY
2647 // 629 C SN NEUTRON SEPARATION ENERGY
2648 // 630 C SBP PROTON SEPARATION ENERGY PLUS EFFECTIVE COULOMB
2649 // 631 C BARRIER
2650 // 632 C SBA ALPHA-PARTICLE SEPARATION ENERGY PLUS EFFECTIVE
2651 // 633 C COULOMB BARRIER
2652 // 634 C BP EFFECTIVE PROTON COULOMB BARRIER
2653 // 635 C BA EFFECTIVE ALPHA COULOMB BARRIER
2654 // 636 C MTOTA TOTAL MASS OF THE EVAPORATED ALPHA PARTICLES
2655 // 637 C X UNIFORM RANDOM NUMBER FOR NUCLEAR CHARGE
2656 // 638 C AMOINS LOCAL MASS NUMBER OF EVAPORATED PARTICLE
2657 // 639 C ZMOINS LOCAL NUCLEAR CHARGE OF EVAPORATED PARTICLE
2658 // 640 C ECP KINETIC ENERGY OF PROTON WITHOUT COULOMB
2659 // 641 C REPULSION
2660 // 642 C ECN KINETIC ENERGY OF NEUTRON
2661 // 643 C ECA KINETIC ENERGY OF ALPHA PARTICLE WITHOUT COULOMB
2662 // 644 C REPULSION
2663 // 645 C PLEVA TRANSVERSAL RECOIL MOMENTUM OF EVAPORATION
2664 // 646 C PTEVA LONGITUDINAL RECOIL MOMENTUM OF EVAPORATION
2665 // 647 C FF FISSION FLAG
2666 // 648 C INTTYPE INTERACTION TYPE FLAG
2667 // 649 C RNDX RECOIL MOMENTUM IN X-DIRECTION IN A SINGLE STEP
2668 // 650 C RNDY RECOIL MOMENTUM IN Y-DIRECTION IN A SINGLE STEP
2669 // 651 C RNDZ RECOIL MOMENTUM IN Z-DIRECTION IN A SINGLE STEP
2670 // 652 C RNDN NORMALIZATION OF RECOIL MOMENTUM FOR EACH STEP
2671 // 653 C-----------------------------------------------------------------------
2672 // 654 C
2673 //
2674 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, probimf=0.0, problamb0 = 0.0, ptotl = 0.0, e = 0.0, tcn = 0.0;
2675 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,sp = 0.0, sd = 0.0, st = 0.0, she = 0.0, sa = 0.0, slamb0 = 0.0;
2676 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, bd = 0.0, bt = 0.0, bhe = 0.0, ba = 0.0;
2677 G4double zimf= 0.0,aimf= 0.0,bimf= 0.0,sbimf= 0.0,timf= 0.0;
2678 G4int itest = 0, sortie=0;
2679 G4double probf = 0.0;
2680 G4double ctet1 = 0.0, stet1 = 0.0, phi1 = 0.0;
2681 G4double rnd = 0.0;
2682 G4double ef = 0.0;
2683 G4double ts1 = 0.0;
2684 G4int fgamma = 0, gammadecay = 0, flamb0decay=0;
2685 G4double pc = 0.0, malpha = 0.0;
2686 G4double jprfn=0.0, jprfp=0.0, jprfd=0.0, jprft=0.0, jprfhe=0.0, jprfa=0.0, jprflamb0 = 0.0;
2687 G4double tsum = 0.0;
2688 G4int twon;
2689
2690 const G4double c = 29.9792458;
2691 const G4double mu = 931.494;
2692 const G4double mu2 = 931.494*931.494;
2693
2694 G4double pleva = 0.0;
2695 G4double pxeva = 0.0;
2696 G4double pyeva = 0.0;
2697 G4int IEV_TAB_TEMP=0;
2698
2699 for(G4int I1=0;I1<200;I1++)
2700 for(G4int I2=0;I2<6;I2++)
2701 EV_TEMP[I1][I2] = 0.0;
2702//
2703 ff = 0;
2704 itest = 0;
2705//
2706 evapora10:
2707 //
2708 // calculation of the probabilities for the different decay channels
2709 // plus separation energies and kinetic energies of the particles
2710 //
2711 if(ee<0.|| zf<3.)goto evapora100;
2712 direct(zf,af,ee,jprf,&probp,&probd,&probt,&probn,&probhe,&proba,&probg,&probimf,&probf,&problamb0,&ptotl,
2713 &sn,&sbp,&sbd,&sbt,&sbhe,&sba,&slamb0,
2714 &ecn,&ecp,&ecd,&ect,&eche,&eca,&ecg,&eclamb0,
2715 &bp,&bd,&bt,&bhe,&ba,&sp,&sd,&st,&she,&sa,&ef,&ts1,inttype,inum,itest,&sortie,&tcn,
2716 &jprfn, &jprfp, &jprfd, &jprft, &jprfhe, &jprfa, &jprflamb0, &tsum, NbLam0);
2717//
2718// HERE THE FINAL STEPS OF THE EVAPORATION ARE CALCULATED
2719//
2720 if(ptotl==0.0) goto evapora100;
2721
2722 e = dmin1(sba,sbhe,dmin1(sbt,sbhe,dmin1(sn,sbp,sbd)));
2723
2724 if(e>1e30)std::cout << "ERROR AT THE EXIT OF EVAPORA,E>1.D30,AF="<< af << " ZF=" << zf << std::endl;
2725
2726 if(sortie==1){
2727 if (probn!=0.0) {
2728 amoins = 1.0;
2729 zmoins = 0.0;
2730 epsiln = sn + ecn;
2731 pc = std::sqrt(std::pow((1.0 + (ecn)/9.3956e2),2.) - 1.0) * 9.3956e2;
2732 malpha = 0.0;
2733 fgamma = 0;
2734 fimf = 0;
2735 flamb0decay=0;
2736 gammadecay = 0;
2737 }
2738 else if(probp!=0.0){
2739 amoins = 1.0;
2740 zmoins = 1.0;
2741 epsiln = sp + ecp;
2742 pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2.) - 1.0) * 9.3827e2;
2743 malpha = 0.0;
2744 fgamma = 0;
2745 fimf = 0;
2746 flamb0decay=0;
2747 gammadecay = 0;
2748 }
2749 else if(probd!=0.0){
2750 amoins = 2.0;
2751 zmoins = 1.0;
2752 epsiln = sd + ecd;
2753 pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
2754 malpha = 0.0;
2755 fgamma = 0;
2756 fimf = 0;
2757 flamb0decay=0;
2758 gammadecay = 0;
2759 }
2760 else if(probt!=0.0){
2761 amoins = 3.0;
2762 zmoins = 1.0;
2763 epsiln = st + ect;
2764 pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
2765 malpha = 0.0;
2766 fgamma = 0;
2767 fimf = 0;
2768 flamb0decay=0;
2769 gammadecay = 0;
2770 }
2771 else if(probhe!=0.0){
2772 amoins = 3.0;
2773 zmoins = 2.0;
2774 epsiln = she + eche;
2775 pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
2776 malpha = 0.0;
2777 fgamma = 0;
2778 fimf = 0;
2779 flamb0decay=0;
2780 gammadecay = 0;
2781 }
2782 else{ if(proba!=0.0){
2783 amoins = 4.0;
2784 zmoins = 2.0;
2785 epsiln = sa + eca;
2786 pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
2787 malpha = 4.0;
2788 fgamma = 0;
2789 fimf = 0;
2790 flamb0decay=0;
2791 gammadecay = 0;
2792 }
2793 }
2794 goto direct99;
2795 }
2796
2797 // here the normal evaporation cascade starts
2798
2799 // random number for the evaporation
2800 x = G4AblaRandom::flat() * ptotl;
2801
2802 itest = 0;
2803 if (x < proba) {
2804 // alpha evaporation
2805 amoins = 4.0;
2806 zmoins = 2.0;
2807 epsiln = sa + eca;
2808 pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
2809 malpha = 4.0;
2810 fgamma = 0;
2811 fimf = 0;
2812 ff = 0;
2813 flamb0decay=0;
2814 gammadecay = 0;
2815 jprf=jprfa;
2816 }
2817 else if (x < proba+probhe) {
2818 // He3 evaporation
2819 amoins = 3.0;
2820 zmoins = 2.0;
2821 epsiln = she + eche;
2822 pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
2823 malpha = 0.0;
2824 fgamma = 0;
2825 fimf = 0;
2826 ff = 0;
2827 flamb0decay=0;
2828 gammadecay = 0;
2829 jprf=jprfhe;
2830 }
2831 else if (x < proba+probhe+probt) {
2832 // triton evaporation
2833 amoins = 3.0;
2834 zmoins = 1.0;
2835 epsiln = st + ect;
2836 pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
2837 malpha = 0.0;
2838 fgamma = 0;
2839 fimf = 0;
2840 ff = 0;
2841 flamb0decay=0;
2842 gammadecay = 0;
2843 jprf=jprft;
2844 }
2845 else if (x < proba+probhe+probt+probd) {
2846 // deuteron evaporation
2847 amoins = 2.0;
2848 zmoins = 1.0;
2849 epsiln = sd + ecd;
2850 pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
2851 malpha = 0.0;
2852 fgamma = 0;
2853 fimf = 0;
2854 ff = 0;
2855 flamb0decay=0;
2856 gammadecay = 0;
2857 jprf=jprfd;
2858 }
2859 else if (x < proba+probhe+probt+probd+probp) {
2860 // proton evaporation
2861 amoins = 1.0;
2862 zmoins = 1.0;
2863 epsiln = sp + ecp;
2864 pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2) - 1.0) * 9.3827e2;
2865 malpha = 0.0;
2866 fgamma = 0;
2867 fimf = 0;
2868 ff = 0;
2869 flamb0decay=0;
2870 gammadecay = 0;
2871 jprf=jprfp;
2872 }
2873 else if (x < proba+probhe+probt+probd+probp+probn) {
2874 // neutron evaporation
2875 amoins = 1.0;
2876 zmoins = 0.0;
2877 epsiln = sn + ecn;
2878 pc = std::sqrt(std::pow((1.0 + (ecn)/9.3956e2),2.) - 1.0) * 9.3956e2;
2879 malpha = 0.0;
2880 fgamma = 0;
2881 fimf = 0;
2882 ff = 0;
2883 flamb0decay=0;
2884 gammadecay = 0;
2885 jprf=jprfn;
2886 }
2887 else if (x < proba+probhe+probt+probd+probp+probn+problamb0) {
2888 // lambda0 evaporation
2889 amoins = 1.0;
2890 zmoins = 0.0;
2891 epsiln = slamb0 + eclamb0;
2892 pc = std::sqrt(std::pow((1.0 + (eclamb0)/11.1568e2),2.) - 1.0) * 11.1568e2;
2893 malpha = 0.0;
2894 fgamma = 0;
2895 fimf = 0;
2896 ff = 0;
2897 flamb0decay = 1;
2898 opt->nblan0 = opt->nblan0 -1;
2899 NbLam0 = NbLam0 -1;
2900 gammadecay = 0;
2901 jprf=jprflamb0;
2902 }
2903 else if (x < proba+probhe+probt+probd+probp+probn+problamb0+probg) {
2904 // gamma evaporation
2905 amoins = 0.0;
2906 zmoins = 0.0;
2907 epsiln = ecg;
2908 pc = ecg;
2909 malpha = 0.0;
2910 flamb0decay = 0;
2911 gammadecay = 1;
2912 //Next IF command is to shorten the calculations when gamma-emission is the only
2913 //possible channel
2914 if(probp==0.0 && probn==0.0 && probd==0.0 && probt==0.0 && proba==0.0 && probhe==0.0 && problamb0==0.0 && probimf==0.0 && probf==0.0)fgamma = 1;
2915 fimf = 0;
2916 ff = 0;
2917 }
2918 else if (x < proba+probhe+probt+probd+probp+probn+problamb0+probg+probimf) {
2919 // imf evaporation
2920// AIMF and ZIMF obtained from complete procedure (integration over all
2921// possible Gamma(IMF) and then randomly picked
2922
2923 G4int iloop=0;
2924 dir1973:
2925 imf(af,zf,tcn,ee,&zimf,&aimf,&bimf,&sbimf,&timf,jprf);
2926 iloop++;
2927 if(iloop>100)std::cout << "Problem in EVAPORA: IMF called > 100 times" << std::endl;
2928 if(zimf>=(zf-2.0)) goto dir1973;
2929 if(zimf>zf/2.0){
2930 zimf = zf - zimf;
2931 aimf = af - aimf;
2932 }
2933 // These cases should in principle never happen
2934 if(zimf==0.0 || aimf==0.0 || sbimf>ee)std::cout << "warning: Look in EVAPORA CALL IMF" << std::endl;
2935
2936// I sample the total kinetic energy consumed by the system of two nuclei
2937// from the distribution determined with the temperature at saddle point
2938// TKEIMF is the kinetic energy in the centre of mass of IMF and its partner
2939
2940 G4int ii=0;
2941 dir1235:
2942 tkeimf= fmaxhaz(timf);
2943 ii++;
2944 if(ii>100){
2945 tkeimf=min(2.0*timf,ee-sbimf);
2946 goto dir1000;
2947 }
2948 if(tkeimf<=0.0)goto dir1235;
2949 if(tkeimf>(ee-sbimf) && timf>0.5)goto dir1235;
2950 dir1000:
2951 tkeimf = tkeimf + bimf;
2952
2953 amoins = aimf;
2954 zmoins = zimf;
2955 epsiln = (sbimf-bimf) + tkeimf;
2956 pc = 0.0;
2957 malpha = 0.0;
2958 fgamma = 0;
2959 fimf = 1;
2960 ff = 0;
2961 flamb0decay = 0;
2962 gammadecay = 0;
2963 }
2964 else {
2965 // fission
2966 // in case of fission-events the fragment nucleus is the mother nucleus
2967 // before fission occurs with excitation energy above the fis.- barrier.
2968 // fission fragment mass distribution is calulated in subroutine fisdis
2969
2970 amoins = 0.0;
2971 zmoins = 0.0;
2972 epsiln = ef;
2973//
2974 malpha = 0.0;
2975 pc = 0.0;
2976 ff = 1;
2977 fimf = 0;
2978 fgamma = 0;
2979 flamb0decay = 0;
2980 gammadecay = 0;
2981 }
2982//
2983 direct99:
2984 if (ee <= 0.01)ee = 0.01;
2985// Davide Mancusi (DM) - 2010
2986 if(gammadecay==1 && ee<(epsiln+0.010)){
2987 epsiln = ee - 0.010;
2988 // fgamma = 1;
2989 }
2990
2991 if(epsiln<0.0){
2992 std::cout << "***WARNING epsilon<0***" << std::endl;
2993 //epsiln=0.;
2994 //PRINT*,IDECAYMODE,IDNINT(AF),IDNINT(ZF),EE,EPSILN
2995 }
2996 // calculation of the daughter nucleus
2997 af = af - amoins;
2998 zf = zf - zmoins;
2999 ee = ee - epsiln;
3000 if (ee <= 0.01)ee = 0.01;
3001 mtota = mtota + malpha;
3002
3003
3004 //if(amoins==2 && zmoins==0)std::cout << ee << std::endl;
3005
3006
3007 secondneutron:
3008 if(amoins==2 && zmoins==0){twon=1;amoins=1;}else{ twon=0;}
3009
3010
3011// Determination of x,y,z components of momentum from known emission momentum PC
3012 if(ff==0 && fimf==0){
3013 //
3014 if(flamb0decay==1){
3015 EV_TEMP[IEV_TAB_TEMP][0] = 0.;
3016 EV_TEMP[IEV_TAB_TEMP][1] = -2;
3017 EV_TEMP[IEV_TAB_TEMP][5] = 1.;
3018 }else{
3019 EV_TEMP[IEV_TAB_TEMP][0] = zmoins;
3020 EV_TEMP[IEV_TAB_TEMP][1] = amoins;
3021 EV_TEMP[IEV_TAB_TEMP][5] = 0.;
3022 }
3023 rnd = G4AblaRandom::flat();
3024 ctet1 = 2.0*rnd - 1.0; // z component: uniform probability between -1 and 1
3025 stet1 = std::sqrt(1.0 - std::pow(ctet1,2)); // component perpendicular to z
3026 rnd = G4AblaRandom::flat();
3027 phi1 = rnd*2.0*3.141592654; // angle in x-y plane: uniform probability between 0 and 2*pi
3028 G4double xcv = stet1*std::cos(phi1);// x component
3029 G4double ycv = stet1*std::sin(phi1);// y component
3030 G4double zcv = ctet1; // z component
3031// In the CM system
3032 if(gammadecay==0){
3033// Light particle
3034 G4double ETOT_LP = std::sqrt(pc*pc + amoins*amoins * mu2);
3035 if(flamb0decay==1)ETOT_LP = std::sqrt(pc*pc + 1115.683*1115.683);
3036 EV_TEMP[IEV_TAB_TEMP][2] = c * pc * xcv / ETOT_LP;
3037 EV_TEMP[IEV_TAB_TEMP][3] = c * pc * ycv / ETOT_LP;
3038 EV_TEMP[IEV_TAB_TEMP][4] = c * pc * zcv / ETOT_LP;
3039 }else{
3040// gamma ray
3041 EV_TEMP[IEV_TAB_TEMP][2] = pc * xcv;
3042 EV_TEMP[IEV_TAB_TEMP][3] = pc * ycv;
3043 EV_TEMP[IEV_TAB_TEMP][4] = pc * zcv;
3044 }
3045 G4double VXOUT=0.,VYOUT=0.,VZOUT=0.;
3046 lorentz_boost(vxeva,vyeva,vleva,
3047 EV_TEMP[IEV_TAB_TEMP][2],EV_TEMP[IEV_TAB_TEMP][3],
3048 EV_TEMP[IEV_TAB_TEMP][4],
3049 &VXOUT,&VYOUT,&VZOUT);
3050 EV_TEMP[IEV_TAB_TEMP][2] = VXOUT;
3051 EV_TEMP[IEV_TAB_TEMP][3] = VYOUT;
3052 EV_TEMP[IEV_TAB_TEMP][4] = VZOUT;
3053// Heavy residue
3054 if(gammadecay==0){
3055 G4double v2 = std::pow(EV_TEMP[IEV_TAB_TEMP][2],2.) +
3056 std::pow(EV_TEMP[IEV_TAB_TEMP][3],2.) +
3057 std::pow(EV_TEMP[IEV_TAB_TEMP][4],2.);
3058 G4double gamma = 1.0/std::sqrt(1.0 - v2 / (c*c));
3059 G4double etot_lp = amoins*mu * gamma;
3060 pxeva = pxeva - EV_TEMP[IEV_TAB_TEMP][2] * etot_lp / c;
3061 pyeva = pyeva - EV_TEMP[IEV_TAB_TEMP][3] * etot_lp / c;
3062 pleva = pleva - EV_TEMP[IEV_TAB_TEMP][4] * etot_lp / c;
3063 }else{
3064// in case of gammas, EV_TEMP contains momentum components and not velocity
3065 pxeva = pxeva - EV_TEMP[IEV_TAB_TEMP][2];
3066 pyeva = pyeva - EV_TEMP[IEV_TAB_TEMP][3];
3067 pleva = pleva - EV_TEMP[IEV_TAB_TEMP][4];
3068 }
3069 G4double pteva = std::sqrt(pxeva*pxeva + pyeva*pyeva);
3070// To be checked:
3071 G4double etot = std::sqrt ( pleva*pleva + pteva*pteva + af*af * mu2 );
3072 vxeva = c * pxeva / etot; // recoil velocity components of residue due to evaporation
3073 vyeva = c * pyeva / etot;
3074 vleva = c * pleva / etot;
3075 IEV_TAB_TEMP = IEV_TAB_TEMP + 1;
3076 }
3077
3078 if(twon==1){goto secondneutron;}
3079
3080 // condition for end of evaporation
3081 if (zf < 3. || (ff == 1) || (fgamma == 1) || (fimf==1)) {
3082 goto evapora100;
3083 }
3084 goto evapora10;
3085
3086 evapora100:
3087 (*zf_par) = zf;
3088 (*af_par) = af;
3089 (*ee_par) = ee;
3090 (*faimf) = aimf;
3091 (*fzimf) = zimf;
3092 (*jprfout) = jprf;
3093 (*tkeimf_par) = tkeimf;
3094 (*mtota_par) = mtota;
3095 (*vleva_par) = vleva;
3096 (*vxeva_par) = vxeva;
3097 (*vyeva_par) = vyeva;
3098 (*ff_par) = ff;
3099 (*fimf_par) = fimf;
3100 (*inttype_par) = inttype;
3101 (*iev_tab_temp_par)= IEV_TAB_TEMP;
3102 (*inum_par) = inum;
3103 (*NbLam0_par) = NbLam0;
3104 return;
3105}
3106
3107void G4Abla::direct(G4double zprf, G4double a, G4double ee, G4double jprf, G4double *probp_par, G4double *probd_par, G4double *probt_par, G4double *probn_par, G4double *probhe_par, G4double *proba_par, G4double *probg_par,G4double *probimf_par,G4double *probf_par,G4double *problamb0_par, G4double *ptotl_par, G4double *sn_par, G4double *sbp_par, G4double *sbd_par, G4double *sbt_par, G4double *sbhe_par, G4double *sba_par,G4double *slamb0_par, G4double *ecn_par, G4double *ecp_par, G4double *ecd_par, G4double *ect_par,G4double *eche_par,G4double *eca_par, G4double *ecg_par, G4double *eclamb0_par, G4double *bp_par, G4double *bd_par, G4double *bt_par, G4double *bhe_par, G4double *ba_par,G4double *sp_par,G4double *sd_par,G4double *st_par,G4double *she_par,G4double *sa_par, G4double *ef_par,G4double *ts1_par, G4int, G4int inum, G4int itest, G4int *sortie, G4double *tcn,G4double *jprfn_par, G4double *jprfp_par, G4double *jprfd_par, G4double *jprft_par, G4double *jprfhe_par, G4double *jprfa_par, G4double *jprflamb0_par, G4double *tsum_par, G4int NbLam0)
3108{
3109 G4double probp = (*probp_par);
3110 G4double probd = (*probd_par);
3111 G4double probt = (*probt_par);
3112 G4double probn = (*probn_par);
3113 G4double probhe = (*probhe_par);
3114 G4double proba = (*proba_par);
3115 G4double probg = (*probg_par);
3116 G4double probimf = (*probimf_par);
3117 G4double probf = (*probf_par);
3118 G4double problamb0 = (*problamb0_par);
3119 G4double ptotl = (*ptotl_par);
3120 G4double sn = (*sn_par);
3121 G4double sp = (*sp_par);
3122 G4double sd = (*sd_par);
3123 G4double st = (*st_par);
3124 G4double she = (*she_par);
3125 G4double sa = (*sa_par);
3126 G4double slamb0 = 0.0;
3127 G4double sbp = (*sbp_par);
3128 G4double sbd = (*sbd_par);
3129 G4double sbt = (*sbt_par);
3130 G4double sbhe = (*sbhe_par);
3131 G4double sba = (*sba_par);
3132 G4double ecn = (*ecn_par);
3133 G4double ecp = (*ecp_par);
3134 G4double ecd = (*ecd_par);
3135 G4double ect = (*ect_par);
3136 G4double eche = (*eche_par);
3137 G4double eca = (*eca_par);
3138 G4double ecg = (*ecg_par);
3139 G4double eclamb0 = (*eclamb0_par);
3140 G4double bp = (*bp_par);
3141 G4double bd = (*bd_par);
3142 G4double bt = (*bt_par);
3143 G4double bhe = (*bhe_par);
3144 G4double ba = (*ba_par);
3145 G4double tsum = (*tsum_par);
3146
3147 // CALCULATION OF PARTICLE-EMISSION PROBABILITIES & FISSION /
3148 // BASED ON THE SIMPLIFIED FORMULAS FOR THE DECAY WIDTH BY /
3149 // MORETTO, ROCHESTER MEETING TO AVOID COMPUTING TIME /
3150 // INTENSIVE INTEGRATION OF THE LEVEL DENSITIES /
3151 // USES EFFECTIVE COULOMB BARRIERS AND AN AVERAGE KINETIC ENERGY/
3152 // OF THE EVAPORATED PARTICLES /
3153 // COLLECTIVE ENHANCMENT OF THE LEVEL DENSITY IS INCLUDED /
3154 // DYNAMICAL HINDRANCE OF FISSION IS INCLUDED BY A STEP FUNCTION/
3155 // APPROXIMATION. SEE A.R. JUNGHANS DIPLOMA THESIS /
3156 // SHELL AND PAIRING STRUCTURES IN THE LEVEL DENSITY IS INCLUDED/
3157
3158 // INPUT:
3159 // ZPRF,A,EE CHARGE, MASS, EXCITATION ENERGY OF COMPOUND
3160 // NUCLEUS
3161 // JPRF ROOT-MEAN-SQUARED ANGULAR MOMENTUM
3162
3163 // DEFORMATIONS AND G.S. SHELL EFFECTS
3164 // COMMON /ECLD/ ECGNZ,ECFNZ,VGSLD,ALPHA
3165
3166 // ECGNZ - GROUND STATE SHELL CORR. FRLDM FOR A SPHERICAL G.S.
3167 // ECFNZ - SHELL CORRECTION FOR THE SADDLE POINT (NOW: == 0)
3168 // VGSLD - DIFFERENCE BETWEEN DEFORMED G.S. AND LDM VALUE
3169 // ALPHA - ALPHA GROUND STATE DEFORMATION (THIS IS NOT BETA2!)
3170 // BETA2 = SQRT((4PI)/5) * ALPHA
3171
3172 //OPTIONS AND PARAMETERS FOR FISSION CHANNEL
3173 //COMMON /FISS/ AKAP,BET,HOMEGA,KOEFF,IFIS,
3174 // OPTSHP,OPTXFIS,OPTLES,OPTCOL
3175 //
3176 // AKAP - HBAR**2/(2* MN * R_0**2) = 10 MEV, R_0 = 1.4 FM
3177 // BET - REDUCED NUCLEAR FRICTION COEFFICIENT IN (10**21 S**-1)
3178 // HOMEGA - CURVATURE OF THE FISSION BARRIER = 1 MEV
3179 // KOEFF - COEFFICIENT FOR THE LD FISSION BARRIER == 1.0
3180 // IFIS - 0/1 FISSION CHANNEL OFF/ON
3181 // OPTSHP - INTEGER SWITCH FOR SHELL CORRECTION IN MASSES/ENERGY
3182 // = 0 NO MICROSCOPIC CORRECTIONS IN MASSES AND ENERGY
3183 // = 1 SHELL , NO PAIRING
3184 // = 2 PAIRING, NO SHELL
3185 // = 3 SHELL AND PAIRING
3186 // OPTCOL - 0/1 COLLECTIVE ENHANCEMENT SWITCHED ON/OFF
3187 // OPTXFIS- 0,1,2 FOR MYERS & SWIATECKI, DAHLINGER, ANDREYEV
3188 // FISSILITY PARAMETER.
3189 // OPTLES - CONSTANT TEMPERATURE LEVEL DENSITY FOR A,Z > TH-224
3190 // OPTCOL - 0/1 COLLECTIVE ENHANCEMENT OFF/ON
3191
3192 // LEVEL DENSITY PARAMETERS
3193 // COMMON /ALD/ AV,AS,AK,OPTAFAN
3194 // AV,AS,AK - VOLUME,SURFACE,CURVATURE DEPENDENCE OF THE
3195 // LEVEL DENSITY PARAMETER
3196 // OPTAFAN - 0/1 AF/AN >=1 OR AF/AN ==1
3197 // RECOMMENDED IS OPTAFAN = 0
3198
3199 // FISSION BARRIERS
3200 // COMMON /FB/ EFA
3201 // EFA - ARRAY OF FISSION BARRIERS
3202
3203
3204 // OUTPUT: PROBN,PROBP,PROBA,PROBF,PTOTL:
3205 // - EMISSION PROBABILITIES FOR N EUTRON, P ROTON, A LPHA
3206 // PARTICLES, F ISSION AND NORMALISATION
3207 // SN,SBP,SBA: SEPARATION ENERGIES N P A
3208 // INCLUDING EFFECTIVE BARRIERS
3209 // ECN,ECP,ECA,BP,BA
3210 // - AVERAGE KINETIC ENERGIES (2*T) AND EFFECTIVE BARRIERS
3211
3212 G4double bk = 0.0;
3213 G4double bksp = 0.0;
3214 G4double bc = 0.0;
3215 G4int afp = 0;
3216 G4double het = 0.0;
3217 G4double at = 0.0;
3218 G4double bs = 0.0;
3219 G4double bssp = 0.0;
3220 G4double bshell = 0.0;
3221 G4double cf = 0.0;
3222 G4double defbet = 0.0;
3223 G4double densa = 0.0;
3224 G4double denshe = 0.0;
3225 G4double densg = 0.0;
3226 G4double densn = 0.0;
3227 G4double densp = 0.0;
3228 G4double densd = 0.0;
3229 G4double denst = 0.0;
3230 G4double denslamb0 = 0.0;
3231 G4double eer = 0.0;
3232 G4double ecor = 0.0;
3233 G4double ef = 0.0;
3234 G4double ft = 0.0;
3235 G4double timf = 0.0;
3236 G4double qr = 0.0;
3237 G4double qrcn = 0.0;
3238 G4double omegap=0.0;
3239 G4double omegad=0.0;
3240 G4double omegat=0.0;
3241 G4double omegahe=0.0;
3242 G4double omegaa=0.0;
3243 G4double ga = 0.0;
3244 G4double ghe = 0.0;
3245 G4double gf = 0.0;
3246 G4double gff = 0.0;
3247 G4double gn = 0.0;
3248 G4double gp = 0.0;
3249 G4double gd = 0.0;
3250 G4double gt = 0.0;
3251 G4double gg = 0.0;
3252 G4double glamb0 = 0.0;
3253 G4double gimf = 0.0;
3254 G4double gimf3 = 0.0;
3255 G4double gimf5 = 0.0;
3256 G4double bimf = 0.0;
3257 G4double bsimf = 0.0;
3258 G4double sbimf = 0.0;
3259 G4double densimf = 0.0;
3260 G4double defbetimf = 0.0;
3261 G4double b_imf = 0.0;
3262 G4double a_imf = 0.0;
3263 G4double omegaimf = 0.0;
3264 G4int izimf = 0;
3265 G4double zimf = 0.0;
3266 G4double gsum = 0.0;
3267 G4double gtotal=0.0;
3268 G4double hbar = 6.582122e-22;
3269 G4double emin = 0.0;
3270 G4int il = 0;
3271 G4int choice_fisspart = 0;
3272 G4double t_lapse=0.0;
3273 G4int imaxwell = 0;
3274 G4int in = 0;
3275 G4int iz = 0;
3276 G4int ind = 0;
3277 G4int izd = 0;
3278 G4int j = 0;
3279 G4int k = 0;
3280 G4double ma1z = 0.0;
3281 G4double mazz = 0.0;
3282 G4double ma2z = 0.0;
3283 G4double ma1z1 = 0.0;
3284 G4double ma2z1 = 0.0;
3285 G4double ma3z1 = 0.0;
3286 G4double ma3z2 = 0.0;
3287 G4double ma4z2 = 0.0;
3288 G4double maz = 0.0;
3289 G4double nt = 0.0;
3290 G4double pi = 3.1415926535;
3291 G4double pt = 0.0;
3292 G4double dt = 0.0;
3293 G4double tt = 0.0;
3294 G4double lamb0t = 0.0;
3295 G4double gtemp = 0.0;
3296 G4double rdt = 0.0;
3297 G4double rtt = 0.0;
3298 G4double rat = 0.0;
3299 G4double rhet = 0.0;
3300 G4double refmod = 0.0;
3301 G4double rnt = 0.0;
3302 G4double rpt = 0.0;
3303 G4double rlamb0t = 0.0;
3304 G4double sbfis = 1.e40;
3305 G4double segs = 0.0;
3306 G4double selmax = 0.0;
3307 G4double tauc = 0.0;
3308 G4double temp = 0.0;
3309 G4double ts1 = 0.0;
3310 G4double xx = 0.0;
3311 G4double y = 0.0;
3312 G4double k1 = 0.0;
3313 G4double omegasp=0.0;
3314 G4double homegasp=0.0;
3315 G4double omegags=0.0;
3316 G4double homegags=0.0;
3317 G4double pa = 0.0;
3318 G4double gamma = 0.0;
3319 G4double gfactor = 0.0;
3320 G4double bscn;
3321 G4double bkcn;
3322 G4double bccn;
3323 G4double ftcn=0.0;
3324 G4double mfcd;
3325 G4double jprfn=jprf;
3326 G4double jprfp=jprf;
3327 G4double jprfd=jprf;
3328 G4double jprft=jprf;
3329 G4double jprfhe=jprf;
3330 G4double jprfa=jprf;
3331 G4double jprflamb0=jprf;
3332 G4double djprf=0.0;
3333 G4double dlout=0.0;
3334 G4double sdlout=0.0;
3335 G4double iinert=0.0;
3336 G4double erot=0.0;
3337 G4double erotn=0.0;
3338 G4double erotp=0.0;
3339 G4double erotd=0.0;
3340 G4double erott=0.0;
3341 G4double erothe=0.0;
3342 G4double erota=0.0;
3343 G4double erotlamb0=0.0;
3344 G4double erotcn=0.0;
3345 // G4double ecorcn=0.0;
3346 G4double imfarg=0.0;
3347 G4double width_imf=0.0;
3348 G4int IDjprf=0;
3349 G4int fimf_allowed=opt->optimfallowed;
3350
3351 if(itest==1){
3352
3353 }
3354 // Switch to calculate Maxwellian distribution of kinetic energies
3355 imaxwell = 1;
3356 *sortie = 0;
3357
3358 // just a change of name until the end of this subroutine
3359 eer = ee;
3360 if (inum == 1) {
3361 ilast = 1;
3362 }
3363 // calculation of masses
3364 // refmod = 1 ==> myers,swiatecki model
3365 // refmod = 0 ==> weizsaecker model
3366 refmod = 1; // Default = 1
3367//
3368 if (refmod == 1) {
3369 mglms(a,zprf,fiss->optshp,&maz);
3370 mglms(a-1.0,zprf,fiss->optshp,&ma1z);
3371 mglms(a-2.0,zprf,fiss->optshp,&ma2z);
3372 mglms(a-1.0,zprf-1.0,fiss->optshp,&ma1z1);
3373 mglms(a-2.0,zprf-1.0,fiss->optshp,&ma2z1);
3374 mglms(a-3.0,zprf-1.0,fiss->optshp,&ma3z1);
3375 mglms(a-3.0,zprf-2.0,fiss->optshp,&ma3z2);
3376 mglms(a-4.0,zprf-2.0,fiss->optshp,&ma4z2);
3377 }
3378 else {
3379 mglw(a,zprf,&maz);
3380 mglw(a-1.0,zprf,&ma1z);
3381 mglw(a-1.0,zprf-1.0,&ma1z1);
3382 mglw(a-2.0,zprf-1.0,&ma2z1);
3383 mglw(a-3.0,zprf-1.0,&ma3z1);
3384 mglw(a-3.0,zprf-2.0,&ma3z2);
3385 mglw(a-4.0,zprf-2.0,&ma4z2);
3386 }
3387
3388 if((a-1.)==3.0 && (zprf-1.0)==2.0) ma1z1=-7.7181660;
3389 if((a-1.)==4.0 && (zprf-1.0)==2.0) ma1z1=-28.295992;
3390
3391 // separation energies
3392 sn = ma1z - maz;
3393 sp = ma1z1 - maz;
3394 sd = ma2z1 - maz - 2.2246;
3395 st = ma3z1 - maz - 8.481977;
3396 she = ma3z2 - maz - 7.7181660;
3397 sa = ma4z2 - maz - 28.295992;
3398 //
3399 if(NbLam0>1){
3400 sn = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-1.,zprf,NbLam0);
3401 sp = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-1.,zprf-1.,NbLam0);
3402 sd = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-2.,zprf-1.,NbLam0);
3403 st = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-3.,zprf-1.,NbLam0);
3404 she = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-3.,zprf-2.,NbLam0);
3405 sa = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-4.,zprf-2.,NbLam0);
3406 slamb0 = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-1.,zprf,NbLam0-1);
3407 }
3408 if(NbLam0==1){
3409 G4double deltasn = sn - (gethyperbinding(a,zprf,0)-gethyperbinding(a-1.,zprf,0));
3410 G4double deltasp = sp - (gethyperbinding(a,zprf,0)-gethyperbinding(a-1.,zprf-1,0));
3411 G4double deltasd = sd - (gethyperbinding(a,zprf,0)-gethyperbinding(a-2.,zprf-1,0));
3412 G4double deltast = st - (gethyperbinding(a,zprf,0)-gethyperbinding(a-3.,zprf-1,0));
3413 G4double deltashe = she - (gethyperbinding(a,zprf,0)-gethyperbinding(a-3.,zprf-2,0));
3414 G4double deltasa = sa - (gethyperbinding(a,zprf,0)-gethyperbinding(a-4.,zprf-2,0));
3415
3416 sn = deltasn + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-1.,zprf,NbLam0);
3417 sp = deltasp + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-1.,zprf-1.,NbLam0);
3418 sd = deltasd + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-2.,zprf-1.,NbLam0);
3419 st = deltast + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-3.,zprf-1.,NbLam0);
3420 she = deltashe + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-3.,zprf-2.,NbLam0);
3421 sa = deltasa + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-4.,zprf-2.,NbLam0);
3422 slamb0 = gethyperseparation(a,zprf,NbLam0);
3423 }
3424
3425// coulomb barriers
3426//Proton
3427 if (zprf <= 1.0e0 || a <= 1.0e0 || (a-zprf) < 0.0) {
3428 sbp = 1.0e75;
3429 bp = 1.0e75;
3430 }else{
3431 barrs(idnint(zprf-1.),idnint(a-1.),1,1,&bp,&omegap);
3432 bp = max(bp,0.1);
3433 sbp = sp + bp;
3434 }
3435
3436//Deuteron
3437 if (zprf <= 1.0e0 || a <= 2.0e0 || (a-zprf) < 1.0) {
3438 sbd = 1.0e75;
3439 bd = 1.0e75;
3440 }else{
3441 barrs(idnint(zprf-1.),idnint(a-2.),1,2,&bd,&omegad);
3442 bd = max(bd,0.1);
3443 sbd = sd + bd;
3444 }
3445
3446//Triton
3447 if (zprf <= 1.0e0 || a <= 3.0e0 || (a-zprf) < 2.0) {
3448 sbt = 1.0e75;
3449 bt = 1.0e75;
3450 }else{
3451 barrs(idnint(zprf-1.),idnint(a-3.),1,3,&bt,&omegat);
3452 bt = max(bt,0.1);
3453 sbt = st + bt;
3454 }
3455
3456//Alpha
3457 if (a-4.0<=0.0 || zprf<=2.0 || (a-zprf)<2.0) {
3458 sba = 1.0e+75;
3459 ba = 1.0e+75;
3460 }else{
3461 barrs(idnint(zprf-2.),idnint(a-4.),2,4,&ba,&omegaa);
3462 ba = max(ba,0.1);
3463 sba = sa + ba;
3464 }
3465
3466//He3
3467 if (a-3.0 <= 0.0 || zprf<=2.0 || (a-zprf)<1.0) {
3468 sbhe = 1.0e+75;
3469 bhe = 1.0e+75;
3470 }else{
3471 barrs(idnint(zprf-2.),idnint(a-3.),2,3,&bhe,&omegahe);
3472 bhe = max(bhe,0.1);
3473 sbhe = she + bhe;
3474 }
3475
3476// Dealing with particle-unbound systems
3477 emin = dmin1(sba,sbhe,dmin1(sbt,sbhe,dmin1(sn,sbp,sbd)));
3478
3479 if(emin<=0.0){
3480 *sortie = 1;
3481 unbound(sn,sp,sd,st,she,sa,bp,bd,bt,bhe,ba,&probf,&probn,&probp,&probd,&probt,&probhe,&proba,&probimf,&probg,&ecn,&ecp,&ecd,&ect,&eche,&eca);
3482 goto direct70;
3483 }
3484//
3485 k = idnint(zprf);
3486 j = idnint(a - zprf);
3487 if (fiss->ifis > 0) {
3488 // now ef is calculated from efa that depends on the subroutine
3489 // barfit which takes into account the modification on the ang. mom.
3490 // note *** shell correction (ecgnz)
3491 il = idnint(jprf);
3492 barfit(k,k+j,il,&sbfis,&segs,&selmax);
3493 if ((fiss->optshp == 1) || (fiss->optshp == 3)) {
3494 ef = G4double(sbfis) - ecld->ecgnz[j][k];
3495// JLRS - Nov 2016 - Corrected values of fission barriers for actinides
3496 if(k==90){
3497 if(mod(j,2)==1){
3498 ef = ef*(4.5114-2.2687*(a-zprf)/zprf);
3499 }else{
3500 ef = ef*(3.3931-1.5338*(a-zprf)/zprf);
3501 }
3502 }
3503 if(k==92){
3504 if((a-zprf)/zprf>1.52)ef=ef*(1.1222-0.10886*(a-zprf)/zprf)-0.1;
3505 }
3506 if(k>=94&&k<=98&&j<158){// Data in this range have been tested
3507// e-e
3508 if(mod(j,2)==0&&mod(k,2)==0){
3509 if(k>=94){ef = ef-(11.54108*(a-zprf)/zprf-18.074);}
3510 }
3511// O-O
3512 if(mod(j,2)==1&&mod(k,2)==1){
3513 if(k>=95){ef = ef-(14.567*(a-zprf)/zprf-23.266);}
3514 }
3515// Odd A
3516 if(mod(j,2)==0&&mod(k,2)==1){
3517 if(j>=144){ef = ef-(13.662*(a-zprf)/zprf-21.656);}
3518 }
3519
3520 if(mod(j,2)==1&&mod(k,2)==0){
3521 if(j>=144){ef = ef-(13.662*(a-zprf)/zprf-21.656);}
3522 }
3523 }
3524 }
3525 else {
3526 ef = G4double(sbfis);
3527 }
3528//
3529// TO AVOID NEGATIVE VALUES FOR IMPOSSIBLE NUCLEI
3530// THE FISSION BARRIER IS SET TO ZERO IF SMALLER THAN ZERO.
3531//
3532 if (ef < 0.0)ef = 0.0;
3533 fb->efa[j][k]=ef;
3534//
3535// Hyper-fission barrier
3536//
3537 if(NbLam0>0){
3538 ef = ef + 0.51*(1115.-938.+sn-slamb0)/std::pow(a,2./3.);
3539 }
3540//
3541// Set fission barrier
3542//
3543 (*ef_par) = ef;
3544//
3545 // calculation of surface and curvature integrals needed to
3546 // to calculate the level density parameter at the saddle point
3547 xx = fissility((k+j),k,NbLam0,sn,slamb0,fiss->optxfis);
3548 y = 1.00 - xx;
3549 if(y<0.0) y = 0.0;
3550 if(y>1.0) y = 1.0;
3551 bssp = bipol(1,y);
3552 bksp = bipol(2,y);
3553 }
3554 else {
3555 ef = 1.0e40;
3556 sbfis = 1.0e40;
3557 bssp = 1.0;
3558 bksp = 1.0;
3559 }
3560//
3561// COMPOUND NUCLEUS LEVEL DENSITY
3562//
3563// AK 2007 - Now DENSNIV called with correct BS, BK
3564
3565 afp = idnint(a);
3566 iz = idnint(zprf);
3567 in = afp - iz;
3568 bshell = ecld->ecgnz[in][iz]- ecld->vgsld[in][iz];
3569 defbet = ecld->beta2[in][iz];
3570
3571 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);
3572 erot = jprf * jprf * 197.328 * 197.328 /(2. * iinert);
3573 erotcn = erot;
3574
3575 bsbkbc(a,zprf,&bscn,&bkcn,&bccn);
3576
3577 // if(ee > erot+emin){
3578 densniv(a,zprf,ee,0.0,&densg,bshell,bscn,bkcn,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprf,0,&qrcn);
3579 ftcn = temp;
3580/*
3581 //ecorcn = ecor;
3582 }else{
3583// If EE < EROT, only gamma emission can take place
3584 probf = 0.0;
3585 probp = 0.0;
3586 probd = 0.0;
3587 probt = 0.0;
3588 probn = 0.0;
3589 probhe = 0.0;
3590 proba = 0.0;
3591 probg = 1.0;
3592 probimf = 0.0;
3593//c JLRS 03/2017 - Added this calculation
3594//C According to A. Ignatyuk, GG :
3595//C Here BS=BK=1, as this was assumed in the parameterization
3596 pa = (ald->av)*a + (ald->as)*std::pow(a,2./3.) + (ald->ak)*std::pow(a,1./3.);
3597 gamma = 2.5 * pa * std::pow(a,-4./3.);
3598 gfactor = 1.+gamma*ecld->ecgnz[in][iz];
3599 if(gfactor<=0.){
3600 gfactor = 0.0;
3601 }
3602//
3603 gtemp = 17.60/(std::pow(a,0.699) * std::sqrt(gfactor));
3604 ecg = 4.0 * gtemp;
3605//
3606 goto direct70;
3607 }
3608*/
3609
3610// ---------------------------------------------------------------
3611// LEVEL DENSITIES AND TEMPERATURES OF THE FINAL STATES
3612// ---------------------------------------------------------------
3613//
3614// MVR - in case of charged particle emission temperature
3615// comes from random kinetic energy from a Maxwelliam distribution
3616// if option imaxwell = 1 (otherwise E=2T)
3617//
3618// AK - LEVEL DENSITY AND TEMPERATURE AT THE SADDLE POINT -> now calculated in the subroutine FISSION_WIDTH
3619//
3620//
3621// LEVEL DENSITY AND TEMPERATURE IN THE NEUTRON DAUGHTER
3622//
3623// KHS, AK 2007 - Reduction of angular momentum due to orbital angular momentum of emitted fragment
3624// JLRS Nov-2016 - Added these caculations in abla++
3625
3626 if (in >= 2) {
3627 ind=idnint(a)-idnint(zprf)-1;
3628 izd=idnint(zprf);
3629 if(jprf>0.10){
3630 lorb(a,a-1.,jprf,ee-sn,&dlout,&sdlout);
3631 djprf = gausshaz(1,dlout,sdlout);
3632 if(IDjprf==1) djprf = 0.0;
3633 jprfn = jprf + djprf;
3634 jprfn = dint(std::abs(jprfn)); // The nucleus just turns the other way around
3635 }
3636 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3637 defbet = ecld->beta2[ind][izd];
3638
3639 iinert = 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);
3640 erotn = jprfn * jprfn * 197.328 * 197.328 /(2. * iinert);
3641 bsbkbc(a-1.,zprf,&bs,&bk,&bc);
3642
3643 // level density and temperature in the neutron daughter
3644 densniv(a-1.0,zprf,ee,sn,&densn,bshell, bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfn,0,&qr);
3645 nt = temp;
3646 ecn=0.0;
3647 if(densn>0.){
3648 G4int IS=0;
3649 if(imaxwell == 1){
3650 rnt = nt;
3651 dir1234:
3652 ecn=fvmaxhaz_neut(rnt);
3653 IS++;
3654 if(IS>100){std::cout << "WARNING: FVMAXHAZ_NEUT CALLED MORE THAN 100 TIMES" << std::endl;
3655 goto exi1000;
3656 }
3657 if(ecn>(ee-sn)){
3658 if((ee-sn)<rnt)
3659 ecn = ee-sn;
3660 else
3661 goto dir1234;
3662 }
3663 if(ecn<=0.0) goto dir1234;
3664 }else{
3665 ecn = 2.0 * nt;
3666 }
3667 }
3668 }
3669 else {
3670 densn = 0.0;
3671 ecn = 0.0;
3672 nt = 0.0;
3673 }
3674 exi1000:
3675
3676// LEVEL DENSITY AND TEMPERATURE IN THE PROTON DAUGHTER
3677//
3678// Reduction of angular momentum due to orbital angular momentum of emitted fragment
3679 if (iz >= 2) {
3680 ind=idnint(a)-idnint(zprf);
3681 izd=idnint(zprf)-1;
3682 if(jprf>0.10){
3683 lorb(a,a-1.,jprf,ee-sbp,&dlout,&sdlout);
3684 djprf = gausshaz(1,dlout,sdlout);
3685 if(IDjprf==1) djprf = 0.0;
3686 jprfp = jprf + djprf;
3687 jprfp = dint(std::abs(jprfp)); // The nucleus just turns the other way around
3688 }
3689 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3690 defbet =ecld->beta2[ind][izd];
3691
3692 iinert = 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);
3693 erotp = jprfp * jprfp * 197.328 * 197.328 /(2. * iinert);
3694
3695 bsbkbc(a-1.,zprf-1.,&bs,&bk,&bc);
3696
3697 // level density and temperature in the proton daughter
3698 densniv(a-1.0,zprf-1.0,ee,sbp,&densp,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfp,0,&qr);
3699 pt = temp;
3700 ecp = 0.;
3701 if(densp>0.){
3702 G4int IS=0;
3703 if(imaxwell == 1){
3704 rpt = pt;
3705 dir1235:
3706 ecp=fvmaxhaz(rpt);
3707 IS++;
3708 if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3709 goto exi1001;
3710 }
3711 if(ecp>(ee-sbp)){
3712 if((ee-sbp)<rpt)
3713 ecp = ee-sbp;
3714 else
3715 goto dir1235;
3716 }
3717 if(ecp<=0.0) goto dir1235;
3718 ecp = ecp + bp;
3719 }else{
3720 ecp = 2.0 * pt + bp;
3721 }
3722 }
3723 }
3724 else {
3725 densp = 0.0;
3726 ecp = 0.0;
3727 pt = 0.0;
3728 }
3729 exi1001:
3730
3731// FINAL LEVEL DENSITY AND TEMPERATURE AFTER DEUTERON EMISSION
3732//
3733// Reduction of angular momentum due to orbital angular momentum of emitted fragment
3734 if ((in >= 2) && (iz >= 2)) {
3735 ind=idnint(a)-idnint(zprf)-1;
3736 izd=idnint(zprf)-1;
3737 if(jprf>0.10){
3738 lorb(a,a-2.,jprf,ee-sbd,&dlout,&sdlout);
3739 djprf = gausshaz(1,dlout,sdlout);
3740 if(IDjprf==1) djprf = 0.0;
3741 jprfd = jprf + djprf;
3742 jprfd = dint(std::abs(jprfd)); // The nucleus just turns the other way around
3743 }
3744 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3745 defbet = ecld->beta2[ind][izd];
3746
3747 iinert = 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);
3748 erotd = jprfd * jprfd * 197.328 * 197.328 /(2. * iinert);
3749
3750 bsbkbc(a-2.,zprf-1.,&bs,&bk,&bc);
3751
3752 // level density and temperature in the deuteron daughter
3753 densniv(a-2.0,zprf-1.0e0,ee,sbd,&densd,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfd,0,&qr);
3754
3755 dt = temp;
3756 ecd = 0.0;
3757 if(densd>0.){
3758 G4int IS=0;
3759 if(imaxwell == 1){
3760 rdt = dt;
3761 dir1236:
3762 ecd=fvmaxhaz(rdt);
3763 IS++;
3764 if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3765 goto exi1002;
3766 }
3767 if(ecd>(ee-sbd)){
3768 if((ee-sbd)<rdt)
3769 ecd = ee-sbd;
3770 else
3771 goto dir1236;
3772 }
3773 if(ecd<=0.0) goto dir1236;
3774 ecd = ecd + bd;
3775 }else{
3776 ecd = 2.0 * dt + bd;
3777 }
3778 }
3779 }
3780 else {
3781 densd = 0.0;
3782 ecd = 0.0;
3783 dt = 0.0;
3784 }
3785 exi1002:
3786
3787// FINAL LEVEL DENSITY AND TEMPERATURE AFTER TRITON EMISSION
3788//
3789// Reduction of angular momentum due to orbital angular momentum of emitted fragment
3790 if ((in >= 3) && (iz >= 2)) {
3791 ind=idnint(a)-idnint(zprf)-2;
3792 izd=idnint(zprf)-1;
3793 if(jprf>0.10){
3794 lorb(a,a-3.,jprf,ee-sbt,&dlout,&sdlout);
3795 djprf = gausshaz(1,dlout,sdlout);
3796 if(IDjprf==1) djprf = 0.0;
3797 jprft = jprf + djprf;
3798 jprft = dint(std::abs(jprft)); // The nucleus just turns the other way around
3799 }
3800 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3801 defbet = ecld->beta2[ind][izd];
3802
3803 iinert = 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);
3804 erott = jprft * jprft * 197.328 * 197.328 /(2. * iinert);
3805
3806 bsbkbc(a-3.,zprf-1.,&bs,&bk,&bc);
3807
3808 // level density and temperature in the triton daughter
3809 densniv(a-3.0,zprf-1.0,ee,sbt,&denst,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprft,0,&qr);
3810
3811 tt = temp;
3812 ect=0.;
3813 if(denst>0.){
3814 G4int IS=0;
3815 if(imaxwell == 1){
3816 rtt = tt;
3817 dir1237:
3818 ect=fvmaxhaz(rtt);
3819 IS++;
3820 if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3821 goto exi1003;
3822 }
3823 if(ect>(ee-sbt)){
3824 if((ee-sbt)<rtt)
3825 ect = ee-sbt;
3826 else
3827 goto dir1237;
3828 }
3829 if(ect<=0.0) goto dir1237;
3830 ect = ect + bt;
3831 }else{
3832 ect = 2.0 * tt + bt;
3833 }
3834 }
3835 }
3836 else {
3837 denst = 0.0;
3838 ect = 0.0;
3839 tt = 0.0;
3840 }
3841 exi1003:
3842
3843// LEVEL DENSITY AND TEMPERATURE IN THE ALPHA DAUGHTER
3844//
3845// Reduction of angular momentum due to orbital angular momentum of emitted fragment
3846 if ((in >= 3) && (iz >= 3)) {
3847 ind=idnint(a)-idnint(zprf)-2;
3848 izd=idnint(zprf)-2;
3849 if(jprf>0.10){
3850 lorb(a,a-4.,jprf,ee-sba,&dlout,&sdlout);
3851 djprf = gausshaz(1,dlout,sdlout);
3852 if(IDjprf==1) djprf = 0.0;
3853 jprfa = jprf + djprf;
3854 jprfa = dint(std::abs(jprfa)); // The nucleus just turns the other way around
3855 }
3856 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3857 defbet = ecld->beta2[ind][izd];
3858
3859 iinert = 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);
3860 erota = jprfa * jprfa * 197.328 * 197.328 /(2. * iinert);
3861
3862 bsbkbc(a-4.,zprf-2.,&bs,&bk,&bc);
3863
3864 // level density and temperature in the alpha daughter
3865 densniv(a-4.0,zprf-2.0,ee,sba,&densa,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfa,0,&qr);
3866
3867 at = temp;
3868 eca = 0.0;
3869 if(densa>0.){
3870 G4int IS=0;
3871 if(imaxwell == 1){
3872 rat = at;
3873 dir1238:
3874 eca=fvmaxhaz(rat);
3875 IS++;
3876 if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3877 goto exi1004;
3878 }
3879 if(eca>(ee-sba)){
3880 if((ee-sba)<rat)
3881 eca = ee-sba;
3882 else
3883 goto dir1238;
3884 }
3885 if(eca<=0.0) goto dir1238;
3886 eca = eca + ba;
3887 }else{
3888 eca = 2.0 * at + ba;
3889 }
3890 }
3891 }
3892 else {
3893 densa = 0.0;
3894 eca = 0.0;
3895 at = 0.0;
3896 }
3897 exi1004:
3898
3899// FINAL LEVEL DENSITY AND TEMPERATURE AFTER 3HE EMISSION
3900//
3901// Reduction of angular momentum due to orbital angular momentum of emitted fragment
3902 if ((in >= 2) && (iz >= 3)) {
3903 ind=idnint(a)-idnint(zprf)-1;
3904 izd=idnint(zprf)-2;
3905 if(jprf>0.10){
3906 lorb(a,a-3.,jprf,ee-sbhe,&dlout,&sdlout);
3907 djprf = gausshaz(1,dlout,sdlout);
3908 if(IDjprf==1) djprf = 0.0;
3909 jprfhe = jprf + djprf;
3910 jprfhe = dint(std::abs(jprfhe)); // The nucleus just turns the other way around
3911 }
3912 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3913 defbet = ecld->beta2[ind][izd];
3914
3915 iinert = 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);
3916 erothe = jprfhe * jprfhe * 197.328 * 197.328 /(2. * iinert);
3917
3918 bsbkbc(a-3.,zprf-2.,&bs,&bk,&bc);
3919
3920 // level density and temperature in the he3 daughter
3921 densniv(a-3.0,zprf-2.0,ee,sbhe,&denshe,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfhe,0,&qr);
3922
3923 het = temp;
3924 eche = 0.0;
3925 if(denshe>0.){
3926 G4int IS=0;
3927 if(imaxwell == 1){
3928 rhet = het;
3929 dir1239:
3930 eche=fvmaxhaz(rhet);
3931 IS++;
3932 if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3933 goto exi1005;
3934 }
3935 if(eche>(ee-sbhe)){
3936 if((ee-sbhe)<rhet)
3937 eche = ee-sbhe;
3938 else
3939 goto dir1239;
3940 }
3941 if(eche<=0.0) goto dir1239;
3942 eche = eche + bhe;
3943 }else{
3944 eche = 2.0 * het + bhe;
3945 }
3946 }
3947 }
3948 else {
3949 denshe = 0.0;
3950 eche = 0.0;
3951 het = 0.0;
3952 }
3953 exi1005:
3954
3955// LEVEL DENSITY AND TEMPERATURE IN THE LAMBDA0 DAUGHTER
3956//
3957// - Reduction of angular momentum due to orbital angular momentum of emitted fragment
3958// JLRS Jun-2017 - Added these caculations in abla++
3959
3960 if (in >= 2 && NbLam0>0) {
3961 ind=idnint(a)-idnint(zprf)-1;
3962 izd=idnint(zprf);
3963 if(jprf>0.10){
3964 lorb(a,a-1.,jprf,ee-slamb0,&dlout,&sdlout);
3965 djprf = gausshaz(1,dlout,sdlout);
3966 if(IDjprf==1) djprf = 0.0;
3967 jprflamb0 = jprf + djprf;
3968 jprflamb0 = dint(std::abs(jprflamb0)); // The nucleus just turns the other way around
3969 }
3970 bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3971 defbet = ecld->beta2[ind][izd];
3972
3973 iinert = 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);
3974 erotlamb0 = jprflamb0 * jprflamb0 * 197.328 * 197.328 /(2. * iinert);
3975 bsbkbc(a-1.,zprf,&bs,&bk,&bc);
3976
3977 // level density and temperature in the neutron daughter
3978 densniv(a-1.0,zprf,ee,slamb0,&denslamb0,bshell, bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprflamb0,0,&qr);
3979 lamb0t = temp;
3980 eclamb0=0.0;
3981 if(denslamb0>0.){
3982 G4int IS=0;
3983 if(imaxwell == 1){
3984 rlamb0t = lamb0t;
3985 dir1240:
3986 eclamb0=fvmaxhaz_neut(rlamb0t);
3987 IS++;
3988 if(IS>100){std::cout << "WARNING: FVMAXHAZ_NEUT CALLED MORE THAN 100 TIMES" << std::endl;
3989 goto exi1006;
3990 }
3991 if(eclamb0>(ee-slamb0)){
3992 if((ee-slamb0)<rlamb0t)
3993 eclamb0 = ee-slamb0;
3994 else
3995 goto dir1240;
3996 }
3997 if(eclamb0<=0.0) goto dir1240;
3998 }else{
3999 eclamb0 = 2.0 * lamb0t;
4000 }
4001 }
4002 }
4003 else {
4004 denslamb0 = 0.0;
4005 eclamb0 = 0.0;
4006 lamb0t = 0.0;
4007 }
4008 exi1006:
4009
4010
4011
4012// Decay widths for particles
4013 if ( densg > 0.) {
4014//
4015// CALCULATION OF THE PARTIAL DECAY WIDTH
4016// USED FOR BOTH THE TIME SCALE AND THE EVAPORATION DECAY WIDTH
4017//
4018// AKAP = HBAR**2/(2* MN * R_0**2) = 10 MEV *** input param ***
4019//
4020// AK, KHS 2005 - Energy-dependen inverse cross sections included, influence of
4021// Coulomb barrier for LCP, tunnelling for LCP
4022// JLRS 2017 - Implementation in abla++
4023
4024 if(densn<=0.0){
4025 gn = 0.0;
4026 }else{
4027 gn = width(a,zprf,1.0,0.0,nt,0.0,sn,ee-erotn)* densn/densg;
4028 }
4029 if(densp<=0.0){
4030 gp = 0.0;
4031 }else{
4032 gp = width(a,zprf,1.0,1.0,pt,bp,sbp,ee-erotp)*densp/densg* pen(a, 1.0, omegap, pt);
4033 }
4034 if(densd<=0.0){
4035 gd = 0.0;
4036 }else{
4037 gd = width(a,zprf,2.0,1.0,dt,bd,sbd,ee-erotd)*densd/densg* pen(a, 2.0, omegad, dt);
4038 }
4039 if(denst<=0.0){
4040 gt = 0.0;
4041 }else{
4042 gt = width(a,zprf,3.0,1.0,tt,bt,sbt,ee-erott)*denst/densg* pen(a, 3.0, omegat, tt);
4043 }
4044 if(denshe<=0.0){
4045 ghe = 0.0;
4046 }else{
4047 ghe =width(a,zprf,3.0,2.0,het,bhe,sbhe,ee-erothe) * denshe/densg* pen(a, 3.0, omegahe, het);
4048 }
4049 if(densa<=0.0){
4050 ga = 0.0;
4051 }else{
4052 ga = width(a,zprf,4.0,2.0,at,ba,sba,ee-erota) * densa/densg* pen(a, 4.0, omegaa, at);
4053 }
4054 if(denslamb0<=0.0){
4055 glamb0 = 0.0;
4056 }else{
4057 glamb0 = width(a,zprf,1.0,-2.0,lamb0t,0.0,slamb0,ee-erotlamb0)* denslamb0/densg;
4058 }
4059
4060// **************************
4061// * Treatment of IMFs *
4062// * KHS, AK, MVR 2005-2006 *
4063// **************************
4064
4065 G4int izcn=0,incn=0,inmin=0,inmax=0,inmi=0,inma=0;
4066 G4double aimf,mares,maimf;
4067
4068 if(fimf_allowed==0 || zprf<=5.0 || a<=7.0){
4069 gimf = 0.0;
4070 }else{
4071// Estimate the total decay width for IMFs (Z >= 3)
4072// By using the logarithmic slope between GIMF3 and GIMF5
4073
4074 mglms(a,zprf,opt->optshpimf,&mazz);
4075
4076 gimf3 = 0.0;
4077 zimf = 3.0;
4078 izimf = 3;
4079// *** Find the limits that both IMF and partner are bound :
4080 izcn = idnint(zprf); // Z of CN
4081 incn = idnint(a) - izcn; // N of CN
4082
4083 isostab_lim(izimf,&inmin,&inmax); // Bound isotopes for IZIMF from INMIN to INIMFMA
4084 isostab_lim(izcn-izimf,&inmi,&inma); // Daughter nucleus after IMF emission,
4085 // limits of bound isotopes
4086 inmin = max(inmin,incn-inma); // Both IMF and daughter must be bound
4087 inmax = min(inmax,incn-inmi); // "
4088
4089 inmax = max(inmax,inmin); // In order to keep the variables below
4090
4091 for(G4int iaimf=izimf+inmin;iaimf<=izimf+inmax;iaimf++){
4092 aimf=G4double(iaimf);
4093 if(aimf>=a || zimf>=zprf){
4094 width_imf = 0.0;
4095 }else{
4096 // Q-values
4097 mglms(a-aimf,zprf-zimf,opt->optshpimf,&mares);
4098 mglms(aimf,zimf,opt->optshpimf,&maimf);
4099 // Bass barrier
4100 barrs(idnint(zprf-zimf),idnint(a-aimf),izimf,idnint(aimf),&bimf,&omegaimf);
4101 sbimf = maimf+mares-mazz+bimf+getdeltabinding(a,NbLam0);
4102 // Rotation energy
4103 defbetimf = ecld->beta2[idnint(aimf-zimf)][idnint(zimf)]+ecld->beta2[idnint(a-aimf-zprf+zimf)][idnint(zprf-zimf)];
4104
4105 iinert= 0.40 * 931.490 * 1.160*1.160 * std::pow(a,5.0/3.0)*(std::pow(aimf,5.0/3.0) + std::pow(a - aimf,5.0/3.0)) + 931.490 * 1.160*1.160 * aimf * (a-aimf) / a *(std::pow(aimf,1.0/3.0) + std::pow(a - aimf,1.0/3.0))*(std::pow(aimf,1.0/3.0) + std::pow(a - aimf,1.0/3.0));
4106
4107 erot = jprf * jprf * 197.328 * 197.328 /(2.0 * iinert);
4108
4109 // Width
4110 if(densg==0.0 || ee < (sbimf + erot)){
4111 width_imf = 0.0;
4112 }else{
4113 // To take into account that at the barrier the system is deformed:
4114 // BSIMF = ((A-AIMF)**(2.D0/3.D0) + AIMF**(2.D0/3.D0))/A**(2.D0/3.D0)
4115 bsimf = bscn;
4116 densniv(a,zprf,ee,sbimf,&densimf,0.0,bsimf,1.0,&timf,0,0,defbetimf,&ecor,jprf,2,&qr);
4117
4118 imfarg = (sbimf+erotcn-erot)/timf;
4119 if(imfarg > 200.0) imfarg = 200.0;
4120
4121// For IMF - The available phase space is given by the level densities in CN at the
4122// barrier; applaying MOrretto -> G=WIDTH*ro_CN(E-SBIMF)/ro_CN(E).
4123// Constant temperature approximation: ro(E+dE)/ro(E)=exp(dE/T)
4124// Ratio DENSIMF/DENSCN is included to take into account that at the barrier system
4125// is deformed. If (above) BSIMF = 1 no deformation is considered and this ratio
4126// is equal to 1.
4127 width_imf = 0.0;
4128 //
4129 width_imf = width(a,zprf,aimf,zimf,timf,bimf,sbimf,ee-erot)*std::exp(-imfarg)*qr/qrcn;
4130 }// if densg
4131 }// if aimf
4132 gimf3 = gimf3 + width_imf;
4133 }// for IAIMF
4134
4135// zimf = 5
4136 gimf5 = 0.0;
4137 zimf = 5.0;
4138 izimf = 5;
4139// *** Find the limits that both IMF and partner are bound :
4140 izcn = idnint(zprf); // Z of CN
4141 incn = idnint(a) - izcn; // N of CN
4142
4143 isostab_lim(izimf,&inmin,&inmax); // Bound isotopes for IZIMF from INMIN to INIMFMA
4144 isostab_lim(izcn-izimf,&inmi,&inma); // Daughter nucleus after IMF emission,
4145 // limits of bound isotopes
4146 inmin = max(inmin,incn-inma); // Both IMF and daughter must be bound
4147 inmax = min(inmax,incn-inmi); // "
4148
4149 inmax = max(inmax,inmin); // In order to keep the variables below
4150
4151 for(G4int iaimf=izimf+inmin;iaimf<=izimf+inmax;iaimf++){
4152 aimf=G4double(iaimf);
4153 if(aimf>=a || zimf>=zprf){
4154 width_imf = 0.0;
4155 }else{
4156 // Q-values
4157 mglms(a-aimf,zprf-zimf,opt->optshpimf,&mares);
4158 mglms(aimf,zimf,opt->optshpimf,&maimf);
4159 // Bass barrier
4160 barrs(idnint(zprf-zimf),idnint(a-aimf),izimf,idnint(aimf),&bimf,&omegaimf);
4161 sbimf = maimf+mares-mazz+bimf+getdeltabinding(a,NbLam0);
4162 // Rotation energy
4163 defbetimf = ecld->beta2[idnint(aimf-zimf)][idnint(zimf)]+ecld->beta2[idnint(a-aimf-zprf+zimf)][idnint(zprf-zimf)];
4164
4165 iinert= 0.40 * 931.490 * 1.160*1.160 * std::pow(a,5.0/3.0)*(std::pow(aimf,5.0/3.0) + std::pow(a - aimf,5.0/3.0)) + 931.490 * 1.160*1.160 * aimf * (a-aimf) / a *(std::pow(aimf,1.0/3.0) + std::pow(a - aimf,1.0/3.0))*(std::pow(aimf,1.0/3.0) + std::pow(a - aimf,1.0/3.0));
4166
4167 erot = jprf * jprf * 197.328 * 197.328 /(2.0 * iinert);
4168//
4169 // Width
4170 if(densg==0.0 || ee < (sbimf + erot)){
4171 width_imf = 0.0;
4172 }else{
4173 // To take into account that at the barrier the system is deformed:
4174 // BSIMF = ((A-AIMF)**(2.D0/3.D0) + AIMF**(2.D0/3.D0))/A**(2.D0/3.D0)
4175 bsimf = bscn;
4176 densniv(a,zprf,ee,sbimf,&densimf,0.0,bsimf,1.0,&timf,0,0,defbetimf,&ecor,jprf,2,&qr);
4177//
4178 imfarg = (sbimf+erotcn-erot)/timf;
4179 if(imfarg > 200.0) imfarg = 200.0;
4180//
4181// For IMF - The available phase space is given by the level densities in CN at the
4182// barrier; applaying MOrretto -> G=WIDTH*ro_CN(E-SBIMF)/ro_CN(E).
4183// Constant temperature approximation: ro(E+dE)/ro(E)=exp(dE/T)
4184// Ratio DENSIMF/DENSCN is included to take into account that at the barrier system
4185// is deformed. If (above) BSIMF = 1 no deformation is considered and this ratio
4186// is equal to 1.
4187 width_imf = 0.0;
4188 width_imf = width(a,zprf,aimf,zimf,timf,bimf,sbimf,ee-erot)*std::exp(-imfarg)*qr/qrcn;//*densimf/densg;
4189 }// if densg
4190 }// if aimf
4191 gimf5 = gimf5 + width_imf;
4192 }// for IAIMF
4193// It is assumed that GIMFi = A_IMF*ZIMF**B_IMF; to get the total GIMF one integrates
4194// Int(A_IMF*ZIMF**B_IMF)(3->ZPRF)
4195
4196 if(gimf3<=0.0 || gimf5<=0.0){
4197 gimf = 0.0;
4198 b_imf = -100.0;
4199 a_imf = 0.0;
4200 }else{
4201//
4202 b_imf = (std::log10(gimf3) - std::log10(gimf5))/(std::log10(3.0)-std::log10(5.0));
4203//
4204 if(b_imf >= -1.01) b_imf = -1.01;
4205 if(b_imf <= -100.0) {
4206 b_imf = -100.0;
4207 a_imf = 0.0;
4208 gimf = 0.0;
4209 goto direct2007;
4210 }
4211//
4212 a_imf = gimf3 / std::pow(3.0,b_imf);
4213 gimf = a_imf * ( std::pow(zprf,b_imf+1.0) - std::pow(3.0,b_imf+1.0)) /(b_imf + 1.0);
4214 }
4215
4216 direct2007:
4217 if(gimf < 1.e-10) gimf = 0.0;
4218 }// if fimf_allowed
4219//
4220//c JLRS 2016 - Added this calculation
4221//C AK 2004 - Gamma width
4222//C According to A. Ignatyuk, GG :
4223//C Here BS=BK=1, as this was assumed in the parameterization
4224 pa = (ald->av)*a + (ald->as)*std::pow(a,2./3.) + (ald->ak)*std::pow(a,1./3.);
4225 gamma = 2.5 * pa * std::pow(a,-4./3.);
4226 gfactor = 1.+gamma*ecld->ecgnz[in][iz];
4227 if(gfactor<=0.){
4228 gfactor = 0.0;
4229 }
4230//
4231 gtemp = 17.60/(std::pow(a,0.699) * std::sqrt(gfactor));
4232//
4233//C If one switches gammas off, one should also switch off tunneling through the fission barrier.
4234 gg = 0.624e-9*std::pow(a,1.6)*std::pow(gtemp,5.);
4235//gammaemission==1
4236//C For fission fragments, GG is ~ 2 times larger than for
4237//c "oridnary" nuclei (A. Ignatyuk, private communication).
4238 if(gammaemission==1){
4239 gg = 2.0 * gg;
4240 }
4241 ecg = 4.0 * gtemp;
4242//
4243//
4244 gsum = ga + ghe + gd + gt + gp + gn + gimf + gg + glamb0;
4245
4246 //std::cout << gn << " " << gd << " " << gp << std::endl;
4247
4248 if (gsum > 0.0) {
4249 ts1 = hbar / gsum;
4250 }
4251 else {
4252 ts1 = 1.0e99;
4253 goto direct69;
4254 }
4255//
4256//Case of nuclei below Businaro-Gallone mass asymmetry point
4257 if(fiss->ifis==0 || (zprf*zprf/a<=22.74 && zprf<60.)){
4258 goto direct69;
4259 }
4260//
4261// Calculation of the fission decay width
4262// Deformation is calculated using the fissility
4263//
4264 defbet = y;
4265 fission_width(zprf,a,ee,bssp,bksp,ef,y,&gf,&temp,jprf,0,1,fiss->optcol,fiss->optshp,densg);
4266 ft=temp;
4267//
4268// Case of very heavy nuclei that have no fission barrier
4269// For them fission is the only decay channel available
4270 if(ef<=0.0){
4271 probf = 1.0;
4272 probp = 0.0;
4273 probd = 0.0;
4274 probt = 0.0;
4275 probn = 0.0;
4276 probhe = 0.0;
4277 proba = 0.0;
4278 probg = 0.0;
4279 probimf = 0.0;
4280 problamb0 = 0.0;
4281 goto direct70;
4282 }
4283
4284 if(fiss->bet<=0.){
4285 gtotal = ga + ghe + gp + gd + gt + gn + gg +gimf + gf + glamb0;
4286 if(gtotal<=0.0){
4287 probf = 0.0;
4288 probp = 0.0;
4289 probd = 0.0;
4290 probt = 0.0;
4291 probn = 0.0;
4292 probhe = 0.0;
4293 proba = 0.0;
4294 probg = 0.0;
4295 probimf = 0.0;
4296 problamb0 = 0.0;
4297 goto direct70;
4298 }else{
4299 probf = gf/gtotal;
4300 probn = gn/gtotal;
4301 probp = gp/gtotal;
4302 probd = gd/gtotal;
4303 probt = gt/gtotal;
4304 probhe = ghe/gtotal;
4305 proba = ga/gtotal;
4306 probg = gg/gtotal;
4307 probimf = gimf/gtotal;
4308 problamb0 = glamb0/gtotal;
4309 goto direct70;
4310 }
4311 }
4312 }else{
4313 goto direct69;
4314 }
4315//
4316 if (inum > ilast) { // new event means reset the time scale
4317 tsum = 0.;
4318 }
4319//
4320// kramers factor for the dynamical hindrances of fission
4321 fomega_sp(a,y,&mfcd,&omegasp,&homegasp);
4322 cf = cram(fiss->bet,homegasp);
4323//
4324// We calculate the transient time
4325 fomega_gs(a,zprf,&k1,&omegags,&homegags);
4326 tauc=tau(fiss->bet,homegags,ef,ft);
4327 gf=gf*cf;
4328//
4329/*
4330c The subroutine part_fiss calculates the fission width GFF that corresponds to the time
4331c dependence of the probability distribution obtained by solving the FOKKER-PLANCK eq
4332c using a nucleus potential that is approximated by a parabola. It also gives the
4333c decay time for this step T_LAPSE that includes all particle decay channels and the
4334c fission channel. And it decides whether the nucleus decays by particle evaporation
4335c CHOICE_FISSPART = 1 or fission CHOICE_FISSPART = 2
4336*/
4337//
4338 part_fiss(fiss->bet,gsum,gf,y,tauc,ts1,tsum, &choice_fisspart,zprf,a,ft,&t_lapse,&gff);
4339 gf = gff;
4340//
4341// We accumulate in TSUM the mean decay for this step including all particle decay channels and fission
4342 tsum = tsum + t_lapse;
4343
4344// If fission occurs
4345 if(choice_fisspart==2){
4346 probf = 1.0;
4347 probp = 0.0;
4348 probd = 0.0;
4349 probt = 0.0;
4350 probn = 0.0;
4351 probhe = 0.0;
4352 proba = 0.0;
4353 probg = 0.0;
4354 probimf = 0.0;
4355 problamb0 = 0.0;
4356 goto direct70;
4357 }else{
4358// If particle evaporation occurs
4359// The probabilities for the different decays are calculated taking into account the fission width GFF that corresponds to this step
4360
4361 gtotal=ga + ghe + gp + gd + gt + gn + gimf + gg + glamb0;
4362 if(gtotal<=0.0){
4363 probf = 0.0;
4364 probp = 0.0;
4365 probd = 0.0;
4366 probt = 0.0;
4367 probn = 0.0;
4368 probhe = 0.0;
4369 proba = 0.0;
4370 probg = 0.0;
4371 probimf = 0.0;
4372 problamb0 = 0.0;
4373 goto direct70;
4374 }else{
4375 probf = 0.0;
4376 probn = gn/gtotal;
4377 probp = gp/gtotal;
4378 probd = gd/gtotal;
4379 probt = gt/gtotal;
4380 probhe = ghe/gtotal;
4381 proba = ga/gtotal;
4382 probg = gg/gtotal;
4383 probimf = gimf/gtotal;
4384 problamb0 = glamb0/gtotal;
4385 goto direct70;
4386 }
4387 }
4388//
4389 direct69:
4390 gtotal = ga + ghe + gp + gd + gt + gn + gg + gimf + glamb0;
4391 if(gtotal<=0.0){
4392 probf = 0.0;
4393 probp = 0.0;
4394 probd = 0.0;
4395 probt = 0.0;
4396 probn = 0.0;
4397 probhe = 0.0;
4398 proba = 0.0;
4399 probg = 0.0;
4400 probimf = 0.0;
4401 problamb0 = 0.0;
4402 }else{
4403 probf = 0.0;
4404 probn = gn/gtotal;
4405 probp = gp/gtotal;
4406 probd = gd/gtotal;
4407 probt = gt/gtotal;
4408 probhe = ghe/gtotal;
4409 proba = ga/gtotal;
4410 probg = gg/gtotal;
4411 probimf = gimf/gtotal;
4412 problamb0 = glamb0/gtotal;
4413 }
4414
4415 direct70:
4416 ptotl = probp+probd+probt+probn+probhe+proba+probg+probimf+probf+problamb0;
4417 //
4418 ee = eer;
4419 ilast = inum;
4420
4421 // Return values:
4422 (*probp_par) = probp;
4423 (*probd_par) = probd;
4424 (*probt_par) = probt;
4425 (*probn_par) = probn;
4426 (*probhe_par) = probhe;
4427 (*proba_par) = proba;
4428 (*probg_par) = probg;
4429 (*probimf_par) = probimf;
4430 (*problamb0_par) = problamb0;
4431 (*probf_par) = probf;
4432 (*ptotl_par) = ptotl;
4433 (*sn_par) = sn;
4434 (*sp_par) = sp;
4435 (*sd_par) = sd;
4436 (*st_par) = st;
4437 (*she_par) = she;
4438 (*sa_par) = sa;
4439 (*slamb0_par) = slamb0;
4440 (*sbp_par) = sbp;
4441 (*sbd_par) = sbd;
4442 (*sbt_par) = sbt;
4443 (*sbhe_par) = sbhe;
4444 (*sba_par) = sba;
4445 (*ecn_par) = ecn;
4446 (*ecp_par) = ecp;
4447 (*ecd_par) = ecd;
4448 (*ect_par) = ect;
4449 (*eche_par) = eche;
4450 (*eca_par) = eca;
4451 (*ecg_par) = ecg;
4452 (*eclamb0_par) = eclamb0;
4453 (*bp_par) = bp;
4454 (*bd_par) = bd;
4455 (*bt_par) = bt;
4456 (*bhe_par) = bhe;
4457 (*ba_par) = ba;
4458 (*tcn) = ftcn;
4459 (*ts1_par) = ts1;
4460 (*jprfn_par) = jprfn;
4461 (*jprfp_par) = jprfp;
4462 (*jprfd_par) = jprfd;
4463 (*jprft_par) = jprft;
4464 (*jprfhe_par) = jprfhe;
4465 (*jprfa_par) = jprfa;
4466 (*jprflamb0_par) = jprflamb0;
4467 (*tsum_par) = tsum;
4468 return;
4469}
4470
4471void G4Abla::densniv(G4double a, G4double z, G4double ee, G4double esous, G4double *dens, G4double bshell, G4double bsin, G4double bkin, G4double *temp, G4int optshp, G4int optcol, G4double defbet, G4double *ecor, G4double jprf, G4int ifis,G4double *qr)
4472{
4473 // 1498 C
4474 // 1499 C INPUT:
4475 // 1500 C A,EE,ESOUS,OPTSHP,BS,BK,BSHELL,DEFBET
4476 // 1501 C
4477 // 1502 C LEVEL DENSITY PARAMETERS
4478 // 1503 C COMMON /ALD/ AV,AS,AK,OPTAFAN
4479 // 1504 C AV,AS,AK - VOLUME,SURFACE,CURVATURE DEPENDENCE OF THE
4480 // 1505 C LEVEL DENSITY PARAMETER
4481 // 1506 C OPTAFAN - 0/1 AF/AN >=1 OR AF/AN ==1
4482 // 1507 C RECOMMENDED IS OPTAFAN = 0
4483 // 1508 C---------------------------------------------------------------------
4484 // 1509 C OUTPUT: DENS,TEMP
4485 // 1510 C
4486 // 1511 C ____________________________________________________________________
4487 // 1512 C /
4488 // 1513 C / PROCEDURE FOR CALCULATING THE STATE DENSITY OF A COMPOUND NUCLEUS
4489 // 1514 C /____________________________________________________________________
4490 // 1515 C
4491 // 1516 INTEGER AFP,IZ,OPTSHP,OPTCOL,J,OPTAFAN
4492 // 1517 REAL*8 A,EE,ESOUS,DENS,E,Y0,Y1,Y2,Y01,Y11,Y21,PA,BS,BK,TEMP
4493 // 1518 C=====INSERTED BY KUDYAEV===============================================
4494 // 1519 COMMON /ALD/ AV,AS,AK,OPTAFAN
4495 // 1520 REAL*8 ECR,ER,DELTAU,Z,DELTPP,PARA,PARZ,FE,HE,ECOR,ECOR1,Pi6
4496 // 1521 REAL*8 BSHELL,DELTA0,AV,AK,AS,PONNIV,PONFE,DEFBET,QR,SIG,FP
4497 // 1522 C=======================================================================
4498 // 1523 C
4499 // 1524 C
4500 // 1525 C-----------------------------------------------------------------------
4501 // 1526 C A MASS NUMBER OF THE DAUGHTER NUCLEUS
4502 // 1527 C EE EXCITATION ENERGY OF THE MOTHER NUCLEUS
4503 // 1528 C ESOUS SEPARATION ENERGY PLUS EFFECTIVE COULOMB BARRIER
4504 // 1529 C DENS STATE DENSITY OF DAUGHTER NUCLEUS AT EE-ESOUS-EC
4505 // 1530 C BSHELL SHELL CORRECTION
4506 // 1531 C TEMP NUCLEAR TEMPERATURE
4507 // 1532 C E LOCAL EXCITATION ENERGY OF THE DAUGHTER NUCLEUS
4508 // 1533 C E1 LOCAL HELP VARIABLE
4509 // 1534 C Y0,Y1,Y2,Y01,Y11,Y21
4510 // 1535 C LOCAL HELP VARIABLES
4511 // 1536 C PA LOCAL STATE-DENSITY PARAMETER
4512 // 1537 C EC KINETIC ENERGY OF EMITTED PARTICLE WITHOUT
4513 // 1538 C COULOMB REPULSION
4514 // 1539 C IDEN FAKTOR FOR SUBSTRACTING KINETIC ENERGY IDEN*TEMP
4515 // 1540 C DELTA0 PAIRING GAP 12 FOR GROUND STATE
4516 // 1541 C 14 FOR SADDLE POINT
4517 // 1542 C EITERA HELP VARIABLE FOR TEMPERATURE ITERATION
4518 // 1543 C-----------------------------------------------------------------------
4519 // 1544 C
4520 // 1545 C
4521 G4double delta0 = 0.0;
4522 G4double deltau = 0.0;
4523 G4double deltpp = 0.0;
4524 G4double e = 0.0;
4525 G4double e0 = 0.0;
4526 G4double ecor1 = 0.0;
4527 G4double ecr = 10.0;
4528 G4double fe = 0.0;
4529 G4double he = 0.0;
4530 G4double pa = 0.0;
4531 G4double para = 0.0;
4532 G4double parz = 0.0;
4533 G4double ponfe = 0.0;
4534 G4double ponniv = 0.0;
4535 G4double fqr = 1.0;
4536 G4double y01 = 0.0;
4537 G4double y11 = 0.0;
4538 G4double y2 = 0.0;
4539 G4double y21 = 0.0;
4540 G4double y1 = 0.0;
4541 G4double y0 = 0.0;
4542 G4double fnorm=0.0;
4543 G4double fp_per=0.;
4544 G4double fp_par=0.;
4545 G4double sig_per=0.;
4546 G4double sig_par=0.;
4547 G4double sigma2;
4548 G4double jfact=1.;
4549 G4double erot=0.;
4550 G4double fdens=0.;
4551 G4double fecor=0.;
4552 G4double BSHELLCT=0.;
4553 G4double gamma=0.;
4554 G4double ftemp=0.0;
4555 G4double tempct=0.0;
4556 G4double densfm = 0.0;
4557 G4double densct = 0.0;
4558 G4double ein=0.;
4559 G4double elim;
4560 G4double tfm;
4561 G4double bs=bsin;
4562 G4double bk=bkin;
4563 G4int IPARITE;
4564 G4int IOPTCT=fiss->optct;
4565//
4566 G4double pi6 = std::pow(3.1415926535,2) / 6.0;
4567 G4double pi = 3.1415926535;
4568//
4569 G4int afp=idnint(a);
4570 G4int iz=idnint(z);
4571 G4int in=afp-iz;
4572//
4573 if(ifis!=1){
4574 BSHELLCT = ecld->ecgnz[in][iz];
4575 }else{
4576 BSHELLCT = 0.0;
4577 }
4578 if(afp<=20) BSHELLCT = 0.0;
4579 //
4580 parite(a,&para);
4581 if (para < 0.0){
4582// Odd A
4583 IPARITE=1;
4584 }else{
4585// Even A
4586 parite(z,&parz);
4587 if(parz > 0.0){
4588// Even Z, even N
4589 IPARITE=2;
4590 }else{
4591// Odd Z, odd N
4592 IPARITE=0;
4593 }
4594 }
4595//
4596 ein = ee - esous;
4597//
4598 if(ein>1.e30){
4599 fdens = 0.0;
4600 ftemp = 0.5;
4601 goto densniv100;
4602 }
4603//
4604 e = ee - esous;
4605//
4606 if(e<0.0&&ifis!=1){ // TUNNELING
4607 fdens = 0.0;
4608 densfm = 0.0;
4609 densct = 0.0;
4610 if(ald->optafan == 1) {
4611 pa = (ald->av)*a + (ald->as)*std::pow(a,(2.e0/3.e0)) + (ald->ak)*std::pow(a,(1.e0/3.e0));
4612 }else {
4613 pa = (ald->av)*a + (ald->as)*bsin*std::pow(a,(2.e0/3.e0)) + (ald->ak)*bkin*std::pow(a,(1.e0/3.e0));
4614 }
4615 gamma = 2.5 * pa * std::pow(a,-4.0/3.0);
4616 fecor=0.0;
4617 goto densniv100;
4618 }
4619//
4620 if(ifis==0&&bs!=1.0){
4621// - With increasing excitation energy system in getting less and less deformed:
4622 G4double ponq = (e-100.0)/5.0;
4623 if(ponq>700.0) ponq = 700.0;
4624 bs = 1.0/(1.0+std::exp(-ponq)) + 1.0/(1.0+std::exp(ponq)) * bsin;
4625 bk = 1.0/(1.0+std::exp(-ponq)) + 1.0/(1.0+std::exp(ponq)) * bkin;
4626 }
4627//
4628 // level density parameter
4629 if(ald->optafan == 1) {
4630 pa = (ald->av)*a + (ald->as)*std::pow(a,(2.e0/3.e0)) + (ald->ak)*std::pow(a,(1.e0/3.e0));
4631 }
4632 else {
4633 pa = (ald->av)*a + (ald->as)*bs*std::pow(a,(2.e0/3.e0)) + (ald->ak)*bk*std::pow(a,(1.e0/3.e0));
4634 }
4635//
4636 gamma = 2.5 * pa * std::pow(a,-4.0/3.0);
4637//
4638// AK - 2009 - trial, in order to have transition to constant-temperature approach
4639// Idea - at the phase transition superfluid-normal fluid, TCT = TEMP, and this
4640// determines critical energy for pairing.
4641 if(a>0.0){
4642 ecr = pa*17.60/(std::pow(a,0.699) * std::sqrt(1.0+gamma*BSHELLCT))*17.60/(std::pow(a,0.699) * std::sqrt(1.0+gamma*BSHELLCT));
4643 }
4644
4645 // pairing corrections
4646 if (ifis == 1) {
4647 delta0 = 14;
4648 }
4649 else {
4650 delta0 = 12;
4651 }
4652
4653 // shell corrections
4654 if (optshp > 0) {
4655 deltau = bshell;
4656 if (optshp == 2) {
4657 deltau = 0.0;
4658 }
4659 if (optshp >= 2) {
4660 // pairing energy shift with condensation energy a.r.j. 10.03.97
4661 //deltpp = -0.25e0* (delta0/pow(sqrt(a),2)) * pa /pi6 + 2.e0*delta0/sqrt(a);
4662 deltpp = -0.25e0* std::pow((delta0/std::sqrt(a)),2) * pa /pi6 + 22.34e0*std::pow(a,-0.464)-0.235;
4663 // Odd A
4664 if (IPARITE == 1) {
4665 //e = e - delta0/sqrt(a);
4666 e=e-(0.285+11.17*std::pow(a,-0.464)-0.390-0.00058*a);//-30./a;//FIXME
4667 }
4668 // Even Z, even N
4669 if(IPARITE==2){
4670 e=e-(22.34*std::pow(a,-0.464)-0.235);//-30./a;//FIXME
4671 }
4672 // Odd Z, odd N
4673 if(IPARITE==0){
4674 if(in==iz){
4675 // e = e;
4676 }else{
4677 // e = e-30./a;
4678 }
4679 }
4680 } else {
4681 deltpp = 0.0;
4682 }
4683 }else {
4684 deltau = 0.0;
4685 deltpp = 0.0;
4686 }
4687
4688 if(e < 0.0){
4689 e = 0.0;
4690 ftemp = 0.5;
4691 }
4692
4693 // washing out is made stronger
4694 ponfe = -2.5*pa*e*std::pow(a,(-4.0/3.0));
4695
4696 if (ponfe < -700.0) {
4697 ponfe = -700.0;
4698 }
4699 fe = 1.0 - std::exp(ponfe);
4700 if (e < ecr) {
4701 // priv. comm. k.-h. schmidt
4702 he = 1.0 - std::pow((1.0 - e/ecr),2);
4703 }
4704 else {
4705 he = 1.0;
4706 }
4707 // Excitation energy corrected for pairing and shell effects
4708 // washing out with excitation energy is included.
4709 fecor = e + deltau*fe + deltpp*he;
4710 if (fecor <= 0.1) {
4711 fecor = 0.1;
4712 }
4713 // iterative procedure according to grossjean and feldmeier
4714 // to avoid the singularity e = 0
4715 if (ee < 5.0) {
4716 y1 = std::sqrt(pa*fecor);
4717 for(G4int j = 0; j < 5; j++) {
4718 y2 = pa*fecor*(1.e0-std::exp(-y1));
4719 y1 = std::sqrt(y2);
4720 }
4721 y0 = pa/y1;
4722 ftemp=1.0/y0;
4723 fdens = std::exp(y0*fecor)/ (std::pow((std::pow(fecor,3)*y0),0.5)*std::pow((1.0-0.5*y0*fecor*std::exp(-y1)),0.5))* std::exp(y1)*(1.0-std::exp(-y1))*0.1477045;
4724 if (fecor < 1.0) {
4725 ecor1=1.0;
4726 y11 = std::sqrt(pa*ecor1);
4727 for(G4int j = 0; j < 7; j++) {
4728 y21 = pa*ecor1*(1.0-std::exp(-y11));
4729 y11 = std::sqrt(y21);
4730 }
4731
4732 y01 = pa/y11;
4733 fdens = fdens*std::pow((y01/y0),1.5);
4734 ftemp = ftemp*std::pow((y01/y0),1.5);
4735 }
4736 }
4737 else {
4738 ponniv = 2.0*std::sqrt(pa*fecor);
4739 if (ponniv > 700.0) {
4740 ponniv = 700.0;
4741 }
4742 // fermi gas state density
4743 fdens = 0.1477045 * std::exp(ponniv)/(std::pow(pa,0.25)*std::pow(fecor,1.25));
4744 ftemp = std::sqrt(fecor/pa);
4745 }
4746//
4747 densfm = fdens;
4748 tfm = ftemp;
4749//
4750 if(IOPTCT==0) goto densniv100;
4751 tempct = 17.60/( std::pow(a,0.699) * std::sqrt(1.+gamma*BSHELLCT));
4752 //tempct = 1.0 / ( (0.0570 + 0.00193*BSHELLCT) * pow(a,0.6666667)); // from PRC 80 (2009) 054310
4753
4754// - CONSTANT-TEMPERATURE LEVEL DENSITY PARAMETER (ONLY AT LOW ENERGIES)
4755 if(e<30.){
4756 if(a>0.0){
4757 if(optshp>=2){
4758// Parametrization of CT model by Ignatyuk; note that E0 is shifted to correspond
4759// to pairing shift in Fermi-gas model (there, energy is shifted taking odd-odd nuclei
4760// as bassis)
4761// e-o, o-e
4762 if (IPARITE == 1) { e0 = 0.285+11.17*std::pow(a,-0.464) - 0.390-0.00058*a;}
4763// e-e
4764 if (IPARITE == 2) { e0 = 22.34*std::pow(a,-0.464)-0.235;}
4765// o-o
4766 if (IPARITE == 0){ e0 = 0.0;}
4767
4768 ponniv = (ein-e0)/tempct;
4769 if(ifis!=1) ponniv = max(0.0,(ein-e0)/tempct);
4770 if(ponniv>700.0){ ponniv = 700.0;}
4771 densct = std::exp(ponniv)/tempct*std::exp(0.079*BSHELLCT/tempct);
4772
4773 elim = ein;
4774
4775 if(elim>=ecr&&densfm<=densct){
4776 fdens = densfm;
4777 // IREGCT = 0;
4778 }else{
4779 fdens = densct;
4780 // IREGCT = 1;
4781// ecor = min(ein-e0,0.10);
4782 }
4783 if(elim>=ecr&&tfm>=tempct){
4784 ftemp = tfm;
4785 }else{
4786 ftemp = tempct;
4787 }
4788 }else{
4789// Case of no pairing considered
4790// ETEST = PA * TEMPCT**2
4791 ponniv = (ein)/tempct;
4792 if(ponniv>700.0){ ponniv = 700.0;}
4793 densct = std::exp(ponniv)/tempct;
4794
4795 if(ein>=ecr && densfm<=densct){
4796 fdens = densfm;
4797 ftemp = tfm;
4798 // IREGCT = 0;
4799 }else{
4800 fdens = densct;
4801 ftemp = tempct;
4802// ECOR = DMIN1(EIN,0.1D0)
4803 }
4804
4805 if(ein>=ecr && tfm>=tempct){
4806 ftemp = tfm;
4807 }else{
4808 ftemp = tempct;
4809 }
4810 }
4811 }
4812 }
4813
4814
4815 densniv100:
4816
4817 if(fdens==0.0){
4818 if(a>0.0){
4819// Parametrization of CT model by Ignatyuk done for masses > 20
4820 ftemp = 17.60/( std::pow(a,0.699) * std::sqrt(1.0+gamma*BSHELLCT));
4821 // ftemp = 1.0 / ( (0.0570 + 0.00193*BSHELLCT) * pow(a,0.6666667)); // from PRC 80 (2009) 054310
4822 }else{
4823 ftemp = 0.5;
4824 }
4825 }
4826//
4827// spin cutoff parameter
4828/*
4829C PERPENDICULAR AND PARALLEL MOMENT OF INERTIA
4830c fnorm = R0*M0/hbar**2 = 1.16fm*931.49MeV/c**2 /(6.582122e-22 MeVs)**2 and is
4831c in units 1/MeV
4832*/
4833 fnorm = std::pow(1.16,2)*931.49*1.e-2/(9.0* std::pow(6.582122,2));
4834
4835 if(ifis==0 || ifis==2){
4836/*
4837C GROUND STATE:
4838C FP_PER ~ 1+0.5*alpha2, FP_PAR ~ 1-alpha2 (Hasse & Myers, Geom. relat. macr. nucl. phys.)
4839C alpha2 = sqrt(5/(4*pi))*beta2
4840*/
4841 fp_per = 0.4*std::pow(a,5.0/3.0)*fnorm*(1.0+0.50*defbet*std::sqrt(5.0/(4.0*pi)));
4842 fp_par = 0.40*std::pow(a,5.0/3.0)*fnorm*(1.0-defbet*std::sqrt(5.0/(4.0*pi)));
4843
4844 }else{
4845 if(ifis==1){
4846/*
4847C SADDLE POINT
4848C See Hasse&Myer, p. 100
4849C Perpendicular moment of inertia
4850*/
4851 fp_per = 2.0/5.0*std::pow(a,5.0/3.0)*fnorm*(1.0+7.0/6.0*defbet*(1.0+1396.0/255.0*defbet));
4852// Parallel moment of inertia
4853 fp_par = 2.0/5.0*std::pow(a,5.0/3.0)*fnorm*(1.0-7.0/3.0*defbet*(1.0-389.0/255.0*defbet));
4854 }else{
4855 if(ifis==20){
4856// IMF - two fragments in contact; it is asumed that both are spherical.
4857// See Hasse&Myers, p.106
4858// Here, DEFBET = R1/R2, where R1 and R2 are radii of IMF and its partner
4859// Perpendicular moment of inertia
4860 fp_per = 0.4*std::pow(a,5.0/3.0)*fnorm*3.50*(1.0 + std::pow(defbet,5.))/std::pow(1.0 + defbet*defbet*defbet,5.0/3.0);
4861 fp_par = 0.4*std::pow(a,5.0/3.0)*fnorm*(1.0 + std::pow(defbet,5.0))/std::pow(1.0 + defbet*defbet*defbet,5.0/3.0);
4862 }
4863 }
4864 }
4865 if(fp_par<0.0)fp_par=0.0;
4866 if(fp_per<0.0)fp_per=0.0;
4867//
4868 sig_per = std::sqrt(fp_per * ftemp);
4869 sig_par = std::sqrt(fp_par * ftemp);
4870//
4871 sigma2 = sig_per*sig_per + sig_par*sig_par;
4872 jfact = (2.*jprf+1.)*std::exp(-1.*jprf*(jprf+1.0)/(2.0*sigma2))/(std::sqrt(8.0*3.1415)*std::pow(sigma2,1.5));
4873 erot = jprf*jprf/(2.0*std::sqrt(fp_par*fp_par+fp_per*fp_per));
4874//
4875 // collective enhancement
4876 if (optcol == 1) {
4877 qrot(z,a,defbet,sig_per,fecor-erot,&fqr);
4878 }
4879 else {
4880 fqr = 1.0;
4881 }
4882//
4883 fdens = fdens * fqr *jfact;
4884//
4885 if(fdens<1e-300)fdens=0.0;
4886//
4887 *dens =fdens;
4888 *ecor=fecor;
4889 *temp=ftemp;
4890 *qr=fqr;
4891}
4892
4894{
4895/*
4896C QROT INCLUDING DAMPING
4897C
4898C INPUT: Z,A,DEFBET,SIG,U
4899C
4900C OUTPUT: QR - COLLECTIVE ENHANCEMENT FACTOR
4901C
4902C SEE JUNGHANS ET AL., NUCL. PHYS. A 629 (1998) 635
4903C
4904C
4905C FR(U) EXPONENTIAL FUNCTION TO DEFINE DAMPING
4906C UCR CRITICAL ENERGY FOR DAMPING
4907C DCR WIDTH OF DAMPING
4908C DEFBET BETA-DEFORMATION !
4909C SIG PERPENDICULAR SPIN CUTOFF FACTOR
4910C U ENERGY
4911C QR COEFFICIENT OF COLLECTIVE ENHANCEMENT
4912C A MASS NUMBER
4913C Z CHARGE NUMBER
4914C
4915*/
4916// JLRS: July 2016: new values for the collective parameters
4917//
4918
4919 G4double ucr = fiss->ucr; // Critical energy for damping.
4920 G4double dcr = fiss->dcr; // Width of damping.
4921 G4double ponq = 0.0, dn = 0.0, n = 0.0, dz = 0.0;
4922 G4int distn,distz,ndist, zdist;
4923 G4int nmn[8]= {2, 8, 14, 20, 28, 50, 82, 126};
4924 G4int nmz[8]= {2, 8, 14, 20, 28, 50, 82, 126};
4925//
4926 sig = sig*sig;
4927//
4928 if(std::abs(bet)<=0.15){
4929 goto qrot10;
4930 }else{
4931 goto qrot11;
4932 }
4933//
4934 qrot10:
4935 n = a - z;
4936 distn = 10000000;
4937 distz = 10000000;
4938
4939 for(G4int i =0;i<8;i++){
4940 ndist = std::fabs(idnint(n) - nmn[i]);
4941 if(ndist < distn) distn = ndist;
4942 zdist = std::fabs(idnint(z) - nmz[i]);
4943 if(zdist < distz) distz = zdist;
4944 }
4945
4946 dz = G4float(distz);
4947 dn = G4float(distn);
4948
4949 bet = 0.022 + 0.003*dn + 0.002*dz;
4950
4951 sig = 75.0*std::pow(bet,2.) * sig;
4952
4953// NO VIBRATIONAL ENHANCEMENT
4954 qrot11:
4955 ponq = (u - ucr)/dcr;
4956
4957 if (ponq > 700.0) {
4958 ponq = 700.0;
4959 }
4960 if (sig < 1.0) {
4961 sig = 1.0;
4962 }
4963 (*qr) = 1.0/(1.0 + std::exp(ponq)) * (sig - 1.0) + 1.0;
4964
4965 if ((*qr) < 1.0) {
4966 (*qr) = 1.0;
4967 }
4968
4969 return;
4970}
4971
4973{
4974 // THIS SUBROUTINE CALCULATES THE ORDINARY LEGENDRE POLYNOMIALS OF
4975 // ORDER 0 TO N-1 OF ARGUMENT X AND STORES THEM IN THE VECTOR PL.
4976 // THEY ARE CALCULATED BY RECURSION RELATION FROM THE FIRST TWO
4977 // POLYNOMIALS.
4978 // WRITTEN BY A.J.SIERK LANL T-9 FEBRUARY, 1984
4979 // NOTE: PL AND X MUST BE DOUBLE PRECISION ON 32-BIT COMPUTERS!
4980
4981 pl[0] = 1.0;
4982 pl[1] = x;
4983
4984 for(G4int i = 2; i < n; i++) {
4985 pl[i] = ((2*G4double(i+1) - 3.0)*x*pl[i-1] - (G4double(i+1) - 2.0)*pl[i-2])/(G4double(i+1)-1.0);
4986 }
4987}
4988
4990{
4991 // CHANGED TO CALCULATE TOTAL BINDING ENERGY INSTEAD OF MASS EXCESS.
4992 // SWITCH FOR PAIRING INCLUDED AS WELL.
4993 // BINDING = EFLMAC(IA,IZ,0,OPTSHP)
4994 // FORTRAN TRANSCRIPT OF /U/GREWE/LANG/EEX/FRLDM.C
4995 // A.J. 15.07.96
4996
4997 // this function will calculate the liquid-drop nuclear mass for spheri
4998 // configuration according to the preprint NUCLEAR GROUND-STATE
4999 // MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
5000 // All constants are taken from this publication for consistency.
5001
5002 // Parameters:
5003 // a: nuclear mass number
5004 // z: nuclear charge
5005 // flag: 0 - return mass excess
5006 // otherwise - return pairing (= -1/2 dpn + 1/2 (Dp + Dn))
5007
5008 G4double eflmacResult = 0.0;
5009
5010 if(ia==0)return eflmacResult;
5011
5012 G4int in = 0;
5013 G4double z = 0.0, n = 0.0, a = 0.0, av = 0.0, as = 0.0;
5014 G4double a0 = 0.0, c1 = 0.0, c4 = 0.0, b1 = 0.0, b3 = 0.0;
5015 G4double ff = 0.0, ca = 0.0, w = 0.0, efl = 0.0;
5016 G4double r0 = 0.0, kf = 0.0, ks = 0.0;
5017 G4double kv = 0.0, rp = 0.0, ay = 0.0, aden = 0.0, x0 = 0.0, y0 = 0.0;
5018 G4double esq = 0.0, ael = 0.0, i = 0.0, e0 = 0.0;
5019 G4double pi = 3.141592653589793238e0;
5020
5021 // fundamental constants
5022 // electronic charge squared
5023 esq = 1.4399764;
5024
5025 // constants from considerations other than nucl. masses
5026 // electronic binding
5027 ael = 1.433e-5;
5028
5029 // proton rms radius
5030 rp = 0.8;
5031
5032 // nuclear radius constant
5033 r0 = 1.16;
5034
5035 // range of yukawa-plus-expon. potential
5036 ay = 0.68;
5037
5038 // range of yukawa function used to generate
5039 // nuclear charge distribution
5040 aden= 0.70;
5041
5042 // wigner constant
5043 w = 30.0;
5044
5045 // adjusted parameters
5046 // volume energy
5047 av = 16.00126;
5048
5049 // volume asymmetry
5050 kv = 1.92240;
5051
5052 // surface energy
5053 as = 21.18466;
5054
5055 // surface asymmetry
5056 ks = 2.345;
5057 // a^0 constant
5058 a0 = 2.615;
5059
5060 // charge asymmetry
5061 ca = 0.10289;
5062
5063 z = G4double(iz);
5064 a = G4double(ia);
5065 in = ia - iz;
5066 n = G4double(in);
5067
5068 if(flag==1){goto eflmac311;}
5069
5070 if(iz<13&&in<3){
5071 if(masses->mexpiop[in][iz]==1){
5072 return masses->bind[in][iz];
5073 }
5074 }
5075
5076 eflmac311:
5077
5078 c1 = 3.0/5.0*esq/r0;
5079 c4 = 5.0/4.0*std::pow((3.0/(2.0*pi)),(2.0/3.0)) * c1;
5080 kf = std::pow((9.0*pi*z/(4.0*a)),(1.0/3.0))/r0;
5081
5082 ff = -1.0/8.0*rp*rp*esq/std::pow(r0,3) * (145.0/48.0 - 327.0/2880.0*std::pow(kf,2) * std::pow(rp,2) + 1527.0/1209600.0*std::pow(kf,4) * std::pow(rp,4));
5083 i = (n-z)/a;
5084
5085 x0 = r0 * std::pow(a,(1.0/3.0)) / ay;
5086 y0 = r0 * std::pow(a,(1.0/3.0)) / aden;
5087
5088 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);
5089
5090 b3 = 1.0 - 5.0/std::pow(y0,2) * (1.0 - 15.0/(8.0*y0) + 21.0/(8.0 * std::pow(y0,3))
5091 - 3.0/4.0 * (1.0 + 9.0/(2.0*y0) + 7.0/std::pow(y0,2)
5092 + 7.0/(2.0 * std::pow(y0,3))) * std::exp(-2.0*y0));
5093
5094 // now calculation of total binding energy a.j. 16.7.96
5095
5096 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
5097 + 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))
5098 + ff*std::pow(z,2)/a -ca*(n-z) - ael * std::pow(z,(2.39e0));
5099
5100 efl = efl + w*std::abs(i);
5101
5102 // pairing is made optional
5103 if (optshp >= 2) {
5104 // average pairing
5105 if (in==iz && (mod(in,2) == 1) && (mod(iz,2) == 1) && in>0.) {
5106 efl = efl + w/a;
5107 }
5108
5109// AK 2008 - Parametrization of CT model by Ignatyuk;
5110// The following part has been introduced in order to have correspondance
5111// between pairing in masses and level densities;
5112// AK 2010 note that E0 is shifted to correspond to pairing shift in
5113// Fermi-gas model (there, energy is shifted taking odd-odd nuclei
5114// as bassis)
5115
5116 G4double para=0.;
5117 parite(a,&para);
5118
5119 if(para<0.0){
5120// e-o, o-e
5121 e0 = 0.285+11.17*std::pow(a,-0.464) -0.390-0.00058*(a);
5122 }else{
5123 G4double parz=0.;
5124 parite(z,&parz);
5125 if (parz>0.0){
5126// e-e
5127 e0 = 22.34*std::pow(a,-0.464)-0.235;
5128 }else{
5129// o-o
5130 e0 = 0.0;
5131 }
5132 }
5133 efl = efl - e0;
5134 // end if for pairing term
5135 }
5136
5137 eflmacResult = efl;
5138
5139 return eflmacResult;
5140}
5141
5143{
5144 // CALCUL DE LA CORRECTION, DUE A L'APPARIEMENT, DE L'ENERGIE DE
5145 // LIAISON D'UN NOYAU
5146 // PROCEDURE FOR CALCULATING THE PAIRING CORRECTION TO THE BINDING
5147 // ENERGY OF A SPECIFIC NUCLEUS
5148
5149 G4double para = 0.0, parz = 0.0;
5150 // A MASS NUMBER
5151 // Z NUCLEAR CHARGE
5152 // PARA HELP VARIABLE FOR PARITY OF A
5153 // PARZ HELP VARIABLE FOR PARITY OF Z
5154 // DEL PAIRING CORRECTION
5155
5156 parite(a, &para);
5157
5158 if (para < 0.0) {
5159 (*del) = 0.0;
5160 }
5161 else {
5162 parite(z, &parz);
5163 if (parz > 0.0) {
5164 (*del) = -12.0/std::sqrt(a);
5165 }
5166 else {
5167 (*del) = 12.0/std::sqrt(a);
5168 }
5169 }
5170}
5171
5173{
5174 // CALCUL DE LA PARITE DU NOMBRE N
5175 //
5176 // PROCEDURE FOR CALCULATING THE PARITY OF THE NUMBER N.
5177 // RETURNS -1 IF N IS ODD AND +1 IF N IS EVEN
5178
5179 G4double n1 = 0.0, n2 = 0.0, n3 = 0.0;
5180
5181 // N NUMBER TO BE TESTED
5182 // N1,N2 HELP VARIABLES
5183 // PAR HELP VARIABLE FOR PARITY OF N
5184
5185 n3 = G4double(idnint(n));
5186 n1 = n3/2.0;
5187 n2 = n1 - dint(n1);
5188
5189 if (n2 > 0.0) {
5190 (*par) = -1.0;
5191 }
5192 else {
5193 (*par) = 1.0;
5194 }
5195}
5196
5198{
5199 // INPUT : BET, HOMEGA, EF, T
5200 // OUTPUT: TAU - RISE TIME IN WHICH THE FISSION WIDTH HAS REACHED
5201 // 90 PERCENT OF ITS FINAL VALUE
5202 //
5203 // BETA - NUCLEAR VISCOSITY
5204 // HOMEGA - CURVATURE OF POTENTIAL
5205 // EF - FISSION BARRIER
5206 // T - NUCLEAR TEMPERATURE
5207
5208 G4double tauResult = 0.0;
5209
5210 G4double tlim = 8.e0 * ef;
5211 if (t > tlim) {
5212 t = tlim;
5213 }
5214 //
5215 if (bet/(std::sqrt(2.0)*10.0*(homega/6.582122)) <= 1.0) {
5216 tauResult = std::log(10.0*ef/t)/(bet*1.0e21);
5217 }
5218 else {
5219 tauResult = std::log(10.0*ef/t)/ (2.0*std::pow((10.0*homega/6.582122),2))*(bet*1.0e-21);
5220 } //end if
5221
5222 return tauResult;
5223}
5224
5226{
5227 // INPUT : BET, HOMEGA NUCLEAR VISCOSITY + CURVATURE OF POTENTIAL
5228 // OUTPUT: KRAMERS FAKTOR - REDUCTION OF THE FISSION PROBABILITY
5229 // INDEPENDENT OF EXCITATION ENERGY
5230
5231 G4double rel = bet/(20.0*homega/6.582122);
5232 G4double cramResult = std::sqrt(1.0 + std::pow(rel,2)) - rel;
5233 // limitation introduced 6.1.2000 by khs
5234
5235 if (cramResult > 1.0) {
5236 cramResult = 1.0;
5237 }
5238
5239 return cramResult;
5240}
5241
5243{
5244 // CALCULATION OF THE SURFACE BS OR CURVATURE BK OF A NUCLEUS
5245 // RELATIVE TO THE SPHERICAL CONFIGURATION
5246 // BASED ON MYERS, DROPLET MODEL FOR ARBITRARY SHAPES
5247
5248 // INPUT: IFLAG - 0/1 BK/BS CALCULATION
5249 // Y - (1 - X) COMPLEMENT OF THE FISSILITY
5250
5251 // LINEAR INTERPOLATION OF BS BK TABLE
5252
5253 G4int i = 0;
5254
5255 G4double bipolResult = 0.0;
5256
5257 const G4int bsbkSize = 54;
5258
5259 G4double bk[bsbkSize] = {0.0, 1.00000,1.00087,1.00352,1.00799,1.01433,1.02265,1.03306,
5260 1.04576,1.06099,1.07910,1.10056,1.12603,1.15651,1.19348,
5261 1.23915,1.29590,1.35951,1.41013,1.44103,1.46026,1.47339,
5262 1.48308,1.49068,1.49692,1.50226,1.50694,1.51114,1.51502,
5263 1.51864,1.52208,1.52539,1.52861,1.53177,1.53490,1.53803,
5264 1.54117,1.54473,1.54762,1.55096,1.55440,1.55798,1.56173,
5265 1.56567,1.56980,1.57413,1.57860,1.58301,1.58688,1.58688,
5266 1.58688,1.58740,1.58740, 0.0}; //Zeroes at bk[0], and at the end added by PK
5267
5268 G4double bs[bsbkSize] = {0.0, 1.00000,1.00086,1.00338,1.00750,1.01319,
5269 1.02044,1.02927,1.03974,
5270 1.05195,1.06604,1.08224,1.10085,1.12229,1.14717,1.17623,1.20963,
5271 1.24296,1.26532,1.27619,1.28126,1.28362,1.28458,1.28477,1.28450,
5272 1.28394,1.28320,1.28235,1.28141,1.28042,1.27941,1.27837,1.27732,
5273 1.27627,1.27522,1.27418,1.27314,1.27210,1.27108,1.27006,1.26906,
5274 1.26806,1.26707,1.26610,1.26514,1.26418,1.26325,1.26233,1.26147,
5275 1.26147,1.26147,1.25992,1.25992, 0.0};
5276
5277 i = idint(y/(2.0e-02)) + 1;
5278
5279 if((i + 1) >= bsbkSize) {
5280 if(verboseLevel > 2) {
5281 // G4cout <<"G4Abla error: index " << i + 1 << " is greater than array size permits." << G4endl;
5282 }
5283 bipolResult = 0.0;
5284 }
5285 else {
5286 if (iflag == 1) {
5287 bipolResult = bs[i] + (bs[i+1] - bs[i])/2.0e-02 * (y - 2.0e-02*(i - 1));
5288 }
5289 else {
5290 bipolResult = bk[i] + (bk[i+1] - bk[i])/2.0e-02 * (y - 2.0e-02*(i - 1));
5291 }
5292 }
5293
5294 return bipolResult;
5295}
5296
5298{
5299/*
5300c Y 1 - Fissility
5301c OMEGA Frequency at the ground state, in units 1.e-21 s
5302*/
5303 G4double OMEGA,HOMEGA,ES0,MR02;
5304
5305 ES0 = 20.760*std::pow(AF,2.0/3.0);
5306// In units 1.e-42 MeVs**2; r0 = 1.175e-15 m, u=931.49MeV/c**2=103.4MeV*s**2/m**2
5307// divided by 1.e-4 to go from 1.e-46 to 1.e-42
5308 MR02 = std::pow(AF,5.0/3.0)*1.0340*0.010*1.175*1.175;
5309// Determination of the inertia of the fission collective degree of freedom
5310 (*MFCD) = MR02 * 3.0/10.0*(1.0+3.0*Y);
5311// Omega at saddle
5312 OMEGA = std::sqrt(ES0/MR02)*std::sqrt(8.0/3.0*Y*(1.0+304.0*Y/255.0));
5313//
5314 HOMEGA = 6.58122*OMEGA/10.0;
5315//
5316 (*sOMEGA)=OMEGA;
5317 (*sHOMEGA)=HOMEGA;
5318//
5319 return;
5320}
5321
5322
5324{
5325/*
5326c Y 1 - Fissility
5327c OMEGA Frequency at the ground state, in units 1.e-21 s
5328*/
5329 G4double OMEGA,HOMEGA,MR02,MINERT,C,fk1;
5330//
5331 MR02 = std::pow(AF,5.0/3.0)*1.0340*0.01*1.175*1.175;
5332 MINERT = 3.*MR02/10.0;
5333 C = 17.9439*(1.-1.7826*std::pow((AF-2.0*ZF)/AF,2));
5334 fk1 = 0.4*C*std::pow(AF,2.0/3.0)-0.1464*std::pow(ZF,2)/std::pow(AF,1./3.);
5335 OMEGA = std::sqrt(fk1/MINERT);
5336 HOMEGA = 6.58122*OMEGA/10.0;
5337//
5338 (*K1)=fk1;
5339 (*sOMEGA)=OMEGA;
5340 (*sHOMEGA)=HOMEGA;
5341//
5342 return;
5343}
5344
5346{/*
5347C AK 2004 - Barriers for LCP and IMF are calculated now according to the
5348C Bass model (Nucl. Phys. A (1974))
5349C KHS 2007 - To speed up, barriers are read from tabels; in case thermal
5350C expansion is considered, barriers are calculated.
5351C INPUT:
5352C EA - Excitation energy per nucleon
5353C Z11, A11 - Charge and mass of daughter nucleus
5354C Z22, A22 - Charge and mass of LCP or IMF
5355C
5356C OUTPUT:
5357C BARR - Barrier
5358C OMEGA - Curvature of the potential
5359C
5360C BASS MODEL NPA 1974 - used only if expansion is considered (OPTEXP=1)
5361C or one wants this model explicitly (OPTBAR=1)
5362C October 2011 - AK - new parametrization of the barrier and its position,
5363C see W.W. Qu et al., NPA 868 (2011) 1; this is now
5364C default option (OPTBAR=0)
5365c
5366c November 2016 - JLRS - Added this function from abla07v4
5367c
5368*/
5369 G4double BARR, OMEGA, RMAX;
5370 RMAX = 1.1 * (ecld->rms[A1-Z1][Z1]+ecld->rms[A2-Z2][Z2]) + 2.8;
5371 BARR = 1.345 * Z1 * Z2 / RMAX;
5372//C Omega according to Avishai:
5373 OMEGA = 4.5 / 197.3287;
5374
5375 // if(Z1<60){
5376 // if(Z2==1 && A2==2) BARR = BARR * 1.1;
5377 // if(Z2==1 && A2==3) BARR = BARR * 1.1;
5378 // if(Z2==2 && A2==3) BARR = BARR * 1.3;
5379 // if(Z2==2 && A2==4) BARR = BARR * 1.1;
5380 // }
5381
5382 (*sOMEGA)=OMEGA;
5383 (*sBARR)=BARR;
5384//
5385 return;
5386}
5387
5388void G4Abla::barfit(G4int iz, G4int ia, G4int il, G4double *sbfis, G4double *segs, G4double *selmax)
5389{
5390 // 2223 C VERSION FOR 32BIT COMPUTER
5391 // 2224 C THIS SUBROUTINE RETURNS THE BARRIER HEIGHT BFIS, THE
5392 // 2225 C GROUND-STATE ENERGY SEGS, IN MEV, AND THE ANGULAR MOMENTUM
5393 // 2226 C AT WHICH THE FISSION BARRIER DISAPPEARS, LMAX, IN UNITS OF
5394 // 2227 C H-BAR, WHEN CALLED WITH INTEGER AGUMENTS IZ, THE ATOMIC
5395 // 2228 C NUMBER, IA, THE ATOMIC MASS NUMBER, AND IL, THE ANGULAR
5396 // 2229 C MOMENTUM IN UNITS OF H-BAR. (PLANCK'S CONSTANT DIVIDED BY
5397 // 2230 C 2*PI).
5398 // 2231 C
5399 // 2232 C THE FISSION BARRIER FO IL = 0 IS CALCULATED FROM A 7TH
5400 // 2233 C ORDER FIT IN TWO VARIABLES TO 638 CALCULATED FISSION
5401 // 2234 C BARRIERS FOR Z VALUES FROM 20 TO 110. THESE 638 BARRIERS ARE
5402 // 2235 C FIT WITH AN RMS DEVIATION OF 0.10 MEV BY THIS 49-PARAMETER
5403 // 2236 C FUNCTION.
5404 // 2237 C IF BARFIT IS CALLED WITH (IZ,IA) VALUES OUTSIDE THE RANGE OF
5405 // 2238 C THE BARRIER HEIGHT IS SET TO 0.0, AND A MESSAGE IS PRINTED
5406 // 2239 C ON THE DEFAULT OUTPUT FILE.
5407 // 2240 C
5408 // 2241 C FOR IL VALUES NOT EQUAL TO ZERO, THE VALUES OF L AT WHICH
5409 // 2242 C THE BARRIER IS 80% AND 20% OF THE L=0 VALUE ARE RESPECTIVELY
5410 // 2243 C FIT TO 20-PARAMETER FUNCTIONS OF Z AND A, OVER A MORE
5411 // 2244 C RESTRICTED RANGE OF A VALUES, THAN IS THE CASE FOR L = 0.
5412 // 2245 C THE VALUE OF L WHERE THE BARRIER DISAPPEARS, LMAX IS FIT TO
5413 // 2246 C A 24-PARAMETER FUNCTION OF Z AND A, WITH THE SAME RANGE OF
5414 // 2247 C Z AND A VALUES AS L-80 AND L-20.
5415 // 2248 C ONCE AGAIN, IF AN (IZ,IA) PAIR IS OUTSIDE OF THE RANGE OF
5416 // 2249 C VALIDITY OF THE FIT, THE BARRIER VALUE IS SET TO 0.0 AND A
5417 // 2250 C MESSAGE IS PRINTED. THESE THREE VALUES (BFIS(L=0),L-80, AND
5418 // 2251 C L-20) AND THE CONSTRINTS OF BFIS = 0 AND D(BFIS)/DL = 0 AT
5419 // 2252 C L = LMAX AND L=0 LEAD TO A FIFTH-ORDER FIT TO BFIS(L) FOR
5420 // 2253 C L>L-20. THE FIRST THREE CONSTRAINTS LEAD TO A THIRD-ORDER FIT
5421 // 2254 C FOR THE REGION L < L-20.
5422 // 2255 C
5423 // 2256 C THE GROUND STATE ENERGIES ARE CALCULATED FROM A
5424 // 2257 C 120-PARAMETER FIT IN Z, A, AND L TO 214 GROUND-STATE ENERGIES
5425 // 2258 C FOR 36 DIFFERENT Z AND A VALUES.
5426 // 2259 C (THE RANGE OF Z AND A IS THE SAME AS FOR L-80, L-20, AND
5427 // 2260 C L-MAX)
5428 // 2261 C
5429 // 2262 C THE CALCULATED BARRIERS FROM WHICH THE FITS WERE MADE WERE
5430 // 2263 C CALCULATED IN 1983-1984 BY A. J. SIERK OF LOS ALAMOS
5431 // 2264 C NATIONAL LABORATORY GROUP T-9, USING YUKAWA-PLUS-EXPONENTIAL
5432 // 2265 C G4DOUBLE FOLDED NUCLEAR ENERGY, EXACT COULOMB DIFFUSENESS
5433 // 2266 C CORRECTIONS, AND DIFFUSE-MATTER MOMENTS OF INERTIA.
5434 // 2267 C THE PARAMETERS OF THE MODEL R-0 = 1.16 FM, AS 21.13 MEV,
5435 // 2268 C KAPPA-S = 2.3, A = 0.68 FM.
5436 // 2269 C THE DIFFUSENESS OF THE MATTER AND CHARGE DISTRIBUTIONS USED
5437 // 2270 C CORRESPONDS TO A SURFACE DIFFUSENESS PARAMETER (DEFINED BY
5438 // 2271 C MYERS) OF 0.99 FM. THE CALCULATED BARRIERS FOR L = 0 ARE
5439 // 2272 C ACCURATE TO A LITTLE LESS THAN 0.1 MEV; THE OUTPUT FROM
5440 // 2273 C THIS SUBROUTINE IS A LITTLE LESS ACCURATE. WORST ERRORS MAY BE
5441 // 2274 C AS LARGE AS 0.5 MEV; CHARACTERISTIC UNCERTAINY IS IN THE RANGE
5442 // 2275 C OF 0.1-0.2 MEV. THE RMS DEVIATION OF THE GROUND-STATE FIT
5443 // 2276 C FROM THE 214 INPUT VALUES IS 0.20 MEV. THE MAXIMUM ERROR
5444 // 2277 C OCCURS FOR LIGHT NUCLEI IN THE REGION WHERE THE GROUND STATE
5445 // 2278 C IS PROLATE, AND MAY BE GREATER THAN 1.0 MEV FOR VERY NEUTRON
5446 // 2279 C DEFICIENT NUCLEI, WITH L NEAR LMAX. FOR MOST NUCLEI LIKELY TO
5447 // 2280 C BE ENCOUNTERED IN REAL EXPERIMENTS, THE MAXIMUM ERROR IS
5448 // 2281 C CLOSER TO 0.5 MEV, AGAIN FOR LIGHT NUCLEI AND L NEAR LMAX.
5449 // 2282 C
5450 // 2283 C WRITTEN BY A. J. SIERK, LANL T-9
5451 // 2284 C VERSION 1.0 FEBRUARY, 1984
5452 // 2285 C
5453 // 2286 C THE FOLLOWING IS NECESSARY FOR 32-BIT MACHINES LIKE DEC VAX,
5454 // 2287 C IBM, ETC
5455
5456 G4double pa[7],pz[7],pl[10];
5457 for(G4int init_i = 0; init_i < 7; init_i++) {
5458 pa[init_i] = 0.0;
5459 pz[init_i] = 0.0;
5460 }
5461 for(G4int init_i = 0; init_i < 10; init_i++) {
5462 pl[init_i] = 0.0;
5463 }
5464
5465 G4double a = 0.0, z = 0.0, amin = 0.0, amax = 0.0, amin2 = 0.0;
5466 G4double amax2 = 0.0, aa = 0.0, zz = 0.0, bfis = 0.0;
5467 G4double bfis0 = 0.0, ell = 0.0, el = 0.0, egs = 0.0, el80 = 0.0, el20 = 0.0;
5468 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;
5469 G4double aj = 0.0, ak = 0.0, a1 = 0.0, a2 = 0.0;
5470
5471 G4int i = 0, j = 0, k = 0, m = 0;
5472 G4int l = 0;
5473
5474 G4double emncof[4][5] = {{-9.01100e+2,-1.40818e+3, 2.77000e+3,-7.06695e+2, 8.89867e+2},
5475 {1.35355e+4,-2.03847e+4, 1.09384e+4,-4.86297e+3,-6.18603e+2},
5476 {-3.26367e+3, 1.62447e+3, 1.36856e+3, 1.31731e+3, 1.53372e+2},
5477 {7.48863e+3,-1.21581e+4, 5.50281e+3,-1.33630e+3, 5.05367e-2}};
5478
5479 G4double elmcof[4][5] = {{1.84542e+3,-5.64002e+3, 5.66730e+3,-3.15150e+3, 9.54160e+2},
5480 {-2.24577e+3, 8.56133e+3,-9.67348e+3, 5.81744e+3,-1.86997e+3},
5481 {2.79772e+3,-8.73073e+3, 9.19706e+3,-4.91900e+3, 1.37283e+3},
5482 {-3.01866e+1, 1.41161e+3,-2.85919e+3, 2.13016e+3,-6.49072e+2}};
5483
5484 G4double emxcof[4][6] = {{9.43596e4,-2.241997e5,2.223237e5,-1.324408e5,4.68922e4,-8.83568e3},
5485 {-1.655827e5,4.062365e5,-4.236128e5,2.66837e5,-9.93242e4,1.90644e4},
5486 {1.705447e5,-4.032e5,3.970312e5,-2.313704e5,7.81147e4,-1.322775e4},
5487 {-9.274555e4,2.278093e5,-2.422225e5,1.55431e5,-5.78742e4,9.97505e3}};
5488
5489 G4double elzcof[7][7] = {{5.11819909e+5,-1.30303186e+6, 1.90119870e+6,-1.20628242e+6, 5.68208488e+5, 5.48346483e+4,-2.45883052e+4},
5490 {-1.13269453e+6, 2.97764590e+6,-4.54326326e+6, 3.00464870e+6, -1.44989274e+6,-1.02026610e+5, 6.27959815e+4},
5491 {1.37543304e+6,-3.65808988e+6, 5.47798999e+6,-3.78109283e+6, 1.84131765e+6, 1.53669695e+4,-6.96817834e+4},
5492 {-8.56559835e+5, 2.48872266e+6,-4.07349128e+6, 3.12835899e+6, -1.62394090e+6, 1.19797378e+5, 4.25737058e+4},
5493 {3.28723311e+5,-1.09892175e+6, 2.03997269e+6,-1.77185718e+6, 9.96051545e+5,-1.53305699e+5,-1.12982954e+4},
5494 {4.15850238e+4, 7.29653408e+4,-4.93776346e+5, 6.01254680e+5, -4.01308292e+5, 9.65968391e+4,-3.49596027e+3},
5495 {-1.82751044e+5, 3.91386300e+5,-3.03639248e+5, 1.15782417e+5, -4.24399280e+3,-6.11477247e+3, 3.66982647e+2}};
5496
5497 const G4int sizex = 5;
5498 const G4int sizey = 6;
5499 const G4int sizez = 4;
5500
5501 G4double egscof[sizey][sizey][sizez];
5502
5503 G4double egs1[sizey][sizex] = {{1.927813e5, 7.666859e5, 6.628436e5, 1.586504e5,-7.786476e3},
5504 {-4.499687e5,-1.784644e6,-1.546968e6,-4.020658e5,-3.929522e3},
5505 {4.667741e5, 1.849838e6, 1.641313e6, 5.229787e5, 5.928137e4},
5506 {-3.017927e5,-1.206483e6,-1.124685e6,-4.478641e5,-8.682323e4},
5507 {1.226517e5, 5.015667e5, 5.032605e5, 2.404477e5, 5.603301e4},
5508 {-1.752824e4,-7.411621e4,-7.989019e4,-4.175486e4,-1.024194e4}};
5509
5510 G4double egs2[sizey][sizex] = {{-6.459162e5,-2.903581e6,-3.048551e6,-1.004411e6,-6.558220e4},
5511 {1.469853e6, 6.564615e6, 6.843078e6, 2.280839e6, 1.802023e5},
5512 {-1.435116e6,-6.322470e6,-6.531834e6,-2.298744e6,-2.639612e5},
5513 {8.665296e5, 3.769159e6, 3.899685e6, 1.520520e6, 2.498728e5},
5514 {-3.302885e5,-1.429313e6,-1.512075e6,-6.744828e5,-1.398771e5},
5515 {4.958167e4, 2.178202e5, 2.400617e5, 1.167815e5, 2.663901e4}};
5516
5517 G4double egs3[sizey][sizex] = {{3.117030e5, 1.195474e6, 9.036289e5, 6.876190e4,-6.814556e4},
5518 {-7.394913e5,-2.826468e6,-2.152757e6,-2.459553e5, 1.101414e5},
5519 {7.918994e5, 3.030439e6, 2.412611e6, 5.228065e5, 8.542465e3},
5520 {-5.421004e5,-2.102672e6,-1.813959e6,-6.251700e5,-1.184348e5},
5521 {2.370771e5, 9.459043e5, 9.026235e5, 4.116799e5, 1.001348e5},
5522 {-4.227664e4,-1.738756e5,-1.795906e5,-9.292141e4,-2.397528e4}};
5523
5524 G4double egs4[sizey][sizex] = {{-1.072763e5,-5.973532e5,-6.151814e5, 7.371898e4, 1.255490e5},
5525 {2.298769e5, 1.265001e6, 1.252798e6,-2.306276e5,-2.845824e5},
5526 {-2.093664e5,-1.100874e6,-1.009313e6, 2.705945e5, 2.506562e5},
5527 {1.274613e5, 6.190307e5, 5.262822e5,-1.336039e5,-1.115865e5},
5528 {-5.715764e4,-2.560989e5,-2.228781e5,-3.222789e3, 1.575670e4},
5529 {1.189447e4, 5.161815e4, 4.870290e4, 1.266808e4, 2.069603e3}};
5530
5531 for(i = 0; i < sizey; i++) {
5532 for(j = 0; j < sizex; j++) {
5533 egscof[i][j][0] = egs1[i][j];
5534 egscof[i][j][1] = egs2[i][j];
5535 egscof[i][j][2] = egs3[i][j];
5536 egscof[i][j][3] = egs4[i][j];
5537 }
5538 }
5539
5540 // the program starts here
5541 if (iz < 19 || iz > 111) {
5542 goto barfit900;
5543 }
5544
5545 if(iz > 102 && il > 0) {
5546 goto barfit902;
5547 }
5548
5549 z=G4double(iz);
5550 a=G4double(ia);
5551 el=G4double(il);
5552 amin= 1.2e0*z + 0.01e0*z*z;
5553 amax= 5.8e0*z - 0.024e0*z*z;
5554
5555 if(a < amin || a > amax) {
5556 goto barfit910;
5557 }
5558
5559 // angul.mom.zero barrier
5560 aa=2.5e-3*a;
5561 zz=1.0e-2*z;
5562 ell=1.0e-2*el;
5563 bfis0 = 0.0;
5564 lpoly(zz,7,pz);
5565 lpoly(aa,7,pa);
5566
5567 for(i = 0; i < 7; i++) { //do 10 i=1,7
5568 for(j = 0; j < 7; j++) { //do 10 j=1,7
5569 bfis0=bfis0+elzcof[j][i]*pz[i]*pa[j];
5570 }
5571 }
5572
5573 bfis=bfis0;
5574
5575 (*sbfis)=bfis;
5576 egs=0.0;
5577 (*segs)=egs;
5578
5579 // values of l at which the barrier
5580 // is 20%(el20) and 80%(el80) of l=0 value
5581 amin2 = 1.4e0*z + 0.009e0*z*z;
5582 amax2 = 20.e0 + 3.0e0*z;
5583
5584 if((a < amin2-5.e0 || a > amax2+10.e0) && il > 0) {
5585 goto barfit920;
5586 }
5587
5588 lpoly(zz,5,pz);
5589 lpoly(aa,4,pa);
5590 el80=0.0;
5591 el20=0.0;
5592 elmax=0.0;
5593
5594 for(i = 0; i < 4; i++) {
5595 for(j = 0; j < 5; j++) {
5596 el80 = el80 + elmcof[i][j]*pz[j]*pa[i];
5597 el20 = el20 + emncof[i][j]*pz[j]*pa[i];
5598 }
5599 }
5600
5601 sel80 = el80;
5602 sel20 = el20;
5603
5604 // value of l (elmax) where barrier disapp.
5605 lpoly(zz,6,pz);
5606 lpoly(ell,9,pl);
5607
5608 for(i = 0; i < 4; i++) { //do 30 i= 1,4
5609 for(j = 0; j < 6; j++) { //do 30 j=1,6
5610 elmax = elmax + emxcof[i][j]*pz[j]*pa[i];
5611 }
5612 }
5613
5614 (*selmax)=elmax;
5615
5616 // value of barrier at ang.mom. l
5617 if(il < 1){
5618 return;
5619 }
5620
5621 x = sel20/(*selmax);
5622 y = sel80/(*selmax);
5623
5624 if(el <= sel20) {
5625 // low l
5626 q = 0.2/(std::pow(sel20,2)*std::pow(sel80,2)*(sel20-sel80));
5627 qa = q*(4.0*std::pow(sel80,3) - std::pow(sel20,3));
5628 qb = -q*(4.0*std::pow(sel80,2) - std::pow(sel20,2));
5629 bfis = bfis*(1.0 + qa*std::pow(el,2) + qb*std::pow(el,3));
5630 }
5631 else {
5632 // high l
5633 aj = (-20.0*std::pow(x,5) + 25.e0*std::pow(x,4) - 4.0)*std::pow((y-1.0),2)*y*y;
5634 ak = (-20.0*std::pow(y,5) + 25.0*std::pow(y,4) - 1.0) * std::pow((x-1.0),2)*x*x;
5635 q = 0.2/(std::pow((y-x)*((1.0-x)*(1.0-y)*x*y),2));
5636 qa = q*(aj*y - ak*x);
5637 qb = -q*(aj*(2.0*y + 1.0) - ak*(2.0*x + 1.0));
5638 z = el/(*selmax);
5639 a1 = 4.0*std::pow(z,5) - 5.0*std::pow(z,4) + 1.0;
5640 a2 = qa*(2.e0*z + 1.e0);
5641 bfis=bfis*(a1 + (z - 1.e0)*(a2 + qb*z)*z*z*(z - 1.e0));
5642 }
5643
5644 if(bfis <= 0.0) {
5645 bfis=0.0;
5646 }
5647
5648 if(el > (*selmax)) {
5649 bfis=0.0;
5650 }
5651 (*sbfis)=bfis;
5652
5653 // now calculate rotating ground state energy
5654 if(el > (*selmax)) {
5655 return;
5656 }
5657
5658 for(k = 0; k < 4; k++) {
5659 for(l = 0; l < 6; l++) {
5660 for(m = 0; m < 5; m++) {
5661 egs = egs + egscof[l][m][k]*pz[l]*pa[k]*pl[2*m];
5662 }
5663 }
5664 }
5665
5666 (*segs)=egs;
5667 if((*segs) < 0.0) {
5668 (*segs)=0.0;
5669 }
5670
5671 return;
5672
5673 barfit900: //continue
5674 (*sbfis)=0.0;
5675 // for z<19 sbfis set to 1.0e3
5676 if (iz < 19) {
5677 (*sbfis) = 1.0e3;
5678 }
5679 (*segs)=0.0;
5680 (*selmax)=0.0;
5681 return;
5682
5683 barfit902:
5684 (*sbfis)=0.0;
5685 (*segs)=0.0;
5686 (*selmax)=0.0;
5687 return;
5688
5689 barfit910:
5690 (*sbfis)=0.0;
5691 (*segs)=0.0;
5692 (*selmax)=0.0;
5693 return;
5694
5695 barfit920:
5696 (*sbfis)=0.0;
5697 (*segs)=0.0;
5698 (*selmax)=0.0;
5699 return;
5700}
5701
5703{
5704 G4double ferf;
5705
5706 if(x<0.){
5707 ferf=-gammp(0.5,x*x);
5708 }else{
5709 ferf=gammp(0.5,x*x);;
5710 }
5711 return ferf;
5712}
5713
5715{
5716 G4double fgammp;
5717 G4double gammcf,gamser,gln=0.;
5718
5719 if(x<0.0 || a<=0.0)std::cout << "G4Abla::gammp = bad arguments in gammp" << std::endl;
5720 if(x<a+1.){
5721 gser(&gamser,a,x,gln);
5722 fgammp=gamser;
5723 }else{
5724 gcf(&gammcf,a,x,gln);
5725 fgammp=1.-gammcf;
5726 }
5727 return fgammp;
5728}
5729
5731{
5732 G4double fgammcf,del;
5733 G4double eps=3e-7;
5734 G4double fpmin=1e-30;
5735 G4int itmax=100;
5736 G4double an,b,c,d,h;
5737
5738 gln=gammln(a);
5739 b=x+1.-a;
5740 c=1./fpmin;
5741 d=1./b;
5742 h=d;
5743 for(G4int i=1;i<=itmax;i++){
5744 an=-i*(i-a);
5745 b=b+2.;
5746 d=an*d+b;
5747 if(std::fabs(d)<fpmin)d=fpmin;
5748 c=b+an/c;
5749 if(std::fabs(c)<fpmin)c=fpmin;
5750 d=1.0/d;
5751 del=d*c;
5752 h=h*del;
5753 if(std::fabs(del-1.)<eps)goto dir1;
5754 }
5755 std::cout << "a too large, ITMAX too small in gcf" << std::endl;
5756 dir1:
5757 fgammcf=std::exp(-x+a*std::log(x)-gln)*h;
5758 (*gammcf)=fgammcf;
5759 return;
5760}
5761
5763{
5764 G4double fgamser,ap,sum,del;
5765 G4double eps=3e-7;
5766 G4int itmax=100;
5767
5768 gln=gammln(a);
5769 if(x<=0.){
5770 if(x<0.)std::cout << "G4Abla::gser = x < 0 in gser" << std::endl;
5771 (*gamser)=0.0;
5772 return;
5773 }
5774 ap=a;
5775 sum=1./a;
5776 del=sum;
5777 for(G4int n=0;n<itmax;n++){
5778 ap=ap+1.;
5779 del=del*x/ap;
5780 sum=sum+del;
5781 if(std::fabs(del)<std::fabs(sum)*eps)goto dir1;
5782 }
5783 std::cout << "a too large, ITMAX too small in gser" << std::endl;
5784 dir1:
5785 fgamser=sum*std::exp(-x+a*std::log(x)-gln);
5786 (*gamser)=fgamser;
5787 return;
5788}
5789
5791{
5792 G4double fgammln,x,ser,tmp,y;
5793 G4double cof[6]={76.18009172947146,-86.50532032941677,24.01409824083091,
5794-1.231739572450155,0.1208650973866179e-2,-0.5395239384953e-5};
5795 G4double stp=2.5066282746310005;
5796
5797 x=xx;
5798 y=x;
5799 tmp=x+5.5;
5800 tmp=(x+0.5)*std::log(tmp)-tmp;
5801 ser=1.000000000190015;
5802 for(G4int j=0;j<6;j++){
5803 y=y+1.;
5804 ser=ser+cof[j]/y;
5805 }
5806
5807 return fgammln=tmp+std::log(stp*ser/x);
5808}
5809
5810
5812{
5813 // DISTRIBUTION DE MAXWELL
5814
5815 return (E*std::exp(-E));
5816}
5817
5819{
5820 // FONCTION INTEGRALE DE FD(E)
5821 return (1.0 - (E + 1.0) * std::exp(-E));
5822}
5823
5825{
5826 return ( -x*std::log(G4AblaRandom::flat()) -x*std::log(G4AblaRandom::flat()) -x*std::log(G4AblaRandom::flat()) ) ;
5827}
5828
5830{
5831 // tirage aleatoire dans une maxwellienne
5832 // t : temperature
5833 //
5834 // declaration des variables
5835 //
5836
5837 const G4int pSize = 101;
5838 G4double p[pSize];
5839
5840 // ial generateur pour le cascade (et les iy pour eviter les correlations)
5841 G4int i = 0;
5842 G4int itest = 0;
5843 // programme principal
5844
5845 // calcul des p(i) par approximation de newton
5846 p[pSize-1] = 8.0;
5847 G4double x = 0.1;
5848 G4double x1 = 0.0;
5849 G4double y = 0.0;
5850
5851 if (itest == 1) {
5852 goto fmaxhaz120;
5853 }
5854
5855 for(i = 1; i <= 99; i++) {
5856 fmaxhaz20:
5857 x1 = x - (f(x) - G4double(i)/100.0)/fd(x);
5858 x = x1;
5859 if (std::fabs(f(x) - G4double(i)/100.0) < 1e-5) {
5860 goto fmaxhaz100;
5861 }
5862 goto fmaxhaz20;
5863 fmaxhaz100:
5864 p[i] = x;
5865 } //end do
5866
5867 // itest = 1;
5868 itest = 0;
5869 // tirage aleatoire et calcul du x correspondant
5870 // par regression lineaire
5871 fmaxhaz120:
5872 y = G4AblaRandom::flat();
5873 i = nint(y*100);
5874
5875 // 2590 c ici on evite froidement les depassements de tableaux....(a.b. 3/9/99)
5876 if(i == 0) {
5877 goto fmaxhaz120;
5878 }
5879
5880 if (i == 1) {
5881 x = p[i]*y*100;
5882 }
5883 else {
5884 x = (p[i] - p[i-1])*(y*100 - i) + p[i];
5885 }
5886
5887 return(x*T);
5888}
5889
5891{
5892 // PACE2
5893 // Cette fonction retourne le defaut de masse du noyau A,Z en MeV
5894 // Revisee pour a, z flottants 25/4/2002 =
5895
5896 G4double fpace2 = 0.0;
5897
5898 G4int ii = idint(a+0.5);
5899 G4int jj = idint(z+0.5);
5900
5901 if(ii <= 0 || jj < 0) {
5902 fpace2=0.;
5903 return fpace2;
5904 }
5905
5906 if(jj > 300) {
5907 fpace2=0.0;
5908 }
5909 else {
5910 fpace2=pace->dm[ii][jj];
5911 }
5912 fpace2=fpace2/1000.;
5913
5914 if(pace->dm[ii][jj] == 0.) {
5915 if(ii < 12) {
5916 fpace2=-500.;
5917 }
5918 else {
5919 guet(&a, &z, &fpace2);
5920 fpace2=fpace2-ii*931.5;
5921 fpace2=fpace2/1000.;
5922 }
5923 }
5924
5925 return fpace2;
5926}
5927
5928void G4Abla::guet(G4double *x_par, G4double *z_par, G4double *find_par)
5929{
5930 // TABLE DE MASSES ET FORMULE DE MASSE TIRE DU PAPIER DE BRACK-GUET
5931 // Gives the theoritical value for mass excess...
5932 // Revisee pour x, z flottants 25/4/2002
5933
5934 //real*8 x,z
5935 // dimension q(0:50,0:70)
5936 G4double x = (*x_par);
5937 G4double z = (*z_par);
5938 G4double find = (*find_par);
5939
5940 const G4int qrows = 50;
5941 const G4int qcols = 70;
5942 G4double q[qrows][qcols];
5943 for(G4int init_i = 0; init_i < qrows; init_i++) {
5944 for(G4int init_j = 0; init_j < qcols; init_j++) {
5945 q[init_i][init_j] = 0.0;
5946 }
5947 }
5948
5949 G4int ix=G4int(std::floor(x+0.5));
5950 G4int iz=G4int(std::floor(z+0.5));
5951 G4double zz = iz;
5952 G4double xx = ix;
5953 find = 0.0;
5954 G4double avol = 15.776;
5955 G4double asur = -17.22;
5956 G4double ac = -10.24;
5957 G4double azer = 8.0;
5958 G4double xjj = -30.03;
5959 G4double qq = -35.4;
5960 G4double c1 = -0.737;
5961 G4double c2 = 1.28;
5962
5963 if(ix <= 7) {
5964 q[0][1]=939.50;
5965 q[1][1]=938.21;
5966 q[1][2]=1876.1;
5967 q[1][3]=2809.39;
5968 q[2][4]=3728.34;
5969 q[2][3]=2809.4;
5970 q[2][5]=4668.8;
5971 q[2][6]=5606.5;
5972 q[3][5]=4669.1;
5973 q[3][6]=5602.9;
5974 q[3][7]=6535.27;
5975 q[4][6]=5607.3;
5976 q[4][7]=6536.1;
5977 q[5][7]=6548.3;
5978 find=q[iz][ix];
5979 }
5980 else {
5981 G4double xneu=xx-zz;
5982 G4double si=(xneu-zz)/xx;
5983 G4double x13=std::pow(xx,.333);
5984 G4double ee1=c1*zz*zz/x13;
5985 G4double ee2=c2*zz*zz/xx;
5986 G4double aux=1.+(9.*xjj/4./qq/x13);
5987 G4double ee3=xjj*xx*si*si/aux;
5988 G4double ee4=avol*xx+asur*(std::pow(xx,.666))+ac*x13+azer;
5989 G4double tota = ee1 + ee2 + ee3 + ee4;
5990 find = 939.55*xneu+938.77*zz - tota;
5991 }
5992
5993 (*x_par) = x;
5994 (*z_par) = z;
5995 (*find_par) = find;
5996}
5997//
5998
5999void G4Abla::FillData(G4int IMULTBU,G4int IEV_TAB){
6000
6001 const G4double c = 29.9792458;
6002 const G4double fmp = 938.27231,fmn=939.56563,fml=1115.683;
6003
6004 varntp->ntrack = IMULTBU + IEV_TAB;
6005
6006 G4int intp=0;
6007
6008 for(G4int i=0;i<IMULTBU;i++){
6009
6010 G4int iz = nint(BU_TAB[i][7]);
6011 G4int ia = nint(BU_TAB[i][8]);
6012 G4int is = nint(BU_TAB[i][11]);
6013
6014 Ainit = Ainit + ia;
6015 Zinit = Zinit + iz;
6016 Sinit = Sinit - is;
6017
6018 varntp->zvv[intp] = iz;
6019 varntp->avv[intp] = ia;
6020 varntp->svv[intp] = -1*is;
6021 varntp->itypcasc[intp] = 0;
6022
6023 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];
6024 G4double gamma = std::sqrt(1.0 - v2 / (c*c));
6025 G4double avvmass = iz*fmp + (ia-iz-is)*fmn + is*fml + eflmac(ia,iz,0,3);
6026 G4double etot = avvmass / gamma;
6027 varntp->pxlab[intp] = etot * BU_TAB[i][4] / c;
6028 varntp->pylab[intp] = etot * BU_TAB[i][5] / c;
6029 varntp->pzlab[intp] = etot * BU_TAB[i][6] / c;
6030 varntp->enerj[intp] = etot - avvmass;
6031 intp++;
6032 }
6033
6034
6035 for(G4int i=0;i<IEV_TAB;i++){
6036
6037 G4int iz = nint(EV_TAB[i][0]);
6038 G4int ia = nint(EV_TAB[i][1]);
6039 G4int is = EV_TAB[i][5];
6040
6041 varntp->itypcasc[intp] = 0;
6042
6043 if(ia>0){// normal particles
6044 varntp->zvv[intp] = iz;
6045 varntp->avv[intp] = ia;
6046 varntp->svv[intp] = -1*is;
6047 Ainit = Ainit + ia;
6048 Zinit = Zinit + iz;
6049 Sinit = Sinit - is;
6050 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];
6051 G4double gamma = std::sqrt(1.0 - v2 / (c*c));
6052 G4double avvmass = iz*fmp + (ia-iz-is)*fmn + is*fml + eflmac(ia,iz,0,3);
6053 G4double etot = avvmass / gamma;
6054 varntp->pxlab[intp] = etot * EV_TAB[i][2] / c;
6055 varntp->pylab[intp] = etot * EV_TAB[i][3] / c;
6056 varntp->pzlab[intp] = etot * EV_TAB[i][4] / c;
6057 varntp->enerj[intp] = etot - avvmass;
6058 }else if(ia==-2){// lambda0
6059 varntp->zvv[intp] = 0;
6060 varntp->avv[intp] = 1;
6061 varntp->svv[intp] = -1;
6062 Ainit = Ainit + 1;
6063 Sinit = Sinit - 1;
6064 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];
6065 G4double gamma = std::sqrt(1.0 - v2 / (c*c));
6066 G4double avvmass = fml;
6067 G4double etot = avvmass / gamma;
6068 varntp->pxlab[intp] = etot * EV_TAB[i][2] / c;
6069 varntp->pylab[intp] = etot * EV_TAB[i][3] / c;
6070 varntp->pzlab[intp] = etot * EV_TAB[i][4] / c;
6071 varntp->enerj[intp] = etot - avvmass;
6072 }else{// photons
6073 varntp->zvv[intp] = iz;
6074 varntp->avv[intp] = ia;
6075 varntp->svv[intp] = 0;
6076 Ainit = Ainit + ia;
6077 Zinit = Zinit + iz;
6078 Sinit = Sinit - is;
6079 varntp->pxlab[intp] = EV_TAB[i][2];
6080 varntp->pylab[intp] = EV_TAB[i][3];
6081 varntp->pzlab[intp] = EV_TAB[i][4];
6082 varntp->enerj[intp] = 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]);
6083 }
6084 intp++;
6085 }
6086//
6087 return;
6088}
6089
6090// Utilities
6091
6093{
6094 if(a < b) {
6095 return a;
6096 }
6097 else {
6098 return b;
6099 }
6100}
6101
6103{
6104 if(a < b) {
6105 return a;
6106 }
6107 else {
6108 return b;
6109 }
6110}
6111
6113{
6114 if(a > b) {
6115 return a;
6116 }
6117 else {
6118 return b;
6119 }
6120}
6121
6123{
6124 if(a > b) {
6125 return a;
6126 }
6127 else {
6128 return b;
6129 }
6130}
6131
6133// A function that assigns the sign of the second argument to the
6134// absolute value of the first
6135
6136 if(b>=0){
6137 return std::abs(a);
6138 }else{
6139 return -1.0*std::abs(a);
6140 }
6141 return 0;
6142}
6143
6145// A function that assigns the sign of the second argument to the
6146// absolute value of the first
6147
6148 if(b>=0){
6149 return std::abs(a);
6150 }else{
6151 return -1*std::abs(a);
6152 }
6153 return 0;
6154}
6155
6157{
6158 G4double intpart = 0.0;
6159 G4double fractpart = 0.0;
6160 fractpart = std::modf(number, &intpart);
6161 if(number == 0) {
6162 return 0;
6163 }
6164 if(number > 0) {
6165 if(fractpart < 0.5) {
6166 return G4int(std::floor(number));
6167 }
6168 else {
6169 return G4int(std::ceil(number));
6170 }
6171 }
6172 if(number < 0) {
6173 if(fractpart < -0.5) {
6174 return G4int(std::floor(number));
6175 }
6176 else {
6177 return G4int(std::ceil(number));
6178 }
6179 }
6180
6181 return G4int(std::floor(number));
6182}
6183
6185{
6186 time_t mytime;
6187 tm *mylocaltime;
6188
6189 time(&mytime);
6190 mylocaltime = localtime(&mytime);
6191
6192 if(x == 0) {
6193 return(mylocaltime->tm_hour*60*60 + mylocaltime->tm_min*60 + mylocaltime->tm_sec);
6194 }
6195 else {
6196 return(mytime - x);
6197 }
6198}
6199
6201{
6202 if(b != 0) {
6203 return a%b;
6204 }
6205 else {
6206 return 0;
6207 }
6208}
6209
6211{
6212 G4double value = 0.0;
6213/*
6214 if(a < 0.0) {
6215 value = double(std::ceil(a));
6216 }
6217 else {
6218 value = double(std::floor(a));
6219 }
6220*/
6221 if(x-std::floor(x) <= std::ceil(x)-x)
6222 value = G4double(std::floor(x));
6223 else
6224 value = G4double(std::ceil(x));
6225
6226 return value;
6227}
6228
6230{
6231 G4int value = 0;
6232 if(x-std::floor(x) <= std::ceil(x)-x)
6233 value = G4int(std::floor(x));
6234 else
6235 value = G4int(std::ceil(x));
6236
6237 return value;
6238}
6239
6241{
6242 if(x-std::floor(x) <= std::ceil(x)-x)
6243 return G4int(std::floor(x));
6244 else
6245 return G4int(std::ceil(x));
6246}
6247
6249{
6250 if(a < b && a < c) {
6251 return a;
6252 }
6253 if(b < a && b < c) {
6254 return b;
6255 }
6256 if(c < a && c < b) {
6257 return c;
6258 }
6259 return a;
6260}
6261
6263{
6264 return std::abs(a);
6265}
6266
6267
6269{
6270/*
6271* Implemented by JLRS for Abla c++: 06/11/2016
6272*
6273C Last update:
6274C 28/10/13 - JLRS - from abrablav4 (AK)
6275*/
6276 G4int IZPART,IAPART,NMOTHER;
6277 G4double B,HBAR,PI,RGEOM,MPART,SB;
6278 G4double BKONST,C,C2,G,APARTNER,MU;
6279 G4double INT1,INT2,INT3,AKONST,EARG,R0,MPARTNER;
6280 G4double AEXP;
6281 G4double ARG;
6282 G4double PAR_A1=0.,PAR_B1=0.,FACT=1.;
6283 G4double fwidth=0.;
6284 G4int idlamb0=0;
6285 PI=3.141592654;
6286
6287 if(ZPART==-2.){
6288 ZPART=0.;
6289 idlamb0=1;
6290 }
6291
6292 IZPART = idnint(ZPART);
6293 IAPART = idnint(APART);
6294
6295 B = B1;
6296 SB = SB1;
6297 NMOTHER = idnint(AMOTHER-ZMOTHER);
6298
6299 PAR_A1 = 0.0;
6300 PAR_B1 = 0.0;
6301
6302 if(SB>EXC){
6303 return fwidth=0.0;
6304 }else{
6305// in MeV*s
6306 HBAR = 6.582122e-22;
6307// HBAR2 = HBAR * HBAR
6308// in m/s
6309 C = 2.99792458e8;
6310 C2 = C * C;
6311 APARTNER = AMOTHER - APART;
6312 MPARTNER = APARTNER * 931.49 / C2;
6313
6314// g=(2s+1)
6315 if(IAPART==1&&IZPART==0){
6316 G = 2.0;
6317 MPART = 939.56 / C2;
6318 if(idlamb0==1)MPART = 1115.683 / C2;
6319 }else{
6320 if(IAPART==1&&IZPART==1){
6321 G = 2.0;
6322 MPART = 938.27 / C2;
6323 }
6324 else{
6325 if(IAPART==2&&IZPART==0){
6326 G = 1.0;
6327 MPART = 2.*939.56 / C2;
6328 }else{
6329 if(IAPART==2&&IZPART==1){
6330 G = 3.0;
6331 MPART = 1876.10 / C2;
6332 }else{
6333 if(IAPART==3&&IZPART==1){
6334 G = 2.0;
6335 MPART = 2809.39 / C2;
6336 }else{
6337 if(IAPART==3&&IZPART==2){
6338 G = 2.0;
6339 MPART = 2809.37 / C2;
6340 }else{
6341 if(IAPART==4&&IZPART==2){
6342 G = 1.0;
6343 MPART = 3728.35 / C2;
6344 }else{
6345 // IMF
6346 G = 1.0;
6347 MPART = APART * 931.49 / C2;
6348 }
6349 }
6350 }
6351 }
6352 }
6353 }
6354 }//end g
6355
6356// Relative mass in MeV*s^2/m^2
6357 MU = MPARTNER * MPART / (MPARTNER + MPART);
6358// in m
6359 R0 = 1.16e-15;
6360
6361 RGEOM = R0 * (std::pow(APART,1.0/3.0)+std::pow(AMOTHER-APART,1.0/3.0));
6362
6363// in m*sqrt(MeV)
6364 AKONST = HBAR*std::sqrt(1.0 / MU);
6365
6366// in 1/(MeV*m^2)
6367 BKONST = MPART / ( PI * PI * HBAR * HBAR);
6368//
6369// USING ANALYTICAL APPROXIMATION
6370
6371 INT1 = 2.0 * std::pow(TEMP,3.) / (2.0 * TEMP + B);
6372
6373 ARG = std::sqrt(B/TEMP);
6374 EARG = (erf(ARG) - 1.0);
6375 if(std::abs(EARG)<1.e-9) EARG = 0.0;
6376 if(B==0.0){
6377 INT2 = 0.5 * std::sqrt(PI) * std::pow(TEMP,3.0/2.0);
6378 }else{
6379 AEXP = B/TEMP;
6380 if(AEXP>700.0) AEXP = 700.0;
6381 INT2 = (2.0*B*B +TEMP*B)/std::sqrt(B) + std::exp(AEXP) * std::sqrt(PI/(4.0*TEMP))*(4.0*B*B+4.0*B*TEMP - TEMP*TEMP) *EARG;
6382 if(INT2<0.0) INT2 = 0.0;
6383// For very low temperatures when EARG=0, INT2 get unreasonably high values
6384// comming from the first term. Therefore, for these cases INT2 is set to 0.
6385 if(EARG==0.0) INT2 = 0.0;
6386 }//if B
6387
6388 INT3 = 2.0*TEMP*TEMP*TEMP / (2.0*TEMP*TEMP + 4.0*B*TEMP + B*B);
6389
6390 if(IZPART<-1.0&&ZMOTHER<151.0){
6391// IF(IZPART.LT.1)THEN
6392// For neutrons, the width is given by a mean value between geometrical and QM values;
6393// Only QM contribution (Rgeom -> Rgeom + Rlamda) seems to be too strong for neutrons
6394 fwidth = PI * BKONST * G * std::sqrt((RGEOM * RGEOM * INT1 + 2.0 * AKONST * RGEOM * INT2 + AKONST * AKONST * INT3) * RGEOM * RGEOM * INT1);
6395
6396 }else{
6397 fwidth = PI * BKONST * G *(RGEOM * RGEOM * INT1 + 2.0 * AKONST * RGEOM * INT2 + AKONST * AKONST * INT3);
6398 }
6399
6400
6401// To correct for too high values of analytical width compared to
6402// numerical solution for energies close to the particle threshold:
6403 if(IZPART<3.0){
6404 if(AMOTHER<155.0){
6405 PAR_A1=std::exp(2.302585*0.2083*std::exp(-0.01548472*AMOTHER))-0.05;
6406 PAR_B1 = 0.59939389 + 0.00915657 * AMOTHER;
6407 }else{
6408 if(AMOTHER>154.0&&AMOTHER<195.0){
6409 PAR_A1=1.0086961-8.629e-5*AMOTHER;
6410 PAR_B1 = 1.5329331 + 0.00302074 * AMOTHER;
6411 }else{
6412 if(AMOTHER>194.0&&AMOTHER<208.0){
6413 PAR_A1=9.8356347-0.09294663*AMOTHER+2.441e-4*AMOTHER*AMOTHER;
6414 PAR_B1 = 7.7701987 - 0.02897401 * AMOTHER;
6415 }else{
6416 if(AMOTHER>207.0&&AMOTHER<228.0){
6417 PAR_A1=15.107385-0.12414415*AMOTHER+2.7222e-4*AMOTHER*AMOTHER;
6418 PAR_B1=-64.078009+0.56813179*AMOTHER-0.00121078*AMOTHER*AMOTHER;
6419 }else{
6420 if(AMOTHER>227.0){
6421 if(mod(NMOTHER,2)==0&&NMOTHER>147.){
6422 PAR_A1 = 2.0*(0.9389118 + 6.4559e-5 * AMOTHER);
6423 }else{
6424 if(mod(NMOTHER,2)==1)PAR_A1 = 3.0*(0.9389118 + 6.4559e-5 * AMOTHER);
6425 }
6426 PAR_B1 = 2.1507177 + 0.00146119 * AMOTHER;
6427 }
6428 }
6429 }
6430 }
6431 }
6432 FACT = std::exp((2.302585*PAR_A1*std::exp(-PAR_B1*(EXC-SB))));
6433 if(FACT<1.0) FACT = 1.0;
6434 if(IZPART<-1.&&ZMOTHER<151.0){
6435// IF(IZPART.LT.1)THEN
6436 fwidth = fwidth / std::sqrt(FACT);
6437 }else{
6438 fwidth = fwidth / FACT;
6439 }
6440 }//if IZPART<3.0
6441
6442 if(fwidth<=0.0){
6443 std::cout <<"LOOK IN PARTICLE_WIDTH!" << std::endl;
6444 std::cout <<"ACN,APART :"<< AMOTHER << APART << std::endl;
6445 std::cout <<"EXC,TEMP,B,SB :" << EXC << " " << TEMP << " " << B << " " << SB << std::endl;
6446 std::cout <<"INTi, i=1-3 :" << INT1 << " " << INT2 << " " << INT3 << std::endl;
6447 std::cout <<" " << std::endl;
6448 }
6449
6450 }//if SB>EXC
6451 return fwidth;
6452}
6453
6455{
6456// JLRS: 06/11/2016
6457// CORRECTIONS FOR BARRIER PENETRATION
6458// AK, KHS 2005 - Energy-dependen inverse cross sections included, influence of
6459// Coulomb barrier for LCP, tunnelling for LCP
6460
6461 G4double fpen=0., MU, HO;
6462
6463// REDUCED MASSES (IN MeV/C**2)
6464 MU = (A - ap) * ap / A;
6465
6466// ENERGY OF THE INVERSE PARABOLA AT THE POTENTIAL BARRIER (hbar*omega);
6467// HERE hbar = 197.3287 fm*MeV/c, omega is in c/fm
6468 HO = 197.3287 * omega;
6469
6470 if(T<=0.0){
6471 fpen = 0.0;
6472 }else{
6473 fpen=std::pow(10.0,4.e-4*std::pow(T/(HO*HO*std::pow(MU,0.25)),-4.3/2.3026));
6474 }
6475
6476 return fpen;
6477}
6478
6480{
6481// Calculate BS and BK needed for a level-density parameter:
6482// BETA2 and BETA4 = quadrupole and hexadecapole deformation
6483
6484 G4double PI = 3.14159265;
6485 G4int IZ = idnint(Z);
6486 G4int IN = idnint(A - Z);
6487// alphaN = sqrt(2*N/(4*pi))*BetaN
6488 G4double ALPHA2 = std::sqrt(5.0/(4.0*PI))*ecld->beta2[IN][IZ];
6489 G4double ALPHA4 = std::sqrt(9.0/(4.0*PI))*ecld->beta4[IN][IZ];
6490
6491 (*BS) = 1.0 + 0.4*ALPHA2*ALPHA2 - 4.0/105.0*ALPHA2*ALPHA2*ALPHA2 - 66.0/175.0*ALPHA2*ALPHA2*ALPHA2*ALPHA2 - 4.0/35.0*ALPHA2*ALPHA2*ALPHA4 + ALPHA4*ALPHA4;
6492
6493 (*BK) = 1.0 + 0.4*ALPHA2*ALPHA2 + 16.0/105.0*ALPHA2*ALPHA2*ALPHA2 - 82.0/175.0*ALPHA2*ALPHA2*ALPHA2*ALPHA2 + 2.0/35.0*ALPHA2*ALPHA2*ALPHA4 + ALPHA4*ALPHA4;
6494
6495 (*BC)=0.0;
6496
6497 return;
6498}
6499
6501{
6502// Random generator according to a distribution similar to a
6503// Maxwell distribution with quantum-mech. x-section for charged particles according to KHS
6504// Y = X**(1.5E0) / (B+X) * EXP(-X/T) (approximation:)
6505
6506return (3.0 * T * std::pow(-1.*std::log(G4AblaRandom::flat()) * std::log(G4AblaRandom::flat())*std::log(G4AblaRandom::flat()),0.333333));
6507}
6508
6510{
6511/*
6512c This function determines the fission width as a function o time
6513c according to the analytical solution of the FPE for the probability distribution
6514c at the barrier when the nucleus potential is aproximated by a parabolic
6515c potential. It is taken from S. Chandrasekhar, Rev. Mod. Phys. 15 (1943) 1
6516c
6517c***********************INPUT PARAMETERS*********************************
6518c Time Time at which we evaluate the fission width
6519c ZF Z of nucleus
6520C AF A of nucleus
6521c BET Reduced dissipation coefficient
6522c FT Nuclear temperature
6523C**************************************************************************
6524C********************************OUTPUT***********************************
6525C Fission decay width at the corresponding time of the decay cascade
6526C*************************************************************************
6527c****************************OTHER VARIABLES******************************
6528C SIGMA_SQR Square of the width of the prob. distribution
6529C XB Deformation of the nucleus at the saddle point
6530c NORM Normalization factor of the probability distribution
6531c W Probability distribution at the saddle deformation XB
6532c W_INFIN Probability distr. at XB at infinite time
6533c MFCD Mass of the fission collective degree of freedom
6534C*************************************************************************
6535*/
6536 G4double PI = 3.14159;
6537 G4double DEFO_INIT,OMEGA,HOMEGA,OMEGA_GS,HOMEGA_GS,K1,MFCD;
6538 G4double BET1,XACT,SIGMA_SQR,W_EXP,XB,NORM,SIGMA_SQR_INF,W_INFIN,W;
6539 G4double FUNC_TRANS,LOG_SLOPE_INF,LOG_SLOPE_ABS;
6540//
6541// Influence of initial deformation
6542// Initial alpha2 deformation (GS)
6543 DEFO_INIT = std::sqrt(5.0/(4.0*PI))*ecld->beta2[fiss->at-fiss->zt][fiss->zt];
6544//
6545 fomega_sp(AF,Y,&MFCD,&OMEGA,&HOMEGA);
6546 fomega_gs(AF,ZF,&K1,&OMEGA_GS,&HOMEGA_GS);
6547//
6548// Determination of the square of the width of the probability distribution
6549// For the overdamped regime BET**2 > 4*OMEGA**2
6550 if((bet*bet)>4.0*OMEGA_GS*OMEGA_GS){
6551 BET1=std::sqrt(bet*bet-4.0*OMEGA_GS*OMEGA_GS);
6552//
6553// REMEMBER THAT HOMEGA IS ACTUALLY HBAR*HOMEGA1=1MeV
6554// SO THAT HOMEGA1 = HOMEGA/HBAR
6555//
6556 SIGMA_SQR = (FT/K1)*(1.0 -((2.0*bet*bet/(BET1*BET1)* (0.5 * (std::exp(0.50*(BET1-bet)*1.e21*TIME) - std::exp(0.5*(-BET1-bet)*1.e21*TIME)))*(0.5 * (std::exp(0.50*(BET1-bet)*1.e21*TIME) - std::exp(0.5*(-BET1-bet)*1.e21*TIME)))) + (bet/BET1*0.50 * (std::exp((BET1-bet)*1.e21*TIME)-std::exp((-BET1-bet)*1.e21*TIME))) + 1. * std::exp(-bet*1.e21*TIME)));
6557//
6558// Evolution of the mean x-value (KHS March 2006)
6559 XACT = DEFO_INIT *std::exp(-0.5*(bet-BET1)*1.e21*(TIME-T_0));
6560//
6561 }else{
6562// For the underdamped regime BET**2 < 4*HOMEGA**2 BET1 becomes a complex number
6563// and the expression with sinh and cosh can be transformed in one with sin and cos
6564 BET1=std::sqrt(4.0*OMEGA_GS*OMEGA_GS-bet*bet);
6565 SIGMA_SQR = FT/K1*(1.-std::exp(-1.0*bet*1.e21*TIME)*(bet*bet/(BET1*BET1)*(1.-std::cos(BET1*1.e21*TIME)) + bet/BET1*std::sin(BET1*1.e21*TIME) + 1.0));
6566 XACT = DEFO_INIT*std::cos(0.5*BET1*1.e21*(TIME-T_0))*std::exp(-bet*1.e21*(TIME-T_0));
6567 }
6568
6569// Determination of the deformation at the saddle point according to
6570// "Geometrical relationships of Macroscopic Nucl. Phys." from Hass and Myers page 100
6571// This corresponds to alpha2 deformation.
6572 XB = 7./3.*Y-938./765.*Y*Y+9.499768*Y*Y*Y-8.050944*Y*Y*Y*Y;
6573//
6574// Determination of the probability distribution at the saddle deformation
6575//
6576 if(SIGMA_SQR>0.0){
6577 NORM = 1./std::sqrt(2.*PI*SIGMA_SQR);
6578//
6579 W_EXP = -1.*(XB - XACT)*(XB - XACT)/(2.0 * SIGMA_SQR);
6580 if(W_EXP<(-708.0) ) W_EXP = -708.0;
6581 W = NORM * std::exp( W_EXP ) * FT / (K1 * SIGMA_SQR);
6582 }else{
6583 W = 0.0;
6584 }
6585//
6586// Determination of the fission decay width, we assume we are in the overdamped regime
6587//
6588 SIGMA_SQR_INF = FT/K1;
6589 W_EXP = -XB*XB/(2.0 * SIGMA_SQR_INF);
6590 if(W_EXP<(-708.0))W_EXP = -708.0;
6591 W_INFIN = std::exp(W_EXP)/std::sqrt(2.0*PI*SIGMA_SQR_INF);
6592 FUNC_TRANS = W / W_INFIN;
6593//
6594// Correction for the variation of the mean velocity at the fission barrier
6595// (see B. Jurado et al, Nucl. Phys. A747, p. 14)
6596//
6597 LOG_SLOPE_INF = cram(bet,HOMEGA)*bet*MFCD*OMEGA/FT;
6598 LOG_SLOPE_ABS = (XB-XACT)/SIGMA_SQR-XB/SIGMA_SQR_INF+cram(bet,HOMEGA)*bet*MFCD*OMEGA/FT;
6599//
6600 FUNC_TRANS = FUNC_TRANS * LOG_SLOPE_ABS/LOG_SLOPE_INF;
6601//
6602 return FUNC_TRANS;
6603}
6604
6605
6607{
6608/*
6609C THIS SUBROUTINE IS AIMED TO CHOOSE BETWEEN PARTICLE EMISSION
6610C AND FISSION
6611C WE USE MONTE-CARLO METHODS AND SAMPLE TIME BETWEEN T=0 AND T=1.5*TAUF
6612c TO SIMULATE THE TRANSIENT TIME WITH 30 STEPS (0.05*TAUF EACH)
6613C FOR t>1.5*TAUF , GF=CONSTANT=ASYMPTOTICAL VALUE (INCLUDING KRAMERS FACTOR)
6614c------------------------------------------------------------------------
6615c Modifications introduced by BEATRIZ JURADO 18/10/01:
6616c 1. Now this subrutine is included in the rutine direct
6617c 2. TSUM does not include the current particle decay time
6618C 3. T_LAPSE is the time until decay, taken as an output variable
6619C 4. GF_LOC is also taken as an output variable
6620C 5. BET (Diss. Coeff.) and HOMEGA (Frequency at the ground state
6621c are included as input variables because they are needed for FUNC_TRANS
6622C-----------------------------------------------------------------------
6623C ON INPUT:
6624C GP Partial particle decay width
6625C GF Asymptotic value of Gamma-f, including Kramers factor
6626C AF Mass number of nucleus
6627C TAUF Transient time
6628C TS1 Partial particle decay time for the next step
6629C TSUM Total sum of partial particle decay times, including
6630C the next expected one, which is in competition
6631C with fission now
6632C ZF Z of nucleus
6633C AF A of nucleus
6634C-----------------------------------------------------------------------
6635C ON OUTPUT:
6636C CHOICE Key for decay mode: 0 = no decay (only internal)
6637C 1 = evaporation
6638C 2 = fission
6639C-----------------------------------------------------------------------
6640C VARIABLES:
6641C GP Partial particle decay width
6642C GF Asymptotic value of Gamma-f, including Kramers factor
6643C TAUF Transient time
6644C TS1 Partial particle decay time
6645C TSUM Total sum of partial particle decay times
6646C CHOICE Key for decay mode
6647C ZF Z of nucleus
6648C AF A of nucleus
6649C FT Used for Fermi function in FUNC_TRANS
6650C STEP_LENGTH Step in time to sample different decays
6651C BEGIN_TIME Total sum of partial particle decay times, excluding
6652C the next expected one, which is in competition
6653C with fission now
6654C LOC_TIME_BEGIN Begin of time interval considered in one step
6655C LOC_TIME_END End of time interval considered in one step
6656C GF_LOC In-grow function for fission width,
6657c normalized to asymptotic value
6658C TS2 Effective partial fission decay time in one time step
6659C HBAR hbar
6660C T_LAPSE Effective decay time in one time step
6661C REAC_PROB Reaction probability in one time step
6662C X Help variable for random generator
6663C------------------------------------------------------------------------
6664*/
6665 G4double K1,OMEGA,HOMEGA,t_0,STEP_LENGTH,LOC_TIME_BEGIN,LOC_TIME_END=0.,BEGIN_TIME=0.,FISS_PROB,X,TS2,LAMBDA,REAC_PROB;
6666 G4double HBAR=6.582122e-22;
6667 G4int fchoice=0;
6668 G4double fGF_LOC=0.,fT_LAPSE=0.;
6669//
6670 if(GF<=0.0){
6671 *CHOICE = 1;
6672 *T_LAPSE=TS1;
6673 *GF_LOC = 0.0;
6674 goto direct107;
6675 }
6676//
6677 fomega_gs(AF,ZF,&K1,&OMEGA,&HOMEGA);
6678//
6679// ****************************************************************
6680// Calculation of the shift in time due to the initial conditions
6681//
6682// Overdamped regime
6683 if(BET*BET>4.0*OMEGA*OMEGA){
6684// REMEMBER THAT HOMEGA IS ACTUALLY HBAR*HOMEGA1=1MeV
6685// SO THAT HOMEGA1 = HOMEGA/HBAR
6686// Additional factor 1/16 proposed by KHS on 14/7/2010. Takes into
6687// account the fact that the curvature of the potential is ~16 times
6688// larger than what predicted by the liquid drop model, because of
6689// shell effects.
6690 t_0 = BET*1.e21*HBAR*HBAR/(4.*HOMEGA*FT)/16.;
6691 }else{
6692// Underdamped regime
6693 if(((2.*FT-HOMEGA/16.)>0.000001) && BET>0.0){
6694// Additional factor 1/16 proposed by KHS on 14/7/2010. Takes into
6695// account the fact that the curvature of the potential is ~16 times
6696// larger than what predicted by the liquid drop model, because of
6697// shell effects.
6698 t_0 = (std::log(2.*FT/(2.*FT-HOMEGA/16.)))/(BET*1.e21);
6699 }else{
6700// Neglect fission transients if the time shift t_0 is too
6701// large. Suppresses large, spurious fission cross section at very
6702// low excitation energy in p+Ta.
6703//
6704 fchoice = 0;
6705 goto direct106;
6706 }
6707 }
6708// ********************************************************************+
6709 fchoice = 0;
6710 STEP_LENGTH = 1.5*TAUF/50.;
6711//
6712// AT FIRST WE CACULATE THE REAL CURRENT TIME
6713// TSUM includes only the time elapsed in the previous steps
6714//
6715 BEGIN_TIME = TSUM + t_0;
6716//
6717 if(BEGIN_TIME<0.0) std::cout << "CURRENT TIME < 0" << BEGIN_TIME << std::endl;
6718//
6719 if(BEGIN_TIME<1.50*TAUF){
6720 LOC_TIME_BEGIN = BEGIN_TIME;
6721//
6722 while((LOC_TIME_BEGIN<1.5*TAUF)&&fchoice==0){
6723
6724 LOC_TIME_END = LOC_TIME_BEGIN + STEP_LENGTH;
6725//
6726// NOW WE ESTIMATE THE MEAN VALUE OF THE FISSION WIDTH WITHIN THE SMALL INTERVAL
6727 fGF_LOC=(func_trans(LOC_TIME_BEGIN,ZF,AF,BET,Y,FT,t_0)+func_trans(LOC_TIME_END,ZF,AF,BET,Y,FT,t_0))/2.0;
6728//
6729 fGF_LOC = fGF_LOC * GF;
6730
6731// TS2 IS THE MEAN DECAY TIME OF THE FISSION CHANNEL
6732 if(fGF_LOC>0.0){
6733 TS2 = HBAR/fGF_LOC;
6734 }else{
6735 TS2 = 0.0;
6736 }
6737//
6738 if(TS2>0.0){
6739 LAMBDA = 1.0/TS1 + 1.0/TS2;
6740 }else{
6741 LAMBDA = 1.0/TS1;
6742 }
6743//
6744// This is the probability to survive the decay at this step
6745 REAC_PROB = std::exp(-1.0*STEP_LENGTH*LAMBDA);
6746// I GENERATE A RANDOM NUMBER
6747 X = G4AblaRandom::flat();
6748 if(X>REAC_PROB){
6749// THEN THE EVAPORATION OR FISSION HAS OCCURED
6750 FISS_PROB = fGF_LOC / (fGF_LOC+GP);
6751 X = G4AblaRandom::flat();
6752// WRITE(6,*)'X=',X
6753 if(X<FISS_PROB){
6754// FISSION OCCURED
6755 fchoice = 2;
6756 }else{
6757// EVAPORATION OCCURED
6758 fchoice = 1;
6759 }
6760 }// if x
6761 LOC_TIME_BEGIN = LOC_TIME_END;
6762 }// while
6763// Take the real decay time of this decay step
6764 fT_LAPSE = LOC_TIME_END - BEGIN_TIME;
6765 }// if BEGIN_TIME
6766//
6767// NOW, IF NOTHING HAPPENED DURING TRANSIENT TIME
6768 direct106:
6769 if(fchoice==0){
6770 fGF_LOC=GF;
6771 FISS_PROB = GF / (GF+GP);
6772
6773// Added for cases where already at the beginning BEGIN_TIME > 1.5d0*TAUF
6774 if(GF>0.0){
6775 TS2 = HBAR/GF;
6776 }else{
6777 TS2 = 0.0;
6778 }
6779
6780 if(TS2>0.0){
6781 LAMBDA = 1./TS1 + 1./TS2;
6782 }else{
6783 LAMBDA = 1./TS1;
6784 }
6785//
6786 X = G4AblaRandom::flat();
6787
6788 if(X<FISS_PROB){
6789// FISSION OCCURED
6790 fchoice = 2;
6791 }else{
6792// EVAPORATION OCCURED
6793 fchoice = 1;
6794 }
6795//
6796//TIRAGE ALEATOIRE DANS UNE EXPONENTIELLLE : Y=EXP(-X/T)
6797// EXPOHAZ=-T*LOG(HAZ(K))
6798 fT_LAPSE = fT_LAPSE -1.0/LAMBDA*std::log(G4AblaRandom::flat());
6799 }
6800//
6801 direct107:
6802
6803 (*T_LAPSE)=fT_LAPSE;
6804 (*GF_LOC)=fGF_LOC;
6805 (*CHOICE)=fchoice;
6806 return;
6807}
6808
6810{
6811// Subroutine to caluclate fission width with included effects
6812// of tunnelling through the fission barrier
6813
6814 G4double PI = 3.14159;
6815 G4int IZ, IN;
6816 G4double MFCD,OMEGA,HOMEGA1,HOMEGA2=0.,GFTUN;
6817 G4double E1,E2,EXP_FACT,CORR_FUNCT,FACT1,FACT2,FACT3;
6818
6819 IZ = idnint(ZPRF);
6820 IN = idnint(A-ZPRF);
6821
6822// For low energies system "sees" LD barrier
6823 fomega_sp(A,Y,&MFCD,&OMEGA,&HOMEGA1);
6824
6825 if(mod(IN,2)==0&&mod(IZ,2)==0){ // e-e
6826// Due to pairing gap, even-even nuclei cannot tunnel for excitation energy lower
6827// than pairing gap (no levels at which system can be)
6828 EE = EE - 12.0/std::sqrt(A);
6829 HOMEGA2 = 1.04;
6830 }
6831
6832 if(mod(IN,2)==1&&mod(IZ,2)==1){ // o-o
6833 HOMEGA2 = 0.65;
6834 }
6835
6836 if(mod(IN,2)==1&&mod(IZ,2)==0){ // o-e
6837 HOMEGA2 = 0.8;
6838 }
6839
6840 if(mod(IN,2)==0&&mod(IZ,2)==1){ // e-0
6841 HOMEGA2 = 0.8;
6842 }
6843
6844 E1 = EF + HOMEGA1/2.0/PI*std::log(HOMEGA1*(2.0*PI+HOMEGA2)/4.0/PI/PI);
6845
6846 E2 = EF + HOMEGA2/(2.0*PI)*std::log(1.0+2.0*PI/HOMEGA2);
6847
6848// AKH May 2013 - Due to approximations in the analytical integration, at energies
6849// just above barrier Pf was to low, at energies below
6850// barrier it was somewhat higher. LInes below are supposed to correct for this.
6851// Factor 0.20 in EXP_FACT comes from the slope of the Pf(Eexc) (Gavron's data)
6852// around fission barrier.
6853 EXP_FACT = (EE-EF)/(HOMEGA2/(2.0*PI));
6854 if(EXP_FACT>700.0) EXP_FACT = 700.0;
6855 CORR_FUNCT = HOMEGA1 * (1.0-1.0/(1.0+std::exp(EXP_FACT)));
6856 if(mod(IN,2)==0&&mod(IZ,2)==0){
6857 CORR_FUNCT = HOMEGA1 * (1.0-1.0/(1.0+std::exp(EXP_FACT)));
6858 }
6859
6860 FACT1 = HOMEGA1/(2.0*PI*TEMP+HOMEGA1);
6861 FACT2 = (2.0*PI/(2.0*PI+HOMEGA2)-HOMEGA1*(2.0*PI+HOMEGA2)/4.0/PI/PI)/(E2-E1);
6862 FACT3 = HOMEGA2/(2.0*PI*TEMP-HOMEGA2);
6863
6864 if(EE<E1){
6865 GFTUN = FACT1*(std::exp(EE/TEMP)*std::exp(2.0*PI*(EE-EF)/HOMEGA1)-std::exp(-2.0*PI*EF/HOMEGA1));
6866 }else{
6867 if(EE>=E1&&EE<E2){
6868 GFTUN = std::exp(EE/TEMP)*(0.50+FACT2*(EE-EF-TEMP))-std::exp(E1/TEMP)*(0.5+FACT2*(E1-EF-TEMP))+FACT1*(std::exp(E1/TEMP)*std::exp(2.0*PI*(E1-EF)/HOMEGA1)-std::exp(-2.0*PI*EF/HOMEGA1));
6869 }else{
6870 GFTUN = std::exp(EE/TEMP)*(1.0+FACT3*std::exp(-2.0*PI*(EE-EF)/HOMEGA2))-std::exp(E2/TEMP)*(1.0+FACT3*std::exp(-2.0*PI*(E2-EF)/HOMEGA2))+std::exp(E2/TEMP)*(0.5+FACT2*(E2-EF-TEMP))-std::exp(E1/TEMP)*(0.5+FACT2*(E1-EF-TEMP))+FACT1*(std::exp(E1/TEMP)*std::exp(2.0*PI*(E1-EF)/HOMEGA1)-std::exp(-2.0*PI*EF/HOMEGA1));
6871 }
6872 }
6873 GFTUN = GFTUN/std::exp(EE/TEMP)*DENSF*ENH_FACT/DENSG/2.0/PI;
6874 GFTUN = GFTUN * CORR_FUNCT;
6875 return GFTUN;
6876}
6877
6878
6879void G4Abla::fission_width(G4double ZPRF,G4double A,G4double EE,G4double BS,G4double BK,G4double EF,G4double Y,G4double *GF,G4double *TEMP,G4double JPR,G4int IEROT,G4int FF_ALLOWED,G4int OPTCOL,G4int OPTSHP,G4double DENSG)
6880{
6881//
6882 G4double FNORM,MASS_ASYM_SADD_B,FP_PER,FP_PAR,SIG_PER_SP,SIG_PAR_SP;
6883 G4double Z2OVERA,ftemp,fgf,DENSF,ECOR,EROT,qr;
6884 G4double DCR,UCR,ENH_FACTA,ENH_FACTB,ENH_FACT,PONFE;
6885 G4double PI = 3.14159;
6886
6887 DCR = fiss->dcr;
6888 UCR = fiss->ucr;
6889 Z2OVERA = ZPRF * ZPRF / A;
6890
6891// Nuclei below Businaro-Gallone point do not go through fission
6892 if((ZPRF<=55.0) || (FF_ALLOWED==0)){
6893 (*GF) = 0.0;
6894 (*TEMP) = 0.5;
6895 return;
6896 }
6897
6898// Level density above SP
6899// Saddle-point deformation is defbet as above. But, FP_PER and FP_PAR
6900// are calculated for fission in DENSNIV acc to Myers and Hasse, and their
6901// parametrization is done as function of y
6902 densniv(A,ZPRF,EE,EF,&DENSF,0.0,BS,BK,&ftemp,OPTSHP,0,Y,&ECOR,JPR,1,&qr);
6903
6904 if(OPTCOL==0){
6905 fgf= DENSF/DENSG/PI/2.0*ftemp;
6906 (*TEMP)=ftemp;
6907 (*GF)= fgf;
6908 return;
6909 }
6910
6911// FP = 2/5*M0*R0**2/HBAR**2 * A**(5/3) * (1 + DEFBET/3)
6912// FP is used to calculate the spin-cutoff parameter SIG=FP*TEMP/hbar**2; hbar**2
6913// is, therefore, included in FP in order to avoid problems with large exponents
6914// The factor fnorm inlcudes then R0, M0 and hbar**2 -
6915// fnorm = R0*M0/hbar**2 = 1.2fm*931.49MeV/c**2 /(6.582122e-22 MeVs)**2 and is
6916// in units 1/MeV
6917 FNORM = 1.2*1.2 * 931.49 * 1.e-2 / (9.0 * 6.582122*6.582122);
6918// FP_PER ~ 1+7*y/6, FP_PAR ~ 1-7*y/3 (Hasse & Myers, Geom. relat. macr. nucl. phys.)
6919// Perpendicular moment of inertia
6920 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));
6921
6922// AK - Jan 2011 - following line is needed, as for these nuclei it seems that
6923// FP_PER calculated according to above formula has too large values, leading to too
6924// large ENH_FACT
6925 if(Z2OVERA<=30.0) FP_PER = 6.50;
6926
6927// Parallel moment of inertia
6928 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));
6929 if(FP_PAR<0.0) FP_PAR = 0.0;
6930
6931 EROT = JPR * JPR / (2.0 * std::sqrt(FP_PAR*FP_PAR + FP_PER*FP_PER));
6932 if(IEROT==1) EROT = 0.0;
6933
6934// Perpendicular spin cut-off parameter
6935 SIG_PER_SP = std::sqrt(FP_PER * ftemp);
6936
6937 if(SIG_PER_SP<1.0) SIG_PER_SP = 1.0;
6938
6939// Parallel spin cut-off parameter
6940 SIG_PAR_SP = std::sqrt(FP_PAR * ftemp);
6941 ENH_FACT = 1.0;
6942//
6943 if(A>223.0){
6944 MASS_ASYM_SADD_B = 2.0;
6945 }else{
6946 MASS_ASYM_SADD_B = 1.0;
6947 }
6948
6949// actinides with low barriers
6950 if(Z2OVERA>35.&&Z2OVERA<=(110.*110./298.0)){
6951// Barrier A is axial asymmetric
6952 ENH_FACTA = std::sqrt(8.0*PI) * SIG_PER_SP*SIG_PER_SP * SIG_PAR_SP;
6953// Barrier B is axial symmetric
6954 ENH_FACTB = MASS_ASYM_SADD_B * SIG_PER_SP*SIG_PER_SP;
6955// Total enhancement
6956 ENH_FACT = ENH_FACTA * ENH_FACTB / (ENH_FACTA + ENH_FACTB);
6957 }else{
6958// nuclei with high fission barriers (only barrier B plays a role, axial symmetric)
6959 if(Z2OVERA<=35.){
6960 ENH_FACT = MASS_ASYM_SADD_B*SIG_PER_SP*SIG_PER_SP;
6961 }else{
6962// super-heavy nuclei (only barrier A plays a role, axial asymmetric)
6963 ENH_FACT = std::sqrt(8.0*PI) * SIG_PER_SP*SIG_PER_SP* SIG_PAR_SP;
6964 }
6965 }
6966
6967// Fading-out with excitation energy above the saddle point:
6968 PONFE = (ECOR-UCR-EROT)/DCR;
6969 if(PONFE>700.) PONFE = 700.0;
6970// Fading-out according to Junghans:
6971 ENH_FACT = 1.0/(1.0+std::exp(PONFE))*ENH_FACT+1.0;
6972
6973 if(ENH_FACT<1.0)ENH_FACT = 1.0;
6974 fgf= DENSF/DENSG/PI/2.0*ftemp*ENH_FACT;
6975
6976// Tunneling
6977 if(EE<EF+1.){
6978 fgf=tunnelling(A,ZPRF,Y,EE,EF,ftemp,DENSG,DENSF,ENH_FACT);
6979 }
6980//
6981 (*GF)= fgf;
6982 (*TEMP)=ftemp;
6983 return;
6984}
6985
6986
6987void G4Abla::lorb(G4double AMOTHER,G4double ADAUGHTER,G4double LMOTHER,G4double EEFINAL,G4double *LORBITAL,G4double *SIGMA_LORBITAL)
6988{
6989
6990 G4double AFRAGMENT,S4FINAL,ALEVDENS;
6991 G4double THETA_MOTHER,THETA_ORBITAL;
6992
6993/*
6994C Values on input:
6995C AMOTHER mass of mother nucleus
6996C ADAUGHTER mass of daughter fragment
6997C LMOTHER angular momentum of mother (may be real)
6998C EEFINAL excitation energy after emission
6999C (sum of daughter and fragment)
7000C
7001C Values on output:
7002C LORBITAL mean value of orbital angular momentum
7003C (assumed to be fully aligned with LMOTHER)
7004C SIGMA_LORBITAL standard deviation of the orbital angular momentum
7005*/
7006 if (EEFINAL<=0.01) EEFINAL = 0.01;
7007 AFRAGMENT = AMOTHER - ADAUGHTER;
7008 ALEVDENS = 0.073*AMOTHER + 0.095*std::pow(AMOTHER,2.0/3.0);
7009 S4FINAL = ALEVDENS * EEFINAL;
7010 if(S4FINAL <= 0.0 || S4FINAL > 100000.){
7011 std::cout<< "S4FINAL:" << S4FINAL << ALEVDENS << EEFINAL << idnint(AMOTHER) << idnint(AFRAGMENT) << std::endl;
7012 }
7013 THETA_MOTHER = 0.0111 * std::pow(AMOTHER,1.66667);
7014 THETA_ORBITAL = 0.0323 / std::pow(AMOTHER,2.) *std::pow(std::pow(AFRAGMENT,0.33333) + std::pow(ADAUGHTER,0.33333),2.) * AFRAGMENT*ADAUGHTER*(AFRAGMENT+ADAUGHTER);
7015
7016 *LORBITAL = -1.* THETA_ORBITAL * (LMOTHER / THETA_MOTHER + std::sqrt(S4FINAL) /(ALEVDENS*LMOTHER));
7017
7018 *SIGMA_LORBITAL = std::sqrt(std::sqrt(S4FINAL) * THETA_ORBITAL / ALEVDENS);
7019
7020 return;
7021}
7022
7023// Random generator according to a distribution similar to a
7024// Maxwell distribution with quantum-mech. x-section for neutrons according to KHS
7025// Y = SQRT(X) * EXP(-X/T) (approximation:)
7027
7028 return (2.0 * x * std::sqrt(std::log(G4AblaRandom::flat()) * std::log(G4AblaRandom::flat())));
7029}
7030
7031void G4Abla::imf(G4double ACN,G4double ZCN,G4double TEMP,G4double EE,G4double *ZIMF,G4double *AIMF,G4double *BIMF,G4double *SBIMF,G4double *TIMF,G4double JPRF)
7032{
7033// input variables (compound nucleus) Acn, Zcn, Temp, EE
7034// output variable (IMF) Zimf,Aimf,Bimf,Sbimf,IRNDM
7035//
7036// SBIMF = separation energy + coulomb barrier
7037//
7038// SDW(Z) is the sum over all isotopes for a given Z of the decay widths
7039// DW(Z,A) is the decay width of a certain nuclide
7040//
7041// Last update:
7042// 28/10/13 - JLRS - from abrablav4 (AK)
7043// 13/11/16 - JLRS - Included this function in Abla++
7044
7045 G4int IZIMFMAX=0;
7046 G4int iz=0,in=0,IZIMF=0,INMI=0,INMA=0,IZCN=0,INCN=0,INIMFMI=0,INIMFMA=0,ILIMMAX=0,INNMAX=0,INMIN=0,IAIMF=0,IZSTOP=3,IZMEM=0,IA=0,INMINMEM=0,INMAXMEM=0,IIA=0;
7047 G4double BS=0,BK=0,BC=0,BSHELL=0,DEFBET=0,DEFBETIMF=0,EROT=0,MAIMF=0,MAZ=0,MARES=0,AIMF_1,OMEGAP=0,fBIMF=0.0,BSIMF=0,A1PAR=0,A2PAR=0,SUM_A,EEDAUG;
7048 G4double DENSCN=0,TEMPCN=0,ECOR=0,IINERT=0,EROTCN=0,WIDTH_IMF=0.0,WIDTH1=0,IMFARG=0,QR=0,QRCN=0,DENSIMF=0,fTIMF=0,fZIMF=0,fAIMF=0.0,NIMF=0,fSBIMF=0;
7049 G4double PI = 3.141592653589793238;
7050 G4double ZIMF_1=0.0;
7051 G4double SDWprevious=0,SUMDW_TOT=0,SUM_Z=0,X=0,SUMDW_N_TOT=0,XX=0;
7052 G4double SDW[98];
7053 G4double DW[98][251];
7054 G4double BBIMF[98][251];
7055 G4double SSBIMF[98][251];
7056 G4int OPTSHPIMF=opt->optshpimf;
7057
7058 // Initialization
7059 for (G4int ia = 0; ia < 98; ia++)
7060 for (G4int ib = 0; ib < 251; ib++) {
7061 BBIMF[ia][ib] = 0.0;
7062 SSBIMF[ia][ib] = 0.0;
7063 }
7064
7065 // take the half of the CN and transform it in integer (floor it)
7066 IZIMFMAX = idnint(ZCN / 2.0);
7067
7068 if(IZIMFMAX<3){
7069 std::cout << "CHARGE_IMF line 46" << std::endl;
7070 std::cout << "Problem: IZIMFMAX < 3 " << std::endl;
7071 std::cout << "ZCN,IZIMFMAX," << ZCN << "," << IZIMFMAX << std::endl;
7072 }
7073
7074 iz = idnint(ZCN);
7075 in = idnint(ACN) - iz;
7076 BSHELL = ecld->ecgnz[in][iz]- ecld->vgsld[in][iz];
7077 DEFBET = ecld->beta2[in][iz];
7078
7079 bsbkbc(ACN,ZCN,&BS,&BK,&BC);
7080
7081 densniv(ACN,ZCN,EE,0.0,&DENSCN,BSHELL,BS,BK,&TEMPCN,0,0,DEFBET,&ECOR,JPRF,0,&QRCN);
7082
7083 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);
7084 EROTCN = JPRF * JPRF * 197.328 * 197.328 /(2. * IINERT);
7085//
7086 for(IZIMF=3;IZIMF<=IZIMFMAX;IZIMF++){
7087
7088 SDW[IZIMF] = 0.0;
7089 ZIMF_1 = 1.0*IZIMF;
7090
7091// *** Find the limits that both IMF and partner are bound :
7092
7093 isostab_lim(IZIMF,&INIMFMI,&INIMFMA);// Bound isotopes for IZIMF from INMIN to INIMFMA
7094// Idea - very proton-rich nuclei can live long enough to evaporate IMF before decaying:
7095 INIMFMI = max(1,INIMFMI-2);
7096
7097 IZCN = idnint(ZCN); // Z of CN
7098 INCN = idnint(ACN) - IZCN; // N of CN
7099
7100 isostab_lim(IZCN-IZIMF,&INMI,&INMA); // Daughter nucleus after IMF emission,
7101 // limits of bound isotopes
7102 INMI = max(1,INMI-2);
7103 INMIN = max(INIMFMI,INCN-INMA); // Both IMF and daughter must be bound
7104 INNMAX = min(INIMFMA,INCN-INMI); // "
7105
7106 ILIMMAX = max(INNMAX,INMIN); // In order to keep the variables below
7107// ***
7108
7109 for(G4int INIMF=INMIN;INIMF<=ILIMMAX;INIMF++){ // Range of possible IMF isotopes
7110 IAIMF = IZIMF + INIMF;
7111 DW[IZIMF][IAIMF] = 0.0;
7112 AIMF_1 = 1.0*(IAIMF);
7113
7114// Q-values
7115 mglms(ACN-AIMF_1,ZCN-ZIMF_1,OPTSHPIMF,&MARES);
7116 mglms(AIMF_1,ZIMF_1,OPTSHPIMF,&MAIMF);
7117 mglms(ACN,ZCN,OPTSHPIMF,&MAZ);
7118
7119// Barrier
7120 if(ACN<=AIMF_1){
7121 SSBIMF[IZIMF][IAIMF] = 1.e37;
7122 }else{
7123 barrs(idnint(ZCN-ZIMF_1),idnint(ACN-AIMF_1),idnint(ZIMF_1),idnint(AIMF_1),&fBIMF,&OMEGAP);
7124 SSBIMF[IZIMF][IAIMF] = MAIMF + MARES - MAZ + fBIMF;
7125 BBIMF[IZIMF][IAIMF] = fBIMF;
7126 }
7127
7128// ***** Width *********************
7129 DEFBETIMF = ecld->beta2[idnint(AIMF_1-ZIMF_1)][idnint(ZIMF_1)]+ecld->beta2[idnint(ACN-AIMF_1-ZCN+ZIMF_1)][idnint(ZCN-ZIMF_1)];
7130
7131 IINERT = 0.40 * 931.490 * 1.160*1.160 * std::pow(ACN,5.0/3.0)*(std::pow(AIMF_1,5.0/3.0) + std::pow(ACN - AIMF_1,5.0/3.0)) + 931.490 * 1.160*1.160 * AIMF_1 * (ACN-AIMF_1) / ACN *(std::pow(AIMF_1,1.0/3.0) + std::pow(ACN - AIMF_1,1.0/3.0))*(std::pow(AIMF_1,1.0/3.0) + std::pow(ACN - AIMF_1,1.0/3.0));
7132
7133 EROT = JPRF * JPRF * 197.328 * 197.328 /(2.0 * IINERT);
7134
7135 // IF(IEROT.EQ.1) EROT = 0.D0
7136 if (EE<(SSBIMF[IZIMF][IAIMF]+EROT) || DENSCN<=0.0){
7137 WIDTH_IMF = 0.0;
7138// PRINT*,IDNINT(ACN),IDNINT(ZCN),IZIMF,IAIMF
7139 }else{
7140// here the temperature at "saddle point" is used
7141// Increase of the level densitiy at the barrier due to deformation; see comment in ABLA
7142// BSIMF = ((ACN-AIMF_1)**(2.D0/3.D0) + AIMF_1**(2.D0/3.D0))/
7143// & ACN**(2.D0/3.D0)
7144 BSIMF = BS;
7145 densniv(ACN,ZCN,EE,SSBIMF[IZIMF][IAIMF],&DENSIMF,0.0,BSIMF,1.0,&fTIMF,0,0,DEFBETIMF,&ECOR,JPRF,2,&QR);
7146 IMFARG = (SSBIMF[IZIMF][IAIMF]+EROTCN-EROT)/fTIMF;
7147 if(IMFARG>200.0) IMFARG = 200.0;
7148
7149 WIDTH1 = width(ACN,ZCN,AIMF_1,ZIMF_1,fTIMF,fBIMF,SSBIMF[IZIMF][IAIMF],EE-EROT);
7150
7151 WIDTH_IMF = WIDTH1 * std::exp(-IMFARG) * QR / QRCN;
7152
7153 if(WIDTH_IMF<=0.0){
7154 std::cout << "GAMMA_IMF=0 -> LOOK IN GAMMA_IMF CALCULATIONS!" << std::endl;
7155 std::cout << "ACN,ZCN,AIMF,ZIMF:" << idnint(ACN) << "," << idnint(ZCN) << "," << idnint(AIMF_1) << "," << idnint(ZIMF_1) << std::endl;
7156 std::cout << "SSBIMF,TIMF :" << SSBIMF[IZIMF][IAIMF] << "," << fTIMF << std::endl;
7157 std::cout << "DEXP(-IMFARG) = " << std::exp(-IMFARG) << std::endl;
7158 std::cout << "WIDTH1 =" << WIDTH1 << std::endl;
7159 }
7160 }// if ee
7161
7162 SDW[IZIMF] = SDW[IZIMF] + WIDTH_IMF;
7163
7164 DW[IZIMF][IAIMF] = WIDTH_IMF;
7165
7166 }// for INIMF
7167 }// for IZIMF
7168// End loop to calculate the decay widths ************************
7169// ***************************************************************
7170
7171// Loop to calculate where the gamma of IMF has the minimum ******
7172 SDWprevious = 1.e20;
7173 IZSTOP = 0;
7174
7175 for(G4int III_ZIMF=3;III_ZIMF<=IZIMFMAX;III_ZIMF++){
7176
7177 if(SDW[III_ZIMF]==0.0){
7178 IZSTOP = III_ZIMF - 1;
7179 goto imfs30;
7180 }
7181
7182 if(SDW[III_ZIMF]>SDWprevious){
7183 IZSTOP = III_ZIMF - 1;
7184 goto imfs30;
7185 }else{
7186 SDWprevious = SDW[III_ZIMF];
7187 }
7188
7189 }// for III_ZIMF
7190
7191 imfs30:
7192
7193 if(IZSTOP<=6){
7194 IZSTOP = IZIMFMAX;
7195 goto imfs15;
7196 }
7197
7198 A1PAR = std::log10(SDW[IZSTOP]/SDW[IZSTOP-2])/std::log10((1.0*IZSTOP)/(1.0*IZSTOP-2.0));
7199 A2PAR = std::log10(SDW[IZSTOP]) - A1PAR * std::log10(1.0*(IZSTOP));
7200 if(A2PAR>0.)A2PAR=-1.*A2PAR;
7201 if(A1PAR>0.)A1PAR=-1.*A1PAR;
7202
7203// End loop to calculate where gamma of IMF has the minimum
7204
7205 for(G4int II_ZIMF = IZSTOP;II_ZIMF<=IZIMFMAX;II_ZIMF++){
7206 SDW[II_ZIMF] = std::pow(10.0,A2PAR) * std::pow(1.0*II_ZIMF,A1PAR); // Power-low
7207 if(SDW[II_ZIMF]<0.0) SDW[II_ZIMF] = 0.0;
7208 }
7209
7210 imfs15:
7211
7212// Sum of all decay widths (for normalisation)
7213 SUMDW_TOT = 0.0;
7214 for(G4int I_ZIMF = 3;I_ZIMF<=IZIMFMAX;I_ZIMF++){
7215 SUMDW_TOT = SUMDW_TOT + SDW[I_ZIMF];
7216 }
7217 if(SUMDW_TOT<=0.0){
7218 std::cout << "*********************" << std::endl;
7219 std::cout << "IMF function" << std::endl;
7220 std::cout << "SUM of decay widths = " << SUMDW_TOT << " IZIMFMAX = " << IZIMFMAX << std::endl;
7221 std::cout << "IZSTOP = " << IZSTOP << std::endl;
7222 }
7223
7224// End of Sum of all decay widths (for normalisation)
7225
7226// Loop to sample the nuclide that is emitted ********************
7227// ------- sample Z -----------
7228 imfs10:
7229 X = haz(1)*SUMDW_TOT;
7230
7231// IF(X.EQ.0.D0) PRINT*,'WARNING: X=0',XRNDM,SUMDW_TOT
7232 SUM_Z = 0.0;
7233 fZIMF = 0.0;
7234 IZMEM = 0;
7235
7236 for(G4int IZ = 3;IZ<=IZIMFMAX;IZ++){
7237 SUM_Z = SUM_Z + SDW[IZ];
7238 if(X<SUM_Z){
7239 fZIMF = 1.0*IZ;
7240 IZMEM = IZ;
7241 goto imfs20;
7242 }
7243 }//for IZ
7244
7245 imfs20:
7246
7247// ------- sample N -----------
7248
7249 isostab_lim(IZMEM,&INMINMEM,&INMAXMEM);
7250 INMINMEM = max(1,INMINMEM-2);
7251
7252 isostab_lim(IZCN-IZMEM,&INMI,&INMA); // Daughter nucleus after IMF emission,
7253 INMI = max(1,INMI-2);
7254 // limits of bound isotopes
7255
7256 INMINMEM = max(INMINMEM,INCN-INMA); // Both IMF and daughter must be bound
7257 INMAXMEM = min(INMAXMEM,INCN-INMI); // "
7258
7259 INMAXMEM = max(INMINMEM,INMAXMEM);
7260
7261 IA = 0;
7262 SUMDW_N_TOT = 0.0;
7263 for(G4int IIINIMF = INMINMEM;IIINIMF<=INMAXMEM;IIINIMF++){
7264 IA = IZMEM + IIINIMF;
7265 if(IZMEM>=3&&IZMEM<=95&&IA>=4&&IA<=250){
7266 SUMDW_N_TOT = SUMDW_N_TOT + DW[IZMEM][IA];
7267 }else{
7268 std::cout << "CHARGE IMF OUT OF RANGE" << IZMEM << ", " << IA << ", " << idnint(ACN) << ", " << idnint(ZCN) << ", " << TEMP << std::endl;
7269 }
7270 }
7271
7272 XX = haz(1)*SUMDW_N_TOT;
7273 IIA = 0;
7274 SUM_A = 0.0;
7275 for(G4int IINIMF = INMINMEM;IINIMF<=INMAXMEM; IINIMF++){
7276 IIA = IZMEM + IINIMF;
7277 // SUM_A = SUM_A + DW[IZ][IIA]; //FIXME
7278 SUM_A = SUM_A + DW[IZMEM][IIA];
7279 if(XX<SUM_A){
7280 fAIMF = G4double(IIA);
7281 goto imfs25;
7282 }
7283 }
7284
7285 imfs25:
7286// CHECK POINT 1
7287 NIMF = fAIMF - fZIMF;
7288
7289 if((ACN-ZCN-NIMF)<=0.0 || (ZCN-fZIMF) <= 0.0){
7290 std::cout << "IMF Partner unstable:" << std::endl;
7291 std::cout << "System: Acn,Zcn,NCN:" << std::endl;
7292 std::cout << idnint(ACN) << ", " << idnint(ZCN) << ", " << idnint(ACN-ZCN) << std::endl;
7293 std::cout << "IMF: A,Z,N:" << std::endl;
7294 std::cout << idnint(fAIMF) << ", " << idnint(fZIMF) << ", " << idnint(fAIMF-fZIMF) << std::endl;
7295 std::cout << "Partner: A,Z,N:" << std::endl;
7296 std::cout << idnint(ACN-fAIMF) << ", " << idnint(ZCN-fZIMF) << ", " << idnint(ACN-ZCN-NIMF) << std::endl;
7297 std::cout << "----nmin,nmax" << INMINMEM << ", " << INMAXMEM << std::endl;
7298 std::cout << "----- warning: Zimf=" << fZIMF << " Aimf=" << fAIMF << std::endl;
7299 std::cout << "----- look in subroutine IMF" << std::endl;
7300 std::cout << "ACN,ZCN,ZIMF,AIMF,temp,EE,JPRF::" << ACN << ", " << ZCN << ", " << fZIMF << ", " << fAIMF << ", " << TEMP << ", " << EE << ", " << JPRF << std::endl;
7301std::cout << "-IZSTOP,IZIMFMAX:" << IZSTOP << ", " << IZIMFMAX << std::endl;
7302std::cout << "----X,SUM_Z,SUMDW_TOT:" << X << ", " << SUM_Z << ", " << SUMDW_TOT << std::endl;
7303//for(int III_ZIMF=3;III_ZIMF<=IZIMFMAX;III_ZIMF++)
7304 // std::cout << "-**Z,SDW:" << III_ZIMF << ", " << SDW[III_ZIMF] << std::endl;
7305
7306 goto imfs10;
7307 }
7308 if(fZIMF>=ZCN || fAIMF>=ACN || fZIMF<=2 || fAIMF<=3){
7309 std::cout << "----nmin,nmax" << INMINMEM << ", " << INMAXMEM << std::endl;
7310 std::cout << "----- warning: Zimf=" << fZIMF << " Aimf=" << fAIMF << std::endl;
7311 std::cout << "----- look in subroutine IMF" << std::endl;
7312 std::cout << "ACN,ZCN,ZIMF,AIMF,temp,EE,JPRF:" << ACN << ", " << ZCN << ", " << fZIMF << ", " << fAIMF << ", " << TEMP << ", " << EE << ", " << JPRF << std::endl;
7313std::cout << "-IZSTOP,IZIMFMAX:" << IZSTOP << ", " << IZIMFMAX << std::endl;
7314std::cout << "----X,SUM_Z,SUMDW_TOT:" << X << ", " << SUM_Z << ", " << SUMDW_TOT << std::endl;
7315for(int III_ZIMF=3;III_ZIMF<=IZIMFMAX;III_ZIMF++)
7316 std::cout << "-**Z,SDW:" << III_ZIMF << ", " << SDW[III_ZIMF] << std::endl;
7317
7318 fZIMF = 3.0; // provisorisch AK
7319 fAIMF = 4.0;
7320 }
7321
7322// Characteristics of selected IMF (AIMF, ZIMF, BIMF, SBIMF, TIMF)
7323 fSBIMF = SSBIMF[idnint(fZIMF)][idnint(fAIMF)];
7324 fBIMF = BBIMF[idnint(fZIMF)][idnint(fAIMF)];
7325
7326 if((ZCN-fZIMF)<=0.0)std::cout << "CHARGE_IMF ZIMF > ZCN" << std::endl;
7327 if((ACN-fAIMF)<=0.0)std::cout << "CHARGE_IMF AIMF > ACN" << std::endl;
7328
7329 BSHELL = ecld->ecgnz[idnint(ACN-ZCN-NIMF)][idnint(ZCN-fZIMF)] -ecld->vgsld[idnint(ACN-ZCN-NIMF)][idnint(ZCN-fZIMF)];
7330
7331 DEFBET = ecld->beta2[idnint(ACN-ZCN-NIMF)][idnint(ZCN-fZIMF)];
7332 EEDAUG = (EE - fSBIMF) * (ACN - fAIMF) / ACN;
7333 bsbkbc(ACN - fAIMF,ZCN-fZIMF,&BS,&BK,&BC);
7334 densniv(ACN-fAIMF,ZCN-fZIMF,EEDAUG,0.0,&DENSIMF,BSHELL,BS,BK,&fTIMF,0,0,DEFBET,&ECOR,0.0,0,&QR);
7335
7336 if(fSBIMF>EE){
7337 std::cout << "----- warning: EE=" << EE << "," << " S+Bimf=" << fSBIMF << std::endl;
7338 std::cout << "----- look in subroutine IMF" << std::endl;
7339 std::cout << "IMF will be resampled" << std::endl;
7340 goto imfs10;
7341 }
7342 (*ZIMF) = fZIMF;
7343 (*AIMF) = fAIMF;
7344 (*SBIMF) = fSBIMF;
7345 (*BIMF) = fBIMF;
7346 (*TIMF) = fTIMF;
7347 return;
7348}
7349
7351{
7352
7353G4int VISOSTAB[191][2]={
7354 {0 , 7 },
7355 {1 , 8 },
7356 {1 , 9 },
7357 {2 , 12 },
7358 {2 , 14 },
7359 {2 , 16 },
7360 {3 , 18 },
7361 {4 , 22 },
7362 {6 , 22 },
7363 {6 , 28 },
7364 {7 , 28 },
7365 {7 , 30 },
7366 {8 , 28 },
7367 {8 , 36 },
7368 {10 , 38 },
7369 {10 , 40 },
7370 {11 , 38 },
7371 {10 , 42 },
7372 {13 , 50 },
7373 {14 , 50 },
7374 {15 , 52 },
7375 {16 , 52 },
7376 {17 , 54 },
7377 {18 , 54 },
7378 {19 , 60 },
7379 {19 , 62 },
7380 {21 , 64 },
7381 {20 , 66 },
7382 {23 , 66 },
7383 {24 , 70 },
7384 {25 , 70 },
7385 {26 , 74 },
7386 {27 , 78 },
7387 {29 , 82 },
7388 {33 , 82 },
7389 {31 , 82 },
7390 {35 , 82 },
7391 {34 , 84 },
7392 {40 , 84 },
7393 {36 , 86 },
7394 {40 , 92 },
7395 {38 , 96 },
7396 {42 , 102 },
7397 {42 , 102 },
7398 {44 , 102 },
7399 {42 , 106 },
7400 {47 , 112 },
7401 {44 , 114 },
7402 {49 , 116 },
7403 {46 , 118 },
7404 {52 , 120 },
7405 {52 , 124 },
7406 {55 , 126 },
7407 {54 , 126 },
7408 {57 , 126 },
7409 {57 , 126 },
7410 {60 , 126 },
7411 {58 , 130 },
7412 { 62 , 132 },
7413 { 60 , 140 },
7414 { 67 , 138 },
7415 { 64 , 142 },
7416 { 67 , 144 },
7417 { 68 , 146 },
7418 { 70 , 148 },
7419 { 70 , 152 },
7420 { 73 , 152 },
7421 { 72 , 154 },
7422 { 75 , 156 },
7423 { 77 , 162 },
7424 { 79 , 164 },
7425 { 78 , 164 },
7426 { 82 , 166 },
7427 { 80 , 166 },
7428 { 85 , 168 },
7429 { 83 , 176 },
7430 { 87 , 178 },
7431 { 88 , 178 },
7432 { 91 , 182 },
7433 { 90 , 184 },
7434 { 96 , 184 },
7435 { 95 , 184 },
7436 { 99 , 184 },
7437 { 98 , 184 },
7438 { 105 , 194 },
7439 { 102 , 194 },
7440 { 108 , 196 },
7441 { 106 , 198 },
7442 { 115 , 204 },
7443 { 110 , 206 },
7444 { 119 , 210 },
7445 { 114 , 210 },
7446 { 124 , 210 },
7447 { 117 , 212 },
7448 { 130 , 212 }
7449 };
7450
7451 if (z<0){
7452 *nmin = 0;
7453 *nmax = 0;
7454 }else{
7455 if(z==0){
7456 *nmin = 1;
7457 *nmax = 1;
7458// AK (Dez2010) - Just to avoid numerical problems
7459 }else{
7460 if(z>95){
7461 *nmin = 130;
7462 *nmax = 200;
7463 }else{
7464 *nmin = VISOSTAB[z-1][0];
7465 *nmax = VISOSTAB[z-1][1];
7466 }
7467 }
7468 }
7469
7470 return;
7471}
7472
7473
7474void G4Abla::evap_postsaddle(G4double A, G4double Z, G4double EXC, G4double *E_scission_post, G4double *A_scission, G4double *Z_scission,G4double &vx_eva,G4double &vy_eva,G4double &vz_eva,G4int *NbLam0_par){
7475
7476// AK 2006 - Now in case of fission deexcitation between saddle and scission
7477// is explicitly calculated. Langevin calculations made by P. Nadtochy
7478// used to parametrise saddle-to-scission time
7479
7480 G4double af,zf,ee;
7481 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, probimf=0.0, problamb0=0.0, ptotl = 0.0, tcn = 0.0;
7482 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,sp= 0.0,sd= 0.0,st= 0.0,she= 0.0,sa= 0.0, slamb0 = 0.0;
7483 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, bd = 0.0, bt = 0.0, bhe = 0.0, ba = 0.0;
7484
7485 G4double xcv=0.,ycv=0.,zcv=0.,VXOUT=0.,VYOUT=0.,VZOUT=0.;
7486
7487 G4double jprfn=0.0, jprfp=0.0, jprfd=0.0, jprft=0.0, jprfhe=0.0, jprfa=0.0, jprflamb0=0.0;
7488 G4double ctet1 = 0.0, stet1 = 0.0, phi1 = 0.0;
7489 G4double rnd = 0.0;
7490
7491 G4int itest = 0, sortie=0;
7492 G4double probf = 0.0;
7493
7494 G4double ef = 0.0;
7495 G4double pc = 0.0;
7496
7497 G4double time,tauf,tau0,a0,a1,emin,ts1,tsum=0.;
7498 G4int inttype=0,inum=0,gammadecay = 0, flamb0decay = 0;
7499 G4double pleva = 0.0;
7500 G4double pxeva = 0.0;
7501 G4double pyeva = 0.0;
7502 G4double pteva = 0.0;
7503 G4double etot = 0.0;
7504 G4int NbLam0= (*NbLam0_par);
7505
7506 const G4double c = 29.9792458;
7507 const G4double mu = 931.494;
7508 const G4double mu2 = 931.494*931.494;
7509
7510 vx_eva=0.;
7511 vy_eva=0.;
7512 vz_eva=0.;
7513 IEV_TAB_SSC = 0;
7514
7515
7516 af = dint(A);
7517 zf = dint(Z);
7518 ee = EXC;
7519
7520 fiss->ifis = 0;
7521 opt->optimfallowed = 0;
7522 gammaemission=0;
7523// Initialsation
7524 time = 0.0;
7525
7526// in sec
7527 tau0 = 1.0e-21;
7528 a0 = 0.66482503 - 3.4678935 * std::exp(-0.0104002*ee);
7529 a1 = 5.6846e-04 + 0.00574515 * std::exp(-0.01114307*ee);
7530 tauf = (a0 + a1 * zf*zf/std::pow(af,0.3333333)) * tau0;
7531//
7532 post10:
7533 direct(zf,af,ee,0.,&probp,&probd,&probt,&probn,&probhe,&proba,&probg,&probimf,&probf,&problamb0,&ptotl,
7534 &sn,&sbp,&sbd,&sbt,&sbhe,&sba,&slamb0,
7535 &ecn,&ecp,&ecd,&ect,&eche,&eca,&ecg,&eclamb0,
7536 &bp,&bd,&bt,&bhe,&ba,&sp,&sd,&st,&she,&sa,&ef,&ts1,inttype,inum,itest,&sortie,&tcn,
7537 &jprfn, &jprfp, &jprfd, &jprft, &jprfhe, &jprfa, &jprflamb0, &tsum, NbLam0); //:::FIXME::: Call
7538//
7539// HERE THE FINAL STEPS OF THE EVAPORATION ARE CALCULATED
7540//
7541 if(ptotl<=0.)goto post100;
7542
7543 emin = dmin1(sba,sbhe,dmin1(sbt,sbhe,dmin1(sn,sbp,sbd)));
7544
7545 if(emin>1e30)std::cout << "ERROR AT THE EXIT OF EVAPORA,E>1.D30,AF" << std::endl;
7546
7547 if(sortie==1){
7548 if (probn!=0.0) {
7549 amoins = 1.0;
7550 zmoins = 0.0;
7551 epsiln = sn + ecn;
7552 pc = std::sqrt(std::pow((1.0 + ecn/9.3956e2),2.) - 1.0) * 9.3956e2;
7553 gammadecay = 0;
7554 flamb0decay = 0;
7555 }
7556 else if(probp!=0.0){
7557 amoins = 1.0;
7558 zmoins = 1.0;
7559 epsiln = sp + ecp;
7560 pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2.) - 1.0) * 9.3827e2;
7561 gammadecay = 0;
7562 flamb0decay = 0;
7563 }
7564 else if(probd!=0.0){
7565 amoins = 2.0;
7566 zmoins = 1.0;
7567 epsiln = sd + ecd;
7568 pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
7569 gammadecay = 0;
7570 flamb0decay = 0;
7571 }
7572 else if(probt!=0.0){
7573 amoins = 3.0;
7574 zmoins = 1.0;
7575 epsiln = st + ect;
7576 pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
7577 gammadecay = 0;
7578 flamb0decay = 0;
7579 }
7580 else if(probhe!=0.0){
7581 amoins = 3.0;
7582 zmoins = 2.0;
7583 epsiln = she + eche;
7584 pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
7585 gammadecay = 0;
7586 flamb0decay = 0;
7587 }
7588 else{ if(proba!=0.0){
7589 amoins = 4.0;
7590 zmoins = 2.0;
7591 epsiln = sa + eca;
7592 pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
7593 gammadecay = 0;
7594 flamb0decay = 0;
7595 }
7596 }
7597 goto post99;
7598 }
7599
7600 // IRNDM = IRNDM+1;
7601//
7602// HERE THE NORMAL EVAPORATION CASCADE STARTS
7603// RANDOM NUMBER FOR THE EVAPORATION
7604
7605
7606 // random number for the evaporation
7607 x = G4AblaRandom::flat() * ptotl;
7608
7609 itest = 0;
7610 if (x < proba) {
7611 // alpha evaporation
7612 amoins = 4.0;
7613 zmoins = 2.0;
7614 epsiln = sa + eca;
7615 pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
7616 gammadecay = 0;
7617 flamb0decay = 0;
7618 }
7619 else if (x < proba+probhe) {
7620 // He3 evaporation
7621 amoins = 3.0;
7622 zmoins = 2.0;
7623 epsiln = she + eche;
7624 pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
7625 gammadecay = 0;
7626 flamb0decay = 0;
7627 }
7628 else if (x < proba+probhe+probt) {
7629 // triton evaporation
7630 amoins = 3.0;
7631 zmoins = 1.0;
7632 epsiln = st + ect;
7633 pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
7634 gammadecay = 0;
7635 flamb0decay = 0;
7636 }
7637 else if (x < proba+probhe+probt+probd) {
7638 // deuteron evaporation
7639 amoins = 2.0;
7640 zmoins = 1.0;
7641 epsiln = sd + ecd;
7642 pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
7643 gammadecay = 0;
7644 flamb0decay = 0;
7645 }
7646 else if (x < proba+probhe+probt+probd+probp) {
7647 // proton evaporation
7648 amoins = 1.0;
7649 zmoins = 1.0;
7650 epsiln = sp + ecp;
7651 pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2) - 1.0) * 9.3827e2;
7652 gammadecay = 0;
7653 flamb0decay = 0;
7654 }
7655 else if (x < proba+probhe+probt+probd+probp+probn) {
7656 // neutron evaporation
7657 amoins = 1.0;
7658 zmoins = 0.0;
7659 epsiln = sn + ecn;
7660 pc = std::sqrt(std::pow((1.0 + ecn/9.3956e2),2.) - 1.0) * 9.3956e2;
7661 gammadecay = 0;
7662 flamb0decay = 0;
7663 }
7664 else if (x < proba+probhe+probt+probd+probp+probn+problamb0) {
7665 // lambda0 evaporation
7666 amoins = 1.0;
7667 zmoins = 0.0;
7668 epsiln = slamb0 + eclamb0;
7669 pc = std::sqrt(std::pow((1.0 + (eclamb0)/11.1568e2),2.) - 1.0) * 11.1568e2;
7670 opt->nblan0 = opt->nblan0 -1;
7671 NbLam0 = NbLam0 -1;
7672 gammadecay = 0;
7673 flamb0decay = 1;
7674 }
7675 else if (x < proba+probhe+probt+probd+probp+probn+problamb0+probg) {
7676 // gamma evaporation
7677 amoins = 0.0;
7678 zmoins = 0.0;
7679 epsiln = ecg;
7680 pc = ecg;
7681 gammadecay = 1;
7682 flamb0decay = 0;
7683 if(probp==0.0 && probn==0.0 && probd==0.0 && probt==0.0 && proba==0.0 && probhe==0.0 && problamb0==0.0 && probimf==0.0 && probf==0.0){
7684 //ee = ee-epsiln;
7685 //if(ee<=0.01) ee = 0.010;
7686 goto post100;
7687 }
7688 }
7689
7690// CALCULATION OF THE DAUGHTER NUCLEUS
7691//
7692 post99:
7693
7694 if(gammadecay==1 && ee<=0.01+epsiln){
7695 epsiln = ee-0.01;
7696 time = tauf + 1.;
7697 }
7698
7699 af = af-amoins;
7700 zf = zf-zmoins;
7701 ee = ee-epsiln;
7702
7703 if(ee<=0.01) ee = 0.010;
7704
7705 if(af<2.5) goto post100;
7706
7707 time = time + ts1;
7708
7709// Determination of x,y,z components of momentum from known emission momentum
7710 if(flamb0decay==1){
7711 EV_TAB_SSC[IEV_TAB_SSC][0] = 0.;
7712 EV_TAB_SSC[IEV_TAB_SSC][1] = -2.;
7713 EV_TAB_SSC[IEV_TAB_SSC][5] = 1.;
7714 }else{
7715 EV_TAB_SSC[IEV_TAB_SSC][0] = zmoins;
7716 EV_TAB_SSC[IEV_TAB_SSC][1] = amoins;
7717 EV_TAB_SSC[IEV_TAB_SSC][5] = 0.;
7718 }
7719
7720 rnd = G4AblaRandom::flat();
7721 ctet1 = 2.0*rnd - 1.0; // z component: uniform probability between -1 and 1
7722 stet1 = std::sqrt(1.0 - std::pow(ctet1,2));// component perpendicular to z
7723 rnd = G4AblaRandom::flat();
7724 phi1 = rnd*2.0*3.141592654; // angle in x-y plane: uniform probability between 0 and 2*pi
7725 xcv = stet1*std::cos(phi1); // x component
7726 ycv = stet1*std::sin(phi1); // y component
7727 zcv = ctet1; // z component
7728// In the CM system
7729 if(gammadecay==0){
7730// Light particle
7731 G4double ETOT_LP = std::sqrt(pc*pc + amoins*amoins * mu2);
7732 if(flamb0decay==1)ETOT_LP = std::sqrt(pc*pc + 1115.683*1115.683);
7733 EV_TAB_SSC[IEV_TAB_SSC][2] = c * pc * xcv / ETOT_LP;
7734 EV_TAB_SSC[IEV_TAB_SSC][3] = c * pc * ycv / ETOT_LP;
7735 EV_TAB_SSC[IEV_TAB_SSC][4] = c * pc * zcv / ETOT_LP;
7736 }else{
7737// gamma ray
7738 EV_TAB_SSC[IEV_TAB_SSC][2] = pc * xcv;
7739 EV_TAB_SSC[IEV_TAB_SSC][3] = pc * ycv;
7740 EV_TAB_SSC[IEV_TAB_SSC][4] = pc * zcv;
7741 }
7742 lorentz_boost(vx_eva,vy_eva,vz_eva,
7745 &VXOUT,&VYOUT,&VZOUT);
7746 EV_TAB_SSC[IEV_TAB_SSC][2] = VXOUT;
7747 EV_TAB_SSC[IEV_TAB_SSC][3] = VYOUT;
7748 EV_TAB_SSC[IEV_TAB_SSC][4] = VZOUT;
7749
7750// Heavy residue
7751 if(gammadecay==0){
7752 G4double v2 = std::pow(EV_TAB_SSC[IEV_TAB_SSC][2],2.) +
7753 std::pow(EV_TAB_SSC[IEV_TAB_SSC][3],2.) +
7754 std::pow(EV_TAB_SSC[IEV_TAB_SSC][4],2.);
7755 G4double gamma = 1.0/std::sqrt(1.0 - v2 / (c*c));
7756 G4double etot_lp = amoins*mu * gamma;
7757 pxeva = pxeva - EV_TAB_SSC[IEV_TAB_SSC][2] * etot_lp / c;
7758 pyeva = pyeva - EV_TAB_SSC[IEV_TAB_SSC][3] * etot_lp / c;
7759 pleva = pleva - EV_TAB_SSC[IEV_TAB_SSC][4] * etot_lp / c;
7760 }else{
7761// in case of gammas, EV_TEMP contains momentum components and not velocity
7762 pxeva = pxeva - EV_TAB_SSC[IEV_TAB_SSC][2];
7763 pyeva = pyeva - EV_TAB_SSC[IEV_TAB_SSC][3];
7764 pleva = pleva - EV_TAB_SSC[IEV_TAB_SSC][4];
7765 }
7766 pteva = std::sqrt(pxeva*pxeva + pyeva*pyeva);
7767// To be checked:
7768 etot = std::sqrt ( pleva*pleva + pteva*pteva + af*af * mu2 );
7769 vx_eva = c * pxeva / etot; // recoil velocity components of residue due to evaporation
7770 vy_eva = c * pyeva / etot;
7771 vz_eva = c * pleva / etot;
7772
7774
7775 if(time<tauf)goto post10;
7776//
7777 post100:
7778//
7779 *A_scission= af;
7780 *Z_scission= zf;
7781 *E_scission_post = ee;
7782 *NbLam0_par = NbLam0;
7783 return;
7784}
7785
7787 if(A<1.)return (1.*H)/A*(10.68*A-21.27*std::pow(A,2./3.))*10.;
7788 return (1.*H)/A*(10.68*A-21.27*std::pow(A,2./3.));
7789}
7790
7791
7793 if(A<1.)return 1.e38;
7794// For light nuclei we take experimental values
7795// Journal of Physics G, Nucl Part Phys 32,363 (2006)
7796 if (ny == 1) {
7797 if (Z == 1 && A == 4)
7798 return 2.04;
7799 else if (Z == 2 && A == 4)
7800 return 2.39;
7801 else if (Z == 2 && A == 5)
7802 return 3.12;
7803 else if (Z == 2 && A == 6)
7804 return 4.18;
7805 else if (Z == 2 && A == 7)
7806 return 5.23;
7807 else if (Z == 2 && A == 8)
7808 return 7.16;
7809 else if (Z == 3 && A == 6)
7810 return 4.50;
7811 else if (Z == 3 && A == 7)
7812 return 5.58;
7813 else if (Z == 3 && A == 8)
7814 return 6.80;
7815 else if (Z == 3 && A == 9)
7816 return 8.50;
7817 else if (Z == 4 && A == 7)
7818 return 5.16;
7819 else if (Z == 4 && A == 8)
7820 return 6.84;
7821 else if (Z == 4 && A == 9)
7822 return 6.71;
7823 else if (Z == 4 && A == 10)
7824 return 9.11;
7825 else if (Z == 5 && A == 9)
7826 return 8.29;
7827 else if (Z == 5 && A == 10)
7828 return 9.01;
7829 else if (Z == 5 && A == 11)
7830 return 10.29;
7831 else if (Z == 5 && A == 12)
7832 return 11.43;
7833 else if (Z == 6 && A == 12)
7834 return 10.95;
7835 else if (Z == 6 && A == 13)
7836 return 11.81;
7837 else if (Z == 6 && A == 14)
7838 return 12.50;
7839 else if (Z == 7 && A == 14)
7840 return 12.17;
7841 else if (Z == 7 && A == 15)
7842 return 13.59;
7843 else if (Z == 8 && A == 16)
7844 return 12.50;
7845 else if (Z == 8 && A == 17)
7846 return 13.59;
7847 else if (Z == 14 && A == 28)
7848 return 16.0;
7849 else if (Z == 39 && A == 89)
7850 return 22.1;
7851 else if (Z == 57 && A == 139)
7852 return 23.8;
7853 else if (Z == 82 && A == 208)
7854 return 26.5;
7855 }//ny==1
7856// For other nuclei we take Bethe-Weizsacker mass formula
7857 return gethyperbinding(A, Z, ny)-gethyperbinding(A-1., Z, ny-1);
7858}
7859
7861//
7862// Bethe-Weizsacker mass formula
7863// Journal of Physics G, Nucl Part Phys 32,363 (2006)
7864//
7865 if(A<2 || Z<2)return 0.;
7866 G4double N = A-Z -1.*ny;
7867 G4double be=0., my = 1115.683,
7868 av = 15.77,
7869 as = 18.34,
7870 ac = 0.71,
7871 asym = 23.21,
7872 k = 17.,
7873 c = 30.,
7874 D = 0.;
7875 if(mod(N,2) == 1 && mod(Z,2) == 1)D = -12./std::sqrt(A);
7876 if(mod(N,2) == 0 && mod(Z,2) == 0)D = 12./std::sqrt(A);
7877//
7878 G4double deltanew = (1.-std::exp(-1.*A/c))*D;
7879//
7880 be= av*A-as*std::pow(A,2./3.)-ac*Z*(Z-1.)/std::pow(A,1./3.)-asym*(N-Z)*(N-Z)/((1.+std::exp(-1.*A/k))*A)+deltanew + ny*(0.0335*my-26.7-48.7/std::pow(A,2.0/3.0));
7881 return be;
7882}
7883
7884void G4Abla::unbound(G4double SN,G4double SP,G4double SD,G4double ST,G4double SHE,G4double SA,G4double BP,G4double BD,G4double BT,G4double BHE,G4double BA,G4double *PROBF,G4double *PROBN,G4double *PROBP,G4double *PROBD,G4double *PROBT,G4double *PROBHE,G4double *PROBA,G4double *PROBIMF,G4double *PROBG,G4double *ECN,G4double *ECP,G4double *ECD,G4double *ECT,G4double *ECHE,G4double *ECA)
7885{
7886 G4double SBP = SP + BP;
7887 G4double SBD = SD + BD;
7888 G4double SBT = ST + BT;
7889 G4double SBHE = SHE + BHE;
7890 G4double SBA = SA + BA;
7891
7892 G4double e = dmin1(SBP,SBD,SBT);
7893 e = dmin1(SBHE,SN,e);
7894 e = dmin1(SBHE,SBA,e);
7895//
7896 if(SN==e){
7897 *ECN = (-1.0)*SN;
7898 *ECP = 0.0;
7899 *ECD = 0.0;
7900 *ECT = 0.0;
7901 *ECHE = 0.0;
7902 *ECA = 0.0;
7903 *PROBN = 1.0;
7904 *PROBP = 0.0;
7905 *PROBD = 0.0;
7906 *PROBT = 0.0;
7907 *PROBHE = 0.0;
7908 *PROBA = 0.0;
7909 *PROBIMF = 0.0;
7910 *PROBF = 0.0;
7911 *PROBG = 0.0;
7912 }
7913 else if(SBP==e){
7914 *ECN = 0.0;
7915 *ECP = (-1.0)*SP + BP;
7916 *ECD = 0.0;
7917 *ECT = 0.0;
7918 *ECHE = 0.0;
7919 *ECA = 0.0;
7920 *PROBN = 0.0;
7921 *PROBP = 1.0;
7922 *PROBD = 0.0;
7923 *PROBT = 0.0;
7924 *PROBHE = 0.0;
7925 *PROBA = 0.0;
7926 *PROBIMF = 0.0;
7927 *PROBF = 0.0;
7928 *PROBG = 0.0;
7929 }
7930 else if(SBD==e){
7931 *ECN = 0.0;
7932 *ECD = (-1.0)*SD + BD;
7933 *ECP = 0.0;
7934 *ECT = 0.0;
7935 *ECHE = 0.0;
7936 *ECA = 0.0;
7937 *PROBN = 0.0;
7938 *PROBP = 0.0;
7939 *PROBD = 1.0;
7940 *PROBT = 0.0;
7941 *PROBHE = 0.0;
7942 *PROBA = 0.0;
7943 *PROBIMF = 0.0;
7944 *PROBF = 0.0;
7945 *PROBG = 0.0;
7946 }
7947 else if(SBT==e){
7948 *ECN = 0.0;
7949 *ECT = (-1.0)*ST + BT;
7950 *ECD = 0.0;
7951 *ECP = 0.0;
7952 *ECHE = 0.0;
7953 *ECA = 0.0;
7954 *PROBN = 0.0;
7955 *PROBP = 0.0;
7956 *PROBD = 0.0;
7957 *PROBT = 1.0;
7958 *PROBHE = 0.0;
7959 *PROBA = 0.0;
7960 *PROBIMF = 0.0;
7961 *PROBF = 0.0;
7962 *PROBG = 0.0;
7963 }
7964 else if(SBHE==e){
7965 *ECN = 0.0;
7966 *ECHE= (-1.0)*SHE + BHE;
7967 *ECD = 0.0;
7968 *ECT = 0.0;
7969 *ECP = 0.0;
7970 *ECA = 0.0;
7971 *PROBN = 0.0;
7972 *PROBP = 0.0;
7973 *PROBD = 0.0;
7974 *PROBT = 0.0;
7975 *PROBHE = 1.0;
7976 *PROBA = 0.0;
7977 *PROBIMF = 0.0;
7978 *PROBF = 0.0;
7979 *PROBG = 0.0;
7980 }
7981 else{
7982 if(SBA==e){
7983 *ECN = 0.0;
7984 *ECA = (-1.0)*SA + BA;
7985 *ECD = 0.0;
7986 *ECT = 0.0;
7987 *ECHE = 0.0;
7988 *ECP = 0.0;
7989 *PROBN = 0.0;
7990 *PROBP = 0.0;
7991 *PROBD = 0.0;
7992 *PROBT = 0.0;
7993 *PROBHE = 0.0;
7994 *PROBA = 1.0;
7995 *PROBIMF = 0.0;
7996 *PROBF = 0.0;
7997 *PROBG = 0.0;
7998 }
7999 }
8000
8001 return;
8002}
8003
8005 G4double &a1,G4double &z1,G4double &e1,G4double &v1,
8006 G4double &a2,G4double &z2,G4double &e2,G4double &v2,
8007 G4double &vx_eva_sc,G4double &vy_eva_sc,G4double &vz_eva_sc,
8008 G4int *NbLam0_par)
8009{
8010
8011/*
8012 Last update:
8013
8014 21/01/17 - J.L.R.S. - Implementation of this fission model in C++
8015
8016
8017 Authors: K.-H. Schmidt, A. Kelic, M. V. Ricciardi,J. Benlliure, and
8018 J.L.Rodriguez-Sanchez(1995 - 2017)
8019
8020 On input: A, Z, E (mass, atomic number and exc. energy of compound nucleus
8021 before fission)
8022 On output: Ai, Zi, Ei (mass, atomic number and (absolute) exc. energy of
8023 fragment 1 and 2 after fission)
8024
8025*/
8026 /* This program calculates isotopic distributions of fission fragments */
8027 /* with a semiempirical model */
8028 /* The width and eventually a shift in N/Z (polarization) follows the */
8029 /* following rules: */
8030 /* */
8031 /* The line N/Z following UCD has an angle of atan(Zcn/Ncn) */
8032 /* to the horizontal axis on a chart of nuclides. */
8033/* (For 238U the angle is 32.2 deg.) */
8034/* */
8035/* The following relations hold: (from Armbruster)
8036c
8037c sigma(N) (A=const) = sigma(Z) (A=const)
8038c sigma(A) (N=const) = sigma(Z) (N=const)
8039c sigma(A) (Z=const) = sigma(N) (Z=const)
8040c
8041c From this we get:
8042c sigma(Z) (N=const) * N = sigma(N) (Z=const) * Z
8043c sigma(A) (Z=const) = sigma(Z) (A=const) * A/Z
8044c sigma(N) (Z=const) = sigma(Z) (A=const) * A/Z
8045c Z*sigma(N) (Z=const) = N*sigma(Z) (N=const) = A*sigma(Z) (A=const) */
8046//
8047
8048/* Model parameters:
8049C These parameters have been adjusted to the compound nucleus 238U.
8050c For the fission of another compound nucleus, it might be
8051c necessary to slightly adjust some parameter values.
8052c The most important ones are
8053C Delta_U1_shell_max and
8054c Delta_u2_shell.
8055*/
8056 G4double Nheavy1_in; // 'position of shell for Standard 1'
8057 Nheavy1_in = 83.0;
8058
8059 G4double Zheavy1_in; // 'position of shell for Standard 1'
8060 Zheavy1_in = 50.0;
8061
8062 G4double Nheavy2; // 'position of heavy peak valley 2'
8063 Nheavy2 = 89.0;
8064
8065 G4double Delta_U1_shell_max; // 'Shell effect for valley 1'
8066 Delta_U1_shell_max = -2.45;
8067
8068 G4double U1NZ_SLOPE; // Reduction of shell effect with distance to 132Sn
8069 U1NZ_SLOPE = 0.2;
8070
8071 G4double Delta_U2_shell; // 'Shell effect for valley 2'
8072 Delta_U2_shell = -2.45;
8073
8074 G4double X_s2s; // 'Ratio (C_sad/C_scis) of curvature of potential'
8075 X_s2s = 0.8;
8076
8077 G4double hbom1,hbom2,hbom3; // 'Curvature of potential at saddle'
8078 hbom1 = 0.2; // hbom1 is hbar * omega1 / (2 pi) !!!
8079 hbom2 = 0.2; // hbom2 is hbar * omega2 / (2 pi) !!!
8080 hbom3 = 0.2; // hbom3 is hbar * omega3 / (2 pi) !!!
8081
8082 G4double Fwidth_asymm1,Fwidth_asymm2,Fwidth_symm;
8083// 'Factors for widths of distr. valley 1 and 2'
8084 Fwidth_asymm1 = 0.65;
8085 Fwidth_asymm2 = 0.65;
8086 Fwidth_symm = 1.16;
8087
8088 G4double xLevdens; // 'Parameter x: a = A/x'
8089 xLevdens = 10.75;
8090// The value of 1/0.093 = 10.75 is consistent with the
8091// systematics of the mass widths of Ref. (RuI97).
8092
8093 G4double FGAMMA; // 'Factor to gamma'
8094 FGAMMA = 1.; // Theoretical expectation, not adjusted to data.
8095// Additional factor to attenuation coefficient of shell effects
8096// with increasing excitation energy
8097
8098 G4double FGAMMA1; // 'Factor to gamma_heavy1'
8099 FGAMMA1 = 2.;
8100// Adjusted to reduce the weight of Standard 1 with increasing
8101// excitation energies, as required by experimental data.
8102
8103 G4double FREDSHELL;
8104 FREDSHELL = 0.;
8105// Adjusted to the reduced attenuation of shells in the superfluid region.
8106// If FGAMMA is modified,
8107// FGAMMA * FREADSHELL should remain constant (0.65) to keep
8108// the attenuation of the shell effects below the critical
8109// pairing energy ECRIT unchanged, which has been carefully
8110// adjusted to the mass yields of Vives and Zoeller in this
8111// energy range. A high value of FGAMMA leads ot a stronger
8112// attenuation of shell effects above the superfluid region.
8113
8114 G4double Ecrit;
8115 Ecrit = 5.;
8116// The value of ECRIT determines the transition from a weak
8117// decrease of the shell effect below ECRIT to a stronger
8118// decrease above the superfluid range.
8119 const G4double d = 2.0; // 'Surface distance of scission configuration'
8120 // d = 2.0;
8121// Charge polarisation from Wagemanns p. 397:
8122 G4double cpol1; // Charge polarisation standard I
8123 cpol1 = 0.35; // calculated internally with shells
8124 G4double cpol2; // Charge polarisation standard II
8125 cpol2 = 0.; // calculated internally from LDM
8126 G4double Friction_factor;
8127 Friction_factor = 1.0;
8128 G4double Nheavy1; // position of valley St 1 in Z and N
8129 G4double Delta_U1,Delta_U2; // used shell effects
8130 G4double cN_asymm1_shell, cN_asymm2_shell;
8131 G4double gamma,gamma_heavy1,gamma_heavy2; // fading of shells
8132 G4double E_saddle_scission; // friction from saddle to scission
8133 G4double Ysymm=0.; // Yield of symmetric mode
8134 G4double Yasymm1=0.; // Yield of asymmetric mode 1
8135 G4double Yasymm2=0.; // Yield of asymmetric mode 2
8136 G4double Nheavy1_eff; // Effective position of valley 1
8137 G4double Nheavy2_eff; // Effective position of valley 2
8138 G4double eexc1_saddle; // Excitation energy above saddle 1
8139 G4double eexc2_saddle; // Excitation energy above saddle 2
8140 G4double EEXC_MAX; // Excitation energy above lowest saddle
8141 G4double r_e_o; // Even-odd effect in Z
8142 G4double cN_symm; // Curvature of symmetric valley
8143 G4double CZ; // Curvature of Z distribution for fixed A
8144 G4double Nheavy2_NZ; // Position of Shell 2, combined N and Z
8145 G4double N;
8146 G4double Aheavy1,Aheavy2;
8147 G4double Sasymm1=0.,Sasymm2=0.,Ssymm=0.,Ysum=0.,Yasymm=0.;
8148 G4double Ssymm_mode1,Ssymm_mode2;
8149 G4double wNasymm1_saddle, wNasymm2_saddle, wNsymm_saddle;
8150 G4double wNasymm2_scission, wNsymm_scission;
8151 G4double wNasymm1, wNasymm2, wNsymm;
8152 G4int imode;
8153 G4double rmode;
8154 G4double ZA1width;
8155 G4double N1r,N2r,A1r,N1,N2;
8156 G4double Zsymm,Nsymm;
8157 G4double N1mean, N1width;
8158 G4double dUeff;
8159 /* effective shell effect at lowest barrier */
8160 G4double Eld;
8161 /* Excitation energy with respect to ld barrier */
8162 G4double re1,re2,re3;
8163 G4double eps1,eps2;
8164 G4double Z1UCD,Z2UCD;
8165 G4double beta=0.,beta1=0.,beta2=0.;
8166 // double betacomplement;
8167 G4double DN1_POL;
8168 /* shift of most probable neutron number for given Z,
8169 according to polarization */
8170 G4int i_help;
8171 G4double A_levdens;
8172 /* level-density parameter */
8173 // double A_levdens_light1,A_levdens_light2;
8174 G4double A_levdens_heavy1,A_levdens_heavy2;
8175
8176 G4double R0=1.16;
8177
8178 G4double epsilon_1_saddle,epsilon0_1_saddle;
8179 G4double epsilon_2_saddle,epsilon0_2_saddle,epsilon_symm_saddle;
8180 G4double epsilon_1_scission;//,epsilon0_1_scission;
8181 G4double epsilon_2_scission;//,epsilon0_2_scission;
8182 G4double epsilon_symm_scission;
8183 /* modified energy */
8184 G4double E_eff1_saddle,E_eff2_saddle;
8185 G4double Epot0_mode1_saddle,Epot0_mode2_saddle,Epot0_symm_saddle;
8186 G4double Epot_mode1_saddle,Epot_mode2_saddle,Epot_symm_saddle;
8187 G4double E_defo,E_defo1,E_defo2,E_scission_pre=0.,E_scission_post;
8188 G4double E_asym;
8189 G4double E1exc=0.,E2exc=0.;
8190 G4double E1exc_sigma,E2exc_sigma;
8191 G4double TKER;
8192 G4double EkinR1,EkinR2;
8193 G4double MassCurv_scis, MassCurv_sadd;
8194 G4double cN_symm_sadd;
8195 G4double Nheavy1_shell,Nheavy2_shell;
8196 G4double wNasymm1_scission;
8197 G4double Aheavy1_eff,Aheavy2_eff;
8198 G4double Z1rr,Z1r;
8199 G4double E_HELP;
8200 G4double Z_scission,N_scission,A_scission;
8201 G4double Z2_over_A_eff;
8202 G4double beta1gs=0.,beta2gs=0.,betags=0.;
8203 G4double sigZmin; // 'Minimum neutron width for constant Z'
8204 G4double DSN132,Delta_U1_shell,E_eff0_saddle;//,e_scission;
8205 G4int NbLam0= (*NbLam0_par);
8206 //
8207 sigZmin = 0.5;
8208 N = A - Z; /* neutron number of the fissioning nucleus */
8209//
8210 cN_asymm1_shell = 0.700 * N/Z;
8211 cN_asymm2_shell = 0.040 * N/Z;
8212
8213//*********************************************************************
8214
8215 DSN132 = Nheavy1_in - N/Z * Zheavy1_in;
8216 Aheavy1 = Nheavy1_in + Zheavy1_in + 0.340 * DSN132;
8217 /* Neutron number of valley Standard 1 */
8218 /* It is assumed that the 82-neutron shell effect is stronger than
8219c the 50-proton shell effect. Therefore, the deviation in N/Z of
8220c the fissioning nucleus from the N/Z of 132Sn will
8221c change the position of the combined shell in mass. For neutron-
8222c deficient fissioning nuclei, the mass will increase and vice
8223c versa. */
8224
8225 Delta_U1_shell = Delta_U1_shell_max + U1NZ_SLOPE * std::abs(DSN132);
8226 Delta_U1_shell = min(0.,Delta_U1_shell);
8227 /* Empirical reduction of shell effect with distance in N/Z of CN to 132Sn */
8228 /* Fits (239U,n)f and 226Th e.-m.-induced fission */
8229
8230 Nheavy1 = N/A * Aheavy1; /* UCD */
8231 Aheavy2 = Nheavy2 * A/N;
8232
8233 Zsymm = Z / 2.0; /* proton number in symmetric fission (centre) */
8234 Nsymm = N / 2.0;
8235 A_levdens = A / xLevdens;
8236 gamma = A_levdens / (0.40 * std::pow(A,1.3333)) * FGAMMA;
8237 A_levdens_heavy1 = Aheavy1 / xLevdens;
8238 gamma_heavy1 = A_levdens_heavy1 / (0.40 * std::pow(Aheavy1,1.3333)) * FGAMMA * FGAMMA1;
8239 A_levdens_heavy2 = Aheavy2 / xLevdens;
8240 gamma_heavy2 = A_levdens_heavy2 / (0.40 * std::pow(Aheavy2,1.3333)) * FGAMMA;
8241
8242// Energy dissipated from saddle to scission
8243// F. Rejmund et al., Nucl. Phys. A 678 (2000) 215, fig. 4 b */
8244 E_saddle_scission = (-24. + 0.02227 * Z*Z/std::pow(A,0.33333))*Friction_factor;
8245 E_saddle_scission = max( 0.0, E_saddle_scission );
8246
8247// Fit to experimental result on curvature of potential at saddle
8248// Parametrization of T. Enqvist according to Mulgin et al. 1998
8249// MassCurv taken at scission. */
8250
8251 Z2_over_A_eff = Z*Z/A;
8252
8253 if( Z2_over_A_eff< 34.0 )
8254 MassCurv_scis = std::pow(10., -1.093364 + 0.082933 * Z2_over_A_eff - 0.0002602 * Z2_over_A_eff*Z2_over_A_eff);
8255 else
8256 MassCurv_scis = std::pow(10., 3.053536 - 0.056477 * Z2_over_A_eff+ 0.0002454 * Z2_over_A_eff*Z2_over_A_eff );
8257
8258// to do:
8259// fix the X with the channel intensities of 226Th (KHS at SEYSSINS,1998)
8260// replace then (all) cN_symm by cN_symm_saddle (at least for Yields)
8261 MassCurv_sadd = X_s2s * MassCurv_scis;
8262
8263 cN_symm = 8.0 / std::pow(N,2.) * MassCurv_scis;
8264 cN_symm_sadd = 8.0 / std::pow(N,2.) * MassCurv_sadd;
8265
8266 Nheavy1_shell = Nheavy1;
8267
8268 if(E < 100.0)
8269 Nheavy1_eff = (cN_symm_sadd*Nsymm + cN_asymm1_shell *
8270 Uwash(E/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1) *
8271 Nheavy1_shell)
8272 / (cN_symm_sadd +
8273 cN_asymm1_shell *
8274 Uwash(E/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1));
8275 else
8276 Nheavy1_eff = (cN_symm_sadd*Nsymm +
8277 cN_asymm1_shell*Nheavy1_shell)
8278 / (cN_symm_sadd +
8279 cN_asymm1_shell);
8280
8281 /* Position of Standard II defined by neutron shell */
8282 Nheavy2_NZ = Nheavy2;
8283 Nheavy2_shell = Nheavy2_NZ;
8284 if (E < 100.)
8285 Nheavy2_eff = (cN_symm_sadd*Nsymm +
8286 cN_asymm2_shell*
8287 Uwash(E/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2) *
8288 Nheavy2_shell)
8289 / (cN_symm_sadd +
8290 cN_asymm2_shell*
8291 Uwash(E/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2));
8292 else
8293 Nheavy2_eff = (cN_symm_sadd*Nsymm +
8294 cN_asymm2_shell*Nheavy2_shell)
8295 / (cN_symm_sadd +
8296 cN_asymm2_shell);
8297
8298 Delta_U1 = Delta_U1_shell + (Nheavy1_shell - Nheavy1_eff)*(Nheavy1_shell - Nheavy1_eff) * cN_asymm1_shell; /* shell effect in valley of mode 1 */
8299 Delta_U1 = min(Delta_U1,0.0);
8300 Delta_U2 = Delta_U2_shell + (Nheavy2_shell - Nheavy2_eff)*(Nheavy2_shell - Nheavy2_eff) * cN_asymm2_shell; /* shell effect in valley of mode 2 */
8301 Delta_U2 = min(Delta_U2,0.0);
8302
8303// liquid drop energies at the centres of the different shell effects
8304// with respect to liquid drop at symmetry
8305 Epot0_mode1_saddle = (Nheavy1_eff-Nsymm)*(Nheavy1_eff-Nsymm) * cN_symm_sadd;
8306 Epot0_mode2_saddle = (Nheavy2_eff-Nsymm)*(Nheavy2_eff-Nsymm) * cN_symm_sadd;
8307 Epot0_symm_saddle = 0.0;
8308
8309// energies including shell effects at the centres of the different
8310// shell effects with respect to liquid drop at symmetry */
8311 Epot_mode1_saddle = Epot0_mode1_saddle + Delta_U1;
8312 Epot_mode2_saddle = Epot0_mode2_saddle + Delta_U2;
8313 Epot_symm_saddle = Epot0_symm_saddle;
8314
8315// minimum of potential with respect to ld potential at symmetry
8316 dUeff = min( Epot_mode1_saddle, Epot_mode2_saddle);
8317 dUeff = min( dUeff, Epot_symm_saddle);
8318 dUeff = dUeff - Epot_symm_saddle;
8319
8320 Eld = E + dUeff;
8321// E = energy above lowest effective barrier
8322// Eld = energy above liquid-drop barrier
8323// Due to this treatment the energy E on input means the excitation
8324// energy above the lowest saddle. */
8325
8326// excitation energies at saddle modes 1 and 2 without shell effect */
8327 epsilon0_1_saddle = Eld - Epot0_mode1_saddle;
8328 epsilon0_2_saddle = Eld - Epot0_mode2_saddle;
8329
8330// excitation energies at saddle modes 1 and 2 with shell effect */
8331 epsilon_1_saddle = Eld - Epot_mode1_saddle;
8332 epsilon_2_saddle = Eld - Epot_mode2_saddle;
8333
8334 epsilon_symm_saddle = Eld - Epot_symm_saddle;
8335// epsilon_symm_saddle = Eld - dUeff;
8336
8337 eexc1_saddle = epsilon_1_saddle;
8338 eexc2_saddle = epsilon_2_saddle;
8339
8340// EEXC_MAX is energy above the lowest saddle */
8341 EEXC_MAX = max( eexc1_saddle, eexc2_saddle);
8342 EEXC_MAX = max( EEXC_MAX, Eld);
8343
8344// excitation energy at scission */
8345 epsilon_1_scission = Eld + E_saddle_scission - Epot_mode1_saddle;
8346 epsilon_2_scission = Eld + E_saddle_scission - Epot_mode2_saddle;
8347
8348// excitation energy of symmetric fragment at scission */
8349 epsilon_symm_scission = Eld + E_saddle_scission - Epot_symm_saddle;
8350
8351// calculate widhts at the saddle
8352 E_eff1_saddle = epsilon0_1_saddle - Delta_U1 *
8353 Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1);
8354
8355 if( E_eff1_saddle < A_levdens * hbom1*hbom1)
8356 E_eff1_saddle = A_levdens * hbom1*hbom1;
8357
8358 wNasymm1_saddle =
8359 std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_eff1_saddle) /
8360 (cN_asymm1_shell *
8361 Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)+
8362 cN_symm_sadd));
8363
8364 E_eff2_saddle = epsilon0_2_saddle -
8365 Delta_U2 *
8366 Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2);
8367
8368 if(E_eff2_saddle < A_levdens * hbom2*hbom2)
8369 E_eff2_saddle = A_levdens * hbom2*hbom2;
8370
8371 wNasymm2_saddle =
8372 std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_eff2_saddle) /
8373 (cN_asymm2_shell *
8374 Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)+
8375 cN_symm_sadd));
8376
8377 E_eff0_saddle = epsilon_symm_saddle;
8378 if(E_eff0_saddle < A_levdens * hbom3*hbom3)
8379 E_eff0_saddle = A_levdens * hbom3*hbom3;
8380
8381 wNsymm_saddle =
8382 std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_eff0_saddle) /
8383 cN_symm_sadd);
8384
8385 if(epsilon_symm_scission > 0.0 ){
8386 E_HELP = max(E_saddle_scission,epsilon_symm_scission);
8387 wNsymm_scission =
8388 std::sqrt(0.50 * std::sqrt(1.0/A_levdens*(E_HELP)) /
8389 cN_symm);
8390 }else{
8391 wNsymm_scission =
8392 std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_saddle_scission) /
8393 cN_symm);
8394 }
8395
8396// Calculate widhts at the scission point:
8397// fits of ref. Beizin 1991 (Plots by Sergei Zhdanov)
8398
8399 if( E_saddle_scission == 0.0 ){
8400 wNasymm1_scission = wNasymm1_saddle;
8401 wNasymm2_scission = wNasymm2_saddle;
8402 }else{
8403 if( Nheavy1_eff > 75.0 ){
8404 wNasymm1_scission = std::sqrt(21.0)*N/A;
8405 wNasymm2_scission = max( 12.8 - 1.0 *(92.0 - Nheavy2_eff),1.0)*N/A;
8406
8407 }else{
8408 wNasymm1_scission = wNasymm1_saddle;
8409 wNasymm2_scission = wNasymm2_saddle;
8410 }
8411 }
8412
8413 wNasymm1_scission = max( wNasymm1_scission, wNasymm1_saddle );
8414 wNasymm2_scission = max( wNasymm2_scission, wNasymm2_saddle );
8415
8416 wNasymm1 = wNasymm1_scission * Fwidth_asymm1;
8417 wNasymm2 = wNasymm2_scission * Fwidth_asymm2;
8418 wNsymm = wNsymm_scission * Fwidth_symm;
8419
8420// mass and charge of fragments using UCD, needed for level densities
8421 Aheavy1_eff = Nheavy1_eff * A/N;
8422 Aheavy2_eff = Nheavy2_eff * A/N;
8423
8424 A_levdens_heavy1 = Aheavy1_eff / xLevdens;
8425 A_levdens_heavy2 = Aheavy2_eff / xLevdens;
8426 gamma_heavy1 = A_levdens_heavy1 / (0.40 * std::pow(Aheavy1_eff,1.3333)) * FGAMMA * FGAMMA1;
8427 gamma_heavy2 = A_levdens_heavy2 / (0.40 * std::pow(Aheavy2_eff,1.3333)) * FGAMMA;
8428
8429 if( epsilon_symm_saddle < A_levdens * hbom3*hbom3)
8430 Ssymm = 2.0 * std::sqrt(A_levdens*A_levdens * hbom3*hbom3) +
8431 (epsilon_symm_saddle - A_levdens * hbom3*hbom3)/hbom3;
8432 else
8433 Ssymm = 2.0 * std::sqrt(A_levdens*epsilon_symm_saddle);
8434
8435 Ysymm = 1.0;
8436
8437 if( epsilon0_1_saddle < A_levdens * hbom1*hbom1 )
8438 Ssymm_mode1 = 2.0 * std::sqrt(A_levdens*A_levdens * hbom1*hbom1) +
8439 (epsilon0_1_saddle - A_levdens * hbom1*hbom1)/hbom1;
8440 else
8441 Ssymm_mode1 = 2.0 * std::sqrt( A_levdens*epsilon0_1_saddle );
8442
8443 if( epsilon0_2_saddle < A_levdens * hbom2*hbom2 )
8444 Ssymm_mode2 = 2.0 * std::sqrt(A_levdens*A_levdens * hbom2*hbom2) +
8445 (epsilon0_2_saddle - A_levdens * hbom2*hbom2)/hbom2;
8446 else
8447 Ssymm_mode2 = 2.0 * std::sqrt(A_levdens*epsilon0_2_saddle);
8448
8449
8450 if( epsilon0_1_saddle -
8451 Delta_U1*
8452 Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)
8453 < A_levdens * hbom1*hbom1 )
8454 Sasymm1 = 2.0 * std::sqrt( A_levdens*A_levdens * hbom1*hbom1 ) +
8455 (epsilon0_1_saddle - Delta_U1 *
8456 Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)
8457 - A_levdens * hbom1*hbom1)/hbom1;
8458 else
8459 Sasymm1 = 2.0 *std::sqrt( A_levdens*(epsilon0_1_saddle - Delta_U1 *
8460 Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)));
8461
8462 if( epsilon0_2_saddle -
8463 Delta_U2*
8464 Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)
8465 < A_levdens * hbom2*hbom2 )
8466 Sasymm2 = 2.0 * std::sqrt( A_levdens*A_levdens * hbom2*hbom2 ) +
8467 (epsilon0_1_saddle-Delta_U1 *
8468 Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)
8469 - A_levdens * hbom2*hbom2)/hbom2;
8470 else
8471 Sasymm2 = 2.0 *
8472 std::sqrt( A_levdens*(epsilon0_2_saddle - Delta_U2 *
8473 Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)));
8474
8475 Yasymm1 = ( std::exp(Sasymm1 - Ssymm) - std::exp(Ssymm_mode1 - Ssymm) ) *
8476 wNasymm1_saddle / wNsymm_saddle * 2.0;
8477
8478 Yasymm2 = ( std::exp(Sasymm2 - Ssymm) - std::exp(Ssymm_mode2 - Ssymm) ) *
8479 wNasymm2_saddle / wNsymm_saddle * 2.0;
8480
8481 Ysum = Ysymm + Yasymm1 + Yasymm2; /* normalize */
8482
8483 if( Ysum > 0.00 ){
8484 Ysymm = Ysymm / Ysum;
8485 Yasymm1 = Yasymm1 / Ysum;
8486 Yasymm2 = Yasymm2 / Ysum;
8487 Yasymm = Yasymm1 + Yasymm2;
8488 }else{
8489 Ysymm = 0.0;
8490 Yasymm1 = 0.0;
8491 Yasymm2 = 0.0;
8492// search minimum threshold and attribute all events to this mode */
8493 if( (epsilon_symm_saddle < epsilon_1_saddle) &&
8494 (epsilon_symm_saddle < epsilon_2_saddle) )
8495 Ysymm = 1.0;
8496 else
8497 if( epsilon_1_saddle < epsilon_2_saddle )
8498 Yasymm1 = 1.0;
8499 else
8500 Yasymm2 = 1.0;
8501 }
8502 // even-odd effect
8503 // Parametrization from Rejmund et al.
8504 if (mod(Z,2.0)== 0)
8505 r_e_o = std::pow(10.0,-0.0170 * (E_saddle_scission + Eld)*(E_saddle_scission + Eld));
8506 else
8507 r_e_o = 0.0;
8508
8509/* -------------------------------------------------------
8510c selecting the fission mode using the yields at scission
8511c -------------------------------------------------------
8512c random decision: symmetric or asymmetric
8513c IMODE = 1 means asymmetric fission, mode 1
8514c IMODE = 2 means asymmetric fission, mode 2
8515c IMODE = 3 means symmetric fission
8516c testcase: 238U, E*= 6 MeV : 6467 8781 4752 (20000)
8517c 127798 176480 95722 (400000)
8518c 319919 440322 239759 (1000000)
8519c E*=12 MeV : 153407 293063 553530 (1000000) */
8520
8521 fiss321: // rmode = DBLE(HAZ(k))
8522 rmode = G4AblaRandom::flat();
8523 if( rmode < Yasymm1 )
8524 imode = 1;
8525 else
8526 if( (rmode > Yasymm1) && (rmode < Yasymm) )
8527 imode = 2;
8528 else
8529 imode = 3;
8530
8531// determine parameters of the neutron distribution of each mode
8532// at scission
8533
8534 if( imode == 1){
8535 N1mean = Nheavy1_eff;
8536 N1width = wNasymm1;
8537 }else{
8538 if( imode == 2 ){
8539 N1mean = Nheavy2_eff;
8540 N1width = wNasymm2;
8541 }else{
8542 //if( imode == 3 ) then
8543 N1mean = Nsymm;
8544 N1width = wNsymm;
8545 }
8546 }
8547
8548// N2mean needed by CZ below
8549 // N2mean = N - N1mean;
8550
8551// fission mode found, then the determination of the
8552// neutron numbers N1 and N2 at scission by randon decision
8553 N1r = 1.0;
8554 N2r = 1.0;
8555 while( N1r < 5.0 || N2r < 5.0 ){
8556 // N1r = DBLE(GaussHaz(k,sngl(N1mean), sngl(N1width) ))
8557 // N1r = N1mean+G4AblaRandom::gaus(N1width);//
8558 N1r = gausshaz(0,N1mean,N1width);
8559 N2r = N - N1r;
8560 }
8561
8562// --------------------------------------------------
8563// first approximation of fission fragments using UCD at saddle
8564// --------------------------------------------------
8565 Z1UCD = Z/N * N1r;
8566 Z2UCD = Z/N * N2r;
8567 A1r = A/N * N1r;
8568//
8569// --------------------------
8570// deformations: starting ...
8571// -------------------------- */
8572 if( imode == 1 ){
8573// --- N = 82 */
8574 E_scission_pre = max( epsilon_1_scission, 1.0 );
8575// ! Eexc at scission, neutron evaporation from saddle to scission not considered */
8576 if( N1mean > N*0.50 ){
8577 beta1 = 0.0; /* 1. fragment is spherical */
8578 beta2 = 0.55; /* 2. fragment is deformed 0.5*/
8579 }else{
8580 beta1 = 0.55; /* 1. fragment is deformed 0.5*/
8581 beta2 = 0.00; /* 2. fragment is spherical */
8582 }
8583 }
8584 if( imode == 2 ){
8585// --- N appr. 86 */
8586 E_scission_pre = max( epsilon_2_scission, 1.0 );
8587 if( N1mean > N*0.50 ){
8588 beta1 = (N1r - 92.0) * 0.030 + 0.60;
8589
8590 beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
8591 beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
8592
8593 beta1 = max(beta1,beta1gs);
8594 beta2 = 1.0 - beta1;
8595 beta2 = max(beta2,beta2gs);
8596 }else{
8597
8598 beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
8599 beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
8600
8601 beta2 = (N2r -92.0) * 0.030 + 0.60;
8602 beta2 = max(beta2,beta2gs);
8603 beta1 = 1.0 - beta2;
8604 beta1 = max(beta1,beta1gs);
8605 }
8606 }
8607 beta = 0.0;
8608 if( imode == 3 ){
8609// if( imode >0 ){
8610// --- Symmetric fission channel
8611// the fit function for beta is the deformation for optimum energy
8612// at the scission point, d = 2
8613// beta : deformation of symmetric fragments
8614// beta1 : deformation of first fragment
8615// beta2 : deformation of second fragment
8616 betags = ecld->beta2[idint(Nsymm)][idint(Zsymm)];
8617 beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
8618 beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
8619 beta = max(0.177963+0.0153241*Zsymm-1.62037e-4*Zsymm*Zsymm,betags);
8620 beta1 = max(0.177963+0.0153241*Z1UCD-1.62037e-4*Z1UCD*Z1UCD,beta1gs);
8621 beta2 = max(0.177963+0.0153241*Z2UCD-1.62037e-4*Z2UCD*Z2UCD,beta2gs);
8622
8623 E_asym = frldm( Z1UCD, N1r, beta1 ) +
8624 frldm( Z2UCD, N2r, beta2 ) +
8625 ecoul( Z1UCD, N1r, beta1, Z2UCD, N2r, beta2, 2.0 ) -
8626 2.0 * frldm( Zsymm, Nsymm, beta ) -
8627 ecoul( Zsymm, Nsymm, beta, Zsymm, Nsymm, beta, 2.0 );
8628 E_scission_pre = max( epsilon_symm_scission - E_asym, 1. );
8629 }
8630// -----------------------
8631// ... end of deformations
8632// -----------------------
8633
8634// ------------------------------------------
8635// evaporation from saddle to scission ...
8636// ------------------------------------------
8637 if(E_scission_pre>5. && NbLam0<1){
8638 evap_postsaddle(A,Z,E_scission_pre,&E_scission_post,
8639 &A_scission,&Z_scission,vx_eva_sc,vy_eva_sc,vz_eva_sc,&NbLam0);
8640 N_scission = A_scission - Z_scission;
8641 }else{
8642 A_scission = A;
8643 Z_scission = Z;
8644 E_scission_post = E_scission_pre;
8645 N_scission = A_scission - Z_scission;
8646 }
8647// ---------------------------------------------------
8648// second approximation of fission fragments using UCD
8649// --------------------------------------------------- */
8650//
8651 N1r = N1r * N_scission / N;
8652 N2r = N2r * N_scission / N;
8653 Z1UCD = Z1UCD * Z_scission / Z;
8654 Z2UCD = Z2UCD * Z_scission / Z;
8655 A1r = Z1UCD + N1r;
8656
8657// ---------------------------------------------------------
8658// determination of the charge and mass of the fragments ...
8659// ---------------------------------------------------------
8660
8661// - CZ is the curvature of charge distribution for fixed mass,
8662// common to all modes, gives the width of the charge distribution.
8663// The physics picture behind is that the division of the
8664// fissioning nucleus in N and Z is slow when mass transport from
8665// one nascent fragment to the other is concerned but fast when the
8666// N/Z degree of freedom is concernded. In addition, the potential
8667// minima in direction of mass transport are broad compared to the
8668// potential minimum in N/Z direction.
8669// The minima in direction of mass transport are calculated
8670// by the liquid-drop (LD) potential (for superlong mode),
8671// by LD + N=82 shell (for standard 1 mode) and
8672// by LD + N=86 shell (for standard 2 mode).
8673// Since the variation of N/Z is fast, it can quickly adjust to
8674// the potential and is thus determined close to scission.
8675// Thus, we calculate the mean N/Z and its width for fixed mass
8676// at scission.
8677// For the SL mode, the mean N/Z is calculated by the
8678// minimum of the potential at scission as a function of N/Z for
8679// fixed mass.
8680// For the S1 and S2 modes, this correlation is imposed by the
8681// empirical charge polarisation.
8682// For the SL mode, the fluctuation in this width is calculated
8683// from the curvature of the potential at scission as a function
8684// of N/Z. This value is also used for the widths of S1 and S2.
8685
8686
8687// Polarisation assumed for standard I and standard II:
8688// Z - Zucd = cpol (for A = const);
8689// from this we get (see remarks above)
8690// Z - Zucd = Acn/Ncn * cpol (for N = const) */
8691//
8692 CZ = ( frldm( Z1UCD-1.0, N1r+1.0, beta1 ) +
8693 frldm( Z2UCD+1.0, N2r-1.0, beta2 ) +
8694 frldm( Z1UCD+1.0, N1r-1.0, beta1 ) +
8695 frldm( Z2UCD-1.0, N2r+1.0, beta2 ) +
8696 ecoul( Z1UCD-1.0, N1r+1.0, beta1,
8697 Z2UCD+1.0, N2r-1.0, beta2, 2.0) +
8698 ecoul( Z1UCD+1.0, N1r-1.0, beta1,
8699 Z2UCD-1.0, N2r+1.0, beta2, 2.0) -
8700 2.0*ecoul( Z1UCD, N1r, beta1, Z2UCD, N2r, beta2, 2.0) -
8701 2.0*frldm( Z1UCD, N1r, beta1 ) -
8702 2.0*frldm( Z2UCD, N2r, beta2) ) * 0.50;
8703//
8704 if(1.0/A_levdens*E_scission_post < 0.0)
8705 std::cout << "DSQRT 1 < 0" << A_levdens << " " << E_scission_post << std::endl;
8706
8707 if(0.50 * std::sqrt(1.0/A_levdens*E_scission_post) / CZ < 0.0){
8708 std::cout << "DSQRT 2 < 0 " << CZ << std::endl;
8709 std::cout << "This event was not considered" << std::endl;
8710 goto fiss321;
8711 }
8712
8713 ZA1width = std::sqrt(0.5*std::sqrt(1.0/A_levdens*E_scission_post)/CZ);
8714
8715// Minimum width in N/Z imposed.
8716// Value of minimum width taken from 235U(nth,f) data
8717// sigma_Z(A=const) = 0.4 to 0.5 (from Lang paper Nucl Phys. A345 (1980) 34)
8718// sigma_N(Z=const) = 0.45 * A/Z (= 1.16 for 238U)
8719// therefore: SIGZMIN = 1.16
8720// Physics; variation in N/Z for fixed A assumed.
8721// Thermal energy at scission is reduced by
8722// pre-scission neutron evaporation"
8723
8724 ZA1width = max(ZA1width,sigZmin);
8725
8726 if(imode == 1 && cpol1 != 0.0){
8727// --- asymmetric fission, mode 1 */
8728 G4int IS = 0;
8729 fiss2801:
8730 Z1rr = Z1UCD - cpol1 * A_scission/N_scission;
8731 // Z1r = DBLE(GaussHaz(k,sngl(Z1rr), sngl(ZA1width) ));
8732 // Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);//
8733 Z1r =gausshaz(0,Z1rr,ZA1width);
8734 IS = IS +1;
8735 if(IS>100){
8736 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED" << std::endl;
8737 Z1r = Z1rr;
8738 }
8739 if ((utilabs(Z1rr - Z1r) > 3.0*ZA1width) || Z1r<1.0)goto fiss2801;
8740 N1r = A1r - Z1r;
8741 }else{
8742 if( imode == 2 && cpol2 != 0.0 ){
8743// --- asymmetric fission, mode 2 */
8744 G4int IS = 0;
8745 fiss2802:
8746 Z1rr = Z1UCD - cpol2 * A_scission/N_scission;
8747 //Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);//
8748 Z1r = gausshaz(0,Z1rr,ZA1width);
8749 IS = IS +1;
8750 if(IS>100){
8751 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED" << std::endl;
8752 Z1r = Z1rr;
8753 }
8754 if( (utilabs(Z1rr - Z1r) > 3.0*ZA1width) || Z1r < 1.0 ) goto fiss2802;
8755 N1r = A1r - Z1r;
8756 }else{
8757// Otherwise do; /* Imode = 3 in any case; imode = 1 and 2 for CPOL = 0 */
8758// and symmetric case */
8759// We treat a simultaneous split in Z and N to determine
8760// polarisation */
8761
8762 re1 = frldm( Z1UCD-1.0, N1r+1.0, beta1 ) +
8763 frldm( Z2UCD+1.0, N2r-1.0, beta2 ) +
8764 ecoul( Z1UCD-1.0, N1r+1.0, beta1,
8765 Z2UCD+1.0, N2r-1.0, beta2, d ); /* d = 2 fm */
8766 re2 = frldm( Z1UCD, N1r, beta1) +
8767 frldm( Z2UCD, N2r, beta2 ) +
8768 ecoul( Z1UCD, N1r, beta1,
8769 Z2UCD, N2r, beta2, d ); /* d = 2 fm */
8770 re3 = frldm( Z1UCD+1.0, N1r-1.0, beta1 ) +
8771 frldm( Z2UCD-1.0, N2r+1.0, beta2 ) +
8772 ecoul( Z1UCD+1.0, N1r-1.0, beta1,
8773 Z2UCD-1.0, N2r+1.0, beta2, d ); /* d = 2 fm */
8774 eps2 = ( re1 - 2.0*re2 + re3 ) / 2.0;
8775 eps1 = ( re3 - re1 ) / 2.0;
8776 DN1_POL = -eps1 / ( 2.0 * eps2 );
8777//
8778 Z1rr = Z1UCD + DN1_POL;
8779
8780// Polarization of Standard 1 from shell effects around 132Sn
8781 if ( imode == 1 ){
8782 if ( Z1rr > 50.0 ){
8783 DN1_POL = DN1_POL - 0.6 * Uwash(E_scission_post,Ecrit,FREDSHELL,gamma);
8784 Z1rr = Z1UCD + DN1_POL;
8785 if ( Z1rr < 50. ) Z1rr = 50.0;
8786 }else{
8787 DN1_POL = DN1_POL + 0.60 * Uwash(E_scission_post,Ecrit,FREDSHELL,gamma);
8788 Z1rr = Z1UCD + DN1_POL;
8789 if ( Z1rr > 50.0 ) Z1rr = 50.0;
8790 }
8791 }
8792
8793 G4int IS = 0;
8794 fiss2803:
8795 //Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);
8796 Z1r = gausshaz(0,Z1rr,ZA1width);
8797 IS = IS +1;
8798 if(IS>100){
8799 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED" << std::endl;
8800 Z1r = Z1rr;
8801 }
8802
8803 if( (utilabs(Z1rr - Z1r) > 3.0*ZA1width) || (Z1r < 1.0) )goto fiss2803;
8804 N1r = A1r - Z1r;
8805
8806 }
8807 }
8808
8809// ------------------------------------------
8810// Integer proton number with even-odd effect
8811// ------------------------------------------
8812 even_odd(Z1r, r_e_o, i_help);
8813
8814 z1 = G4double(i_help);
8815 z2 = dint( Z_scission ) - z1;
8816 N1 = dint( N1r );
8817 N2 = dint( N_scission ) - N1;
8818 a1 = z1 + N1;
8819 a2 = z2 + N2;
8820
8821 if( (z1 < 0) || (z2 < 0) || (a1 < 0) || (a2 < 0) ){
8822 std::cout << " -------------------------------" << std::endl;
8823 std::cout << " Z, A, N : " << Z << " " << A << " " << N << std::endl;
8824 std::cout << z1 << " " << z2 << " " << a1 << " " << a2 << std::endl;
8825 std::cout << E_scission_post << " " << A_levdens << " " << CZ << std::endl;
8826
8827 std::cout << " -------------------------------" << std::endl;
8828 }
8829
8830// -----------------------
8831// excitation energies ...
8832// -----------------------
8833//
8834 if( imode == 1 ){
8835// ---- N = 82
8836 if( N1mean > N*0.50 ){
8837// (a) 1. fragment is spherical and 2. fragment is deformed */
8838 E_defo = 0.0;
8839 beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8840 if(beta2< beta2gs) beta2 = beta2gs;
8841 E1exc = E_scission_pre * a1 / A + E_defo;
8842 E_defo = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8843 E2exc = E_scission_pre * a2 / A + E_defo;
8844 }else{
8845// (b) 1. fragment is deformed and 2. fragment is spherical */
8846 beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8847 if(beta1< beta1gs) beta1 = beta1gs;
8848 E_defo = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8849 E1exc = E_scission_pre * a1 / A + E_defo;
8850 E_defo = 0.0;
8851 E2exc = E_scission_pre * a2 / A + E_defo;
8852 }
8853 }
8854
8855
8856 if( imode == 2 ){
8857// --- N appr. 86 */
8858 if( N1mean > N*0.5 ){
8859 /* 2. fragment is spherical */
8860 beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8861 if(beta1< beta1gs) beta1 = beta1gs;
8862 E_defo = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8863 E1exc = E_scission_pre * a1 / A + E_defo;
8864 beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8865 if(beta2< beta2gs) beta2 = beta2gs;
8866 E_defo = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8867 E2exc = E_scission_pre * a2 / A + E_defo;
8868 }else{
8869 /* 1. fragment is spherical */
8870 beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8871 if(beta2< beta2gs) beta2 = beta2gs;
8872 E_defo = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8873 E2exc = E_scission_pre * a2 / A + E_defo;
8874 beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8875 if(beta1< beta1gs) beta1 = beta1gs;
8876 E_defo = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8877 E1exc = E_scission_pre * a1 / A + E_defo;
8878 }
8879 }
8880
8881 if( imode == 3 ){
8882// --- Symmetric fission channel
8883 beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8884 if(beta1< beta1gs) beta1 = beta1gs;
8885 beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8886 if(beta2< beta2gs) beta2 = beta2gs;
8887 E_defo1 = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8888 E_defo2 = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8889 E1exc = E_scission_pre * a1 / A + E_defo1;
8890 E2exc = E_scission_pre * a2 / A + E_defo2;
8891 }
8892
8893
8894// pre-neutron-emission total kinetic energy */
8895 TKER = ( z1 * z2 * 1.440 ) /
8896 ( R0 * std::pow(a1,0.333330) * (1.0 + 2.0/3.0 * beta1 ) +
8897 R0 * std::pow(a2,0.333330) * (1.0 + 2.0/3.0 * beta2 ) + 2.0 );
8898// Pre-neutron-emission kinetic energies of the fragments */
8899 EkinR1 = TKER * a2 / A;
8900 EkinR2 = TKER * a1 / A;
8901 v1 = std::sqrt(EkinR1/a1) * 1.3887;
8902 v2 = std::sqrt(EkinR2/a2) * 1.3887;
8903
8904// Extracted from Lang et al. Nucl. Phys. A 345 (1980) 34 */
8905 E1exc_sigma = 5.50;
8906 E2exc_sigma = 5.50;
8907
8908 fis987:
8909 //e1 = E1exc+G4AblaRandom::gaus(E1exc_sigma);//
8910 e1 = gausshaz(0,E1exc,E1exc_sigma);
8911 if(e1<0.)goto fis987;
8912 fis988:
8913 //e2 = E2exc+G4AblaRandom::gaus(E2exc_sigma);//
8914 e2 = gausshaz(0,E2exc,E2exc_sigma);
8915 if(e2<0.)goto fis988;
8916
8917 (*NbLam0_par) = NbLam0;
8918 return;
8919}
8920
8921
8922void G4Abla::even_odd(G4double r_origin,G4double r_even_odd,G4int &i_out)
8923{
8924 // Procedure to calculate I_OUT from R_IN in a way that
8925 // on the average a flat distribution in R_IN results in a
8926 // fluctuating distribution in I_OUT with an even-odd effect as
8927 // given by R_EVEN_ODD
8928
8929 // /* ------------------------------------------------------------ */
8930 // /* EXAMPLES : */
8931 // /* ------------------------------------------------------------ */
8932 // /* If R_EVEN_ODD = 0 : */
8933 // /* CEIL(R_IN) ---- */
8934 // /* */
8935 // /* R_IN -> */
8936 // /* (somewhere in between CEIL(R_IN) and FLOOR(R_IN)) */ */
8937 // /* */
8938 // /* FLOOR(R_IN) ---- --> I_OUT */
8939 // /* ------------------------------------------------------------ */
8940 // /* If R_EVEN_ODD > 0 : */
8941 // /* The interval for the above treatment is */
8942 // /* larger for FLOOR(R_IN) = even and */
8943 // /* smaller for FLOOR(R_IN) = odd */
8944 // /* For R_EVEN_ODD < 0 : just opposite treatment */
8945 // /* ------------------------------------------------------------ */
8946
8947 // /* ------------------------------------------------------------ */
8948 // /* On input: R_ORIGIN nuclear charge (real number) */
8949 // /* R_EVEN_ODD requested even-odd effect */
8950 // /* Intermediate quantity: R_IN = R_ORIGIN + 0.5 */
8951 // /* On output: I_OUT nuclear charge (integer) */
8952 // /* ------------------------------------------------------------ */
8953
8954 // G4double R_ORIGIN,R_IN,R_EVEN_ODD,R_REST,R_HELP;
8955 G4double r_in = 0.0, r_rest = 0.0, r_help = 0.0;
8956 G4double r_floor = 0.0;
8957 G4double r_middle = 0.0;
8958 // G4int I_OUT,N_FLOOR;
8959 G4int n_floor = 0;
8960
8961 r_in = r_origin + 0.5;
8962 r_floor = (G4double)((G4int)(r_in));
8963 if (r_even_odd < 0.001) {
8964 i_out = (G4int)(r_floor);
8965 }
8966 else {
8967 r_rest = r_in - r_floor;
8968 r_middle = r_floor + 0.5;
8969 n_floor = (G4int)(r_floor);
8970 if (n_floor%2 == 0) {
8971 // even before modif.
8972 r_help = r_middle + (r_rest - 0.5) * (1.0 - r_even_odd);
8973 }
8974 else {
8975 // odd before modification
8976 r_help = r_middle + (r_rest - 0.5) * (1.0 + r_even_odd);
8977 }
8978 i_out = (G4int)(r_help);
8979 }
8980}
8981
8983{
8984 // liquid-drop mass, Myers & Swiatecki, Lysekil, 1967
8985 // pure liquid drop, without pairing and shell effects
8986
8987 // On input: Z nuclear charge of nucleus
8988 // N number of neutrons in nucleus
8989 // beta deformation of nucleus
8990 // On output: binding energy of nucleus
8991
8992 G4double a = 0.0, fumass = 0.0;
8993 G4double alpha = 0.0;
8994 G4double xcom = 0.0, xvs = 0.0, xe = 0.0;
8995 const G4double pi = 3.1416;
8996
8997 a = n + z;
8998 alpha = ( std::sqrt(5.0/(4.0*pi)) ) * beta;
8999
9000 xcom = 1.0 - 1.7826 * ((a - 2.0*z)/a)*((a - 2.0*z)/a);
9001 // factor for asymmetry dependence of surface and volume term
9002 xvs = - xcom * ( 15.4941 * a -
9003 17.9439 * std::pow(a,2.0/3.0) * (1.0+0.4*alpha*alpha) );
9004 // sum of volume and surface energy
9005 xe = z*z * (0.7053/(std::pow(a,1.0/3.0)) * (1.0-0.2*alpha*alpha) - 1.1529/a);
9006 fumass = xvs + xe;
9007
9008 return fumass;
9009}
9010
9011
9013{
9014 // Coulomb potential between two nuclei
9015 // surfaces are in a distance of d
9016 // in a tip to tip configuration
9017
9018 // approximate formulation
9019 // On input: Z1 nuclear charge of first nucleus
9020 // N1 number of neutrons in first nucleus
9021 // beta1 deformation of first nucleus
9022 // Z2 nuclear charge of second nucleus
9023 // N2 number of neutrons in second nucleus
9024 // beta2 deformation of second nucleus
9025 // d distance of surfaces of the nuclei
9026
9027 // G4double Z1,N1,beta1,Z2,N2,beta2,d,ecoul;
9028 G4double fecoul = 0;
9029 G4double dtot = 0;
9030 const G4double r0 = 1.16;
9031
9032 dtot = r0 * ( std::pow((z1+n1),1.0/3.0) * (1.0+0.6666667*beta1)
9033 + std::pow((z2+n2),1.0/3.0) * (1.0+0.6666667*beta2) ) + d;
9034 fecoul = z1 * z2 * 1.44 / dtot;
9035
9036 return fecoul;
9037}
9038
9039
9041 // E excitation energy
9042 // Ecrit critical pairing energy
9043 // Freduction reduction factor for shell washing in superfluid region
9044 G4double R_wash,uwash;
9045 if(E < Ecrit)
9046 R_wash = std::exp(-E * Freduction * gamma);
9047 else
9048 R_wash = std::exp(- Ecrit * Freduction * gamma -(E-Ecrit) * gamma);
9049
9050 uwash = R_wash;
9051 return uwash;
9052}
9053
9054
9056
9057// Liquid-drop mass, Myers & Swiatecki, Lysekil, 1967
9058// pure liquid drop, without pairing and shell effects
9059//
9060// On input: Z nuclear charge of nucleus
9061// N number of neutrons in nucleus
9062// beta deformation of nucleus
9063// On output: binding energy of nucleus
9064// The idea is to use FRLDM model for beta=0 and using Lysekil
9065// model to get the deformation energy
9066
9067 G4double a;
9068 a = n + z;
9069 return eflmac_profi(a,z) + umass(z,n,beta) - umass(z,n,0.0);
9070}
9071
9072
9073//**********************************************************************
9074// *
9075// * this function will calculate the liquid-drop nuclear mass for spheri
9076// * configuration according to the preprint NUCLEAR GROUND-STATE
9077// * MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
9078// * All constants are taken from this publication for consistency.
9079// *
9080// * Parameters:
9081// * a: nuclear mass number
9082// * z: nuclear charge
9083// **********************************************************************
9084
9085
9087{
9088 // CHANGED TO CALCULATE TOTAL BINDING ENERGY INSTEAD OF MASS EXCESS.
9089 // SWITCH FOR PAIRING INCLUDED AS WELL.
9090 // BINDING = EFLMAC(IA,IZ,0,OPTSHP)
9091 // FORTRAN TRANSCRIPT OF /U/GREWE/LANG/EEX/FRLDM.C
9092 // A.J. 15.07.96
9093
9094 // this function will calculate the liquid-drop nuclear mass for spheri
9095 // configuration according to the preprint NUCLEAR GROUND-STATE
9096 // MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
9097 // All constants are taken from this publication for consistency.
9098
9099 // Parameters:
9100 // a: nuclear mass number
9101 // z: nuclear charge
9102
9103 G4double eflmacResult = 0.0;
9104
9105 G4int in = 0;
9106 G4double z = 0.0, n = 0.0, a = 0.0, av = 0.0, as = 0.0;
9107 G4double a0 = 0.0, c1 = 0.0, c4 = 0.0, b1 = 0.0, b3 = 0.0;
9108 G4double ff = 0.0, ca = 0.0, w = 0.0, efl = 0.0;
9109 G4double r0 = 0.0, kf = 0.0, ks = 0.0;
9110 G4double kv = 0.0, rp = 0.0, ay = 0.0, aden = 0.0, x0 = 0.0, y0 = 0.0;
9111 G4double esq = 0.0, ael = 0.0, i = 0.0;
9112 G4double pi = 3.141592653589793238e0;
9113
9114 // fundamental constants
9115 // electronic charge squared
9116 esq = 1.4399764;
9117
9118 // constants from considerations other than nucl. masses
9119 // electronic binding
9120 ael = 1.433e-5;
9121
9122 // proton rms radius
9123 rp = 0.8;
9124
9125 // nuclear radius constant
9126 r0 = 1.16;
9127
9128 // range of yukawa-plus-expon. potential
9129 ay = 0.68;
9130
9131 // range of yukawa function used to generate
9132 // nuclear charge distribution
9133 aden= 0.70;
9134
9135 // wigner constant
9136 w = 30.0;
9137
9138 // adjusted parameters
9139 // volume energy
9140 av = 16.00126;
9141
9142 // volume asymmetry
9143 kv = 1.92240;
9144
9145 // surface energy
9146 as = 21.18466;
9147
9148 // surface asymmetry
9149 ks = 2.345;
9150 // a^0 constant
9151 a0 = 2.615;
9152
9153 // charge asymmetry
9154 ca = 0.10289;
9155
9156 z = G4double(iz);
9157 a = G4double(ia);
9158 in = ia - iz;
9159 n = G4double(in);
9160
9161
9162 c1 = 3.0/5.0*esq/r0;
9163 c4 = 5.0/4.0*std::pow((3.0/(2.0*pi)),(2.0/3.0)) * c1;
9164 kf = std::pow((9.0*pi*z/(4.0*a)),(1.0/3.0))/r0;
9165
9166 ff = -1.0/8.0*rp*rp*esq/std::pow(r0,3) * (145.0/48.0 - 327.0/2880.0*std::pow(kf,2) * std::pow(rp,2) + 1527.0/1209600.0*std::pow(kf,4) * std::pow(rp,4));
9167
9168 i = (n-z)/a;
9169
9170 x0 = r0 * std::pow(a,(1.0/3.0)) / ay;
9171 y0 = r0 * std::pow(a,(1.0/3.0)) / aden;
9172
9173 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);
9174
9175 b3 = 1.0 - 5.0/std::pow(y0,2) * (1.0 - 15.0/(8.0*y0) + 21.0/(8.0 * std::pow(y0,3))
9176 - 3.0/4.0 * (1.0 + 9.0/(2.0*y0) + 7.0/std::pow(y0,2)
9177 + 7.0/(2.0 * std::pow(y0,3))) * std::exp(-2.0*y0));
9178
9179 // now calculation of total binding energy
9180
9181 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
9182 + 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))
9183 + ff*std::pow(z,2)/a -ca*(n-z) - ael * std::pow(z,(2.39e0));
9184
9185 efl = efl + w*utilabs(i);
9186
9187 eflmacResult = efl;
9188
9189 return eflmacResult;
9190}
9191//
9192//
9193//
9194void G4Abla::unstable_nuclei(G4int AFP,G4int ZFP,G4int *AFPNEW,G4int *ZFPNEW,G4int &IOUNSTABLE,G4double VX,G4double VY,G4double VZ,G4double *VP1X,G4double *VP1Y,G4double *VP1Z,G4double BU_TAB_TEMP[200][6],G4int *ILOOP){
9195//
9196 G4int INMIN,INMAX,NDIF=0,IMEM;
9197 G4int NEVA=0,PEVA=0;
9198 G4double VP2X,VP2Y,VP2Z;
9199
9200 *AFPNEW = AFP;
9201 *ZFPNEW = ZFP;
9202 IOUNSTABLE = 0;
9203 *ILOOP = 0;
9204 IMEM = 0;
9205 for(G4int i=0;i<200;i++){
9206 BU_TAB_TEMP[i][0] = 0.0;
9207 BU_TAB_TEMP[i][1] = 0.0;
9208 BU_TAB_TEMP[i][2] = 0.0;
9209 BU_TAB_TEMP[i][3] = 0.0;
9210 BU_TAB_TEMP[i][4] = 0.0;
9211 //BU_TAB_TEMP[i][5] = 0.0;
9212 }
9213 *VP1X = 0.0;
9214 *VP1Y = 0.0;
9215 *VP1Z = 0.0;
9216
9217 if(AFP==0 && ZFP==0){
9218// PRINT*,'UNSTABLE NUCLEI, AFP=0, ZFP=0'
9219 return;
9220 }
9221 if((AFP==1 && ZFP==0) ||
9222 (AFP==1 && ZFP==1) ||
9223 (AFP==2 && ZFP==1) ||
9224 (AFP==3 && ZFP==1) ||
9225 (AFP==3 && ZFP==2) ||
9226 (AFP==4 && ZFP==2) ||
9227 (AFP==6 && ZFP==2) ||
9228 (AFP==8 && ZFP==2)
9229 ){
9230 *VP1X = VX;
9231 *VP1Y = VY;
9232 *VP1Z = VZ;
9233 return;
9234 }
9235
9236 if ((AFP-ZFP)==0 && ZFP>1){
9237 for(G4int I = 0;I<=AFP-2;I++){
9238 unstable_tke(G4double(AFP-I),G4double(AFP-I),G4double(AFP-I-1),G4double(AFP-I-1),VX,VY,VZ,
9239 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9240 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9241 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9242 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9243 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9244 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9245 *ILOOP = *ILOOP + 1;
9246 VX = *VP1X;
9247 VY = *VP1Y;
9248 VZ = *VP1Z;
9249 }
9250 // PEVA = PEVA + ZFP - 1;
9251 AFP = 1;
9252 ZFP = 1;
9253 IOUNSTABLE = 1;
9254 }
9255//
9256//*** Find the limits nucleus is bound :
9257 isostab_lim(ZFP,&INMIN,&INMAX);
9258 NDIF = AFP - ZFP;
9259 if(NDIF<INMIN){
9260// Proton unbound
9261 IOUNSTABLE = 1;
9262 for(G4int I = 1;I<=10; I++){
9263 isostab_lim(ZFP-I,&INMIN,&INMAX);
9264 if(INMIN<=NDIF){
9265 IMEM = I;
9266 ZFP = ZFP - I;
9267 AFP = ZFP + NDIF;
9268 PEVA = I;
9269 goto u10;
9270 }
9271 }
9272//
9273 u10:
9274 for(G4int I = 0;I< IMEM;I++){
9275 unstable_tke(G4double(NDIF+ZFP+IMEM-I),
9276 G4double(ZFP+IMEM-I),
9277 G4double(NDIF+ZFP+IMEM-I-1),
9278 G4double(ZFP+IMEM-I-1),
9279 VX,VY,VZ,
9280 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9281 BU_TAB_TEMP[I+1+*ILOOP][0] = 1.0;
9282 BU_TAB_TEMP[I+1+*ILOOP][1] = 1.0;
9283 BU_TAB_TEMP[I+1+*ILOOP][2] = VP2X;
9284 BU_TAB_TEMP[I+1+*ILOOP][3] = VP2Y;
9285 BU_TAB_TEMP[I+1+*ILOOP][4] = VP2Z;
9286 VX = *VP1X;
9287 VY = *VP1Y;
9288 VZ = *VP1Z;
9289 }
9290 *ILOOP = *ILOOP + IMEM;
9291
9292 }
9293 if(NDIF>INMAX){
9294// Neutron unbound
9295 NEVA = NDIF - INMAX;
9296 AFP = ZFP + INMAX;
9297 IOUNSTABLE = 1;
9298 for(G4int I = 0;I<NEVA;I++){
9299 unstable_tke(G4double(ZFP+NDIF-I),
9300 G4double(ZFP),
9301 G4double(ZFP+NDIF-I-1),
9302 G4double(ZFP),
9303 VX,VY,VZ,
9304 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9305
9306 BU_TAB_TEMP[*ILOOP][0] = 0.0;
9307 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9308 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9309 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9310 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9311 *ILOOP = *ILOOP + 1;
9312 VX = *VP1X;
9313 VY = *VP1Y;
9314 VZ = *VP1Z;
9315 }
9316 }
9317
9318 if ((AFP>=2) && (ZFP==0)){
9319 for(G4int I = 0;I<= AFP-2;I++){
9320 unstable_tke(G4double(AFP-I),G4double(ZFP),
9321 G4double(AFP-I-1),G4double(ZFP),
9322 VX,VY,VZ,
9323 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9324
9325 BU_TAB_TEMP[*ILOOP][0] = 0.0;
9326 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9327 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9328 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9329 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9330 *ILOOP = *ILOOP + 1;
9331 VX = *VP1X;
9332 VY = *VP1Y;
9333 VZ = *VP1Z;
9334 }
9335
9336 //NEVA = NEVA + (AFP - 1);
9337 AFP = 1;
9338 ZFP = 0;
9339 IOUNSTABLE = 1;
9340 }
9341 if (AFP<ZFP){
9342 std::cout << "WARNING - BU UNSTABLE: AF < ZF" << std::endl;
9343 AFP = 0;
9344 ZFP = 0;
9345 IOUNSTABLE = 1;
9346 }
9347 if ((AFP>=4) && (ZFP==1)){
9348// Heavy residue is treated as 3H and the rest of mass is emitted as neutrons:
9349 for(G4int I = 0; I<AFP-3;I++){
9350 unstable_tke(G4double(AFP-I),G4double(ZFP),
9351 G4double(AFP-I-1),G4double(ZFP),
9352 VX,VY,VZ,
9353 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9354
9355 BU_TAB_TEMP[*ILOOP][0] = 0.0;
9356 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9357 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9358 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9359 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9360 *ILOOP = *ILOOP + 1;
9361 VX = *VP1X;
9362 VY = *VP1Y;
9363 VZ = *VP1Z;
9364 }
9365
9366 // NEVA = NEVA + (AFP - 3);
9367 AFP = 3;
9368 ZFP = 1;
9369 IOUNSTABLE = 1;
9370 }
9371
9372 if ((AFP==4) && (ZFP==3)){
9373// 4Li -> 3He + p ->
9374 AFP = 3;
9375 ZFP = 2;
9376 //PEVA = PEVA + 1;
9377 IOUNSTABLE = 1;
9378 unstable_tke(4.0,3.0,3.0,2.0,
9379 VX,VY,VZ,
9380 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9381
9382 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9383 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9384 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9385 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9386 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9387 *ILOOP = *ILOOP + 1;
9388 }
9389 if ((AFP==5) && (ZFP==2)){
9390// 5He -> 4He + n ->
9391 AFP = 4;
9392 ZFP = 2;
9393 //NEVA = NEVA + 1;
9394 IOUNSTABLE = 1;
9395 unstable_tke(5.0,2.0,4.0,2.0,
9396 VX,VY,VZ,
9397 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9398 BU_TAB_TEMP[*ILOOP][0] = 0.0;
9399 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9400 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9401 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9402 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9403 *ILOOP = *ILOOP + 1;
9404 }
9405
9406 if ((AFP==5) && (ZFP==3)){
9407// 5Li -> 4He + p
9408 AFP = 4;
9409 ZFP = 2;
9410 //PEVA = PEVA + 1;
9411 IOUNSTABLE = 1;
9412 unstable_tke(5.0,3.0,4.0,2.0,
9413 VX,VY,VZ,
9414 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9415 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9416 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9417 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9418 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9419 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9420 *ILOOP = *ILOOP + 1;
9421 }
9422
9423 if ((AFP==6) && (ZFP==4)){
9424// 6Be -> 4He + 2p (velocity in two steps: 6Be->5Li->4He)
9425 AFP = 4;
9426 ZFP = 2;
9427 //PEVA = PEVA + 2;
9428 IOUNSTABLE = 1;
9429// 6Be -> 5Li + p
9430 unstable_tke(6.0,4.0,5.0,3.0,
9431 VX,VY,VZ,
9432 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9433 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9434 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9435 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9436 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9437 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9438 *ILOOP = *ILOOP + 1;
9439 VX = *VP1X;
9440 VY = *VP1Y;
9441 VZ = *VP1Z;
9442
9443// 5Li -> 4He + p
9444 unstable_tke(5.0,3.0,4.0,2.0,
9445 VX,VY,VZ,
9446 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9447 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9448 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9449 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9450 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9451 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9452 *ILOOP = *ILOOP + 1;
9453 }
9454 if ((AFP==7)&&(ZFP==2)){
9455// 7He -> 6He + n
9456 AFP = 6;
9457 ZFP = 2;
9458 //NEVA = NEVA + 1;
9459 IOUNSTABLE = 1;
9460 unstable_tke(7.0,2.0,6.0,2.0,
9461 VX,VY,VZ,
9462 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9463 BU_TAB_TEMP[*ILOOP][0] = 0.0;
9464 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9465 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9466 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9467 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9468 *ILOOP = *ILOOP + 1;
9469 }
9470
9471 if ((AFP==7) && (ZFP==5)){
9472// 7B -> 6Be + p -> 4He + 3p
9473 for(int I = 0; I<= AFP-5;I++){
9474 unstable_tke(double(AFP-I),double(ZFP-I),
9475 double(AFP-I-1),double(ZFP-I-1),
9476 VX,VY,VZ,
9477 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9478 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9479 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9480 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9481 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9482 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9483 *ILOOP = *ILOOP + 1;
9484 VX = *VP1X;
9485 VY = *VP1Y;
9486 VZ = *VP1Z;
9487 }
9488
9489 AFP = 4;
9490 ZFP = 2;
9491 //PEVA = PEVA + 3;
9492 IOUNSTABLE = 1;
9493 }
9494 if ((AFP==8) && (ZFP==4)){
9495// 8Be -> 4He + 4He
9496 AFP = 4;
9497 ZFP = 2;
9498 IOUNSTABLE = 1;
9499 unstable_tke(8.0,4.0,4.0,2.0,
9500 VX,VY,VZ,
9501 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9502 BU_TAB_TEMP[*ILOOP][0] = 2.0;
9503 BU_TAB_TEMP[*ILOOP][1] = 4.0;
9504 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9505 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9506 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9507 *ILOOP = *ILOOP + 1;
9508 }
9509 if ((AFP==8) && (ZFP==6)){
9510// 8C -> 2p + 6Be
9511 AFP = 6;
9512 ZFP = 4;
9513 //PEVA = PEVA + 2;
9514 IOUNSTABLE = 1;
9515
9516 unstable_tke(8.0,6.0,7.0,5.0,
9517 VX,VY,VZ,
9518 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9519 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9520 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9521 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9522 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9523 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9524 *ILOOP = *ILOOP + 1;
9525 VX = *VP1X;
9526 VY = *VP1Y;
9527 VZ = *VP1Z;
9528
9529 unstable_tke(7.0,5.0,6.0,4.0,
9530 VX,VY,VZ,
9531 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9532 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9533 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9534 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9535 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9536 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9537 *ILOOP = *ILOOP + 1;
9538 VX = *VP1X;
9539 VY = *VP1Y;
9540 VZ = *VP1Z;
9541 }
9542
9543 if((AFP==9) && (ZFP==2)){
9544// 9He -> 8He + n
9545 AFP = 8;
9546 ZFP = 2;
9547 //NEVA = NEVA + 1;
9548 IOUNSTABLE = 1;
9549
9550 unstable_tke(9.0,2.0,8.0,2.0,
9551 VX,VY,VZ,
9552 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9553 BU_TAB_TEMP[*ILOOP][0] = 0.0;
9554 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9555 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9556 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9557 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9558 *ILOOP = *ILOOP + 1;
9559 VX = *VP1X;
9560 VY = *VP1Y;
9561 VZ = *VP1Z;
9562 }
9563
9564 if((AFP==9) && (ZFP==5)){
9565// 9B -> 4He + 4He + p ->
9566 AFP = 4;
9567 ZFP = 2;
9568 //PEVA = PEVA + 1;
9569 IOUNSTABLE = 1;
9570 unstable_tke(9.0,5.0,8.0,4.0,
9571 VX,VY,VZ,
9572 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9573 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9574 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9575 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9576 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9577 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9578 *ILOOP = *ILOOP + 1;
9579 VX = *VP1X;
9580 VY = *VP1Y;
9581 VZ = *VP1Z;
9582
9583 unstable_tke(8.0,4.0,4.0,2.0,
9584 VX,VY,VZ,
9585 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9586 BU_TAB_TEMP[*ILOOP][0] = 2.0;
9587 BU_TAB_TEMP[*ILOOP][1] = 4.0;
9588 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9589 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9590 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9591 *ILOOP = *ILOOP + 1;
9592 VX = *VP1X;
9593 VY = *VP1Y;
9594 VZ = *VP1Z;
9595 }
9596
9597 if((AFP==10) && (ZFP==2)){
9598// 10He -> 8He + 2n
9599 AFP = 8;
9600 ZFP = 2;
9601 //NEVA = NEVA + 2;
9602 IOUNSTABLE = 1;
9603// 10He -> 9He + n
9604 unstable_tke(10.0,2.0,9.0,2.0,
9605 VX,VY,VZ,
9606 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9607 BU_TAB_TEMP[*ILOOP][0] = 0.0;
9608 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9609 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9610 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9611 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9612 *ILOOP = *ILOOP + 1;
9613 VX = *VP1X;
9614 VY = *VP1Y;
9615 VZ = *VP1Z;
9616
9617// 9He -> 8He + n
9618 unstable_tke(9.0,2.0,8.0,2.0,
9619 VX,VY,VZ,
9620 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9621 BU_TAB_TEMP[*ILOOP][0] = 0.0;
9622 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9623 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9624 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9625 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9626 *ILOOP = *ILOOP + 1;
9627 VX = *VP1X;
9628 VY = *VP1Y;
9629 VZ = *VP1Z;
9630 }
9631 if ((AFP==10) && (ZFP==3)){
9632// 10Li -> 9Li + n ->
9633 AFP = 9;
9634 ZFP = 3;
9635 //NEVA = NEVA + 1;
9636 IOUNSTABLE = 1;
9637 unstable_tke(10.0,3.0,9.0,3.0,
9638 VX,VY,VZ,
9639 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9640 BU_TAB_TEMP[*ILOOP][0] = 0.0;
9641 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9642 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9643 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9644 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9645 *ILOOP = *ILOOP + 1;
9646 VX = *VP1X;
9647 VY = *VP1Y;
9648 VZ = *VP1Z;
9649 }
9650 if ((AFP==10) && (ZFP==7)){
9651// 10N -> 9C + p ->
9652 AFP = 9;
9653 ZFP = 6;
9654 //PEVA = PEVA + 1;
9655 IOUNSTABLE = 1;
9656 unstable_tke(10.0,7.0,9.0,6.0,
9657 VX,VY,VZ,
9658 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9659 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9660 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9661 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9662 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9663 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9664 *ILOOP = *ILOOP + 1;
9665 VX = *VP1X;
9666 VY = *VP1Y;
9667 VZ = *VP1Z;
9668 }
9669
9670 if((AFP==11) && (ZFP==7)){
9671// 11N -> 10C + p ->
9672 AFP = 10;
9673 ZFP = 6;
9674 //PEVA = PEVA + 1;
9675 IOUNSTABLE = 1;
9676 unstable_tke(11.0,7.0,10.0,6.0,
9677 VX,VY,VZ,
9678 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9679 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9680 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9681 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9682 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9683 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9684 *ILOOP = *ILOOP + 1;
9685 VX = *VP1X;
9686 VY = *VP1Y;
9687 VZ = *VP1Z;
9688 }
9689 if ((AFP==12) && (ZFP==8)){
9690// 12O -> 10C + 2p ->
9691 AFP = 10;
9692 ZFP = 6;
9693 //PEVA = PEVA + 2;
9694 IOUNSTABLE = 1;
9695
9696 unstable_tke(12.0,8.0,11.0,7.0,
9697 VX,VY,VZ,
9698 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9699 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9700 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9701 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9702 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9703 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9704 *ILOOP = *ILOOP + 1;
9705 VX = *VP1X;
9706 VY = *VP1Y;
9707 VZ = *VP1Z;
9708
9709 unstable_tke(11.0,7.0,10.0,6.0,
9710 VX,VY,VZ,
9711 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9712 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9713 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9714 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9715 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9716 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9717 *ILOOP = *ILOOP + 1;
9718 VX = *VP1X;
9719 VY = *VP1Y;
9720 VZ = *VP1Z;
9721 }
9722 if ((AFP==15) && (ZFP==9)){
9723// 15F -> 14O + p ->
9724 AFP = 14;
9725 ZFP = 8;
9726 //PEVA = PEVA + 1;
9727 IOUNSTABLE = 1;
9728 unstable_tke(15.0,9.0,14.0,8.0,
9729 VX,VY,VZ,
9730 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9731 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9732 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9733 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9734 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9735 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9736 *ILOOP = *ILOOP + 1;
9737 VX = *VP1X;
9738 VY = *VP1Y;
9739 VZ = *VP1Z;
9740 }
9741
9742 if ((AFP==16) && (ZFP==9)){
9743// 16F -> 15O + p ->
9744 AFP = 15;
9745 ZFP = 8;
9746 //PEVA = PEVA + 1;
9747 IOUNSTABLE = 1;
9748 unstable_tke(16.0,9.0,15.0,8.0,
9749 VX,VY,VZ,
9750 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9751 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9752 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9753 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9754 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9755 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9756 *ILOOP = *ILOOP + 1;
9757 VX = *VP1X;
9758 VY = *VP1Y;
9759 VZ = *VP1Z;
9760 }
9761
9762 if ((AFP==16) && (ZFP==10)){
9763// 16Ne -> 14O + 2p ->
9764 AFP = 14;
9765 ZFP = 8;
9766 //PEVA = PEVA + 2;
9767 IOUNSTABLE = 1;
9768 unstable_tke(16.0,10.0,15.0,9.0,
9769 VX,VY,VZ,
9770 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9771 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9772 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9773 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9774 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9775 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9776 *ILOOP = *ILOOP + 1;
9777 VX = *VP1X;
9778 VY = *VP1Y;
9779 VZ = *VP1Z;
9780
9781 unstable_tke(15.0,9.0,14.0,8.0,
9782 VX,VY,VZ,
9783 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9784 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9785 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9786 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9787 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9788 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9789 *ILOOP = *ILOOP + 1;
9790 VX = *VP1X;
9791 VY = *VP1Y;
9792 VZ = *VP1Z;
9793 }
9794 if((AFP==18) && (ZFP==11)){
9795// 18Na -> 17Ne + p ->
9796 AFP = 17;
9797 ZFP = 10;
9798 //PEVA = PEVA + 1;
9799 IOUNSTABLE = 1;
9800 unstable_tke(18.0,11.0,17.0,10.0,
9801 VX,VY,VZ,
9802 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9803 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9804 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9805 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9806 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9807 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9808 *ILOOP = *ILOOP + 1;
9809 VX = *VP1X;
9810 VY = *VP1Y;
9811 VZ = *VP1Z;
9812 }
9813 if((AFP==19) && (ZFP==11)){
9814// 19Na -> 18Ne + p ->
9815 AFP = 18;
9816 ZFP = 10;
9817 //PEVA = PEVA + 1;
9818 IOUNSTABLE = 1;
9819 unstable_tke(19.0,11.0,18.0,10.0,
9820 VX,VY,VZ,
9821 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9822 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9823 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9824 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9825 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9826 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9827 *ILOOP = *ILOOP + 1;
9828 VX = *VP1X;
9829 VY = *VP1Y;
9830 VZ = *VP1Z;
9831 }
9832 if (ZFP>=4 && (AFP-ZFP)==1){
9833// Heavy residue is treated as 3He
9834 NEVA = AFP - 3;
9835 PEVA = ZFP - 2;
9836
9837 for(G4int I = 0;I< NEVA;I++){
9838 unstable_tke(G4double(AFP-I),G4double(ZFP),
9839 G4double(AFP-I-1),G4double(ZFP),
9840 VX,VY,VZ,
9841 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9842 BU_TAB_TEMP[*ILOOP][0] = 0.0;
9843 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9844 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9845 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9846 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9847 *ILOOP = *ILOOP + 1;
9848 VX = *VP1X;
9849 VY = *VP1Y;
9850 VZ = *VP1Z;
9851 }
9852 for( G4int I = 0;I<PEVA;I++){
9853 unstable_tke(G4double(AFP-NEVA-I),G4double(ZFP-I),
9854 G4double(AFP-NEVA-I-1),G4double(ZFP-I-1),
9855 VX,VY,VZ,
9856 &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9857 BU_TAB_TEMP[*ILOOP][0] = 1.0;
9858 BU_TAB_TEMP[*ILOOP][1] = 1.0;
9859 BU_TAB_TEMP[*ILOOP][2] = VP2X;
9860 BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9861 BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9862 *ILOOP = *ILOOP + 1;
9863 VX = *VP1X;
9864 VY = *VP1Y;
9865 VZ = *VP1Z;
9866 }
9867
9868 AFP = 3;
9869 ZFP = 2;
9870 IOUNSTABLE = 1;
9871 }
9872//
9873 *AFPNEW = AFP;
9874 *ZFPNEW = ZFP;
9875 return;
9876}
9877
9878//
9879//
9881//
9882 G4double EKIN_P1=0.,ekin_tot=0.;
9883 G4double PX1,PX2,PY1,PY2,PZ1,PZ2,PTOT;
9884 G4double RNDT,CTET1,STET1,RNDP,PHI1,ETOT_P1,ETOT_P2;
9885 G4double MASS,MASS1,MASS2;
9886 G4double vxout=0.,vyout=0.,vzout=0.;
9887 G4int iain,izin,ianew,iznew,inin,innew;
9888//
9889 G4double C = 29.97924580;// cm/ns
9890 G4double AMU = 931.4940; // MeV/C^2
9891//
9892 iain = idnint(ain);
9893 izin = idnint(zin);
9894 inin = iain - izin;
9895 ianew = idnint(anew);
9896 iznew = idnint(znew);
9897 innew = ianew - iznew;
9898 //
9899 if(ain==0)return;
9900 //
9901 if(izin>12){
9902 mglms(ain,zin,3,&MASS);
9903 mglms(anew,znew,3,&MASS1);
9904 mglms(ain-anew,zin-znew,3,&MASS2);
9905 ekin_tot = MASS-MASS1-MASS2;
9906 }else{
9907 // ekin_tot = MEXP(ININ,IZIN)-(MEXP(INNEW,IZNEW)+MEXP(ININ-INNEW,IZIN-IZNEW));
9908 ekin_tot = masses->massexp[inin][izin]-(masses->massexp[innew][iznew]+masses->massexp[inin-innew][izin-iznew]);
9909 if(izin>12)std::cout << "*** ZIN > 12 ***" << izin << std::endl;
9910 }
9911
9912 if( ekin_tot<0.00 ){
9913// if( iain.ne.izin .and. izin.ne.0 ){
9914// print *,"Negative Q-value in UNSTABLE_TKE"
9915// print *,"ekin_tot=",ekin_tot
9916// print *,"ain,zin=",ain,zin,MEXP(ININ,IZIN)
9917// print *,"anew,znew=",anew,znew,MEXP(INNEW,IZNEW)
9918// print *
9919// }
9920 ekin_tot=0.0;
9921 }
9922//
9923 EKIN_P1 = ekin_tot*(ain-anew)/ ain;
9924 ETOT_P1 = EKIN_P1 + anew * AMU;
9925 PTOT = anew*AMU*std::sqrt((EKIN_P1/(anew*AMU)+1.0)*(EKIN_P1/(anew*AMU)+1.0)-1.0); // MeV/C
9926//
9927 RNDT = G4AblaRandom::flat();
9928 CTET1 = 2.0*RNDT-1.0;
9929 STET1 = std::sqrt(1.0-CTET1*CTET1);
9930 RNDP = G4AblaRandom::flat();
9931 PHI1 = RNDP*2.0*3.141592654;
9932 PX1 = PTOT * STET1*std::cos(PHI1);
9933 PY1 = PTOT * STET1*std::sin(PHI1);
9934 PZ1 = PTOT * CTET1;
9935 *v1x = C * PX1 / ETOT_P1;
9936 *v1y = C * PY1 / ETOT_P1;
9937 *v1z = C * PZ1 / ETOT_P1;
9938 lorentz_boost(vxin,vyin,vzin,*v1x,*v1y,*v1z,&vxout,&vyout,&vzout);
9939 *v1x = vxout;
9940 *v1y = vyout;
9941 *v1z = vzout;
9942//
9943 PX2 = - PX1;
9944 PY2 = - PY1;
9945 PZ2 = - PZ1;
9946 ETOT_P2 = (ekin_tot - EKIN_P1) + (ain-anew) * AMU;
9947 *v2x = C * PX2 / ETOT_P2;
9948 *v2y = C * PY2 / ETOT_P2;
9949 *v2z = C * PZ2 / ETOT_P2;
9950 lorentz_boost(vxin,vyin,vzin,*v2x,*v2y,*v2z,&vxout,&vyout,&vzout);
9951 *v2x = vxout;
9952 *v2y = vyout;
9953 *v2z = vzout;
9954//
9955 return;
9956}
9957//
9958//**************************************************************************
9959//
9960void G4Abla::lorentz_boost(G4double VXRIN,G4double VYRIN,G4double VZRIN,G4double VXIN,G4double VYIN,G4double VZIN,G4double *VXOUT,G4double *VYOUT,G4double *VZOUT){
9961//
9962// Calculate velocities of a given fragment from frame 1 into frame 2.
9963// Frame 1 is moving with velocity v=(vxr,vyr,vzr) relative to frame 2.
9964// Velocity of the fragment in frame 1 -> vxin,vyin,vzin
9965// Velocity of the fragment in frame 2 -> vxout,vyout,vzout
9966//
9967 G4double VXR,VYR,VZR;
9968 G4double GAMMA,VR,C,CC,DENO,VXNOM,VYNOM,VZNOM;
9969//
9970 C = 29.9792458; // cm/ns
9971 CC = C*C;
9972//
9973// VXR,VYR,VZR are velocities of frame 1 relative to frame 2; to go from 1 to 2
9974// we need to multiply them by -1
9975 VXR = -1.0 * VXRIN;
9976 VYR = -1.0 * VYRIN;
9977 VZR = -1.0 * VZRIN;
9978//
9979 VR = std::sqrt(VXR*VXR + VYR*VYR + VZR*VZR);
9980 if(VR<1e-9){
9981 *VXOUT = VXIN;
9982 *VYOUT = VYIN;
9983 *VZOUT = VZIN;
9984 return;
9985 }
9986 GAMMA = 1.0/std::sqrt(1.0 - VR*VR/CC);
9987 DENO = 1.0 - VXR*VXIN/CC - VYR*VYIN/CC - VZR*VZIN/CC;
9988
9989// X component
9990 VXNOM = -GAMMA*VXR + (1.0+(GAMMA-1.0)*VXR*VXR/(VR*VR))*VXIN + (GAMMA-1.0)*VXR*VYR/(VR*VR)*VYIN + (GAMMA-1.0)*VXR*VZR/(VR*VR)*VZIN;
9991
9992 *VXOUT = VXNOM / (GAMMA * DENO);
9993
9994// Y component
9995 VYNOM = -GAMMA*VYR + (1.0+(GAMMA-1.0)*VYR*VYR/(VR*VR))*VYIN + (GAMMA-1.0)*VXR*VYR/(VR*VR)*VXIN + (GAMMA-1.0)*VYR*VZR/(VR*VR)*VZIN;
9996
9997 *VYOUT = VYNOM / (GAMMA * DENO);
9998
9999// Z component
10000 VZNOM = -GAMMA*VZR + (1.0+(GAMMA-1.0)*VZR*VZR/(VR*VR))*VZIN + (GAMMA-1.0)*VXR*VZR/(VR*VR)*VXIN + (GAMMA-1.0)*VYR*VZR/(VR*VR)*VYIN;
10001
10002 *VZOUT = VZNOM / (GAMMA * DENO);
10003
10004 return;
10005}
10006
10008 G4double *VX1_FISSION_par,G4double *VY1_FISSION_par,G4double *VZ1_FISSION_par,
10009 G4double *VX2_FISSION_par,G4double *VY2_FISSION_par,G4double *VZ2_FISSION_par,
10010 G4int *ZFP1,G4int *AFP1,G4int *SFP1, G4int *ZFP2,G4int *AFP2,G4int *SFP2,G4int *imode_par,
10011 G4double *VX_EVA_SC_par, G4double *VY_EVA_SC_par, G4double *VZ_EVA_SC_par,
10012 G4double EV_TEMP[200][6],G4int *IEV_TAB_FIS_par, G4int *NbLam0_par){
10014 G4double EFF1=0.,EFF2=0.,VFF1=0.,VFF2=0.,
10015 AF1=0.,ZF1=0.,AF2=0.,ZF2=0.,
10016 AFF1=0.,ZFF1=0.,AFF2=0.,ZFF2=0.,
10017 vz1_eva=0., vx1_eva=0.,vy1_eva=0.,
10018 vz2_eva=0., vx2_eva=0.,vy2_eva=0.,
10019 vx_eva_sc=0.,vy_eva_sc=0.,vz_eva_sc=0.,
10020 VXOUT=0.,VYOUT=0.,VZOUT=0.,
10021 VX2OUT=0.,VY2OUT=0.,VZ2OUT=0.;
10022 G4int IEV_TAB_FIS=0,IEV_TAB_TEMP=0;
10023 G4double EV_TEMP1[200][6], EV_TEMP2[200][6],mtota=0.;
10024 G4int inttype = 0,inum=0;
10025 IEV_TAB_SSC=0;
10026 (*imode_par)=0;
10027 G4int NbLam0= (*NbLam0_par);
10028
10029 for(G4int I1=0;I1<200;I1++)
10030 for(G4int I2=0;I2<6;I2++){
10031 EV_TEMP[I1][I2] = 0.0;
10032 EV_TEMP1[I1][I2] = 0.0;
10033 EV_TEMP2[I1][I2] = 0.0;
10034 }
10035
10036 G4double et = EE - JPRF * JPRF * 197. * 197./(2.*0.4*931.*std::pow(AF,5.0/3.0)*1.16*1.16);
10037
10038 fissionDistri(AF,ZF,et,AF1,ZF1,EFF1,VFF1,AF2,ZF2,EFF2,VFF2,
10039 vx_eva_sc,vy_eva_sc,vz_eva_sc,&NbLam0);
10040
10041// Lambda particles
10042 G4int NbLam1=0;
10043 G4int NbLam2=0;
10044 G4double pbH = (AF1 - ZF1) / (AF1 - ZF1 + AF2 - ZF2);
10045 for(G4int i=0;i<NbLam0;i++){
10046 if(G4AblaRandom::flat()<pbH){
10047 NbLam1++;
10048 }else{
10049 NbLam2++;
10050 }
10051 }
10052// Copy of the evaporated particles from saddle to scission
10053 for(G4int IJ = 0; IJ< IEV_TAB_SSC;IJ++){
10054 EV_TEMP[IJ][0] = EV_TAB_SSC[IJ][0];
10055 EV_TEMP[IJ][1] = EV_TAB_SSC[IJ][1];
10056 EV_TEMP[IJ][2] = EV_TAB_SSC[IJ][2];
10057 EV_TEMP[IJ][3] = EV_TAB_SSC[IJ][3];
10058 EV_TEMP[IJ][4] = EV_TAB_SSC[IJ][4];
10059 EV_TEMP[IJ][5] = EV_TAB_SSC[IJ][5];
10060 }
10061 IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_SSC;
10062
10063// Velocities
10064 G4double VZ1_FISSION = (2.0 * G4AblaRandom::flat() - 1.0) * VFF1;
10065 G4double VPERP1 = std::sqrt(VFF1*VFF1 - VZ1_FISSION*VZ1_FISSION);
10066 G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
10067 G4double VX1_FISSION = VPERP1 * std::sin(ALPHA1);
10068 G4double VY1_FISSION = VPERP1 * std::cos(ALPHA1);
10069 G4double VX2_FISSION = - VX1_FISSION / VFF1 * VFF2;
10070 G4double VY2_FISSION = - VY1_FISSION / VFF1 * VFF2;
10071 G4double VZ2_FISSION = - VZ1_FISSION / VFF1 * VFF2;
10072//
10073// Fission fragment 1
10074 if( (ZF1<=0.0) || (AF1<=0.0) || (AF1<ZF1) ){
10075 std::cout << "F1 unphysical: "<<ZF<< " "<<AF<< " "<<EE<< " "<<ZF1<< " "<<AF1 << std::endl;
10076 }else{
10077// fission and IMF emission are not allowed
10078 opt->optimfallowed = 0; // IMF is not allowed
10079 fiss->ifis = 0; // fission is not allowed
10080 gammaemission=1;
10081 G4int FF11=0, FIMF11=0;
10082 G4double ZIMFF1=0., AIMFF1=0.,TKEIMF1=0.,JPRFOUT=0.;
10083//
10084 evapora(ZF1,AF1,&EFF1,0., &ZFF1, &AFF1, &mtota, &vz1_eva, &vx1_eva,&vy1_eva, &FF11, &FIMF11, &ZIMFF1, &AIMFF1,&TKEIMF1, &JPRFOUT, &inttype, &inum,EV_TEMP1,&IEV_TAB_TEMP,&NbLam1);
10085
10086 for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
10087 EV_TEMP[IJ+IEV_TAB_FIS][0] = EV_TEMP1[IJ][0];
10088 EV_TEMP[IJ+IEV_TAB_FIS][1] = EV_TEMP1[IJ][1];
10089// Lorentz kinematics
10090// EV_TEMP(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
10091// EV_TEMP(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
10092// EV_TEMP(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
10093// Lorentz transformation
10094 lorentz_boost(VX1_FISSION,VY1_FISSION,VZ1_FISSION,
10095 EV_TEMP1[IJ][2],EV_TEMP1[IJ][3],EV_TEMP1[IJ][4],
10096 &VXOUT,&VYOUT,&VZOUT);
10097 lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
10098 VXOUT,VYOUT,VZOUT,
10099 &VX2OUT,&VY2OUT,&VZ2OUT);
10100 EV_TEMP[IJ+IEV_TAB_FIS][2] = VX2OUT;
10101 EV_TEMP[IJ+IEV_TAB_FIS][3] = VY2OUT;
10102 EV_TEMP[IJ+IEV_TAB_FIS][4] = VZ2OUT;
10103 //
10104 }
10105 IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_TEMP;
10106
10107 }
10108//
10109// Fission fragment 2
10110 if( (ZF2<=0.0) || (AF2<=0.0) || (AF2<ZF2) ){
10111 std::cout << "F2 unphysical: "<<ZF<< " "<<AF<< " "<<EE<< " "<<ZF2<< " "<<AF2 << std::endl;
10112 }else{
10113// fission and IMF emission are not allowed
10114 opt->optimfallowed = 0; // IMF is not allowed
10115 fiss->ifis = 0; // fission is not allowed
10116 gammaemission=1;
10117 G4int FF22=0, FIMF22=0;
10118 G4double ZIMFF2=0., AIMFF2=0.,TKEIMF2=0.,JPRFOUT=0.;
10119//
10120 evapora(ZF2,AF2,&EFF2,0., &ZFF2, &AFF2, &mtota, &vz2_eva, &vx2_eva,&vy2_eva, &FF22, &FIMF22, &ZIMFF2, &AIMFF2,&TKEIMF2, &JPRFOUT, &inttype, &inum,EV_TEMP2,&IEV_TAB_TEMP,&NbLam2);
10121
10122 for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
10123 EV_TEMP[IJ+IEV_TAB_FIS][0] = EV_TEMP2[IJ][0];
10124 EV_TEMP[IJ+IEV_TAB_FIS][1] = EV_TEMP2[IJ][1];
10125// Lorentz kinematics
10126// EV_TEMP(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
10127// EV_TEMP(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
10128// EV_TEMP(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
10129// Lorentz transformation
10130 lorentz_boost(VX2_FISSION,VY2_FISSION,VZ2_FISSION,
10131 EV_TEMP2[IJ][2],EV_TEMP2[IJ][3],EV_TEMP2[IJ][4],
10132 &VXOUT,&VYOUT,&VZOUT);
10133 lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
10134 VXOUT,VYOUT,VZOUT,
10135 &VX2OUT,&VY2OUT,&VZ2OUT);
10136 EV_TEMP[IJ+IEV_TAB_FIS][2] = VX2OUT;
10137 EV_TEMP[IJ+IEV_TAB_FIS][3] = VY2OUT;
10138 EV_TEMP[IJ+IEV_TAB_FIS][4] = VZ2OUT;
10139 //
10140 }
10141 IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_TEMP;
10142 }
10143//
10144// Lorentz kinematics
10145// vx1_fission = vx1_fission + vx1_eva
10146// vy1_fission = vy1_fission + vy1_eva
10147// vz1_fission = vz1_fission + vz1_eva
10148// vx2_fission = vx2_fission + vx2_eva
10149// vy2_fission = vy2_fission + vy2_eva
10150// vz2_fission = vz2_fission + vz2_eva
10151// The v_eva_sc contribution is considered in the calling subroutine
10152// Lorentz transformations
10153 lorentz_boost(vx1_eva,vy1_eva,vz1_eva,
10154 VX1_FISSION,VY1_FISSION,VZ1_FISSION,
10155 &VXOUT,&VYOUT,&VZOUT);
10156 VX1_FISSION = VXOUT;
10157 VY1_FISSION = VYOUT;
10158 VZ1_FISSION = VZOUT;
10159 lorentz_boost(vx2_eva,vy2_eva,vz2_eva,
10160 VX2_FISSION,VY2_FISSION,VZ2_FISSION,
10161 &VXOUT,&VYOUT,&VZOUT);
10162 VX2_FISSION = VXOUT;
10163 VY2_FISSION = VYOUT;
10164 VZ2_FISSION = VZOUT;
10165//
10166 (*ZFP1) = idnint(ZFF1);
10167 (*AFP1) = idnint(AFF1);
10168 (*SFP1) = NbLam1;
10169 (*VX1_FISSION_par) = VX1_FISSION;
10170 (*VY1_FISSION_par) = VY1_FISSION;
10171 (*VZ1_FISSION_par) = VZ1_FISSION;
10172 (*VX_EVA_SC_par)=vx_eva_sc;
10173 (*VY_EVA_SC_par)=vy_eva_sc;
10174 (*VZ_EVA_SC_par)=vz_eva_sc;
10175 (*ZFP2) = idnint(ZFF2);
10176 (*AFP2) = idnint(AFF2);
10177 (*SFP2) = NbLam2;
10178 (*VX2_FISSION_par) = VX2_FISSION;
10179 (*VY2_FISSION_par) = VY2_FISSION;
10180 (*VZ2_FISSION_par) = VZ2_FISSION;
10181 (*IEV_TAB_FIS_par) = IEV_TAB_FIS;
10182 (*NbLam0_par) = NbLam1 + NbLam2;
10183 if(NbLam0>(NbLam1 + NbLam2))varntp->kfis = 25;
10184 return;
10185}
10186//*************************************************************************
10187//
10189
10190 G4double V_over_V0,R0,RALL,RHAZ,R,TKE,Ekin,V,VPERP,ALPHA1;
10191
10192 V_over_V0 = 6.0;
10193 R0 = 1.16;
10194
10195 if(Z < 1.0){
10196 *VX = 0.0;
10197 *VY = 0.0;
10198 *VZ = 0.0;
10199 return;
10200 }
10201
10202 RALL = R0 * std::pow(V_over_V0,1.0/3.0) * std::pow(AAL,1.0/3.0);
10203 RHAZ = G4double(haz(1));
10204 R = std::pow(RHAZ,1.0/3.0) * RALL;
10205 TKE = 1.44 * Z * ZALL * R*R * (1.0 - A/AAL)*(1.0 - A/AAL) / std::pow(RALL,3.0);
10206
10207 Ekin = TKE * (AAL - A) / AAL;
10208// print*,'!!!',IDNINT(AAl),IDNINT(A),IDNINT(ZALL),IDNINT(Z)
10209 V = std::sqrt(Ekin/A) * 1.3887;
10210 *VZ = (2.0 * G4double(haz(1)) - 1.0) * V;
10211 VPERP = std::sqrt(V*V - (*VZ)*(*VZ));
10212 ALPHA1 = G4double(haz(1)) * 2.0 * 3.142;
10213 *VX = VPERP * std::sin(ALPHA1);
10214 *VY = VPERP * std::cos(ALPHA1);
10215 return;
10216}
10217
10219{
10220 // const G4int pSize = 110;
10221 // static G4ThreadLocal G4double p[pSize];
10222 static G4ThreadLocal G4long ix = 0;
10223 static G4ThreadLocal G4double x = 0.0, y = 0.0;
10224 // k =< -1 on initialise
10225 // k = -1 c'est reproductible
10226 // k < -1 || k > -1 ce n'est pas reproductible
10227/*
10228 // Zero is invalid random seed. Set proper value from our random seed collection:
10229 if(ix == 0) {
10230 // ix = hazard->ial;
10231 }
10232*/
10233 if (k <= -1) { //then
10234 if(k == -1) { //then
10235 ix = 0;
10236 }
10237 else {
10238 x = 0.0;
10239 y = secnds(G4int(x));
10240 ix = G4int(y * 100 + 43543000);
10241 if(mod(ix,2) == 0) {
10242 ix = ix + 1;
10243 }
10244 }}
10245
10246 return G4AblaRandom::flat();
10247}
10248
10249// Random generator according to the
10250// powerfunction y = x**(lambda) in the range from xmin to xmax
10251// xmin, xmax and y are integers.
10252// lambda must be different from -1 !
10254 G4double y,l_plus,rxmin,rxmax;
10255 l_plus = lambda + 1.;
10256 rxmin = G4double(xmin) - 0.5;
10257 rxmax = G4double(xmax) + 0.5;
10258// y=(HAZ(k)*(rxmax**l_plus-rxmin**l_plus)+ rxmin**l_plus)**(1.E0/l_plus)
10259 y=std::pow(G4AblaRandom::flat()*(std::pow(rxmax,l_plus)-std::pow(rxmin,l_plus))+ std::pow(rxmin,l_plus),1.0/l_plus);
10260 return nint(y);
10261}
10262
10263void G4Abla::AMOMENT(G4double AABRA,G4double APRF, G4int IMULTIFR,G4double *PX,G4double *PY,G4double *PZ){
10264
10265 G4int ISIGOPT = 0;
10266 G4double GOLDHA_BU=0.,GOLDHA=0.;
10267 G4double PI = 3.141592653589793;
10268 //nu = 1.d0
10269
10270 // G4double BETAP = sqrt(1.0 - 1.0/sqrt(1.0+EAP/931.494));
10271 // G4double GAMMAP = 1.0 / sqrt(1. - BETAP*BETAP);
10272 // G4double FACT_PROJ = (GAMMAP + 1.) / (BETAP * GAMMAP);
10273
10274 // G4double R = 1.160 * pow(APRF,1.0/3.0);
10275
10276 // G4double RNDT = double(haz(1));
10277 // G4double CTET = 2.0*RNDT-1.0;
10278 // G4double TETA = acos(CTET);
10279 // G4double RNDP = double(haz(1));
10280 // G4double PHI = RNDP*2.0*PI;
10281 // G4double STET = sqrt(1.0-CTET*CTET);
10282// RX = R * STET * DCOS(PHI)
10283// RY = R * STET * DSIN(PHI)
10284// RZ = R * CTET
10285
10286 // G4double RZ = 0.0;
10287 // G4double RY = R * sin(PHI);
10288 // G4double RX = R * cos(PHI);
10289
10290// In MeV/C
10291 G4double V0_over_VBU = 1.0 / 6.0;
10292 G4double SIGMA_0 = 118.50;
10293 G4double Efermi = 5.0 * SIGMA_0 * SIGMA_0 / (2.0 * 931.4940);
10294
10295 if(IMULTIFR==1){
10296 if(ISIGOPT == 0){
10297// "Fermi model" picture:
10298// Influence of expansion:
10299 SIGMA_0 = SIGMA_0 * std::pow(V0_over_VBU,1.0/3.0);
10300// To take into account the influence of thermal motion of nucleons (see W. Bauer,
10301// PRC 51 (1995) 803)
10302// Efermi = 5.D0 * SIGMA_0 * SIGMA_0 / (2.D0 * 931.49D0)
10303
10304 GOLDHA_BU = SIGMA_0 * std::sqrt((APRF*(AABRA-APRF))/(AABRA-1.0));
10305 GOLDHA = GOLDHA_BU*std::sqrt(1.0 +
10306 5.0 * PI*PI / 12.0 * (T_freeze_out / Efermi)*(T_freeze_out / Efermi));
10307// PRINT*,'AFTER BU fermi:',IDNINT(AABRA),IDNINT(APRF),GOLDHA,
10308// & GOLDHA_BU
10309 }else{
10310// Thermal equilibrium picture (<=> to Boltzmann distribution in momentum with sigma2=M*T)
10311// The factor (AABRA-APRF)/AP comes from momentum conservation:
10312 GOLDHA_BU = std::sqrt(APRF * T_freeze_out * 931.494 *
10313 (AABRA - APRF) / AABRA);
10314 GOLDHA = GOLDHA_BU;
10315// PRINT*,'AFTER BU therm:',IDNINT(AABRA),IDNINT(APRF),GOLDHA,
10316// & GOLDHA_BU
10317 }
10318 }else{
10319 GOLDHA = SIGMA_0 * std::sqrt((APRF*(AABRA-APRF))/(AABRA-1.0));
10320 }
10321
10322 G4int IS = 0;
10323 mom123:
10324 *PX = G4double(gausshaz(1,0.0,GOLDHA));
10325 IS = IS +1;
10326 if(IS>100){
10327 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING PX IN Rn07.FOR. A VALUE WILL BE FORCED." << std::endl;
10328 *PX = (AABRA-1.0)*931.4940;
10329 }
10330 if(std::abs(*PX)>= AABRA*931.494){
10331// PRINT*,'VX > C',PX,IDNINT(APRF)
10332 goto mom123;
10333 }
10334 IS = 0;
10335 mom456:
10336 *PY = G4double(gausshaz(1,0.0,GOLDHA));
10337 IS = IS +1;
10338 if(IS>100){
10339 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING PY IN Rn07.FOR. A VALUE WILL BE FORCED." << std::endl;
10340 *PY = (AABRA-1.0)*931.4940;
10341 }
10342 if(std::abs(*PY)>= AABRA*931.494){
10343// PRINT*,'VX > C',PX,IDNINT(APRF)
10344 goto mom456;
10345 }
10346 IS = 0;
10347 mom789:
10348 *PZ = G4double(gausshaz(1,0.0,GOLDHA));
10349 IS = IS +1;
10350 if(IS>100){
10351 std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING PZ IN Rn07.FOR. A VALUE WILL BE FORCED." << std::endl;
10352 *PZ = (AABRA-1.0)*931.4940;
10353 }
10354 if(std::abs(*PZ)>= AABRA*931.494){
10355// PRINT*,'VX > C',PX,IDNINT(APRF)
10356 goto mom789;
10357 }
10358 return;
10359}
10360
10362{
10363 // Gaussian random numbers:
10364
10365 // 1005 C*** TIRAGE ALEATOIRE DANS UNE GAUSSIENNE DE LARGEUR SIG ET MOYENNE XMOY
10366 static G4ThreadLocal G4int iset = 0;
10367 static G4ThreadLocal G4double v1,v2,r,fac,gset,fgausshaz;
10368
10369 if(iset == 0) { //then
10370 do {
10371 v1 = 2.0*haz(k) - 1.0;
10372 v2 = 2.0*haz(k) - 1.0;
10373 r = std::pow(v1,2) + std::pow(v2,2);
10374 } while(r >= 1);
10375
10376 fac = std::sqrt(-2.*std::log(r)/r);
10377 gset = v1*fac;
10378 fgausshaz = v2*fac*sig+xmoy;
10379 iset = 1;
10380 }
10381 else {
10382 fgausshaz=gset*sig+xmoy;
10383 iset=0;
10384 }
10385 return fgausshaz;
10386}
static const G4double e1[44]
static const G4double e2[44]
G4double C(G4double temp)
G4double B(G4double temperature)
G4double D(G4double temp)
G4double Y(G4double density)
static const G4double bp
static const G4double eps
const G4double a0
static const G4int amax[]
static const G4int amin[]
G4fissionEvent * fe
static const G4double alpha
static const G4double fac
static constexpr double m
Definition: G4SIunits.hh:109
static constexpr double pc
Definition: G4SIunits.hh:117
static constexpr double pi
Definition: G4SIunits.hh:55
float G4float
Definition: G4Types.hh:84
double G4double
Definition: G4Types.hh:83
long G4long
Definition: G4Types.hh:87
int G4int
Definition: G4Types.hh:85
const G4int Z[17]
const G4double A[17]
const G4double alpha2
const double C2
G4double getMexp(G4int A, G4int Z)
G4double getPace2(G4int A, G4int Z)
G4double getAlpha(G4int A, G4int Z)
G4double getBeta2(G4int A, G4int Z)
G4double getRms(G4int A, G4int Z)
G4double getVgsld(G4int A, G4int Z)
G4double getBeta4(G4int A, G4int Z)
G4double getEcnz(G4int A, G4int Z)
G4int getMexpID(G4int A, G4int Z)
G4double eflmac(G4int ia, G4int iz, G4int flag, G4int optshp)
Definition: G4Abla.cc:4989
G4Ec2sub * ec2sub
Definition: G4Abla.hh:496
G4double func_trans(G4double TIME, G4double ZF, G4double AF, G4double BET, G4double Y, G4double FT, G4double T_0)
Definition: G4Abla.cc:6509
void part_fiss(G4double BET, G4double GP, G4double GF, G4double Y, G4double TAUF, G4double TS1, G4double TSUM, G4int *CHOICE, G4double ZF, G4double AF, G4double FT, G4double *T_LAPSE, G4double *GF_LOC)
Definition: G4Abla.cc:6606
void initEvapora()
Definition: G4Abla.cc:2133
G4Mexp * masses
Definition: G4Abla.hh:498
G4int IPOWERLIMHAZ(G4double lambda, G4int xmin, G4int xmax)
Definition: G4Abla.cc:10253
G4Ecld * ecld
Definition: G4Abla.hh:497
void imf(G4double ACN, G4double ZCN, G4double TEMP, G4double EE, G4double *ZIMF, G4double *AIMF, G4double *BIMF, G4double *SBIMF, G4double *TIMF, G4double JPRF)
Definition: G4Abla.cc:7031
G4double fvmaxhaz_neut(G4double x)
Definition: G4Abla.cc:7026
G4double tau(G4double bet, G4double homega, G4double ef, G4double t)
Definition: G4Abla.cc:5197
G4double fmaxhaz(G4double T)
Definition: G4Abla.cc:5824
G4double gammp(G4double a, G4double x)
Definition: G4Abla.cc:5714
void isostab_lim(G4int z, G4int *nmin, G4int *nmax)
Definition: G4Abla.cc:7350
void barrs(G4int Z1, G4int A1, G4int Z2, G4int A2, G4double *sBARR, G4double *sOMEGA)
Definition: G4Abla.cc:5345
void even_odd(G4double r_origin, G4double r_even_odd, G4int &i_out)
Definition: G4Abla.cc:8922
G4double BU_TAB[200][12]
Definition: G4Abla.hh:490
G4Opt * opt
Definition: G4Abla.hh:501
G4double DSIGN(G4double a, G4double b)
Definition: G4Abla.cc:6132
G4double fvmaxhaz(G4double T)
Definition: G4Abla.cc:6500
G4Ald * ald
Definition: G4Abla.hh:494
G4double gethyperseparation(G4double A, G4double Z, G4int ny)
Definition: G4Abla.cc:7792
G4double EV_TAB_SSC[200][6]
Definition: G4Abla.hh:490
G4int nint(G4double number)
Definition: G4Abla.cc:6156
G4Eenuc * eenuc
Definition: G4Abla.hh:495
G4double gammln(G4double xx)
Definition: G4Abla.cc:5790
void fomega_gs(G4double AF, G4double ZF, G4double *K1, G4double *sOMEGA, G4double *sHOMEGA)
Definition: G4Abla.cc:5323
G4int ilast
Definition: G4Abla.hh:487
G4double tunnelling(G4double A, G4double ZPRF, G4double Y, G4double EE, G4double EF, G4double TEMP, G4double DENSG, G4double DENSF, G4double ENH_FACT)
Definition: G4Abla.cc:6809
G4int ISIGN(G4int a, G4int b)
Definition: G4Abla.cc:6144
G4double fmaxhaz_old(G4double T)
Definition: G4Abla.cc:5829
void evap_postsaddle(G4double A, G4double Z, G4double E_scission_pre, G4double *E_scission_post, G4double *A_scission, G4double *Z_scission, G4double &vx_eva, G4double &vy_eva, G4double &vz_eva, G4int *NbLam0_par)
Definition: G4Abla.cc:7474
G4double pace2(G4double a, G4double z)
Definition: G4Abla.cc:5890
G4Pace * pace
Definition: G4Abla.hh:493
void mglw(G4double a, G4double z, G4double *el)
Definition: G4Abla.cc:2387
G4double dmin1(G4double a, G4double b, G4double c)
Definition: G4Abla.cc:6248
G4int mod(G4int a, G4int b)
Definition: G4Abla.cc:6200
void SetParameters()
Definition: G4Abla.cc:2320
void unstable_tke(G4double AIN, G4double ZIN, G4double ANEW, G4double ZNEW, G4double VXIN, G4double VYIN, G4double VZIN, G4double *V1X, G4double *V1Y, G4double *V1Z, G4double *V2X, G4double *V2Y, G4double *V2Z)
Definition: G4Abla.cc:9880
void parite(G4double n, G4double *par)
Definition: G4Abla.cc:5172
G4Abla(G4Volant *aVolant, G4VarNtp *aVarntp)
Definition: G4Abla.cc:44
G4double fissility(G4int a, G4int z, G4int ny, G4double sn, G4double slam, G4int optxfis)
Definition: G4Abla.cc:2511
void unbound(G4double SN, G4double SP, G4double SD, G4double ST, G4double SHE, G4double SA, G4double BP, G4double BD, G4double BT, G4double BHE, G4double BA, G4double *PROBF, G4double *PROBN, G4double *PROBP, G4double *PROBD, G4double *PROBT, G4double *PROBHE, G4double *PROBA, G4double *PROBIMF, G4double *PROBG, G4double *ECN, G4double *ECP, G4double *ECD, G4double *ECT, G4double *ECHE, G4double *ECA)
Definition: G4Abla.cc:7884
G4double cram(G4double bet, G4double homega)
Definition: G4Abla.cc:5225
void AMOMENT(G4double AABRA, G4double APRF, G4int IMULTIFR, G4double *PX, G4double *PY, G4double *PZ)
Definition: G4Abla.cc:10263
G4double T_freeze_out
Definition: G4Abla.hh:492
void unstable_nuclei(G4int AFP, G4int ZFP, G4int *AFPNEW, G4int *ZFPNEW, G4int &IOUNSTABLE, G4double VX, G4double VY, G4double VZ, G4double *VP1X, G4double *VP1Y, G4double *VP1Z, G4double BU_TAB_TEMP[200][6], G4int *ILOOP)
Definition: G4Abla.cc:9194
void tke_bu(G4double Z, G4double A, G4double ZALL, G4double AAL, G4double *VX, G4double *VY, G4double *VZ)
Definition: G4Abla.cc:10188
G4double haz(G4int k)
Definition: G4Abla.cc:10218
void mglms(G4double a, G4double z, G4int refopt4, G4double *el)
Definition: G4Abla.cc:2414
G4double f(G4double E)
Definition: G4Abla.cc:5818
void barfit(G4int iz, G4int ia, G4int il, G4double *sbfis, G4double *segs, G4double *selmax)
Definition: G4Abla.cc:5388
G4double dint(G4double a)
Definition: G4Abla.cc:6210
G4double umass(G4double z, G4double n, G4double beta)
Definition: G4Abla.cc:8982
G4int IEV_TAB_SSC
Definition: G4Abla.hh:489
G4int idnint(G4double value)
Definition: G4Abla.cc:6240
void appariem(G4double a, G4double z, G4double *del)
Definition: G4Abla.cc:5142
void gser(G4double *gamser, G4double a, G4double x, G4double gln)
Definition: G4Abla.cc:5762
G4double spdef(G4int a, G4int z, G4int optxfis)
Definition: G4Abla.cc:2469
void qrot(G4double z, G4double a, G4double bet, G4double sig, G4double u, G4double *qr)
Definition: G4Abla.cc:4893
G4double utilabs(G4double a)
Definition: G4Abla.cc:6262
void direct(G4double zprf, G4double a, G4double ee, G4double jprf, G4double *probp_par, G4double *probd_par, G4double *probt_par, G4double *probn_par, G4double *probhe_par, G4double *proba_par, G4double *probg_par, G4double *probimf_par, G4double *probf_par, G4double *problamb0_par, G4double *ptotl_par, G4double *sn_par, G4double *sbp_par, G4double *sbd_par, G4double *sbt_par, G4double *sbhe_par, G4double *sba_par, G4double *slamb0_par, G4double *ecn_par, G4double *ecp_par, G4double *ecd_par, G4double *ect_par, G4double *eche_par, G4double *eca_par, G4double *ecg_par, G4double *eclamb0_par, G4double *bp_par, G4double *bd_par, G4double *bt_par, G4double *bhe_par, G4double *ba_par, G4double *sp_par, G4double *sd_par, G4double *st_par, G4double *she_par, G4double *sa_par, G4double *ef_par, G4double *ts1_par, G4int, G4int inum, G4int itest, G4int *sortie, G4double *tcn, G4double *jprfn_par, G4double *jprfp_par, G4double *jprfd_par, G4double *jprft_par, G4double *jprfhe_par, G4double *jprfa_par, G4double *jprflamb0_par, G4double *tsum_par, G4int NbLam0)
Definition: G4Abla.cc:3107
void lpoly(G4double x, G4int n, G4double pl[])
Definition: G4Abla.cc:4972
void fission_width(G4double ZPRF, G4double A, G4double EE, G4double BS, G4double BK, G4double EF, G4double Y, G4double *GF, G4double *TEMP, G4double JPR, G4int IEROT, G4int FF_ALLOWED, G4int OPTCOL, G4int OPTSHP, G4double DENSG)
Definition: G4Abla.cc:6879
G4int gammaemission
Definition: G4Abla.hh:491
G4Fiss * fiss
Definition: G4Abla.hh:500
G4double Uwash(G4double E, G4double Ecrit, G4double Freduction, G4double gamma)
Definition: G4Abla.cc:9040
G4int Ainit
Definition: G4Abla.hh:504
G4int max(G4int a, G4int b)
Definition: G4Abla.cc:6122
G4int min(G4int a, G4int b)
Definition: G4Abla.cc:6102
void fissionDistri(G4double &a, G4double &z, G4double &e, G4double &a1, G4double &z1, G4double &e1, G4double &v1, G4double &a2, G4double &z2, G4double &e2, G4double &v2, G4double &vx_eva_sc, G4double &vy_eva_sc, G4double &vz_eva_sc, G4int *NbLam0_par)
Definition: G4Abla.cc:8004
G4double width(G4double AMOTHER, G4double ZMOTHER, G4double APART, G4double ZPART, G4double TEMP, G4double B1, G4double SB1, G4double EXC)
Definition: G4Abla.cc:6268
G4VarNtp * varntp
Definition: G4Abla.hh:503
~G4Abla()
Definition: G4Abla.cc:82
G4double gethyperbinding(G4double A, G4double Z, G4int ny)
Definition: G4Abla.cc:7860
G4int Sinit
Definition: G4Abla.hh:504
void guet(G4double *x_par, G4double *z_par, G4double *find_par)
Definition: G4Abla.cc:5928
G4double eflmac_profi(G4double a, G4double z)
Definition: G4Abla.cc:9086
G4double pen(G4double A, G4double ap, G4double omega, G4double T)
Definition: G4Abla.cc:6454
G4int verboseLevel
Definition: G4Abla.hh:486
G4double ecoul(G4double z1, G4double n1, G4double beta1, G4double z2, G4double n2, G4double beta2, G4double d)
Definition: G4Abla.cc:9012
G4double gausshaz(G4int k, G4double xmoy, G4double sig)
Definition: G4Abla.cc:10361
G4Fb * fb
Definition: G4Abla.hh:499
G4double bipol(G4int iflag, G4double y)
Definition: G4Abla.cc:5242
void DeexcitationAblaxx(G4int nucleusA, G4int nucleusZ, G4double excitationEnergy, G4double angularMomentum, G4double momX, G4double momY, G4double momZ, G4int eventnumber)
Definition: G4Abla.cc:96
void densniv(G4double a, G4double z, G4double ee, G4double ef, G4double *dens, G4double bshell, G4double bs, G4double bk, G4double *temp, G4int optshp, G4int optcol, G4double defbet, G4double *ecor, G4double jprf, G4int ifis, G4double *qr)
Definition: G4Abla.cc:4471
G4double T_freeze_out_in
Definition: G4Abla.hh:488
void fomega_sp(G4double AF, G4double Y, G4double *MFCD, G4double *sOMEGA, G4double *sHOMEGA)
Definition: G4Abla.cc:5297
G4int secnds(G4int x)
Definition: G4Abla.cc:6184
void evapora(G4double zprf, G4double aprf, G4double *ee_par, G4double jprf, G4double *zf_par, G4double *af_par, G4double *mtota_par, G4double *vleva_par, G4double *vxeva_par, G4double *vyeva_par, G4int *ff_par, G4int *fimf_par, G4double *fzimf, G4double *faimf, G4double *tkeimf_par, G4double *jprfout, G4int *inttype_par, G4int *inum_par, G4double EV_TEMP[200][6], G4int *iev_tab_temp_par, G4int *nblam0)
Definition: G4Abla.cc:2566
G4int Zinit
Definition: G4Abla.hh:504
G4double getdeltabinding(G4double a, G4int nblamb)
Definition: G4Abla.cc:7786
void FillData(G4int IMULTBU, G4int IEV_TAB)
Definition: G4Abla.cc:5999
G4int idint(G4double a)
Definition: G4Abla.cc:6229
G4Volant * volant
Definition: G4Abla.hh:502
G4double EV_TAB[200][6]
Definition: G4Abla.hh:490
void SetParametersG4(G4int z, G4int a)
Definition: G4Abla.cc:2300
void bsbkbc(G4double A, G4double Z, G4double *BS, G4double *BK, G4double *BC)
Definition: G4Abla.cc:6479
void fission(G4double AF, G4double ZF, G4double EE, G4double JPRF, G4double *VX1_FISSION, G4double *VY1_FISSION, G4double *VZ1_FISSION, G4double *VX2_FISSION, G4double *VY2_FISSION, G4double *VZ2_FISSION, G4int *ZFP1, G4int *AFP1, G4int *SFP1, G4int *ZFP2, G4int *AFP2, G4int *SFP2, G4int *imode, G4double *VX_EVA_SC, G4double *VY_EVA_SC, G4double *VZ_EVA_SC, G4double EV_TEMP[200][6], G4int *IEV_TAB_FIS, G4int *NbLam0)
Definition: G4Abla.cc:10007
G4double erf(G4double x)
Definition: G4Abla.cc:5702
void gcf(G4double *gammcf, G4double a, G4double x, G4double gln)
Definition: G4Abla.cc:5730
G4double fd(G4double E)
Definition: G4Abla.cc:5811
void lorentz_boost(G4double VXRIN, G4double VYRIN, G4double VZRIN, G4double VXIN, G4double VYIN, G4double VZIN, G4double *VXOUT, G4double *VYOUT, G4double *VZOUT)
Definition: G4Abla.cc:9960
void lorb(G4double AMOTHER, G4double ADAUGHTER, G4double LMOTHER, G4double EEFINAL, G4double *LORBITAL, G4double *SIGMA_LORBITAL)
Definition: G4Abla.cc:6987
void setVerboseLevel(G4int level)
Definition: G4Abla.cc:77
G4double frldm(G4double z, G4double n, G4double beta)
Definition: G4Abla.cc:9055
G4double as
G4double optafan
G4double av
G4double ak
G4double ecnz[EC2SUBROWS][EC2SUBCOLS]
G4double vgsld[ECLDROWS][ECLDCOLS]
G4double ecfnz[ECLDROWS][ECLDCOLS]
G4double alpha[ECLDROWS][ECLDCOLS]
G4double ecgnz[ECLDROWS][ECLDCOLS]
G4double rms[ECLDROWS][ECLDCOLS]
G4double beta2[ECLDROWSbeta][ECLDCOLSbeta]
G4double beta4[ECLDROWSbeta][ECLDCOLSbeta]
G4double efa[FBCOLS][FBROWS]
G4double ucr
G4int optxfis
G4int optcol
G4int optshp
G4double dcr
G4double bet
G4int optct
G4double ifis
G4double bind[MASSIZEROWS][MASSIZECOLS]
G4double massexp[MASSIZEROWS][MASSIZECOLS]
G4int mexpiop[MASSIZEROWS][MASSIZECOLS]
G4int optcha
G4int optimfallowed
G4int optemd
G4int nblan0
G4int optshpimf
G4double dm[PACESIZEROWS][PACESIZECOLS]
void clear()
G4double enerj[VARNTPSIZE]
G4double pylab[VARNTPSIZE]
G4int svv[VARNTPSIZE]
G4int avv[VARNTPSIZE]
G4double pzlab[VARNTPSIZE]
G4int itypcasc[VARNTPSIZE]
G4int zvv[VARNTPSIZE]
G4double pxlab[VARNTPSIZE]
void clear()
struct config_s config
@ TIME
Definition: inflate.h:23
double flat()
Definition: G4AblaRandom.cc:48
static const G4double Z1[5]
Definition: paraMaker.cc:41
#define G4ThreadLocal
Definition: tls.hh:77
#define V1(a, b, c)
#define V2(a, b, c)