ECCE @ EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
G4Abla.cc
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file G4Abla.cc
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
44 G4Abla::G4Abla(G4Volant *aVolant, G4VarNtp *aVarntp)
45 #else
46 G4Abla::G4Abla(G4INCL::Config *config, G4Volant *aVolant, G4VarNtp *aVarntp)
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 
77 void G4Abla::setVerboseLevel(G4int level)
78 {
79  verboseLevel = level;
80 }
81 
82 G4Abla::~G4Abla()
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
96 void 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
102 void 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;
132  opt->optimfallowed=1;
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;
159  gammaemission=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 /*
236 C Set maximum temperature for sequential decay (evaporation)
237 C Remove additional energy by simultaneous break up
238 C (vaporisation or multi-fragmentation)
239 
240 C Idea: If the temperature of the projectile spectator exceeds
241 c the limiting temperature T_freeze_out, the additional
242 C energy which is present in the spectator is used for
243 C a stage of simultaneous break up. It is either the
244 C simultaneous emission of a gaseous phase or the simultaneous
245 C emission of several intermediate-mass fragments. Only one
246 C piece of the projectile spectator (assumed to be the largest
247 C one) is kept track.
248 
249 C MVR, KHS, October 2001
250 C KHS, AK 2007 - Masses from the power low; slope parameter dependent on
251 C energy per nucleon; symmtery-energy coeff. dependent on
252 C energy per nucleon.
253 
254 c Clear BU_TAB (array of multifragmentation products)
255 */
256  if(T_freeze_out_in >= 0.0){
257  T_freeze_out = T_freeze_out_in;
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;
1022  G4double ran = G4AblaRandom::flat();
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 
1321 
1322  if(IMULTBU>200)std::cout << "IMULTBU>200 " << IMULTBU << std::endl;
1323  }// if(T_diff>0.1)
1324 // End of multi-fragmentation
1325  mult7777:
1326 
1327  // std::cout << "hola 100" << std::endl;
1328 
1329 // Start basic de-excitation of fragments
1330  aprfp = idnint(aprf);
1331  zprfp = idnint(zprf);
1332 
1333  if(IMULTIFR == 0){
1334 // These momenta are in the frame of the projectile (or target in case of direct kinematics)
1335  VX_PREF = VX_incl;
1336  VY_PREF = VY_incl;
1337  VZ_PREF = VZ_incl;
1338  }
1339 // Lambdas after multi-fragmentation
1340  if(IMULTIFR == 1){
1341  NbLam0 = NbLamprf;
1342  }
1343 //
1344 // CALL THE EVAPORATION SUBROUTINE
1345 //
1346  opt->optimfallowed = 1; // IMF is allowed
1347  fiss->ifis = 1; // fission is allowed
1348  fimf=0;
1349  ff=0;
1350 
1351 // To spare computing time; these events in any case cannot decay
1352 // IF(ZPRFP.LE.2.AND.ZPRFP.LT.APRFP)THEN FIXME: <= or <
1353  if(zprfp<=2 && zprfp<aprfp){
1354  zf = zprf;
1355  af = aprf;
1356  ee = 0.0;
1357  ff = 0;
1358  fimf = 0;
1359  ftype = 0;
1360  aimf = 0.0;
1361  zimf = 0.0;
1362  tkeimf = 0.0;
1363  vx_eva = 0.0;
1364  vy_eva = 0.0;
1365  vz_eva = 0.0;
1366  jprf0 = jprf;
1367  goto a1972;
1368  }
1369 
1370 // if(ZPRFP.LE.2.AND.ZPRFP.EQ.APRFP)
1371  if(zprfp<=2 && zprfp==aprfp){
1372  unstable_nuclei(aprfp,zprfp,&afpnew,&zfpnew,IOUNSTABLE,
1373  VX_PREF, VY_PREF, VZ_PREF,
1374  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1375  af = G4double(afpnew);
1376  zf = G4double(zfpnew);
1377  VX_PREF = VP1X;
1378  VY_PREF = VP1Y;
1379  VZ_PREF = VP1Z;
1380  for(G4int I = 0;I<ILOOP;I++){
1381  for(G4int IJ = 0; IJ<6; IJ++)
1382  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1383  }
1384  IEV_TAB = IEV_TAB + ILOOP;
1385  ee = 0.0;
1386  ff = 0;
1387  fimf = 0;
1388  ftype = 0;
1389  aimf = 0.0;
1390  zimf = 0.0;
1391  tkeimf = 0.0;
1392  vx_eva = 0.0;
1393  vy_eva = 0.0;
1394  vz_eva = 0.0;
1395  jprf0 = jprf;
1396  goto a1972;
1397  }
1398 
1399 // IF(ZPRFP.EQ.APRFP)THEN
1400  if(zprfp==aprfp){
1401  unstable_nuclei(aprfp,zprfp,&afpnew,&zfpnew,IOUNSTABLE,
1402  VX_PREF, VY_PREF, VZ_PREF,
1403  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1404  af = G4double(afpnew);
1405  zf = G4double(zfpnew);
1406  VX_PREF = VP1X;
1407  VY_PREF = VP1Y;
1408  VZ_PREF = VP1Z;
1409  for(G4int I = 0;I<ILOOP;I++){
1410  for(G4int IJ = 0; IJ<6; IJ++)
1411  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1412  }
1413  IEV_TAB = IEV_TAB + ILOOP;
1414  ee = 0.0;
1415  ff = 0;
1416  fimf = 0;
1417  ftype = 0;
1418  aimf = 0.0;
1419  zimf = 0.0;
1420  tkeimf = 0.0;
1421  vx_eva = 0.0;
1422  vy_eva = 0.0;
1423  vz_eva = 0.0;
1424  jprf0 = jprf;
1425  goto a1972;
1426  }
1427 //
1428  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);
1429 //
1430  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1431  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1432  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1433  EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1434 //
1435 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1436 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1437 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1438 // Lorentz transformation
1439  lorentz_boost(VX_PREF,VY_PREF,VZ_PREF,
1440  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1441  &VXOUT,&VYOUT,&VZOUT);
1442  EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1443  EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1444  EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1445  }
1446  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1447 
1448  a1972:
1449 
1450 // vi_pref - velocity of the prefragment; vi_eva - recoil due to evaporation
1451  lorentz_boost(VX_PREF,VY_PREF,VZ_PREF,
1452  vx_eva,vy_eva,vz_eva,
1453  &VXOUT,&VYOUT,&VZOUT);
1454  V_CM[0] = VXOUT;
1455  V_CM[1] = VYOUT;
1456  V_CM[2] = VZOUT;
1457 //
1458  if(ff == 0 && fimf == 0){
1459 // Evaporation of neutrons and LCP; no IMF, no fission
1460  ftype = 0;
1461  ZFP1 = idnint(zf);
1462  AFP1 = idnint(af);
1463  SFP1 = NbLam0;
1464  AFPIMF = 0;
1465  ZFPIMF = 0;
1466  SFPIMF = 0;
1467  ZFP2 = 0;
1468  AFP2 = 0;
1469  SFP2 = 0;
1470  VFP1_CM[0] = V_CM[0];
1471  VFP1_CM[1] = V_CM[1];
1472  VFP1_CM[2] = V_CM[2];
1473  for(G4int j=0;j<3;j++){
1474  VIMF_CM[j] = 0.0;
1475  VFP2_CM[j] = 0.0;
1476  }
1477  }
1478 //
1479  if(ff == 1 && fimf == 0) ftype = 1; // fission
1480  if(ff == 0 && fimf == 1) ftype = 2; // IMF emission
1481 //
1482 // AFP,ZFP IS THE FINAL FRAGMENT IF NO FISSION OR IMF EMISSION OCCURS
1483 // IN CASE OF FISSION IT IS THE NUCLEUS THAT UNDERGOES FISSION OR IMF
1484 //
1485 
1486 //***************** FISSION ***************************************
1487 //
1488  if(ftype == 1){
1489  varntp->kfis = 1;
1490  if(NbLam0>0)varntp->kfis = 20;
1491  // ftype1=0;
1492 
1493  G4int IEV_TAB_FIS = 0,imode=0;
1494 
1495  G4double vx1_fission=0.,vy1_fission=0.,vz1_fission=0.;
1496  G4double vx2_fission=0.,vy2_fission=0.,vz2_fission=0.;
1497  G4double vx_eva_sc=0.,vy_eva_sc=0.,vz_eva_sc=0.;
1498 
1499  fission(af,zf,ee,jprf0,
1500  &vx1_fission,&vy1_fission,&vz1_fission,
1501  &vx2_fission,&vy2_fission,&vz2_fission,
1502  &ZFP1,&AFP1,&SFP1,&ZFP2,&AFP2,&SFP2,&imode,
1503  &vx_eva_sc,&vy_eva_sc,&vz_eva_sc,EV_TEMP,&IEV_TAB_FIS,&NbLam0);
1504 
1505  for(G4int IJ = 0; IJ< IEV_TAB_FIS;IJ++){
1506  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1507  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1508  EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1509 // Lorentz kinematics
1510 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1511 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1512 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1513 // Lorentz transformation
1514  lorentz_boost(V_CM[0],V_CM[1],V_CM[2],
1515  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1516  &VXOUT,&VYOUT,&VZOUT);
1517  EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1518  EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1519  EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1520  }
1521  IEV_TAB = IEV_TAB + IEV_TAB_FIS;
1522 
1523  // if(imode==1) ftype1 = 1; // S1 mode
1524  // if(imode==2) ftype1 = 2; // S2 mode
1525 
1526  AFPIMF = 0;
1527  ZFPIMF = 0;
1528  SFPIMF = 0;
1529 
1530 // VX_EVA_SC,VY_EVA_SC,VZ_EVA_SC - recoil due to particle emisison
1531 // between saddle and scission
1532 // Lorentz kinematics
1533 // VFP1_CM(1) = V_CM(1) + VX1_FISSION + VX_EVA_SC ! Velocity of FF1 in x
1534 // VFP1_CM(2) = V_CM(2) + VY1_FISSION + VY_EVA_SC ! Velocity of FF1 in y
1535 // VFP1_CM(3) = V_CM(3) + VZ1_FISSION + VZ_EVA_SC ! Velocity of FF1 in x
1536  lorentz_boost(vx1_fission,vy1_fission,vz1_fission,
1537  V_CM[0],V_CM[1],V_CM[2],
1538  &VXOUT,&VYOUT,&VZOUT);
1539  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1540  VXOUT,VYOUT,VZOUT,
1541  &VX2OUT,&VY2OUT,&VZ2OUT);
1542  VFP1_CM[0] = VX2OUT;
1543  VFP1_CM[1] = VY2OUT;
1544  VFP1_CM[2] = VZ2OUT;
1545 
1546 // Lorentz kinematics
1547 // VFP2_CM(1) = V_CM(1) + VX2_FISSION + VX_EVA_SC ! Velocity of FF2 in x
1548 // VFP2_CM(2) = V_CM(2) + VY2_FISSION + VY_EVA_SC ! Velocity of FF2 in y
1549 // VFP2_CM(3) = V_CM(3) + VZ2_FISSION + VZ_EVA_SC ! Velocity of FF2 in x
1550  lorentz_boost(vx2_fission,vy2_fission,vz2_fission,
1551  V_CM[0],V_CM[1],V_CM[2],
1552  &VXOUT,&VYOUT,&VZOUT);
1553  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1554  VXOUT,VYOUT,VZOUT,
1555  &VX2OUT,&VY2OUT,&VZ2OUT);
1556  VFP2_CM[0] = VX2OUT;
1557  VFP2_CM[1] = VY2OUT;
1558  VFP2_CM[2] = VZ2OUT;
1559 
1560 //************** IMF EMISSION ************************************************
1561 //
1562  }else if(ftype == 2){
1563 // IMF emission: Heavy partner is allowed to fission and to emitt IMF, but ONLY once.
1564  G4int FF11 = 0;
1565  G4int FIMF11 = 0;
1566  opt->optimfallowed = 1; // IMF is allowed
1567  fiss->ifis = 1; // fission is allowed
1568 // Lambda particles
1569  G4int NbLamH=0;
1570  G4int NbLamimf=0;
1571  G4double pbH = (af-zf) / (af-zf+aimf-zimf);
1572  //double pbL = aimf / (af+aimf);
1573  for(G4int i=0;i<NbLam0;i++){
1574  if(G4AblaRandom::flat()<pbH){
1575  NbLamH++;
1576  }else{
1577  NbLamimf++;
1578  }
1579  }
1580 //
1581 // Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
1582  G4double EkinR1 = tkeimf * aimf / (af+aimf);
1583  G4double EkinR2 = tkeimf * af / (af+aimf);
1584  G4double V1 = std::sqrt(EkinR1/af) * 1.3887;
1585  G4double V2 = std::sqrt(EkinR2/aimf) * 1.3887;
1586  G4double VZ1_IMF = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
1587  G4double VPERP1 = std::sqrt(V1*V1 - VZ1_IMF*VZ1_IMF);
1588  G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
1589  G4double VX1_IMF = VPERP1 * std::sin(ALPHA1);
1590  G4double VY1_IMF = VPERP1 * std::cos(ALPHA1);
1591  G4double VX2_IMF = - VX1_IMF / V1 * V2;
1592  G4double VY2_IMF = - VY1_IMF / V1 * V2;
1593  G4double VZ2_IMF = - VZ1_IMF / V1 * V2;
1594 
1595  G4double EEIMFP = ee * af /(af + aimf);
1596  G4double EEIMF = ee * aimf /(af + aimf);
1597 
1598 // Decay of heavy partner
1599  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.));
1600 
1601  G4double JPRFHEAVY = jprf0 * 0.4 * 931.49 * 1.16*1.16 * std::pow(af,5.0/3.0) / IINERTTOT;
1602  G4double JPRFLIGHT = jprf0 * 0.4 * 931.49 * 1.16*1.16 * std::pow(aimf,5.0/3.0) / IINERTTOT;
1603  if(af<2.0) std::cout << "RN117-4,AF,ZF,EE,JPRFheavy" << std::endl;
1604 
1605  G4double vx1ev_imf=0., vy1ev_imf=0., vz1ev_imf=0., zdummy=0., adummy=0., tkedummy=0.,jprf1=0.;
1606 
1607  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);
1608 
1609  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1610  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1611  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1612  EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1613 //
1614 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1615 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1616 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1617 // Lorentz transformation
1618  lorentz_boost(V_CM[0],V_CM[1],V_CM[2],
1619  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1620  &VXOUT,&VYOUT,&VZOUT);
1621  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1622  VXOUT,VYOUT,VZOUT,
1623  &VX2OUT,&VY2OUT,&VZ2OUT);
1624  EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1625  EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1626  EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1627  }
1628  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1629 
1630 // For IMF - fission and IMF emission are not allowed
1631  G4int FF22 = 0;
1632  G4int FIMF22 = 0;
1633  opt->optimfallowed = 0; // IMF is not allowed
1634  fiss->ifis = 0; // fission is not allowed
1635 
1636 // Decay of IMF
1637  G4double zffimf, affimf,zdummy1=0., adummy1=0., tkedummy1=0.,jprf2,vx2ev_imf,vy2ev_imf,
1638  vz2ev_imf;
1639 
1640  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);
1641 
1642  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1643  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1644  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1645  EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1646 //
1647 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1648 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1649 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1650 // Lorentz transformation
1651  lorentz_boost(V_CM[0],V_CM[1],V_CM[2],
1652  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1653  &VXOUT,&VYOUT,&VZOUT);
1654  lorentz_boost(VX2_IMF,VY2_IMF,VZ2_IMF,
1655  VXOUT,VYOUT,VZOUT,
1656  &VX2OUT,&VY2OUT,&VZ2OUT);
1657  EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1658  EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1659  EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1660  }
1661  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1662 // As IMF is not allowed to emit IMF, adummy1=zdummy1=0
1663 
1664  AFPIMF = idnint(affimf);
1665  ZFPIMF = idnint(zffimf);
1666  SFPIMF = NbLamimf;
1667 
1668 // vi1_imf, vi2_imf - velocities of imf and partner from TKE;
1669 // vi1ev_imf, vi2_imf - recoil of partner and imf due to evaporation
1670 // Lorentz kinematics - DM 18/5/2010
1671 // VIMF_CM(1) = V_CM(1) + VX2_IMF + VX2EV_IMF
1672 // VIMF_CM(2) = V_CM(2) + VY2_IMF + VY2EV_IMF
1673 // VIMF_CM(3) = V_CM(3) + VZ2_IMF + VZ2EV_IMF
1674  lorentz_boost(VX2_IMF,VY2_IMF,VZ2_IMF,
1675  V_CM[0],V_CM[1],V_CM[2],
1676  &VXOUT,&VYOUT,&VZOUT);
1677  lorentz_boost(vx2ev_imf,vy2ev_imf,vz2ev_imf,
1678  VXOUT,VYOUT,VZOUT,
1679  &VX2OUT,&VY2OUT,&VZ2OUT);
1680  VIMF_CM[0] = VX2OUT;
1681  VIMF_CM[1] = VY2OUT;
1682  VIMF_CM[2] = VZ2OUT;
1683 // Lorentz kinematics
1684 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
1685 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
1686 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
1687  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1688  V_CM[0],V_CM[1],V_CM[2],
1689  &VXOUT,&VYOUT,&VZOUT);
1690  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1691  VXOUT,VYOUT,VZOUT,
1692  &VX2OUT,&VY2OUT,&VZ2OUT);
1693  VFP1_CM[0] = VX2OUT;
1694  VFP1_CM[1] = VY2OUT;
1695  VFP1_CM[2] = VZ2OUT;
1696 
1697  if(FF11==0 && FIMF11==0){
1698 // heavy partner deexcites by emission of light particles
1699  AFP1 = idnint(aff);
1700  ZFP1 = idnint(zff);
1701  SFP1 = NbLamH;
1702  ZFP2 = 0;
1703  AFP2 = 0;
1704  SFP2 = 0;
1705  ftype = 2;
1706  AFPIMF = idnint(affimf);
1707  ZFPIMF = idnint(zffimf);
1708  SFPIMF = NbLamimf;
1709  for(G4int I=0;I<3;I++)
1710  VFP2_CM[I] = 0.0;
1711 
1712 
1713  } else if(FF11==1 && FIMF11==0){
1714 // Heavy partner fissions
1715  varntp->kfis = 1;
1716  if(NbLam0>0)varntp->kfis = 20;
1717 //
1718  opt->optimfallowed = 0; // IMF is not allowed
1719  fiss->ifis = 0; // fission is not allowed
1720 //
1721  zf = zff;
1722  af = aff;
1723  ee = EEIMFP;
1724  // ftype1=0;
1725  ftype=21;
1726 
1727  G4int IEV_TAB_FIS = 0,imode=0;
1728 
1729  G4double vx1_fission=0.,vy1_fission=0.,vz1_fission=0.;
1730  G4double vx2_fission=0.,vy2_fission=0.,vz2_fission=0.;
1731  G4double vx_eva_sc=0.,vy_eva_sc=0.,vz_eva_sc=0.;
1732 
1733  fission(af,zf,ee,jprf1,
1734  &vx1_fission,&vy1_fission,&vz1_fission,
1735  &vx2_fission,&vy2_fission,&vz2_fission,
1736  &ZFP1,&AFP1,&SFP1,&ZFP2,&AFP2,&SFP2,&imode,
1737  &vx_eva_sc,&vy_eva_sc,&vz_eva_sc,EV_TEMP,&IEV_TAB_FIS,&NbLamH);
1738 
1739  for(int IJ = 0; IJ< IEV_TAB_FIS;IJ++){
1740  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1741  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1742  EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1743 // Lorentz kinematics
1744 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1745 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1746 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1747 // Lorentz transformation
1748  lorentz_boost(VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1749  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1750  &VXOUT,&VYOUT,&VZOUT);
1751  EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1752  EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1753  EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1754  }
1755  IEV_TAB = IEV_TAB + IEV_TAB_FIS;
1756 
1757  // if(imode==1) ftype1 = 1; // S1 mode
1758  // if(imode==2) ftype1 = 2; // S2 mode
1759 
1760 // Lorentz kinematics
1761 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF + VX1_FISSION +
1762 // & VX_EVA_SC ! Velocity of FF1 in x
1763 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF + VY1_FISSION +
1764 // & VY_EVA_SC ! Velocity of FF1 in y
1765 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF + VZ1_FISSION +
1766 // & VZ_EVA_SC ! Velocity of FF1 in x
1767  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1768  V_CM[0],V_CM[1],V_CM[2],
1769  &VXOUT,&VYOUT,&VZOUT);
1770  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1771  VXOUT,VYOUT,VZOUT,
1772  &VX2OUT,&VY2OUT,&VZ2OUT);
1773  lorentz_boost(vx1_fission,vy1_fission,vz1_fission,
1774  VX2OUT,VY2OUT,VZ2OUT,
1775  &VXOUT,&VYOUT,&VZOUT);
1776  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1777  VXOUT,VYOUT,VZOUT,
1778  &VX2OUT,&VY2OUT,&VZ2OUT);
1779  VFP1_CM[0] = VX2OUT;
1780  VFP1_CM[1] = VY2OUT;
1781  VFP1_CM[2] = VZ2OUT;
1782 
1783 // Lorentz kinematics
1784 // VFP2_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF + VX2_FISSION +
1785 // & VX_EVA_SC ! Velocity of FF2 in x
1786 // VFP2_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF + VY2_FISSION +
1787 // & VY_EVA_SC ! Velocity of FF2 in y
1788 // VFP2_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF + VZ2_FISSION +
1789 // & VZ_EVA_SC ! Velocity of FF2 in x
1790  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1791  V_CM[0],V_CM[1],V_CM[2],
1792  &VXOUT,&VYOUT,&VZOUT);
1793  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1794  VXOUT,VYOUT,VZOUT,
1795  &VX2OUT,&VY2OUT,&VZ2OUT);
1796  lorentz_boost(vx2_fission,vy2_fission,vz2_fission,
1797  VX2OUT,VY2OUT,VZ2OUT,
1798  &VXOUT,&VYOUT,&VZOUT);
1799  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1800  VXOUT,VYOUT,VZOUT,
1801  &VX2OUT,&VY2OUT,&VZ2OUT);
1802  VFP2_CM[0] = VX2OUT;
1803  VFP2_CM[1] = VY2OUT;
1804  VFP2_CM[2] = VZ2OUT;
1805 
1806  } else if(FF11==0 && FIMF11==1){
1807 // Heavy partner emits imf, consequtive imf emission or fission is not allowed
1808  opt->optimfallowed = 0; // IMF is not allowed
1809  fiss->ifis = 0; // fission is not allowed
1810 //
1811  zf = zff;
1812  af = aff;
1813  ee = EEIMFP;
1814  aimf = adummy;
1815  zimf = zdummy;
1816  tkeimf = tkedummy;
1817  FF11 = 0;
1818  FIMF11 = 0;
1819  ftype = 22;
1820 // Lambda particles
1821  G4int NbLamH1=0;
1822  G4int NbLamimf1=0;
1823  G4double pbH1 = (af-zf) / (af-zf+aimf-zimf);
1824  for(G4int i=0;i<NbLamH;i++){
1825  if(G4AblaRandom::flat()<pbH1){
1826  NbLamH1++;
1827  }else{
1828  NbLamimf1++;
1829  }
1830  }
1831 //
1832 // Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
1833  EkinR1 = tkeimf * aimf / (af+aimf);
1834  EkinR2 = tkeimf * af / (af+aimf);
1835  V1 = std::sqrt(EkinR1/af) * 1.3887;
1836  V2 = std::sqrt(EkinR2/aimf) * 1.3887;
1837  G4double VZ1_IMFS = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
1838  VPERP1 = std::sqrt(V1*V1 - VZ1_IMFS*VZ1_IMFS);
1839  ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
1840  G4double VX1_IMFS = VPERP1 * std::sin(ALPHA1);
1841  G4double VY1_IMFS = VPERP1 * std::cos(ALPHA1);
1842  G4double VX2_IMFS = - VX1_IMFS / V1 * V2;
1843  G4double VY2_IMFS = - VY1_IMFS / V1 * V2;
1844  G4double VZ2_IMFS = - VZ1_IMFS / V1 * V2;
1845 
1846  EEIMFP = ee * af /(af + aimf);
1847  EEIMF = ee * aimf /(af + aimf);
1848 
1849 // Decay of heavy partner
1850  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.));
1851 
1852  JPRFHEAVY = jprf1 * 0.4 * 931.49 * 1.16*1.16 * std::pow(af,5.0/3.0) / IINERTTOT;
1853  JPRFLIGHT = jprf1 * 0.4 * 931.49 * 1.16*1.16 * std::pow(aimf,5.0/3.0) / IINERTTOT;
1854 
1855  G4double zffs=0.,affs=0.,vx1ev_imfs=0.,vy1ev_imfs=0.,vz1ev_imfs=0.,jprf3=0.;
1856 
1857  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);
1858 
1859  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1860  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1861  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1862  EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1863 //
1864 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1865 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1866 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1867 // Lorentz transformation
1868  lorentz_boost(VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1869  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1870  &VXOUT,&VYOUT,&VZOUT);
1871  lorentz_boost(vx1ev_imfs,vy1ev_imfs,vz1ev_imfs,
1872  VXOUT,VYOUT,VZOUT,
1873  &VX2OUT,&VY2OUT,&VZ2OUT);
1874  EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1875  EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1876  EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1877  }
1878  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1879 
1880 // For IMF - fission and IMF emission are not allowed
1881  opt->optimfallowed = 0; // IMF is not allowed
1882  fiss->ifis = 0; // fission is not allowed
1883 //
1884  FF22 = 0;
1885  FIMF22 = 0;
1886 // Decay of "second" IMF
1887  G4double zffimfs=0.,affimfs=0.,vx2ev_imfs=0.,vy2ev_imfs=0.,vz2ev_imfs=0.,jprf4=0.;
1888 
1889  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);
1890 
1891  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1892  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1893  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1894  EV_TAB[IJ+IEV_TAB][5] = EV_TEMP[IJ][5];
1895 //
1896 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1897 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1898 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1899 // Lorentz transformation
1900  lorentz_boost(VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1901  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1902  &VXOUT,&VYOUT,&VZOUT);
1903  lorentz_boost(vx2ev_imfs,vy2ev_imfs,vz2ev_imfs,
1904  VXOUT,VYOUT,VZOUT,
1905  &VX2OUT,&VY2OUT,&VZ2OUT);
1906  EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1907  EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1908  EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1909  }
1910  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1911 
1912  AFP1 = idnint(affs);
1913  ZFP1 = idnint(zffs);
1914  SFP1 = NbLamH1;
1915  ZFP2 = idnint(zffimfs);
1916  AFP2 = idnint(affimfs);
1917  SFP2 = NbLamimf1;
1918 
1919 // Velocity of final heavy residue
1920 // Lorentz kinematics
1921 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
1922 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
1923 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
1924  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1925  V_CM[0],V_CM[1],V_CM[2],
1926  &VXOUT,&VYOUT,&VZOUT);
1927  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1928  VXOUT,VYOUT,VZOUT,
1929  &VX2OUT,&VY2OUT,&VZ2OUT);
1930  lorentz_boost(VX1_IMFS,VY1_IMFS,VZ1_IMFS,
1931  VX2OUT,VY2OUT,VZ2OUT,
1932  &VXOUT,&VYOUT,&VZOUT);
1933  lorentz_boost(vx1ev_imfs,vy1ev_imfs,vz1ev_imfs,
1934  VXOUT,VYOUT,VZOUT,
1935  &VX2OUT,&VY2OUT,&VZ2OUT);
1936  VFP1_CM[0] = VX2OUT;
1937  VFP1_CM[1] = VY2OUT;
1938  VFP1_CM[2] = VZ2OUT;
1939 
1940 // Velocity of the second IMF
1941 // Lorentz kinematics
1942 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
1943 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
1944 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
1945  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1946  V_CM[0],V_CM[1],V_CM[2],
1947  &VXOUT,&VYOUT,&VZOUT);
1948  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1949  VXOUT,VYOUT,VZOUT,
1950  &VX2OUT,&VY2OUT,&VZ2OUT);
1951  lorentz_boost(VX2_IMFS,VY2_IMFS,VZ2_IMFS,
1952  VX2OUT,VY2OUT,VZ2OUT,
1953  &VXOUT,&VYOUT,&VZOUT);
1954  lorentz_boost(vx2ev_imfs,vy2ev_imfs,vz2ev_imfs,
1955  VXOUT,VYOUT,VZOUT,
1956  &VX2OUT,&VY2OUT,&VZ2OUT);
1957  VFP2_CM[0] = VX2OUT;
1958  VFP2_CM[1] = VY2OUT;
1959  VFP2_CM[2] = VZ2OUT;
1960  }//second decay
1961  }// if(ftype == 2)
1962 
1963 // Only evaporation of light particles
1964  if(ftype!=1 && ftype!=21){
1965 
1966 // ----------- RESOLVE UNSTABLE NUCLEI
1967  IOUNSTABLE=0;
1968 
1969  unstable_nuclei(AFP1,ZFP1,&afpnew,&zfpnew,IOUNSTABLE,
1970  VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1971  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1972 
1973  if(IOUNSTABLE==1){
1974  AFP1 = afpnew;
1975  ZFP1 = zfpnew;
1976  VFP1_CM[0] = VP1X;
1977  VFP1_CM[1] = VP1Y;
1978  VFP1_CM[2] = VP1Z;
1979  for(G4int I = 0;I<ILOOP;I++){
1980  for(G4int IJ = 0; IJ<5; IJ++)
1981  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1982  }
1983  IEV_TAB = IEV_TAB + ILOOP;
1984  }
1985 
1986  if(ftype>1){
1987  IOUNSTABLE=0;
1988 
1989  unstable_nuclei(AFPIMF,ZFPIMF,&afpnew,&zfpnew,IOUNSTABLE,
1990  VIMF_CM[0],VIMF_CM[1],VIMF_CM[2],
1991  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1992 
1993  if(IOUNSTABLE==1){
1994  AFPIMF = afpnew;
1995  ZFPIMF = zfpnew;
1996  VIMF_CM[0] = VP1X;
1997  VIMF_CM[1] = VP1Y;
1998  VIMF_CM[2] = VP1Z;
1999  for(G4int I = 0;I<ILOOP;I++){
2000  for(G4int IJ = 0; IJ<5; IJ++)
2001  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2002  }
2003  IEV_TAB = IEV_TAB + ILOOP;
2004  }
2005 
2006  if(ftype>2){
2007  IOUNSTABLE=0;
2008 
2009  unstable_nuclei(AFP2,ZFP2,&afpnew,&zfpnew,IOUNSTABLE,
2010  VFP2_CM[0],VFP2_CM[1],VFP2_CM[2],
2011  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
2012 
2013  if(IOUNSTABLE==1){
2014  AFP2 = afpnew;
2015  ZFP2 = zfpnew;
2016  VFP2_CM[0] = VP1X;
2017  VFP2_CM[1] = VP1Y;
2018  VFP2_CM[2] = VP1Z;
2019  for(G4int I = 0;I<ILOOP;I++){
2020  for(G4int IJ = 0; IJ<5; IJ++)
2021  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2022  }
2023  IEV_TAB = IEV_TAB + ILOOP;
2024  }
2025  }// ftype>2
2026  }// ftype>1
2027  }
2028 
2029 
2030 // For the case of fission:
2031  if(ftype==1 || ftype==21){
2032 // ----------- RESOLVE UNSTABLE NUCLEI
2033  IOUNSTABLE=0;
2034 // ----------- Fragment 1
2035  unstable_nuclei(AFP1,ZFP1,&afpnew,&zfpnew,IOUNSTABLE,
2036  VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
2037  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
2038 
2039  if(IOUNSTABLE==1){
2040  AFP1 = afpnew;
2041  ZFP1 = zfpnew;
2042  VFP1_CM[0] = VP1X;
2043  VFP1_CM[1] = VP1Y;
2044  VFP1_CM[2] = VP1Z;
2045  for(G4int I = 0;I<ILOOP;I++){
2046  for(G4int IJ = 0; IJ<5; IJ++)
2047  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2048  }
2049  IEV_TAB = IEV_TAB + ILOOP;
2050  }
2051 
2052  IOUNSTABLE=0;
2053 // ----------- Fragment 2
2054  unstable_nuclei(AFP2,ZFP2,&afpnew,&zfpnew,IOUNSTABLE,
2055  VFP2_CM[0],VFP2_CM[1],VFP2_CM[2],
2056  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
2057 
2058  if(IOUNSTABLE==1){
2059  AFP2 = afpnew;
2060  ZFP2 = zfpnew;
2061  VFP2_CM[0] = VP1X;
2062  VFP2_CM[1] = VP1Y;
2063  VFP2_CM[2] = VP1Z;
2064  for(G4int I = 0;I<ILOOP;I++){
2065  for(G4int IJ = 0; IJ<5; IJ++)
2066  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2067  }
2068  IEV_TAB = IEV_TAB + ILOOP;
2069  }
2070 
2071  if(ftype==21){
2072  IOUNSTABLE=0;
2073 // ----------- Fragment IMF
2074  unstable_nuclei(AFPIMF,ZFPIMF,&afpnew,&zfpnew,IOUNSTABLE,
2075  VIMF_CM[0],VIMF_CM[1],VIMF_CM[2],
2076  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
2077 
2078  if(IOUNSTABLE==1){
2079  AFPIMF = afpnew;
2080  ZFPIMF = zfpnew;
2081  VIMF_CM[0] = VP1X;
2082  VIMF_CM[1] = VP1Y;
2083  VIMF_CM[2] = VP1Z;
2084  for(G4int I = 0;I<ILOOP;I++){
2085  for(G4int IJ = 0; IJ<5; IJ++)
2086  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
2087  }
2088  IEV_TAB = IEV_TAB + ILOOP;
2089  }
2090  }// ftype=21
2091  }
2092 
2093 // Cross check
2094  if((ftype == 1 || ftype == 21) && (AFP2<=0 || AFP1<=0 || ZFP2<=0 || ZFP1<=0)){
2095  std::cout << "ZFP1:" << ZFP1 << std::endl;
2096  std::cout << "AFP1:" << AFP1 << std::endl;
2097  std::cout << "ZFP2:" << ZFP2 << std::endl;
2098  std::cout << "AFP2:" << AFP2 << std::endl;
2099  }
2100 
2101 // Put heavy residues in the EV_TAB array
2102  EV_TAB[IEV_TAB][0] = ZFP1;
2103  EV_TAB[IEV_TAB][1] = AFP1;
2104  EV_TAB[IEV_TAB][5] = SFP1;
2105  EV_TAB[IEV_TAB][2] = VFP1_CM[0];
2106  EV_TAB[IEV_TAB][3] = VFP1_CM[1];
2107  EV_TAB[IEV_TAB][4] = VFP1_CM[2];
2108  IEV_TAB = IEV_TAB + 1;
2109 
2110  if(AFP2>0){
2111  EV_TAB[IEV_TAB][0] = ZFP2;
2112  EV_TAB[IEV_TAB][1] = AFP2;
2113  EV_TAB[IEV_TAB][5] = SFP2;
2114  EV_TAB[IEV_TAB][2] = VFP2_CM[0];
2115  EV_TAB[IEV_TAB][3] = VFP2_CM[1];
2116  EV_TAB[IEV_TAB][4] = VFP2_CM[2];
2117  IEV_TAB = IEV_TAB + 1;
2118  }
2119 
2120  if(AFPIMF>0){
2121  EV_TAB[IEV_TAB][0] = ZFPIMF;
2122  EV_TAB[IEV_TAB][1] = AFPIMF;
2123  EV_TAB[IEV_TAB][5] = SFPIMF;
2124  EV_TAB[IEV_TAB][2] = VIMF_CM[0];
2125  EV_TAB[IEV_TAB][3] = VIMF_CM[1];
2126  EV_TAB[IEV_TAB][4] = VIMF_CM[2];
2127  IEV_TAB = IEV_TAB + 1;
2128  }
2129 // Put the array of particles in the root file of INCL
2130  FillData(IMULTBU,IEV_TAB);
2131  return;
2132 }
2133 
2134 // Evaporation code
2135 void G4Abla::initEvapora()
2136 {
2137 
2138  // 40 C BFPRO,SNPRO,SPPRO,SHELL
2139  // 41 C
2140  // 42 C AP,ZP,AT,ZT - PROJECTILE AND TARGET MASSES
2141  // 43 C EAP,BETA - BEAM ENERGY PER NUCLEON, V/C
2142  // 44 C BMAXNUC - MAX. IMPACT PARAMETER FOR NUCL. REAC.
2143  // 45 C CRTOT,CRNUC - TOTAL AND NUCLEAR REACTION CROSS SECTION
2144  // 46 C R_0,R_P,R_T, - RADIUS PARAMETER, PROJECTILE+ TARGET RADII
2145  // 47 C IMAX,IRNDM,PI - MAXIMUM NUMBER OF EVENTS, DUMMY, 3.141...
2146  // 48 C BFPRO - FISSION BARRIER OF THE PROJECTILE
2147  // 49 C SNPRO - NEUTRON SEPARATION ENERGY OF THE PROJECTILE
2148  // 50 C SPPRO - PROTON " " " " "
2149  // 51 C SHELL - GROUND STATE SHELL CORRECTION
2150  // 52 C---------------------------------------------------------------------
2151  // 53 C
2152  // 54 C ENERGIES WIDTHS AND CROSS SECTIONS FOR EM EXCITATION
2153  // 55 C COMMON /EMDPAR/ EGDR,EGQR,FWHMGDR,FWHMGQR,CREMDE1,CREMDE2,
2154  // 56 C AE1,BE1,CE1,AE2,BE2,CE2,SR1,SR2,XR
2155  // 57 C
2156  // 58 C EGDR,EGQR - MEAN ENERGY OF GDR AND GQR
2157  // 59 C FWHMGDR,FWHMGQR - FWHM OF GDR, GQR
2158  // 60 C CREMDE1,CREMDE2 - EM CROSS SECTION FOR E1 AND E2
2159  // 61 C AE1,BE1,CE1 - ARRAYS TO CALCULATE
2160  // 62 C AE2,BE2,CE2 - THE EXCITATION ENERGY AFTER E.M. EXC.
2161  // 63 C SR1,SR2,XR - WITH MONTE CARLO
2162  // 64 C---------------------------------------------------------------------
2163  // 65 C
2164  // 66 C DEFORMATIONS AND G.S. SHELL EFFECTS
2165  // 67 C COMMON /ECLD/ ECGNZ,ECFNZ,VGSLD,ALPHA
2166  // 68 C
2167  // 69 C ECGNZ - GROUND STATE SHELL CORR. FRLDM FOR A SPHERICAL G.S.
2168  // 70 C ECFNZ - SHELL CORRECTION FOR THE SADDLE POINT (NOW: == 0)
2169  // 71 C VGSLD - DIFFERENCE BETWEEN DEFORMED G.S. AND LDM VALUE
2170  // 72 C ALPHA - ALPHA GROUND STATE DEFORMATION (THIS IS NOT BETA2!)
2171  // 73 C BETA2 = SQRT(5/(4PI)) * ALPHA
2172  // 74 C---------------------------------------------------------------------
2173  // 75 C
2174  // 76 C ARRAYS FOR EXCITATION ENERGY BY STATISTICAL HOLE ENERY MODEL
2175  // 77 C COMMON /EENUC/ SHE, XHE
2176  // 78 C
2177  // 79 C SHE, XHE - ARRAYS TO CALCULATE THE EXC. ENERGY AFTER
2178  // 80 C ABRASION BY THE STATISTICAL HOLE ENERGY MODEL
2179  // 81 C---------------------------------------------------------------------
2180  // 82 C
2181  // 83 C G.S. SHELL EFFECT
2182  // 84 C COMMON /EC2SUB/ ECNZ
2183  // 85 C
2184  // 86 C ECNZ G.S. SHELL EFFECT FOR THE MASSES (IDENTICAL TO ECGNZ)
2185  // 87 C---------------------------------------------------------------------
2186  //
2187 
2188  G4double MN = 939.5653301;
2189  G4double MP = 938.7829835;
2190 
2191 #ifdef ABLAXX_IN_GEANT4_MODE
2192  G4AblaDataFile *dataInterface = new G4AblaDataFile();
2193 #else
2194  G4AblaDataFile *dataInterface = new G4AblaDataFile(theConfig);
2195 #endif
2196  if(dataInterface->readData() == true) {
2197  if(verboseLevel > 0) {
2198  // G4cout <<"G4Abla: Datafiles read successfully." << G4endl;
2199  }
2200  }
2201  else {
2202  // G4Exception("ERROR: Failed to read datafiles.");
2203  }
2204 
2205  for(G4int z = 0; z < 99; z++) { //do 30 z = 0,98,1
2206  for(G4int n = 0; n < 154; n++) { //do 31 n = 0,153,1
2207  ecld->ecfnz[n][z] = 0.e0;
2208  ec2sub->ecnz[n][z] = dataInterface->getEcnz(n,z);
2209  ecld->ecgnz[n][z] = dataInterface->getEcnz(n,z);
2210  ecld->alpha[n][z] = dataInterface->getAlpha(n,z);
2211  ecld->vgsld[n][z] = dataInterface->getVgsld(n,z);
2212  ecld->rms[n][z] = dataInterface->getRms(n,z);
2213  }
2214  }
2215 
2216  for(G4int z = 0; z < 137; z++){
2217  for(G4int n = 0; n < 251; n++){
2218  ecld->beta2[n][z] = dataInterface->getBeta2(n,z);
2219  ecld->beta4[n][z] = dataInterface->getBeta4(n,z);
2220  }
2221  }
2222 
2223  for(G4int z = 0; z < 500; z++) {
2224  for(G4int a = 0; a < 500; a++) {
2225  pace->dm[z][a] = dataInterface->getPace2(z,a);
2226  }
2227  }
2228 
2229 
2230 
2231  G4double mfrldm[154][13];
2232 // For 2 < Z < 12 we take "experimental" shell corrections instead of calculated
2233 // Read FRLDM tables
2234  for(G4int i=1;i<13;i++){
2235  for(G4int j=1;j<154;j++){
2236  if(dataInterface->getMexpID(j,i)==1){
2237  masses->mexpiop[j][i]=1;
2238  }else{
2239  masses->mexpiop[j][i]=0;
2240  }
2241 // LD masses (even-odd effect is later considered according to Ignatyuk)
2242  if(i==0 && j==0)
2243  mfrldm[j][i] = 0.;
2244  else
2245  mfrldm[j][i] = MP*i+MN*j+eflmac(i+j,i,1,0);
2246  }
2247  }
2248 
2249  G4double e0=0.;
2250  for(G4int i=1;i<13;i++){
2251  for(G4int j=1;j<154;j++){
2252  masses->bind[j][i]=0.;
2253  if(masses->mexpiop[j][i]==1){
2254  if(j<3){
2255 
2256  ec2sub->ecnz[j][i] = 0.0;
2257  ecld->ecgnz[j][i] = ec2sub->ecnz[j][i];
2258  masses->bind[j][i] = dataInterface->getMexp(j,i)-MP*i -MN*j;
2259  ecld->vgsld[j][i]=0.;
2260 
2261  e0=0.;
2262  }else{
2263 // For these nuclei, we take "experimental" ground-state shell corrections
2264 //
2265 // Parametrization of CT model by Ignatyuk; note that E0 is shifted to correspond
2266 // to pairing shift in Fermi-gas model (there, energy is shifted taking odd-odd nuclei as bassis)
2267  G4double para=0.;
2268  parite(j+i,&para);
2269  if(para<0.0){
2270 // e-o, o-e
2271  e0 = 0.285+11.17*std::pow(j+i,-0.464) -0.390-0.00058*(j+i);
2272  }else{
2273  G4double parz=0.;
2274  parite(i,&parz);
2275  if (parz>0.0){
2276 // e-e
2277  e0 = 22.34*std::pow(j+i,-0.464)-0.235;
2278  }else{
2279 // o-o
2280  e0 = 0.0;
2281  }
2282  }
2283 //
2284  if((j==i)&&mod(j,2)==1&&mod(i,2)==1){
2285  e0 = e0 - 30.0*(1.0/G4double(j+i));
2286  }
2287 
2288  G4double delta_tot = ec2sub->ecnz[j][i] - ecld->vgsld[j][i];
2289  ec2sub->ecnz[j][i] = dataInterface->getMexp(j,i) - (mfrldm[j][i] - e0);
2290 
2291  ecld->vgsld[j][i] = max(0.0,ec2sub->ecnz[j][i] - delta_tot);
2292  ecld->ecgnz[j][i] = ec2sub->ecnz[j][i];
2293 
2294  }//if j
2295  }//if mexpiop
2296  }
2297  }
2298 //
2299  delete dataInterface;
2300 }
2301 
2302 void G4Abla::SetParametersG4(G4int z, G4int a)
2303 {
2304  //A and Z for the target
2305  fiss->at = a;
2306  fiss->zt = z;
2307 
2308  // shell+pairing.0-1-2-3 for IMFs
2309  opt->optshpimf = 0;
2310 
2311  //collective enhancement switched on 1 or off 0 in densn (qr=val or =1.)
2312  fiss->optcol = 1;
2313  if(fiss->zt<83 && fiss->zt>56){
2314  fiss->optshp = 1;
2315  }
2316  if(fiss->zt<=56){
2317  fiss->optcol = 0;
2318  fiss->optshp = 3;
2319  }
2320 }
2321 
2322 void G4Abla::SetParameters()
2323 {
2324 /*
2325 C IFIS = INTEGER SWITCH FOR FISSION
2326 C OPTSHP = INTEGER SWITCH FOR SHELL CORRECTION IN MASSES/ENERGY
2327 C =0 NO MICROSCOPIC CORRECTIONS IN MASSES AND ENERGY
2328 C =1 SHELL , NO PAIRING CORRECTION
2329 C =2 PAIRING, NO SHELL CORRECTION
2330 C =3 SHELL AND PAIRING CORRECTION IN MASSES AND ENERGY
2331 C OPTCOL =0,1 COLLECTIVE ENHANCEMENT SWITCHED ON 1 OR OFF 0 IN DENSN
2332 C OPTAFAN=0,1 SWITCH FOR AF/AN = 1 IN DENSNIV 0 AF/AN>1 1 AF/AN=1
2333 C BET = REAL REDUCED FRICTION COEFFICIENT / 10**(+21) S**(-1)
2334 C OPTXFIS= INTEGER 0,1,2 FOR MYERS & SWIATECKI, DAHLINGER, ANDREYEV
2335 C FISSILITY PARAMETER.
2336 C
2337 C NUCLEAR LEVEL DENSITIES:
2338 C AV = REAL KOEFFICIENTS FOR CALCULATION OF A(TILDE)
2339 C AS = REAL LEVEL DENSITY PARAMETER
2340 C AK = REAL
2341 */
2342 
2343  // switch-fission.1=on.0=off
2344  fiss->ifis = 1;
2345 
2346  // shell+pairing.0-1-2-3
2347  fiss->optshp = 3;
2348  if(fiss->zt<84 && fiss->zt>56)
2349  fiss->optshp = 1;
2350 
2351  // optemd =0,1 0 no emd, 1 incl. emd
2352  opt->optemd = 1;
2353  // read(10,*,iostat=io) dum(10),optcha
2354  opt->optcha = 1;
2355 
2356  // shell+pairing.0-1-2-3 for IMFs
2357  opt->optshpimf = 0;
2358  opt->optimfallowed = 1;
2359 
2360  // nuclear.viscosity.(beta)
2361  fiss->bet = 4.5;
2362 
2363  //collective enhancement switched on 1 or off 0 in densn (qr=val or =1.)
2364  fiss->optcol = 1;
2365  if(fiss->zt<=56){
2366  fiss->optcol = 0;
2367  fiss->optshp = 3;
2368  }
2369  //collective enhancement parameters
2370  fiss->ucr = 40.;
2371  fiss->dcr = 10.;
2372 
2373  // switch for temperature constant model (CTM)
2374  fiss->optct = 1;
2375 
2376  ald->optafan = 0;
2377 
2378  ald->av = 0.0730;
2379  ald->as = 0.0950;
2380  ald->ak = 0.0000;
2381 
2382  fiss->optxfis = 3;
2383 
2384 // Multi-fragmentation
2385  T_freeze_out_in = -6.5;
2386 
2387 }
2388 
2389 void G4Abla::mglw(G4double a, G4double z, G4double *el)
2390 {
2391  // MODEL DE LA GOUTTE LIQUIDE DE C. F. WEIZSACKER.
2392  // USUALLY AN OBSOLETE OPTION
2393 
2394  G4double xv = 0.0, xs = 0.0, xc = 0.0, xa = 0.0;
2395 
2396  if ((a <= 0.01) || (z < 0.01)) {
2397  (*el) = 1.0e38;
2398  }
2399  else {
2400  xv = -15.56*a;
2401  xs = 17.23*std::pow(a,(2.0/3.0));
2402 
2403  if (a > 1.0) {
2404  xc = 0.7*z*(z-1.0)*std::pow((a-1.0),(-1.e0/3.e0));
2405  }
2406  else {
2407  xc = 0.0;
2408  }
2409  }
2410 
2411  xa = 23.6*(std::pow((a-2.0*z),2)/a);
2412  (*el) = xv+xs+xc+xa;
2413  return;
2414 }
2415 
2416 void G4Abla::mglms(G4double a, G4double z, G4int refopt4, G4double *el)
2417 {
2418  // USING FUNCTION EFLMAC(IA,IZ,0)
2419  //
2420  // REFOPT4 = 0 : WITHOUT MICROSCOPIC CORRECTIONS
2421  // REFOPT4 = 1 : WITH SHELL CORRECTION
2422  // REFOPT4 = 2 : WITH PAIRING CORRECTION
2423  // REFOPT4 = 3 : WITH SHELL- AND PAIRING CORRECTION
2424 
2425  // 1839 C-----------------------------------------------------------------------
2426  // 1840 C A1 LOCAL MASS NUMBER (INTEGER VARIABLE OF A)
2427  // 1841 C Z1 LOCAL NUCLEAR CHARGE (INTEGER VARIABLE OF Z)
2428  // 1842 C REFOPT4 OPTION, SPECIFYING THE MASS FORMULA (SEE ABOVE)
2429  // 1843 C A MASS NUMBER
2430  // 1844 C Z NUCLEAR CHARGE
2431  // 1845 C DEL PAIRING CORRECTION
2432  // 1846 C EL BINDING ENERGY
2433  // 1847 C ECNZ( , ) TABLE OF SHELL CORRECTIONS
2434  // 1848 C-----------------------------------------------------------------------
2435  // 1849 C
2436  G4int a1 = idnint(a);
2437  G4int z1 = idnint(z);
2438  G4int n1 = a1-z1;
2439 
2440  if ( (a1 <= 0) || (z1 <= 0) || ((a1-z1) <= 0) ) { //then
2441  // modif pour recuperer une masse p et n correcte:
2442  (*el) = 1.e38;
2443  return;
2444  // goto mglms50;
2445  }
2446  else {
2447  // binding energy incl. pairing contr. is calculated from
2448  // function eflmac
2449  (*el) = eflmac(a1,z1,0,refopt4);
2450 
2451  if (refopt4 > 0) {
2452  if (refopt4 != 2) {
2453  (*el) = (*el) + ec2sub->ecnz[a1-z1][z1];
2454  }
2455  }
2456 
2457  if(z1>=90){
2458  if(n1<=145){
2459  (*el) = (*el) + (12.552-0.1436*z1);
2460  }else{
2461  if(n1>145&&n1<=152){
2462  (*el) = (*el) + ((152.4-1.77*z1)+(-0.972+0.0113*z1)*n1);
2463  }
2464  }
2465  }
2466 
2467  }
2468  return;
2469 }
2470 
2471 G4double G4Abla::spdef(G4int a, G4int z, G4int optxfis)
2472 {
2473 
2474  // INPUT: A,Z,OPTXFIS MASS AND CHARGE OF A NUCLEUS,
2475  // OPTION FOR FISSILITY
2476  // OUTPUT: SPDEF
2477 
2478  // ALPHA2 SADDLE POINT DEF. COHEN&SWIATECKI ANN.PHYS. 22 (1963) 406
2479  // RANGING FROM FISSILITY X=0.30 TO X=1.00 IN STEPS OF 0.02
2480 
2481  G4int index = 0;
2482  G4double x = 0.0, v = 0.0, dx = 0.0;
2483 
2484  const G4int alpha2Size = 37;
2485  // The value 0.0 at alpha2[0] added by PK.
2486  G4double alpha2[alpha2Size] = {0.0, 2.5464e0, 2.4944e0, 2.4410e0, 2.3915e0, 2.3482e0,
2487  2.3014e0, 2.2479e0, 2.1982e0, 2.1432e0, 2.0807e0, 2.0142e0, 1.9419e0,
2488  1.8714e0, 1.8010e0, 1.7272e0, 1.6473e0, 1.5601e0, 1.4526e0, 1.3164e0,
2489  1.1391e0, 0.9662e0, 0.8295e0, 0.7231e0, 0.6360e0, 0.5615e0, 0.4953e0,
2490  0.4354e0, 0.3799e0, 0.3274e0, 0.2779e0, 0.2298e0, 0.1827e0, 0.1373e0,
2491  0.0901e0, 0.0430e0, 0.0000e0};
2492 
2493  dx = 0.02;
2494  x = fissility(a,z,0,0.,0.,optxfis);
2495 
2496  v = (x - 0.3)/dx + 1.0;
2497  index = idnint(v);
2498 
2499  if (index < 1) {
2500  return(alpha2[1]);
2501  }
2502 
2503  if (index == 36) {
2504  return(alpha2[36]);
2505  }
2506  else {
2507  return(alpha2[index] + (alpha2[index+1] - alpha2[index]) / dx * ( x - (0.3e0 + dx*(index-1))));
2508  }
2509 
2510  return alpha2[0]; // The algorithm is not supposed to reach this point.
2511 }
2512 
2513 G4double G4Abla::fissility(G4int a, G4int z, G4int ny, G4double sn, G4double slam, G4int optxfis)
2514 {
2515  // CALCULATION OF FISSILITY PARAMETER
2516  //
2517  // INPUT: A,Z INTEGER MASS & CHARGE OF NUCLEUS
2518  // OPTXFIS = 0 : MYERS, SWIATECKI
2519  // 1 : DAHLINGER
2520  // 2 : ANDREYEV
2521 
2522  G4double aa = 0.0, zz = 0.0, i = 0.0,z2a,C_S,R,W,G,G1,G2,A_CC;
2523  G4double fissilityResult = 0.0;
2524 
2525  aa = G4double(a);
2526  zz = G4double(z);
2527  i = G4double(a-2*z) / aa;
2528  z2a= zz*zz/aa-ny*(1115.-939.+sn-slam)/(0.7053*std::pow(a,2./3.));
2529 
2530  // myers & swiatecki droplet modell
2531  if (optxfis == 0) { //then
2532  fissilityResult = std::pow(zz,2) / aa /50.8830e0 / (1.0e0 - 1.7826e0 * std::pow(i,2));
2533  }
2534 
2535  if (optxfis == 1) {
2536  // dahlinger fit:
2537  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));
2538  }
2539 
2540  if (optxfis == 2) {
2541  // dubna fit:
2542  fissilityResult = std::pow(zz,2) / aa /(48.e0*(1.e0 - 17.22e0*std::pow(i,4)));
2543  }
2544 
2545  if (optxfis == 3) {
2546 // Fissiilty is calculated according to FRLDM, see Sierk, PRC 1984.
2547  C_S = 21.13 * (1.0 - 2.3*i*i);
2548  R = 1.16 * std::pow(aa,1.0/3.0);
2549  W = 0.704/R;
2550  G1 = 1.0 - 15.0/8.0*W+21.0/8.0*W*W*W;
2551  G2 = 1.0 + 9.0/2.0*W + 7.0*W*W + 7.0/2.0*W*W*W;
2552  G = 1.0 - 5.0*W*W*(G1 - 3.0/4.0*G2*std::exp(-2.0/W));
2553  A_CC = 3.0/5.0 * 1.44 * G / 1.16;
2554  fissilityResult = z2a * A_CC/(2.0*C_S);
2555  }
2556 
2557  if (fissilityResult > 1.0) {
2558  fissilityResult = 1.0;
2559  }
2560 
2561  if (fissilityResult < 0.0) {
2562  fissilityResult = 0.0;
2563  }
2564 
2565  return fissilityResult;
2566 }
2567 
2568 void 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,
2569 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_par)
2570 {
2571  G4double zf = zprf;
2572  G4double af = aprf;
2573  G4double ee = (*ee_par);
2574  G4double jprf = dint(jprf_par);
2575  G4double mtota = (*mtota_par);
2576  G4double vleva = 0.;
2577  G4double vxeva = 0.;
2578  G4double vyeva = 0.;
2579  G4int ff = (*ff_par);
2580  G4int fimf = (*fimf_par);
2581  G4double tkeimf = (*tkeimf_par);
2582  G4int inttype = (*inttype_par);
2583  G4int inum = (*inum_par);
2584  G4int NbLam0 = (*NbLam0_par);
2585 
2586  // 533 C
2587  // 534 C INPUT:
2588  // 535 C
2589  // 536 C ZPRF, APRF, EE(EE IS MODIFIED!), JPRF
2590  // 537 C
2591  // 538 C PROJECTILE AND TARGET PARAMETERS + CROSS SECTIONS
2592  // 539 C COMMON /ABRAMAIN/ AP,ZP,AT,ZT,EAP,BETA,BMAXNUC,CRTOT,CRNUC,
2593  // 540 C R_0,R_P,R_T, IMAX,IRNDM,PI,
2594  // 541 C BFPRO,SNPRO,SPPRO,SHELL
2595  // 542 C
2596  // 543 C AP,ZP,AT,ZT - PROJECTILE AND TARGET MASSES
2597  // 544 C EAP,BETA - BEAM ENERGY PER NUCLEON, V/C
2598  // 545 C BMAXNUC - MAX. IMPACT PARAMETER FOR NUCL. REAC.
2599  // 546 C CRTOT,CRNUC - TOTAL AND NUCLEAR REACTION CROSS SECTION
2600  // 547 C R_0,R_P,R_T, - RADIUS PARAMETER, PROJECTILE+ TARGET RADII
2601  // 548 C IMAX,IRNDM,PI - MAXIMUM NUMBER OF EVENTS, DUMMY, 3.141...
2602  // 549 C BFPRO - FISSION BARRIER OF THE PROJECTILE
2603  // 550 C SNPRO - NEUTRON SEPARATION ENERGY OF THE PROJECTILE
2604  // 551 C SPPRO - PROTON " " " " "
2605  // 552 C SHELL - GROUND STATE SHELL CORRECTION
2606  // 553 C
2607  // 554 C---------------------------------------------------------------------
2608  // 555 C FISSION BARRIERS
2609  // 556 C COMMON /FB/ EFA
2610  // 557 C EFA - ARRAY OF FISSION BARRIERS
2611  // 558 C---------------------------------------------------------------------
2612  // 559 C OUTPUT:
2613  // 560 C ZF, AF, MTOTA, PLEVA, PTEVA, FF, INTTYPE, INUM
2614  // 561 C
2615  // 562 C ZF,AF - CHARGE AND MASS OF FINAL FRAGMENT AFTER EVAPORATION
2616  // 563 C MTOTA _ NUMBER OF EVAPORATED ALPHAS
2617  // 564 C PLEVA,PXEVA,PYEVA - MOMENTUM RECOIL BY EVAPORATION
2618  // 565 C INTTYPE - TYPE OF REACTION 0/1 NUCLEAR OR ELECTROMAGNETIC
2619  // 566 C FF - 0/1 NO FISSION / FISSION EVENT
2620  // 567 C INUM - EVENTNUMBER
2621  // 568 C ____________________________________________________________________
2622  // 569 C /
2623  // 570 C / CALCUL DE LA MASSE ET CHARGE FINALES D'UNE CHAINE D'EVAPORATION
2624  // 571 C /
2625  // 572 C / PROCEDURE FOR CALCULATING THE FINAL MASS AND CHARGE VALUES OF A
2626  // 573 C / SPECIFIC EVAPORATION CHAIN, STARTING POINT DEFINED BY (APRF, ZPRF,
2627  // 574 C / EE)
2628  // 575 C / On ajoute les 3 composantes de l'impulsion (PXEVA,PYEVA,PLEVA)
2629  // 576 C / (actuellement PTEVA n'est pas correct; mauvaise norme...)
2630  // 577 C /____________________________________________________________________
2631  // 578 C
2632  // 612 C
2633  // 613 C-----------------------------------------------------------------------
2634  // 614 C IRNDM DUMMY ARGUMENT FOR RANDOM-NUMBER FUNCTION
2635  // 615 C SORTIE LOCAL HELP VARIABLE TO END THE EVAPORATION CHAIN
2636  // 616 C ZF NUCLEAR CHARGE OF THE FRAGMENT
2637  // 617 C ZPRF NUCLEAR CHARGE OF THE PREFRAGMENT
2638  // 618 C AF MASS NUMBER OF THE FRAGMENT
2639  // 619 C APRF MASS NUMBER OF THE PREFRAGMENT
2640  // 620 C EPSILN ENERGY BURNED IN EACH EVAPORATION STEP
2641  // 621 C MALPHA LOCAL MASS CONTRIBUTION TO MTOTA IN EACH EVAPORATION
2642  // 622 C STEP
2643  // 623 C EE EXCITATION ENERGY (VARIABLE)
2644  // 624 C PROBP PROTON EMISSION PROBABILITY
2645  // 625 C PROBN NEUTRON EMISSION PROBABILITY
2646  // 626 C PROBA ALPHA-PARTICLE EMISSION PROBABILITY
2647  // 627 C PTOTL TOTAL EMISSION PROBABILITY
2648  // 628 C E LOWEST PARTICLE-THRESHOLD ENERGY
2649  // 629 C SN NEUTRON SEPARATION ENERGY
2650  // 630 C SBP PROTON SEPARATION ENERGY PLUS EFFECTIVE COULOMB
2651  // 631 C BARRIER
2652  // 632 C SBA ALPHA-PARTICLE SEPARATION ENERGY PLUS EFFECTIVE
2653  // 633 C COULOMB BARRIER
2654  // 634 C BP EFFECTIVE PROTON COULOMB BARRIER
2655  // 635 C BA EFFECTIVE ALPHA COULOMB BARRIER
2656  // 636 C MTOTA TOTAL MASS OF THE EVAPORATED ALPHA PARTICLES
2657  // 637 C X UNIFORM RANDOM NUMBER FOR NUCLEAR CHARGE
2658  // 638 C AMOINS LOCAL MASS NUMBER OF EVAPORATED PARTICLE
2659  // 639 C ZMOINS LOCAL NUCLEAR CHARGE OF EVAPORATED PARTICLE
2660  // 640 C ECP KINETIC ENERGY OF PROTON WITHOUT COULOMB
2661  // 641 C REPULSION
2662  // 642 C ECN KINETIC ENERGY OF NEUTRON
2663  // 643 C ECA KINETIC ENERGY OF ALPHA PARTICLE WITHOUT COULOMB
2664  // 644 C REPULSION
2665  // 645 C PLEVA TRANSVERSAL RECOIL MOMENTUM OF EVAPORATION
2666  // 646 C PTEVA LONGITUDINAL RECOIL MOMENTUM OF EVAPORATION
2667  // 647 C FF FISSION FLAG
2668  // 648 C INTTYPE INTERACTION TYPE FLAG
2669  // 649 C RNDX RECOIL MOMENTUM IN X-DIRECTION IN A SINGLE STEP
2670  // 650 C RNDY RECOIL MOMENTUM IN Y-DIRECTION IN A SINGLE STEP
2671  // 651 C RNDZ RECOIL MOMENTUM IN Z-DIRECTION IN A SINGLE STEP
2672  // 652 C RNDN NORMALIZATION OF RECOIL MOMENTUM FOR EACH STEP
2673  // 653 C-----------------------------------------------------------------------
2674  // 654 C
2675  //
2676  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;
2677  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;
2678  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;
2679  G4double zimf= 0.0,aimf= 0.0,bimf= 0.0,sbimf= 0.0,timf= 0.0;
2680  G4int itest = 0, sortie=0;
2681  G4double probf = 0.0;
2682  G4double ctet1 = 0.0, stet1 = 0.0, phi1 = 0.0;
2683  G4double rnd = 0.0;
2684  G4double ef = 0.0;
2685  G4double ts1 = 0.0;
2686  G4int fgamma = 0, gammadecay = 0, flamb0decay=0;
2687  G4double pc = 0.0, malpha = 0.0;
2688  G4double jprfn=0.0, jprfp=0.0, jprfd=0.0, jprft=0.0, jprfhe=0.0, jprfa=0.0, jprflamb0 = 0.0;
2689  G4double tsum = 0.0;
2690  G4int twon;
2691 
2692  const G4double c = 29.9792458;
2693  const G4double mu = 931.494;
2694  const G4double mu2 = 931.494*931.494;
2695 
2696  G4double pleva = 0.0;
2697  G4double pxeva = 0.0;
2698  G4double pyeva = 0.0;
2699  G4int IEV_TAB_TEMP=0;
2700 
2701  for(G4int I1=0;I1<200;I1++)
2702  for(G4int I2=0;I2<6;I2++)
2703  EV_TEMP[I1][I2] = 0.0;
2704 //
2705  ff = 0;
2706  itest = 0;
2707 //
2708  evapora10:
2709  //
2710  // calculation of the probabilities for the different decay channels
2711  // plus separation energies and kinetic energies of the particles
2712  //
2713  if(ee<0.|| zf<3.)goto evapora100;
2714  direct(zf,af,ee,jprf,&probp,&probd,&probt,&probn,&probhe,&proba,&probg,&probimf,&probf,&problamb0,&ptotl,
2715  &sn,&sbp,&sbd,&sbt,&sbhe,&sba,&slamb0,
2716  &ecn,&ecp,&ecd,&ect,&eche,&eca,&ecg,&eclamb0,
2717  &bp,&bd,&bt,&bhe,&ba,&sp,&sd,&st,&she,&sa,&ef,&ts1,inttype,inum,itest,&sortie,&tcn,
2718  &jprfn, &jprfp, &jprfd, &jprft, &jprfhe, &jprfa, &jprflamb0, &tsum, NbLam0);
2719 //
2720 // HERE THE FINAL STEPS OF THE EVAPORATION ARE CALCULATED
2721 //
2722  if(ptotl==0.0) goto evapora100;
2723 
2724  e = dmin1(sba,sbhe,dmin1(sbt,sbhe,dmin1(sn,sbp,sbd)));
2725 
2726  if(e>1e30)std::cout << "ERROR AT THE EXIT OF EVAPORA,E>1.D30,AF="<< af << " ZF=" << zf << std::endl;
2727 
2728  if(sortie==1){
2729  if (probn!=0.0) {
2730  amoins = 1.0;
2731  zmoins = 0.0;
2732  epsiln = sn + ecn;
2733  pc = std::sqrt(std::pow((1.0 + (ecn)/9.3956e2),2.) - 1.0) * 9.3956e2;
2734  malpha = 0.0;
2735  fgamma = 0;
2736  fimf = 0;
2737  flamb0decay=0;
2738  gammadecay = 0;
2739  }
2740  else if(probp!=0.0){
2741  amoins = 1.0;
2742  zmoins = 1.0;
2743  epsiln = sp + ecp;
2744  pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2.) - 1.0) * 9.3827e2;
2745  malpha = 0.0;
2746  fgamma = 0;
2747  fimf = 0;
2748  flamb0decay=0;
2749  gammadecay = 0;
2750  }
2751  else if(probd!=0.0){
2752  amoins = 2.0;
2753  zmoins = 1.0;
2754  epsiln = sd + ecd;
2755  pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
2756  malpha = 0.0;
2757  fgamma = 0;
2758  fimf = 0;
2759  flamb0decay=0;
2760  gammadecay = 0;
2761  }
2762  else if(probt!=0.0){
2763  amoins = 3.0;
2764  zmoins = 1.0;
2765  epsiln = st + ect;
2766  pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
2767  malpha = 0.0;
2768  fgamma = 0;
2769  fimf = 0;
2770  flamb0decay=0;
2771  gammadecay = 0;
2772  }
2773  else if(probhe!=0.0){
2774  amoins = 3.0;
2775  zmoins = 2.0;
2776  epsiln = she + eche;
2777  pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
2778  malpha = 0.0;
2779  fgamma = 0;
2780  fimf = 0;
2781  flamb0decay=0;
2782  gammadecay = 0;
2783  }
2784  else{ if(proba!=0.0){
2785  amoins = 4.0;
2786  zmoins = 2.0;
2787  epsiln = sa + eca;
2788  pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
2789  malpha = 4.0;
2790  fgamma = 0;
2791  fimf = 0;
2792  flamb0decay=0;
2793  gammadecay = 0;
2794  }
2795  }
2796  goto direct99;
2797  }
2798 
2799  // here the normal evaporation cascade starts
2800 
2801  // random number for the evaporation
2802  x = G4AblaRandom::flat() * ptotl;
2803 
2804  itest = 0;
2805  if (x < proba) {
2806  // alpha evaporation
2807  amoins = 4.0;
2808  zmoins = 2.0;
2809  epsiln = sa + eca;
2810  pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
2811  malpha = 4.0;
2812  fgamma = 0;
2813  fimf = 0;
2814  ff = 0;
2815  flamb0decay=0;
2816  gammadecay = 0;
2817  jprf=jprfa;
2818  }
2819  else if (x < proba+probhe) {
2820  // He3 evaporation
2821  amoins = 3.0;
2822  zmoins = 2.0;
2823  epsiln = she + eche;
2824  pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
2825  malpha = 0.0;
2826  fgamma = 0;
2827  fimf = 0;
2828  ff = 0;
2829  flamb0decay=0;
2830  gammadecay = 0;
2831  jprf=jprfhe;
2832  }
2833  else if (x < proba+probhe+probt) {
2834  // triton evaporation
2835  amoins = 3.0;
2836  zmoins = 1.0;
2837  epsiln = st + ect;
2838  pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
2839  malpha = 0.0;
2840  fgamma = 0;
2841  fimf = 0;
2842  ff = 0;
2843  flamb0decay=0;
2844  gammadecay = 0;
2845  jprf=jprft;
2846  }
2847  else if (x < proba+probhe+probt+probd) {
2848  // deuteron evaporation
2849  amoins = 2.0;
2850  zmoins = 1.0;
2851  epsiln = sd + ecd;
2852  pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
2853  malpha = 0.0;
2854  fgamma = 0;
2855  fimf = 0;
2856  ff = 0;
2857  flamb0decay=0;
2858  gammadecay = 0;
2859  jprf=jprfd;
2860  }
2861  else if (x < proba+probhe+probt+probd+probp) {
2862  // proton evaporation
2863  amoins = 1.0;
2864  zmoins = 1.0;
2865  epsiln = sp + ecp;
2866  pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2) - 1.0) * 9.3827e2;
2867  malpha = 0.0;
2868  fgamma = 0;
2869  fimf = 0;
2870  ff = 0;
2871  flamb0decay=0;
2872  gammadecay = 0;
2873  jprf=jprfp;
2874  }
2875  else if (x < proba+probhe+probt+probd+probp+probn) {
2876  // neutron evaporation
2877  amoins = 1.0;
2878  zmoins = 0.0;
2879  epsiln = sn + ecn;
2880  pc = std::sqrt(std::pow((1.0 + (ecn)/9.3956e2),2.) - 1.0) * 9.3956e2;
2881  malpha = 0.0;
2882  fgamma = 0;
2883  fimf = 0;
2884  ff = 0;
2885  flamb0decay=0;
2886  gammadecay = 0;
2887  jprf=jprfn;
2888  }
2889  else if (x < proba+probhe+probt+probd+probp+probn+problamb0) {
2890  // lambda0 evaporation
2891  amoins = 1.0;
2892  zmoins = 0.0;
2893  epsiln = slamb0 + eclamb0;
2894  pc = std::sqrt(std::pow((1.0 + (eclamb0)/11.1568e2),2.) - 1.0) * 11.1568e2;
2895  malpha = 0.0;
2896  fgamma = 0;
2897  fimf = 0;
2898  ff = 0;
2899  flamb0decay = 1;
2900  opt->nblan0 = opt->nblan0 -1;
2901  NbLam0 = NbLam0 -1;
2902  gammadecay = 0;
2903  jprf=jprflamb0;
2904  }
2905  else if (x < proba+probhe+probt+probd+probp+probn+problamb0+probg) {
2906  // gamma evaporation
2907  amoins = 0.0;
2908  zmoins = 0.0;
2909  epsiln = ecg;
2910  pc = ecg;
2911  malpha = 0.0;
2912  flamb0decay = 0;
2913  gammadecay = 1;
2914  //Next IF command is to shorten the calculations when gamma-emission is the only
2915  //possible channel
2916  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;
2917  fimf = 0;
2918  ff = 0;
2919  }
2920  else if (x < proba+probhe+probt+probd+probp+probn+problamb0+probg+probimf) {
2921  // imf evaporation
2922 // AIMF and ZIMF obtained from complete procedure (integration over all
2923 // possible Gamma(IMF) and then randomly picked
2924 
2925  G4int iloop=0;
2926  dir1973:
2927  imf(af,zf,tcn,ee,&zimf,&aimf,&bimf,&sbimf,&timf,jprf);
2928  iloop++;
2929  if(iloop>100)std::cout << "Problem in EVAPORA: IMF called > 100 times" << std::endl;
2930  if(zimf>=(zf-2.0)) goto dir1973;
2931  if(zimf>zf/2.0){
2932  zimf = zf - zimf;
2933  aimf = af - aimf;
2934  }
2935  // These cases should in principle never happen
2936  if(zimf==0.0 || aimf==0.0 || sbimf>ee)std::cout << "warning: Look in EVAPORA CALL IMF" << std::endl;
2937 
2938 // I sample the total kinetic energy consumed by the system of two nuclei
2939 // from the distribution determined with the temperature at saddle point
2940 // TKEIMF is the kinetic energy in the centre of mass of IMF and its partner
2941 
2942  G4int ii=0;
2943  dir1235:
2944  tkeimf= fmaxhaz(timf);
2945  ii++;
2946  if(ii>100){
2947  tkeimf=min(2.0*timf,ee-sbimf);
2948  goto dir1000;
2949  }
2950  if(tkeimf<=0.0)goto dir1235;
2951  if(tkeimf>(ee-sbimf) && timf>0.5)goto dir1235;
2952  dir1000:
2953  tkeimf = tkeimf + bimf;
2954 
2955  amoins = aimf;
2956  zmoins = zimf;
2957  epsiln = (sbimf-bimf) + tkeimf;
2958  pc = 0.0;
2959  malpha = 0.0;
2960  fgamma = 0;
2961  fimf = 1;
2962  ff = 0;
2963  flamb0decay = 0;
2964  gammadecay = 0;
2965  }
2966  else {
2967  // fission
2968  // in case of fission-events the fragment nucleus is the mother nucleus
2969  // before fission occurs with excitation energy above the fis.- barrier.
2970  // fission fragment mass distribution is calulated in subroutine fisdis
2971 
2972  amoins = 0.0;
2973  zmoins = 0.0;
2974  epsiln = ef;
2975 //
2976  malpha = 0.0;
2977  pc = 0.0;
2978  ff = 1;
2979  fimf = 0;
2980  fgamma = 0;
2981  flamb0decay = 0;
2982  gammadecay = 0;
2983  }
2984 //
2985  direct99:
2986  if (ee <= 0.01)ee = 0.01;
2987 // Davide Mancusi (DM) - 2010
2988  if(gammadecay==1 && ee<(epsiln+0.010)){
2989  epsiln = ee - 0.010;
2990  // fgamma = 1;
2991  }
2992 
2993  if(epsiln<0.0){
2994  std::cout << "***WARNING epsilon<0***" << std::endl;
2995  //epsiln=0.;
2996  //PRINT*,IDECAYMODE,IDNINT(AF),IDNINT(ZF),EE,EPSILN
2997  }
2998  // calculation of the daughter nucleus
2999  af = af - amoins;
3000  zf = zf - zmoins;
3001  ee = ee - epsiln;
3002  if (ee <= 0.01)ee = 0.01;
3003  mtota = mtota + malpha;
3004 
3005 
3006  //if(amoins==2 && zmoins==0)std::cout << ee << std::endl;
3007 
3008 
3009  secondneutron:
3010  if(amoins==2 && zmoins==0){twon=1;amoins=1;}else{ twon=0;}
3011 
3012 
3013 // Determination of x,y,z components of momentum from known emission momentum PC
3014  if(ff==0 && fimf==0){
3015  //
3016  if(flamb0decay==1){
3017  EV_TEMP[IEV_TAB_TEMP][0] = 0.;
3018  EV_TEMP[IEV_TAB_TEMP][1] = -2;
3019  EV_TEMP[IEV_TAB_TEMP][5] = 1.;
3020  }else{
3021  EV_TEMP[IEV_TAB_TEMP][0] = zmoins;
3022  EV_TEMP[IEV_TAB_TEMP][1] = amoins;
3023  EV_TEMP[IEV_TAB_TEMP][5] = 0.;
3024  }
3025  rnd = G4AblaRandom::flat();
3026  ctet1 = 2.0*rnd - 1.0; // z component: uniform probability between -1 and 1
3027  stet1 = std::sqrt(1.0 - std::pow(ctet1,2)); // component perpendicular to z
3028  rnd = G4AblaRandom::flat();
3029  phi1 = rnd*2.0*3.141592654; // angle in x-y plane: uniform probability between 0 and 2*pi
3030  G4double xcv = stet1*std::cos(phi1);// x component
3031  G4double ycv = stet1*std::sin(phi1);// y component
3032  G4double zcv = ctet1; // z component
3033 // In the CM system
3034  if(gammadecay==0){
3035 // Light particle
3036  G4double ETOT_LP = std::sqrt(pc*pc + amoins*amoins * mu2);
3037  if(flamb0decay==1)ETOT_LP = std::sqrt(pc*pc + 1115.683*1115.683);
3038  EV_TEMP[IEV_TAB_TEMP][2] = c * pc * xcv / ETOT_LP;
3039  EV_TEMP[IEV_TAB_TEMP][3] = c * pc * ycv / ETOT_LP;
3040  EV_TEMP[IEV_TAB_TEMP][4] = c * pc * zcv / ETOT_LP;
3041  }else{
3042 // gamma ray
3043  EV_TEMP[IEV_TAB_TEMP][2] = pc * xcv;
3044  EV_TEMP[IEV_TAB_TEMP][3] = pc * ycv;
3045  EV_TEMP[IEV_TAB_TEMP][4] = pc * zcv;
3046  }
3047  G4double VXOUT=0.,VYOUT=0.,VZOUT=0.;
3048  lorentz_boost(vxeva,vyeva,vleva,
3049  EV_TEMP[IEV_TAB_TEMP][2],EV_TEMP[IEV_TAB_TEMP][3],
3050  EV_TEMP[IEV_TAB_TEMP][4],
3051  &VXOUT,&VYOUT,&VZOUT);
3052  EV_TEMP[IEV_TAB_TEMP][2] = VXOUT;
3053  EV_TEMP[IEV_TAB_TEMP][3] = VYOUT;
3054  EV_TEMP[IEV_TAB_TEMP][4] = VZOUT;
3055 // Heavy residue
3056  if(gammadecay==0){
3057  G4double v2 = std::pow(EV_TEMP[IEV_TAB_TEMP][2],2.) +
3058  std::pow(EV_TEMP[IEV_TAB_TEMP][3],2.) +
3059  std::pow(EV_TEMP[IEV_TAB_TEMP][4],2.);
3060  G4double gamma = 1.0/std::sqrt(1.0 - v2 / (c*c));
3061  G4double etot_lp = amoins*mu * gamma;
3062  pxeva = pxeva - EV_TEMP[IEV_TAB_TEMP][2] * etot_lp / c;
3063  pyeva = pyeva - EV_TEMP[IEV_TAB_TEMP][3] * etot_lp / c;
3064  pleva = pleva - EV_TEMP[IEV_TAB_TEMP][4] * etot_lp / c;
3065  }else{
3066 // in case of gammas, EV_TEMP contains momentum components and not velocity
3067  pxeva = pxeva - EV_TEMP[IEV_TAB_TEMP][2];
3068  pyeva = pyeva - EV_TEMP[IEV_TAB_TEMP][3];
3069  pleva = pleva - EV_TEMP[IEV_TAB_TEMP][4];
3070  }
3071  G4double pteva = std::sqrt(pxeva*pxeva + pyeva*pyeva);
3072 // To be checked:
3073  G4double etot = std::sqrt ( pleva*pleva + pteva*pteva + af*af * mu2 );
3074  vxeva = c * pxeva / etot; // recoil velocity components of residue due to evaporation
3075  vyeva = c * pyeva / etot;
3076  vleva = c * pleva / etot;
3077  IEV_TAB_TEMP = IEV_TAB_TEMP + 1;
3078  }
3079 
3080  if(twon==1){goto secondneutron;}
3081 
3082  // condition for end of evaporation
3083  if (zf < 3. || (ff == 1) || (fgamma == 1) || (fimf==1)) {
3084  goto evapora100;
3085  }
3086  goto evapora10;
3087 
3088  evapora100:
3089  (*zf_par) = zf;
3090  (*af_par) = af;
3091  (*ee_par) = ee;
3092  (*faimf) = aimf;
3093  (*fzimf) = zimf;
3094  (*jprfout) = jprf;
3095  (*tkeimf_par) = tkeimf;
3096  (*mtota_par) = mtota;
3097  (*vleva_par) = vleva;
3098  (*vxeva_par) = vxeva;
3099  (*vyeva_par) = vyeva;
3100  (*ff_par) = ff;
3101  (*fimf_par) = fimf;
3102  (*inttype_par) = inttype;
3103  (*iev_tab_temp_par)= IEV_TAB_TEMP;
3104  (*inum_par) = inum;
3105  (*NbLam0_par) = NbLam0;
3106  return;
3107 }
3108 
3109 void 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)
3110 {
3111  G4double probp = (*probp_par);
3112  G4double probd = (*probd_par);
3113  G4double probt = (*probt_par);
3114  G4double probn = (*probn_par);
3115  G4double probhe = (*probhe_par);
3116  G4double proba = (*proba_par);
3117  G4double probg = (*probg_par);
3118  G4double probimf = (*probimf_par);
3119  G4double probf = (*probf_par);
3120  G4double problamb0 = (*problamb0_par);
3121  G4double ptotl = (*ptotl_par);
3122  G4double sn = (*sn_par);
3123  G4double sp = (*sp_par);
3124  G4double sd = (*sd_par);
3125  G4double st = (*st_par);
3126  G4double she = (*she_par);
3127  G4double sa = (*sa_par);
3128  G4double slamb0 = 0.0;
3129  G4double sbp = (*sbp_par);
3130  G4double sbd = (*sbd_par);
3131  G4double sbt = (*sbt_par);
3132  G4double sbhe = (*sbhe_par);
3133  G4double sba = (*sba_par);
3134  G4double ecn = (*ecn_par);
3135  G4double ecp = (*ecp_par);
3136  G4double ecd = (*ecd_par);
3137  G4double ect = (*ect_par);
3138  G4double eche = (*eche_par);
3139  G4double eca = (*eca_par);
3140  G4double ecg = (*ecg_par);
3141  G4double eclamb0 = (*eclamb0_par);
3142  G4double bp = (*bp_par);
3143  G4double bd = (*bd_par);
3144  G4double bt = (*bt_par);
3145  G4double bhe = (*bhe_par);
3146  G4double ba = (*ba_par);
3147  G4double tsum = (*tsum_par);
3148 
3149  // CALCULATION OF PARTICLE-EMISSION PROBABILITIES & FISSION /
3150  // BASED ON THE SIMPLIFIED FORMULAS FOR THE DECAY WIDTH BY /
3151  // MORETTO, ROCHESTER MEETING TO AVOID COMPUTING TIME /
3152  // INTENSIVE INTEGRATION OF THE LEVEL DENSITIES /
3153  // USES EFFECTIVE COULOMB BARRIERS AND AN AVERAGE KINETIC ENERGY/
3154  // OF THE EVAPORATED PARTICLES /
3155  // COLLECTIVE ENHANCMENT OF THE LEVEL DENSITY IS INCLUDED /
3156  // DYNAMICAL HINDRANCE OF FISSION IS INCLUDED BY A STEP FUNCTION/
3157  // APPROXIMATION. SEE A.R. JUNGHANS DIPLOMA THESIS /
3158  // SHELL AND PAIRING STRUCTURES IN THE LEVEL DENSITY IS INCLUDED/
3159 
3160  // INPUT:
3161  // ZPRF,A,EE CHARGE, MASS, EXCITATION ENERGY OF COMPOUND
3162  // NUCLEUS
3163  // JPRF ROOT-MEAN-SQUARED ANGULAR MOMENTUM
3164 
3165  // DEFORMATIONS AND G.S. SHELL EFFECTS
3166  // COMMON /ECLD/ ECGNZ,ECFNZ,VGSLD,ALPHA
3167 
3168  // ECGNZ - GROUND STATE SHELL CORR. FRLDM FOR A SPHERICAL G.S.
3169  // ECFNZ - SHELL CORRECTION FOR THE SADDLE POINT (NOW: == 0)
3170  // VGSLD - DIFFERENCE BETWEEN DEFORMED G.S. AND LDM VALUE
3171  // ALPHA - ALPHA GROUND STATE DEFORMATION (THIS IS NOT BETA2!)
3172  // BETA2 = SQRT((4PI)/5) * ALPHA
3173 
3174  //OPTIONS AND PARAMETERS FOR FISSION CHANNEL
3175  //COMMON /FISS/ AKAP,BET,HOMEGA,KOEFF,IFIS,
3176  // OPTSHP,OPTXFIS,OPTLES,OPTCOL
3177  //
3178  // AKAP - HBAR**2/(2* MN * R_0**2) = 10 MEV, R_0 = 1.4 FM
3179  // BET - REDUCED NUCLEAR FRICTION COEFFICIENT IN (10**21 S**-1)
3180  // HOMEGA - CURVATURE OF THE FISSION BARRIER = 1 MEV
3181  // KOEFF - COEFFICIENT FOR THE LD FISSION BARRIER == 1.0
3182  // IFIS - 0/1 FISSION CHANNEL OFF/ON
3183  // OPTSHP - INTEGER SWITCH FOR SHELL CORRECTION IN MASSES/ENERGY
3184  // = 0 NO MICROSCOPIC CORRECTIONS IN MASSES AND ENERGY
3185  // = 1 SHELL , NO PAIRING
3186  // = 2 PAIRING, NO SHELL
3187  // = 3 SHELL AND PAIRING
3188  // OPTCOL - 0/1 COLLECTIVE ENHANCEMENT SWITCHED ON/OFF
3189  // OPTXFIS- 0,1,2 FOR MYERS & SWIATECKI, DAHLINGER, ANDREYEV
3190  // FISSILITY PARAMETER.
3191  // OPTLES - CONSTANT TEMPERATURE LEVEL DENSITY FOR A,Z > TH-224
3192  // OPTCOL - 0/1 COLLECTIVE ENHANCEMENT OFF/ON
3193 
3194  // LEVEL DENSITY PARAMETERS
3195  // COMMON /ALD/ AV,AS,AK,OPTAFAN
3196  // AV,AS,AK - VOLUME,SURFACE,CURVATURE DEPENDENCE OF THE
3197  // LEVEL DENSITY PARAMETER
3198  // OPTAFAN - 0/1 AF/AN >=1 OR AF/AN ==1
3199  // RECOMMENDED IS OPTAFAN = 0
3200 
3201  // FISSION BARRIERS
3202  // COMMON /FB/ EFA
3203  // EFA - ARRAY OF FISSION BARRIERS
3204 
3205 
3206  // OUTPUT: PROBN,PROBP,PROBA,PROBF,PTOTL:
3207  // - EMISSION PROBABILITIES FOR N EUTRON, P ROTON, A LPHA
3208  // PARTICLES, F ISSION AND NORMALISATION
3209  // SN,SBP,SBA: SEPARATION ENERGIES N P A
3210  // INCLUDING EFFECTIVE BARRIERS
3211  // ECN,ECP,ECA,BP,BA
3212  // - AVERAGE KINETIC ENERGIES (2*T) AND EFFECTIVE BARRIERS
3213 
3214  G4double bk = 0.0;
3215  G4double bksp = 0.0;
3216  G4double bc = 0.0;
3217  G4int afp = 0;
3218  G4double het = 0.0;
3219  G4double at = 0.0;
3220  G4double bs = 0.0;
3221  G4double bssp = 0.0;
3222  G4double bshell = 0.0;
3223  G4double cf = 0.0;
3224  G4double defbet = 0.0;
3225  G4double densa = 0.0;
3226  G4double denshe = 0.0;
3227  G4double densg = 0.0;
3228  G4double densn = 0.0;
3229  G4double densp = 0.0;
3230  G4double densd = 0.0;
3231  G4double denst = 0.0;
3232  G4double denslamb0 = 0.0;
3233  G4double eer = 0.0;
3234  G4double ecor = 0.0;
3235  G4double ef = 0.0;
3236  G4double ft = 0.0;
3237  G4double timf = 0.0;
3238  G4double qr = 0.0;
3239  G4double qrcn = 0.0;
3240  G4double omegap=0.0;
3241  G4double omegad=0.0;
3242  G4double omegat=0.0;
3243  G4double omegahe=0.0;
3244  G4double omegaa=0.0;
3245  G4double ga = 0.0;
3246  G4double ghe = 0.0;
3247  G4double gf = 0.0;
3248  G4double gff = 0.0;
3249  G4double gn = 0.0;
3250  G4double gp = 0.0;
3251  G4double gd = 0.0;
3252  G4double gt = 0.0;
3253  G4double gg = 0.0;
3254  G4double glamb0 = 0.0;
3255  G4double gimf = 0.0;
3256  G4double gimf3 = 0.0;
3257  G4double gimf5 = 0.0;
3258  G4double bimf = 0.0;
3259  G4double bsimf = 0.0;
3260  G4double sbimf = 0.0;
3261  G4double densimf = 0.0;
3262  G4double defbetimf = 0.0;
3263  G4double b_imf = 0.0;
3264  G4double a_imf = 0.0;
3265  G4double omegaimf = 0.0;
3266  G4int izimf = 0;
3267  G4double zimf = 0.0;
3268  G4double gsum = 0.0;
3269  G4double gtotal=0.0;
3270  G4double hbar = 6.582122e-22;
3271  G4double emin = 0.0;
3272  G4int il = 0;
3273  G4int choice_fisspart = 0;
3274  G4double t_lapse=0.0;
3275  G4int imaxwell = 0;
3276  G4int in = 0;
3277  G4int iz = 0;
3278  G4int ind = 0;
3279  G4int izd = 0;
3280  G4int j = 0;
3281  G4int k = 0;
3282  G4double ma1z = 0.0;
3283  G4double mazz = 0.0;
3284  G4double ma2z = 0.0;
3285  G4double ma1z1 = 0.0;
3286  G4double ma2z1 = 0.0;
3287  G4double ma3z1 = 0.0;
3288  G4double ma3z2 = 0.0;
3289  G4double ma4z2 = 0.0;
3290  G4double maz = 0.0;
3291  G4double nt = 0.0;
3292  G4double pi = 3.1415926535;
3293  G4double pt = 0.0;
3294  G4double dt = 0.0;
3295  G4double tt = 0.0;
3296  G4double lamb0t = 0.0;
3297  G4double gtemp = 0.0;
3298  G4double rdt = 0.0;
3299  G4double rtt = 0.0;
3300  G4double rat = 0.0;
3301  G4double rhet = 0.0;
3302  G4double refmod = 0.0;
3303  G4double rnt = 0.0;
3304  G4double rpt = 0.0;
3305  G4double rlamb0t = 0.0;
3306  G4double sbfis = 1.e40;
3307  G4double segs = 0.0;
3308  G4double selmax = 0.0;
3309  G4double tauc = 0.0;
3310  G4double temp = 0.0;
3311  G4double ts1 = 0.0;
3312  G4double xx = 0.0;
3313  G4double y = 0.0;
3314  G4double k1 = 0.0;
3315  G4double omegasp=0.0;
3316  G4double homegasp=0.0;
3317  G4double omegags=0.0;
3318  G4double homegags=0.0;
3319  G4double pa = 0.0;
3320  G4double gamma = 0.0;
3321  G4double gfactor = 0.0;
3322  G4double bscn;
3323  G4double bkcn;
3324  G4double bccn;
3325  G4double ftcn=0.0;
3326  G4double mfcd;
3327  G4double jprfn=jprf;
3328  G4double jprfp=jprf;
3329  G4double jprfd=jprf;
3330  G4double jprft=jprf;
3331  G4double jprfhe=jprf;
3332  G4double jprfa=jprf;
3333  G4double jprflamb0=jprf;
3334  G4double djprf=0.0;
3335  G4double dlout=0.0;
3336  G4double sdlout=0.0;
3337  G4double iinert=0.0;
3338  G4double erot=0.0;
3339  G4double erotn=0.0;
3340  G4double erotp=0.0;
3341  G4double erotd=0.0;
3342  G4double erott=0.0;
3343  G4double erothe=0.0;
3344  G4double erota=0.0;
3345  G4double erotlamb0=0.0;
3346  G4double erotcn=0.0;
3347  // G4double ecorcn=0.0;
3348  G4double imfarg=0.0;
3349  G4double width_imf=0.0;
3350  G4int IDjprf=0;
3351  G4int fimf_allowed=opt->optimfallowed;
3352 
3353  if(itest==1){
3354 
3355  }
3356  // Switch to calculate Maxwellian distribution of kinetic energies
3357  imaxwell = 1;
3358  *sortie = 0;
3359 
3360  // just a change of name until the end of this subroutine
3361  eer = ee;
3362  if (inum == 1) {
3363  ilast = 1;
3364  }
3365  // calculation of masses
3366  // refmod = 1 ==> myers,swiatecki model
3367  // refmod = 0 ==> weizsaecker model
3368  refmod = 1; // Default = 1
3369 //
3370  if (refmod == 1) {
3371  mglms(a,zprf,fiss->optshp,&maz);
3372  mglms(a-1.0,zprf,fiss->optshp,&ma1z);
3373  mglms(a-2.0,zprf,fiss->optshp,&ma2z);
3374  mglms(a-1.0,zprf-1.0,fiss->optshp,&ma1z1);
3375  mglms(a-2.0,zprf-1.0,fiss->optshp,&ma2z1);
3376  mglms(a-3.0,zprf-1.0,fiss->optshp,&ma3z1);
3377  mglms(a-3.0,zprf-2.0,fiss->optshp,&ma3z2);
3378  mglms(a-4.0,zprf-2.0,fiss->optshp,&ma4z2);
3379  }
3380  else {
3381  mglw(a,zprf,&maz);
3382  mglw(a-1.0,zprf,&ma1z);
3383  mglw(a-1.0,zprf-1.0,&ma1z1);
3384  mglw(a-2.0,zprf-1.0,&ma2z1);
3385  mglw(a-3.0,zprf-1.0,&ma3z1);
3386  mglw(a-3.0,zprf-2.0,&ma3z2);
3387  mglw(a-4.0,zprf-2.0,&ma4z2);
3388  }
3389 
3390  if((a-1.)==3.0 && (zprf-1.0)==2.0) ma1z1=-7.7181660;
3391  if((a-1.)==4.0 && (zprf-1.0)==2.0) ma1z1=-28.295992;
3392 
3393  // separation energies
3394  sn = ma1z - maz;
3395  sp = ma1z1 - maz;
3396  sd = ma2z1 - maz - 2.2246;
3397  st = ma3z1 - maz - 8.481977;
3398  she = ma3z2 - maz - 7.7181660;
3399  sa = ma4z2 - maz - 28.295992;
3400  //
3401  if(NbLam0>1){
3402  sn = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-1.,zprf,NbLam0);
3403  sp = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-1.,zprf-1.,NbLam0);
3404  sd = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-2.,zprf-1.,NbLam0);
3405  st = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-3.,zprf-1.,NbLam0);
3406  she = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-3.,zprf-2.,NbLam0);
3407  sa = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-4.,zprf-2.,NbLam0);
3408  slamb0 = gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-1.,zprf,NbLam0-1);
3409  }
3410  if(NbLam0==1){
3411  G4double deltasn = sn - (gethyperbinding(a,zprf,0)-gethyperbinding(a-1.,zprf,0));
3412  G4double deltasp = sp - (gethyperbinding(a,zprf,0)-gethyperbinding(a-1.,zprf-1,0));
3413  G4double deltasd = sd - (gethyperbinding(a,zprf,0)-gethyperbinding(a-2.,zprf-1,0));
3414  G4double deltast = st - (gethyperbinding(a,zprf,0)-gethyperbinding(a-3.,zprf-1,0));
3415  G4double deltashe = she - (gethyperbinding(a,zprf,0)-gethyperbinding(a-3.,zprf-2,0));
3416  G4double deltasa = sa - (gethyperbinding(a,zprf,0)-gethyperbinding(a-4.,zprf-2,0));
3417 
3418  sn = deltasn + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-1.,zprf,NbLam0);
3419  sp = deltasp + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-1.,zprf-1.,NbLam0);
3420  sd = deltasd + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-2.,zprf-1.,NbLam0);
3421  st = deltast + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-3.,zprf-1.,NbLam0);
3422  she = deltashe + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-3.,zprf-2.,NbLam0);
3423  sa = deltasa + gethyperbinding(a,zprf,NbLam0)-gethyperbinding(a-4.,zprf-2.,NbLam0);
3424  slamb0 = gethyperseparation(a,zprf,NbLam0);
3425  }
3426 
3427 // coulomb barriers
3428 //Proton
3429  if (zprf <= 1.0e0 || a <= 1.0e0 || (a-zprf) < 0.0) {
3430  sbp = 1.0e75;
3431  bp = 1.0e75;
3432  }else{
3433  barrs(idnint(zprf-1.),idnint(a-1.),1,1,&bp,&omegap);
3434  bp = max(bp,0.1);
3435  sbp = sp + bp;
3436  }
3437 
3438 //Deuteron
3439  if (zprf <= 1.0e0 || a <= 2.0e0 || (a-zprf) < 1.0) {
3440  sbd = 1.0e75;
3441  bd = 1.0e75;
3442  }else{
3443  barrs(idnint(zprf-1.),idnint(a-2.),1,2,&bd,&omegad);
3444  bd = max(bd,0.1);
3445  sbd = sd + bd;
3446  }
3447 
3448 //Triton
3449  if (zprf <= 1.0e0 || a <= 3.0e0 || (a-zprf) < 2.0) {
3450  sbt = 1.0e75;
3451  bt = 1.0e75;
3452  }else{
3453  barrs(idnint(zprf-1.),idnint(a-3.),1,3,&bt,&omegat);
3454  bt = max(bt,0.1);
3455  sbt = st + bt;
3456  }
3457 
3458 //Alpha
3459  if (a-4.0<=0.0 || zprf<=2.0 || (a-zprf)<2.0) {
3460  sba = 1.0e+75;
3461  ba = 1.0e+75;
3462  }else{
3463  barrs(idnint(zprf-2.),idnint(a-4.),2,4,&ba,&omegaa);
3464  ba = max(ba,0.1);
3465  sba = sa + ba;
3466  }
3467 
3468 //He3
3469  if (a-3.0 <= 0.0 || zprf<=2.0 || (a-zprf)<1.0) {
3470  sbhe = 1.0e+75;
3471  bhe = 1.0e+75;
3472  }else{
3473  barrs(idnint(zprf-2.),idnint(a-3.),2,3,&bhe,&omegahe);
3474  bhe = max(bhe,0.1);
3475  sbhe = she + bhe;
3476  }
3477 
3478 // Dealing with particle-unbound systems
3479  emin = dmin1(sba,sbhe,dmin1(sbt,sbhe,dmin1(sn,sbp,sbd)));
3480 
3481  if(emin<=0.0){
3482  *sortie = 1;
3483  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);
3484  goto direct70;
3485  }
3486 //
3487  k = idnint(zprf);
3488  j = idnint(a - zprf);
3489  if (fiss->ifis > 0) {
3490  // now ef is calculated from efa that depends on the subroutine
3491  // barfit which takes into account the modification on the ang. mom.
3492  // note *** shell correction (ecgnz)
3493  il = idnint(jprf);
3494  barfit(k,k+j,il,&sbfis,&segs,&selmax);
3495  if ((fiss->optshp == 1) || (fiss->optshp == 3)) {
3496  ef = G4double(sbfis) - ecld->ecgnz[j][k];
3497 // JLRS - Nov 2016 - Corrected values of fission barriers for actinides
3498  if(k==90){
3499  if(mod(j,2)==1){
3500  ef = ef*(4.5114-2.2687*(a-zprf)/zprf);
3501  }else{
3502  ef = ef*(3.3931-1.5338*(a-zprf)/zprf);
3503  }
3504  }
3505  if(k==92){
3506  if((a-zprf)/zprf>1.52)ef=ef*(1.1222-0.10886*(a-zprf)/zprf)-0.1;
3507  }
3508  if(k>=94&&k<=98&&j<158){// Data in this range have been tested
3509 // e-e
3510  if(mod(j,2)==0&&mod(k,2)==0){
3511  if(k>=94){ef = ef-(11.54108*(a-zprf)/zprf-18.074);}
3512  }
3513 // O-O
3514  if(mod(j,2)==1&&mod(k,2)==1){
3515  if(k>=95){ef = ef-(14.567*(a-zprf)/zprf-23.266);}
3516  }
3517 // Odd A
3518  if(mod(j,2)==0&&mod(k,2)==1){
3519  if(j>=144){ef = ef-(13.662*(a-zprf)/zprf-21.656);}
3520  }
3521 
3522  if(mod(j,2)==1&&mod(k,2)==0){
3523  if(j>=144){ef = ef-(13.662*(a-zprf)/zprf-21.656);}
3524  }
3525  }
3526  }
3527  else {
3528  ef = G4double(sbfis);
3529  }
3530 //
3531 // TO AVOID NEGATIVE VALUES FOR IMPOSSIBLE NUCLEI
3532 // THE FISSION BARRIER IS SET TO ZERO IF SMALLER THAN ZERO.
3533 //
3534  if (ef < 0.0)ef = 0.0;
3535  fb->efa[j][k]=ef;
3536 //
3537 // Hyper-fission barrier
3538 //
3539  if(NbLam0>0){
3540  ef = ef + 0.51*(1115.-938.+sn-slamb0)/std::pow(a,2./3.);
3541  }
3542 //
3543 // Set fission barrier
3544 //
3545  (*ef_par) = ef;
3546 //
3547  // calculation of surface and curvature integrals needed to
3548  // to calculate the level density parameter at the saddle point
3549  xx = fissility((k+j),k,NbLam0,sn,slamb0,fiss->optxfis);
3550  y = 1.00 - xx;
3551  if(y<0.0) y = 0.0;
3552  if(y>1.0) y = 1.0;
3553  bssp = bipol(1,y);
3554  bksp = bipol(2,y);
3555  }
3556  else {
3557  ef = 1.0e40;
3558  sbfis = 1.0e40;
3559  bssp = 1.0;
3560  bksp = 1.0;
3561  }
3562 //
3563 // COMPOUND NUCLEUS LEVEL DENSITY
3564 //
3565 // AK 2007 - Now DENSNIV called with correct BS, BK
3566 
3567  afp = idnint(a);
3568  iz = idnint(zprf);
3569  in = afp - iz;
3570  bshell = ecld->ecgnz[in][iz]- ecld->vgsld[in][iz];
3571  defbet = ecld->beta2[in][iz];
3572 
3573  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);
3574  erot = jprf * jprf * 197.328 * 197.328 /(2. * iinert);
3575  erotcn = erot;
3576 
3577  bsbkbc(a,zprf,&bscn,&bkcn,&bccn);
3578 
3579  // if(ee > erot+emin){
3580  densniv(a,zprf,ee,0.0,&densg,bshell,bscn,bkcn,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprf,0,&qrcn);
3581  ftcn = temp;
3582 /*
3583  //ecorcn = ecor;
3584  }else{
3585 // If EE < EROT, only gamma emission can take place
3586  probf = 0.0;
3587  probp = 0.0;
3588  probd = 0.0;
3589  probt = 0.0;
3590  probn = 0.0;
3591  probhe = 0.0;
3592  proba = 0.0;
3593  probg = 1.0;
3594  probimf = 0.0;
3595 //c JLRS 03/2017 - Added this calculation
3596 //C According to A. Ignatyuk, GG :
3597 //C Here BS=BK=1, as this was assumed in the parameterization
3598  pa = (ald->av)*a + (ald->as)*std::pow(a,2./3.) + (ald->ak)*std::pow(a,1./3.);
3599  gamma = 2.5 * pa * std::pow(a,-4./3.);
3600  gfactor = 1.+gamma*ecld->ecgnz[in][iz];
3601  if(gfactor<=0.){
3602  gfactor = 0.0;
3603  }
3604 //
3605  gtemp = 17.60/(std::pow(a,0.699) * std::sqrt(gfactor));
3606  ecg = 4.0 * gtemp;
3607 //
3608  goto direct70;
3609  }
3610 */
3611 
3612 // ---------------------------------------------------------------
3613 // LEVEL DENSITIES AND TEMPERATURES OF THE FINAL STATES
3614 // ---------------------------------------------------------------
3615 //
3616 // MVR - in case of charged particle emission temperature
3617 // comes from random kinetic energy from a Maxwelliam distribution
3618 // if option imaxwell = 1 (otherwise E=2T)
3619 //
3620 // AK - LEVEL DENSITY AND TEMPERATURE AT THE SADDLE POINT -> now calculated in the subroutine FISSION_WIDTH
3621 //
3622 //
3623 // LEVEL DENSITY AND TEMPERATURE IN THE NEUTRON DAUGHTER
3624 //
3625 // KHS, AK 2007 - Reduction of angular momentum due to orbital angular momentum of emitted fragment
3626 // JLRS Nov-2016 - Added these caculations in abla++
3627 
3628  if (in >= 2) {
3629  ind=idnint(a)-idnint(zprf)-1;
3630  izd=idnint(zprf);
3631  if(jprf>0.10){
3632  lorb(a,a-1.,jprf,ee-sn,&dlout,&sdlout);
3633  djprf = gausshaz(1,dlout,sdlout);
3634  if(IDjprf==1) djprf = 0.0;
3635  jprfn = jprf + djprf;
3636  jprfn = dint(std::abs(jprfn)); // The nucleus just turns the other way around
3637  }
3638  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3639  defbet = ecld->beta2[ind][izd];
3640 
3641  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);
3642  erotn = jprfn * jprfn * 197.328 * 197.328 /(2. * iinert);
3643  bsbkbc(a-1.,zprf,&bs,&bk,&bc);
3644 
3645  // level density and temperature in the neutron daughter
3646  densniv(a-1.0,zprf,ee,sn,&densn,bshell, bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfn,0,&qr);
3647  nt = temp;
3648  ecn=0.0;
3649  if(densn>0.){
3650  G4int IS=0;
3651  if(imaxwell == 1){
3652  rnt = nt;
3653  dir1234:
3654  ecn=fvmaxhaz_neut(rnt);
3655  IS++;
3656  if(IS>100){std::cout << "WARNING: FVMAXHAZ_NEUT CALLED MORE THAN 100 TIMES" << std::endl;
3657  goto exi1000;
3658  }
3659  if(ecn>(ee-sn)){
3660  if((ee-sn)<rnt)
3661  ecn = ee-sn;
3662  else
3663  goto dir1234;
3664  }
3665  if(ecn<=0.0) goto dir1234;
3666  }else{
3667  ecn = 2.0 * nt;
3668  }
3669  }
3670  }
3671  else {
3672  densn = 0.0;
3673  ecn = 0.0;
3674  nt = 0.0;
3675  }
3676  exi1000:
3677 
3678 // LEVEL DENSITY AND TEMPERATURE IN THE PROTON DAUGHTER
3679 //
3680 // Reduction of angular momentum due to orbital angular momentum of emitted fragment
3681  if (iz >= 2) {
3682  ind=idnint(a)-idnint(zprf);
3683  izd=idnint(zprf)-1;
3684  if(jprf>0.10){
3685  lorb(a,a-1.,jprf,ee-sbp,&dlout,&sdlout);
3686  djprf = gausshaz(1,dlout,sdlout);
3687  if(IDjprf==1) djprf = 0.0;
3688  jprfp = jprf + djprf;
3689  jprfp = dint(std::abs(jprfp)); // The nucleus just turns the other way around
3690  }
3691  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3692  defbet =ecld->beta2[ind][izd];
3693 
3694  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);
3695  erotp = jprfp * jprfp * 197.328 * 197.328 /(2. * iinert);
3696 
3697  bsbkbc(a-1.,zprf-1.,&bs,&bk,&bc);
3698 
3699  // level density and temperature in the proton daughter
3700  densniv(a-1.0,zprf-1.0,ee,sbp,&densp,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfp,0,&qr);
3701  pt = temp;
3702  ecp = 0.;
3703  if(densp>0.){
3704  G4int IS=0;
3705  if(imaxwell == 1){
3706  rpt = pt;
3707  dir1235:
3708  ecp=fvmaxhaz(rpt);
3709  IS++;
3710  if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3711  goto exi1001;
3712  }
3713  if(ecp>(ee-sbp)){
3714  if((ee-sbp)<rpt)
3715  ecp = ee-sbp;
3716  else
3717  goto dir1235;
3718  }
3719  if(ecp<=0.0) goto dir1235;
3720  ecp = ecp + bp;
3721  }else{
3722  ecp = 2.0 * pt + bp;
3723  }
3724  }
3725  }
3726  else {
3727  densp = 0.0;
3728  ecp = 0.0;
3729  pt = 0.0;
3730  }
3731  exi1001:
3732 
3733 // FINAL LEVEL DENSITY AND TEMPERATURE AFTER DEUTERON EMISSION
3734 //
3735 // Reduction of angular momentum due to orbital angular momentum of emitted fragment
3736  if ((in >= 2) && (iz >= 2)) {
3737  ind=idnint(a)-idnint(zprf)-1;
3738  izd=idnint(zprf)-1;
3739  if(jprf>0.10){
3740  lorb(a,a-2.,jprf,ee-sbd,&dlout,&sdlout);
3741  djprf = gausshaz(1,dlout,sdlout);
3742  if(IDjprf==1) djprf = 0.0;
3743  jprfd = jprf + djprf;
3744  jprfd = dint(std::abs(jprfd)); // The nucleus just turns the other way around
3745  }
3746  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3747  defbet = ecld->beta2[ind][izd];
3748 
3749  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);
3750  erotd = jprfd * jprfd * 197.328 * 197.328 /(2. * iinert);
3751 
3752  bsbkbc(a-2.,zprf-1.,&bs,&bk,&bc);
3753 
3754  // level density and temperature in the deuteron daughter
3755  densniv(a-2.0,zprf-1.0e0,ee,sbd,&densd,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfd,0,&qr);
3756 
3757  dt = temp;
3758  ecd = 0.0;
3759  if(densd>0.){
3760  G4int IS=0;
3761  if(imaxwell == 1){
3762  rdt = dt;
3763  dir1236:
3764  ecd=fvmaxhaz(rdt);
3765  IS++;
3766  if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3767  goto exi1002;
3768  }
3769  if(ecd>(ee-sbd)){
3770  if((ee-sbd)<rdt)
3771  ecd = ee-sbd;
3772  else
3773  goto dir1236;
3774  }
3775  if(ecd<=0.0) goto dir1236;
3776  ecd = ecd + bd;
3777  }else{
3778  ecd = 2.0 * dt + bd;
3779  }
3780  }
3781  }
3782  else {
3783  densd = 0.0;
3784  ecd = 0.0;
3785  dt = 0.0;
3786  }
3787  exi1002:
3788 
3789 // FINAL LEVEL DENSITY AND TEMPERATURE AFTER TRITON EMISSION
3790 //
3791 // Reduction of angular momentum due to orbital angular momentum of emitted fragment
3792  if ((in >= 3) && (iz >= 2)) {
3793  ind=idnint(a)-idnint(zprf)-2;
3794  izd=idnint(zprf)-1;
3795  if(jprf>0.10){
3796  lorb(a,a-3.,jprf,ee-sbt,&dlout,&sdlout);
3797  djprf = gausshaz(1,dlout,sdlout);
3798  if(IDjprf==1) djprf = 0.0;
3799  jprft = jprf + djprf;
3800  jprft = dint(std::abs(jprft)); // The nucleus just turns the other way around
3801  }
3802  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3803  defbet = ecld->beta2[ind][izd];
3804 
3805  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);
3806  erott = jprft * jprft * 197.328 * 197.328 /(2. * iinert);
3807 
3808  bsbkbc(a-3.,zprf-1.,&bs,&bk,&bc);
3809 
3810  // level density and temperature in the triton daughter
3811  densniv(a-3.0,zprf-1.0,ee,sbt,&denst,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprft,0,&qr);
3812 
3813  tt = temp;
3814  ect=0.;
3815  if(denst>0.){
3816  G4int IS=0;
3817  if(imaxwell == 1){
3818  rtt = tt;
3819  dir1237:
3820  ect=fvmaxhaz(rtt);
3821  IS++;
3822  if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3823  goto exi1003;
3824  }
3825  if(ect>(ee-sbt)){
3826  if((ee-sbt)<rtt)
3827  ect = ee-sbt;
3828  else
3829  goto dir1237;
3830  }
3831  if(ect<=0.0) goto dir1237;
3832  ect = ect + bt;
3833  }else{
3834  ect = 2.0 * tt + bt;
3835  }
3836  }
3837  }
3838  else {
3839  denst = 0.0;
3840  ect = 0.0;
3841  tt = 0.0;
3842  }
3843  exi1003:
3844 
3845 // LEVEL DENSITY AND TEMPERATURE IN THE ALPHA DAUGHTER
3846 //
3847 // Reduction of angular momentum due to orbital angular momentum of emitted fragment
3848  if ((in >= 3) && (iz >= 3)) {
3849  ind=idnint(a)-idnint(zprf)-2;
3850  izd=idnint(zprf)-2;
3851  if(jprf>0.10){
3852  lorb(a,a-4.,jprf,ee-sba,&dlout,&sdlout);
3853  djprf = gausshaz(1,dlout,sdlout);
3854  if(IDjprf==1) djprf = 0.0;
3855  jprfa = jprf + djprf;
3856  jprfa = dint(std::abs(jprfa)); // The nucleus just turns the other way around
3857  }
3858  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3859  defbet = ecld->beta2[ind][izd];
3860 
3861  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);
3862  erota = jprfa * jprfa * 197.328 * 197.328 /(2. * iinert);
3863 
3864  bsbkbc(a-4.,zprf-2.,&bs,&bk,&bc);
3865 
3866  // level density and temperature in the alpha daughter
3867  densniv(a-4.0,zprf-2.0,ee,sba,&densa,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfa,0,&qr);
3868 
3869  at = temp;
3870  eca = 0.0;
3871  if(densa>0.){
3872  G4int IS=0;
3873  if(imaxwell == 1){
3874  rat = at;
3875  dir1238:
3876  eca=fvmaxhaz(rat);
3877  IS++;
3878  if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3879  goto exi1004;
3880  }
3881  if(eca>(ee-sba)){
3882  if((ee-sba)<rat)
3883  eca = ee-sba;
3884  else
3885  goto dir1238;
3886  }
3887  if(eca<=0.0) goto dir1238;
3888  eca = eca + ba;
3889  }else{
3890  eca = 2.0 * at + ba;
3891  }
3892  }
3893  }
3894  else {
3895  densa = 0.0;
3896  eca = 0.0;
3897  at = 0.0;
3898  }
3899  exi1004:
3900 
3901 // FINAL LEVEL DENSITY AND TEMPERATURE AFTER 3HE EMISSION
3902 //
3903 // Reduction of angular momentum due to orbital angular momentum of emitted fragment
3904  if ((in >= 2) && (iz >= 3)) {
3905  ind=idnint(a)-idnint(zprf)-1;
3906  izd=idnint(zprf)-2;
3907  if(jprf>0.10){
3908  lorb(a,a-3.,jprf,ee-sbhe,&dlout,&sdlout);
3909  djprf = gausshaz(1,dlout,sdlout);
3910  if(IDjprf==1) djprf = 0.0;
3911  jprfhe = jprf + djprf;
3912  jprfhe = dint(std::abs(jprfhe)); // The nucleus just turns the other way around
3913  }
3914  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3915  defbet = ecld->beta2[ind][izd];
3916 
3917  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);
3918  erothe = jprfhe * jprfhe * 197.328 * 197.328 /(2. * iinert);
3919 
3920  bsbkbc(a-3.,zprf-2.,&bs,&bk,&bc);
3921 
3922  // level density and temperature in the he3 daughter
3923  densniv(a-3.0,zprf-2.0,ee,sbhe,&denshe,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfhe,0,&qr);
3924 
3925  het = temp;
3926  eche = 0.0;
3927  if(denshe>0.){
3928  G4int IS=0;
3929  if(imaxwell == 1){
3930  rhet = het;
3931  dir1239:
3932  eche=fvmaxhaz(rhet);
3933  IS++;
3934  if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3935  goto exi1005;
3936  }
3937  if(eche>(ee-sbhe)){
3938  if((ee-sbhe)<rhet)
3939  eche = ee-sbhe;
3940  else
3941  goto dir1239;
3942  }
3943  if(eche<=0.0) goto dir1239;
3944  eche = eche + bhe;
3945  }else{
3946  eche = 2.0 * het + bhe;
3947  }
3948  }
3949  }
3950  else {
3951  denshe = 0.0;
3952  eche = 0.0;
3953  het = 0.0;
3954  }
3955  exi1005:
3956 
3957 // LEVEL DENSITY AND TEMPERATURE IN THE LAMBDA0 DAUGHTER
3958 //
3959 // - Reduction of angular momentum due to orbital angular momentum of emitted fragment
3960 // JLRS Jun-2017 - Added these caculations in abla++
3961 
3962  if (in >= 2 && NbLam0>0) {
3963  ind=idnint(a)-idnint(zprf)-1;
3964  izd=idnint(zprf);
3965  if(jprf>0.10){
3966  lorb(a,a-1.,jprf,ee-slamb0,&dlout,&sdlout);
3967  djprf = gausshaz(1,dlout,sdlout);
3968  if(IDjprf==1) djprf = 0.0;
3969  jprflamb0 = jprf + djprf;
3970  jprflamb0 = dint(std::abs(jprflamb0)); // The nucleus just turns the other way around
3971  }
3972  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3973  defbet = ecld->beta2[ind][izd];
3974 
3975  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);
3976  erotlamb0 = jprflamb0 * jprflamb0 * 197.328 * 197.328 /(2. * iinert);
3977  bsbkbc(a-1.,zprf,&bs,&bk,&bc);
3978 
3979  // level density and temperature in the neutron daughter
3980  densniv(a-1.0,zprf,ee,slamb0,&denslamb0,bshell, bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprflamb0,0,&qr);
3981  lamb0t = temp;
3982  eclamb0=0.0;
3983  if(denslamb0>0.){
3984  G4int IS=0;
3985  if(imaxwell == 1){
3986  rlamb0t = lamb0t;
3987  dir1240:
3988  eclamb0=fvmaxhaz_neut(rlamb0t);
3989  IS++;
3990  if(IS>100){std::cout << "WARNING: FVMAXHAZ_NEUT CALLED MORE THAN 100 TIMES" << std::endl;
3991  goto exi1006;
3992  }
3993  if(eclamb0>(ee-slamb0)){
3994  if((ee-slamb0)<rlamb0t)
3995  eclamb0 = ee-slamb0;
3996  else
3997  goto dir1240;
3998  }
3999  if(eclamb0<=0.0) goto dir1240;
4000  }else{
4001  eclamb0 = 2.0 * lamb0t;
4002  }
4003  }
4004  }
4005  else {
4006  denslamb0 = 0.0;
4007  eclamb0 = 0.0;
4008  lamb0t = 0.0;
4009  }
4010  exi1006:
4011 
4012 
4013 
4014 // Decay widths for particles
4015  if ( densg > 0.) {
4016 //
4017 // CALCULATION OF THE PARTIAL DECAY WIDTH
4018 // USED FOR BOTH THE TIME SCALE AND THE EVAPORATION DECAY WIDTH
4019 //
4020 // AKAP = HBAR**2/(2* MN * R_0**2) = 10 MEV *** input param ***
4021 //
4022 // AK, KHS 2005 - Energy-dependen inverse cross sections included, influence of
4023 // Coulomb barrier for LCP, tunnelling for LCP
4024 // JLRS 2017 - Implementation in abla++
4025 
4026  if(densn<=0.0){
4027  gn = 0.0;
4028  }else{
4029  gn = width(a,zprf,1.0,0.0,nt,0.0,sn,ee-erotn)* densn/densg;
4030  }
4031  if(densp<=0.0){
4032  gp = 0.0;
4033  }else{
4034  gp = width(a,zprf,1.0,1.0,pt,bp,sbp,ee-erotp)*densp/densg* pen(a, 1.0, omegap, pt);
4035  }
4036  if(densd<=0.0){
4037  gd = 0.0;
4038  }else{
4039  gd = width(a,zprf,2.0,1.0,dt,bd,sbd,ee-erotd)*densd/densg* pen(a, 2.0, omegad, dt);
4040  }
4041  if(denst<=0.0){
4042  gt = 0.0;
4043  }else{
4044  gt = width(a,zprf,3.0,1.0,tt,bt,sbt,ee-erott)*denst/densg* pen(a, 3.0, omegat, tt);
4045  }
4046  if(denshe<=0.0){
4047  ghe = 0.0;
4048  }else{
4049  ghe =width(a,zprf,3.0,2.0,het,bhe,sbhe,ee-erothe) * denshe/densg* pen(a, 3.0, omegahe, het);
4050  }
4051  if(densa<=0.0){
4052  ga = 0.0;
4053  }else{
4054  ga = width(a,zprf,4.0,2.0,at,ba,sba,ee-erota) * densa/densg* pen(a, 4.0, omegaa, at);
4055  }
4056  if(denslamb0<=0.0){
4057  glamb0 = 0.0;
4058  }else{
4059  glamb0 = width(a,zprf,1.0,-2.0,lamb0t,0.0,slamb0,ee-erotlamb0)* denslamb0/densg;
4060  }
4061 
4062 // **************************
4063 // * Treatment of IMFs *
4064 // * KHS, AK, MVR 2005-2006 *
4065 // **************************
4066 
4067  G4int izcn=0,incn=0,inmin=0,inmax=0,inmi=0,inma=0;
4068  G4double aimf,mares,maimf;
4069 
4070  if(fimf_allowed==0 || zprf<=5.0 || a<=7.0){
4071  gimf = 0.0;
4072  }else{
4073 // Estimate the total decay width for IMFs (Z >= 3)
4074 // By using the logarithmic slope between GIMF3 and GIMF5
4075 
4076  mglms(a,zprf,opt->optshpimf,&mazz);
4077 
4078  gimf3 = 0.0;
4079  zimf = 3.0;
4080  izimf = 3;
4081 // *** Find the limits that both IMF and partner are bound :
4082  izcn = idnint(zprf); // Z of CN
4083  incn = idnint(a) - izcn; // N of CN
4084 
4085  isostab_lim(izimf,&inmin,&inmax); // Bound isotopes for IZIMF from INMIN to INIMFMA
4086  isostab_lim(izcn-izimf,&inmi,&inma); // Daughter nucleus after IMF emission,
4087  // limits of bound isotopes
4088  inmin = max(inmin,incn-inma); // Both IMF and daughter must be bound
4089  inmax = min(inmax,incn-inmi); // "
4090 
4091  inmax = max(inmax,inmin); // In order to keep the variables below
4092 
4093  for(G4int iaimf=izimf+inmin;iaimf<=izimf+inmax;iaimf++){
4094  aimf=G4double(iaimf);
4095  if(aimf>=a || zimf>=zprf){
4096  width_imf = 0.0;
4097  }else{
4098  // Q-values
4099  mglms(a-aimf,zprf-zimf,opt->optshpimf,&mares);
4100  mglms(aimf,zimf,opt->optshpimf,&maimf);
4101  // Bass barrier
4102  barrs(idnint(zprf-zimf),idnint(a-aimf),izimf,idnint(aimf),&bimf,&omegaimf);
4103  sbimf = maimf+mares-mazz+bimf+getdeltabinding(a,NbLam0);
4104  // Rotation energy
4105  defbetimf = ecld->beta2[idnint(aimf-zimf)][idnint(zimf)]+ecld->beta2[idnint(a-aimf-zprf+zimf)][idnint(zprf-zimf)];
4106 
4107  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));
4108 
4109  erot = jprf * jprf * 197.328 * 197.328 /(2.0 * iinert);
4110 
4111  // Width
4112  if(densg==0.0 || ee < (sbimf + erot)){
4113  width_imf = 0.0;
4114  }else{
4115  // To take into account that at the barrier the system is deformed:
4116  // BSIMF = ((A-AIMF)**(2.D0/3.D0) + AIMF**(2.D0/3.D0))/A**(2.D0/3.D0)
4117  bsimf = bscn;
4118  densniv(a,zprf,ee,sbimf,&densimf,0.0,bsimf,1.0,&timf,0,0,defbetimf,&ecor,jprf,2,&qr);
4119 
4120  imfarg = (sbimf+erotcn-erot)/timf;
4121  if(imfarg > 200.0) imfarg = 200.0;
4122 
4123 // For IMF - The available phase space is given by the level densities in CN at the
4124 // barrier; applaying MOrretto -> G=WIDTH*ro_CN(E-SBIMF)/ro_CN(E).
4125 // Constant temperature approximation: ro(E+dE)/ro(E)=exp(dE/T)
4126 // Ratio DENSIMF/DENSCN is included to take into account that at the barrier system
4127 // is deformed. If (above) BSIMF = 1 no deformation is considered and this ratio
4128 // is equal to 1.
4129  width_imf = 0.0;
4130  //
4131  width_imf = width(a,zprf,aimf,zimf,timf,bimf,sbimf,ee-erot)*std::exp(-imfarg)*qr/qrcn;
4132  }// if densg
4133  }// if aimf
4134  gimf3 = gimf3 + width_imf;
4135  }// for IAIMF
4136 
4137 // zimf = 5
4138  gimf5 = 0.0;
4139  zimf = 5.0;
4140  izimf = 5;
4141 // *** Find the limits that both IMF and partner are bound :
4142  izcn = idnint(zprf); // Z of CN
4143  incn = idnint(a) - izcn; // N of CN
4144 
4145  isostab_lim(izimf,&inmin,&inmax); // Bound isotopes for IZIMF from INMIN to INIMFMA
4146  isostab_lim(izcn-izimf,&inmi,&inma); // Daughter nucleus after IMF emission,
4147  // limits of bound isotopes
4148  inmin = max(inmin,incn-inma); // Both IMF and daughter must be bound
4149  inmax = min(inmax,incn-inmi); // "
4150 
4151  inmax = max(inmax,inmin); // In order to keep the variables below
4152 
4153  for(G4int iaimf=izimf+inmin;iaimf<=izimf+inmax;iaimf++){
4154  aimf=G4double(iaimf);
4155  if(aimf>=a || zimf>=zprf){
4156  width_imf = 0.0;
4157  }else{
4158  // Q-values
4159  mglms(a-aimf,zprf-zimf,opt->optshpimf,&mares);
4160  mglms(aimf,zimf,opt->optshpimf,&maimf);
4161  // Bass barrier
4162  barrs(idnint(zprf-zimf),idnint(a-aimf),izimf,idnint(aimf),&bimf,&omegaimf);
4163  sbimf = maimf+mares-mazz+bimf+getdeltabinding(a,NbLam0);
4164  // Rotation energy
4165  defbetimf = ecld->beta2[idnint(aimf-zimf)][idnint(zimf)]+ecld->beta2[idnint(a-aimf-zprf+zimf)][idnint(zprf-zimf)];
4166 
4167  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));
4168 
4169  erot = jprf * jprf * 197.328 * 197.328 /(2.0 * iinert);
4170 //
4171  // Width
4172  if(densg==0.0 || ee < (sbimf + erot)){
4173  width_imf = 0.0;
4174  }else{
4175  // To take into account that at the barrier the system is deformed:
4176  // BSIMF = ((A-AIMF)**(2.D0/3.D0) + AIMF**(2.D0/3.D0))/A**(2.D0/3.D0)
4177  bsimf = bscn;
4178  densniv(a,zprf,ee,sbimf,&densimf,0.0,bsimf,1.0,&timf,0,0,defbetimf,&ecor,jprf,2,&qr);
4179 //
4180  imfarg = (sbimf+erotcn-erot)/timf;
4181  if(imfarg > 200.0) imfarg = 200.0;
4182 //
4183 // For IMF - The available phase space is given by the level densities in CN at the
4184 // barrier; applaying MOrretto -> G=WIDTH*ro_CN(E-SBIMF)/ro_CN(E).
4185 // Constant temperature approximation: ro(E+dE)/ro(E)=exp(dE/T)
4186 // Ratio DENSIMF/DENSCN is included to take into account that at the barrier system
4187 // is deformed. If (above) BSIMF = 1 no deformation is considered and this ratio
4188 // is equal to 1.
4189  width_imf = 0.0;
4190  width_imf = width(a,zprf,aimf,zimf,timf,bimf,sbimf,ee-erot)*std::exp(-imfarg)*qr/qrcn;//*densimf/densg;
4191  }// if densg
4192  }// if aimf
4193  gimf5 = gimf5 + width_imf;
4194  }// for IAIMF
4195 // It is assumed that GIMFi = A_IMF*ZIMF**B_IMF; to get the total GIMF one integrates
4196 // Int(A_IMF*ZIMF**B_IMF)(3->ZPRF)
4197 
4198  if(gimf3<=0.0 || gimf5<=0.0){
4199  gimf = 0.0;
4200  b_imf = -100.0;
4201  a_imf = 0.0;
4202  }else{
4203 //
4204  b_imf = (std::log10(gimf3) - std::log10(gimf5))/(std::log10(3.0)-std::log10(5.0));
4205 //
4206  if(b_imf >= -1.01) b_imf = -1.01;
4207  if(b_imf <= -100.0) {
4208  b_imf = -100.0;
4209  a_imf = 0.0;
4210  gimf = 0.0;
4211  goto direct2007;
4212  }
4213 //
4214  a_imf = gimf3 / std::pow(3.0,b_imf);
4215  gimf = a_imf * ( std::pow(zprf,b_imf+1.0) - std::pow(3.0,b_imf+1.0)) /(b_imf + 1.0);
4216  }
4217 
4218  direct2007:
4219  if(gimf < 1.e-10) gimf = 0.0;
4220  }// if fimf_allowed
4221 //
4222 //c JLRS 2016 - Added this calculation
4223 //C AK 2004 - Gamma width
4224 //C According to A. Ignatyuk, GG :
4225 //C Here BS=BK=1, as this was assumed in the parameterization
4226  pa = (ald->av)*a + (ald->as)*std::pow(a,2./3.) + (ald->ak)*std::pow(a,1./3.);
4227  gamma = 2.5 * pa * std::pow(a,-4./3.);
4228  gfactor = 1.+gamma*ecld->ecgnz[in][iz];
4229  if(gfactor<=0.){
4230  gfactor = 0.0;
4231  }
4232 //
4233  gtemp = 17.60/(std::pow(a,0.699) * std::sqrt(gfactor));
4234 //
4235 //C If one switches gammas off, one should also switch off tunneling through the fission barrier.
4236  gg = 0.624e-9*std::pow(a,1.6)*std::pow(gtemp,5.);
4237 //gammaemission==1
4238 //C For fission fragments, GG is ~ 2 times larger than for
4239 //c "oridnary" nuclei (A. Ignatyuk, private communication).
4240  if(gammaemission==1){
4241  gg = 2.0 * gg;
4242  }
4243  ecg = 4.0 * gtemp;
4244 //
4245 //
4246  gsum = ga + ghe + gd + gt + gp + gn + gimf + gg + glamb0;
4247 
4248  //std::cout << gn << " " << gd << " " << gp << std::endl;
4249 
4250  if (gsum > 0.0) {
4251  ts1 = hbar / gsum;
4252  }
4253  else {
4254  ts1 = 1.0e99;
4255  goto direct69;
4256  }
4257 //
4258 //Case of nuclei below Businaro-Gallone mass asymmetry point
4259  if(fiss->ifis==0 || (zprf*zprf/a<=22.74 && zprf<60.)){
4260  goto direct69;
4261  }
4262 //
4263 // Calculation of the fission decay width
4264 // Deformation is calculated using the fissility
4265 //
4266  defbet = y;
4267  fission_width(zprf,a,ee,bssp,bksp,ef,y,&gf,&temp,jprf,0,1,fiss->optcol,fiss->optshp,densg);
4268  ft=temp;
4269 //
4270 // Case of very heavy nuclei that have no fission barrier
4271 // For them fission is the only decay channel available
4272  if(ef<=0.0){
4273  probf = 1.0;
4274  probp = 0.0;
4275  probd = 0.0;
4276  probt = 0.0;
4277  probn = 0.0;
4278  probhe = 0.0;
4279  proba = 0.0;
4280  probg = 0.0;
4281  probimf = 0.0;
4282  problamb0 = 0.0;
4283  goto direct70;
4284  }
4285 
4286  if(fiss->bet<=0.){
4287  gtotal = ga + ghe + gp + gd + gt + gn + gg +gimf + gf + glamb0;
4288  if(gtotal<=0.0){
4289  probf = 0.0;
4290  probp = 0.0;
4291  probd = 0.0;
4292  probt = 0.0;
4293  probn = 0.0;
4294  probhe = 0.0;
4295  proba = 0.0;
4296  probg = 0.0;
4297  probimf = 0.0;
4298  problamb0 = 0.0;
4299  goto direct70;
4300  }else{
4301  probf = gf/gtotal;
4302  probn = gn/gtotal;
4303  probp = gp/gtotal;
4304  probd = gd/gtotal;
4305  probt = gt/gtotal;
4306  probhe = ghe/gtotal;
4307  proba = ga/gtotal;
4308  probg = gg/gtotal;
4309  probimf = gimf/gtotal;
4310  problamb0 = glamb0/gtotal;
4311  goto direct70;
4312  }
4313  }
4314  }else{
4315  goto direct69;
4316  }
4317 //
4318  if (inum > ilast) { // new event means reset the time scale
4319  tsum = 0.;
4320  }
4321 //
4322 // kramers factor for the dynamical hindrances of fission
4323  fomega_sp(a,y,&mfcd,&omegasp,&homegasp);
4324  cf = cram(fiss->bet,homegasp);
4325 //
4326 // We calculate the transient time
4327  fomega_gs(a,zprf,&k1,&omegags,&homegags);
4328  tauc=tau(fiss->bet,homegags,ef,ft);
4329  gf=gf*cf;
4330 //
4331 /*
4332 c The subroutine part_fiss calculates the fission width GFF that corresponds to the time
4333 c dependence of the probability distribution obtained by solving the FOKKER-PLANCK eq
4334 c using a nucleus potential that is approximated by a parabola. It also gives the
4335 c decay time for this step T_LAPSE that includes all particle decay channels and the
4336 c fission channel. And it decides whether the nucleus decays by particle evaporation
4337 c CHOICE_FISSPART = 1 or fission CHOICE_FISSPART = 2
4338 */
4339 //
4340  part_fiss(fiss->bet,gsum,gf,y,tauc,ts1,tsum, &choice_fisspart,zprf,a,ft,&t_lapse,&gff);
4341  gf = gff;
4342 //
4343 // We accumulate in TSUM the mean decay for this step including all particle decay channels and fission
4344  tsum = tsum + t_lapse;
4345 
4346 // If fission occurs
4347  if(choice_fisspart==2){
4348  probf = 1.0;
4349  probp = 0.0;
4350  probd = 0.0;
4351  probt = 0.0;
4352  probn = 0.0;
4353  probhe = 0.0;
4354  proba = 0.0;
4355  probg = 0.0;
4356  probimf = 0.0;
4357  problamb0 = 0.0;
4358  goto direct70;
4359  }else{
4360 // If particle evaporation occurs
4361 // The probabilities for the different decays are calculated taking into account the fission width GFF that corresponds to this step
4362 
4363  gtotal=ga + ghe + gp + gd + gt + gn + gimf + gg + glamb0;
4364  if(gtotal<=0.0){
4365  probf = 0.0;
4366  probp = 0.0;
4367  probd = 0.0;
4368  probt = 0.0;
4369  probn = 0.0;
4370  probhe = 0.0;
4371  proba = 0.0;
4372  probg = 0.0;
4373  probimf = 0.0;
4374  problamb0 = 0.0;
4375  goto direct70;
4376  }else{
4377  probf = 0.0;
4378  probn = gn/gtotal;
4379  probp = gp/gtotal;
4380  probd = gd/gtotal;
4381  probt = gt/gtotal;
4382  probhe = ghe/gtotal;
4383  proba = ga/gtotal;
4384  probg = gg/gtotal;
4385  probimf = gimf/gtotal;
4386  problamb0 = glamb0/gtotal;
4387  goto direct70;
4388  }
4389  }
4390 //
4391  direct69:
4392  gtotal = ga + ghe + gp + gd + gt + gn + gg + gimf + glamb0;
4393  if(gtotal<=0.0){
4394  probf = 0.0;
4395  probp = 0.0;
4396  probd = 0.0;
4397  probt = 0.0;
4398  probn = 0.0;
4399  probhe = 0.0;
4400  proba = 0.0;
4401  probg = 0.0;
4402  probimf = 0.0;
4403  problamb0 = 0.0;
4404  }else{
4405  probf = 0.0;
4406  probn = gn/gtotal;
4407  probp = gp/gtotal;
4408  probd = gd/gtotal;
4409  probt = gt/gtotal;
4410  probhe = ghe/gtotal;
4411  proba = ga/gtotal;
4412  probg = gg/gtotal;
4413  probimf = gimf/gtotal;
4414  problamb0 = glamb0/gtotal;
4415  }
4416 
4417  direct70:
4418  ptotl = probp+probd+probt+probn+probhe+proba+probg+probimf+probf+problamb0;
4419  //
4420  ee = eer;
4421  ilast = inum;
4422 
4423  // Return values:
4424  (*probp_par) = probp;
4425  (*probd_par) = probd;
4426  (*probt_par) = probt;
4427  (*probn_par) = probn;
4428  (*probhe_par) = probhe;
4429  (*proba_par) = proba;
4430  (*probg_par) = probg;
4431  (*probimf_par) = probimf;
4432  (*problamb0_par) = problamb0;
4433  (*probf_par) = probf;
4434  (*ptotl_par) = ptotl;
4435  (*sn_par) = sn;
4436  (*sp_par) = sp;
4437  (*sd_par) = sd;
4438  (*st_par) = st;
4439  (*she_par) = she;
4440  (*sa_par) = sa;
4441  (*slamb0_par) = slamb0;
4442  (*sbp_par) = sbp;
4443  (*sbd_par) = sbd;
4444  (*sbt_par) = sbt;
4445  (*sbhe_par) = sbhe;
4446  (*sba_par) = sba;
4447  (*ecn_par) = ecn;
4448  (*ecp_par) = ecp;
4449  (*ecd_par) = ecd;
4450  (*ect_par) = ect;
4451  (*eche_par) = eche;
4452  (*eca_par) = eca;
4453  (*ecg_par) = ecg;
4454  (*eclamb0_par) = eclamb0;
4455  (*bp_par) = bp;
4456  (*bd_par) = bd;
4457  (*bt_par) = bt;
4458  (*bhe_par) = bhe;
4459  (*ba_par) = ba;
4460  (*tcn) = ftcn;
4461  (*ts1_par) = ts1;
4462  (*jprfn_par) = jprfn;
4463  (*jprfp_par) = jprfp;
4464  (*jprfd_par) = jprfd;
4465  (*jprft_par) = jprft;
4466  (*jprfhe_par) = jprfhe;
4467  (*jprfa_par) = jprfa;
4468  (*jprflamb0_par) = jprflamb0;
4469  (*tsum_par) = tsum;
4470  return;
4471 }
4472 
4473 void 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)
4474 {
4475  // 1498 C
4476  // 1499 C INPUT:
4477  // 1500 C A,EE,ESOUS,OPTSHP,BS,BK,BSHELL,DEFBET
4478  // 1501 C
4479  // 1502 C LEVEL DENSITY PARAMETERS
4480  // 1503 C COMMON /ALD/ AV,AS,AK,OPTAFAN
4481  // 1504 C AV,AS,AK - VOLUME,SURFACE,CURVATURE DEPENDENCE OF THE
4482  // 1505 C LEVEL DENSITY PARAMETER
4483  // 1506 C OPTAFAN - 0/1 AF/AN >=1 OR AF/AN ==1
4484  // 1507 C RECOMMENDED IS OPTAFAN = 0
4485  // 1508 C---------------------------------------------------------------------
4486  // 1509 C OUTPUT: DENS,TEMP
4487  // 1510 C
4488  // 1511 C ____________________________________________________________________
4489  // 1512 C /
4490  // 1513 C / PROCEDURE FOR CALCULATING THE STATE DENSITY OF A COMPOUND NUCLEUS
4491  // 1514 C /____________________________________________________________________
4492  // 1515 C
4493  // 1516 INTEGER AFP,IZ,OPTSHP,OPTCOL,J,OPTAFAN
4494  // 1517 REAL*8 A,EE,ESOUS,DENS,E,Y0,Y1,Y2,Y01,Y11,Y21,PA,BS,BK,TEMP
4495  // 1518 C=====INSERTED BY KUDYAEV===============================================
4496  // 1519 COMMON /ALD/ AV,AS,AK,OPTAFAN
4497  // 1520 REAL*8 ECR,ER,DELTAU,Z,DELTPP,PARA,PARZ,FE,HE,ECOR,ECOR1,Pi6
4498  // 1521 REAL*8 BSHELL,DELTA0,AV,AK,AS,PONNIV,PONFE,DEFBET,QR,SIG,FP
4499  // 1522 C=======================================================================
4500  // 1523 C
4501  // 1524 C
4502  // 1525 C-----------------------------------------------------------------------
4503  // 1526 C A MASS NUMBER OF THE DAUGHTER NUCLEUS
4504  // 1527 C EE EXCITATION ENERGY OF THE MOTHER NUCLEUS
4505  // 1528 C ESOUS SEPARATION ENERGY PLUS EFFECTIVE COULOMB BARRIER
4506  // 1529 C DENS STATE DENSITY OF DAUGHTER NUCLEUS AT EE-ESOUS-EC
4507  // 1530 C BSHELL SHELL CORRECTION
4508  // 1531 C TEMP NUCLEAR TEMPERATURE
4509  // 1532 C E LOCAL EXCITATION ENERGY OF THE DAUGHTER NUCLEUS
4510  // 1533 C E1 LOCAL HELP VARIABLE
4511  // 1534 C Y0,Y1,Y2,Y01,Y11,Y21
4512  // 1535 C LOCAL HELP VARIABLES
4513  // 1536 C PA LOCAL STATE-DENSITY PARAMETER
4514  // 1537 C EC KINETIC ENERGY OF EMITTED PARTICLE WITHOUT
4515  // 1538 C COULOMB REPULSION
4516  // 1539 C IDEN FAKTOR FOR SUBSTRACTING KINETIC ENERGY IDEN*TEMP
4517  // 1540 C DELTA0 PAIRING GAP 12 FOR GROUND STATE
4518  // 1541 C 14 FOR SADDLE POINT
4519  // 1542 C EITERA HELP VARIABLE FOR TEMPERATURE ITERATION
4520  // 1543 C-----------------------------------------------------------------------
4521  // 1544 C
4522  // 1545 C
4523  G4double delta0 = 0.0;
4524  G4double deltau = 0.0;
4525  G4double deltpp = 0.0;
4526  G4double e = 0.0;
4527  G4double e0 = 0.0;
4528  G4double ecor1 = 0.0;
4529  G4double ecr = 10.0;
4530  G4double fe = 0.0;
4531  G4double he = 0.0;
4532  G4double pa = 0.0;
4533  G4double para = 0.0;
4534  G4double parz = 0.0;
4535  G4double ponfe = 0.0;
4536  G4double ponniv = 0.0;
4537  G4double fqr = 1.0;
4538  G4double y01 = 0.0;
4539  G4double y11 = 0.0;
4540  G4double y2 = 0.0;
4541  G4double y21 = 0.0;
4542  G4double y1 = 0.0;
4543  G4double y0 = 0.0;
4544  G4double fnorm=0.0;
4545  G4double fp_per=0.;
4546  G4double fp_par=0.;
4547  G4double sig_per=0.;
4548  G4double sig_par=0.;
4549  G4double sigma2;
4550  G4double jfact=1.;
4551  G4double erot=0.;
4552  G4double fdens=0.;
4553  G4double fecor=0.;
4554  G4double BSHELLCT=0.;
4555  G4double gamma=0.;
4556  G4double ftemp=0.0;
4557  G4double tempct=0.0;
4558  G4double densfm = 0.0;
4559  G4double densct = 0.0;
4560  G4double ein=0.;
4561  G4double elim;
4562  G4double tfm;
4563  G4double bs=bsin;
4564  G4double bk=bkin;
4565  G4int IPARITE;
4566  G4int IOPTCT=fiss->optct;
4567 //
4568  G4double pi6 = std::pow(3.1415926535,2) / 6.0;
4569  G4double pi = 3.1415926535;
4570 //
4571  G4int afp=idnint(a);
4572  G4int iz=idnint(z);
4573  G4int in=afp-iz;
4574 //
4575  if(ifis!=1){
4576  BSHELLCT = ecld->ecgnz[in][iz];
4577  }else{
4578  BSHELLCT = 0.0;
4579  }
4580  if(afp<=20) BSHELLCT = 0.0;
4581  //
4582  parite(a,&para);
4583  if (para < 0.0){
4584 // Odd A
4585  IPARITE=1;
4586  }else{
4587 // Even A
4588  parite(z,&parz);
4589  if(parz > 0.0){
4590 // Even Z, even N
4591  IPARITE=2;
4592  }else{
4593 // Odd Z, odd N
4594  IPARITE=0;
4595  }
4596  }
4597 //
4598  ein = ee - esous;
4599 //
4600  if(ein>1.e30){
4601  fdens = 0.0;
4602  ftemp = 0.5;
4603  goto densniv100;
4604  }
4605 //
4606  e = ee - esous;
4607 //
4608  if(e<0.0&&ifis!=1){ // TUNNELING
4609  fdens = 0.0;
4610  densfm = 0.0;
4611  densct = 0.0;
4612  if(ald->optafan == 1) {
4613  pa = (ald->av)*a + (ald->as)*std::pow(a,(2.e0/3.e0)) + (ald->ak)*std::pow(a,(1.e0/3.e0));
4614  }else {
4615  pa = (ald->av)*a + (ald->as)*bsin*std::pow(a,(2.e0/3.e0)) + (ald->ak)*bkin*std::pow(a,(1.e0/3.e0));
4616  }
4617  gamma = 2.5 * pa * std::pow(a,-4.0/3.0);
4618  fecor=0.0;
4619  goto densniv100;
4620  }
4621 //
4622  if(ifis==0&&bs!=1.0){
4623 // - With increasing excitation energy system in getting less and less deformed:
4624  G4double ponq = (e-100.0)/5.0;
4625  if(ponq>700.0) ponq = 700.0;
4626  bs = 1.0/(1.0+std::exp(-ponq)) + 1.0/(1.0+std::exp(ponq)) * bsin;
4627  bk = 1.0/(1.0+std::exp(-ponq)) + 1.0/(1.0+std::exp(ponq)) * bkin;
4628  }
4629 //
4630  // level density parameter
4631  if(ald->optafan == 1) {
4632  pa = (ald->av)*a + (ald->as)*std::pow(a,(2.e0/3.e0)) + (ald->ak)*std::pow(a,(1.e0/3.e0));
4633  }
4634  else {
4635  pa = (ald->av)*a + (ald->as)*bs*std::pow(a,(2.e0/3.e0)) + (ald->ak)*bk*std::pow(a,(1.e0/3.e0));
4636  }
4637 //
4638  gamma = 2.5 * pa * std::pow(a,-4.0/3.0);
4639 //
4640 // AK - 2009 - trial, in order to have transition to constant-temperature approach
4641 // Idea - at the phase transition superfluid-normal fluid, TCT = TEMP, and this
4642 // determines critical energy for pairing.
4643  if(a>0.0){
4644  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));
4645  }
4646 
4647  // pairing corrections
4648  if (ifis == 1) {
4649  delta0 = 14;
4650  }
4651  else {
4652  delta0 = 12;
4653  }
4654 
4655  // shell corrections
4656  if (optshp > 0) {
4657  deltau = bshell;
4658  if (optshp == 2) {
4659  deltau = 0.0;
4660  }
4661  if (optshp >= 2) {
4662  // pairing energy shift with condensation energy a.r.j. 10.03.97
4663  //deltpp = -0.25e0* (delta0/pow(sqrt(a),2)) * pa /pi6 + 2.e0*delta0/sqrt(a);
4664  deltpp = -0.25e0* std::pow((delta0/std::sqrt(a)),2) * pa /pi6 + 22.34e0*std::pow(a,-0.464)-0.235;
4665  // Odd A
4666  if (IPARITE == 1) {
4667  //e = e - delta0/sqrt(a);
4668  e=e-(0.285+11.17*std::pow(a,-0.464)-0.390-0.00058*a);//-30./a;//FIXME
4669  }
4670  // Even Z, even N
4671  if(IPARITE==2){
4672  e=e-(22.34*std::pow(a,-0.464)-0.235);//-30./a;//FIXME
4673  }
4674  // Odd Z, odd N
4675  if(IPARITE==0){
4676  if(in==iz){
4677  // e = e;
4678  }else{
4679  // e = e-30./a;
4680  }
4681  }
4682  } else {
4683  deltpp = 0.0;
4684  }
4685  }else {
4686  deltau = 0.0;
4687  deltpp = 0.0;
4688  }
4689 
4690  if(e < 0.0){
4691  e = 0.0;
4692  ftemp = 0.5;
4693  }
4694 
4695  // washing out is made stronger
4696  ponfe = -2.5*pa*e*std::pow(a,(-4.0/3.0));
4697 
4698  if (ponfe < -700.0) {
4699  ponfe = -700.0;
4700  }
4701  fe = 1.0 - std::exp(ponfe);
4702  if (e < ecr) {
4703  // priv. comm. k.-h. schmidt
4704  he = 1.0 - std::pow((1.0 - e/ecr),2);
4705  }
4706  else {
4707  he = 1.0;
4708  }
4709  // Excitation energy corrected for pairing and shell effects
4710  // washing out with excitation energy is included.
4711  fecor = e + deltau*fe + deltpp*he;
4712  if (fecor <= 0.1) {
4713  fecor = 0.1;
4714  }
4715  // iterative procedure according to grossjean and feldmeier
4716  // to avoid the singularity e = 0
4717  if (ee < 5.0) {
4718  y1 = std::sqrt(pa*fecor);
4719  for(G4int j = 0; j < 5; j++) {
4720  y2 = pa*fecor*(1.e0-std::exp(-y1));
4721  y1 = std::sqrt(y2);
4722  }
4723  y0 = pa/y1;
4724  ftemp=1.0/y0;
4725  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;
4726  if (fecor < 1.0) {
4727  ecor1=1.0;
4728  y11 = std::sqrt(pa*ecor1);
4729  for(G4int j = 0; j < 7; j++) {
4730  y21 = pa*ecor1*(1.0-std::exp(-y11));
4731  y11 = std::sqrt(y21);
4732  }
4733 
4734  y01 = pa/y11;
4735  fdens = fdens*std::pow((y01/y0),1.5);
4736  ftemp = ftemp*std::pow((y01/y0),1.5);
4737  }
4738  }
4739  else {
4740  ponniv = 2.0*std::sqrt(pa*fecor);
4741  if (ponniv > 700.0) {
4742  ponniv = 700.0;
4743  }
4744  // fermi gas state density
4745  fdens = 0.1477045 * std::exp(ponniv)/(std::pow(pa,0.25)*std::pow(fecor,1.25));
4746  ftemp = std::sqrt(fecor/pa);
4747  }
4748 //
4749  densfm = fdens;
4750  tfm = ftemp;
4751 //
4752  if(IOPTCT==0) goto densniv100;
4753  tempct = 17.60/( std::pow(a,0.699) * std::sqrt(1.+gamma*BSHELLCT));
4754  //tempct = 1.0 / ( (0.0570 + 0.00193*BSHELLCT) * pow(a,0.6666667)); // from PRC 80 (2009) 054310
4755 
4756 // - CONSTANT-TEMPERATURE LEVEL DENSITY PARAMETER (ONLY AT LOW ENERGIES)
4757  if(e<30.){
4758  if(a>0.0){
4759  if(optshp>=2){
4760 // Parametrization of CT model by Ignatyuk; note that E0 is shifted to correspond
4761 // to pairing shift in Fermi-gas model (there, energy is shifted taking odd-odd nuclei
4762 // as bassis)
4763 // e-o, o-e
4764  if (IPARITE == 1) { e0 = 0.285+11.17*std::pow(a,-0.464) - 0.390-0.00058*a;}
4765 // e-e
4766  if (IPARITE == 2) { e0 = 22.34*std::pow(a,-0.464)-0.235;}
4767 // o-o
4768  if (IPARITE == 0){ e0 = 0.0;}
4769 
4770  ponniv = (ein-e0)/tempct;
4771  if(ifis!=1) ponniv = max(0.0,(ein-e0)/tempct);
4772  if(ponniv>700.0){ ponniv = 700.0;}
4773  densct = std::exp(ponniv)/tempct*std::exp(0.079*BSHELLCT/tempct);
4774 
4775  elim = ein;
4776 
4777  if(elim>=ecr&&densfm<=densct){
4778  fdens = densfm;
4779  // IREGCT = 0;
4780  }else{
4781  fdens = densct;
4782  // IREGCT = 1;
4783 // ecor = min(ein-e0,0.10);
4784  }
4785  if(elim>=ecr&&tfm>=tempct){
4786  ftemp = tfm;
4787  }else{
4788  ftemp = tempct;
4789  }
4790  }else{
4791 // Case of no pairing considered
4792 // ETEST = PA * TEMPCT**2
4793  ponniv = (ein)/tempct;
4794  if(ponniv>700.0){ ponniv = 700.0;}
4795  densct = std::exp(ponniv)/tempct;
4796 
4797  if(ein>=ecr && densfm<=densct){
4798  fdens = densfm;
4799  ftemp = tfm;
4800  // IREGCT = 0;
4801  }else{
4802  fdens = densct;
4803  ftemp = tempct;
4804 // ECOR = DMIN1(EIN,0.1D0)
4805  }
4806 
4807  if(ein>=ecr && tfm>=tempct){
4808  ftemp = tfm;
4809  }else{
4810  ftemp = tempct;
4811  }
4812  }
4813  }
4814  }
4815 
4816 
4817  densniv100:
4818 
4819  if(fdens==0.0){
4820  if(a>0.0){
4821 // Parametrization of CT model by Ignatyuk done for masses > 20
4822  ftemp = 17.60/( std::pow(a,0.699) * std::sqrt(1.0+gamma*BSHELLCT));
4823  // ftemp = 1.0 / ( (0.0570 + 0.00193*BSHELLCT) * pow(a,0.6666667)); // from PRC 80 (2009) 054310
4824  }else{
4825  ftemp = 0.5;
4826  }
4827  }
4828 //
4829 // spin cutoff parameter
4830 /*
4831 C PERPENDICULAR AND PARALLEL MOMENT OF INERTIA
4832 c fnorm = R0*M0/hbar**2 = 1.16fm*931.49MeV/c**2 /(6.582122e-22 MeVs)**2 and is
4833 c in units 1/MeV
4834 */
4835  fnorm = std::pow(1.16,2)*931.49*1.e-2/(9.0* std::pow(6.582122,2));
4836 
4837  if(ifis==0 || ifis==2){
4838 /*
4839 C GROUND STATE:
4840 C FP_PER ~ 1+0.5*alpha2, FP_PAR ~ 1-alpha2 (Hasse & Myers, Geom. relat. macr. nucl. phys.)
4841 C alpha2 = sqrt(5/(4*pi))*beta2
4842 */
4843  fp_per = 0.4*std::pow(a,5.0/3.0)*fnorm*(1.0+0.50*defbet*std::sqrt(5.0/(4.0*pi)));
4844  fp_par = 0.40*std::pow(a,5.0/3.0)*fnorm*(1.0-defbet*std::sqrt(5.0/(4.0*pi)));
4845 
4846  }else{
4847  if(ifis==1){
4848 /*
4849 C SADDLE POINT
4850 C See Hasse&Myer, p. 100
4851 C Perpendicular moment of inertia
4852 */
4853  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));
4854 // Parallel moment of inertia
4855  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));
4856  }else{
4857  if(ifis==20){
4858 // IMF - two fragments in contact; it is asumed that both are spherical.
4859 // See Hasse&Myers, p.106
4860 // Here, DEFBET = R1/R2, where R1 and R2 are radii of IMF and its partner
4861 // Perpendicular moment of inertia
4862  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);
4863  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);
4864  }
4865  }
4866  }
4867  if(fp_par<0.0)fp_par=0.0;
4868  if(fp_per<0.0)fp_per=0.0;
4869 //
4870  sig_per = std::sqrt(fp_per * ftemp);
4871  sig_par = std::sqrt(fp_par * ftemp);
4872 //
4873  sigma2 = sig_per*sig_per + sig_par*sig_par;
4874  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));
4875  erot = jprf*jprf/(2.0*std::sqrt(fp_par*fp_par+fp_per*fp_per));
4876 //
4877  // collective enhancement
4878  if (optcol == 1) {
4879  qrot(z,a,defbet,sig_per,fecor-erot,&fqr);
4880  }
4881  else {
4882  fqr = 1.0;
4883  }
4884 //
4885  fdens = fdens * fqr *jfact;
4886 //
4887  if(fdens<1e-300)fdens=0.0;
4888 //
4889  *dens =fdens;
4890  *ecor=fecor;
4891  *temp=ftemp;
4892  *qr=fqr;
4893 }
4894 
4895 void G4Abla::qrot(G4double z, G4double a, G4double bet, G4double sig, G4double u, G4double *qr)
4896 {
4897 /*
4898 C QROT INCLUDING DAMPING
4899 C
4900 C INPUT: Z,A,DEFBET,SIG,U
4901 C
4902 C OUTPUT: QR - COLLECTIVE ENHANCEMENT FACTOR
4903 C
4904 C SEE JUNGHANS ET AL., NUCL. PHYS. A 629 (1998) 635
4905 C
4906 C
4907 C FR(U) EXPONENTIAL FUNCTION TO DEFINE DAMPING
4908 C UCR CRITICAL ENERGY FOR DAMPING
4909 C DCR WIDTH OF DAMPING
4910 C DEFBET BETA-DEFORMATION !
4911 C SIG PERPENDICULAR SPIN CUTOFF FACTOR
4912 C U ENERGY
4913 C QR COEFFICIENT OF COLLECTIVE ENHANCEMENT
4914 C A MASS NUMBER
4915 C Z CHARGE NUMBER
4916 C
4917 */
4918 // JLRS: July 2016: new values for the collective parameters
4919 //
4920 
4921  G4double ucr = fiss->ucr; // Critical energy for damping.
4922  G4double dcr = fiss->dcr; // Width of damping.
4923  G4double ponq = 0.0, dn = 0.0, n = 0.0, dz = 0.0;
4924  G4int distn,distz,ndist, zdist;
4925  G4int nmn[8]= {2, 8, 14, 20, 28, 50, 82, 126};
4926  G4int nmz[8]= {2, 8, 14, 20, 28, 50, 82, 126};
4927 //
4928  sig = sig*sig;
4929 //
4930  if(std::abs(bet)<=0.15){
4931  goto qrot10;
4932  }else{
4933  goto qrot11;
4934  }
4935 //
4936  qrot10:
4937  n = a - z;
4938  distn = 10000000;
4939  distz = 10000000;
4940 
4941  for(G4int i =0;i<8;i++){
4942  ndist = std::fabs(idnint(n) - nmn[i]);
4943  if(ndist < distn) distn = ndist;
4944  zdist = std::fabs(idnint(z) - nmz[i]);
4945  if(zdist < distz) distz = zdist;
4946  }
4947 
4948  dz = G4float(distz);
4949  dn = G4float(distn);
4950 
4951  bet = 0.022 + 0.003*dn + 0.002*dz;
4952 
4953  sig = 75.0*std::pow(bet,2.) * sig;
4954 
4955 // NO VIBRATIONAL ENHANCEMENT
4956  qrot11:
4957  ponq = (u - ucr)/dcr;
4958 
4959  if (ponq > 700.0) {
4960  ponq = 700.0;
4961  }
4962  if (sig < 1.0) {
4963  sig = 1.0;
4964  }
4965  (*qr) = 1.0/(1.0 + std::exp(ponq)) * (sig - 1.0) + 1.0;
4966 
4967  if ((*qr) < 1.0) {
4968  (*qr) = 1.0;
4969  }
4970 
4971  return;
4972 }
4973 
4974 void G4Abla::lpoly(G4double x, G4int n, G4double pl[])
4975 {
4976  // THIS SUBROUTINE CALCULATES THE ORDINARY LEGENDRE POLYNOMIALS OF
4977  // ORDER 0 TO N-1 OF ARGUMENT X AND STORES THEM IN THE VECTOR PL.
4978  // THEY ARE CALCULATED BY RECURSION RELATION FROM THE FIRST TWO
4979  // POLYNOMIALS.
4980  // WRITTEN BY A.J.SIERK LANL T-9 FEBRUARY, 1984
4981  // NOTE: PL AND X MUST BE DOUBLE PRECISION ON 32-BIT COMPUTERS!
4982 
4983  pl[0] = 1.0;
4984  pl[1] = x;
4985 
4986  for(G4int i = 2; i < n; i++) {
4987  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);
4988  }
4989 }
4990 
4991 G4double G4Abla::eflmac(G4int ia, G4int iz, G4int flag, G4int optshp)
4992 {
4993  // CHANGED TO CALCULATE TOTAL BINDING ENERGY INSTEAD OF MASS EXCESS.
4994  // SWITCH FOR PAIRING INCLUDED AS WELL.
4995  // BINDING = EFLMAC(IA,IZ,0,OPTSHP)
4996  // FORTRAN TRANSCRIPT OF /U/GREWE/LANG/EEX/FRLDM.C
4997  // A.J. 15.07.96
4998 
4999  // this function will calculate the liquid-drop nuclear mass for spheri
5000  // configuration according to the preprint NUCLEAR GROUND-STATE
5001  // MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
5002  // All constants are taken from this publication for consistency.
5003 
5004  // Parameters:
5005  // a: nuclear mass number
5006  // z: nuclear charge
5007  // flag: 0 - return mass excess
5008  // otherwise - return pairing (= -1/2 dpn + 1/2 (Dp + Dn))
5009 
5010  G4double eflmacResult = 0.0;
5011 
5012  if(ia==0)return eflmacResult;
5013 
5014  G4int in = 0;
5015  G4double z = 0.0, n = 0.0, a = 0.0, av = 0.0, as = 0.0;
5016  G4double a0 = 0.0, c1 = 0.0, c4 = 0.0, b1 = 0.0, b3 = 0.0;
5017  G4double ff = 0.0, ca = 0.0, w = 0.0, efl = 0.0;
5018  G4double r0 = 0.0, kf = 0.0, ks = 0.0;
5019  G4double kv = 0.0, rp = 0.0, ay = 0.0, aden = 0.0, x0 = 0.0, y0 = 0.0;
5020  G4double esq = 0.0, ael = 0.0, i = 0.0, e0 = 0.0;
5021  G4double pi = 3.141592653589793238e0;
5022 
5023  // fundamental constants
5024  // electronic charge squared
5025  esq = 1.4399764;
5026 
5027  // constants from considerations other than nucl. masses
5028  // electronic binding
5029  ael = 1.433e-5;
5030 
5031  // proton rms radius
5032  rp = 0.8;
5033 
5034  // nuclear radius constant
5035  r0 = 1.16;
5036 
5037  // range of yukawa-plus-expon. potential
5038  ay = 0.68;
5039 
5040  // range of yukawa function used to generate
5041  // nuclear charge distribution
5042  aden= 0.70;
5043 
5044  // wigner constant
5045  w = 30.0;
5046 
5047  // adjusted parameters
5048  // volume energy
5049  av = 16.00126;
5050 
5051  // volume asymmetry
5052  kv = 1.92240;
5053 
5054  // surface energy
5055  as = 21.18466;
5056 
5057  // surface asymmetry
5058  ks = 2.345;
5059  // a^0 constant
5060  a0 = 2.615;
5061 
5062  // charge asymmetry
5063  ca = 0.10289;
5064 
5065  z = G4double(iz);
5066  a = G4double(ia);
5067  in = ia - iz;
5068  n = G4double(in);
5069 
5070  if(flag==1){goto eflmac311;}
5071 
5072  if(iz<13&&in<3){
5073  if(masses->mexpiop[in][iz]==1){
5074  return masses->bind[in][iz];
5075  }
5076  }
5077 
5078  eflmac311:
5079 
5080  c1 = 3.0/5.0*esq/r0;
5081  c4 = 5.0/4.0*std::pow((3.0/(2.0*pi)),(2.0/3.0)) * c1;
5082  kf = std::pow((9.0*pi*z/(4.0*a)),(1.0/3.0))/r0;
5083 
5084  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));
5085  i = (n-z)/a;
5086 
5087  x0 = r0 * std::pow(a,(1.0/3.0)) / ay;
5088  y0 = r0 * std::pow(a,(1.0/3.0)) / aden;
5089 
5090  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);
5091 
5092  b3 = 1.0 - 5.0/std::pow(y0,2) * (1.0 - 15.0/(8.0*y0) + 21.0/(8.0 * std::pow(y0,3))
5093  - 3.0/4.0 * (1.0 + 9.0/(2.0*y0) + 7.0/std::pow(y0,2)
5094  + 7.0/(2.0 * std::pow(y0,3))) * std::exp(-2.0*y0));
5095 
5096  // now calulation of total binding energy a.j. 16.7.96
5097 
5098  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
5099  + 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))
5100  + ff*std::pow(z,2)/a -ca*(n-z) - ael * std::pow(z,(2.39e0));
5101 
5102  efl = efl + w*std::abs(i);
5103 
5104  // pairing is made optional
5105  if (optshp >= 2) {
5106  // average pairing
5107  if (in==iz && (mod(in,2) == 1) && (mod(iz,2) == 1) && in>0.) {
5108  efl = efl + w/a;
5109  }
5110 
5111 // AK 2008 - Parametrization of CT model by Ignatyuk;
5112 // The following part has been introduced in order to have correspondance
5113 // between pairing in masses and level densities;
5114 // AK 2010 note that E0 is shifted to correspond to pairing shift in
5115 // Fermi-gas model (there, energy is shifted taking odd-odd nuclei
5116 // as bassis)
5117 
5118  G4double para=0.;
5119  parite(a,&para);
5120 
5121  if(para<0.0){
5122 // e-o, o-e
5123  e0 = 0.285+11.17*std::pow(a,-0.464) -0.390-0.00058*(a);
5124  }else{
5125  G4double parz=0.;
5126  parite(z,&parz);
5127  if (parz>0.0){
5128 // e-e
5129  e0 = 22.34*std::pow(a,-0.464)-0.235;
5130  }else{
5131 // o-o
5132  e0 = 0.0;
5133  }
5134  }
5135  efl = efl - e0;
5136  // end if for pairing term
5137  }
5138 
5139  eflmacResult = efl;
5140 
5141  return eflmacResult;
5142 }
5143 
5144 void G4Abla::appariem(G4double a, G4double z, G4double *del)
5145 {
5146  // CALCUL DE LA CORRECTION, DUE A L'APPARIEMENT, DE L'ENERGIE DE
5147  // LIAISON D'UN NOYAU
5148  // PROCEDURE FOR CALCULATING THE PAIRING CORRECTION TO THE BINDING
5149  // ENERGY OF A SPECIFIC NUCLEUS
5150 
5151  G4double para = 0.0, parz = 0.0;
5152  // A MASS NUMBER
5153  // Z NUCLEAR CHARGE
5154  // PARA HELP VARIABLE FOR PARITY OF A
5155  // PARZ HELP VARIABLE FOR PARITY OF Z
5156  // DEL PAIRING CORRECTION
5157 
5158  parite(a, &para);
5159 
5160  if (para < 0.0) {
5161  (*del) = 0.0;
5162  }
5163  else {
5164  parite(z, &parz);
5165  if (parz > 0.0) {
5166  (*del) = -12.0/std::sqrt(a);
5167  }
5168  else {
5169  (*del) = 12.0/std::sqrt(a);
5170  }
5171  }
5172 }
5173 
5174 void G4Abla::parite(G4double n, G4double *par)
5175 {
5176  // CALCUL DE LA PARITE DU NOMBRE N
5177  //
5178  // PROCEDURE FOR CALCULATING THE PARITY OF THE NUMBER N.
5179  // RETURNS -1 IF N IS ODD AND +1 IF N IS EVEN
5180 
5181  G4double n1 = 0.0, n2 = 0.0, n3 = 0.0;
5182 
5183  // N NUMBER TO BE TESTED
5184  // N1,N2 HELP VARIABLES
5185  // PAR HELP VARIABLE FOR PARITY OF N
5186 
5187  n3 = G4double(idnint(n));
5188  n1 = n3/2.0;
5189  n2 = n1 - dint(n1);
5190 
5191  if (n2 > 0.0) {
5192  (*par) = -1.0;
5193  }
5194  else {
5195  (*par) = 1.0;
5196  }
5197 }
5198 
5199 G4double G4Abla::tau(G4double bet, G4double homega, G4double ef, G4double t)
5200 {
5201  // INPUT : BET, HOMEGA, EF, T
5202  // OUTPUT: TAU - RISE TIME IN WHICH THE FISSION WIDTH HAS REACHED
5203  // 90 PERCENT OF ITS FINAL VALUE
5204  //
5205  // BETA - NUCLEAR VISCOSITY
5206  // HOMEGA - CURVATURE OF POTENTIAL
5207  // EF - FISSION BARRIER
5208  // T - NUCLEAR TEMPERATURE
5209 
5210  G4double tauResult = 0.0;
5211 
5212  G4double tlim = 8.e0 * ef;
5213  if (t > tlim) {
5214  t = tlim;
5215  }
5216  //
5217  if (bet/(std::sqrt(2.0)*10.0*(homega/6.582122)) <= 1.0) {
5218  tauResult = std::log(10.0*ef/t)/(bet*1.0e21);
5219  }
5220  else {
5221  tauResult = std::log(10.0*ef/t)/ (2.0*std::pow((10.0*homega/6.582122),2))*(bet*1.0e-21);
5222  } //end if
5223 
5224  return tauResult;
5225 }
5226 
5227 G4double G4Abla::cram(G4double bet, G4double homega)
5228 {
5229  // INPUT : BET, HOMEGA NUCLEAR VISCOSITY + CURVATURE OF POTENTIAL
5230  // OUTPUT: KRAMERS FAKTOR - REDUCTION OF THE FISSION PROBABILITY
5231  // INDEPENDENT OF EXCITATION ENERGY
5232 
5233  G4double rel = bet/(20.0*homega/6.582122);
5234  G4double cramResult = std::sqrt(1.0 + std::pow(rel,2)) - rel;
5235  // limitation introduced 6.1.2000 by khs
5236 
5237  if (cramResult > 1.0) {
5238  cramResult = 1.0;
5239  }
5240 
5241  return cramResult;
5242 }
5243 
5244 G4double G4Abla::bipol(G4int iflag, G4double y)
5245 {
5246  // CALCULATION OF THE SURFACE BS OR CURVATURE BK OF A NUCLEUS
5247  // RELATIVE TO THE SPHERICAL CONFIGURATION
5248  // BASED ON MYERS, DROPLET MODEL FOR ARBITRARY SHAPES
5249 
5250  // INPUT: IFLAG - 0/1 BK/BS CALCULATION
5251  // Y - (1 - X) COMPLEMENT OF THE FISSILITY
5252 
5253  // LINEAR INTERPOLATION OF BS BK TABLE
5254 
5255  G4int i = 0;
5256 
5257  G4double bipolResult = 0.0;
5258 
5259  const G4int bsbkSize = 54;
5260 
5261  G4double bk[bsbkSize] = {0.0, 1.00000,1.00087,1.00352,1.00799,1.01433,1.02265,1.03306,
5262  1.04576,1.06099,1.07910,1.10056,1.12603,1.15651,1.19348,
5263  1.23915,1.29590,1.35951,1.41013,1.44103,1.46026,1.47339,
5264  1.48308,1.49068,1.49692,1.50226,1.50694,1.51114,1.51502,
5265  1.51864,1.52208,1.52539,1.52861,1.53177,1.53490,1.53803,
5266  1.54117,1.54473,1.54762,1.55096,1.55440,1.55798,1.56173,
5267  1.56567,1.56980,1.57413,1.57860,1.58301,1.58688,1.58688,
5268  1.58688,1.58740,1.58740, 0.0}; //Zeroes at bk[0], and at the end added by PK
5269 
5270  G4double bs[bsbkSize] = {0.0, 1.00000,1.00086,1.00338,1.00750,1.01319,
5271  1.02044,1.02927,1.03974,
5272  1.05195,1.06604,1.08224,1.10085,1.12229,1.14717,1.17623,1.20963,
5273  1.24296,1.26532,1.27619,1.28126,1.28362,1.28458,1.28477,1.28450,
5274  1.28394,1.28320,1.28235,1.28141,1.28042,1.27941,1.27837,1.27732,
5275  1.27627,1.27522,1.27418,1.27314,1.27210,1.27108,1.27006,1.26906,
5276  1.26806,1.26707,1.26610,1.26514,1.26418,1.26325,1.26233,1.26147,
5277  1.26147,1.26147,1.25992,1.25992, 0.0};
5278 
5279  i = idint(y/(2.0e-02)) + 1;
5280 
5281  if((i + 1) >= bsbkSize) {
5282  if(verboseLevel > 2) {
5283  // G4cout <<"G4Abla error: index " << i + 1 << " is greater than array size permits." << G4endl;
5284  }
5285  bipolResult = 0.0;
5286  }
5287  else {
5288  if (iflag == 1) {
5289  bipolResult = bs[i] + (bs[i+1] - bs[i])/2.0e-02 * (y - 2.0e-02*(i - 1));
5290  }
5291  else {
5292  bipolResult = bk[i] + (bk[i+1] - bk[i])/2.0e-02 * (y - 2.0e-02*(i - 1));
5293  }
5294  }
5295 
5296  return bipolResult;
5297 }
5298 
5299 void G4Abla::fomega_sp(G4double AF,G4double Y,G4double *MFCD,G4double *sOMEGA,G4double *sHOMEGA)
5300 {
5301 /*
5302 c Y 1 - Fissility
5303 c OMEGA Frequency at the ground state, in units 1.e-21 s
5304 */
5305  G4double OMEGA,HOMEGA,ES0,MR02;
5306 
5307  ES0 = 20.760*std::pow(AF,2.0/3.0);
5308 // In units 1.e-42 MeVs**2; r0 = 1.175e-15 m, u=931.49MeV/c**2=103.4MeV*s**2/m**2
5309 // divided by 1.e-4 to go from 1.e-46 to 1.e-42
5310  MR02 = std::pow(AF,5.0/3.0)*1.0340*0.010*1.175*1.175;
5311 // Determination of the inertia of the fission collective degree of freedom
5312  (*MFCD) = MR02 * 3.0/10.0*(1.0+3.0*Y);
5313 // Omega at saddle
5314  OMEGA = std::sqrt(ES0/MR02)*std::sqrt(8.0/3.0*Y*(1.0+304.0*Y/255.0));
5315 //
5316  HOMEGA = 6.58122*OMEGA/10.0;
5317 //
5318  (*sOMEGA)=OMEGA;
5319  (*sHOMEGA)=HOMEGA;
5320 //
5321  return;
5322 }
5323 
5324 
5325 void G4Abla::fomega_gs(G4double AF,G4double ZF,G4double *K1,G4double *sOMEGA,G4double *sHOMEGA)
5326 {
5327 /*
5328 c Y 1 - Fissility
5329 c OMEGA Frequency at the ground state, in units 1.e-21 s
5330 */
5331  G4double OMEGA,HOMEGA,MR02,MINERT,C,fk1;
5332 //
5333  MR02 = std::pow(AF,5.0/3.0)*1.0340*0.01*1.175*1.175;
5334  MINERT = 3.*MR02/10.0;
5335  C = 17.9439*(1.-1.7826*std::pow((AF-2.0*ZF)/AF,2));
5336  fk1 = 0.4*C*std::pow(AF,2.0/3.0)-0.1464*std::pow(ZF,2)/std::pow(AF,1./3.);
5337  OMEGA = std::sqrt(fk1/MINERT);
5338  HOMEGA = 6.58122*OMEGA/10.0;
5339 //
5340  (*K1)=fk1;
5341  (*sOMEGA)=OMEGA;
5342  (*sHOMEGA)=HOMEGA;
5343 //
5344  return;
5345 }
5346 
5347 void G4Abla::barrs(G4int Z1,G4int A1,G4int Z2,G4int A2,G4double *sBARR,G4double *sOMEGA)
5348 {/*
5349 C AK 2004 - Barriers for LCP and IMF are calculated now according to the
5350 C Bass model (Nucl. Phys. A (1974))
5351 C KHS 2007 - To speed up, barriers are read from tabels; in case thermal
5352 C expansion is considered, barriers are calculated.
5353 C INPUT:
5354 C EA - Excitation energy per nucleon
5355 C Z11, A11 - Charge and mass of daughter nucleus
5356 C Z22, A22 - Charge and mass of LCP or IMF
5357 C
5358 C OUTPUT:
5359 C BARR - Barrier
5360 C OMEGA - Curvature of the potential
5361 C
5362 C BASS MODEL NPA 1974 - used only if expansion is considered (OPTEXP=1)
5363 C or one wants this model explicitely (OPTBAR=1)
5364 C October 2011 - AK - new parametrization of the barrier and its position,
5365 C see W.W. Qu et al., NPA 868 (2011) 1; this is now
5366 C default option (OPTBAR=0)
5367 c
5368 c November 2016 - JLRS - Added this function from abla07v4
5369 c
5370 */
5371  G4double BARR, OMEGA, RMAX;
5372  RMAX = 1.1 * (ecld->rms[A1-Z1][Z1]+ecld->rms[A2-Z2][Z2]) + 2.8;
5373  BARR = 1.345 * Z1 * Z2 / RMAX;
5374 //C Omega according to Avishai:
5375  OMEGA = 4.5 / 197.3287;
5376 
5377  // if(Z1<60){
5378  // if(Z2==1 && A2==2) BARR = BARR * 1.1;
5379  // if(Z2==1 && A2==3) BARR = BARR * 1.1;
5380  // if(Z2==2 && A2==3) BARR = BARR * 1.3;
5381  // if(Z2==2 && A2==4) BARR = BARR * 1.1;
5382  // }
5383 
5384  (*sOMEGA)=OMEGA;
5385  (*sBARR)=BARR;
5386 //
5387  return;
5388 }
5389 
5390 void G4Abla::barfit(G4int iz, G4int ia, G4int il, G4double *sbfis, G4double *segs, G4double *selmax)
5391 {
5392  // 2223 C VERSION FOR 32BIT COMPUTER
5393  // 2224 C THIS SUBROUTINE RETURNS THE BARRIER HEIGHT BFIS, THE
5394  // 2225 C GROUND-STATE ENERGY SEGS, IN MEV, AND THE ANGULAR MOMENTUM
5395  // 2226 C AT WHICH THE FISSION BARRIER DISAPPEARS, LMAX, IN UNITS OF
5396  // 2227 C H-BAR, WHEN CALLED WITH INTEGER AGUMENTS IZ, THE ATOMIC
5397  // 2228 C NUMBER, IA, THE ATOMIC MASS NUMBER, AND IL, THE ANGULAR
5398  // 2229 C MOMENTUM IN UNITS OF H-BAR. (PLANCK'S CONSTANT DIVIDED BY
5399  // 2230 C 2*PI).
5400  // 2231 C
5401  // 2232 C THE FISSION BARRIER FO IL = 0 IS CALCULATED FROM A 7TH
5402  // 2233 C ORDER FIT IN TWO VARIABLES TO 638 CALCULATED FISSION
5403  // 2234 C BARRIERS FOR Z VALUES FROM 20 TO 110. THESE 638 BARRIERS ARE
5404  // 2235 C FIT WITH AN RMS DEVIATION OF 0.10 MEV BY THIS 49-PARAMETER
5405  // 2236 C FUNCTION.
5406  // 2237 C IF BARFIT IS CALLED WITH (IZ,IA) VALUES OUTSIDE THE RANGE OF
5407  // 2238 C THE BARRIER HEIGHT IS SET TO 0.0, AND A MESSAGE IS PRINTED
5408  // 2239 C ON THE DEFAULT OUTPUT FILE.
5409  // 2240 C
5410  // 2241 C FOR IL VALUES NOT EQUAL TO ZERO, THE VALUES OF L AT WHICH
5411  // 2242 C THE BARRIER IS 80% AND 20% OF THE L=0 VALUE ARE RESPECTIVELY
5412  // 2243 C FIT TO 20-PARAMETER FUNCTIONS OF Z AND A, OVER A MORE
5413  // 2244 C RESTRICTED RANGE OF A VALUES, THAN IS THE CASE FOR L = 0.
5414  // 2245 C THE VALUE OF L WHERE THE BARRIER DISAPPEARS, LMAX IS FIT TO
5415  // 2246 C A 24-PARAMETER FUNCTION OF Z AND A, WITH THE SAME RANGE OF
5416  // 2247 C Z AND A VALUES AS L-80 AND L-20.
5417  // 2248 C ONCE AGAIN, IF AN (IZ,IA) PAIR IS OUTSIDE OF THE RANGE OF
5418  // 2249 C VALIDITY OF THE FIT, THE BARRIER VALUE IS SET TO 0.0 AND A
5419  // 2250 C MESSAGE IS PRINTED. THESE THREE VALUES (BFIS(L=0),L-80, AND
5420  // 2251 C L-20) AND THE CONSTRINTS OF BFIS = 0 AND D(BFIS)/DL = 0 AT
5421  // 2252 C L = LMAX AND L=0 LEAD TO A FIFTH-ORDER FIT TO BFIS(L) FOR
5422  // 2253 C L>L-20. THE FIRST THREE CONSTRAINTS LEAD TO A THIRD-ORDER FIT
5423  // 2254 C FOR THE REGION L < L-20.
5424  // 2255 C
5425  // 2256 C THE GROUND STATE ENERGIES ARE CALCULATED FROM A
5426  // 2257 C 120-PARAMETER FIT IN Z, A, AND L TO 214 GROUND-STATE ENERGIES
5427  // 2258 C FOR 36 DIFFERENT Z AND A VALUES.
5428  // 2259 C (THE RANGE OF Z AND A IS THE SAME AS FOR L-80, L-20, AND
5429  // 2260 C L-MAX)
5430  // 2261 C
5431  // 2262 C THE CALCULATED BARRIERS FROM WHICH THE FITS WERE MADE WERE
5432  // 2263 C CALCULATED IN 1983-1984 BY A. J. SIERK OF LOS ALAMOS
5433  // 2264 C NATIONAL LABORATORY GROUP T-9, USING YUKAWA-PLUS-EXPONENTIAL
5434  // 2265 C G4DOUBLE FOLDED NUCLEAR ENERGY, EXACT COULOMB DIFFUSENESS
5435  // 2266 C CORRECTIONS, AND DIFFUSE-MATTER MOMENTS OF INERTIA.
5436  // 2267 C THE PARAMETERS OF THE MODEL R-0 = 1.16 FM, AS 21.13 MEV,
5437  // 2268 C KAPPA-S = 2.3, A = 0.68 FM.
5438  // 2269 C THE DIFFUSENESS OF THE MATTER AND CHARGE DISTRIBUTIONS USED
5439  // 2270 C CORRESPONDS TO A SURFACE DIFFUSENESS PARAMETER (DEFINED BY
5440  // 2271 C MYERS) OF 0.99 FM. THE CALCULATED BARRIERS FOR L = 0 ARE
5441  // 2272 C ACCURATE TO A LITTLE LESS THAN 0.1 MEV; THE OUTPUT FROM
5442  // 2273 C THIS SUBROUTINE IS A LITTLE LESS ACCURATE. WORST ERRORS MAY BE
5443  // 2274 C AS LARGE AS 0.5 MEV; CHARACTERISTIC UNCERTAINY IS IN THE RANGE
5444  // 2275 C OF 0.1-0.2 MEV. THE RMS DEVIATION OF THE GROUND-STATE FIT
5445  // 2276 C FROM THE 214 INPUT VALUES IS 0.20 MEV. THE MAXIMUM ERROR
5446  // 2277 C OCCURS FOR LIGHT NUCLEI IN THE REGION WHERE THE GROUND STATE
5447  // 2278 C IS PROLATE, AND MAY BE GREATER THAN 1.0 MEV FOR VERY NEUTRON
5448  // 2279 C DEFICIENT NUCLEI, WITH L NEAR LMAX. FOR MOST NUCLEI LIKELY TO
5449  // 2280 C BE ENCOUNTERED IN REAL EXPERIMENTS, THE MAXIMUM ERROR IS
5450  // 2281 C CLOSER TO 0.5 MEV, AGAIN FOR LIGHT NUCLEI AND L NEAR LMAX.
5451  // 2282 C
5452  // 2283 C WRITTEN BY A. J. SIERK, LANL T-9
5453  // 2284 C VERSION 1.0 FEBRUARY, 1984
5454  // 2285 C
5455  // 2286 C THE FOLLOWING IS NECESSARY FOR 32-BIT MACHINES LIKE DEC VAX,
5456  // 2287 C IBM, ETC
5457 
5458  G4double pa[7],pz[7],pl[10];
5459  for(G4int init_i = 0; init_i < 7; init_i++) {
5460  pa[init_i] = 0.0;
5461  pz[init_i] = 0.0;
5462  }
5463  for(G4int init_i = 0; init_i < 10; init_i++) {
5464  pl[init_i] = 0.0;
5465  }
5466 
5467  G4double a = 0.0, z = 0.0, amin = 0.0, amax = 0.0, amin2 = 0.0;
5468  G4double amax2 = 0.0, aa = 0.0, zz = 0.0, bfis = 0.0;
5469  G4double bfis0 = 0.0, ell = 0.0, el = 0.0, egs = 0.0, el80 = 0.0, el20 = 0.0;
5470  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;
5471  G4double aj = 0.0, ak = 0.0, a1 = 0.0, a2 = 0.0;
5472 
5473  G4int i = 0, j = 0, k = 0, m = 0;
5474  G4int l = 0;
5475 
5476  G4double emncof[4][5] = {{-9.01100e+2,-1.40818e+3, 2.77000e+3,-7.06695e+2, 8.89867e+2},
5477  {1.35355e+4,-2.03847e+4, 1.09384e+4,-4.86297e+3,-6.18603e+2},
5478  {-3.26367e+3, 1.62447e+3, 1.36856e+3, 1.31731e+3, 1.53372e+2},
5479  {7.48863e+3,-1.21581e+4, 5.50281e+3,-1.33630e+3, 5.05367e-2}};
5480 
5481  G4double elmcof[4][5] = {{1.84542e+3,-5.64002e+3, 5.66730e+3,-3.15150e+3, 9.54160e+2},
5482  {-2.24577e+3, 8.56133e+3,-9.67348e+3, 5.81744e+3,-1.86997e+3},
5483  {2.79772e+3,-8.73073e+3, 9.19706e+3,-4.91900e+3, 1.37283e+3},
5484  {-3.01866e+1, 1.41161e+3,-2.85919e+3, 2.13016e+3,-6.49072e+2}};
5485 
5486  G4double emxcof[4][6] = {{9.43596e4,-2.241997e5,2.223237e5,-1.324408e5,4.68922e4,-8.83568e3},
5487  {-1.655827e5,4.062365e5,-4.236128e5,2.66837e5,-9.93242e4,1.90644e4},
5488  {1.705447e5,-4.032e5,3.970312e5,-2.313704e5,7.81147e4,-1.322775e4},
5489  {-9.274555e4,2.278093e5,-2.422225e5,1.55431e5,-5.78742e4,9.97505e3}};
5490 
5491  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},
5492  {-1.13269453e+6, 2.97764590e+6,-4.54326326e+6, 3.00464870e+6, -1.44989274e+6,-1.02026610e+5, 6.27959815e+4},
5493  {1.37543304e+6,-3.65808988e+6, 5.47798999e+6,-3.78109283e+6, 1.84131765e+6, 1.53669695e+4,-6.96817834e+4},
5494  {-8.56559835e+5, 2.48872266e+6,-4.07349128e+6, 3.12835899e+6, -1.62394090e+6, 1.19797378e+5, 4.25737058e+4},
5495  {3.28723311e+5,-1.09892175e+6, 2.03997269e+6,-1.77185718e+6, 9.96051545e+5,-1.53305699e+5,-1.12982954e+4},
5496  {4.15850238e+4, 7.29653408e+4,-4.93776346e+5, 6.01254680e+5, -4.01308292e+5, 9.65968391e+4,-3.49596027e+3},
5497  {-1.82751044e+5, 3.91386300e+5,-3.03639248e+5, 1.15782417e+5, -4.24399280e+3,-6.11477247e+3, 3.66982647e+2}};
5498 
5499  const G4int sizex = 5;
5500  const G4int sizey = 6;
5501  const G4int sizez = 4;
5502 
5503  G4double egscof[sizey][sizey][sizez];
5504 
5505  G4double egs1[sizey][sizex] = {{1.927813e5, 7.666859e5, 6.628436e5, 1.586504e5,-7.786476e3},
5506  {-4.499687e5,-1.784644e6,-1.546968e6,-4.020658e5,-3.929522e3},
5507  {4.667741e5, 1.849838e6, 1.641313e6, 5.229787e5, 5.928137e4},
5508  {-3.017927e5,-1.206483e6,-1.124685e6,-4.478641e5,-8.682323e4},
5509  {1.226517e5, 5.015667e5, 5.032605e5, 2.404477e5, 5.603301e4},
5510  {-1.752824e4,-7.411621e4,-7.989019e4,-4.175486e4,-1.024194e4}};
5511 
5512  G4double egs2[sizey][sizex] = {{-6.459162e5,-2.903581e6,-3.048551e6,-1.004411e6,-6.558220e4},
5513  {1.469853e6, 6.564615e6, 6.843078e6, 2.280839e6, 1.802023e5},
5514  {-1.435116e6,-6.322470e6,-6.531834e6,-2.298744e6,-2.639612e5},
5515  {8.665296e5, 3.769159e6, 3.899685e6, 1.520520e6, 2.498728e5},
5516  {-3.302885e5,-1.429313e6,-1.512075e6,-6.744828e5,-1.398771e5},
5517  {4.958167e4, 2.178202e5, 2.400617e5, 1.167815e5, 2.663901e4}};
5518 
5519  G4double egs3[sizey][sizex] = {{3.117030e5, 1.195474e6, 9.036289e5, 6.876190e4,-6.814556e4},
5520  {-7.394913e5,-2.826468e6,-2.152757e6,-2.459553e5, 1.101414e5},
5521  {7.918994e5, 3.030439e6, 2.412611e6, 5.228065e5, 8.542465e3},
5522  {-5.421004e5,-2.102672e6,-1.813959e6,-6.251700e5,-1.184348e5},
5523  {2.370771e5, 9.459043e5, 9.026235e5, 4.116799e5, 1.001348e5},
5524  {-4.227664e4,-1.738756e5,-1.795906e5,-9.292141e4,-2.397528e4}};
5525 
5526  G4double egs4[sizey][sizex] = {{-1.072763e5,-5.973532e5,-6.151814e5, 7.371898e4, 1.255490e5},
5527  {2.298769e5, 1.265001e6, 1.252798e6,-2.306276e5,-2.845824e5},
5528  {-2.093664e5,-1.100874e6,-1.009313e6, 2.705945e5, 2.506562e5},
5529  {1.274613e5, 6.190307e5, 5.262822e5,-1.336039e5,-1.115865e5},
5530  {-5.715764e4,-2.560989e5,-2.228781e5,-3.222789e3, 1.575670e4},
5531  {1.189447e4, 5.161815e4, 4.870290e4, 1.266808e4, 2.069603e3}};
5532 
5533  for(i = 0; i < sizey; i++) {
5534  for(j = 0; j < sizex; j++) {
5535  egscof[i][j][0] = egs1[i][j];
5536  egscof[i][j][1] = egs2[i][j];
5537  egscof[i][j][2] = egs3[i][j];
5538  egscof[i][j][3] = egs4[i][j];
5539  }
5540  }
5541 
5542  // the program starts here
5543  if (iz < 19 || iz > 111) {
5544  goto barfit900;
5545  }
5546 
5547  if(iz > 102 && il > 0) {
5548  goto barfit902;
5549  }
5550 
5551  z=G4double(iz);
5552  a=G4double(ia);
5553  el=G4double(il);
5554  amin= 1.2e0*z + 0.01e0*z*z;
5555  amax= 5.8e0*z - 0.024e0*z*z;
5556 
5557  if(a < amin || a > amax) {
5558  goto barfit910;
5559  }
5560 
5561  // angul.mom.zero barrier
5562  aa=2.5e-3*a;
5563  zz=1.0e-2*z;
5564  ell=1.0e-2*el;
5565  bfis0 = 0.0;
5566  lpoly(zz,7,pz);
5567  lpoly(aa,7,pa);
5568 
5569  for(i = 0; i < 7; i++) { //do 10 i=1,7
5570  for(j = 0; j < 7; j++) { //do 10 j=1,7
5571  bfis0=bfis0+elzcof[j][i]*pz[i]*pa[j];
5572  }
5573  }
5574 
5575  bfis=bfis0;
5576 
5577  (*sbfis)=bfis;
5578  egs=0.0;
5579  (*segs)=egs;
5580 
5581  // values of l at which the barrier
5582  // is 20%(el20) and 80%(el80) of l=0 value
5583  amin2 = 1.4e0*z + 0.009e0*z*z;
5584  amax2 = 20.e0 + 3.0e0*z;
5585 
5586  if((a < amin2-5.e0 || a > amax2+10.e0) && il > 0) {
5587  goto barfit920;
5588  }
5589 
5590  lpoly(zz,5,pz);
5591  lpoly(aa,4,pa);
5592  el80=0.0;
5593  el20=0.0;
5594  elmax=0.0;
5595 
5596  for(i = 0; i < 4; i++) {
5597  for(j = 0; j < 5; j++) {
5598  el80 = el80 + elmcof[i][j]*pz[j]*pa[i];
5599  el20 = el20 + emncof[i][j]*pz[j]*pa[i];
5600  }
5601  }
5602 
5603  sel80 = el80;
5604  sel20 = el20;
5605 
5606  // value of l (elmax) where barrier disapp.
5607  lpoly(zz,6,pz);
5608  lpoly(ell,9,pl);
5609 
5610  for(i = 0; i < 4; i++) { //do 30 i= 1,4
5611  for(j = 0; j < 6; j++) { //do 30 j=1,6
5612  elmax = elmax + emxcof[i][j]*pz[j]*pa[i];
5613  }
5614  }
5615 
5616  (*selmax)=elmax;
5617 
5618  // value of barrier at ang.mom. l
5619  if(il < 1){
5620  return;
5621  }
5622 
5623  x = sel20/(*selmax);
5624  y = sel80/(*selmax);
5625 
5626  if(el <= sel20) {
5627  // low l
5628  q = 0.2/(std::pow(sel20,2)*std::pow(sel80,2)*(sel20-sel80));
5629  qa = q*(4.0*std::pow(sel80,3) - std::pow(sel20,3));
5630  qb = -q*(4.0*std::pow(sel80,2) - std::pow(sel20,2));
5631  bfis = bfis*(1.0 + qa*std::pow(el,2) + qb*std::pow(el,3));
5632  }
5633  else {
5634  // high l
5635  aj = (-20.0*std::pow(x,5) + 25.e0*std::pow(x,4) - 4.0)*std::pow((y-1.0),2)*y*y;
5636  ak = (-20.0*std::pow(y,5) + 25.0*std::pow(y,4) - 1.0) * std::pow((x-1.0),2)*x*x;
5637  q = 0.2/(std::pow((y-x)*((1.0-x)*(1.0-y)*x*y),2));
5638  qa = q*(aj*y - ak*x);
5639  qb = -q*(aj*(2.0*y + 1.0) - ak*(2.0*x + 1.0));
5640  z = el/(*selmax);
5641  a1 = 4.0*std::pow(z,5) - 5.0*std::pow(z,4) + 1.0;
5642  a2 = qa*(2.e0*z + 1.e0);
5643  bfis=bfis*(a1 + (z - 1.e0)*(a2 + qb*z)*z*z*(z - 1.e0));
5644  }
5645 
5646  if(bfis <= 0.0) {
5647  bfis=0.0;
5648  }
5649 
5650  if(el > (*selmax)) {
5651  bfis=0.0;
5652  }
5653  (*sbfis)=bfis;
5654 
5655  // now calculate rotating ground state energy
5656  if(el > (*selmax)) {
5657  return;
5658  }
5659 
5660  for(k = 0; k < 4; k++) {
5661  for(l = 0; l < 6; l++) {
5662  for(m = 0; m < 5; m++) {
5663  egs = egs + egscof[l][m][k]*pz[l]*pa[k]*pl[2*m];
5664  }
5665  }
5666  }
5667 
5668  (*segs)=egs;
5669  if((*segs) < 0.0) {
5670  (*segs)=0.0;
5671  }
5672 
5673  return;
5674 
5675  barfit900: //continue
5676  (*sbfis)=0.0;
5677  // for z<19 sbfis set to 1.0e3
5678  if (iz < 19) {
5679  (*sbfis) = 1.0e3;
5680  }
5681  (*segs)=0.0;
5682  (*selmax)=0.0;
5683  return;
5684 
5685  barfit902:
5686  (*sbfis)=0.0;
5687  (*segs)=0.0;
5688  (*selmax)=0.0;
5689  return;
5690 
5691  barfit910:
5692  (*sbfis)=0.0;
5693  (*segs)=0.0;
5694  (*selmax)=0.0;
5695  return;
5696 
5697  barfit920:
5698  (*sbfis)=0.0;
5699  (*segs)=0.0;
5700  (*selmax)=0.0;
5701  return;
5702 }
5703 
5704 G4double G4Abla::erf(G4double x)
5705 {
5706  G4double ferf;
5707 
5708  if(x<0.){
5709  ferf=-gammp(0.5,x*x);
5710  }else{
5711  ferf=gammp(0.5,x*x);;
5712  }
5713  return ferf;
5714 }
5715 
5716 G4double G4Abla::gammp(G4double a, G4double x)
5717 {
5718  G4double fgammp;
5719  G4double gammcf,gamser,gln=0.;
5720 
5721  if(x<0.0 || a<=0.0)std::cout << "G4Abla::gammp = bad arguments in gammp" << std::endl;
5722  if(x<a+1.){
5723  gser(&gamser,a,x,gln);
5724  fgammp=gamser;
5725  }else{
5726  gcf(&gammcf,a,x,gln);
5727  fgammp=1.-gammcf;
5728  }
5729  return fgammp;
5730 }
5731 
5732 void G4Abla::gcf(G4double *gammcf,G4double a,G4double x,G4double gln)
5733 {
5734  G4double fgammcf,del;
5735  G4double eps=3e-7;
5736  G4double fpmin=1e-30;
5737  G4int itmax=100;
5738  G4double an,b,c,d,h;
5739 
5740  gln=gammln(a);
5741  b=x+1.-a;
5742  c=1./fpmin;
5743  d=1./b;
5744  h=d;
5745  for(G4int i=1;i<=itmax;i++){
5746  an=-i*(i-a);
5747  b=b+2.;
5748  d=an*d+b;
5749  if(std::fabs(d)<fpmin)d=fpmin;
5750  c=b+an/c;
5751  if(std::fabs(c)<fpmin)c=fpmin;
5752  d=1.0/d;
5753  del=d*c;
5754  h=h*del;
5755  if(std::fabs(del-1.)<eps)goto dir1;
5756  }
5757  std::cout << "a too large, ITMAX too small in gcf" << std::endl;
5758  dir1:
5759  fgammcf=std::exp(-x+a*std::log(x)-gln)*h;
5760  (*gammcf)=fgammcf;
5761  return;
5762 }
5763 
5764 void G4Abla::gser(G4double *gamser,G4double a,G4double x,G4double gln)
5765 {
5766  G4double fgamser,ap,sum,del;
5767  G4double eps=3e-7;
5768  G4int itmax=100;
5769 
5770  gln=gammln(a);
5771  if(x<=0.){
5772  if(x<0.)std::cout << "G4Abla::gser = x < 0 in gser" << std::endl;
5773  (*gamser)=0.0;
5774  return;
5775  }
5776  ap=a;
5777  sum=1./a;
5778  del=sum;
5779  for(G4int n=0;n<itmax;n++){
5780  ap=ap+1.;
5781  del=del*x/ap;
5782  sum=sum+del;
5783  if(std::fabs(del)<std::fabs(sum)*eps)goto dir1;
5784  }
5785  std::cout << "a too large, ITMAX too small in gser" << std::endl;
5786  dir1:
5787  fgamser=sum*std::exp(-x+a*std::log(x)-gln);
5788  (*gamser)=fgamser;
5789  return;
5790 }
5791 
5792 G4double G4Abla::gammln(G4double xx)
5793 {
5794  G4double fgammln,x,ser,tmp,y;
5795  G4double cof[6]={76.18009172947146,-86.50532032941677,24.01409824083091,
5796 -1.231739572450155,0.1208650973866179e-2,-0.5395239384953e-5};
5797  G4double stp=2.5066282746310005;
5798 
5799  x=xx;
5800  y=x;
5801  tmp=x+5.5;
5802  tmp=(x+0.5)*std::log(tmp)-tmp;
5803  ser=1.000000000190015;
5804  for(G4int j=0;j<6;j++){
5805  y=y+1.;
5806  ser=ser+cof[j]/y;
5807  }
5808 
5809  return fgammln=tmp+std::log(stp*ser/x);
5810 }
5811 
5812 
5813 G4double G4Abla::fd(G4double E)
5814 {
5815  // DISTRIBUTION DE MAXWELL
5816 
5817  return (E*std::exp(-E));
5818 }
5819 
5820 G4double G4Abla::f(G4double E)
5821 {
5822  // FONCTION INTEGRALE DE FD(E)
5823  return (1.0 - (E + 1.0) * std::exp(-E));
5824 }
5825 
5826 G4double G4Abla::fmaxhaz(G4double x)
5827 {
5828  return ( -x*std::log(G4AblaRandom::flat()) -x*std::log(G4AblaRandom::flat()) -x*std::log(G4AblaRandom::flat()) ) ;
5829 }
5830 
5831 G4double G4Abla::fmaxhaz_old(G4double T)
5832 {
5833  // tirage aleatoire dans une maxwellienne
5834  // t : temperature
5835  //
5836  // declaration des variables
5837  //
5838 
5839  const G4int pSize = 101;
5840  G4double p[pSize];
5841 
5842  // ial generateur pour le cascade (et les iy pour eviter les correlations)
5843  G4int i = 0;
5844  G4int itest = 0;
5845  // programme principal
5846 
5847  // calcul des p(i) par approximation de newton
5848  p[pSize-1] = 8.0;
5849  G4double x = 0.1;
5850  G4double x1 = 0.0;
5851  G4double y = 0.0;
5852 
5853  if (itest == 1) {
5854  goto fmaxhaz120;
5855  }
5856 
5857  for(i = 1; i <= 99; i++) {
5858  fmaxhaz20:
5859  x1 = x - (f(x) - G4double(i)/100.0)/fd(x);
5860  x = x1;
5861  if (std::fabs(f(x) - G4double(i)/100.0) < 1e-5) {
5862  goto fmaxhaz100;
5863  }
5864  goto fmaxhaz20;
5865  fmaxhaz100:
5866  p[i] = x;
5867  } //end do
5868 
5869  // itest = 1;
5870  itest = 0;
5871  // tirage aleatoire et calcul du x correspondant
5872  // par regression lineaire
5873  fmaxhaz120:
5874  y = G4AblaRandom::flat();
5875  i = nint(y*100);
5876 
5877  // 2590 c ici on evite froidement les depassements de tableaux....(a.b. 3/9/99)
5878  if(i == 0) {
5879  goto fmaxhaz120;
5880  }
5881 
5882  if (i == 1) {
5883  x = p[i]*y*100;
5884  }
5885  else {
5886  x = (p[i] - p[i-1])*(y*100 - i) + p[i];
5887  }
5888 
5889  return(x*T);
5890 }
5891 
5892 G4double G4Abla::pace2(G4double a, G4double z)
5893 {
5894  // PACE2
5895  // Cette fonction retourne le defaut de masse du noyau A,Z en MeV
5896  // Revisee pour a, z flottants 25/4/2002 =
5897 
5898  G4double fpace2 = 0.0;
5899 
5900  G4int ii = idint(a+0.5);
5901  G4int jj = idint(z+0.5);
5902 
5903  if(ii <= 0 || jj < 0) {
5904  fpace2=0.;
5905  return fpace2;
5906  }
5907 
5908  if(jj > 300) {
5909  fpace2=0.0;
5910  }
5911  else {
5912  fpace2=pace->dm[ii][jj];
5913  }
5914  fpace2=fpace2/1000.;
5915 
5916  if(pace->dm[ii][jj] == 0.) {
5917  if(ii < 12) {
5918  fpace2=-500.;
5919  }
5920  else {
5921  guet(&a, &z, &fpace2);
5922  fpace2=fpace2-ii*931.5;
5923  fpace2=fpace2/1000.;
5924  }
5925  }
5926 
5927  return fpace2;
5928 }
5929 
5930 void G4Abla::guet(G4double *x_par, G4double *z_par, G4double *find_par)
5931 {
5932  // TABLE DE MASSES ET FORMULE DE MASSE TIRE DU PAPIER DE BRACK-GUET
5933  // Gives the theoritical value for mass excess...
5934  // Revisee pour x, z flottants 25/4/2002
5935 
5936  //real*8 x,z
5937  // dimension q(0:50,0:70)
5938  G4double x = (*x_par);
5939  G4double z = (*z_par);
5940  G4double find = (*find_par);
5941 
5942  const G4int qrows = 50;
5943  const G4int qcols = 70;
5944  G4double q[qrows][qcols];
5945  for(G4int init_i = 0; init_i < qrows; init_i++) {
5946  for(G4int init_j = 0; init_j < qcols; init_j++) {
5947  q[init_i][init_j] = 0.0;
5948  }
5949  }
5950 
5951  G4int ix=G4int(std::floor(x+0.5));
5952  G4int iz=G4int(std::floor(z+0.5));
5953  G4double zz = iz;
5954  G4double xx = ix;
5955  find = 0.0;
5956  G4double avol = 15.776;
5957  G4double asur = -17.22;
5958  G4double ac = -10.24;
5959  G4double azer = 8.0;
5960  G4double xjj = -30.03;
5961  G4double qq = -35.4;
5962  G4double c1 = -0.737;
5963  G4double c2 = 1.28;
5964 
5965  if(ix <= 7) {
5966  q[0][1]=939.50;
5967  q[1][1]=938.21;
5968  q[1][2]=1876.1;
5969  q[1][3]=2809.39;
5970  q[2][4]=3728.34;
5971  q[2][3]=2809.4;
5972  q[2][5]=4668.8;
5973  q[2][6]=5606.5;
5974  q[3][5]=4669.1;
5975  q[3][6]=5602.9;
5976  q[3][7]=6535.27;
5977  q[4][6]=5607.3;
5978  q[4][7]=6536.1;
5979  q[5][7]=6548.3;
5980  find=q[iz][ix];
5981  }
5982  else {
5983  G4double xneu=xx-zz;
5984  G4double si=(xneu-zz)/xx;
5985  G4double x13=std::pow(xx,.333);
5986  G4double ee1=c1*zz*zz/x13;
5987  G4double ee2=c2*zz*zz/xx;
5988  G4double aux=1.+(9.*xjj/4./qq/x13);
5989  G4double ee3=xjj*xx*si*si/aux;
5990  G4double ee4=avol*xx+asur*(std::pow(xx,.666))+ac*x13+azer;
5991  G4double tota = ee1 + ee2 + ee3 + ee4;
5992  find = 939.55*xneu+938.77*zz - tota;
5993  }
5994 
5995  (*x_par) = x;
5996  (*z_par) = z;
5997  (*find_par) = find;
5998 }
5999 //
6000 
6001 void G4Abla::FillData(G4int IMULTBU,G4int IEV_TAB){
6002 
6003  const G4double c = 29.9792458;
6004  const G4double fmp = 938.27231,fmn=939.56563,fml=1115.683;
6005 
6006  varntp->ntrack = IMULTBU + IEV_TAB;
6007 
6008  G4int intp=0;
6009 
6010  for(G4int i=0;i<IMULTBU;i++){
6011 
6012  G4int iz = nint(BU_TAB[i][7]);
6013  G4int ia = nint(BU_TAB[i][8]);
6014  G4int is = nint(BU_TAB[i][11]);
6015 
6016  Ainit = Ainit + ia;
6017  Zinit = Zinit + iz;
6018  Sinit = Sinit - is;
6019 
6020  varntp->zvv[intp] = iz;
6021  varntp->avv[intp] = ia;
6022  varntp->svv[intp] = -1*is;
6023  varntp->itypcasc[intp] = 0;
6024 
6025  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];
6026  G4double gamma = std::sqrt(1.0 - v2 / (c*c));
6027  G4double avvmass = iz*fmp + (ia-iz-is)*fmn + is*fml + eflmac(ia,iz,0,3);
6028  G4double etot = avvmass / gamma;
6029  varntp->pxlab[intp] = etot * BU_TAB[i][4] / c;
6030  varntp->pylab[intp] = etot * BU_TAB[i][5] / c;
6031  varntp->pzlab[intp] = etot * BU_TAB[i][6] / c;
6032  varntp->enerj[intp] = etot - avvmass;
6033  intp++;
6034  }
6035 
6036 
6037  for(G4int i=0;i<IEV_TAB;i++){
6038 
6039  G4int iz = nint(EV_TAB[i][0]);
6040  G4int ia = nint(EV_TAB[i][1]);
6041  G4int is = EV_TAB[i][5];
6042 
6043  varntp->itypcasc[intp] = 0;
6044 
6045  if(ia>0){// normal particles
6046  varntp->zvv[intp] = iz;
6047  varntp->avv[intp] = ia;
6048  varntp->svv[intp] = -1*is;
6049  Ainit = Ainit + ia;
6050  Zinit = Zinit + iz;
6051  Sinit = Sinit - is;
6052  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];
6053  G4double gamma = std::sqrt(1.0 - v2 / (c*c));
6054  G4double avvmass = iz*fmp + (ia-iz-is)*fmn + is*fml + eflmac(ia,iz,0,3);
6055  G4double etot = avvmass / gamma;
6056  varntp->pxlab[intp] = etot * EV_TAB[i][2] / c;
6057  varntp->pylab[intp] = etot * EV_TAB[i][3] / c;
6058  varntp->pzlab[intp] = etot * EV_TAB[i][4] / c;
6059  varntp->enerj[intp] = etot - avvmass;
6060  }else if(ia==-2){// lambda0
6061  varntp->zvv[intp] = 0;
6062  varntp->avv[intp] = 1;
6063  varntp->svv[intp] = -1;
6064  Ainit = Ainit + 1;
6065  Sinit = Sinit - 1;
6066  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];
6067  G4double gamma = std::sqrt(1.0 - v2 / (c*c));
6068  G4double avvmass = fml;
6069  G4double etot = avvmass / gamma;
6070  varntp->pxlab[intp] = etot * EV_TAB[i][2] / c;
6071  varntp->pylab[intp] = etot * EV_TAB[i][3] / c;
6072  varntp->pzlab[intp] = etot * EV_TAB[i][4] / c;
6073  varntp->enerj[intp] = etot - avvmass;
6074  }else{// photons
6075  varntp->zvv[intp] = iz;
6076  varntp->avv[intp] = ia;
6077  varntp->svv[intp] = 0;
6078  Ainit = Ainit + ia;
6079  Zinit = Zinit + iz;
6080  Sinit = Sinit - is;
6081  varntp->pxlab[intp] = EV_TAB[i][2];
6082  varntp->pylab[intp] = EV_TAB[i][3];
6083  varntp->pzlab[intp] = EV_TAB[i][4];
6084  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]);
6085  }
6086  intp++;
6087  }
6088 //
6089  return;
6090 }
6091 
6092 // Utilities
6093 
6094 G4double G4Abla::min(G4double a, G4double b)
6095 {
6096  if(a < b) {
6097  return a;
6098  }
6099  else {
6100  return b;
6101  }
6102 }
6103 
6104 G4int G4Abla::min(G4int a, G4int b)
6105 {
6106  if(a < b) {
6107  return a;
6108  }
6109  else {
6110  return b;
6111  }
6112 }
6113 
6114 G4double G4Abla::max(G4double a, G4double b)
6115 {
6116  if(a > b) {
6117  return a;
6118  }
6119  else {
6120  return b;
6121  }
6122 }
6123 
6124 G4int G4Abla::max(G4int a, G4int b)
6125 {
6126  if(a > b) {
6127  return a;
6128  }
6129  else {
6130  return b;
6131  }
6132 }
6133 
6134 G4double G4Abla::DSIGN(G4double a, G4double b){
6135 // A function that assigns the sign of the second argument to the
6136 // absolute value of the first
6137 
6138  if(b>=0){
6139  return std::abs(a);
6140  }else{
6141  return -1.0*std::abs(a);
6142  }
6143  return 0;
6144 }
6145 
6146 G4int G4Abla::ISIGN(G4int a, G4int b){
6147 // A function that assigns the sign of the second argument to the
6148 // absolute value of the first
6149 
6150  if(b>=0){
6151  return std::abs(a);
6152  }else{
6153  return -1*std::abs(a);
6154  }
6155  return 0;
6156 }
6157 
6158 G4int G4Abla::nint(G4double number)
6159 {
6160  G4double intpart = 0.0;
6161  G4double fractpart = 0.0;
6162  fractpart = std::modf(number, &intpart);
6163  if(number == 0) {
6164  return 0;
6165  }
6166  if(number > 0) {
6167  if(fractpart < 0.5) {
6168  return G4int(std::floor(number));
6169  }
6170  else {
6171  return G4int(std::ceil(number));
6172  }
6173  }
6174  if(number < 0) {
6175  if(fractpart < -0.5) {
6176  return G4int(std::floor(number));
6177  }
6178  else {
6179  return G4int(std::ceil(number));
6180  }
6181  }
6182 
6183  return G4int(std::floor(number));
6184 }
6185 
6186 G4int G4Abla::secnds(G4int x)
6187 {
6188  time_t mytime;
6189  tm *mylocaltime;
6190 
6191  time(&mytime);
6192  mylocaltime = localtime(&mytime);
6193 
6194  if(x == 0) {
6195  return(mylocaltime->tm_hour*60*60 + mylocaltime->tm_min*60 + mylocaltime->tm_sec);
6196  }
6197  else {
6198  return(mytime - x);
6199  }
6200 }
6201 
6202 G4int G4Abla::mod(G4int a, G4int b)
6203 {
6204  if(b != 0) {
6205  return a%b;
6206  }
6207  else {
6208  return 0;
6209  }
6210 }
6211 
6212 G4double G4Abla::dint(G4double x)
6213 {
6214  G4double value = 0.0;
6215 /*
6216  if(a < 0.0) {
6217  value = double(std::ceil(a));
6218  }
6219  else {
6220  value = double(std::floor(a));
6221  }
6222 */
6223  if(x-std::floor(x) <= std::ceil(x)-x)
6224  value = G4double(std::floor(x));
6225  else
6226  value = G4double(std::ceil(x));
6227 
6228  return value;
6229 }
6230 
6231 G4int G4Abla::idint(G4double x)
6232 {
6233  G4int value = 0;
6234  if(x-std::floor(x) <= std::ceil(x)-x)
6235  value = G4int(std::floor(x));
6236  else
6237  value = G4int(std::ceil(x));
6238 
6239  return value;
6240 }
6241 
6242 G4int G4Abla::idnint(G4double x)
6243 {
6244  if(x-std::floor(x) <= std::ceil(x)-x)
6245  return G4int(std::floor(x));
6246  else
6247  return G4int(std::ceil(x));
6248 }
6249 
6250 G4double G4Abla::dmin1(G4double a, G4double b, G4double c)
6251 {
6252  if(a < b && a < c) {
6253  return a;
6254  }
6255  if(b < a && b < c) {
6256  return b;
6257  }
6258  if(c < a && c < b) {
6259  return c;
6260  }
6261  return a;
6262 }
6263 
6264 G4double G4Abla::utilabs(G4double a)
6265 {
6266  return std::abs(a);
6267 }
6268 
6269 
6270 G4double G4Abla::width(G4double AMOTHER,G4double ZMOTHER,G4double APART,G4double ZPART,G4double TEMP,G4double B1,G4double SB1,G4double EXC)
6271 {
6272 /*
6273 * Implemented by JLRS for Abla c++: 06/11/2016
6274 *
6275 C Last update:
6276 C 28/10/13 - JLRS - from abrablav4 (AK)
6277 */
6278  G4int IZPART,IAPART,NMOTHER;
6279  G4double B,HBAR,PI,RGEOM,MPART,SB;
6280  G4double BKONST,C,C2,G,APARTNER,MU;
6281  G4double INT1,INT2,INT3,AKONST,EARG,R0,MPARTNER;
6282  G4double AEXP;
6283  G4double ARG;
6284  G4double PAR_A1=0.,PAR_B1=0.,FACT=1.;
6285  G4double fwidth=0.;
6286  G4int idlamb0=0;
6287  PI=3.141592654;
6288 
6289  if(ZPART==-2.){
6290  ZPART=0.;
6291  idlamb0=1;
6292  }
6293 
6294  IZPART = idnint(ZPART);
6295  IAPART = idnint(APART);
6296 
6297  B = B1;
6298  SB = SB1;
6299  NMOTHER = idnint(AMOTHER-ZMOTHER);
6300 
6301  PAR_A1 = 0.0;
6302  PAR_B1 = 0.0;
6303 
6304  if(SB>EXC){
6305  return fwidth=0.0;
6306  }else{
6307 // in MeV*s
6308  HBAR = 6.582122e-22;
6309 // HBAR2 = HBAR * HBAR
6310 // in m/s
6311  C = 2.99792458e8;
6312  C2 = C * C;
6313  APARTNER = AMOTHER - APART;
6314  MPARTNER = APARTNER * 931.49 / C2;
6315 
6316 // g=(2s+1)
6317  if(IAPART==1&&IZPART==0){
6318  G = 2.0;
6319  MPART = 939.56 / C2;
6320  if(idlamb0==1)MPART = 1115.683 / C2;
6321  }else{
6322  if(IAPART==1&&IZPART==1){
6323  G = 2.0;
6324  MPART = 938.27 / C2;
6325  }
6326  else{
6327  if(IAPART==2&&IZPART==0){
6328  G = 1.0;
6329  MPART = 2.*939.56 / C2;
6330  }else{
6331  if(IAPART==2&&IZPART==1){
6332  G = 3.0;
6333  MPART = 1876.10 / C2;
6334  }else{
6335  if(IAPART==3&&IZPART==1){
6336  G = 2.0;
6337  MPART = 2809.39 / C2;
6338  }else{
6339  if(IAPART==3&&IZPART==2){
6340  G = 2.0;
6341  MPART = 2809.37 / C2;
6342  }else{
6343  if(IAPART==4&&IZPART==2){
6344  G = 1.0;
6345  MPART = 3728.35 / C2;
6346  }else{
6347  // IMF
6348  G = 1.0;
6349  MPART = APART * 931.49 / C2;
6350  }
6351  }
6352  }
6353  }
6354  }
6355  }
6356  }//end g
6357 
6358 // Relative mass in MeV*s^2/m^2
6359  MU = MPARTNER * MPART / (MPARTNER + MPART);
6360 // in m
6361  R0 = 1.16e-15;
6362 
6363  RGEOM = R0 * (std::pow(APART,1.0/3.0)+std::pow(AMOTHER-APART,1.0/3.0));
6364 
6365 // in m*sqrt(MeV)
6366  AKONST = HBAR*std::sqrt(1.0 / MU);
6367 
6368 // in 1/(MeV*m^2)
6369  BKONST = MPART / ( PI * PI * HBAR * HBAR);
6370 //
6371 // USING ANALYTICAL APPROXIMATION
6372 
6373  INT1 = 2.0 * std::pow(TEMP,3.) / (2.0 * TEMP + B);
6374 
6375  ARG = std::sqrt(B/TEMP);
6376  EARG = (erf(ARG) - 1.0);
6377  if(std::abs(EARG)<1.e-9) EARG = 0.0;
6378  if(B==0.0){
6379  INT2 = 0.5 * std::sqrt(PI) * std::pow(TEMP,3.0/2.0);
6380  }else{
6381  AEXP = B/TEMP;
6382  if(AEXP>700.0) AEXP = 700.0;
6383  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;
6384  if(INT2<0.0) INT2 = 0.0;
6385 // For very low temperatures when EARG=0, INT2 get unreasonably high values
6386 // comming from the first term. Therefore, for these cases INT2 is set to 0.
6387  if(EARG==0.0) INT2 = 0.0;
6388  }//if B
6389 
6390  INT3 = 2.0*TEMP*TEMP*TEMP / (2.0*TEMP*TEMP + 4.0*B*TEMP + B*B);
6391 
6392  if(IZPART<-1.0&&ZMOTHER<151.0){
6393 // IF(IZPART.LT.1)THEN
6394 // For neutrons, the width is given by a mean value between geometrical and QM values;
6395 // Only QM contribution (Rgeom -> Rgeom + Rlamda) seems to be too strong for neutrons
6396  fwidth = PI * BKONST * G * std::sqrt((RGEOM * RGEOM * INT1 + 2.0 * AKONST * RGEOM * INT2 + AKONST * AKONST * INT3) * RGEOM * RGEOM * INT1);
6397 
6398  }else{
6399  fwidth = PI * BKONST * G *(RGEOM * RGEOM * INT1 + 2.0 * AKONST * RGEOM * INT2 + AKONST * AKONST * INT3);
6400  }
6401 
6402 
6403 // To correct for too high values of analytical width compared to
6404 // numerical solution for energies close to the particle threshold:
6405  if(IZPART<3.0){
6406  if(AMOTHER<155.0){
6407  PAR_A1=std::exp(2.302585*0.2083*std::exp(-0.01548472*AMOTHER))-0.05;
6408  PAR_B1 = 0.59939389 + 0.00915657 * AMOTHER;
6409  }else{
6410  if(AMOTHER>154.0&&AMOTHER<195.0){
6411  PAR_A1=1.0086961-8.629e-5*AMOTHER;
6412  PAR_B1 = 1.5329331 + 0.00302074 * AMOTHER;
6413  }else{
6414  if(AMOTHER>194.0&&AMOTHER<208.0){
6415  PAR_A1=9.8356347-0.09294663*AMOTHER+2.441e-4*AMOTHER*AMOTHER;
6416  PAR_B1 = 7.7701987 - 0.02897401 * AMOTHER;
6417  }else{
6418  if(AMOTHER>207.0&&AMOTHER<228.0){
6419  PAR_A1=15.107385-0.12414415*AMOTHER+2.7222e-4*AMOTHER*AMOTHER;
6420  PAR_B1=-64.078009+0.56813179*AMOTHER-0.00121078*AMOTHER*AMOTHER;
6421  }else{
6422  if(AMOTHER>227.0){
6423  if(mod(NMOTHER,2)==0&&NMOTHER>147.){
6424  PAR_A1 = 2.0*(0.9389118 + 6.4559e-5 * AMOTHER);
6425  }else{
6426  if(mod(NMOTHER,2)==1)PAR_A1 = 3.0*(0.9389118 + 6.4559e-5 * AMOTHER);
6427  }
6428  PAR_B1 = 2.1507177 + 0.00146119 * AMOTHER;
6429  }
6430  }
6431  }
6432  }
6433  }
6434  FACT = std::exp((2.302585*PAR_A1*std::exp(-PAR_B1*(EXC-SB))));
6435  if(FACT<1.0) FACT = 1.0;
6436  if(IZPART<-1.&&ZMOTHER<151.0){
6437 // IF(IZPART.LT.1)THEN
6438  fwidth = fwidth / std::sqrt(FACT);
6439  }else{
6440  fwidth = fwidth / FACT;
6441  }
6442  }//if IZPART<3.0
6443 
6444  if(fwidth<=0.0){
6445  std::cout <<"LOOK IN PARTICLE_WIDTH!" << std::endl;
6446  std::cout <<"ACN,APART :"<< AMOTHER << APART << std::endl;
6447  std::cout <<"EXC,TEMP,B,SB :" << EXC << " " << TEMP << " " << B << " " << SB << std::endl;
6448  std::cout <<"INTi, i=1-3 :" << INT1 << " " << INT2 << " " << INT3 << std::endl;
6449  std::cout <<" " << std::endl;
6450  }
6451 
6452  }//if SB>EXC
6453  return fwidth;
6454 }
6455 
6456 G4double G4Abla::pen(G4double A, G4double ap, G4double omega, G4double T)
6457 {
6458 // JLRS: 06/11/2016
6459 // CORRECTIONS FOR BARRIER PENETRATION
6460 // AK, KHS 2005 - Energy-dependen inverse cross sections included, influence of
6461 // Coulomb barrier for LCP, tunnelling for LCP
6462 
6463  G4double fpen=0., MU, HO;
6464 
6465 // REDUCED MASSES (IN MeV/C**2)
6466  MU = (A - ap) * ap / A;
6467 
6468 // ENERGY OF THE INVERSE PARABOLA AT THE POTENTIAL BARRIER (hbar*omega);
6469 // HERE hbar = 197.3287 fm*MeV/c, omega is in c/fm
6470  HO = 197.3287 * omega;
6471 
6472  if(T<=0.0){
6473  fpen = 0.0;
6474  }else{
6475  fpen=std::pow(10.0,4.e-4*std::pow(T/(HO*HO*std::pow(MU,0.25)),-4.3/2.3026));
6476  }
6477 
6478  return fpen;
6479 }
6480 
6481 void G4Abla::bsbkbc(G4double A,G4double Z,G4double *BS,G4double *BK,G4double *BC)
6482 {
6483 // Calculate BS and BK needed for a level-density parameter:
6484 // BETA2 and BETA4 = quadrupole and hexadecapole deformation
6485 
6486  G4double PI = 3.14159265;
6487  G4int IZ = idnint(Z);
6488  G4int IN = idnint(A - Z);
6489 // alphaN = sqrt(2*N/(4*pi))*BetaN
6490  G4double ALPHA2 = std::sqrt(5.0/(4.0*PI))*ecld->beta2[IN][IZ];
6491  G4double ALPHA4 = std::sqrt(9.0/(4.0*PI))*ecld->beta4[IN][IZ];
6492 
6493  (*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;
6494 
6495  (*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;
6496 
6497  (*BC)=0.0;
6498 
6499  return;
6500 }
6501 
6502 G4double G4Abla::fvmaxhaz( G4double T)
6503 {
6504 // Random generator according to a distribution similar to a
6505 // Maxwell distribution with quantum-mech. x-section for charged particles according to KHS
6506 // Y = X**(1.5E0) / (B+X) * EXP(-X/T) (approximation:)
6507 
6508 return (3.0 * T * std::pow(-1.*std::log(G4AblaRandom::flat()) * std::log(G4AblaRandom::flat())*std::log(G4AblaRandom::flat()),0.333333));
6509 }
6510 
6511 G4double G4Abla::func_trans(G4double TIME,G4double ZF,G4double AF,G4double bet,G4double Y,G4double FT,G4double T_0)
6512 {
6513 /*
6514 c This function determines the fission width as a function o time
6515 c according to the analytical solution of the FPE for the probability distribution
6516 c at the barrier when the nucleus potential is aproximated by a parabolic
6517 c potential. It is taken from S. Chandrasekhar, Rev. Mod. Phys. 15 (1943) 1
6518 c
6519 c***********************INPUT PARAMETERS*********************************
6520 c Time Time at which we evaluate the fission width
6521 c ZF Z of nucleus
6522 C AF A of nucleus
6523 c BET Reduced dissipation coefficient
6524 c FT Nuclear temperature
6525 C**************************************************************************
6526 C********************************OUTPUT***********************************
6527 C Fission decay width at the corresponding time of the decay cascade
6528 C*************************************************************************
6529 c****************************OTHER VARIABLES******************************
6530 C SIGMA_SQR Square of the width of the prob. distribution
6531 C XB Deformation of the nucleus at the saddle point
6532 c NORM Normalization factor of the probability distribution
6533 c W Probability distribution at the saddle deformation XB
6534 c W_INFIN Probability distr. at XB at infinite time
6535 c MFCD Mass of the fission collective degree of freedom
6536 C*************************************************************************
6537 */
6538  G4double PI = 3.14159;
6539  G4double DEFO_INIT,OMEGA,HOMEGA,OMEGA_GS,HOMEGA_GS,K1,MFCD;
6540  G4double BET1,XACT,SIGMA_SQR,W_EXP,XB,NORM,SIGMA_SQR_INF,W_INFIN,W;
6541  G4double FUNC_TRANS,LOG_SLOPE_INF,LOG_SLOPE_ABS;
6542 //
6543 // Influence of initial deformation
6544 // Initial alpha2 deformation (GS)
6545  DEFO_INIT = std::sqrt(5.0/(4.0*PI))*ecld->beta2[fiss->at-fiss->zt][fiss->zt];
6546 //
6547  fomega_sp(AF,Y,&MFCD,&OMEGA,&HOMEGA);
6548  fomega_gs(AF,ZF,&K1,&OMEGA_GS,&HOMEGA_GS);
6549 //
6550 // Determination of the square of the width of the probability distribution
6551 // For the overdamped regime BET**2 > 4*OMEGA**2
6552  if((bet*bet)>4.0*OMEGA_GS*OMEGA_GS){
6553  BET1=std::sqrt(bet*bet-4.0*OMEGA_GS*OMEGA_GS);
6554 //
6555 // REMEMBER THAT HOMEGA IS ACTUALLY HBAR*HOMEGA1=1MeV
6556 // SO THAT HOMEGA1 = HOMEGA/HBAR
6557 //
6558  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)));
6559 //
6560 // Evolution of the mean x-value (KHS March 2006)
6561  XACT = DEFO_INIT *std::exp(-0.5*(bet-BET1)*1.e21*(TIME-T_0));
6562 //
6563  }else{
6564 // For the underdamped regime BET**2 < 4*HOMEGA**2 BET1 becomes a complex number
6565 // and the expression with sinh and cosh can be transformed in one with sin and cos
6566  BET1=std::sqrt(4.0*OMEGA_GS*OMEGA_GS-bet*bet);
6567  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));
6568  XACT = DEFO_INIT*std::cos(0.5*BET1*1.e21*(TIME-T_0))*std::exp(-bet*1.e21*(TIME-T_0));
6569  }
6570 
6571 // Determination of the deformation at the saddle point according to
6572 // "Geometrical relationships of Macroscopic Nucl. Phys." from Hass and Myers page 100
6573 // This corresponds to alpha2 deformation.
6574  XB = 7./3.*Y-938./765.*Y*Y+9.499768*Y*Y*Y-8.050944*Y*Y*Y*Y;
6575 //
6576 // Determination of the probability distribution at the saddle deformation
6577 //
6578  if(SIGMA_SQR>0.0){
6579  NORM = 1./std::sqrt(2.*PI*SIGMA_SQR);
6580 //
6581  W_EXP = -1.*(XB - XACT)*(XB - XACT)/(2.0 * SIGMA_SQR);
6582  if(W_EXP<(-708.0) ) W_EXP = -708.0;
6583  W = NORM * std::exp( W_EXP ) * FT / (K1 * SIGMA_SQR);
6584  }else{
6585  W = 0.0;
6586  }
6587 //
6588 // Determination of the fission decay width, we assume we are in the overdamped regime
6589 //
6590  SIGMA_SQR_INF = FT/K1;
6591  W_EXP = -XB*XB/(2.0 * SIGMA_SQR_INF);
6592  if(W_EXP<(-708.0))W_EXP = -708.0;
6593  W_INFIN = std::exp(W_EXP)/std::sqrt(2.0*PI*SIGMA_SQR_INF);
6594  FUNC_TRANS = W / W_INFIN;
6595 //
6596 // Correction for the variation of the mean velocity at the fission barrier
6597 // (see B. Jurado et al, Nucl. Phys. A747, p. 14)
6598 //
6599  LOG_SLOPE_INF = cram(bet,HOMEGA)*bet*MFCD*OMEGA/FT;
6600  LOG_SLOPE_ABS = (XB-XACT)/SIGMA_SQR-XB/SIGMA_SQR_INF+cram(bet,HOMEGA)*bet*MFCD*OMEGA/FT;
6601 //
6602  FUNC_TRANS = FUNC_TRANS * LOG_SLOPE_ABS/LOG_SLOPE_INF;
6603 //
6604  return FUNC_TRANS;
6605 }
6606 
6607 
6608 void G4Abla::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)
6609 {
6610 /*
6611 C THIS SUBROUTINE IS AIMED TO CHOOSE BETWEEN PARTICLE EMISSION
6612 C AND FISSION
6613 C WE USE MONTE-CARLO METHODS AND SAMPLE TIME BETWEEN T=0 AND T=1.5*TAUF
6614 c TO SIMULATE THE TRANSIENT TIME WITH 30 STEPS (0.05*TAUF EACH)
6615 C FOR t>1.5*TAUF , GF=CONSTANT=ASYMPTOTICAL VALUE (INCLUDING KRAMERS FACTOR)
6616 c------------------------------------------------------------------------
6617 c Modifications introduced by BEATRIZ JURADO 18/10/01:
6618 c 1. Now this subrutine is included in the rutine direct
6619 c 2. TSUM does not include the current particle decay time
6620 C 3. T_LAPSE is the time until decay, taken as an output variable
6621 C 4. GF_LOC is also taken as an output variable
6622 C 5. BET (Diss. Coeff.) and HOMEGA (Frequency at the ground state
6623 c are included as input variables because they are needed for FUNC_TRANS
6624 C-----------------------------------------------------------------------
6625 C ON INPUT:
6626 C GP Partial particle decay width
6627 C GF Asymptotic value of Gamma-f, including Kramers factor
6628 C AF Mass number of nucleus
6629 C TAUF Transient time
6630 C TS1 Partial particle decay time for the next step
6631 C TSUM Total sum of partial particle decay times, including
6632 C the next expected one, which is in competition
6633 C with fission now
6634 C ZF Z of nucleus
6635 C AF A of nucleus
6636 C-----------------------------------------------------------------------
6637 C ON OUTPUT:
6638 C CHOICE Key for decay mode: 0 = no decay (only internal)
6639 C 1 = evaporation
6640 C 2 = fission
6641 C-----------------------------------------------------------------------
6642 C VARIABLES:
6643 C GP Partial particle decay width
6644 C GF Asymptotic value of Gamma-f, including Kramers factor
6645 C TAUF Transient time
6646 C TS1 Partial particle decay time
6647 C TSUM Total sum of partial particle decay times
6648 C CHOICE Key for decay mode
6649 C ZF Z of nucleus
6650 C AF A of nucleus
6651 C FT Used for Fermi function in FUNC_TRANS
6652 C STEP_LENGTH Step in time to sample different decays
6653 C BEGIN_TIME Total sum of partial particle decay times, excluding
6654 C the next expected one, which is in competition
6655 C with fission now
6656 C LOC_TIME_BEGIN Begin of time interval considered in one step
6657 C LOC_TIME_END End of time interval considered in one step
6658 C GF_LOC In-grow function for fission width,
6659 c normalized to asymptotic value
6660 C TS2 Effective partial fission decay time in one time step
6661 C HBAR hbar
6662 C T_LAPSE Effective decay time in one time step
6663 C REAC_PROB Reaction probability in one time step
6664 C X Help variable for random generator
6665 C------------------------------------------------------------------------
6666 */
6667  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;
6668  G4double HBAR=6.582122e-22;
6669  G4int fchoice=0;
6670  G4double fGF_LOC=0.,fT_LAPSE=0.;
6671 //
6672  if(GF<=0.0){
6673  *CHOICE = 1;
6674  *T_LAPSE=TS1;
6675  *GF_LOC = 0.0;
6676  goto direct107;
6677  }
6678 //
6679  fomega_gs(AF,ZF,&K1,&OMEGA,&HOMEGA);
6680 //
6681 // ****************************************************************
6682 // Calculation of the shift in time due to the initial conditions
6683 //
6684 // Overdamped regime
6685  if(BET*BET>4.0*OMEGA*OMEGA){
6686 // REMEMBER THAT HOMEGA IS ACTUALLY HBAR*HOMEGA1=1MeV
6687 // SO THAT HOMEGA1 = HOMEGA/HBAR
6688 // Additional factor 1/16 proposed by KHS on 14/7/2010. Takes into
6689 // account the fact that the curvature of the potential is ~16 times
6690 // larger than what predicted by the liquid drop model, because of
6691 // shell effects.
6692  t_0 = BET*1.e21*HBAR*HBAR/(4.*HOMEGA*FT)/16.;
6693  }else{
6694 // Underdamped regime
6695  if(((2.*FT-HOMEGA/16.)>0.000001) && BET>0.0){
6696 // Additional factor 1/16 proposed by KHS on 14/7/2010. Takes into
6697 // account the fact that the curvature of the potential is ~16 times
6698 // larger than what predicted by the liquid drop model, because of
6699 // shell effects.
6700  t_0 = (std::log(2.*FT/(2.*FT-HOMEGA/16.)))/(BET*1.e21);
6701  }else{
6702 // Neglect fission transients if the time shift t_0 is too
6703 // large. Suppresses large, spurious fission cross section at very
6704 // low excitation energy in p+Ta.
6705 //
6706  fchoice = 0;
6707  goto direct106;
6708  }
6709  }
6710 // ********************************************************************+
6711  fchoice = 0;
6712  STEP_LENGTH = 1.5*TAUF/50.;
6713 //
6714 // AT FIRST WE CACULATE THE REAL CURRENT TIME
6715 // TSUM includes only the time elapsed in the previous steps
6716 //
6717  BEGIN_TIME = TSUM + t_0;
6718 //
6719  if(BEGIN_TIME<0.0) std::cout << "CURRENT TIME < 0" << BEGIN_TIME << std::endl;
6720 //
6721  if(BEGIN_TIME<1.50*TAUF){
6722  LOC_TIME_BEGIN = BEGIN_TIME;
6723 //
6724  while((LOC_TIME_BEGIN<1.5*TAUF)&&fchoice==0){
6725 
6726  LOC_TIME_END = LOC_TIME_BEGIN + STEP_LENGTH;
6727 //
6728 // NOW WE ESTIMATE THE MEAN VALUE OF THE FISSION WIDTH WITHIN THE SMALL INTERVAL
6729  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;
6730 //
6731  fGF_LOC = fGF_LOC * GF;
6732 
6733 // TS2 IS THE MEAN DECAY TIME OF THE FISSION CHANNEL
6734  if(fGF_LOC>0.0){
6735  TS2 = HBAR/fGF_LOC;
6736  }else{
6737  TS2 = 0.0;
6738  }
6739 //
6740  if(TS2>0.0){
6741  LAMBDA = 1.0/TS1 + 1.0/TS2;
6742  }else{
6743  LAMBDA = 1.0/TS1;
6744  }
6745 //
6746 // This is the probability to survive the decay at this step
6747  REAC_PROB = std::exp(-1.0*STEP_LENGTH*LAMBDA);
6748 // I GENERATE A RANDOM NUMBER
6749  X = G4AblaRandom::flat();
6750  if(X>REAC_PROB){
6751 // THEN THE EVAPORATION OR FISSION HAS OCCURED
6752  FISS_PROB = fGF_LOC / (fGF_LOC+GP);
6753  X = G4AblaRandom::flat();
6754 // WRITE(6,*)'X=',X
6755  if(X<FISS_PROB){
6756 // FISSION OCCURED
6757  fchoice = 2;
6758  }else{
6759 // EVAPORATION OCCURED
6760  fchoice = 1;
6761  }
6762  }// if x
6763  LOC_TIME_BEGIN = LOC_TIME_END;
6764  }// while
6765 // Take the real decay time of this decay step
6766  fT_LAPSE = LOC_TIME_END - BEGIN_TIME;
6767  }// if BEGIN_TIME
6768 //
6769 // NOW, IF NOTHING HAPPENED DURING TRANSIENT TIME
6770  direct106:
6771  if(fchoice==0){
6772  fGF_LOC=GF;
6773  FISS_PROB = GF / (GF+GP);
6774 
6775 // Added for cases where already at the beginning BEGIN_TIME > 1.5d0*TAUF
6776  if(GF>0.0){
6777  TS2 = HBAR/GF;
6778  }else{
6779  TS2 = 0.0;
6780  }
6781 
6782  if(TS2>0.0){
6783  LAMBDA = 1./TS1 + 1./TS2;
6784  }else{
6785  LAMBDA = 1./TS1;
6786  }
6787 //
6788  X = G4AblaRandom::flat();
6789 
6790  if(X<FISS_PROB){
6791 // FISSION OCCURED
6792  fchoice = 2;
6793  }else{
6794 // EVAPORATION OCCURED
6795  fchoice = 1;
6796  }
6797 //
6798 //TIRAGE ALEATOIRE DANS UNE EXPONENTIELLLE : Y=EXP(-X/T)
6799 // EXPOHAZ=-T*LOG(HAZ(K))
6800  fT_LAPSE = fT_LAPSE -1.0/LAMBDA*std::log(G4AblaRandom::flat());
6801  }
6802 //
6803  direct107:
6804 
6805  (*T_LAPSE)=fT_LAPSE;
6806  (*GF_LOC)=fGF_LOC;
6807  (*CHOICE)=fchoice;
6808  return;
6809 }
6810 
6811 G4double G4Abla::tunnelling(G4double A,G4double ZPRF,G4double Y,G4double EE,G4double EF,G4double TEMP,G4double DENSG,G4double DENSF,G4double ENH_FACT)
6812 {
6813 // Subroutine to caluclate fission width with included effects
6814 // of tunnelling through the fission barrier
6815 
6816  G4double PI = 3.14159;
6817  G4int IZ, IN;
6818  G4double MFCD,OMEGA,HOMEGA1,HOMEGA2=0.,GFTUN;
6819  G4double E1,E2,EXP_FACT,CORR_FUNCT,FACT1,FACT2,FACT3;
6820 
6821  IZ = idnint(ZPRF);
6822  IN = idnint(A-ZPRF);
6823 
6824 // For low energies system "sees" LD barrier
6825  fomega_sp(A,Y,&MFCD,&OMEGA,&HOMEGA1);
6826 
6827  if(mod(IN,2)==0&&mod(IZ,2)==0){ // e-e
6828 // Due to pairing gap, even-even nuclei cannot tunnel for excitation energy lower
6829 // than pairing gap (no levels at which system can be)
6830  EE = EE - 12.0/std::sqrt(A);
6831  HOMEGA2 = 1.04;
6832  }
6833 
6834  if(mod(IN,2)==1&&mod(IZ,2)==1){ // o-o
6835  HOMEGA2 = 0.65;
6836  }
6837 
6838  if(mod(IN,2)==1&&mod(IZ,2)==0){ // o-e
6839  HOMEGA2 = 0.8;
6840  }
6841 
6842  if(mod(IN,2)==0&&mod(IZ,2)==1){ // e-0
6843  HOMEGA2 = 0.8;
6844  }
6845 
6846  E1 = EF + HOMEGA1/2.0/PI*std::log(HOMEGA1*(2.0*PI+HOMEGA2)/4.0/PI/PI);
6847 
6848  E2 = EF + HOMEGA2/(2.0*PI)*std::log(1.0+2.0*PI/HOMEGA2);
6849 
6850 // AKH May 2013 - Due to approximations in the analytical integration, at energies
6851 // just above barrier Pf was to low, at energies below
6852 // barrier it was somewhat higher. LInes below are supposed to correct for this.
6853 // Factor 0.20 in EXP_FACT comes from the slope of the Pf(Eexc) (Gavron's data)
6854 // around fission barrier.
6855  EXP_FACT = (EE-EF)/(HOMEGA2/(2.0*PI));
6856  if(EXP_FACT>700.0) EXP_FACT = 700.0;
6857  CORR_FUNCT = HOMEGA1 * (1.0-1.0/(1.0+std::exp(EXP_FACT)));
6858  if(mod(IN,2)==0&&mod(IZ,2)==0){
6859  CORR_FUNCT = HOMEGA1 * (1.0-1.0/(1.0+std::exp(EXP_FACT)));
6860  }
6861 
6862  FACT1 = HOMEGA1/(2.0*PI*TEMP+HOMEGA1);
6863  FACT2 = (2.0*PI/(2.0*PI+HOMEGA2)-HOMEGA1*(2.0*PI+HOMEGA2)/4.0/PI/PI)/(E2-E1);
6864  FACT3 = HOMEGA2/(2.0*PI*TEMP-HOMEGA2);
6865 
6866  if(EE<E1){
6867  GFTUN = FACT1*(std::exp(EE/TEMP)*std::exp(2.0*PI*(EE-EF)/HOMEGA1)-std::exp(-2.0*PI*EF/HOMEGA1));
6868  }else{
6869  if(EE>=E1&&EE<E2){
6870  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));
6871  }else{
6872  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));
6873  }
6874  }
6875  GFTUN = GFTUN/std::exp(EE/TEMP)*DENSF*ENH_FACT/DENSG/2.0/PI;
6876  GFTUN = GFTUN * CORR_FUNCT;
6877  return GFTUN;
6878 }
6879 
6880 
6881 void 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)
6882 {
6883 //
6884  G4double FNORM,MASS_ASYM_SADD_B,FP_PER,FP_PAR,SIG_PER_SP,SIG_PAR_SP;
6885  G4double Z2OVERA,ftemp,fgf,DENSF,ECOR,EROT,qr;
6886  G4double DCR,UCR,ENH_FACTA,ENH_FACTB,ENH_FACT,PONFE;
6887  G4double PI = 3.14159;
6888 
6889  DCR = fiss->dcr;
6890  UCR = fiss->ucr;
6891  Z2OVERA = ZPRF * ZPRF / A;
6892 
6893 // Nuclei below Businaro-Gallone point do not go through fission
6894  if((ZPRF<=55.0) || (FF_ALLOWED==0)){
6895  (*GF) = 0.0;
6896  (*TEMP) = 0.5;
6897  return;
6898  }
6899 
6900 // Level density above SP
6901 // Saddle-point deformation is defbet as above. But, FP_PER and FP_PAR
6902 // are calculated for fission in DENSNIV acc to Myers and Hasse, and their
6903 // parametrization is done as function of y
6904  densniv(A,ZPRF,EE,EF,&DENSF,0.0,BS,BK,&ftemp,OPTSHP,0,Y,&ECOR,JPR,1,&qr);
6905 
6906  if(OPTCOL==0){
6907  fgf= DENSF/DENSG/PI/2.0*ftemp;
6908  (*TEMP)=ftemp;
6909  (*GF)= fgf;
6910  return;
6911  }
6912 
6913 // FP = 2/5*M0*R0**2/HBAR**2 * A**(5/3) * (1 + DEFBET/3)
6914 // FP is used to calculate the spin-cutoff parameter SIG=FP*TEMP/hbar**2; hbar**2
6915 // is, therefore, included in FP in order to avoid problems with large exponents
6916 // The factor fnorm inlcudes then R0, M0 and hbar**2 -
6917 // fnorm = R0*M0/hbar**2 = 1.2fm*931.49MeV/c**2 /(6.582122e-22 MeVs)**2 and is
6918 // in units 1/MeV
6919  FNORM = 1.2*1.2 * 931.49 * 1.e-2 / (9.0 * 6.582122*6.582122);
6920 // FP_PER ~ 1+7*y/6, FP_PAR ~ 1-7*y/3 (Hasse & Myers, Geom. relat. macr. nucl. phys.)
6921 // Perpendicular moment of inertia
6922  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));
6923 
6924 // AK - Jan 2011 - following line is needed, as for these nuclei it seems that
6925 // FP_PER calculated according to above formula has too large values, leading to too
6926 // large ENH_FACT
6927  if(Z2OVERA<=30.0) FP_PER = 6.50;
6928 
6929 // Parallel moment of inertia
6930  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));
6931  if(FP_PAR<0.0) FP_PAR = 0.0;
6932 
6933  EROT = JPR * JPR / (2.0 * std::sqrt(FP_PAR*FP_PAR + FP_PER*FP_PER));
6934  if(IEROT==1) EROT = 0.0;
6935 
6936 // Perpendicular spin cut-off parameter
6937  SIG_PER_SP = std::sqrt(FP_PER * ftemp);
6938 
6939  if(SIG_PER_SP<1.0) SIG_PER_SP = 1.0;
6940 
6941 // Parallel spin cut-off parameter
6942  SIG_PAR_SP = std::sqrt(FP_PAR * ftemp);
6943  ENH_FACT = 1.0;
6944 //
6945  if(A>223.0){
6946  MASS_ASYM_SADD_B = 2.0;
6947  }else{
6948  MASS_ASYM_SADD_B = 1.0;
6949  }
6950 
6951 // actinides with low barriers
6952  if(Z2OVERA>35.&&Z2OVERA<=(110.*110./298.0)){
6953 // Barrier A is axial asymmetric
6954  ENH_FACTA = std::sqrt(8.0*PI) * SIG_PER_SP*SIG_PER_SP * SIG_PAR_SP;
6955 // Barrier B is axial symmetric
6956  ENH_FACTB = MASS_ASYM_SADD_B * SIG_PER_SP*SIG_PER_SP;
6957 // Total enhancement
6958  ENH_FACT = ENH_FACTA * ENH_FACTB / (ENH_FACTA + ENH_FACTB);
6959  }else{
6960 // nuclei with high fission barriers (only barrier B plays a role, axial symmetric)
6961  if(Z2OVERA<=35.){
6962  ENH_FACT = MASS_ASYM_SADD_B*SIG_PER_SP*SIG_PER_SP;
6963  }else{
6964 // super-heavy nuclei (only barrier A plays a role, axial asymmetric)
6965  ENH_FACT = std::sqrt(8.0*PI) * SIG_PER_SP*SIG_PER_SP* SIG_PAR_SP;
6966  }
6967  }
6968 
6969 // Fading-out with excitation energy above the saddle point:
6970  PONFE = (ECOR-UCR-EROT)/DCR;
6971  if(PONFE>700.) PONFE = 700.0;
6972 // Fading-out according to Junghans:
6973  ENH_FACT = 1.0/(1.0+std::exp(PONFE))*ENH_FACT+1.0;
6974 
6975  if(ENH_FACT<1.0)ENH_FACT = 1.0;
6976  fgf= DENSF/DENSG/PI/2.0*ftemp*ENH_FACT;
6977 
6978 // Tunneling
6979  if(EE<EF+1.){
6980  fgf=tunnelling(A,ZPRF,Y,EE,EF,ftemp,DENSG,DENSF,ENH_FACT);
6981  }
6982 //
6983  (*GF)= fgf;
6984  (*TEMP)=ftemp;
6985  return;
6986 }
6987 
6988 
6989 void G4Abla::lorb(G4double AMOTHER,G4double ADAUGHTER,G4double LMOTHER,G4double EEFINAL,G4double *LORBITAL,G4double *SIGMA_LORBITAL)
6990 {
6991 
6992  G4double AFRAGMENT,S4FINAL,ALEVDENS;
6993  G4double THETA_MOTHER,THETA_ORBITAL;
6994 
6995 /*
6996 C Values on input:
6997 C AMOTHER mass of mother nucleus
6998 C ADAUGHTER mass of daughter fragment
6999 C LMOTHER angular momentum of mother (may be real)
7000 C EEFINAL excitation energy after emission
7001 C (sum of daughter and fragment)
7002 C
7003 C Values on output:
7004 C LORBITAL mean value of orbital angular momentum
7005 C (assumed to be fully aligned with LMOTHER)
7006 C SIGMA_LORBITAL standard deviation of the orbital angular momentum
7007 */
7008  if (EEFINAL<=0.01) EEFINAL = 0.01;
7009  AFRAGMENT = AMOTHER - ADAUGHTER;
7010  ALEVDENS = 0.073*AMOTHER + 0.095*std::pow(AMOTHER,2.0/3.0);
7011  S4FINAL = ALEVDENS * EEFINAL;
7012  if(S4FINAL <= 0.0 || S4FINAL > 100000.){
7013  std::cout<< "S4FINAL:" << S4FINAL << ALEVDENS << EEFINAL << idnint(AMOTHER) << idnint(AFRAGMENT) << std::endl;
7014  }
7015  THETA_MOTHER = 0.0111 * std::pow(AMOTHER,1.66667);
7016  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);
7017 
7018  *LORBITAL = -1.* THETA_ORBITAL * (LMOTHER / THETA_MOTHER + std::sqrt(S4FINAL) /(ALEVDENS*LMOTHER));
7019 
7020  *SIGMA_LORBITAL = std::sqrt(std::sqrt(S4FINAL) * THETA_ORBITAL / ALEVDENS);
7021 
7022  return;
7023 }
7024 
7025 // Random generator according to a distribution similar to a
7026 // Maxwell distribution with quantum-mech. x-section for neutrons according to KHS
7027 // Y = SQRT(X) * EXP(-X/T) (approximation:)
7028 G4double G4Abla::fvmaxhaz_neut(G4double x){
7029 
7030  return (2.0 * x * std::sqrt(std::log(G4AblaRandom::flat()) * std::log(G4AblaRandom::flat())));
7031 }
7032 
7033 void G4Abla::imf(G4double ACN,G4double ZCN,G4double TEMP,G4double EE,G4double *ZIMF,G4double *AIMF,G4double *BIMF,G4double *SBIMF,G4double *TIMF,G4double JPRF)
7034 {
7035 // input variables (compound nucleus) Acn, Zcn, Temp, EE
7036 // output variable (IMF) Zimf,Aimf,Bimf,Sbimf,IRNDM
7037 //
7038 // SBIMF = separation energy + coulomb barrier
7039 //
7040 // SDW(Z) is the sum over all isotopes for a given Z of the decay widths
7041 // DW(Z,A) is the decay width of a certain nuclide
7042 //
7043 // Last update:
7044 // 28/10/13 - JLRS - from abrablav4 (AK)
7045 // 13/11/16 - JLRS - Included this function in Abla++
7046 
7047  G4int IZIMFMAX=0;
7048  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;
7049  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;
7050  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;
7051  G4double PI = 3.141592653589793238;
7052  G4double ZIMF_1=0.0;
7053  G4double SDWprevious=0,SUMDW_TOT=0,SUM_Z=0,X=0,SUMDW_N_TOT=0,XX=0;
7054  G4double SDW[98];
7055  G4double DW[98][251];
7056  G4double BBIMF[98][251];
7057  G4double SSBIMF[98][251];
7058  G4int OPTSHPIMF=opt->optshpimf;
7059 
7060 // take the half of the CN and transform it in integer (floor it)
7061  IZIMFMAX = idnint(ZCN / 2.0);
7062 
7063  if(IZIMFMAX<3){
7064  std::cout << "CHARGE_IMF line 46" << std::endl;
7065  std::cout << "Problem: IZIMFMAX < 3 " << std::endl;
7066  std::cout << "ZCN,IZIMFMAX," << ZCN << "," << IZIMFMAX << std::endl;
7067  }
7068 
7069  iz = idnint(ZCN);
7070  in = idnint(ACN) - iz;
7071  BSHELL = ecld->ecgnz[in][iz]- ecld->vgsld[in][iz];
7072  DEFBET = ecld->beta2[in][iz];
7073 
7074  bsbkbc(ACN,ZCN,&BS,&BK,&BC);
7075 
7076  densniv(ACN,ZCN,EE,0.0,&DENSCN,BSHELL,BS,BK,&TEMPCN,0,0,DEFBET,&ECOR,JPRF,0,&QRCN);
7077 
7078  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);
7079  EROTCN = JPRF * JPRF * 197.328 * 197.328 /(2. * IINERT);
7080 //
7081  for(IZIMF=3;IZIMF<=IZIMFMAX;IZIMF++){
7082 
7083  SDW[IZIMF] = 0.0;
7084  ZIMF_1 = 1.0*IZIMF;
7085 
7086 // *** Find the limits that both IMF and partner are bound :
7087 
7088  isostab_lim(IZIMF,&INIMFMI,&INIMFMA);// Bound isotopes for IZIMF from INMIN to INIMFMA
7089 // Idea - very proton-rich nuclei can live long enough to evaporate IMF before decaying:
7090  INIMFMI = max(1,INIMFMI-2);
7091 
7092  IZCN = idnint(ZCN); // Z of CN
7093  INCN = idnint(ACN) - IZCN; // N of CN
7094 
7095  isostab_lim(IZCN-IZIMF,&INMI,&INMA); // Daughter nucleus after IMF emission,
7096  // limits of bound isotopes
7097  INMI = max(1,INMI-2);
7098  INMIN = max(INIMFMI,INCN-INMA); // Both IMF and daughter must be bound
7099  INNMAX = min(INIMFMA,INCN-INMI); // "
7100 
7101  ILIMMAX = max(INNMAX,INMIN); // In order to keep the variables below
7102 // ***
7103 
7104  for(G4int INIMF=INMIN;INIMF<=ILIMMAX;INIMF++){ // Range of possible IMF isotopes
7105  IAIMF = IZIMF + INIMF;
7106  DW[IZIMF][IAIMF] = 0.0;
7107  AIMF_1 = 1.0*(IAIMF);
7108 
7109 // Q-values
7110  mglms(ACN-AIMF_1,ZCN-ZIMF_1,OPTSHPIMF,&MARES);
7111  mglms(AIMF_1,ZIMF_1,OPTSHPIMF,&MAIMF);
7112  mglms(ACN,ZCN,OPTSHPIMF,&MAZ);
7113 
7114 // Barrier
7115  if(ACN<=AIMF_1){
7116  SSBIMF[IZIMF][IAIMF] = 1.e37;
7117  }else{
7118  barrs(idnint(ZCN-ZIMF_1),idnint(ACN-AIMF_1),idnint(ZIMF_1),idnint(AIMF_1),&fBIMF,&OMEGAP);
7119  SSBIMF[IZIMF][IAIMF] = MAIMF + MARES - MAZ + fBIMF;
7120  BBIMF[IZIMF][IAIMF] = fBIMF;
7121  }
7122 
7123 // ***** Width *********************
7124  DEFBETIMF = ecld->beta2[idnint(AIMF_1-ZIMF_1)][idnint(ZIMF_1)]+ecld->beta2[idnint(ACN-AIMF_1-ZCN+ZIMF_1)][idnint(ZCN-ZIMF_1)];
7125 
7126  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));
7127 
7128  EROT = JPRF * JPRF * 197.328 * 197.328 /(2.0 * IINERT);
7129 
7130  // IF(IEROT.EQ.1) EROT = 0.D0
7131  if (EE<(SSBIMF[IZIMF][IAIMF]+EROT) || DENSCN<=0.0){
7132  WIDTH_IMF = 0.0;
7133 // PRINT*,IDNINT(ACN),IDNINT(ZCN),IZIMF,IAIMF
7134  }else{
7135 // here the temperature at "saddle point" is used
7136 // Increase of the level densitiy at the barrier due to deformation; see comment in ABLA
7137 // BSIMF = ((ACN-AIMF_1)**(2.D0/3.D0) + AIMF_1**(2.D0/3.D0))/
7138 // & ACN**(2.D0/3.D0)
7139  BSIMF = BS;
7140  densniv(ACN,ZCN,EE,SSBIMF[IZIMF][IAIMF],&DENSIMF,0.0,BSIMF,1.0,&fTIMF,0,0,DEFBETIMF,&ECOR,JPRF,2,&QR);
7141  IMFARG = (SSBIMF[IZIMF][IAIMF]+EROTCN-EROT)/fTIMF;
7142  if(IMFARG>200.0) IMFARG = 200.0;
7143 
7144  WIDTH1 = width(ACN,ZCN,AIMF_1,ZIMF_1,fTIMF,fBIMF,SSBIMF[IZIMF][IAIMF],EE-EROT);
7145 
7146  WIDTH_IMF = WIDTH1 * std::exp(-IMFARG) * QR / QRCN;
7147 
7148  if(WIDTH_IMF<=0.0){
7149  std::cout << "GAMMA_IMF=0 -> LOOK IN GAMMA_IMF CALCULATIONS!" << std::endl;
7150  std::cout << "ACN,ZCN,AIMF,ZIMF:" << idnint(ACN) << "," << idnint(ZCN) << "," << idnint(AIMF_1) << "," << idnint(ZIMF_1) << std::endl;
7151  std::cout << "SSBIMF,TIMF :" << SSBIMF[IZIMF][IAIMF] << "," << fTIMF << std::endl;
7152  std::cout << "DEXP(-IMFARG) = " << std::exp(-IMFARG) << std::endl;
7153  std::cout << "WIDTH1 =" << WIDTH1 << std::endl;
7154  }
7155  }// if ee
7156 
7157  SDW[IZIMF] = SDW[IZIMF] + WIDTH_IMF;
7158 
7159  DW[IZIMF][IAIMF] = WIDTH_IMF;
7160 
7161  }// for INIMF
7162  }// for IZIMF
7163 // End loop to calculate the decay widths ************************
7164 // ***************************************************************
7165 
7166 // Loop to calculate where the gamma of IMF has the minimum ******
7167  SDWprevious = 1.e20;
7168  IZSTOP = 0;
7169 
7170  for(G4int III_ZIMF=3;III_ZIMF<=IZIMFMAX;III_ZIMF++){
7171 
7172  if(SDW[III_ZIMF]==0.0){
7173  IZSTOP = III_ZIMF - 1;
7174  goto imfs30;
7175  }
7176 
7177  if(SDW[III_ZIMF]>SDWprevious){
7178  IZSTOP = III_ZIMF - 1;
7179  goto imfs30;
7180  }else{
7181  SDWprevious = SDW[III_ZIMF];
7182  }
7183 
7184  }// for III_ZIMF
7185 
7186  imfs30:
7187 
7188  if(IZSTOP<=6){
7189  IZSTOP = IZIMFMAX;
7190  goto imfs15;
7191  }
7192 
7193  A1PAR = std::log10(SDW[IZSTOP]/SDW[IZSTOP-2])/std::log10((1.0*IZSTOP)/(1.0*IZSTOP-2.0));
7194  A2PAR = std::log10(SDW[IZSTOP]) - A1PAR * std::log10(1.0*(IZSTOP));
7195  if(A2PAR>0.)A2PAR=-1.*A2PAR;
7196  if(A1PAR>0.)A1PAR=-1.*A1PAR;
7197 
7198 // End loop to calculate where gamma of IMF has the minimum
7199 
7200  for(G4int II_ZIMF = IZSTOP;II_ZIMF<=IZIMFMAX;II_ZIMF++){
7201  SDW[II_ZIMF] = std::pow(10.0,A2PAR) * std::pow(1.0*II_ZIMF,A1PAR); // Power-low
7202  if(SDW[II_ZIMF]<0.0) SDW[II_ZIMF] = 0.0;
7203  }
7204 
7205  imfs15:
7206 
7207 // Sum of all decay widths (for normalisation)
7208  SUMDW_TOT = 0.0;
7209  for(G4int I_ZIMF = 3;I_ZIMF<=IZIMFMAX;I_ZIMF++){
7210  SUMDW_TOT = SUMDW_TOT + SDW[I_ZIMF];
7211  }
7212  if(SUMDW_TOT<=0.0){
7213  std::cout << "*********************" << std::endl;
7214  std::cout << "IMF function" << std::endl;
7215  std::cout << "SUM of decay widths = " << SUMDW_TOT << " IZIMFMAX = " << IZIMFMAX << std::endl;
7216  std::cout << "IZSTOP = " << IZSTOP << std::endl;
7217  }
7218 
7219 // End of Sum of all decay widths (for normalisation)
7220 
7221 // Loop to sample the nuclide that is emitted ********************
7222 // ------- sample Z -----------
7223  imfs10:
7224  X = haz(1)*SUMDW_TOT;
7225 
7226 // IF(X.EQ.0.D0) PRINT*,'WARNING: X=0',XRNDM,SUMDW_TOT
7227  SUM_Z = 0.0;
7228  fZIMF = 0.0;
7229  IZMEM = 0;
7230 
7231  for(G4int IZ = 3;IZ<=IZIMFMAX;IZ++){
7232  SUM_Z = SUM_Z + SDW[IZ];
7233  if(X<SUM_Z){
7234  fZIMF = 1.0*IZ;
7235  IZMEM = IZ;
7236  goto imfs20;
7237  }
7238  }//for IZ
7239 
7240  imfs20:
7241 
7242 // ------- sample N -----------
7243 
7244  isostab_lim(IZMEM,&INMINMEM,&INMAXMEM);
7245  INMINMEM = max(1,INMINMEM-2);
7246 
7247  isostab_lim(IZCN-IZMEM,&INMI,&INMA); // Daughter nucleus after IMF emission,
7248  INMI = max(1,INMI-2);
7249  // limits of bound isotopes
7250 
7251  INMINMEM = max(INMINMEM,INCN-INMA); // Both IMF and daughter must be bound
7252  INMAXMEM = min(INMAXMEM,INCN-INMI); // "
7253 
7254  INMAXMEM = max(INMINMEM,INMAXMEM);
7255 
7256  IA = 0;
7257  SUMDW_N_TOT = 0.0;
7258  for(G4int IIINIMF = INMINMEM;IIINIMF<=INMAXMEM;IIINIMF++){
7259  IA = IZMEM + IIINIMF;
7260  if(IZMEM>=3&&IZMEM<=95&&IA>=4&&IA<=250){
7261  SUMDW_N_TOT = SUMDW_N_TOT + DW[IZMEM][IA];
7262  }else{
7263  std::cout << "CHARGE IMF OUT OF RANGE" << IZMEM << ", " << IA << ", " << idnint(ACN) << ", " << idnint(ZCN) << ", " << TEMP << std::endl;
7264  }
7265  }
7266 
7267  XX = haz(1)*SUMDW_N_TOT;
7268  IIA = 0;
7269  SUM_A = 0.0;
7270  for(G4int IINIMF = INMINMEM;IINIMF<=INMAXMEM; IINIMF++){
7271  IIA = IZMEM + IINIMF;
7272  // SUM_A = SUM_A + DW[IZ][IIA]; //FIXME
7273  SUM_A = SUM_A + DW[IZMEM][IIA];
7274  if(XX<SUM_A){
7275  fAIMF = G4double(IIA);
7276  goto imfs25;
7277  }
7278  }
7279 
7280  imfs25:
7281 // CHECK POINT 1
7282  NIMF = fAIMF - fZIMF;
7283 
7284  if((ACN-ZCN-NIMF)<=0.0 || (ZCN-fZIMF) <= 0.0){
7285  std::cout << "IMF Partner unstable:" << std::endl;
7286  std::cout << "System: Acn,Zcn,NCN:" << std::endl;
7287  std::cout << idnint(ACN) << ", " << idnint(ZCN) << ", " << idnint(ACN-ZCN) << std::endl;
7288  std::cout << "IMF: A,Z,N:" << std::endl;
7289  std::cout << idnint(fAIMF) << ", " << idnint(fZIMF) << ", " << idnint(fAIMF-fZIMF) << std::endl;
7290  std::cout << "Partner: A,Z,N:" << std::endl;
7291  std::cout << idnint(ACN-fAIMF) << ", " << idnint(ZCN-fZIMF) << ", " << idnint(ACN-ZCN-NIMF) << std::endl;
7292  std::cout << "----nmin,nmax" << INMINMEM << ", " << INMAXMEM << std::endl;
7293  std::cout << "----- warning: Zimf=" << fZIMF << " Aimf=" << fAIMF << std::endl;
7294  std::cout << "----- look in subroutine IMF" << std::endl;
7295  std::cout << "ACN,ZCN,ZIMF,AIMF,temp,EE,JPRF::" << ACN << ", " << ZCN << ", " << fZIMF << ", " << fAIMF << ", " << TEMP << ", " << EE << ", " << JPRF << std::endl;
7296 std::cout << "-IZSTOP,IZIMFMAX:" << IZSTOP << ", " << IZIMFMAX << std::endl;
7297 std::cout << "----X,SUM_Z,SUMDW_TOT:" << X << ", " << SUM_Z << ", " << SUMDW_TOT << std::endl;
7298 //for(int III_ZIMF=3;III_ZIMF<=IZIMFMAX;III_ZIMF++)
7299  // std::cout << "-**Z,SDW:" << III_ZIMF << ", " << SDW[III_ZIMF] << std::endl;
7300 
7301  goto imfs10;
7302  }
7303  if(fZIMF>=ZCN || fAIMF>=ACN || fZIMF<=2 || fAIMF<=3){
7304  std::cout << "----nmin,nmax" << INMINMEM << ", " << INMAXMEM << std::endl;
7305  std::cout << "----- warning: Zimf=" << fZIMF << " Aimf=" << fAIMF << std::endl;
7306  std::cout << "----- look in subroutine IMF" << std::endl;
7307  std::cout << "ACN,ZCN,ZIMF,AIMF,temp,EE,JPRF:" << ACN << ", " << ZCN << ", " << fZIMF << ", " << fAIMF << ", " << TEMP << ", " << EE << ", " << JPRF << std::endl;
7308 std::cout << "-IZSTOP,IZIMFMAX:" << IZSTOP << ", " << IZIMFMAX << std::endl;
7309 std::cout << "----X,SUM_Z,SUMDW_TOT:" << X << ", " << SUM_Z << ", " << SUMDW_TOT << std::endl;
7310 for(int III_ZIMF=3;III_ZIMF<=IZIMFMAX;III_ZIMF++)
7311  std::cout << "-**Z,SDW:" << III_ZIMF << ", " << SDW[III_ZIMF] << std::endl;
7312 
7313  fZIMF = 3.0; // provisorisch AK
7314  fAIMF = 4.0;
7315  }
7316 
7317 // Characteristics of selected IMF (AIMF, ZIMF, BIMF, SBIMF, TIMF)
7318  fSBIMF = SSBIMF[idnint(fZIMF)][idnint(fAIMF)];
7319  fBIMF = BBIMF[idnint(fZIMF)][idnint(fAIMF)];
7320 
7321  if((ZCN-fZIMF)<=0.0)std::cout << "CHARGE_IMF ZIMF > ZCN" << std::endl;
7322  if((ACN-fAIMF)<=0.0)std::cout << "CHARGE_IMF AIMF > ACN" << std::endl;
7323 
7324  BSHELL = ecld->ecgnz[idnint(ACN-ZCN-NIMF)][idnint(ZCN-fZIMF)] -ecld->vgsld[idnint(ACN-ZCN-NIMF)][idnint(ZCN-fZIMF)];
7325 
7326  DEFBET = ecld->beta2[idnint(ACN-ZCN-NIMF)][idnint(ZCN-fZIMF)];
7327  EEDAUG = (EE - fSBIMF) * (ACN - fAIMF) / ACN;
7328  bsbkbc(ACN - fAIMF,ZCN-fZIMF,&BS,&BK,&BC);
7329  densniv(ACN-fAIMF,ZCN-fZIMF,EEDAUG,0.0,&DENSIMF,BSHELL,BS,BK,&fTIMF,0,0,DEFBET,&ECOR,0.0,0,&QR);
7330 
7331  if(fSBIMF>EE){
7332  std::cout << "----- warning: EE=" << EE << "," << " S+Bimf=" << fSBIMF << std::endl;
7333  std::cout << "----- look in subroutine IMF" << std::endl;
7334  std::cout << "IMF will be resampled" << std::endl;
7335  goto imfs10;
7336  }
7337  (*ZIMF) = fZIMF;
7338  (*AIMF) = fAIMF;
7339  (*SBIMF) = fSBIMF;
7340  (*BIMF) = fBIMF;
7341  (*TIMF) = fTIMF;
7342  return;
7343 }
7344 
7345 void G4Abla::isostab_lim(G4int z, G4int *nmin, G4int *nmax)
7346 {
7347 
7348 G4int VISOSTAB[191][2]={
7349  {0 , 7 },
7350  {1 , 8 },
7351  {1 , 9 },
7352  {2 , 12 },
7353  {2 , 14 },
7354  {2 , 16 },
7355  {3 , 18 },
7356  {4 , 22 },
7357  {6 , 22 },
7358  {6 , 28 },
7359  {7 , 28 },
7360  {7 , 30 },
7361  {8 , 28 },
7362  {8 , 36 },
7363  {10 , 38 },
7364  {10 , 40 },
7365  {11 , 38 },
7366  {10 , 42 },
7367  {13 , 50 },
7368  {14 , 50 },
7369  {15 , 52 },
7370  {16 , 52 },
7371  {17 , 54 },
7372  {18 , 54 },
7373  {19 , 60 },
7374  {19 , 62 },
7375  {21 , 64 },
7376  {20 , 66 },
7377  {23 , 66 },
7378  {24 , 70 },
7379  {25 , 70 },
7380  {26 , 74 },
7381  {27 , 78 },
7382  {29 , 82 },
7383  {33 , 82 },
7384  {31 , 82 },
7385  {35 , 82 },
7386  {34 , 84 },
7387  {40 , 84 },
7388  {36 , 86 },
7389  {40 , 92 },
7390  {38 , 96 },
7391  {42 , 102 },
7392  {42 , 102 },
7393  {44 , 102 },
7394  {42 , 106 },
7395  {47 , 112 },
7396  {44 , 114 },
7397  {49 , 116 },
7398  {46 , 118 },
7399  {52 , 120 },
7400  {52 , 124 },
7401  {55 , 126 },
7402  {54 , 126 },
7403  {57 , 126 },
7404  {57 , 126 },
7405  {60 , 126 },
7406  {58 , 130 },
7407  { 62 , 132 },
7408  { 60 , 140 },
7409  { 67 , 138 },
7410  { 64 , 142 },
7411  { 67 , 144 },
7412  { 68 , 146 },
7413  { 70 , 148 },
7414  { 70 , 152 },
7415  { 73 , 152 },
7416  { 72 , 154 },
7417  { 75 , 156 },
7418  { 77 , 162 },
7419  { 79 , 164 },
7420  { 78 , 164 },
7421  { 82 , 166 },
7422  { 80 , 166 },
7423  { 85 , 168 },
7424  { 83 , 176 },
7425  { 87 , 178 },
7426  { 88 , 178 },
7427  { 91 , 182 },
7428  { 90 , 184 },
7429  { 96 , 184 },
7430  { 95 , 184 },
7431  { 99 , 184 },
7432  { 98 , 184 },
7433  { 105 , 194 },
7434  { 102 , 194 },
7435  { 108 , 196 },
7436  { 106 , 198 },
7437  { 115 , 204 },
7438  { 110 , 206 },
7439  { 119 , 210 },
7440  { 114 , 210 },
7441  { 124 , 210 },
7442  { 117 , 212 },
7443  { 130 , 212 }
7444  };
7445 
7446  if (z<0){
7447  *nmin = 0;
7448  *nmax = 0;
7449  }else{
7450  if(z==0){
7451  *nmin = 1;
7452  *nmax = 1;
7453 // AK (Dez2010) - Just to avoid numerical problems
7454  }else{
7455  if(z>95){
7456  *nmin = 130;
7457  *nmax = 200;
7458  }else{
7459  *nmin = VISOSTAB[z-1][0];
7460  *nmax = VISOSTAB[z-1][1];
7461  }
7462  }
7463  }
7464 
7465  return;
7466 }
7467 
7468 
7469 void 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){
7470 
7471 // AK 2006 - Now in case of fission deexcitation between saddle and scission
7472 // is explicitely calculated. Langevin calculations made by P. Nadtochy
7473 // used to parametrise saddle-to-scission time
7474 
7475  G4double af,zf,ee;
7476  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;
7477  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;
7478  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;
7479 
7480  G4double xcv=0.,ycv=0.,zcv=0.,VXOUT=0.,VYOUT=0.,VZOUT=0.;
7481 
7482  G4double jprfn=0.0, jprfp=0.0, jprfd=0.0, jprft=0.0, jprfhe=0.0, jprfa=0.0, jprflamb0=0.0;
7483  G4double ctet1 = 0.0, stet1 = 0.0, phi1 = 0.0;
7484  G4double rnd = 0.0;
7485 
7486  G4int itest = 0, sortie=0;
7487  G4double probf = 0.0;
7488 
7489  G4double ef = 0.0;
7490  G4double pc = 0.0;
7491 
7492  G4double time,tauf,tau0,a0,a1,emin,ts1,tsum=0.;
7493  G4int inttype=0,inum=0,gammadecay = 0, flamb0decay = 0;
7494  G4double pleva = 0.0;
7495  G4double pxeva = 0.0;
7496  G4double pyeva = 0.0;
7497  G4double pteva = 0.0;
7498  G4double etot = 0.0;
7499  G4int NbLam0= (*NbLam0_par);
7500 
7501  const G4double c = 29.9792458;
7502  const G4double mu = 931.494;
7503  const G4double mu2 = 931.494*931.494;
7504 
7505  vx_eva=0.;
7506  vy_eva=0.;
7507  vz_eva=0.;
7508  IEV_TAB_SSC = 0;
7509 
7510 
7511  af = dint(A);
7512  zf = dint(Z);
7513  ee = EXC;
7514 
7515  fiss->ifis = 0;
7516  opt->optimfallowed = 0;
7517  gammaemission=0;
7518 // Initialsation
7519  time = 0.0;
7520 
7521 // in sec
7522  tau0 = 1.0e-21;
7523  a0 = 0.66482503 - 3.4678935 * std::exp(-0.0104002*ee);
7524  a1 = 5.6846e-04 + 0.00574515 * std::exp(-0.01114307*ee);
7525  tauf = (a0 + a1 * zf*zf/std::pow(af,0.3333333)) * tau0;
7526 //
7527  post10:
7528  direct(zf,af,ee,0.,&probp,&probd,&probt,&probn,&probhe,&proba,&probg,&probimf,&probf,&problamb0,&ptotl,
7529  &sn,&sbp,&sbd,&sbt,&sbhe,&sba,&slamb0,
7530  &ecn,&ecp,&ecd,&ect,&eche,&eca,&ecg,&eclamb0,
7531  &bp,&bd,&bt,&bhe,&ba,&sp,&sd,&st,&she,&sa,&ef,&ts1,inttype,inum,itest,&sortie,&tcn,
7532  &jprfn, &jprfp, &jprfd, &jprft, &jprfhe, &jprfa, &jprflamb0, &tsum, NbLam0); //:::FIXME::: Call
7533 //
7534 // HERE THE FINAL STEPS OF THE EVAPORATION ARE CALCULATED
7535 //
7536  if(ptotl<=0.)goto post100;
7537 
7538  emin = dmin1(sba,sbhe,dmin1(sbt,sbhe,dmin1(sn,sbp,sbd)));
7539 
7540  if(emin>1e30)std::cout << "ERROR AT THE EXIT OF EVAPORA,E>1.D30,AF" << std::endl;
7541 
7542  if(sortie==1){
7543  if (probn!=0.0) {
7544  amoins = 1.0;
7545  zmoins = 0.0;
7546  epsiln = sn + ecn;
7547  pc = std::sqrt(std::pow((1.0 + ecn/9.3956e2),2.) - 1.0) * 9.3956e2;
7548  gammadecay = 0;
7549  flamb0decay = 0;
7550  }
7551  else if(probp!=0.0){
7552  amoins = 1.0;
7553  zmoins = 1.0;
7554  epsiln = sp + ecp;
7555  pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2.) - 1.0) * 9.3827e2;
7556  gammadecay = 0;
7557  flamb0decay = 0;
7558  }
7559  else if(probd!=0.0){
7560  amoins = 2.0;
7561  zmoins = 1.0;
7562  epsiln = sd + ecd;
7563  pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
7564  gammadecay = 0;
7565  flamb0decay = 0;
7566  }
7567  else if(probt!=0.0){
7568  amoins = 3.0;
7569  zmoins = 1.0;
7570  epsiln = st + ect;
7571  pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
7572  gammadecay = 0;
7573  flamb0decay = 0;
7574  }
7575  else if(probhe!=0.0){
7576  amoins = 3.0;
7577  zmoins = 2.0;
7578  epsiln = she + eche;
7579  pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
7580  gammadecay = 0;
7581  flamb0decay = 0;
7582  }
7583  else{ if(proba!=0.0){
7584  amoins = 4.0;
7585  zmoins = 2.0;
7586  epsiln = sa + eca;
7587  pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
7588  gammadecay = 0;
7589  flamb0decay = 0;
7590  }
7591  }
7592  goto post99;
7593  }
7594 
7595  // IRNDM = IRNDM+1;
7596 //
7597 // HERE THE NORMAL EVAPORATION CASCADE STARTS
7598 // RANDOM NUMBER FOR THE EVAPORATION
7599 
7600 
7601  // random number for the evaporation
7602  x = G4AblaRandom::flat() * ptotl;
7603 
7604  itest = 0;
7605  if (x < proba) {
7606  // alpha evaporation
7607  amoins = 4.0;
7608  zmoins = 2.0;
7609  epsiln = sa + eca;
7610  pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
7611  gammadecay = 0;
7612  flamb0decay = 0;
7613  }
7614  else if (x < proba+probhe) {
7615  // He3 evaporation
7616  amoins = 3.0;
7617  zmoins = 2.0;
7618  epsiln = she + eche;
7619  pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
7620  gammadecay = 0;
7621  flamb0decay = 0;
7622  }
7623  else if (x < proba+probhe+probt) {
7624  // triton evaporation
7625  amoins = 3.0;
7626  zmoins = 1.0;
7627  epsiln = st + ect;
7628  pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
7629  gammadecay = 0;
7630  flamb0decay = 0;
7631  }
7632  else if (x < proba+probhe+probt+probd) {
7633  // deuteron evaporation
7634  amoins = 2.0;
7635  zmoins = 1.0;
7636  epsiln = sd + ecd;
7637  pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
7638  gammadecay = 0;
7639  flamb0decay = 0;
7640  }
7641  else if (x < proba+probhe+probt+probd+probp) {
7642  // proton evaporation
7643  amoins = 1.0;
7644  zmoins = 1.0;
7645  epsiln = sp + ecp;
7646  pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2) - 1.0) * 9.3827e2;
7647  gammadecay = 0;
7648  flamb0decay = 0;
7649  }
7650  else if (x < proba+probhe+probt+probd+probp+probn) {
7651  // neutron evaporation
7652  amoins = 1.0;
7653  zmoins = 0.0;
7654  epsiln = sn + ecn;
7655  pc = std::sqrt(std::pow((1.0 + ecn/9.3956e2),2.) - 1.0) * 9.3956e2;
7656  gammadecay = 0;
7657  flamb0decay = 0;
7658  }
7659  else if (x < proba+probhe+probt+probd+probp+probn+problamb0) {
7660  // lambda0 evaporation
7661  amoins = 1.0;
7662  zmoins = 0.0;
7663  epsiln = slamb0 + eclamb0;
7664  pc = std::sqrt(std::pow((1.0 + (eclamb0)/11.1568e2),2.) - 1.0) * 11.1568e2;
7665  opt->nblan0 = opt->nblan0 -1;
7666  NbLam0 = NbLam0 -1;
7667  gammadecay = 0;
7668  flamb0decay = 1;
7669  }
7670  else if (x < proba+probhe+probt+probd+probp+probn+problamb0+probg) {
7671  // gamma evaporation
7672  amoins = 0.0;
7673  zmoins = 0.0;
7674  epsiln = ecg;
7675  pc = ecg;
7676  gammadecay = 1;
7677  flamb0decay = 0;
7678  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){
7679  //ee = ee-epsiln;
7680  //if(ee<=0.01) ee = 0.010;
7681  goto post100;
7682  }
7683  }
7684 
7685 // CALCULATION OF THE DAUGHTER NUCLEUS
7686 //
7687  post99:
7688 
7689  if(gammadecay==1 && ee<=0.01+epsiln){
7690  epsiln = ee-0.01;
7691  time = tauf + 1.;
7692  }
7693 
7694  af = af-amoins;
7695  zf = zf-zmoins;
7696  ee = ee-epsiln;
7697 
7698  if(ee<=0.01) ee = 0.010;
7699 
7700  if(af<2.5) goto post100;
7701 
7702  time = time + ts1;
7703 
7704 // Determination of x,y,z components of momentum from known emission momentum
7705  if(flamb0decay==1){
7706  EV_TAB_SSC[IEV_TAB_SSC][0] = 0.;
7707  EV_TAB_SSC[IEV_TAB_SSC][1] = -2.;
7708  EV_TAB_SSC[IEV_TAB_SSC][5] = 1.;
7709  }else{
7710  EV_TAB_SSC[IEV_TAB_SSC][0] = zmoins;
7711  EV_TAB_SSC[IEV_TAB_SSC][1] = amoins;
7712  EV_TAB_SSC[IEV_TAB_SSC][5] = 0.;
7713  }
7714 
7715  rnd = G4AblaRandom::flat();
7716  ctet1 = 2.0*rnd - 1.0; // z component: uniform probability between -1 and 1
7717  stet1 = std::sqrt(1.0 - std::pow(ctet1,2));// component perpendicular to z
7718  rnd = G4AblaRandom::flat();
7719  phi1 = rnd*2.0*3.141592654; // angle in x-y plane: uniform probability between 0 and 2*pi
7720  xcv = stet1*std::cos(phi1); // x component
7721  ycv = stet1*std::sin(phi1); // y component
7722  zcv = ctet1; // z component
7723 // In the CM system
7724  if(gammadecay==0){
7725 // Light particle
7726  G4double ETOT_LP = std::sqrt(pc*pc + amoins*amoins * mu2);
7727  if(flamb0decay==1)ETOT_LP = std::sqrt(pc*pc + 1115.683*1115.683);
7728  EV_TAB_SSC[IEV_TAB_SSC][2] = c * pc * xcv / ETOT_LP;
7729  EV_TAB_SSC[IEV_TAB_SSC][3] = c * pc * ycv / ETOT_LP;
7730  EV_TAB_SSC[IEV_TAB_SSC][4] = c * pc * zcv / ETOT_LP;
7731  }else{
7732 // gamma ray
7733  EV_TAB_SSC[IEV_TAB_SSC][2] = pc * xcv;
7734  EV_TAB_SSC[IEV_TAB_SSC][3] = pc * ycv;
7735  EV_TAB_SSC[IEV_TAB_SSC][4] = pc * zcv;
7736  }
7737  lorentz_boost(vx_eva,vy_eva,vz_eva,
7738  EV_TAB_SSC[IEV_TAB_SSC][2],EV_TAB_SSC[IEV_TAB_SSC][3],
7739  EV_TAB_SSC[IEV_TAB_SSC][4],
7740  &VXOUT,&VYOUT,&VZOUT);
7741  EV_TAB_SSC[IEV_TAB_SSC][2] = VXOUT;
7742  EV_TAB_SSC[IEV_TAB_SSC][3] = VYOUT;
7743  EV_TAB_SSC[IEV_TAB_SSC][4] = VZOUT;
7744 
7745 // Heavy residue
7746  if(gammadecay==0){
7747  G4double v2 = std::pow(EV_TAB_SSC[IEV_TAB_SSC][2],2.) +
7748  std::pow(EV_TAB_SSC[IEV_TAB_SSC][3],2.) +
7749  std::pow(EV_TAB_SSC[IEV_TAB_SSC][4],2.);
7750  G4double gamma = 1.0/std::sqrt(1.0 - v2 / (c*c));
7751  G4double etot_lp = amoins*mu * gamma;
7752  pxeva = pxeva - EV_TAB_SSC[IEV_TAB_SSC][2] * etot_lp / c;
7753  pyeva = pyeva - EV_TAB_SSC[IEV_TAB_SSC][3] * etot_lp / c;
7754  pleva = pleva - EV_TAB_SSC[IEV_TAB_SSC][4] * etot_lp / c;
7755  }else{
7756 // in case of gammas, EV_TEMP contains momentum components and not velocity
7757  pxeva = pxeva - EV_TAB_SSC[IEV_TAB_SSC][2];
7758  pyeva = pyeva - EV_TAB_SSC[IEV_TAB_SSC][3];
7759  pleva = pleva - EV_TAB_SSC[IEV_TAB_SSC][4];
7760  }
7761  pteva = std::sqrt(pxeva*pxeva + pyeva*pyeva);
7762 // To be checked:
7763  etot = std::sqrt ( pleva*pleva + pteva*pteva + af*af * mu2 );
7764  vx_eva = c * pxeva / etot; // recoil velocity components of residue due to evaporation
7765  vy_eva = c * pyeva / etot;
7766  vz_eva = c * pleva / etot;
7767 
7768  IEV_TAB_SSC = IEV_TAB_SSC +1;
7769 
7770  if(time<tauf)goto post10;
7771 //
7772  post100:
7773 //
7774  *A_scission= af;
7775  *Z_scission= zf;
7776  *E_scission_post = ee;
7777  *NbLam0_par = NbLam0;
7778  return;
7779 }
7780 
7781 G4double G4Abla::getdeltabinding(G4double A, G4int H){
7782  if(A<1.)return (1.*H)/A*(10.68*A-21.27*std::pow(A,2./3.))*10.;
7783  return (1.*H)/A*(10.68*A-21.27*std::pow(A,2./3.));
7784 }
7785 
7786 
7787 G4double G4Abla::gethyperseparation(G4double A, G4double Z, G4int ny){
7788  if(A<1.)return 1.e38;
7789 // For light nuclei we take experimental values
7790 // Journal of Physics G, Nucl Part Phys 32,363 (2006)
7791  if(ny==1){
7792  if(Z==1 && A==4) return 2.04;
7793  else if(Z==2 && A==4) return 2.39;
7794  else if(Z==2 && A==5) return 3.12;
7795  else if(Z==2 && A==6) return 4.18;
7796  else if(Z==2 && A==7) return 5.23;
7797  else if(Z==2 && A==8) return 7.16;
7798  else if(Z==3 && A==6) return 4.50;
7799  else if(Z==3 && A==7) return 5.58;
7800  else if(Z==3 && A==8) return 6.80;
7801  else if(Z==3 && A==9) return 8.50;
7802  else if(Z==4 && A==7) return 5.16;
7803  else if(Z==4 && A==8) return 6.84;
7804  else if(Z==4 && A==9) return 6.71;
7805  else if(Z==4 && A==10) return 9.11;
7806  else if(Z==5 && A==9) return 8.29;
7807  else if(Z==5 && A==10) return 8.89;
7808  else if(Z==5 && A==11) return 10.24;
7809  else if(Z==5 && A==12) return 11.37;
7810  else if(Z==6 && A==12) return 10.76;
7811  else if(Z==6 && A==13) return 11.69;
7812  else if(Z==6 && A==14) return 12.17;
7813  else if(Z==14 && A==28) return 16.0;
7814  else if(Z==39 && A==89) return 22.1;
7815  else if(Z==57 && A==139) return 23.8;
7816  else if(Z==82 && A==208) return 26.5;
7817  }//ny==1
7818 // For other nuclei we take Bethe-Weizsacker mass formula
7819  return gethyperbinding(A, Z, ny)-gethyperbinding(A-1., Z, ny-1);
7820 }
7821 
7822 G4double G4Abla::gethyperbinding(G4double A, G4double Z, G4int ny){
7823 //
7824 // Bethe-Weizsacker mass formula
7825 // Journal of Physics G, Nucl Part Phys 32,363 (2006)
7826 //
7827  if(A<2 || Z<2)return 0.;
7828  G4double N = A-Z -1.*ny;
7829  G4double be=0., my = 1115.683,
7830  av = 15.77,
7831  as = 18.34,
7832  ac = 0.71,
7833  asym = 23.21,
7834  k = 17.,
7835  c = 30.,
7836  D = 0.;
7837  if(mod(N,2) == 1 && mod(Z,2) == 1)D = -12./std::sqrt(A);
7838  if(mod(N,2) == 0 && mod(Z,2) == 0)D = 12./std::sqrt(A);
7839 //
7840  G4double deltanew = (1.-std::exp(-1.*A/c))*D;
7841 //
7842  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));
7843  return be;
7844 }
7845 
7846 void 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)
7847 {
7848  G4double SBP = SP + BP;
7849  G4double SBD = SD + BD;
7850  G4double SBT = ST + BT;
7851  G4double SBHE = SHE + BHE;
7852  G4double SBA = SA + BA;
7853 
7854  G4double e = dmin1(SBP,SBD,SBT);
7855  e = dmin1(SBHE,SN,e);
7856  e = dmin1(SBHE,SBA,e);
7857 //
7858  if(SN==e){
7859  *ECN = (-1.0)*SN;
7860  *ECP = 0.0;
7861  *ECD = 0.0;
7862  *ECT = 0.0;
7863  *ECHE = 0.0;
7864  *ECA = 0.0;
7865  *PROBN = 1.0;
7866  *PROBP = 0.0;
7867  *PROBD = 0.0;
7868  *PROBT = 0.0;
7869  *PROBHE = 0.0;
7870  *PROBA = 0.0;
7871  *PROBIMF = 0.0;
7872  *PROBF = 0.0;
7873  *PROBG = 0.0;
7874  }
7875  else if(SBP==e){
7876  *ECN = 0.0;
7877  *ECP = (-1.0)*SP + BP;
7878  *ECD = 0.0;
7879  *ECT = 0.0;
7880  *ECHE = 0.0;
7881  *ECA = 0.0;
7882  *PROBN = 0.0;
7883  *PROBP = 1.0;
7884  *PROBD = 0.0;
7885  *PROBT = 0.0;
7886  *PROBHE = 0.0;
7887  *PROBA = 0.0;
7888  *PROBIMF = 0.0;
7889  *PROBF = 0.0;
7890  *PROBG = 0.0;
7891  }
7892  else if(SBD==e){
7893  *ECN = 0.0;
7894  *ECD = (-1.0)*SD + BD;
7895  *ECP = 0.0;
7896  *ECT = 0.0;
7897  *ECHE = 0.0;
7898  *ECA = 0.0;
7899  *PROBN = 0.0;
7900  *PROBP = 0.0;
7901  *PROBD = 1.0;
7902  *PROBT = 0.0;
7903  *PROBHE = 0.0;
7904  *PROBA = 0.0;
7905  *PROBIMF = 0.0;
7906  *PROBF = 0.0;
7907  *PROBG = 0.0;
7908  }
7909  else if(SBT==e){
7910  *ECN = 0.0;
7911  *ECT = (-1.0)*ST + BT;
7912  *ECD = 0.0;
7913  *ECP = 0.0;
7914  *ECHE = 0.0;
7915  *ECA = 0.0;
7916  *PROBN = 0.0;
7917  *PROBP = 0.0;
7918  *PROBD = 0.0;
7919  *PROBT = 1.0;
7920  *PROBHE = 0.0;
7921  *PROBA = 0.0;
7922  *PROBIMF = 0.0;
7923  *PROBF = 0.0;
7924  *PROBG = 0.0;
7925  }
7926  else if(SBHE==e){
7927  *ECN = 0.0;
7928  *ECHE= (-1.0)*SHE + BHE;
7929  *ECD = 0.0;
7930  *ECT = 0.0;
7931  *ECP = 0.0;
7932  *ECA = 0.0;
7933  *PROBN = 0.0;
7934  *PROBP = 0.0;
7935  *PROBD = 0.0;
7936  *PROBT = 0.0;
7937  *PROBHE = 1.0;
7938  *PROBA = 0.0;
7939  *PROBIMF = 0.0;
7940  *PROBF = 0.0;
7941  *PROBG = 0.0;
7942  }
7943  else{
7944  if(SBA==e){
7945  *ECN = 0.0;
7946  *ECA = (-1.0)*SA + BA;
7947  *ECD = 0.0;
7948  *ECT = 0.0;
7949  *ECHE = 0.0;
7950  *ECP = 0.0;
7951  *PROBN = 0.0;
7952  *PROBP = 0.0;
7953  *PROBD = 0.0;
7954  *PROBT = 0.0;
7955  *PROBHE = 0.0;
7956  *PROBA = 1.0;
7957  *PROBIMF = 0.0;
7958  *PROBF = 0.0;
7959  *PROBG = 0.0;
7960  }
7961  }
7962 
7963  return;
7964 }
7965 
7966 void G4Abla::fissionDistri(G4double &A,G4double &Z,G4double &E,
7967  G4double &a1,G4double &z1,G4double &e1,G4double &v1,
7968  G4double &a2,G4double &z2,G4double &e2,G4double &v2,
7969  G4double &vx_eva_sc,G4double &vy_eva_sc,G4double &vz_eva_sc,
7970  G4int *NbLam0_par)
7971 {
7972 
7973 /*
7974  Last update:
7975 
7976  21/01/17 - J.L.R.S. - Implementation of this fission model in C++
7977 
7978 
7979  Authors: K.-H. Schmidt, A. Kelic, M. V. Ricciardi,J. Benlliure, and
7980  J.L.Rodriguez-Sanchez(1995 - 2017)
7981 
7982  On input: A, Z, E (mass, atomic number and exc. energy of compound nucleus
7983  before fission)
7984  On output: Ai, Zi, Ei (mass, atomic number and (absolute) exc. energy of
7985  fragment 1 and 2 after fission)
7986 
7987 */
7988  /* This program calculates isotopic distributions of fission fragments */
7989  /* with a semiempirical model */
7990  /* The width and eventually a shift in N/Z (polarization) follows the */
7991  /* following rules: */
7992  /* */
7993  /* The line N/Z following UCD has an angle of atan(Zcn/Ncn) */
7994  /* to the horizontal axis on a chart of nuclides. */
7995 /* (For 238U the angle is 32.2 deg.) */
7996 /* */
7997 /* The following relations hold: (from Armbruster)
7998 c
7999 c sigma(N) (A=const) = sigma(Z) (A=const)
8000 c sigma(A) (N=const) = sigma(Z) (N=const)
8001 c sigma(A) (Z=const) = sigma(N) (Z=const)
8002 c
8003 c From this we get:
8004 c sigma(Z) (N=const) * N = sigma(N) (Z=const) * Z
8005 c sigma(A) (Z=const) = sigma(Z) (A=const) * A/Z
8006 c sigma(N) (Z=const) = sigma(Z) (A=const) * A/Z
8007 c Z*sigma(N) (Z=const) = N*sigma(Z) (N=const) = A*sigma(Z) (A=const) */
8008 //
8009 
8010 /* Model parameters:
8011 C These parameters have been adjusted to the compound nucleus 238U.
8012 c For the fission of another compound nucleus, it might be
8013 c necessary to slightly adjust some parameter values.
8014 c The most important ones are
8015 C Delta_U1_shell_max and
8016 c Delta_u2_shell.
8017 */
8018  G4double Nheavy1_in; // 'position of shell for Standard 1'
8019  Nheavy1_in = 83.0;
8020 
8021  G4double Zheavy1_in; // 'position of shell for Standard 1'
8022  Zheavy1_in = 50.0;
8023 
8024  G4double Nheavy2; // 'position of heavy peak valley 2'
8025  Nheavy2 = 89.0;
8026 
8027  G4double Delta_U1_shell_max; // 'Shell effect for valley 1'
8028  Delta_U1_shell_max = -2.45;
8029 
8030  G4double U1NZ_SLOPE; // Reduction of shell effect with distance to 132Sn
8031  U1NZ_SLOPE = 0.2;
8032 
8033  G4double Delta_U2_shell; // 'Shell effect for valley 2'
8034  Delta_U2_shell = -2.45;
8035 
8036  G4double X_s2s; // 'Ratio (C_sad/C_scis) of curvature of potential'
8037  X_s2s = 0.8;
8038 
8039  G4double hbom1,hbom2,hbom3; // 'Curvature of potential at saddle'
8040  hbom1 = 0.2; // hbom1 is hbar * omega1 / (2 pi) !!!
8041  hbom2 = 0.2; // hbom2 is hbar * omega2 / (2 pi) !!!
8042  hbom3 = 0.2; // hbom3 is hbar * omega3 / (2 pi) !!!
8043 
8044  G4double Fwidth_asymm1,Fwidth_asymm2,Fwidth_symm;
8045 // 'Factors for widths of distr. valley 1 and 2'
8046  Fwidth_asymm1 = 0.65;
8047  Fwidth_asymm2 = 0.65;
8048  Fwidth_symm = 1.16;
8049 
8050  G4double xLevdens; // 'Parameter x: a = A/x'
8051  xLevdens = 10.75;
8052 // The value of 1/0.093 = 10.75 is consistent with the
8053 // systematics of the mass widths of Ref. (RuI97).
8054 
8055  G4double FGAMMA; // 'Factor to gamma'
8056  FGAMMA = 1.; // Theoretical expectation, not adjusted to data.
8057 // Additional factor to attenuation coefficient of shell effects
8058 // with increasing excitation energy
8059 
8060  G4double FGAMMA1; // 'Factor to gamma_heavy1'
8061  FGAMMA1 = 2.;
8062 // Adjusted to reduce the weight of Standard 1 with increasing
8063 // excitation energies, as required by experimental data.
8064 
8065  G4double FREDSHELL;
8066  FREDSHELL = 0.;
8067 // Adjusted to the reduced attenuation of shells in the superfluid region.
8068 // If FGAMMA is modified,
8069 // FGAMMA * FREADSHELL should remain constant (0.65) to keep
8070 // the attenuation of the shell effects below the critical
8071 // pairing energy ECRIT unchanged, which has been carefully
8072 // adjusted to the mass yields of Vives and Zoeller in this
8073 // energy range. A high value of FGAMMA leads ot a stronger
8074 // attenuation of shell effects above the superfluid region.
8075 
8076  G4double Ecrit;
8077  Ecrit = 5.;
8078 // The value of ECRIT determines the transition from a weak
8079 // decrease of the shell effect below ECRIT to a stronger
8080 // decrease above the superfluid range.
8081  const G4double d = 2.0; // 'Surface distance of scission configuration'
8082  // d = 2.0;
8083 // Charge polarisation from Wagemanns p. 397:
8084  G4double cpol1; // Charge polarisation standard I
8085  cpol1 = 0.35; // calculated internally with shells
8086  G4double cpol2; // Charge polarisation standard II
8087  cpol2 = 0.; // calculated internally from LDM
8088  G4double Friction_factor;
8089  Friction_factor = 1.0;
8090  G4double Nheavy1; // position of valley St 1 in Z and N
8091  G4double Delta_U1,Delta_U2; // used shell effects
8092  G4double cN_asymm1_shell, cN_asymm2_shell;
8093  G4double gamma,gamma_heavy1,gamma_heavy2; // fading of shells
8094  G4double E_saddle_scission; // friction from saddle to scission
8095  G4double Ysymm=0.; // Yield of symmetric mode
8096  G4double Yasymm1=0.; // Yield of asymmetric mode 1
8097  G4double Yasymm2=0.; // Yield of asymmetric mode 2
8098  G4double Nheavy1_eff; // Effective position of valley 1
8099  G4double Nheavy2_eff; // Effective position of valley 2
8100  G4double eexc1_saddle; // Excitation energy above saddle 1
8101  G4double eexc2_saddle; // Excitation energy above saddle 2
8102  G4double EEXC_MAX; // Excitation energy above lowest saddle
8103  G4double r_e_o; // Even-odd effect in Z
8104  G4double cN_symm; // Curvature of symmetric valley
8105  G4double CZ; // Curvature of Z distribution for fixed A
8106  G4double Nheavy2_NZ; // Position of Shell 2, combined N and Z
8107  G4double N;
8108  G4double Aheavy1,Aheavy2;
8109  G4double Sasymm1=0.,Sasymm2=0.,Ssymm=0.,Ysum=0.,Yasymm=0.;
8110  G4double Ssymm_mode1,Ssymm_mode2;
8111  G4double wNasymm1_saddle, wNasymm2_saddle, wNsymm_saddle;
8112  G4double wNasymm2_scission, wNsymm_scission;
8113  G4double wNasymm1, wNasymm2, wNsymm;
8114  G4int imode;
8115  G4double rmode;
8116  G4double ZA1width;
8117  G4double N1r,N2r,A1r,N1,N2;
8118  G4double Zsymm,Nsymm;
8119  G4double N1mean, N1width;
8120  G4double dUeff;
8121  /* effective shell effect at lowest barrier */
8122  G4double Eld;
8123  /* Excitation energy with respect to ld barrier */
8124  G4double re1,re2,re3;
8125  G4double eps1,eps2;
8126  G4double Z1UCD,Z2UCD;
8127  G4double beta,beta1,beta2;
8128  // double betacomplement;
8129  G4double DN1_POL;
8130  /* shift of most probable neutron number for given Z,
8131  according to polarization */
8132  G4int i_help;
8133  G4double A_levdens;
8134  /* level-density parameter */
8135  // double A_levdens_light1,A_levdens_light2;
8136  G4double A_levdens_heavy1,A_levdens_heavy2;
8137 
8138  G4double R0=1.16;
8139 
8140  G4double epsilon_1_saddle,epsilon0_1_saddle;
8141  G4double epsilon_2_saddle,epsilon0_2_saddle,epsilon_symm_saddle;
8142  G4double epsilon_1_scission;//,epsilon0_1_scission;
8143  G4double epsilon_2_scission;//,epsilon0_2_scission;
8144  G4double epsilon_symm_scission;
8145  /* modified energy */
8146  G4double E_eff1_saddle,E_eff2_saddle;
8147  G4double Epot0_mode1_saddle,Epot0_mode2_saddle,Epot0_symm_saddle;
8148  G4double Epot_mode1_saddle,Epot_mode2_saddle,Epot_symm_saddle;
8149  G4double E_defo,E_defo1,E_defo2,E_scission_pre,E_scission_post;
8150  G4double E_asym;
8151  G4double E1exc,E2exc;
8152  G4double E1exc_sigma,E2exc_sigma;
8153  G4double TKER;
8154  G4double EkinR1,EkinR2;
8155  G4double MassCurv_scis, MassCurv_sadd;
8156  G4double cN_symm_sadd;
8157  G4double Nheavy1_shell,Nheavy2_shell;
8158  G4double wNasymm1_scission;
8159  G4double Aheavy1_eff,Aheavy2_eff;
8160  G4double Z1rr,Z1r;
8161  G4double E_HELP;
8162  G4double Z_scission,N_scission,A_scission;
8163  G4double Z2_over_A_eff;
8164  G4double beta1gs,beta2gs,betags;
8165  G4double sigZmin; // 'Minimum neutron width for constant Z'
8166  G4double DSN132,Delta_U1_shell,E_eff0_saddle;//,e_scission;
8167  G4int NbLam0= (*NbLam0_par);
8168  //
8169  sigZmin = 0.5;
8170  N = A - Z; /* neutron number of the fissioning nucleus */
8171 //
8172  cN_asymm1_shell = 0.700 * N/Z;
8173  cN_asymm2_shell = 0.040 * N/Z;
8174 
8175 //*********************************************************************
8176 
8177  DSN132 = Nheavy1_in - N/Z * Zheavy1_in;
8178  Aheavy1 = Nheavy1_in + Zheavy1_in + 0.340 * DSN132;
8179  /* Neutron number of valley Standard 1 */
8180  /* It is assumed that the 82-neutron shell effect is stronger than
8181 c the 50-proton shell effect. Therefore, the deviation in N/Z of
8182 c the fissioning nucleus from the N/Z of 132Sn will
8183 c change the position of the combined shell in mass. For neutron-
8184 c deficient fissioning nuclei, the mass will increase and vice
8185 c versa. */
8186 
8187  Delta_U1_shell = Delta_U1_shell_max + U1NZ_SLOPE * std::abs(DSN132);
8188  Delta_U1_shell = min(0.,Delta_U1_shell);
8189  /* Empirical reduction of shell effect with distance in N/Z of CN to 132Sn */
8190  /* Fits (239U,n)f and 226Th e.-m.-induced fission */
8191 
8192  Nheavy1 = N/A * Aheavy1; /* UCD */
8193  Aheavy2 = Nheavy2 * A/N;
8194 
8195  Zsymm = Z / 2.0; /* proton number in symmetric fission (centre) */
8196  Nsymm = N / 2.0;
8197  A_levdens = A / xLevdens;
8198  gamma = A_levdens / (0.40 * std::pow(A,1.3333)) * FGAMMA;
8199  A_levdens_heavy1 = Aheavy1 / xLevdens;
8200  gamma_heavy1 = A_levdens_heavy1 / (0.40 * std::pow(Aheavy1,1.3333)) * FGAMMA * FGAMMA1;
8201  A_levdens_heavy2 = Aheavy2 / xLevdens;
8202  gamma_heavy2 = A_levdens_heavy2 / (0.40 * std::pow(Aheavy2,1.3333)) * FGAMMA;
8203 
8204 // Energy dissipated from saddle to scission
8205 // F. Rejmund et al., Nucl. Phys. A 678 (2000) 215, fig. 4 b */
8206  E_saddle_scission = (-24. + 0.02227 * Z*Z/std::pow(A,0.33333))*Friction_factor;
8207  E_saddle_scission = max( 0.0, E_saddle_scission );
8208 
8209 // Fit to experimental result on curvature of potential at saddle
8210 // Parametrization of T. Enqvist according to Mulgin et al. 1998
8211 // MassCurv taken at scission. */
8212 
8213  Z2_over_A_eff = Z*Z/A;
8214 
8215  if( Z2_over_A_eff< 34.0 )
8216  MassCurv_scis = std::pow(10., -1.093364 + 0.082933 * Z2_over_A_eff - 0.0002602 * Z2_over_A_eff*Z2_over_A_eff);
8217  else
8218  MassCurv_scis = std::pow(10., 3.053536 - 0.056477 * Z2_over_A_eff+ 0.0002454 * Z2_over_A_eff*Z2_over_A_eff );
8219 
8220 // to do:
8221 // fix the X with the channel intensities of 226Th (KHS at SEYSSINS,1998)
8222 // replace then (all) cN_symm by cN_symm_saddle (at least for Yields)
8223  MassCurv_sadd = X_s2s * MassCurv_scis;
8224 
8225  cN_symm = 8.0 / std::pow(N,2.) * MassCurv_scis;
8226  cN_symm_sadd = 8.0 / std::pow(N,2.) * MassCurv_sadd;
8227 
8228  Nheavy1_shell = Nheavy1;
8229 
8230  if(E < 100.0)
8231  Nheavy1_eff = (cN_symm_sadd*Nsymm + cN_asymm1_shell *
8232  Uwash(E/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1) *
8233  Nheavy1_shell)
8234  / (cN_symm_sadd +
8235  cN_asymm1_shell *
8236  Uwash(E/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1));
8237  else
8238  Nheavy1_eff = (cN_symm_sadd*Nsymm +
8239  cN_asymm1_shell*Nheavy1_shell)
8240  / (cN_symm_sadd +
8241  cN_asymm1_shell);
8242 
8243  /* Position of Standard II defined by neutron shell */
8244  Nheavy2_NZ = Nheavy2;
8245  Nheavy2_shell = Nheavy2_NZ;
8246  if (E < 100.)
8247  Nheavy2_eff = (cN_symm_sadd*Nsymm +
8248  cN_asymm2_shell*
8249  Uwash(E/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2) *
8250  Nheavy2_shell)
8251  / (cN_symm_sadd +
8252  cN_asymm2_shell*
8253  Uwash(E/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2));
8254  else
8255  Nheavy2_eff = (cN_symm_sadd*Nsymm +
8256  cN_asymm2_shell*Nheavy2_shell)
8257  / (cN_symm_sadd +
8258  cN_asymm2_shell);
8259 
8260  Delta_U1 = Delta_U1_shell + (Nheavy1_shell - Nheavy1_eff)*(Nheavy1_shell - Nheavy1_eff) * cN_asymm1_shell; /* shell effect in valley of mode 1 */
8261  Delta_U1 = min(Delta_U1,0.0);
8262  Delta_U2 = Delta_U2_shell + (Nheavy2_shell - Nheavy2_eff)*(Nheavy2_shell - Nheavy2_eff) * cN_asymm2_shell; /* shell effect in valley of mode 2 */
8263  Delta_U2 = min(Delta_U2,0.0);
8264 
8265 // liquid drop energies at the centres of the different shell effects
8266 // with respect to liquid drop at symmetry
8267  Epot0_mode1_saddle = (Nheavy1_eff-Nsymm)*(Nheavy1_eff-Nsymm) * cN_symm_sadd;
8268  Epot0_mode2_saddle = (Nheavy2_eff-Nsymm)*(Nheavy2_eff-Nsymm) * cN_symm_sadd;
8269  Epot0_symm_saddle = 0.0;
8270 
8271 // energies including shell effects at the centres of the different
8272 // shell effects with respect to liquid drop at symmetry */
8273  Epot_mode1_saddle = Epot0_mode1_saddle + Delta_U1;
8274  Epot_mode2_saddle = Epot0_mode2_saddle + Delta_U2;
8275  Epot_symm_saddle = Epot0_symm_saddle;
8276 
8277 // minimum of potential with respect to ld potential at symmetry
8278  dUeff = min( Epot_mode1_saddle, Epot_mode2_saddle);
8279  dUeff = min( dUeff, Epot_symm_saddle);
8280  dUeff = dUeff - Epot_symm_saddle;
8281 
8282  Eld = E + dUeff;
8283 // E = energy above lowest effective barrier
8284 // Eld = energy above liquid-drop barrier
8285 // Due to this treatment the energy E on input means the excitation
8286 // energy above the lowest saddle. */
8287 
8288 // excitation energies at saddle modes 1 and 2 without shell effect */
8289  epsilon0_1_saddle = Eld - Epot0_mode1_saddle;
8290  epsilon0_2_saddle = Eld - Epot0_mode2_saddle;
8291 
8292 // excitation energies at saddle modes 1 and 2 with shell effect */
8293  epsilon_1_saddle = Eld - Epot_mode1_saddle;
8294  epsilon_2_saddle = Eld - Epot_mode2_saddle;
8295 
8296  epsilon_symm_saddle = Eld - Epot_symm_saddle;
8297 // epsilon_symm_saddle = Eld - dUeff;
8298 
8299  eexc1_saddle = epsilon_1_saddle;
8300  eexc2_saddle = epsilon_2_saddle;
8301 
8302 // EEXC_MAX is energy above the lowest saddle */
8303  EEXC_MAX = max( eexc1_saddle, eexc2_saddle);
8304  EEXC_MAX = max( EEXC_MAX, Eld);
8305 
8306 // excitation energy at scission */
8307  epsilon_1_scission = Eld + E_saddle_scission - Epot_mode1_saddle;
8308  epsilon_2_scission = Eld + E_saddle_scission - Epot_mode2_saddle;
8309 
8310 // excitation energy of symmetric fragment at scission */
8311  epsilon_symm_scission = Eld + E_saddle_scission - Epot_symm_saddle;
8312 
8313 // calculate widhts at the saddle
8314  E_eff1_saddle = epsilon0_1_saddle - Delta_U1 *
8315  Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1);
8316 
8317  if( E_eff1_saddle < A_levdens * hbom1*hbom1)
8318  E_eff1_saddle = A_levdens * hbom1*hbom1;
8319 
8320  wNasymm1_saddle =
8321  std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_eff1_saddle) /
8322  (cN_asymm1_shell *
8323  Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)+
8324  cN_symm_sadd));
8325 
8326  E_eff2_saddle = epsilon0_2_saddle -
8327  Delta_U2 *
8328  Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2);
8329 
8330  if(E_eff2_saddle < A_levdens * hbom2*hbom2)
8331  E_eff2_saddle = A_levdens * hbom2*hbom2;
8332 
8333  wNasymm2_saddle =
8334  std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_eff2_saddle) /
8335  (cN_asymm2_shell *
8336  Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)+
8337  cN_symm_sadd));
8338 
8339  E_eff0_saddle = epsilon_symm_saddle;
8340  if(E_eff0_saddle < A_levdens * hbom3*hbom3)
8341  E_eff0_saddle = A_levdens * hbom3*hbom3;
8342 
8343  wNsymm_saddle =
8344  std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_eff0_saddle) /
8345  cN_symm_sadd);
8346 
8347  if(epsilon_symm_scission > 0.0 ){
8348  E_HELP = max(E_saddle_scission,epsilon_symm_scission);
8349  wNsymm_scission =
8350  std::sqrt(0.50 * std::sqrt(1.0/A_levdens*(E_HELP)) /
8351  cN_symm);
8352  }else{
8353  wNsymm_scission =
8354  std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_saddle_scission) /
8355  cN_symm);
8356  }
8357 
8358 // Calculate widhts at the scission point:
8359 // fits of ref. Beizin 1991 (Plots by Sergei Zhdanov)
8360 
8361  if( E_saddle_scission == 0.0 ){
8362  wNasymm1_scission = wNasymm1_saddle;
8363  wNasymm2_scission = wNasymm2_saddle;
8364  }else{
8365  if( Nheavy1_eff > 75.0 ){
8366  wNasymm1_scission = std::sqrt(21.0)*N/A;
8367  wNasymm2_scission = max( 12.8 - 1.0 *(92.0 - Nheavy2_eff),1.0)*N/A;
8368 
8369  }else{
8370  wNasymm1_scission = wNasymm1_saddle;
8371  wNasymm2_scission = wNasymm2_saddle;
8372  }
8373  }
8374 
8375  wNasymm1_scission = max( wNasymm1_scission, wNasymm1_saddle );
8376  wNasymm2_scission = max( wNasymm2_scission, wNasymm2_saddle );
8377 
8378  wNasymm1 = wNasymm1_scission * Fwidth_asymm1;
8379  wNasymm2 = wNasymm2_scission * Fwidth_asymm2;
8380  wNsymm = wNsymm_scission * Fwidth_symm;
8381 
8382 // mass and charge of fragments using UCD, needed for level densities
8383  Aheavy1_eff = Nheavy1_eff * A/N;
8384  Aheavy2_eff = Nheavy2_eff * A/N;
8385 
8386  A_levdens_heavy1 = Aheavy1_eff / xLevdens;
8387  A_levdens_heavy2 = Aheavy2_eff / xLevdens;
8388  gamma_heavy1 = A_levdens_heavy1 / (0.40 * std::pow(Aheavy1_eff,1.3333)) * FGAMMA * FGAMMA1;
8389  gamma_heavy2 = A_levdens_heavy2 / (0.40 * std::pow(Aheavy2_eff,1.3333)) * FGAMMA;
8390 
8391  if( epsilon_symm_saddle < A_levdens * hbom3*hbom3)
8392  Ssymm = 2.0 * std::sqrt(A_levdens*A_levdens * hbom3*hbom3) +
8393  (epsilon_symm_saddle - A_levdens * hbom3*hbom3)/hbom3;
8394  else
8395  Ssymm = 2.0 * std::sqrt(A_levdens*epsilon_symm_saddle);
8396 
8397  Ysymm = 1.0;
8398 
8399  if( epsilon0_1_saddle < A_levdens * hbom1*hbom1 )
8400  Ssymm_mode1 = 2.0 * std::sqrt(A_levdens*A_levdens * hbom1*hbom1) +
8401  (epsilon0_1_saddle - A_levdens * hbom1*hbom1)/hbom1;
8402  else
8403  Ssymm_mode1 = 2.0 * std::sqrt( A_levdens*epsilon0_1_saddle );
8404 
8405  if( epsilon0_2_saddle < A_levdens * hbom2*hbom2 )
8406  Ssymm_mode2 = 2.0 * std::sqrt(A_levdens*A_levdens * hbom2*hbom2) +
8407  (epsilon0_2_saddle - A_levdens * hbom2*hbom2)/hbom2;
8408  else
8409  Ssymm_mode2 = 2.0 * std::sqrt(A_levdens*epsilon0_2_saddle);
8410 
8411 
8412  if( epsilon0_1_saddle -
8413  Delta_U1*
8414  Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)
8415  < A_levdens * hbom1*hbom1 )
8416  Sasymm1 = 2.0 * std::sqrt( A_levdens*A_levdens * hbom1*hbom1 ) +
8417  (epsilon0_1_saddle - Delta_U1 *
8418  Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)
8419  - A_levdens * hbom1*hbom1)/hbom1;
8420  else
8421  Sasymm1 = 2.0 *std::sqrt( A_levdens*(epsilon0_1_saddle - Delta_U1 *
8422  Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)));
8423 
8424  if( epsilon0_2_saddle -
8425  Delta_U2*
8426  Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)
8427  < A_levdens * hbom2*hbom2 )
8428  Sasymm2 = 2.0 * std::sqrt( A_levdens*A_levdens * hbom2*hbom2 ) +
8429  (epsilon0_1_saddle-Delta_U1 *
8430  Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)
8431  - A_levdens * hbom2*hbom2)/hbom2;
8432  else
8433  Sasymm2 = 2.0 *
8434  std::sqrt( A_levdens*(epsilon0_2_saddle - Delta_U2 *
8435  Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)));
8436 
8437  Yasymm1 = ( std::exp(Sasymm1 - Ssymm) - std::exp(Ssymm_mode1 - Ssymm) ) *
8438  wNasymm1_saddle / wNsymm_saddle * 2.0;
8439 
8440  Yasymm2 = ( std::exp(Sasymm2 - Ssymm) - std::exp(Ssymm_mode2 - Ssymm) ) *
8441  wNasymm2_saddle / wNsymm_saddle * 2.0;
8442 
8443  Ysum = Ysymm + Yasymm1 + Yasymm2; /* normalize */
8444 
8445  if( Ysum > 0.00 ){
8446  Ysymm = Ysymm / Ysum;
8447  Yasymm1 = Yasymm1 / Ysum;
8448  Yasymm2 = Yasymm2 / Ysum;
8449  Yasymm = Yasymm1 + Yasymm2;
8450  }else{
8451  Ysymm = 0.0;
8452  Yasymm1 = 0.0;
8453  Yasymm2 = 0.0;
8454 // search minimum threshold and attribute all events to this mode */
8455  if( (epsilon_symm_saddle < epsilon_1_saddle) &&
8456  (epsilon_symm_saddle < epsilon_2_saddle) )
8457  Ysymm = 1.0;
8458  else
8459  if( epsilon_1_saddle < epsilon_2_saddle )
8460  Yasymm1 = 1.0;
8461  else
8462  Yasymm2 = 1.0;
8463  }
8464  // even-odd effect
8465  // Parametrization from Rejmund et al.
8466  if (mod(Z,2.0)== 0)
8467  r_e_o = std::pow(10.0,-0.0170 * (E_saddle_scission + Eld)*(E_saddle_scission + Eld));
8468  else
8469  r_e_o = 0.0;
8470 
8471 /* -------------------------------------------------------
8472 c selecting the fission mode using the yields at scission
8473 c -------------------------------------------------------
8474 c random decision: symmetric or asymmetric
8475 c IMODE = 1 means asymmetric fission, mode 1
8476 c IMODE = 2 means asymmetric fission, mode 2
8477 c IMODE = 3 means symmetric fission
8478 c testcase: 238U, E*= 6 MeV : 6467 8781 4752 (20000)
8479 c 127798 176480 95722 (400000)
8480 c 319919 440322 239759 (1000000)
8481 c E*=12 MeV : 153407 293063 553530 (1000000) */
8482 
8483  fiss321: // rmode = DBLE(HAZ(k))
8484  rmode = G4AblaRandom::flat();
8485  if( rmode < Yasymm1 )
8486  imode = 1;
8487  else
8488  if( (rmode > Yasymm1) && (rmode < Yasymm) )
8489  imode = 2;
8490  else
8491  imode = 3;
8492 
8493 // determine parameters of the neutron distribution of each mode
8494 // at scission
8495 
8496  if( imode == 1){
8497  N1mean = Nheavy1_eff;
8498  N1width = wNasymm1;
8499  }else{
8500  if( imode == 2 ){
8501  N1mean = Nheavy2_eff;
8502  N1width = wNasymm2;
8503  }else{
8504  //if( imode == 3 ) then
8505  N1mean = Nsymm;
8506  N1width = wNsymm;
8507  }
8508  }
8509 
8510 // N2mean needed by CZ below
8511  // N2mean = N - N1mean;
8512 
8513 // fission mode found, then the determination of the
8514 // neutron numbers N1 and N2 at scission by randon decision
8515  N1r = 1.0;
8516  N2r = 1.0;
8517  while( N1r < 5.0 || N2r < 5.0 ){
8518  // N1r = DBLE(GaussHaz(k,sngl(N1mean), sngl(N1width) ))
8519  // N1r = N1mean+G4AblaRandom::gaus(N1width);//
8520  N1r = gausshaz(0,N1mean,N1width);
8521  N2r = N - N1r;
8522  }
8523 
8524 // --------------------------------------------------
8525 // first approximation of fission fragments using UCD at saddle
8526 // --------------------------------------------------
8527  Z1UCD = Z/N * N1r;
8528  Z2UCD = Z/N * N2r;
8529  A1r = A/N * N1r;
8530 //
8531 // --------------------------
8532 // deformations: starting ...
8533 // -------------------------- */
8534  if( imode == 1 ){
8535 // --- N = 82 */
8536  E_scission_pre = max( epsilon_1_scission, 1.0 );
8537 // ! Eexc at scission, neutron evaporation from saddle to scission not considered */
8538  if( N1mean > N*0.50 ){
8539  beta1 = 0.0; /* 1. fragment is spherical */
8540  beta2 = 0.55; /* 2. fragment is deformed 0.5*/
8541  }else{
8542  beta1 = 0.55; /* 1. fragment is deformed 0.5*/
8543  beta2 = 0.00; /* 2. fragment is spherical */
8544  }
8545  }
8546  if( imode == 2 ){
8547 // --- N appr. 86 */
8548  E_scission_pre = max( epsilon_2_scission, 1.0 );
8549  if( N1mean > N*0.50 ){
8550  beta1 = (N1r - 92.0) * 0.030 + 0.60;
8551 
8552  beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
8553  beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
8554 
8555  beta1 = max(beta1,beta1gs);
8556  beta2 = 1.0 - beta1;
8557  beta2 = max(beta2,beta2gs);
8558  }else{
8559 
8560  beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
8561  beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
8562 
8563  beta2 = (N2r -92.0) * 0.030 + 0.60;
8564  beta2 = max(beta2,beta2gs);
8565  beta1 = 1.0 - beta2;
8566  beta1 = max(beta1,beta1gs);
8567  }
8568  }
8569  beta = 0.0;
8570  if( imode == 3 ){
8571 // if( imode >0 ){
8572 // --- Symmetric fission channel
8573 // the fit function for beta is the deformation for optimum energy
8574 // at the scission point, d = 2
8575 // beta : deformation of symmetric fragments
8576 // beta1 : deformation of first fragment
8577 // beta2 : deformation of second fragment
8578  betags = ecld->beta2[idint(Nsymm)][idint(Zsymm)];
8579  beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
8580  beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
8581  beta = max(0.177963+0.0153241*Zsymm-1.62037e-4*Zsymm*Zsymm,betags);
8582  beta1 = max(0.177963+0.0153241*Z1UCD-1.62037e-4*Z1UCD*Z1UCD,beta1gs);
8583  beta2 = max(0.177963+0.0153241*Z2UCD-1.62037e-4*Z2UCD*Z2UCD,beta2gs);
8584 
8585  E_asym = frldm( Z1UCD, N1r, beta1 ) +
8586  frldm( Z2UCD, N2r, beta2 ) +
8587  ecoul( Z1UCD, N1r, beta1, Z2UCD, N2r, beta2, 2.0 ) -
8588  2.0 * frldm( Zsymm, Nsymm, beta ) -
8589  ecoul( Zsymm, Nsymm, beta, Zsymm, Nsymm, beta, 2.0 );
8590  E_scission_pre = max( epsilon_symm_scission - E_asym, 1. );
8591  }
8592 // -----------------------
8593 // ... end of deformations
8594 // -----------------------
8595 
8596 // ------------------------------------------
8597 // evaporation from saddle to scission ...
8598 // ------------------------------------------
8599  if(E_scission_pre>5. && NbLam0<1){
8600  evap_postsaddle(A,Z,E_scission_pre,&E_scission_post,
8601  &A_scission,&Z_scission,vx_eva_sc,vy_eva_sc,vz_eva_sc,&NbLam0);
8602  N_scission = A_scission - Z_scission;
8603  }else{
8604  A_scission = A;
8605  Z_scission = Z;
8606  E_scission_post = E_scission_pre;
8607  N_scission = A_scission - Z_scission;
8608  }
8609 // ---------------------------------------------------
8610 // second approximation of fission fragments using UCD
8611 // --------------------------------------------------- */
8612 //
8613  N1r = N1r * N_scission / N;
8614  N2r = N2r * N_scission / N;
8615  Z1UCD = Z1UCD * Z_scission / Z;
8616  Z2UCD = Z2UCD * Z_scission / Z;
8617  A1r = Z1UCD + N1r;
8618 
8619 // ---------------------------------------------------------
8620 // determination of the charge and mass of the fragments ...
8621 // ---------------------------------------------------------
8622 
8623 // - CZ is the curvature of charge distribution for fixed mass,
8624 // common to all modes, gives the width of the charge distribution.
8625 // The physics picture behind is that the division of the
8626 // fissioning nucleus in N and Z is slow when mass transport from
8627 // one nascent fragment to the other is concerned but fast when the
8628 // N/Z degree of freedom is concernded. In addition, the potential
8629 // minima in direction of mass transport are broad compared to the
8630 // potential minimum in N/Z direction.
8631 // The minima in direction of mass transport are calculated
8632 // by the liquid-drop (LD) potential (for superlong mode),
8633 // by LD + N=82 shell (for standard 1 mode) and
8634 // by LD + N=86 shell (for standard 2 mode).
8635 // Since the variation of N/Z is fast, it can quickly adjust to
8636 // the potential and is thus determined close to scission.
8637 // Thus, we calculate the mean N/Z and its width for fixed mass
8638 // at scission.
8639 // For the SL mode, the mean N/Z is calculated by the
8640 // minimum of the potential at scission as a function of N/Z for
8641 // fixed mass.
8642 // For the S1 and S2 modes, this correlation is imposed by the
8643 // empirical charge polarisation.
8644 // For the SL mode, the fluctuation in this width is calculated
8645 // from the curvature of the potential at scission as a function
8646 // of N/Z. This value is also used for the widths of S1 and S2.
8647 
8648 
8649 // Polarisation assumed for standard I and standard II:
8650 // Z - Zucd = cpol (for A = const);
8651 // from this we get (see remarks above)
8652 // Z - Zucd = Acn/Ncn * cpol (for N = const) */
8653 //
8654  CZ = ( frldm( Z1UCD-1.0, N1r+1.0, beta1 ) +
8655  frldm( Z2UCD+1.0, N2r-1.0, beta2 ) +
8656  frldm( Z1UCD+1.0, N1r-1.0, beta1 ) +
8657  frldm( Z2UCD-1.0, N2r+1.0, beta2 ) +
8658  ecoul( Z1UCD-1.0, N1r+1.0, beta1,
8659  Z2UCD+1.0, N2r-1.0, beta2, 2.0) +
8660  ecoul( Z1UCD+1.0, N1r-1.0, beta1,
8661  Z2UCD-1.0, N2r+1.0, beta2, 2.0) -
8662  2.0*ecoul( Z1UCD, N1r, beta1, Z2UCD, N2r, beta2, 2.0) -
8663  2.0*frldm( Z1UCD, N1r, beta1 ) -
8664  2.0*frldm( Z2UCD, N2r, beta2) ) * 0.50;
8665 //
8666  if(1.0/A_levdens*E_scission_post < 0.0)
8667  std::cout << "DSQRT 1 < 0" << A_levdens << " " << E_scission_post << std::endl;
8668 
8669  if(0.50 * std::sqrt(1.0/A_levdens*E_scission_post) / CZ < 0.0){
8670  std::cout << "DSQRT 2 < 0 " << CZ << std::endl;
8671  std::cout << "This event was not considered" << std::endl;
8672  goto fiss321;
8673  }
8674 
8675  ZA1width = std::sqrt(0.5*std::sqrt(1.0/A_levdens*E_scission_post)/CZ);
8676 
8677 // Minimum width in N/Z imposed.
8678 // Value of minimum width taken from 235U(nth,f) data
8679 // sigma_Z(A=const) = 0.4 to 0.5 (from Lang paper Nucl Phys. A345 (1980) 34)
8680 // sigma_N(Z=const) = 0.45 * A/Z (= 1.16 for 238U)
8681 // therefore: SIGZMIN = 1.16
8682 // Physics; variation in N/Z for fixed A assumed.
8683 // Thermal energy at scission is reduced by
8684 // pre-scission neutron evaporation"
8685 
8686  ZA1width = max(ZA1width,sigZmin);
8687 
8688  if(imode == 1 && cpol1 != 0.0){
8689 // --- asymmetric fission, mode 1 */
8690  G4int IS = 0;
8691  fiss2801:
8692  Z1rr = Z1UCD - cpol1 * A_scission/N_scission;
8693  // Z1r = DBLE(GaussHaz(k,sngl(Z1rr), sngl(ZA1width) ));
8694  // Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);//
8695  Z1r =gausshaz(0,Z1rr,ZA1width);
8696  IS = IS +1;
8697  if(IS>100){
8698  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED" << std::endl;
8699  Z1r = Z1rr;
8700  }
8701  if ((utilabs(Z1rr - Z1r) > 3.0*ZA1width) || Z1r<1.0)goto fiss2801;
8702  N1r = A1r - Z1r;
8703  }else{
8704  if( imode == 2 && cpol2 != 0.0 ){
8705 // --- asymmetric fission, mode 2 */
8706  G4int IS = 0;
8707  fiss2802:
8708  Z1rr = Z1UCD - cpol2 * A_scission/N_scission;
8709  //Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);//
8710  Z1r = gausshaz(0,Z1rr,ZA1width);
8711  IS = IS +1;
8712  if(IS>100){
8713  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED" << std::endl;
8714  Z1r = Z1rr;
8715  }
8716  if( (utilabs(Z1rr - Z1r) > 3.0*ZA1width) || Z1r < 1.0 ) goto fiss2802;
8717  N1r = A1r - Z1r;
8718  }else{
8719 // Otherwise do; /* Imode = 3 in any case; imode = 1 and 2 for CPOL = 0 */
8720 // and symmetric case */
8721 // We treat a simultaneous split in Z and N to determine
8722 // polarisation */
8723 
8724  re1 = frldm( Z1UCD-1.0, N1r+1.0, beta1 ) +
8725  frldm( Z2UCD+1.0, N2r-1.0, beta2 ) +
8726  ecoul( Z1UCD-1.0, N1r+1.0, beta1,
8727  Z2UCD+1.0, N2r-1.0, beta2, d ); /* d = 2 fm */
8728  re2 = frldm( Z1UCD, N1r, beta1) +
8729  frldm( Z2UCD, N2r, beta2 ) +
8730  ecoul( Z1UCD, N1r, beta1,
8731  Z2UCD, N2r, beta2, d ); /* d = 2 fm */
8732  re3 = frldm( Z1UCD+1.0, N1r-1.0, beta1 ) +
8733  frldm( Z2UCD-1.0, N2r+1.0, beta2 ) +
8734  ecoul( Z1UCD+1.0, N1r-1.0, beta1,
8735  Z2UCD-1.0, N2r+1.0, beta2, d ); /* d = 2 fm */
8736  eps2 = ( re1 - 2.0*re2 + re3 ) / 2.0;
8737  eps1 = ( re3 - re1 ) / 2.0;
8738  DN1_POL = -eps1 / ( 2.0 * eps2 );
8739 //
8740  Z1rr = Z1UCD + DN1_POL;
8741 
8742 // Polarization of Standard 1 from shell effects around 132Sn
8743  if ( imode == 1 ){
8744  if ( Z1rr > 50.0 ){
8745  DN1_POL = DN1_POL - 0.6 * Uwash(E_scission_post,Ecrit,FREDSHELL,gamma);
8746  Z1rr = Z1UCD + DN1_POL;
8747  if ( Z1rr < 50. ) Z1rr = 50.0;
8748  }else{
8749  DN1_POL = DN1_POL + 0.60 * Uwash(E_scission_post,Ecrit,FREDSHELL,gamma);
8750  Z1rr = Z1UCD + DN1_POL;
8751  if ( Z1rr > 50.0 ) Z1rr = 50.0;
8752  }
8753  }
8754 
8755  G4int IS = 0;
8756  fiss2803:
8757  //Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);
8758  Z1r = gausshaz(0,Z1rr,ZA1width);
8759  IS = IS +1;
8760  if(IS>100){
8761  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED" << std::endl;
8762  Z1r = Z1rr;
8763  }
8764 
8765  if( (utilabs(Z1rr - Z1r) > 3.0*ZA1width) || (Z1r < 1.0) )goto fiss2803;
8766  N1r = A1r - Z1r;
8767 
8768  }
8769  }
8770 
8771 // ------------------------------------------
8772 // Integer proton number with even-odd effect
8773 // ------------------------------------------
8774  even_odd(Z1r, r_e_o, i_help);
8775 
8776  z1 = G4double(i_help);
8777  z2 = dint( Z_scission ) - z1;
8778  N1 = dint( N1r );
8779  N2 = dint( N_scission ) - N1;
8780  a1 = z1 + N1;
8781  a2 = z2 + N2;
8782 
8783  if( (z1 < 0) || (z2 < 0) || (a1 < 0) || (a2 < 0) ){
8784  std::cout << " -------------------------------" << std::endl;
8785  std::cout << " Z, A, N : " << Z << " " << A << " " << N << std::endl;
8786  std::cout << z1 << " " << z2 << " " << a1 << " " << a2 << std::endl;
8787  std::cout << E_scission_post << " " << A_levdens << " " << CZ << std::endl;
8788 
8789  std::cout << " -------------------------------" << std::endl;
8790  }
8791 
8792 // -----------------------
8793 // excitation energies ...
8794 // -----------------------
8795 //
8796  if( imode == 1 ){
8797 // ---- N = 82
8798  if( N1mean > N*0.50 ){
8799 // (a) 1. fragment is spherical and 2. fragment is deformed */
8800  E_defo = 0.0;
8801  beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8802  if(beta2< beta2gs) beta2 = beta2gs;
8803  E1exc = E_scission_pre * a1 / A + E_defo;
8804  E_defo = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8805  E2exc = E_scission_pre * a2 / A + E_defo;
8806  }else{
8807 // (b) 1. fragment is deformed and 2. fragment is spherical */
8808  beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8809  if(beta1< beta1gs) beta1 = beta1gs;
8810  E_defo = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8811  E1exc = E_scission_pre * a1 / A + E_defo;
8812  E_defo = 0.0;
8813  E2exc = E_scission_pre * a2 / A + E_defo;
8814  }
8815  }
8816 
8817 
8818  if( imode == 2 ){
8819 // --- N appr. 86 */
8820  if( N1mean > N*0.5 ){
8821  /* 2. fragment is spherical */
8822  beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8823  if(beta1< beta1gs) beta1 = beta1gs;
8824  E_defo = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8825  E1exc = E_scission_pre * a1 / A + E_defo;
8826  beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8827  if(beta2< beta2gs) beta2 = beta2gs;
8828  E_defo = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8829  E2exc = E_scission_pre * a2 / A + E_defo;
8830  }else{
8831  /* 1. fragment is spherical */
8832  beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8833  if(beta2< beta2gs) beta2 = beta2gs;
8834  E_defo = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8835  E2exc = E_scission_pre * a2 / A + E_defo;
8836  beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8837  if(beta1< beta1gs) beta1 = beta1gs;
8838  E_defo = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8839  E1exc = E_scission_pre * a1 / A + E_defo;
8840  }
8841  }
8842 
8843  if( imode == 3 ){
8844 // --- Symmetric fission channel
8845  beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8846  if(beta1< beta1gs) beta1 = beta1gs;
8847  beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8848  if(beta2< beta2gs) beta2 = beta2gs;
8849  E_defo1 = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8850  E_defo2 = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8851  E1exc = E_scission_pre * a1 / A + E_defo1;
8852  E2exc = E_scission_pre * a2 / A + E_defo2;
8853  }
8854 
8855 
8856 // pre-neutron-emission total kinetic energy */
8857  TKER = ( z1 * z2 * 1.440 ) /
8858  ( R0 * std::pow(a1,0.333330) * (1.0 + 2.0/3.0 * beta1 ) +
8859  R0 * std::pow(a2,0.333330) * (1.0 + 2.0/3.0 * beta2 ) + 2.0 );
8860 // Pre-neutron-emission kinetic energies of the fragments */
8861  EkinR1 = TKER * a2 / A;
8862  EkinR2 = TKER * a1 / A;
8863  v1 = std::sqrt(EkinR1/a1) * 1.3887;
8864  v2 = std::sqrt(EkinR2/a2) * 1.3887;
8865 
8866 // Extracted from Lang et al. Nucl. Phys. A 345 (1980) 34 */
8867  E1exc_sigma = 5.50;
8868  E2exc_sigma = 5.50;
8869 
8870  fis987:
8871  //e1 = E1exc+G4AblaRandom::gaus(E1exc_sigma);//
8872  e1 = gausshaz(0,E1exc,E1exc_sigma);
8873  if(e1<0.)goto fis987;
8874  fis988:
8875  //e2 = E2exc+G4AblaRandom::gaus(E2exc_sigma);//
8876  e2 = gausshaz(0,E2exc,E2exc_sigma);
8877  if(e2<0.)goto fis988;
8878 
8879  (*NbLam0_par) = NbLam0;
8880  return;
8881 }
8882 
8883 
8884 void G4Abla::even_odd(G4double r_origin,G4double r_even_odd,G4int &i_out)
8885 {
8886  // Procedure to calculate I_OUT from R_IN in a way that
8887  // on the average a flat distribution in R_IN results in a
8888  // fluctuating distribution in I_OUT with an even-odd effect as
8889  // given by R_EVEN_ODD
8890 
8891  // /* ------------------------------------------------------------ */
8892  // /* EXAMPLES : */
8893  // /* ------------------------------------------------------------ */
8894  // /* If R_EVEN_ODD = 0 : */
8895  // /* CEIL(R_IN) ---- */
8896  // /* */
8897  // /* R_IN -> */
8898  // /* (somewhere in between CEIL(R_IN) and FLOOR(R_IN)) */ */
8899  // /* */
8900  // /* FLOOR(R_IN) ---- --> I_OUT */
8901  // /* ------------------------------------------------------------ */
8902  // /* If R_EVEN_ODD > 0 : */
8903  // /* The interval for the above treatment is */
8904  // /* larger for FLOOR(R_IN) = even and */
8905  // /* smaller for FLOOR(R_IN) = odd */
8906  // /* For R_EVEN_ODD < 0 : just opposite treatment */
8907  // /* ------------------------------------------------------------ */
8908 
8909  // /* ------------------------------------------------------------ */
8910  // /* On input: R_ORIGIN nuclear charge (real number) */
8911  // /* R_EVEN_ODD requested even-odd effect */
8912  // /* Intermediate quantity: R_IN = R_ORIGIN + 0.5 */
8913  // /* On output: I_OUT nuclear charge (integer) */
8914  // /* ------------------------------------------------------------ */
8915 
8916  // G4double R_ORIGIN,R_IN,R_EVEN_ODD,R_REST,R_HELP;
8917  G4double r_in = 0.0, r_rest = 0.0, r_help = 0.0;
8918  G4double r_floor = 0.0;
8919  G4double r_middle = 0.0;
8920  // G4int I_OUT,N_FLOOR;
8921  G4int n_floor = 0;
8922 
8923  r_in = r_origin + 0.5;
8924  r_floor = (G4double)((G4int)(r_in));
8925  if (r_even_odd < 0.001) {
8926  i_out = (G4int)(r_floor);
8927  }
8928  else {
8929  r_rest = r_in - r_floor;
8930  r_middle = r_floor + 0.5;
8931  n_floor = (G4int)(r_floor);
8932  if (n_floor%2 == 0) {
8933  // even before modif.
8934  r_help = r_middle + (r_rest - 0.5) * (1.0 - r_even_odd);
8935  }
8936  else {
8937  // odd before modification
8938  r_help = r_middle + (r_rest - 0.5) * (1.0 + r_even_odd);
8939  }
8940  i_out = (G4int)(r_help);
8941  }
8942 }
8943 
8944 double G4Abla::umass(G4double z,G4double n,G4double beta)
8945 {
8946  // liquid-drop mass, Myers & Swiatecki, Lysekil, 1967
8947  // pure liquid drop, without pairing and shell effects
8948 
8949  // On input: Z nuclear charge of nucleus
8950  // N number of neutrons in nucleus
8951  // beta deformation of nucleus
8952  // On output: binding energy of nucleus
8953 
8954  G4double a = 0.0, fumass = 0.0;
8955  G4double alpha = 0.0;
8956  G4double xcom = 0.0, xvs = 0.0, xe = 0.0;
8957  const G4double pi = 3.1416;
8958 
8959  a = n + z;
8960  alpha = ( std::sqrt(5.0/(4.0*pi)) ) * beta;
8961 
8962  xcom = 1.0 - 1.7826 * ((a - 2.0*z)/a)*((a - 2.0*z)/a);
8963  // factor for asymmetry dependence of surface and volume term
8964  xvs = - xcom * ( 15.4941 * a -
8965  17.9439 * std::pow(a,2.0/3.0) * (1.0+0.4*alpha*alpha) );
8966  // sum of volume and surface energy
8967  xe = z*z * (0.7053/(std::pow(a,1.0/3.0)) * (1.0-0.2*alpha*alpha) - 1.1529/a);
8968  fumass = xvs + xe;
8969 
8970  return fumass;
8971 }
8972 
8973 
8974 double G4Abla::ecoul(G4double z1,G4double n1,G4double beta1,G4double z2,G4double n2,G4double beta2,G4double d)
8975 {
8976  // Coulomb potential between two nuclei
8977  // surfaces are in a distance of d
8978  // in a tip to tip configuration
8979 
8980  // approximate formulation
8981  // On input: Z1 nuclear charge of first nucleus
8982  // N1 number of neutrons in first nucleus
8983  // beta1 deformation of first nucleus
8984  // Z2 nuclear charge of second nucleus
8985  // N2 number of neutrons in second nucleus
8986  // beta2 deformation of second nucleus
8987  // d distance of surfaces of the nuclei
8988 
8989  // G4double Z1,N1,beta1,Z2,N2,beta2,d,ecoul;
8990  G4double fecoul = 0;
8991  G4double dtot = 0;
8992  const G4double r0 = 1.16;
8993 
8994  dtot = r0 * ( std::pow((z1+n1),1.0/3.0) * (1.0+0.6666667*beta1)
8995  + std::pow((z2+n2),1.0/3.0) * (1.0+0.6666667*beta2) ) + d;
8996  fecoul = z1 * z2 * 1.44 / dtot;
8997 
8998  return fecoul;
8999 }
9000 
9001 
9002  G4double G4Abla::Uwash(G4double E, G4double Ecrit,G4double Freduction,G4double gamma){
9003  // E excitation energy
9004  // Ecrit critical pairing energy
9005  // Freduction reduction factor for shell washing in superfluid region
9006  G4double R_wash,uwash;
9007  if(E < Ecrit)
9008  R_wash = std::exp(-E * Freduction * gamma);
9009  else
9010  R_wash = std::exp(- Ecrit * Freduction * gamma -(E-Ecrit) * gamma);
9011 
9012  uwash = R_wash;
9013  return uwash;
9014 }
9015 
9016 
9017 G4double G4Abla::frldm(G4double z,G4double n,G4double beta){
9018 
9019 // Liquid-drop mass, Myers & Swiatecki, Lysekil, 1967
9020 // pure liquid drop, without pairing and shell effects
9021 //
9022 // On input: Z nuclear charge of nucleus
9023 // N number of neutrons in nucleus
9024 // beta deformation of nucleus
9025 // On output: binding energy of nucleus
9026 // The idea is to use FRLDM model for beta=0 and using Lysekil
9027 // model to get the deformation energy
9028 
9029  G4double a;
9030  a = n + z;
9031  return eflmac_profi(a,z) + umass(z,n,beta) - umass(z,n,0.0);
9032 }
9033 
9034 
9035 //**********************************************************************
9036 // *
9037 // * this function will calculate the liquid-drop nuclear mass for spheri
9038 // * configuration according to the preprint NUCLEAR GROUND-STATE
9039 // * MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
9040 // * All constants are taken from this publication for consistency.
9041 // *
9042 // * Parameters:
9043 // * a: nuclear mass number
9044 // * z: nuclear charge
9045 // **********************************************************************
9046 
9047 
9048 G4double G4Abla::eflmac_profi(G4double ia, G4double iz)
9049 {
9050  // CHANGED TO CALCULATE TOTAL BINDING ENERGY INSTEAD OF MASS EXCESS.
9051  // SWITCH FOR PAIRING INCLUDED AS WELL.
9052  // BINDING = EFLMAC(IA,IZ,0,OPTSHP)
9053  // FORTRAN TRANSCRIPT OF /U/GREWE/LANG/EEX/FRLDM.C
9054  // A.J. 15.07.96
9055 
9056  // this function will calculate the liquid-drop nuclear mass for spheri
9057  // configuration according to the preprint NUCLEAR GROUND-STATE
9058  // MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
9059  // All constants are taken from this publication for consistency.
9060 
9061  // Parameters:
9062  // a: nuclear mass number
9063  // z: nuclear charge
9064 
9065  G4double eflmacResult = 0.0;
9066 
9067  G4int in = 0;
9068  G4double z = 0.0, n = 0.0, a = 0.0, av = 0.0, as = 0.0;
9069  G4double a0 = 0.0, c1 = 0.0, c4 = 0.0, b1 = 0.0, b3 = 0.0;
9070  G4double ff = 0.0, ca = 0.0, w = 0.0, efl = 0.0;
9071  G4double r0 = 0.0, kf = 0.0, ks = 0.0;
9072  G4double kv = 0.0, rp = 0.0, ay = 0.0, aden = 0.0, x0 = 0.0, y0 = 0.0;
9073  G4double esq = 0.0, ael = 0.0, i = 0.0;
9074  G4double pi = 3.141592653589793238e0;
9075 
9076  // fundamental constants
9077  // electronic charge squared
9078  esq = 1.4399764;
9079 
9080  // constants from considerations other than nucl. masses
9081  // electronic binding
9082  ael = 1.433e-5;
9083 
9084  // proton rms radius
9085  rp = 0.8;
9086 
9087  // nuclear radius constant
9088  r0 = 1.16;
9089 
9090  // range of yukawa-plus-expon. potential
9091  ay = 0.68;
9092 
9093  // range of yukawa function used to generate
9094  // nuclear charge distribution
9095  aden= 0.70;
9096 
9097  // wigner constant
9098  w = 30.0;
9099 
9100  // adjusted parameters
9101  // volume energy
9102  av = 16.00126;
9103 
9104  // volume asymmetry
9105  kv = 1.92240;
9106 
9107  // surface energy
9108  as = 21.18466;
9109 
9110  // surface asymmetry
9111  ks = 2.345;
9112  // a^0 constant
9113  a0 = 2.615;
9114 
9115  // charge asymmetry
9116  ca = 0.10289;
9117 
9118  z = G4double(iz);
9119  a = G4double(ia);
9120  in = ia - iz;
9121  n = G4double(in);
9122 
9123 
9124  c1 = 3.0/5.0*esq/r0;
9125  c4 = 5.0/4.0*std::pow((3.0/(2.0*pi)),(2.0/3.0)) * c1;
9126  kf = std::pow((9.0*pi*z/(4.0*a)),(1.0/3.0))/r0;
9127 
9128  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));
9129 
9130  i = (n-z)/a;
9131 
9132  x0 = r0 * std::pow(a,(1.0/3.0)) / ay;
9133  y0 = r0 * std::pow(a,(1.0/3.0)) / aden;
9134 
9135  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);
9136 
9137  b3 = 1.0 - 5.0/std::pow(y0,2) * (1.0 - 15.0/(8.0*y0) + 21.0/(8.0 * std::pow(y0,3))
9138  - 3.0/4.0 * (1.0 + 9.0/(2.0*y0) + 7.0/std::pow(y0,2)
9139  + 7.0/(2.0 * std::pow(y0,3))) * std::exp(-2.0*y0));
9140 
9141  // now calulation of total binding energy
9142 
9143  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
9144  + 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))
9145  + ff*std::pow(z,2)/a -ca*(n-z) - ael * std::pow(z,(2.39e0));
9146 
9147  efl = efl + w*utilabs(i);
9148 
9149  eflmacResult = efl;
9150 
9151  return eflmacResult;
9152 }
9153 //
9154 //
9155 //
9156 void 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){
9157 //
9158  G4int INMIN,INMAX,NDIF=0,IMEM;
9159  G4int NEVA=0,PEVA=0;
9160  G4double VP2X,VP2Y,VP2Z;
9161 
9162  *AFPNEW = AFP;
9163  *ZFPNEW = ZFP;
9164  IOUNSTABLE = 0;
9165  *ILOOP = 0;
9166  IMEM = 0;
9167  for(G4int i=0;i<200;i++){
9168  BU_TAB_TEMP[i][0] = 0.0;
9169  BU_TAB_TEMP[i][1] = 0.0;
9170  BU_TAB_TEMP[i][2] = 0.0;
9171  BU_TAB_TEMP[i][3] = 0.0;
9172  BU_TAB_TEMP[i][4] = 0.0;
9173  //BU_TAB_TEMP[i][5] = 0.0;
9174  }
9175  *VP1X = 0.0;
9176  *VP1Y = 0.0;
9177  *VP1Z = 0.0;
9178 
9179  if(AFP==0 && ZFP==0){
9180 // PRINT*,'UNSTABLE NUCLEI, AFP=0, ZFP=0'
9181  return;
9182  }
9183  if((AFP==1 && ZFP==0) ||
9184  (AFP==1 && ZFP==1) ||
9185  (AFP==2 && ZFP==1) ||
9186  (AFP==3 && ZFP==1) ||
9187  (AFP==3 && ZFP==2) ||
9188  (AFP==4 && ZFP==2) ||
9189  (AFP==6 && ZFP==2) ||
9190  (AFP==8 && ZFP==2)
9191  ){
9192  *VP1X = VX;
9193  *VP1Y = VY;
9194  *VP1Z = VZ;
9195  return;
9196  }
9197 
9198  if ((AFP-ZFP)==0 && ZFP>1){
9199  for(G4int I = 0;I<=AFP-2;I++){
9200  unstable_tke(G4double(AFP-I),G4double(AFP-I),G4double(AFP-I-1),G4double(AFP-I-1),VX,VY,VZ,
9201  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9202  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9203  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9204  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9205  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9206  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9207  *ILOOP = *ILOOP + 1;
9208  VX = *VP1X;
9209  VY = *VP1Y;
9210  VZ = *VP1Z;
9211  }
9212  // PEVA = PEVA + ZFP - 1;
9213  AFP = 1;
9214  ZFP = 1;
9215  IOUNSTABLE = 1;
9216  }
9217 //
9218 //*** Find the limits nucleus is bound :
9219  isostab_lim(ZFP,&INMIN,&INMAX);
9220  NDIF = AFP - ZFP;
9221  if(NDIF<INMIN){
9222 // Proton unbound
9223  IOUNSTABLE = 1;
9224  for(G4int I = 1;I<=10; I++){
9225  isostab_lim(ZFP-I,&INMIN,&INMAX);
9226  if(INMIN<=NDIF){
9227  IMEM = I;
9228  ZFP = ZFP - I;
9229  AFP = ZFP + NDIF;
9230  PEVA = I;
9231  goto u10;
9232  }
9233  }
9234 //
9235  u10:
9236  for(G4int I = 0;I< IMEM;I++){
9237  unstable_tke(G4double(NDIF+ZFP+IMEM-I),
9238  G4double(ZFP+IMEM-I),
9239  G4double(NDIF+ZFP+IMEM-I-1),
9240  G4double(ZFP+IMEM-I-1),
9241  VX,VY,VZ,
9242  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9243  BU_TAB_TEMP[I+1+*ILOOP][0] = 1.0;
9244  BU_TAB_TEMP[I+1+*ILOOP][1] = 1.0;
9245  BU_TAB_TEMP[I+1+*ILOOP][2] = VP2X;
9246  BU_TAB_TEMP[I+1+*ILOOP][3] = VP2Y;
9247  BU_TAB_TEMP[I+1+*ILOOP][4] = VP2Z;
9248  VX = *VP1X;
9249  VY = *VP1Y;
9250  VZ = *VP1Z;
9251  }
9252  *ILOOP = *ILOOP + IMEM;
9253 
9254  }
9255  if(NDIF>INMAX){
9256 // Neutron unbound
9257  NEVA = NDIF - INMAX;
9258  AFP = ZFP + INMAX;
9259  IOUNSTABLE = 1;
9260  for(G4int I = 0;I<NEVA;I++){
9261  unstable_tke(G4double(ZFP+NDIF-I),
9262  G4double(ZFP),
9263  G4double(ZFP+NDIF-I-1),
9264  G4double(ZFP),
9265  VX,VY,VZ,
9266  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9267 
9268  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9269  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9270  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9271  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9272  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9273  *ILOOP = *ILOOP + 1;
9274  VX = *VP1X;
9275  VY = *VP1Y;
9276  VZ = *VP1Z;
9277  }
9278  }
9279 
9280  if ((AFP>=2) && (ZFP==0)){
9281  for(G4int I = 0;I<= AFP-2;I++){
9282  unstable_tke(G4double(AFP-I),G4double(ZFP),
9283  G4double(AFP-I-1),G4double(ZFP),
9284  VX,VY,VZ,
9285  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9286 
9287  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9288  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9289  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9290  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9291  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9292  *ILOOP = *ILOOP + 1;
9293  VX = *VP1X;
9294  VY = *VP1Y;
9295  VZ = *VP1Z;
9296  }
9297 
9298  //NEVA = NEVA + (AFP - 1);
9299  AFP = 1;
9300  ZFP = 0;
9301  IOUNSTABLE = 1;
9302  }
9303  if (AFP<ZFP){
9304  std::cout << "WARNING - BU UNSTABLE: AF < ZF" << std::endl;
9305  AFP = 0;
9306  ZFP = 0;
9307  IOUNSTABLE = 1;
9308  }
9309  if ((AFP>=4) && (ZFP==1)){
9310 // Heavy residue is treated as 3H and the rest of mass is emitted as neutrons:
9311  for(G4int I = 0; I<AFP-3;I++){
9312  unstable_tke(G4double(AFP-I),G4double(ZFP),
9313  G4double(AFP-I-1),G4double(ZFP),
9314  VX,VY,VZ,
9315  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9316 
9317  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9318  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9319  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9320  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9321  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9322  *ILOOP = *ILOOP + 1;
9323  VX = *VP1X;
9324  VY = *VP1Y;
9325  VZ = *VP1Z;
9326  }
9327 
9328  // NEVA = NEVA + (AFP - 3);
9329  AFP = 3;
9330  ZFP = 1;
9331  IOUNSTABLE = 1;
9332  }
9333 
9334  if ((AFP==4) && (ZFP==3)){
9335 // 4Li -> 3He + p ->
9336  AFP = 3;
9337  ZFP = 2;
9338  //PEVA = PEVA + 1;
9339  IOUNSTABLE = 1;
9340  unstable_tke(4.0,3.0,3.0,2.0,
9341  VX,VY,VZ,
9342  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9343 
9344  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9345  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9346  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9347  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9348  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9349  *ILOOP = *ILOOP + 1;
9350  }
9351  if ((AFP==5) && (ZFP==2)){
9352 // 5He -> 4He + n ->
9353  AFP = 4;
9354  ZFP = 2;
9355  //NEVA = NEVA + 1;
9356  IOUNSTABLE = 1;
9357  unstable_tke(5.0,2.0,4.0,2.0,
9358  VX,VY,VZ,
9359  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9360  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9361  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9362  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9363  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9364  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9365  *ILOOP = *ILOOP + 1;
9366  }
9367 
9368  if ((AFP==5) && (ZFP==3)){
9369 // 5Li -> 4He + p
9370  AFP = 4;
9371  ZFP = 2;
9372  //PEVA = PEVA + 1;
9373  IOUNSTABLE = 1;
9374  unstable_tke(5.0,3.0,4.0,2.0,
9375  VX,VY,VZ,
9376  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9377  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9378  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9379  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9380  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9381  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9382  *ILOOP = *ILOOP + 1;
9383  }
9384 
9385  if ((AFP==6) && (ZFP==4)){
9386 // 6Be -> 4He + 2p (velocity in two steps: 6Be->5Li->4He)
9387  AFP = 4;
9388  ZFP = 2;
9389  //PEVA = PEVA + 2;
9390  IOUNSTABLE = 1;
9391 // 6Be -> 5Li + p
9392  unstable_tke(6.0,4.0,5.0,3.0,
9393  VX,VY,VZ,
9394  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9395  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9396  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9397  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9398  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9399  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9400  *ILOOP = *ILOOP + 1;
9401  VX = *VP1X;
9402  VY = *VP1Y;
9403  VZ = *VP1Z;
9404 
9405 // 5Li -> 4He + p
9406  unstable_tke(5.0,3.0,4.0,2.0,
9407  VX,VY,VZ,
9408  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9409  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9410  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9411  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9412  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9413  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9414  *ILOOP = *ILOOP + 1;
9415  }
9416  if ((AFP==7)&&(ZFP==2)){
9417 // 7He -> 6He + n
9418  AFP = 6;
9419  ZFP = 2;
9420  //NEVA = NEVA + 1;
9421  IOUNSTABLE = 1;
9422  unstable_tke(7.0,2.0,6.0,2.0,
9423  VX,VY,VZ,
9424  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9425  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9426  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9427  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9428  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9429  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9430  *ILOOP = *ILOOP + 1;
9431  }
9432 
9433  if ((AFP==7) && (ZFP==5)){
9434 // 7B -> 6Be + p -> 4He + 3p
9435  for(int I = 0; I<= AFP-5;I++){
9436  unstable_tke(double(AFP-I),double(ZFP-I),
9437  double(AFP-I-1),double(ZFP-I-1),
9438  VX,VY,VZ,
9439  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9440  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9441  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9442  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9443  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9444  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9445  *ILOOP = *ILOOP + 1;
9446  VX = *VP1X;
9447  VY = *VP1Y;
9448  VZ = *VP1Z;
9449  }
9450 
9451  AFP = 4;
9452  ZFP = 2;
9453  //PEVA = PEVA + 3;
9454  IOUNSTABLE = 1;
9455  }
9456  if ((AFP==8) && (ZFP==4)){
9457 // 8Be -> 4He + 4He
9458  AFP = 4;
9459  ZFP = 2;
9460  IOUNSTABLE = 1;
9461  unstable_tke(8.0,4.0,4.0,2.0,
9462  VX,VY,VZ,
9463  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9464  BU_TAB_TEMP[*ILOOP][0] = 2.0;
9465  BU_TAB_TEMP[*ILOOP][1] = 4.0;
9466  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9467  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9468  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9469  *ILOOP = *ILOOP + 1;
9470  }
9471  if ((AFP==8) && (ZFP==6)){
9472 // 8C -> 2p + 6Be
9473  AFP = 6;
9474  ZFP = 4;
9475  //PEVA = PEVA + 2;
9476  IOUNSTABLE = 1;
9477 
9478  unstable_tke(8.0,6.0,7.0,5.0,
9479  VX,VY,VZ,
9480  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9481  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9482  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9483  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9484  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9485  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9486  *ILOOP = *ILOOP + 1;
9487  VX = *VP1X;
9488  VY = *VP1Y;
9489  VZ = *VP1Z;
9490 
9491  unstable_tke(7.0,5.0,6.0,4.0,
9492  VX,VY,VZ,
9493  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9494  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9495  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9496  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9497  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9498  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9499  *ILOOP = *ILOOP + 1;
9500  VX = *VP1X;
9501  VY = *VP1Y;
9502  VZ = *VP1Z;
9503  }
9504 
9505  if((AFP==9) && (ZFP==2)){
9506 // 9He -> 8He + n
9507  AFP = 8;
9508  ZFP = 2;
9509  //NEVA = NEVA + 1;
9510  IOUNSTABLE = 1;
9511 
9512  unstable_tke(9.0,2.0,8.0,2.0,
9513  VX,VY,VZ,
9514  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9515  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9516  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9517  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9518  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9519  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9520  *ILOOP = *ILOOP + 1;
9521  VX = *VP1X;
9522  VY = *VP1Y;
9523  VZ = *VP1Z;
9524  }
9525 
9526  if((AFP==9) && (ZFP==5)){
9527 // 9B -> 4He + 4He + p ->
9528  AFP = 4;
9529  ZFP = 2;
9530  //PEVA = PEVA + 1;
9531  IOUNSTABLE = 1;
9532  unstable_tke(9.0,5.0,8.0,4.0,
9533  VX,VY,VZ,
9534  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9535  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9536  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9537  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9538  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9539  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9540  *ILOOP = *ILOOP + 1;
9541  VX = *VP1X;
9542  VY = *VP1Y;
9543  VZ = *VP1Z;
9544 
9545  unstable_tke(8.0,4.0,4.0,2.0,
9546  VX,VY,VZ,
9547  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9548  BU_TAB_TEMP[*ILOOP][0] = 2.0;
9549  BU_TAB_TEMP[*ILOOP][1] = 4.0;
9550  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9551  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9552  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9553  *ILOOP = *ILOOP + 1;
9554  VX = *VP1X;
9555  VY = *VP1Y;
9556  VZ = *VP1Z;
9557  }
9558 
9559  if((AFP==10) && (ZFP==2)){
9560 // 10He -> 8He + 2n
9561  AFP = 8;
9562  ZFP = 2;
9563  //NEVA = NEVA + 2;
9564  IOUNSTABLE = 1;
9565 // 10He -> 9He + n
9566  unstable_tke(10.0,2.0,9.0,2.0,
9567  VX,VY,VZ,
9568  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9569  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9570  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9571  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9572  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9573  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9574  *ILOOP = *ILOOP + 1;
9575  VX = *VP1X;
9576  VY = *VP1Y;
9577  VZ = *VP1Z;
9578 
9579 // 9He -> 8He + n
9580  unstable_tke(9.0,2.0,8.0,2.0,
9581  VX,VY,VZ,
9582  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9583  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9584  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9585  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9586  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9587  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9588  *ILOOP = *ILOOP + 1;
9589  VX = *VP1X;
9590  VY = *VP1Y;
9591  VZ = *VP1Z;
9592  }
9593  if ((AFP==10) && (ZFP==3)){
9594 // 10Li -> 9Li + n ->
9595  AFP = 9;
9596  ZFP = 3;
9597  //NEVA = NEVA + 1;
9598  IOUNSTABLE = 1;
9599  unstable_tke(10.0,3.0,9.0,3.0,
9600  VX,VY,VZ,
9601  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9602  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9603  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9604  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9605  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9606  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9607  *ILOOP = *ILOOP + 1;
9608  VX = *VP1X;
9609  VY = *VP1Y;
9610  VZ = *VP1Z;
9611  }
9612  if ((AFP==10) && (ZFP==7)){
9613 // 10N -> 9C + p ->
9614  AFP = 9;
9615  ZFP = 6;
9616  //PEVA = PEVA + 1;
9617  IOUNSTABLE = 1;
9618  unstable_tke(10.0,7.0,9.0,6.0,
9619  VX,VY,VZ,
9620  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9621  BU_TAB_TEMP[*ILOOP][0] = 1.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 
9632  if((AFP==11) && (ZFP==7)){
9633 // 11N -> 10C + p ->
9634  AFP = 10;
9635  ZFP = 6;
9636  //PEVA = PEVA + 1;
9637  IOUNSTABLE = 1;
9638  unstable_tke(11.0,7.0,10.0,6.0,
9639  VX,VY,VZ,
9640  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9641  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9642  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9643  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9644  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9645  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9646  *ILOOP = *ILOOP + 1;
9647  VX = *VP1X;
9648  VY = *VP1Y;
9649  VZ = *VP1Z;
9650  }
9651  if ((AFP==12) && (ZFP==8)){
9652 // 12O -> 10C + 2p ->
9653  AFP = 10;
9654  ZFP = 6;
9655  //PEVA = PEVA + 2;
9656  IOUNSTABLE = 1;
9657 
9658  unstable_tke(12.0,8.0,11.0,7.0,
9659  VX,VY,VZ,
9660  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9661  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9662  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9663  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9664  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9665  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9666  *ILOOP = *ILOOP + 1;
9667  VX = *VP1X;
9668  VY = *VP1Y;
9669  VZ = *VP1Z;
9670 
9671  unstable_tke(11.0,7.0,10.0,6.0,
9672  VX,VY,VZ,
9673  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9674  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9675  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9676  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9677  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9678  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9679  *ILOOP = *ILOOP + 1;
9680  VX = *VP1X;
9681  VY = *VP1Y;
9682  VZ = *VP1Z;
9683  }
9684  if ((AFP==15) && (ZFP==9)){
9685 // 15F -> 14O + p ->
9686  AFP = 14;
9687  ZFP = 8;
9688  //PEVA = PEVA + 1;
9689  IOUNSTABLE = 1;
9690  unstable_tke(15.0,9.0,14.0,8.0,
9691  VX,VY,VZ,
9692  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9693  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9694  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9695  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9696  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9697  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9698  *ILOOP = *ILOOP + 1;
9699  VX = *VP1X;
9700  VY = *VP1Y;
9701  VZ = *VP1Z;
9702  }
9703 
9704  if ((AFP==16) && (ZFP==9)){
9705 // 16F -> 15O + p ->
9706  AFP = 15;
9707  ZFP = 8;
9708  //PEVA = PEVA + 1;
9709  IOUNSTABLE = 1;
9710  unstable_tke(16.0,9.0,15.0,8.0,
9711  VX,VY,VZ,
9712  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9713  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9714  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9715  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9716  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9717  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9718  *ILOOP = *ILOOP + 1;
9719  VX = *VP1X;
9720  VY = *VP1Y;
9721  VZ = *VP1Z;
9722  }
9723 
9724  if ((AFP==16) && (ZFP==10)){
9725 // 16Ne -> 14O + 2p ->
9726  AFP = 14;
9727  ZFP = 8;
9728  //PEVA = PEVA + 2;
9729  IOUNSTABLE = 1;
9730  unstable_tke(16.0,10.0,15.0,9.0,
9731  VX,VY,VZ,
9732  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9733  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9734  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9735  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9736  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9737  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9738  *ILOOP = *ILOOP + 1;
9739  VX = *VP1X;
9740  VY = *VP1Y;
9741  VZ = *VP1Z;
9742 
9743  unstable_tke(15.0,9.0,14.0,8.0,
9744  VX,VY,VZ,
9745  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9746  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9747  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9748  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9749  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9750  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9751  *ILOOP = *ILOOP + 1;
9752  VX = *VP1X;
9753  VY = *VP1Y;
9754  VZ = *VP1Z;
9755  }
9756  if((AFP==18) && (ZFP==11)){
9757 // 18Na -> 17Ne + p ->
9758  AFP = 17;
9759  ZFP = 10;
9760  //PEVA = PEVA + 1;
9761  IOUNSTABLE = 1;
9762  unstable_tke(18.0,11.0,17.0,10.0,
9763  VX,VY,VZ,
9764  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9765  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9766  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9767  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9768  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9769  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9770  *ILOOP = *ILOOP + 1;
9771  VX = *VP1X;
9772  VY = *VP1Y;
9773  VZ = *VP1Z;
9774  }
9775  if((AFP==19) && (ZFP==11)){
9776 // 19Na -> 18Ne + p ->
9777  AFP = 18;
9778  ZFP = 10;
9779  //PEVA = PEVA + 1;
9780  IOUNSTABLE = 1;
9781  unstable_tke(19.0,11.0,18.0,10.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 (ZFP>=4 && (AFP-ZFP)==1){
9795 // Heavy residue is treated as 3He
9796  NEVA = AFP - 3;
9797  PEVA = ZFP - 2;
9798 
9799  for(G4int I = 0;I< NEVA;I++){
9800  unstable_tke(G4double(AFP-I),G4double(ZFP),
9801  G4double(AFP-I-1),G4double(ZFP),
9802  VX,VY,VZ,
9803  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9804  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9805  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9806  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9807  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9808  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9809  *ILOOP = *ILOOP + 1;
9810  VX = *VP1X;
9811  VY = *VP1Y;
9812  VZ = *VP1Z;
9813  }
9814  for( G4int I = 0;I<PEVA;I++){
9815  unstable_tke(G4double(AFP-NEVA-I),G4double(ZFP-I),
9816  G4double(AFP-NEVA-I-1),G4double(ZFP-I-1),
9817  VX,VY,VZ,
9818  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9819  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9820  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9821  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9822  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9823  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9824  *ILOOP = *ILOOP + 1;
9825  VX = *VP1X;
9826  VY = *VP1Y;
9827  VZ = *VP1Z;
9828  }
9829 
9830  AFP = 3;
9831  ZFP = 2;
9832  IOUNSTABLE = 1;
9833  }
9834 //
9835  *AFPNEW = AFP;
9836  *ZFPNEW = ZFP;
9837  return;
9838 }
9839 
9840 //
9841 //
9842 void G4Abla::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){
9843 //
9844  G4double EKIN_P1=0.,ekin_tot=0.;
9845  G4double PX1,PX2,PY1,PY2,PZ1,PZ2,PTOT;
9846  G4double RNDT,CTET1,STET1,RNDP,PHI1,ETOT_P1,ETOT_P2;
9847  G4double MASS,MASS1,MASS2;
9848  G4double vxout=0.,vyout=0.,vzout=0.;
9849  G4int iain,izin,ianew,iznew,inin,innew;
9850 //
9851  G4double C = 29.97924580;// cm/ns
9852  G4double AMU = 931.4940; // MeV/C^2
9853 //
9854  iain = idnint(ain);
9855  izin = idnint(zin);
9856  inin = iain - izin;
9857  ianew = idnint(anew);
9858  iznew = idnint(znew);
9859  innew = ianew - iznew;
9860 //
9861  if(izin>12){
9862  mglms(ain,zin,3,&MASS);
9863  mglms(anew,znew,3,&MASS1);
9864  mglms(ain-anew,zin-znew,3,&MASS2);
9865  ekin_tot = MASS-MASS1-MASS2;
9866  }else{
9867  // ekin_tot = MEXP(ININ,IZIN)-(MEXP(INNEW,IZNEW)+MEXP(ININ-INNEW,IZIN-IZNEW));
9868  ekin_tot = masses->massexp[inin][izin]-(masses->massexp[innew][iznew]+masses->massexp[inin-innew][izin-iznew]);
9869  if(izin>12)std::cout << "*** ZIN > 12 ***" << izin << std::endl;
9870  }
9871 
9872  if( ekin_tot<0.00 ){
9873 // if( iain.ne.izin .and. izin.ne.0 ){
9874 // print *,"Negative Q-value in UNSTABLE_TKE"
9875 // print *,"ekin_tot=",ekin_tot
9876 // print *,"ain,zin=",ain,zin,MEXP(ININ,IZIN)
9877 // print *,"anew,znew=",anew,znew,MEXP(INNEW,IZNEW)
9878 // print *
9879 // }
9880  ekin_tot=0.0;
9881  }
9882 //
9883  EKIN_P1 = ekin_tot*(ain-anew)/ ain;
9884  ETOT_P1 = EKIN_P1 + anew * AMU;
9885  PTOT = anew*AMU*std::sqrt((EKIN_P1/(anew*AMU)+1.0)*(EKIN_P1/(anew*AMU)+1.0)-1.0); // MeV/C
9886 //
9887  RNDT = G4AblaRandom::flat();
9888  CTET1 = 2.0*RNDT-1.0;
9889  STET1 = std::sqrt(1.0-CTET1*CTET1);
9890  RNDP = G4AblaRandom::flat();
9891  PHI1 = RNDP*2.0*3.141592654;
9892  PX1 = PTOT * STET1*std::cos(PHI1);
9893  PY1 = PTOT * STET1*std::sin(PHI1);
9894  PZ1 = PTOT * CTET1;
9895  *v1x = C * PX1 / ETOT_P1;
9896  *v1y = C * PY1 / ETOT_P1;
9897  *v1z = C * PZ1 / ETOT_P1;
9898  lorentz_boost(vxin,vyin,vzin,*v1x,*v1y,*v1z,&vxout,&vyout,&vzout);
9899  *v1x = vxout;
9900  *v1y = vyout;
9901  *v1z = vzout;
9902 //
9903  PX2 = - PX1;
9904  PY2 = - PY1;
9905  PZ2 = - PZ1;
9906  ETOT_P2 = (ekin_tot - EKIN_P1) + (ain-anew) * AMU;
9907  *v2x = C * PX2 / ETOT_P2;
9908  *v2y = C * PY2 / ETOT_P2;
9909  *v2z = C * PZ2 / ETOT_P2;
9910  lorentz_boost(vxin,vyin,vzin,*v2x,*v2y,*v2z,&vxout,&vyout,&vzout);
9911  *v2x = vxout;
9912  *v2y = vyout;
9913  *v2z = vzout;
9914 //
9915  return;
9916 }
9917 //
9918 //**************************************************************************
9919 //
9920 void G4Abla::lorentz_boost(G4double VXRIN,G4double VYRIN,G4double VZRIN,G4double VXIN,G4double VYIN,G4double VZIN,G4double *VXOUT,G4double *VYOUT,G4double *VZOUT){
9921 //
9922 // Calculate velocities of a given fragment from frame 1 into frame 2.
9923 // Frame 1 is moving with velocity v=(vxr,vyr,vzr) relative to frame 2.
9924 // Velocity of the fragment in frame 1 -> vxin,vyin,vzin
9925 // Velocity of the fragment in frame 2 -> vxout,vyout,vzout
9926 //
9927  G4double VXR,VYR,VZR;
9928  G4double GAMMA,VR,C,CC,DENO,VXNOM,VYNOM,VZNOM;
9929 //
9930  C = 29.9792458; // cm/ns
9931  CC = C*C;
9932 //
9933 // VXR,VYR,VZR are velocities of frame 1 relative to frame 2; to go from 1 to 2
9934 // we need to multiply them by -1
9935  VXR = -1.0 * VXRIN;
9936  VYR = -1.0 * VYRIN;
9937  VZR = -1.0 * VZRIN;
9938 //
9939  VR = std::sqrt(VXR*VXR + VYR*VYR + VZR*VZR);
9940  if(VR<1e-9){
9941  *VXOUT = VXIN;
9942  *VYOUT = VYIN;
9943  *VZOUT = VZIN;
9944  return;
9945  }
9946  GAMMA = 1.0/std::sqrt(1.0 - VR*VR/CC);
9947  DENO = 1.0 - VXR*VXIN/CC - VYR*VYIN/CC - VZR*VZIN/CC;
9948 
9949 // X component
9950  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;
9951 
9952  *VXOUT = VXNOM / (GAMMA * DENO);
9953 
9954 // Y component
9955  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;
9956 
9957  *VYOUT = VYNOM / (GAMMA * DENO);
9958 
9959 // Z component
9960  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;
9961 
9962  *VZOUT = VZNOM / (GAMMA * DENO);
9963 
9964  return;
9965 }
9966 
9967 void G4Abla::fission(G4double AF,G4double ZF,G4double EE,G4double JPRF,
9968  G4double *VX1_FISSION_par,G4double *VY1_FISSION_par,G4double *VZ1_FISSION_par,
9969  G4double *VX2_FISSION_par,G4double *VY2_FISSION_par,G4double *VZ2_FISSION_par,
9970  G4int *ZFP1,G4int *AFP1,G4int *SFP1, G4int *ZFP2,G4int *AFP2,G4int *SFP2,G4int *imode_par,
9971  G4double *VX_EVA_SC_par, G4double *VY_EVA_SC_par, G4double *VZ_EVA_SC_par,
9972  G4double EV_TEMP[200][6],G4int *IEV_TAB_FIS_par, G4int *NbLam0_par){
9974  G4double EFF1=0.,EFF2=0.,VFF1=0.,VFF2=0.,
9975  AF1=0.,ZF1=0.,AF2=0.,ZF2=0.,
9976  AFF1=0.,ZFF1=0.,AFF2=0.,ZFF2=0.,
9977  vz1_eva=0., vx1_eva=0.,vy1_eva=0.,
9978  vz2_eva=0., vx2_eva=0.,vy2_eva=0.,
9979  vx_eva_sc=0.,vy_eva_sc=0.,vz_eva_sc=0.,
9980  VXOUT=0.,VYOUT=0.,VZOUT=0.,
9981  VX2OUT=0.,VY2OUT=0.,VZ2OUT=0.;
9982  G4int IEV_TAB_FIS=0,IEV_TAB_TEMP=0;
9983  G4double EV_TEMP1[200][6], EV_TEMP2[200][6],mtota=0.;
9984  G4int inttype = 0,inum=0;
9985  IEV_TAB_SSC=0;
9986  (*imode_par)=0;
9987  G4int NbLam0= (*NbLam0_par);
9988 
9989  for(G4int I1=0;I1<200;I1++)
9990  for(G4int I2=0;I2<6;I2++){
9991  EV_TEMP[I1][I2] = 0.0;
9992  EV_TEMP1[I1][I2] = 0.0;
9993  EV_TEMP2[I1][I2] = 0.0;
9994  }
9995 
9996  G4double et = EE - JPRF * JPRF * 197. * 197./(2.*0.4*931.*std::pow(AF,5.0/3.0)*1.16*1.16);
9997 
9998  fissionDistri(AF,ZF,et,AF1,ZF1,EFF1,VFF1,AF2,ZF2,EFF2,VFF2,
9999  vx_eva_sc,vy_eva_sc,vz_eva_sc,&NbLam0);
10000 
10001 // Lambda particles
10002  G4int NbLam1=0;
10003  G4int NbLam2=0;
10004  G4double pbH = (AF1 - ZF1) / (AF1 - ZF1 + AF2 - ZF2);
10005  for(G4int i=0;i<NbLam0;i++){
10006  if(G4AblaRandom::flat()<pbH){
10007  NbLam1++;
10008  }else{
10009  NbLam2++;
10010  }
10011  }
10012 // Copy of the evaporated particles from saddle to scission
10013  for(G4int IJ = 0; IJ< IEV_TAB_SSC;IJ++){
10014  EV_TEMP[IJ][0] = EV_TAB_SSC[IJ][0];
10015  EV_TEMP[IJ][1] = EV_TAB_SSC[IJ][1];
10016  EV_TEMP[IJ][2] = EV_TAB_SSC[IJ][2];
10017  EV_TEMP[IJ][3] = EV_TAB_SSC[IJ][3];
10018  EV_TEMP[IJ][4] = EV_TAB_SSC[IJ][4];
10019  EV_TEMP[IJ][5] = EV_TAB_SSC[IJ][5];
10020  }
10021  IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_SSC;
10022 
10023 // Velocities
10024  G4double VZ1_FISSION = (2.0 * G4AblaRandom::flat() - 1.0) * VFF1;
10025  G4double VPERP1 = std::sqrt(VFF1*VFF1 - VZ1_FISSION*VZ1_FISSION);
10026  G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
10027  G4double VX1_FISSION = VPERP1 * std::sin(ALPHA1);
10028  G4double VY1_FISSION = VPERP1 * std::cos(ALPHA1);
10029  G4double VX2_FISSION = - VX1_FISSION / VFF1 * VFF2;
10030  G4double VY2_FISSION = - VY1_FISSION / VFF1 * VFF2;
10031  G4double VZ2_FISSION = - VZ1_FISSION / VFF1 * VFF2;
10032 //
10033 // Fission fragment 1
10034  if( (ZF1<=0.0) || (AF1<=0.0) || (AF1<ZF1) ){
10035  std::cout << "F1 unphysical: "<<ZF<< " "<<AF<< " "<<EE<< " "<<ZF1<< " "<<AF1 << std::endl;
10036  }else{
10037 // fission and IMF emission are not allowed
10038  opt->optimfallowed = 0; // IMF is not allowed
10039  fiss->ifis = 0; // fission is not allowed
10040  gammaemission=1;
10041  G4int FF11=0, FIMF11=0;
10042  G4double ZIMFF1=0., AIMFF1=0.,TKEIMF1=0.,JPRFOUT=0.;
10043 //
10044  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);
10045 
10046  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
10047  EV_TEMP[IJ+IEV_TAB_FIS][0] = EV_TEMP1[IJ][0];
10048  EV_TEMP[IJ+IEV_TAB_FIS][1] = EV_TEMP1[IJ][1];
10049 // Lorentz kinematics
10050 // EV_TEMP(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
10051 // EV_TEMP(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
10052 // EV_TEMP(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
10053 // Lorentz transformation
10054  lorentz_boost(VX1_FISSION,VY1_FISSION,VZ1_FISSION,
10055  EV_TEMP1[IJ][2],EV_TEMP1[IJ][3],EV_TEMP1[IJ][4],
10056  &VXOUT,&VYOUT,&VZOUT);
10057  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
10058  VXOUT,VYOUT,VZOUT,
10059  &VX2OUT,&VY2OUT,&VZ2OUT);
10060  EV_TEMP[IJ+IEV_TAB_FIS][2] = VX2OUT;
10061  EV_TEMP[IJ+IEV_TAB_FIS][3] = VY2OUT;
10062  EV_TEMP[IJ+IEV_TAB_FIS][4] = VZ2OUT;
10063  //
10064  }
10065  IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_TEMP;
10066 
10067  }
10068 //
10069 // Fission fragment 2
10070  if( (ZF2<=0.0) || (AF2<=0.0) || (AF2<ZF2) ){
10071  std::cout << "F2 unphysical: "<<ZF<< " "<<AF<< " "<<EE<< " "<<ZF2<< " "<<AF2 << std::endl;
10072  }else{
10073 // fission and IMF emission are not allowed
10074  opt->optimfallowed = 0; // IMF is not allowed
10075  fiss->ifis = 0; // fission is not allowed
10076  gammaemission=1;
10077  G4int FF22=0, FIMF22=0;
10078  G4double ZIMFF2=0., AIMFF2=0.,TKEIMF2=0.,JPRFOUT=0.;
10079 //
10080  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);
10081 
10082  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
10083  EV_TEMP[IJ+IEV_TAB_FIS][0] = EV_TEMP2[IJ][0];
10084  EV_TEMP[IJ+IEV_TAB_FIS][1] = EV_TEMP2[IJ][1];
10085 // Lorentz kinematics
10086 // EV_TEMP(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
10087 // EV_TEMP(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
10088 // EV_TEMP(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
10089 // Lorentz transformation
10090  lorentz_boost(VX2_FISSION,VY2_FISSION,VZ2_FISSION,
10091  EV_TEMP2[IJ][2],EV_TEMP2[IJ][3],EV_TEMP2[IJ][4],
10092  &VXOUT,&VYOUT,&VZOUT);
10093  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
10094  VXOUT,VYOUT,VZOUT,
10095  &VX2OUT,&VY2OUT,&VZ2OUT);
10096  EV_TEMP[IJ+IEV_TAB_FIS][2] = VX2OUT;
10097  EV_TEMP[IJ+IEV_TAB_FIS][3] = VY2OUT;
10098  EV_TEMP[IJ+IEV_TAB_FIS][4] = VZ2OUT;
10099  //
10100  }
10101  IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_TEMP;
10102  }
10103 //
10104 // Lorentz kinematics
10105 // vx1_fission = vx1_fission + vx1_eva
10106 // vy1_fission = vy1_fission + vy1_eva
10107 // vz1_fission = vz1_fission + vz1_eva
10108 // vx2_fission = vx2_fission + vx2_eva
10109 // vy2_fission = vy2_fission + vy2_eva
10110 // vz2_fission = vz2_fission + vz2_eva
10111 // The v_eva_sc contribution is considered in the calling subroutine
10112 // Lorentz transformations
10113  lorentz_boost(vx1_eva,vy1_eva,vz1_eva,
10114  VX1_FISSION,VY1_FISSION,VZ1_FISSION,
10115  &VXOUT,&VYOUT,&VZOUT);
10116  VX1_FISSION = VXOUT;
10117  VY1_FISSION = VYOUT;
10118  VZ1_FISSION = VZOUT;
10119  lorentz_boost(vx2_eva,vy2_eva,vz2_eva,
10120  VX2_FISSION,VY2_FISSION,VZ2_FISSION,
10121  &VXOUT,&VYOUT,&VZOUT);
10122  VX2_FISSION = VXOUT;
10123  VY2_FISSION = VYOUT;
10124  VZ2_FISSION = VZOUT;
10125 //
10126  (*ZFP1) = idnint(ZFF1);
10127  (*AFP1) = idnint(AFF1);
10128  (*SFP1) = NbLam1;
10129  (*VX1_FISSION_par) = VX1_FISSION;
10130  (*VY1_FISSION_par) = VY1_FISSION;
10131  (*VZ1_FISSION_par) = VZ1_FISSION;
10132  (*VX_EVA_SC_par)=vx_eva_sc;
10133  (*VY_EVA_SC_par)=vy_eva_sc;
10134  (*VZ_EVA_SC_par)=vz_eva_sc;
10135  (*ZFP2) = idnint(ZFF2);
10136  (*AFP2) = idnint(AFF2);
10137  (*SFP2) = NbLam2;
10138  (*VX2_FISSION_par) = VX2_FISSION;
10139  (*VY2_FISSION_par) = VY2_FISSION;
10140  (*VZ2_FISSION_par) = VZ2_FISSION;
10141  (*IEV_TAB_FIS_par) = IEV_TAB_FIS;
10142  (*NbLam0_par) = NbLam1 + NbLam2;
10143  if(NbLam0>(NbLam1 + NbLam2))varntp->kfis = 25;
10144  return;
10145 }
10146 //*************************************************************************
10147 //
10148 void G4Abla::tke_bu(G4double Z,G4double A,G4double ZALL,G4double AAL,G4double *VX,G4double *VY,G4double *VZ){
10149 
10150  G4double V_over_V0,R0,RALL,RHAZ,R,TKE,Ekin,V,VPERP,ALPHA1;
10151 
10152  V_over_V0 = 6.0;
10153  R0 = 1.16;
10154 
10155  if(Z < 1.0){
10156  *VX = 0.0;
10157  *VY = 0.0;
10158  *VZ = 0.0;
10159  return;
10160  }
10161 
10162  RALL = R0 * std::pow(V_over_V0,1.0/3.0) * std::pow(AAL,1.0/3.0);
10163  RHAZ = G4double(haz(1));
10164  R = std::pow(RHAZ,1.0/3.0) * RALL;
10165  TKE = 1.44 * Z * ZALL * R*R * (1.0 - A/AAL)*(1.0 - A/AAL) / std::pow(RALL,3.0);
10166 
10167  Ekin = TKE * (AAL - A) / AAL;
10168 // print*,'!!!',IDNINT(AAl),IDNINT(A),IDNINT(ZALL),IDNINT(Z)
10169  V = std::sqrt(Ekin/A) * 1.3887;
10170  *VZ = (2.0 * G4double(haz(1)) - 1.0) * V;
10171  VPERP = std::sqrt(V*V - (*VZ)*(*VZ));
10172  ALPHA1 = G4double(haz(1)) * 2.0 * 3.142;
10173  *VX = VPERP * std::sin(ALPHA1);
10174  *VY = VPERP * std::cos(ALPHA1);
10175  return;
10176 }
10177 
10178 G4double G4Abla::haz(G4int k)
10179 {
10180  // const G4int pSize = 110;
10181  // static G4ThreadLocal G4double p[pSize];
10182  static G4ThreadLocal G4long ix = 0;
10183  static G4ThreadLocal G4double x = 0.0, y = 0.0;
10184  // k =< -1 on initialise
10185  // k = -1 c'est reproductible
10186  // k < -1 || k > -1 ce n'est pas reproductible
10187 /*
10188  // Zero is invalid random seed. Set proper value from our random seed collection:
10189  if(ix == 0) {
10190  // ix = hazard->ial;
10191  }
10192 */
10193  if (k <= -1) { //then
10194  if(k == -1) { //then
10195  ix = 0;
10196  }
10197  else {
10198  x = 0.0;
10199  y = secnds(G4int(x));
10200  ix = G4int(y * 100 + 43543000);
10201  if(mod(ix,2) == 0) {
10202  ix = ix + 1;
10203  }
10204  }}
10205 
10206  return G4AblaRandom::flat();
10207 }
10208 
10209 // Random generator according to the
10210 // powerfunction y = x**(lambda) in the range from xmin to xmax
10211 // xmin, xmax and y are integers.
10212 // lambda must be different from -1 !
10213 G4int G4Abla::IPOWERLIMHAZ(G4double lambda,G4int xmin,G4int xmax){
10214  G4double y,l_plus,rxmin,rxmax;
10215  l_plus = lambda + 1.;
10216  rxmin = G4double(xmin) - 0.5;
10217  rxmax = G4double(xmax) + 0.5;
10218 // y=(HAZ(k)*(rxmax**l_plus-rxmin**l_plus)+ rxmin**l_plus)**(1.E0/l_plus)
10219  y=std::pow(G4AblaRandom::flat()*(std::pow(rxmax,l_plus)-std::pow(rxmin,l_plus))+ std::pow(rxmin,l_plus),1.0/l_plus);
10220  return nint(y);
10221 }
10222 
10223 void G4Abla::AMOMENT(G4double AABRA,G4double APRF, G4int IMULTIFR,G4double *PX,G4double *PY,G4double *PZ){
10224 
10225  G4int ISIGOPT = 0;
10226  G4double GOLDHA_BU=0.,GOLDHA=0.;
10227  G4double PI = 3.141592653589793;
10228  //nu = 1.d0
10229 
10230  // G4double BETAP = sqrt(1.0 - 1.0/sqrt(1.0+EAP/931.494));
10231  // G4double GAMMAP = 1.0 / sqrt(1. - BETAP*BETAP);
10232  // G4double FACT_PROJ = (GAMMAP + 1.) / (BETAP * GAMMAP);
10233 
10234  // G4double R = 1.160 * pow(APRF,1.0/3.0);
10235 
10236  // G4double RNDT = double(haz(1));
10237  // G4double CTET = 2.0*RNDT-1.0;
10238  // G4double TETA = acos(CTET);
10239  // G4double RNDP = double(haz(1));
10240  // G4double PHI = RNDP*2.0*PI;
10241  // G4double STET = sqrt(1.0-CTET*CTET);
10242 // RX = R * STET * DCOS(PHI)
10243 // RY = R * STET * DSIN(PHI)
10244 // RZ = R * CTET
10245 
10246  // G4double RZ = 0.0;
10247  // G4double RY = R * sin(PHI);
10248  // G4double RX = R * cos(PHI);
10249 
10250 // In MeV/C
10251  G4double V0_over_VBU = 1.0 / 6.0;
10252  G4double SIGMA_0 = 118.50;
10253  G4double Efermi = 5.0 * SIGMA_0 * SIGMA_0 / (2.0 * 931.4940);
10254 
10255  if(IMULTIFR==1){
10256  if(ISIGOPT == 0){
10257 // "Fermi model" picture:
10258 // Influence of expansion:
10259  SIGMA_0 = SIGMA_0 * std::pow(V0_over_VBU,1.0/3.0);
10260 // To take into account the influence of thermal motion of nucleons (see W. Bauer,
10261 // PRC 51 (1995) 803)
10262 // Efermi = 5.D0 * SIGMA_0 * SIGMA_0 / (2.D0 * 931.49D0)
10263 
10264  GOLDHA_BU = SIGMA_0 * std::sqrt((APRF*(AABRA-APRF))/(AABRA-1.0));
10265  GOLDHA = GOLDHA_BU*std::sqrt(1.0 +
10266  5.0 * PI*PI / 12.0 * (T_freeze_out / Efermi)*(T_freeze_out / Efermi));
10267 // PRINT*,'AFTER BU fermi:',IDNINT(AABRA),IDNINT(APRF),GOLDHA,
10268 // & GOLDHA_BU
10269  }else{
10270 // Thermal equilibrium picture (<=> to Boltzmann distribution in momentum with sigma2=M*T)
10271 // The factor (AABRA-APRF)/AP comes from momentum conservation:
10272  GOLDHA_BU = std::sqrt(APRF * T_freeze_out * 931.494 *
10273  (AABRA - APRF) / AABRA);
10274  GOLDHA = GOLDHA_BU;
10275 // PRINT*,'AFTER BU therm:',IDNINT(AABRA),IDNINT(APRF),GOLDHA,
10276 // & GOLDHA_BU
10277  }
10278  }else{
10279  GOLDHA = SIGMA_0 * std::sqrt((APRF*(AABRA-APRF))/(AABRA-1.0));
10280  }
10281 
10282  G4int IS = 0;
10283  mom123:
10284  *PX = G4double(gausshaz(1,0.0,GOLDHA));
10285  IS = IS +1;
10286  if(IS>100){
10287  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING PX IN Rn07.FOR. A VALUE WILL BE FORCED." << std::endl;
10288  *PX = (AABRA-1.0)*931.4940;
10289  }
10290  if(std::abs(*PX)>= AABRA*931.494){
10291 // PRINT*,'VX > C',PX,IDNINT(APRF)
10292  goto mom123;
10293  }
10294  IS = 0;
10295  mom456:
10296  *PY = G4double(gausshaz(1,0.0,GOLDHA));
10297  IS = IS +1;
10298  if(IS>100){
10299  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING PY IN Rn07.FOR. A VALUE WILL BE FORCED." << std::endl;
10300  *PY = (AABRA-1.0)*931.4940;
10301  }
10302  if(std::abs(*PY)>= AABRA*931.494){
10303 // PRINT*,'VX > C',PX,IDNINT(APRF)
10304  goto mom456;
10305  }
10306  IS = 0;
10307  mom789:
10308  *PZ = G4double(gausshaz(1,0.0,GOLDHA));
10309  IS = IS +1;
10310  if(IS>100){
10311  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING PZ IN Rn07.FOR. A VALUE WILL BE FORCED." << std::endl;
10312  *PZ = (AABRA-1.0)*931.4940;
10313  }
10314  if(std::abs(*PZ)>= AABRA*931.494){
10315 // PRINT*,'VX > C',PX,IDNINT(APRF)
10316  goto mom789;
10317  }
10318  return;
10319 }
10320 
10321 G4double G4Abla::gausshaz(G4int k, G4double xmoy, G4double sig)
10322 {
10323  // Gaussian random numbers:
10324 
10325  // 1005 C*** TIRAGE ALEATOIRE DANS UNE GAUSSIENNE DE LARGEUR SIG ET MOYENNE XMOY
10326  static G4ThreadLocal G4int iset = 0;
10327  static G4ThreadLocal G4double v1,v2,r,fac,gset,fgausshaz;
10328 
10329  if(iset == 0) { //then
10330  do {
10331  v1 = 2.0*haz(k) - 1.0;
10332  v2 = 2.0*haz(k) - 1.0;
10333  r = std::pow(v1,2) + std::pow(v2,2);
10334  } while(r >= 1);
10335 
10336  fac = std::sqrt(-2.*std::log(r)/r);
10337  gset = v1*fac;
10338  fgausshaz = v2*fac*sig+xmoy;
10339  iset = 1;
10340  }
10341  else {
10342  fgausshaz=gset*sig+xmoy;
10343  iset=0;
10344  }
10345  return fgausshaz;
10346 }