Geant4  v4-10.4-release
 모두 클래스 네임스페이스들 파일들 함수 변수 타입정의 열거형 타입 열거형 멤버 Friends 매크로 그룹들 페이지들
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 
44 #ifdef ABLAXX_IN_GEANT4_MODE
45 G4Abla::G4Abla(G4Volant *aVolant, G4VarNtp *aVarntp)
46 #else
47 G4Abla::G4Abla(G4INCL::Config *config, G4Volant *aVolant, G4VarNtp *aVarntp)
48 #endif
49 {
50 #ifndef ABLAXX_IN_GEANT4_MODE
51  theConfig = config;
52 #endif
53  verboseLevel = 0;
54  ilast = 0;
55  volant = aVolant; // ABLA internal particle data
56  volant->iv = 0;
57  varntp = aVarntp; // Output data structure
58  varntp->ntrack = 0;
59 
60  verboseLevel = 0;
61  gammaemission= 0;// 0 presaddle, 1 postsaddle
62  T_freeze_out = 0.;
63 
64  pace = new G4Pace();
65  ald = new G4Ald();
66  eenuc = new G4Eenuc();
67  ec2sub = new G4Ec2sub();
68  ecld = new G4Ecld();
69  masses = new G4Mexp();
70  fb = new G4Fb();
71  fiss = new G4Fiss();
72  opt = new G4Opt();
73 }
74 
76 {
77  verboseLevel = level;
78 }
79 
81 {
82  delete pace;
83  delete ald;
84  delete eenuc;
85  delete ec2sub;
86  delete ecld;
87  delete masses;
88  delete fb;
89  delete fiss;
90  delete opt;
91 }
92 
93 // Main interface to the evaporation
94 
95 void G4Abla::DeexcitationAblaxx(G4int nucleusA, G4int nucleusZ, G4double excitationEnergy, G4double angularMomentum, G4double momX, G4double momY, G4double momZ, G4int eventnumber)
96 {
97 
98  const G4double amu = 931.4940; // MeV/C^2
99  const G4double C = 29.9792458; // cm/ns
100 
101  SetParametersG4(nucleusZ, nucleusA);
102 
103  mult10:
104  G4int IS = 0;
105 
106  G4double aff = 0.0;
107  G4double zff = 0.0;
108  G4int ZFP1 = 0, AFP1 = 0, AFPIMF = 0, ZFPIMF = 0, ZFP2 = 0, AFP2 = 0;
109  G4double vx_eva = 0.0, vy_eva = 0.0, vz_eva = 0.0;
110  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;
111  G4double zf = 0.0, af = 0.0, mtota = 0.0, tkeimf = 0.0, jprf0=0.;
112  G4int ff = 0,afpnew=0,zfpnew=0,aprfp=0,zprfp=0,IOUNSTABLE=0,ILOOP=0,IEV_TAB=0,IEV_TAB_TEMP=0;
113  G4int fimf = 0,INMIN=0,INMAX=0;
114  G4int ftype=0;//,ftype1=0;
115  G4int inum = eventnumber;
116  G4int inttype = 0;
117  opt->optimfallowed=1;
118  if(fiss->zt>56){
119  fiss->ifis = 1;
120  }else {
121  fiss->ifis = 0;
122  }
123 
124  G4double aprf = (G4double) nucleusA;
125  G4double zprf = (G4double) nucleusZ;
126  G4double ee = excitationEnergy;
127  G4double jprf = angularMomentum; // actually root-mean-squared
128 
129  G4double pxrem = momX;
130  G4double pyrem = momY;
131  G4double pzrem = momZ;
132  G4double zimf,aimf;
133 
134  volant->clear(); // Clean up an initialize ABLA output.
135  varntp->clear(); // Clean up an initialize ABLA output.
136  varntp->ntrack = 0;
137  varntp->kfis = 0;
138  volant->iv = 0;
139  gammaemission=0;
140  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.;
141 
142  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.;
143 
144  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.;
145 
146  G4int ABU_DIFF,ZBU_DIFF,NBU_DIFF;
147  G4int INEWLOOP = 0, ILOOPBU=0;
148 
149  G4double BU_TAB_TEMP[200][5], BU_TAB_TEMP1[200][5];
150  G4double EV_TAB_TEMP[200][5],EV_TEMP[200][5];
151  G4int IMEM_BU[201], IMEM=0;
152 
153  for(G4int j=0;j<3;j++){
154  V_CM[j]=0.;
155  VFP1_CM[j]=0.;
156  VFP2_CM[j]=0.;
157  VIMF_CM[j]=0.;
158  }
159 
160  for(G4int I1=0;I1<200;I1++){
161  for(G4int I2 = 0;I2<11;I2++)
162  BU_TAB[I1][I2] = 0.0;
163  for(G4int I2 = 0;I2<5;I2++){
164  BU_TAB_TEMP[I1][I2] = 0.0;
165  BU_TAB_TEMP1[I1][I2] = 0.0;
166  EV_TAB_TEMP[I1][I2] = 0.0;
167  EV_TAB[I1][I2] = 0.0;
168  EV_TAB_SSC[I1][I2] = 0.0;
169  EV_TEMP[I1][I2] = 0.0;
170  }
171  }
172 
173  G4int idebug = 0;
174  if(idebug == 1) {
175  zprf = 81.;
176  aprf = 201.;
177 // ee = 86.5877686;
178  ee = 100.0;
179  jprf = 10.;
180  zf = 0.;
181  af = 0.;
182  mtota = 0.;
183  ff = 1;
184  inttype = 0;
185  //inum = 2;
186  }
187 //
188  G4double AAINCL = aprf;
189  G4double ZAINCL = zprf;
190  EINCL = ee;
191 //
192 // Velocity after the first stage of reaction (INCL)
193 // For coupling with INCL, comment the lines below, and use output
194 // of INCL as pxincl, pyincl,pzincl
195 //
196  G4double pincl = std::sqrt(pxrem*pxrem + pyrem*pyrem + pzrem*pzrem);
197 // PPRFP is in MeV/c
198  G4double ETOT_incl = std::sqrt(pincl*pincl + (AAINCL * amu)*(AAINCL * amu));
199  G4double VX_incl = C * pxrem / ETOT_incl;
200  G4double VY_incl = C * pyrem / ETOT_incl;
201  G4double VZ_incl = C * pzrem / ETOT_incl;
202 
203 // Multiplicity in the break-up event
204  G4int IMULTBU = 0;
205  G4int IMULTIFR = 0;
206  G4int I_Breakup=0;
207  IEV_TAB = 0;
208 /*
209 C Set maximum temperature for sequential decay (evaporation)
210 C Remove additional energy by simultaneous break up
211 C (vaporisation or multi-fragmentation)
212 
213 C Idea: If the temperature of the projectile spectator exceeds
214 c the limiting temperature T_freeze_out, the additional
215 C energy which is present in the spectator is used for
216 C a stage of simultaneous break up. It is either the
217 C simultaneous emission of a gaseous phase or the simultaneous
218 C emission of several intermediate-mass fragments. Only one
219 C piece of the projectile spectator (assumed to be the largest
220 C one) is kept track.
221 
222 C MVR, KHS, October 2001
223 C KHS, AK 2007 - Masses from the power low; slope parameter dependent on
224 C energy per nucleon; symmtery-energy coeff. dependent on
225 C energy per nucleon.
226 
227 c Clear BU_TAB (array of multifragmentation products)
228 */
229  if(T_freeze_out_in >= 0.0){
231  }else{
232  T_freeze_out = max(9.33*std::exp(-0.00282*AAINCL),5.5);
233 // ! See: J. Natowitz et al, PRC65 (2002) 034618
234 // T_freeze_out=DMAX1(9.0D0*DEXP(-0.001D0*AAABRA),
235 // & 5.5D0)
236  }
237 
238  a_tilda = ald->av*aprf + ald->as*std::pow(aprf,2.0/3.0) + ald->ak*std::pow(aprf,1.0/3.0);
239 
240  T_init = std::sqrt(EINCL/a_tilda);
241 
242  T_diff = T_init - T_freeze_out;
243 
244  if(T_diff>0.1 && zprf>2.){
245  // T_Diff is set to be larger than 0.1 MeV in order to avoid strange cases for which
246  // T_Diff is of the order of 1.e-3 and less.
247  varntp->kfis = 10;
248 
249  for(G4int i=0;i<5;i++){
250  EE_diff = EINCL - a_tilda * T_freeze_out*T_freeze_out;
251 // Energy removed 10*5/T_init per nucleon removed in simultaneous breakup
252 // adjusted to frag. xsections 238U (1AGeV) + Pb data, KHS Dec. 2005
253 // This should maybe be re-checked, in a meanwhile several things in break-up description
254 // have changed (AK).
255 
256  A_diff = dint(EE_diff / (8.0 * 5.0 / T_freeze_out));
257 
258  if(A_diff>AAINCL) A_diff = AAINCL;
259 
260  A_FINAL = AAINCL - A_diff;
261 
262  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);
263  E_FINAL = a_tilda * T_freeze_out*T_freeze_out;
264 
265  if(A_FINAL<4.0){ // To avoid numerical problems
266  EE_diff = EINCL - E_FINAL;
267  A_FINAL = 1.0;
268  Z_FINAL = 1.0;
269  E_FINAL = 0.0;
270  goto mul4325;
271  }
272  }
273  mul4325:
274 // The idea is similar to Z determination of multifragment - Z of "heavy" partner is not
275 // fixed by the A/Z of the prefragment, but randomly picked from Gaussian
276  // Z_FINAL_MEAN = dint(zprf * A_FINAL / (aprf));
277 
278  Z_FINAL = dint(zprf * A_FINAL / (aprf));
279 
280  if(E_FINAL<0.0) E_FINAL = 0.0;
281 
282  aprf = A_FINAL;
283  zprf = Z_FINAL;
284  ee = E_FINAL;
285 
286  A_diff = AAINCL - aprf;
287 
288 // Creation of multifragmentation products by breakup
289  if(A_diff<=1.0){
290  aprf = AAINCL;
291  zprf = ZAINCL;
292  ee = EINCL;
293  IMULTIFR = 0;
294  goto mult7777;
295  }else if(A_diff>1.0){
296 
297  A_ACC = 0.0;
298 // Energy-dependence of the slope parameter, acc. to A. Botvina, fits also to exp. data (see
299 // e.g. Sfienti et al, NPA 2007)
300  ASLOPE1 = -2.400; // e*/a=7 -2.4
301  ASLOPE2 = -1.200; // e*/a=3 -1.2
302 
303  a_tilda = ald->av*AAINCL + ald->as*std::pow(AAINCL,2.0/3.0) + ald->ak*std::pow(AAINCL,1.0/3.0);
304 
305  E_FINAL = a_tilda * T_freeze_out*T_freeze_out;
306 
307  ABU_SLOPE = (ASLOPE1-ASLOPE2)/4.0*(E_FINAL/AAINCL)+
308  ASLOPE1-(ASLOPE1-ASLOPE2)*7.0/4.0;
309 
310 // Botvina et al, PRC 74 (2006) 044609, fig. 5 for B0=18 MeV
311 // ABU_SLOPE = 5.57489D0-2.08149D0*(E_FINAL/AAABRA)+
312 // & 0.3552D0*(E_FINAL/AAABRA)**2-0.024927D0*(E_FINAL/AAABRA)**3+
313 // & 7.268D-4*(E_FINAL/AAABRA)**4
314 // They fit with A**(-tau) and here is done A**(tau)
315 // ABU_SLOPE = ABU_SLOPE*(-1.D0)
316 
317 // ABU_SLOPE = -2.60D0
318 // print*,ABU_SLOPE,(E_FINAL/AAABRA)
319 
320  if(ABU_SLOPE > -1.01) ABU_SLOPE = -1.01;
321 
322  I_Breakup = 0;
323  Z_Breakup_sum = Z_FINAL;
324  ABU_SUM = 0.0;
325  ZBU_SUM = 0.0;
326 
327  for(G4int i=0;i<100;i++){
328  IS = 0;
329  mult4326:
330  A_Breakup = dint(double(IPOWERLIMHAZ(ABU_SLOPE,1,idnint(A_diff))));
331  // Power law with exponent ABU_SLOPE
332  IS = IS +1;
333  if(IS>100){
334  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;
335  goto mult10;
336  }
337 
338  if(A_Breakup>AAINCL) goto mult4326;
339 
340  if(A_Breakup<=0.0){
341  std::cout << "A_BREAKUP <= 0 " << std::endl;
342  goto mult10;
343  }
344 
345  A_ACC = A_ACC + A_Breakup;
346 
347  if(A_ACC<=A_diff){
348 
349  Z_Breakup_Mean = dint(A_Breakup * ZAINCL / AAINCL);
350 
351  Z_Breakup_sum = Z_Breakup_sum + Z_Breakup_Mean;
352 //
353 // See G.A. Souliotis et al, PRC 75 (2007) 011601R (Fig. 2)
354  G_SYMM = 34.2281 - 5.14037 * E_FINAL/AAINCL;
355  if(E_FINAL/AAINCL < 2.0) G_SYMM = 25.0;
356  if(E_FINAL/AAINCL > 4.0) G_SYMM = 15.0;
357 
358 // G_SYMM = 23.6;
359 
360  G_SYMM = 25.0; //25
361  CZ = 2.0 * G_SYMM * 4.0 / A_Breakup;
362  // 2*CZ=d^2(Esym)/dZ^2, Esym=Gamma*(A-2Z)**2/A
363  // gamma = 23.6D0 is the symmetry-energy coefficient
364  G4int IIS = 0;
365  Sigma_Z = std::sqrt(T_freeze_out/CZ);
366 
367  IS = 0;
368  mult4333:
369  Z_Breakup = dint( G4double(gausshaz(1,Z_Breakup_Mean,Sigma_Z)));
370  IS = IS +1;
371 //
372  if(IS>100){
373  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;
374  goto mult10;
375  }
376 
377  if(Z_Breakup<0.0 ) goto mult4333;
378  if((A_Breakup-Z_Breakup)<0.0) goto mult4333;
379  if((A_Breakup-Z_Breakup)==0.0 && Z_Breakup!=1.0) goto mult4333;
380 
381  if(Z_Breakup>=ZAINCL){
382  IIS = IIS + 1;
383  if(IIS > 10){
384  std::cout << "Z_BREAKUP RESAMPLED MORE THAN 10 TIMES; EVENT WILL BE RESAMPLED AGAIN " << std::endl;
385  goto mult10;
386  }
387  goto mult4333;
388  }
389 
390 // *** Find the limits that fragment is bound :
391  isostab_lim(idnint(Z_Breakup),&INMIN,&INMAX);
392 // INMIN = MAX(1,INMIN-2)
393  if(Z_Breakup > 2.0){
394  if(idnint(A_Breakup-Z_Breakup)<INMIN || idnint(A_Breakup-Z_Breakup)>(INMAX+5)){
395 // PRINT*,'N_Breakup >< NMAX',
396 // & IDNINT(Z_Breakup),IDNINT(A_Breakup-Z_Breakup),INMIN,INMAX
397  goto mult4343;
398  }
399  }
400 
401  mult4343:
402 
403 // We consider all products, also nucleons created in the break-up
404 // I_Breakup = I_Breakup + 1;// moved below
405 
406  N_Breakup = A_Breakup - Z_Breakup;
407  BU_TAB[I_Breakup][0] = dint(Z_Breakup); // Mass of break-up product
408  BU_TAB[I_Breakup][1] = dint(A_Breakup); // Z of break-up product
409  ABU_SUM = ABU_SUM + BU_TAB[i][1];
410  ZBU_SUM = ZBU_SUM + BU_TAB[i][0];
411 //
412 // Break-up products are given zero angular momentum (simplification)
413  BU_TAB[I_Breakup][3] = 0.0;
414  I_Breakup = I_Breakup + 1;
415  IMULTBU = IMULTBU + 1;
416  }else{
417 // There are A_DIFF - A_ACC nucleons lost by breakup, but they do not end up in multifragmentation products.
418 // This is a deficiency of the Monte-Carlo method applied above to determine the sizes of the fragments
419 // according to the power law.
420 // print*,'Deficiency',IDNINT(A_DIFF-A_ACC)
421 
422  goto mult4327;
423  }// if(A_ACC<=A_diff)
424  }//for
425  //mult4327:
426  //IMULTIFR = 1;
427  } // if(A_diff>1.0)
428  mult4327:
429  IMULTIFR = 1;
430 
431 // "Missing" A and Z picked from the power law:
432  ABU_DIFF = idnint(ABU_SUM+aprf-AAINCL);
433  ZBU_DIFF = idnint(ZBU_SUM+zprf-ZAINCL);
434  NBU_DIFF = idnint((ABU_SUM-ZBU_SUM)+(aprf-zprf)-(AAINCL-ZAINCL));
435 //
436  if(IMULTBU > 200)
437  std::cout << "WARNING - MORE THAN 200 BU " << IMULTBU << std::endl;
438 
439  if(IMULTBU < 1)
440  std::cout << "WARNING - LESS THAN 1 BU " << IMULTBU << std::endl;
441  //,AABRA,ZABRA,IDNINT(APRF),IDNINT(ZPRF),ABU_DIFF,ZBU_DIFF
442 
443  G4int IPROBA = 0;
444  for(G4int i=0;i<IMULTBU;i++)
445  IMEM_BU[i] = 0;
446 
447  while(NBU_DIFF!=0 && ZBU_DIFF!=0){
448 // (APRF,ZPRF) is also inlcuded in this game, as from time to time the program
449 // is entering into endless loop, as it can not find proper nucleus for adapting A and Z.
450  IS = 0;
451  mult5555:
452  G4double RHAZ = G4AblaRandom::flat()*double(IMULTBU);
453  IPROBA = IPROBA + 1;
454  IS = IS + 1;
455  if(IS>100){
456  std::cout << "WARNING: HAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING N_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED." << std::endl;
457  goto mult10;
458  }
459  G4int IEL = G4int(RHAZ);
460  if(IMEM_BU[IEL]==1) goto mult5555;
461  if(IEL>200)std::cout << "5555:" << IEL << RHAZ << IMULTBU << std::endl;
462  if(IEL<0)std::cout << "5555:"<< IEL << RHAZ << IMULTBU << std::endl;
463  if(IEL<=IMULTBU){
464  N_Breakup = dint(BU_TAB[IEL][1]-BU_TAB[IEL][0] - DSIGN(1.0,double(NBU_DIFF)));
465  }else if(IEL>IMULTBU){
466  N_Breakup = dint(aprf - zprf - DSIGN(1.0,double(NBU_DIFF)));
467  }
468  if(N_Breakup<0.0){
469  IMEM_BU[IEL] = 1;
470  goto mult5555;
471  }
472  if(IEL<=IMULTBU){
473  ZTEMP = dint(BU_TAB[IEL][0] - DSIGN(1.0,double(ZBU_DIFF)));
474  }else if(IEL>IMULTBU){
475  ZTEMP = dint(zprf - DSIGN(1.0,double(ZBU_DIFF)));
476  }
477  if(ZTEMP<0.0){
478  IMEM_BU[IEL] = 1;
479  goto mult5555;
480  }
481  if(ZTEMP<1.0 && N_Breakup<1.0){
482  IMEM_BU[IEL] = 1;
483  goto mult5555;
484  }
485 // Nuclei with A=Z and Z>1 are allowed in this stage, as otherwise,
486 // for more central collisions there is not enough mass which can be
487 // shufeled in order to conserve A and Z. These are mostly nuclei with
488 // Z=2 and in less extent 3, 4 or 5.
489 // IF(ZTEMP.GT.1.D0 .AND. N_Breakup.EQ.0.D0) THEN
490 // GOTO 5555
491 // ENDIF
492  if(IEL<=IMULTBU){
493  BU_TAB[IEL][0] = dint(ZTEMP);
494  BU_TAB[IEL][1] = dint(ZTEMP + N_Breakup);
495  }else if(IEL>IMULTBU){
496  zprf = dint(ZTEMP);
497  aprf = dint(ZTEMP + N_Breakup);
498  }
499  NBU_DIFF = NBU_DIFF - ISIGN(1,NBU_DIFF);
500  ZBU_DIFF = ZBU_DIFF - ISIGN(1,ZBU_DIFF);
501  }// while
502 
503  IPROBA = 0;
504  for(G4int i=0;i<IMULTBU;i++)
505  IMEM_BU[i] = 0;
506 
507  if(NBU_DIFF != 0 && ZBU_DIFF == 0){
508  while(NBU_DIFF > 0 || NBU_DIFF < 0){
509  IS = 0;
510  mult5556:
511  G4double RHAZ = G4AblaRandom::flat()*double(IMULTBU);
512  IS = IS + 1;
513  if(IS>100){
514  std::cout << "WARNING: HAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING N_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED." << std::endl;
515  goto mult10;
516  }
517  G4int IEL = G4int(RHAZ);
518  if(IMEM_BU[IEL]==1) goto mult5556;
519 // IPROBA = IPROBA + 1;
520  if(IPROBA>IMULTBU+1 && NBU_DIFF>0){
521  std::cout << "###',IPROBA,IMULTBU,NBU_DIFF,ZBU_DIFF,T_freeze_out" << std::endl;
522  IPROBA = IPROBA + 1;
523  if(IEL<=IMULTBU){
524  BU_TAB[IEL][1] = dint(BU_TAB[IEL][1]- G4double(NBU_DIFF));
525  }else{ if(IEL>IMULTBU)
526  aprf = dint(aprf - G4double(NBU_DIFF));
527  }
528  goto mult5432;
529  }
530  if(IEL>200)std::cout << "5556:" << IEL << RHAZ << IMULTBU << std::endl;
531  if(IEL<0)std::cout << "5556:"<< IEL << RHAZ << IMULTBU << std::endl;
532  if(IEL<=IMULTBU){
533  N_Breakup = dint(BU_TAB[IEL][1]-BU_TAB[IEL][0] - DSIGN(1.0, G4double(NBU_DIFF)));
534  }else if(IEL>IMULTBU){
535  N_Breakup = dint(aprf - zprf - DSIGN(1.0, G4double(NBU_DIFF)));
536  }
537  if(N_Breakup<0.0){
538  IMEM_BU[IEL] = 1;
539  goto mult5556;
540  }
541  if(IEL<=IMULTBU){
542  ATEMP = dint(BU_TAB[IEL][0] + N_Breakup);
543  }else if(IEL>IMULTBU){
544  ATEMP = dint(zprf + N_Breakup);
545  }
546  if((ATEMP - N_Breakup)<1.0 && N_Breakup<1.0){
547  IMEM_BU[IEL] = 1;
548  goto mult5556;
549  }
550 // IF((ATEMP - N_Breakup).GT.1.D0 .AND.
551 // & N_Breakup.EQ.0.D0) THEN
552 // IMEM_BU(IEL) = 1
553 // GOTO 5556
554 // ENDIF
555  if(IEL<=IMULTBU)
556  BU_TAB[IEL][1] = dint(BU_TAB[IEL][0] + N_Breakup);
557  else if(IEL>IMULTBU)
558  aprf = dint(zprf + N_Breakup);
559 //
560  NBU_DIFF = NBU_DIFF - ISIGN(1,NBU_DIFF);
561  }//while(NBU_DIFF > 0 || NBU_DIFF < 0)
562 
563  IPROBA = 0;
564  for(G4int i=0;i<IMULTBU;i++)
565  IMEM_BU[i] = 0;
566 
567  }else{// if(NBU_DIFF != 0 && ZBU_DIFF == 0)
568  if(ZBU_DIFF != 0 && NBU_DIFF == 0){
569  while(ZBU_DIFF > 0 || ZBU_DIFF < 0){
570  IS = 0;
571  mult5557:
572  G4double RHAZ = G4AblaRandom::flat()* G4double(IMULTBU);
573  IS = IS + 1;
574  if(IS>100){
575  std::cout << "WARNING: HAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING N_BREAKUP IN Rn07.FOR. NEW EVENT WILL BE DICED." << std::endl;
576  goto mult10;
577  }
578  G4int IEL = G4int(RHAZ);
579  if(IMEM_BU[IEL]==1) goto mult5557;
580  //IPROBA = IPROBA + 1;
581  if(IPROBA>IMULTBU+1 && ZBU_DIFF>0){
582  std::cout << "###',IPROBA,IMULTBU,NBU_DIFF,ZBU_DIFF,T_freeze_out" << std::endl;
583  IPROBA = IPROBA + 1;
584  if(IEL<=IMULTBU){
585  N_Breakup = dint(BU_TAB[IEL][1]-BU_TAB[IEL][0]);
586  BU_TAB[IEL][0] = dint(BU_TAB[IEL][0] - G4double(ZBU_DIFF));
587  BU_TAB[IEL][1] = dint(BU_TAB[IEL][0] + N_Breakup);
588  }else{
589  if(IEL>IMULTBU){
590  N_Breakup = aprf - zprf;
591  zprf = dint(zprf - G4double(ZBU_DIFF));
592  aprf = dint(zprf + N_Breakup);
593  }
594  }
595  goto mult5432;
596  }
597  if(IEL>200)std::cout << "5557:" << IEL << RHAZ << IMULTBU << std::endl;
598  if(IEL<0)std::cout << "5557:"<< IEL << RHAZ << IMULTBU << std::endl;
599  if(IEL<=IMULTBU){
600  N_Breakup = dint(BU_TAB[IEL][1]-BU_TAB[IEL][0]);
601  ZTEMP = dint(BU_TAB[IEL][0] - DSIGN(1.0, G4double(ZBU_DIFF)));
602  }else if(IEL>IMULTBU){
603  N_Breakup = dint(aprf - zprf);
604  ZTEMP = dint(zprf - DSIGN(1.0, G4double(ZBU_DIFF)));
605  }
606  ATEMP = dint(ZTEMP + N_Breakup);
607  if(ZTEMP<0.0){
608  IMEM_BU[IEL] = 1;
609  goto mult5557;
610  }
611  if((ATEMP-ZTEMP)<0.0){
612  IMEM_BU[IEL] = 1;
613  goto mult5557;
614  }
615  if((ATEMP-ZTEMP)<1.0 && ZTEMP<1.0){
616  IMEM_BU[IEL] = 1;
617  goto mult5557;
618  }
619  if(IEL<=IMULTBU){
620  BU_TAB[IEL][0] = dint(ZTEMP);
621  BU_TAB[IEL][1] = dint(ZTEMP + N_Breakup);
622  }else{
623  if(IEL>IMULTBU){
624  zprf = dint(ZTEMP);
625  aprf = dint(ZTEMP + N_Breakup);
626  }
627  }
628  ZBU_DIFF = ZBU_DIFF - ISIGN(1,ZBU_DIFF);
629  }//while
630  }//if(ZBU_DIFF != 0 && NBU_DIFF == 0)
631  }// if(NBU_DIFF != 0 && ZBU_DIFF == 0)
632 
633  mult5432:
634 // Looking for the heaviest fragment among all multifragmentation events, and
635 // "giving" excitation energy to fragments
636  ZMEM = 0.0;
637 
638  for(G4int i =0;i<IMULTBU;i++){
639 //For particles with Z>2 we calculate excitation energy from freeze-out temperature.
640 // For particels with Z<3 we assume that they form a gas, and that temperature results
641 // in kinetic energy (which is sampled from Maxwell distribution with T=Tfreeze-out)
642 // and not excitation energy.
643  if(BU_TAB[i][0]>2.0){
644  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);
645  BU_TAB[i][2] = a_tilda_BU * T_freeze_out*T_freeze_out; // E* of break-up product
646  }else{
647  BU_TAB[i][2] = 0.0;
648  }
649 //
650  if(BU_TAB[i][0] > ZMEM){
651  IMEM = i;
652  ZMEM = BU_TAB[i][0];
653  AMEM = BU_TAB[i][1];
654  EMEM = BU_TAB[i][2];
655  JMEM = BU_TAB[i][3];
656  }
657  }//for IMULTBU
658 
659  if(zprf < ZMEM){
660  BU_TAB[IMEM][0] = zprf;
661  BU_TAB[IMEM][1] = aprf;
662  BU_TAB[IMEM][2] = ee;
663  BU_TAB[IMEM][3] = jprf;
664  zprf = ZMEM;
665  aprf = AMEM;
666  aprfp = idnint(aprf);
667  zprfp = idnint(zprf);
668  ee = EMEM;
669  jprf = JMEM;
670  }
671 
672 // Just for checking:
673  ABU_SUM = aprf;
674  ZBU_SUM = zprf;
675  for( G4int i = 0;i<IMULTBU;i++){
676  ABU_SUM = ABU_SUM + BU_TAB[i][1];
677  ZBU_SUM = ZBU_SUM + BU_TAB[i][0];
678  }
679  ABU_DIFF = idnint(ABU_SUM-AAINCL);
680  ZBU_DIFF = idnint(ZBU_SUM-ZAINCL);
681 //
682  if(ABU_DIFF!=0 || ZBU_DIFF!=0)
683  std::cout << "Problem of mass in BU " << ABU_DIFF << " " << ZBU_DIFF << std::endl;
684  PX_BU_SUM = 0.0;
685  PY_BU_SUM = 0.0;
686  PZ_BU_SUM = 0.0;
687 // Momenta of break-up products are calculated. They are all given in the rest frame
688 // of the primary prefragment (i.e. after incl):
689 // Goldhaber model ****************************************
690 // "Heavy" residue
691  AMOMENT(AAINCL,aprf,1,&PXPRFP,&PYPRFP,&PZPRFP);
692  PPRFP = std::sqrt(PXPRFP*PXPRFP + PYPRFP*PYPRFP + PZPRFP*PZPRFP);
693 // ********************************************************
694 // PPRFP is in MeV/c
695  ETOT_PRF = std::sqrt(PPRFP*PPRFP + (aprf * amu)*(aprf * amu));
696  VX_PREF = C * PXPRFP / ETOT_PRF;
697  VY_PREF = C * PYPRFP / ETOT_PRF;
698  VZ_PREF = C * PZPRFP / ETOT_PRF;
699 
700 // Contribution from Coulomb repulsion ********************
701  tke_bu(zprf,aprf,ZAINCL,AAINCL,&VX1_BU,&VY1_BU,&VZ1_BU);
702 
703 // Lorentz kinematics
704 // VX_PREF = VX_PREF + VX1_BU
705 // VY_PREF = VY_PREF + VY1_BU
706 // VZ_PREF = VZ_PREF + VZ1_BU
707 // Lorentz transformation
708  lorentz_boost(VX1_BU,VY1_BU,VZ1_BU,
709  VX_PREF,VY_PREF,VZ_PREF,
710  &VXOUT,&VYOUT,&VZOUT);
711 
712  VX_PREF = VXOUT;
713  VY_PREF = VYOUT;
714  VZ_PREF = VZOUT;
715 
716 // Total momentum: Goldhaber + Coulomb
717  VBU2 = VX_PREF*VX_PREF + VY_PREF*VY_PREF + VZ_PREF*VZ_PREF;
718  GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
719  ETOT_PRF = aprf * amu / GAMMA_REL;
720  PXPRFP = ETOT_PRF * VX_PREF / C;
721  PYPRFP = ETOT_PRF * VY_PREF / C;
722  PZPRFP = ETOT_PRF * VZ_PREF / C;
723 
724 // ********************************************************
725 // Momentum: Total width of abrasion and breakup assumed to be given
726 // by Fermi momenta of nucleons
727 // *****************************************
728 
729  PX_BU_SUM = PXPRFP;
730  PY_BU_SUM = PYPRFP;
731  PZ_BU_SUM = PZPRFP;
732 
733  Eexc_BU_SUM = ee;
734  Bvalue_BU = eflmac(idnint(aprf),idnint(zprf),1,0);
735 
736  for(I_Breakup=0;I_Breakup<IMULTBU;I_Breakup++){
737 // For bu products:
738  Bvalue_BU = Bvalue_BU + eflmac(idnint(BU_TAB[I_Breakup][1]), idnint(BU_TAB[I_Breakup][0]),1,0);
739  Eexc_BU_SUM = Eexc_BU_SUM + BU_TAB[I_Breakup][2];
740 
741  AMOMENT(AAINCL,BU_TAB[I_Breakup][1],1,&PX_BU,&PY_BU,&PZ_BU);
742  P_BU = std::sqrt(PX_BU*PX_BU + PY_BU*PY_BU + PZ_BU*PZ_BU);
743 // *******************************************************
744 // PPRFP is in MeV/c
745  ETOT_BU = std::sqrt(P_BU*P_BU + (BU_TAB[I_Breakup][1]*amu)*(BU_TAB[I_Breakup][1]*amu));
746  BU_TAB[I_Breakup][4] = C * PX_BU / ETOT_BU; // Velocity in x
747  BU_TAB[I_Breakup][5] = C * PY_BU / ETOT_BU; // Velocity in y
748  BU_TAB[I_Breakup][6] = C * PZ_BU / ETOT_BU; // Velocity in z
749 // Contribution from Coulomb repulsion:
750  tke_bu(BU_TAB[I_Breakup][0],BU_TAB[I_Breakup][1],ZAINCL,AAINCL,&VX2_BU,&VY2_BU,&VZ2_BU);
751 // Lorentz kinematics
752 // BU_TAB(I_Breakup,5) = BU_TAB(I_Breakup,5) + VX2_BU ! velocity change by Coulomb repulsion
753 // BU_TAB(I_Breakup,6) = BU_TAB(I_Breakup,6) + VY2_BU
754 // BU_TAB(I_Breakup,7) = BU_TAB(I_Breakup,7) + VZ2_BU
755 // Lorentz transformation
756  lorentz_boost(VX2_BU,VY2_BU,VZ2_BU,
757  BU_TAB[I_Breakup][4],BU_TAB[I_Breakup][5],BU_TAB[I_Breakup][6],
758  &VXOUT,&VYOUT,&VZOUT);
759 
760  BU_TAB[I_Breakup][4] = VXOUT;
761  BU_TAB[I_Breakup][5] = VYOUT;
762  BU_TAB[I_Breakup][6] = VZOUT;
763 
764 // Total momentum: Goldhaber + Coulomb
765  VBU2 = BU_TAB[I_Breakup][4]*BU_TAB[I_Breakup][4] +
766  BU_TAB[I_Breakup][5]*BU_TAB[I_Breakup][5] +
767  BU_TAB[I_Breakup][6]*BU_TAB[I_Breakup][6];
768  GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
769  ETOT_BU = BU_TAB[I_Breakup][1]*amu/GAMMA_REL;
770  PX_BU = ETOT_BU * BU_TAB[I_Breakup][4] / C;
771  PY_BU = ETOT_BU * BU_TAB[I_Breakup][5] / C;
772  PZ_BU = ETOT_BU * BU_TAB[I_Breakup][6] / C;
773 
774  PX_BU_SUM = PX_BU_SUM + PX_BU;
775  PY_BU_SUM = PY_BU_SUM + PY_BU;
776  PZ_BU_SUM = PZ_BU_SUM + PZ_BU;
777 
778  }//for I_Breakup
779 
780 // In the frame of source (i.e. prefragment after abrasion or INCL)
781  P_BU_SUM = std::sqrt(PX_BU_SUM*PX_BU_SUM + PY_BU_SUM*PY_BU_SUM +
782  PZ_BU_SUM*PZ_BU_SUM);
783 // ********************************************************
784 // PPRFP is in MeV/c
785  ETOT_SUM = std::sqrt(P_BU_SUM*P_BU_SUM +
786  (AAINCL * amu)*(AAINCL * amu));
787 
788  VX_BU_SUM = C * PX_BU_SUM / ETOT_SUM;
789  VY_BU_SUM = C * PY_BU_SUM / ETOT_SUM;
790  VZ_BU_SUM = C * PZ_BU_SUM / ETOT_SUM;
791 
792 // Lorentz kinematics - DM 17/5/2010
793 // VX_PREF = VX_PREF - VX_BU_SUM
794 // VY_PREF = VY_PREF - VY_BU_SUM
795 // VZ_PREF = VZ_PREF - VZ_BU_SUM
796 // Lorentz transformation
797  lorentz_boost(-VX_BU_SUM,-VY_BU_SUM,-VZ_BU_SUM,
798  VX_PREF,VY_PREF,VZ_PREF,
799  &VXOUT,&VYOUT,&VZOUT);
800 
801  VX_PREF = VXOUT;
802  VY_PREF = VYOUT;
803  VZ_PREF = VZOUT;
804 
805  VBU2 = VX_PREF*VX_PREF + VY_PREF*VY_PREF + VZ_PREF*VZ_PREF;
806  GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
807  ETOT_PRF = aprf * amu / GAMMA_REL;
808  PXPRFP = ETOT_PRF * VX_PREF / C;
809  PYPRFP = ETOT_PRF * VY_PREF / C;
810  PZPRFP = ETOT_PRF * VZ_PREF / C;
811 
812  PX_BU_SUM = 0.0;
813  PY_BU_SUM = 0.0;
814  PZ_BU_SUM = 0.0;
815 
816  PX_BU_SUM = PXPRFP;
817  PY_BU_SUM = PYPRFP;
818  PZ_BU_SUM = PZPRFP;
819  E_tot_BU = ETOT_PRF;
820 
821  EKIN_BU = aprf * amu / GAMMA_REL - aprf * amu;
822 
823  for(I_Breakup=0;I_Breakup<IMULTBU;I_Breakup++){
824 // Lorentz kinematics - DM 17/5/2010
825 // BU_TAB(I_Breakup,5) = BU_TAB(I_Breakup,5) - VX_BU_SUM
826 // BU_TAB(I_Breakup,6) = BU_TAB(I_Breakup,6) - VY_BU_SUM
827 // BU_TAB(I_Breakup,7) = BU_TAB(I_Breakup,7) - VZ_BU_SUM
828 // Lorentz transformation
829  lorentz_boost(-VX_BU_SUM,-VY_BU_SUM,-VZ_BU_SUM,
830  BU_TAB[I_Breakup][4],BU_TAB[I_Breakup][5],BU_TAB[I_Breakup][6],
831  &VXOUT,&VYOUT,&VZOUT);
832 
833  BU_TAB[I_Breakup][4] = VXOUT;
834  BU_TAB[I_Breakup][5] = VYOUT;
835  BU_TAB[I_Breakup][6] = VZOUT;
836 
837  VBU2 = BU_TAB[I_Breakup][4]*BU_TAB[I_Breakup][4] +
838  BU_TAB[I_Breakup][5]*BU_TAB[I_Breakup][5] +
839  BU_TAB[I_Breakup][6]*BU_TAB[I_Breakup][6];
840  GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
841 
842  ETOT_BU = BU_TAB[I_Breakup][1]*amu/GAMMA_REL;
843 
844  EKIN_BU = EKIN_BU + BU_TAB[I_Breakup][1] * amu /
845  GAMMA_REL - BU_TAB[I_Breakup][1] * amu;
846 
847  PX_BU = ETOT_BU * BU_TAB[I_Breakup][4] / C;
848  PY_BU = ETOT_BU * BU_TAB[I_Breakup][5] / C;
849  PZ_BU = ETOT_BU * BU_TAB[I_Breakup][6] / C;
850  E_tot_BU = E_tot_BU + ETOT_BU;
851 
852  PX_BU_SUM = PX_BU_SUM + PX_BU;
853  PY_BU_SUM = PY_BU_SUM + PY_BU;
854  PZ_BU_SUM = PZ_BU_SUM + PZ_BU;
855  }// for I_Breakup
856 
857  if(std::abs(PX_BU_SUM)>10. || std::abs(PY_BU_SUM)>10. ||
858  std::abs(PZ_BU_SUM)>10.){
859 
860 // In the frame of source (i.e. prefragment after INCL)
861  P_BU_SUM = std::sqrt(PX_BU_SUM*PX_BU_SUM + PY_BU_SUM*PY_BU_SUM +
862  PZ_BU_SUM*PZ_BU_SUM);
863 // ********************************************************
864 // PPRFP is in MeV/c
865  ETOT_SUM = std::sqrt(P_BU_SUM*P_BU_SUM +
866  (AAINCL * amu)*(AAINCL * amu));
867 
868  VX_BU_SUM = C * PX_BU_SUM / ETOT_SUM;
869  VY_BU_SUM = C * PY_BU_SUM / ETOT_SUM;
870  VZ_BU_SUM = C * PZ_BU_SUM / ETOT_SUM;
871 
872 // Lorentz kinematics
873 // VX_PREF = VX_PREF - VX_BU_SUM
874 // VY_PREF = VY_PREF - VY_BU_SUM
875 // VZ_PREF = VZ_PREF - VZ_BU_SUM
876 // Lorentz transformation
877  lorentz_boost(-VX_BU_SUM,-VY_BU_SUM,-VZ_BU_SUM,
878  VX_PREF,VY_PREF,VZ_PREF,
879  &VXOUT,&VYOUT,&VZOUT);
880 
881  VX_PREF = VXOUT;
882  VY_PREF = VYOUT;
883  VZ_PREF = VZOUT;
884 
885  VBU2 = VX_PREF*VX_PREF + VY_PREF*VY_PREF + VZ_PREF*VZ_PREF;
886  GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
887  ETOT_PRF = aprf * amu / GAMMA_REL;
888  PXPRFP = ETOT_PRF * VX_PREF / C;
889  PYPRFP = ETOT_PRF * VY_PREF / C;
890  PZPRFP = ETOT_PRF * VZ_PREF / C;
891 
892  PX_BU_SUM = 0.0;
893  PY_BU_SUM = 0.0;
894  PZ_BU_SUM = 0.0;
895 
896  PX_BU_SUM = PXPRFP;
897  PY_BU_SUM = PYPRFP;
898  PZ_BU_SUM = PZPRFP;
899  E_tot_BU = ETOT_PRF;
900 
901  EKIN_BU = aprf * amu / GAMMA_REL - aprf * amu;
902 
903  for(I_Breakup=0;I_Breakup<IMULTBU;I_Breakup++){
904 // Lorentz kinematics - DM 17/5/2010
905 // BU_TAB(I_Breakup,5) = BU_TAB(I_Breakup,5) - VX_BU_SUM
906 // BU_TAB(I_Breakup,6) = BU_TAB(I_Breakup,6) - VY_BU_SUM
907 // BU_TAB(I_Breakup,7) = BU_TAB(I_Breakup,7) - VZ_BU_SUM
908 // Lorentz transformation
909  lorentz_boost(-VX_BU_SUM,-VY_BU_SUM,-VZ_BU_SUM,
910  BU_TAB[I_Breakup][4],BU_TAB[I_Breakup][5],BU_TAB[I_Breakup][6],
911  &VXOUT,&VYOUT,&VZOUT);
912 
913  BU_TAB[I_Breakup][4] = VXOUT;
914  BU_TAB[I_Breakup][5] = VYOUT;
915  BU_TAB[I_Breakup][6] = VZOUT;
916 
917  VBU2 = BU_TAB[I_Breakup][4]*BU_TAB[I_Breakup][4] +
918  BU_TAB[I_Breakup][5]*BU_TAB[I_Breakup][5] +
919  BU_TAB[I_Breakup][6]*BU_TAB[I_Breakup][6];
920  GAMMA_REL = std::sqrt(1.0 - VBU2 / (C*C));
921 
922  ETOT_BU = BU_TAB[I_Breakup][1]*amu/GAMMA_REL;
923 
924  EKIN_BU = EKIN_BU + BU_TAB[I_Breakup][1] * amu /
925  GAMMA_REL - BU_TAB[I_Breakup][1] * amu;
926 
927  PX_BU = ETOT_BU * BU_TAB[I_Breakup][4] / C;
928  PY_BU = ETOT_BU * BU_TAB[I_Breakup][5] / C;
929  PZ_BU = ETOT_BU * BU_TAB[I_Breakup][6] / C;
930  E_tot_BU = E_tot_BU + ETOT_BU;
931 
932  PX_BU_SUM = PX_BU_SUM + PX_BU;
933  PY_BU_SUM = PY_BU_SUM + PY_BU;
934  PZ_BU_SUM = PZ_BU_SUM + PZ_BU;
935  }// for I_Breakup
936  }// if DABS(PX_BU_SUM).GT.10.d0
937 //
938 // Find the limits that fragment is bound - only done for neutrons and LCPs and for
939 // nuclei with A=Z, for other nuclei it will be done after decay:
940 
941  INEWLOOP = 0;
942  for(G4int i=0;i<IMULTBU;i++){
943  if(BU_TAB[i][0]<3.0 || BU_TAB[i][0]==BU_TAB[i][1]){
944  unstable_nuclei(idnint(BU_TAB[i][1]),idnint(BU_TAB[i][0]), &afpnew,&zfpnew,IOUNSTABLE,
945  BU_TAB[i][4], BU_TAB[i][5], BU_TAB[i][6],
946  &VP1X,&VP1Y,&VP1Z,BU_TAB_TEMP,&ILOOP);
947 
948  if(IOUNSTABLE>0){
949 // Properties of "heavy fragment":
950  BU_TAB[i][1] = G4double(afpnew);
951  BU_TAB[i][0] = G4double(zfpnew);
952  BU_TAB[i][4] = VP1X;
953  BU_TAB[i][5] = VP1Y;
954  BU_TAB[i][6] = VP1Z;
955 
956 //Properties of "light" fragments:
957  for(G4int IJ=0;IJ<ILOOP;IJ++){
958  BU_TAB[IMULTBU+INEWLOOP+IJ][0] = BU_TAB_TEMP[IJ][0];
959  BU_TAB[IMULTBU+INEWLOOP+IJ][1] = BU_TAB_TEMP[IJ][1];
960  BU_TAB[IMULTBU+INEWLOOP+IJ][4] = BU_TAB_TEMP[IJ][2];
961  BU_TAB[IMULTBU+INEWLOOP+IJ][5] = BU_TAB_TEMP[IJ][3];
962  BU_TAB[IMULTBU+INEWLOOP+IJ][6] = BU_TAB_TEMP[IJ][4];
963  BU_TAB[IMULTBU+INEWLOOP+IJ][2] = 0.0;
964  BU_TAB[IMULTBU+INEWLOOP+IJ][3] = 0.0;
965  }// for ILOOP
966 
967  INEWLOOP = INEWLOOP + ILOOP;
968 
969  }// if IOUNSTABLE.GT.0
970  }//if BU_TAB[I_Breakup][0]<3.0
971  }// for IMULTBU
972 
973 // Increased array of BU_TAB
974  IMULTBU = IMULTBU + INEWLOOP;
975 // Evaporation from multifragmentation products
976  opt->optimfallowed = 1; // IMF is allowed
977  fiss->ifis = 0; // fission is not allowed
978  gammaemission=0;
979  ILOOPBU = 0;
980 
981  for(G4int i=0;i<IMULTBU;i++){
982  EEBU = BU_TAB[i][2];
983  BU_TAB[i][10] = BU_TAB[i][6];
984  G4double jprfbu = BU_TAB[i][9];
985  if(BU_TAB[i][0]>2.0){
986  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);
987 
988  BU_TAB[i][9] = jprfbu;
989 
990 //Velocities of evaporated particles (in the frame of the primary prefragment)
991  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
992  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
993  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
994 //Lorentz kinematics
995 // DO IK = 3, 5, 1
996 // EV_TAB(IJ+IEV_TAB,IK) = EV_TEMP(IJ,IK) + BU_TAB(I,IK+2)
997 // ENDDO
998 // Lorentz transformation
999  lorentz_boost(BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1000  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1001  &VXOUT,&VYOUT,&VZOUT);
1002  EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1003  EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1004  EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1005  }
1006  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1007 
1008 //All velocities in the frame of the "primary" prefragment (after INC)
1009 // Lorentz kinematics
1010 // BU_TAB(I,5) = BU_TAB(I,5) + VX_EVABU
1011 // BU_TAB(I,6) = BU_TAB(I,6) + VY_EVABU
1012 // BU_TAB(I,7) = BU_TAB(I,7) + VZ_EVABU
1013 // Lorentz transformation
1014  lorentz_boost(vx_evabu,vy_evabu,vz_evabu,
1015  BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1016  &VXOUT,&VYOUT,&VZOUT);
1017  BU_TAB[i][4] = VXOUT;
1018  BU_TAB[i][5] = VYOUT;
1019  BU_TAB[i][6] = VZOUT;
1020 
1021  if(fimf==0){
1022  BU_TAB[i][7] = dint(ZFBU);
1023  BU_TAB[i][8] = dint(AFBU);
1024  }// if fimf==0
1025 
1026  if(fimf==1){
1027 // PRINT*,'IMF EMISSION FROM BU PRODUCTS'
1028 // IMF emission: Heavy partner is not allowed to fission or to emitt IMF.
1029  //double FEE = EEBU;
1030  G4int FFBU1 = 0;
1031  G4int FIMFBU1 = 0;
1032  opt->optimfallowed = 0; // IMF is not allowed
1033  fiss->ifis = 0; // fission is not allowed
1034 // Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
1035  G4double EkinR1 = TKEIMFBU * AIMFBU / (AFBU+AIMFBU);
1036  G4double EkinR2 = TKEIMFBU * AFBU / (AFBU+AIMFBU);
1037  G4double V1 = std::sqrt(EkinR1/AFBU) * 1.3887;
1038  G4double V2 = std::sqrt(EkinR2/AIMFBU) * 1.3887;
1039  G4double VZ1_IMF = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
1040  G4double VPERP1 = std::sqrt(V1*V1 - VZ1_IMF*VZ1_IMF);
1041  G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
1042  G4double VX1_IMF = VPERP1 * std::sin(ALPHA1);
1043  G4double VY1_IMF = VPERP1 * std::cos(ALPHA1);
1044  G4double VX2_IMF = - VX1_IMF / V1 * V2;
1045  G4double VY2_IMF = - VY1_IMF / V1 * V2;
1046  G4double VZ2_IMF = - VZ1_IMF / V1 * V2;
1047 
1048  G4double EEIMFP = EEBU * AFBU /(AFBU + AIMFBU);
1049  G4double EEIMF = EEBU * AIMFBU /(AFBU + AIMFBU);
1050 
1051 // Decay of heavy partner
1052  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.));
1053 
1054  G4double JPRFHEAVY = BU_TAB[i][9] * 0.4 * 931.49 * 1.16*1.16 * std::pow(AFBU,5.0/3.0) / IINERTTOT;
1055  G4double JPRFLIGHT = BU_TAB[i][9] * 0.4 * 931.49 * 1.16*1.16 * std::pow(AIMFBU,5.0/3.0) / IINERTTOT;
1056 
1057 // Lorentz kinematics
1058 // BU_TAB(I,5) = BU_TAB(I,5) + VX1_IMF
1059 // BU_TAB(I,6) = BU_TAB(I,6) + VY1_IMF
1060 // BU_TAB(I,7) = BU_TAB(I,7) + VZ1_IMF
1061 // Lorentz transformation
1062  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1063  BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1064  &VXOUT,&VYOUT,&VZOUT);
1065  BU_TAB[i][4] = VXOUT;
1066  BU_TAB[i][5] = VYOUT;
1067  BU_TAB[i][6] = VZOUT;
1068 
1069  G4double vx1ev_imf=0., vy1ev_imf=0., vz1ev_imf=0., zdummy=0., adummy=0., tkedummy=0.,jprf1=0.;
1070 
1071 // Decay of IMF's partner:
1072  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);
1073 
1074  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1075  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1076  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1077 //Lorentz kinematics
1078 // DO IK = 3, 5, 1
1079 // EV_TAB(IJ+IEV_TAB,IK) = EV_TEMP(IJ,IK) + BU_TAB(I,IK+2)
1080 // ENDDO
1081 // Lorentz transformation
1082  lorentz_boost(BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1083  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1084  &VXOUT,&VYOUT,&VZOUT);
1085  EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1086  EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1087  EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1088  }
1089  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1090 
1091  BU_TAB[i][7] = dint(ZFFBU);
1092  BU_TAB[i][8] = dint(AFFBU);
1093 //Lorentz kinematics
1094 // BU_TAB(I,5) = BU_TAB(I,5) + vx1ev_imf
1095 // BU_TAB(I,6) = BU_TAB(I,6) + vy1ev_imf
1096 // BU_TAB(I,7) = BU_TAB(I,7) + vz1ev_imf
1097  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1098  BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1099  &VXOUT,&VYOUT,&VZOUT);
1100  BU_TAB[i][4] = VXOUT;
1101  BU_TAB[i][5] = VYOUT;
1102  BU_TAB[i][6] = VZOUT;
1103 // For IMF - fission and IMF emission are not allowed
1104  G4int FFBU2 = 0;
1105  G4int FIMFBU2 = 0;
1106  opt->optimfallowed = 0; // IMF is not allowed
1107  fiss->ifis = 0; // fission is not allowed
1108 // Decay of IMF
1109  G4double zffimf, affimf,zdummy1, adummy1, tkedummy1, jprf2, vx2ev_imf, vy2ev_imf, vz2ev_imf;
1110 
1111  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);
1112 
1113  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1114  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1115  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1116 //Lorentz kinematics
1117 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + BU_TAB(I,5) +VX2_IMF
1118 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + BU_TAB(I,6) +VY2_IMF
1119 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + BU_TAB(I,7) +VZ2_IMF
1120 // Lorentz transformation
1121  lorentz_boost(BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1122  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1123  &VXOUT,&VYOUT,&VZOUT);
1124  lorentz_boost(VX2_IMF,VY2_IMF,VZ2_IMF,
1125  VXOUT,VYOUT,VZOUT,
1126  &VX2OUT,&VY2OUT,&VZ2OUT);
1127  EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1128  EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1129  EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1130  }
1131  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1132 
1133  BU_TAB[IMULTBU+ILOOPBU][0] = BU_TAB[i][0];
1134  BU_TAB[IMULTBU+ILOOPBU][1] = BU_TAB[i][1];
1135  BU_TAB[IMULTBU+ILOOPBU][2] = BU_TAB[i][2];
1136  BU_TAB[IMULTBU+ILOOPBU][3] = BU_TAB[i][3];
1137  BU_TAB[IMULTBU+ILOOPBU][7] = dint(zffimf);
1138  BU_TAB[IMULTBU+ILOOPBU][8] = dint(affimf);
1139 // Lorentz transformation
1140  lorentz_boost(VX2_IMF,VY2_IMF,VZ2_IMF,
1141  BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1142  &VXOUT,&VYOUT,&VZOUT);
1143  lorentz_boost(vx2ev_imf,vy2ev_imf,vz2ev_imf,
1144  VXOUT,VYOUT,VZOUT,
1145  &VX2OUT,&VY2OUT,&VZ2OUT);
1146  BU_TAB[IMULTBU+ILOOPBU][4] = VX2OUT;
1147  BU_TAB[IMULTBU+ILOOPBU][5] = VY2OUT;
1148  BU_TAB[IMULTBU+ILOOPBU][6] = VZ2OUT;
1149  ILOOPBU = ILOOPBU + 1;
1150  }// if fimf==1
1151 
1152  } else {// if BU_TAB(I,1).GT.2.D0
1153  BU_TAB[i][0] = BU_TAB[i][0];
1154  BU_TAB[i][1] = BU_TAB[i][1];
1155  BU_TAB[i][2] = BU_TAB[i][2];
1156  BU_TAB[i][3] = BU_TAB[i][3];
1157  BU_TAB[i][7] = BU_TAB[i][0];
1158  BU_TAB[i][8] = BU_TAB[i][1];
1159  BU_TAB[i][4] = BU_TAB[i][4];
1160  BU_TAB[i][5] = BU_TAB[i][5];
1161  BU_TAB[i][6] = BU_TAB[i][6];
1162  }// if BU_TAB(I,1).GT.2.D0
1163  }// for IMULTBU
1164 
1165  IMULTBU = IMULTBU + ILOOPBU;
1166 //
1167 // RESOLVE UNSTABLE NUCLEI
1168 //
1169  INEWLOOP = 0;
1170  ABU_SUM = 0.0;
1171  ZBU_SUM = 0.0;
1172 //
1173  for(G4int i=0;i<IMULTBU;i++){
1174  ABU_SUM = ABU_SUM + BU_TAB[i][8];
1175  ZBU_SUM = ZBU_SUM + BU_TAB[i][7];
1176  unstable_nuclei(idnint(BU_TAB[i][8]),idnint(BU_TAB[i][7]), &afpnew,&zfpnew,IOUNSTABLE,
1177  BU_TAB[i][4], BU_TAB[i][5], BU_TAB[i][6],
1178  &VP1X,&VP1Y,&VP1Z,BU_TAB_TEMP1,&ILOOP);
1179 
1180 //From now on, all neutrons and LCP created in above subroutine are part of the
1181 // BU_TAB array (see below - Properties of "light" fragments). Therefore,
1182 // NEVA, PEVA ... are not needed any more in the break-up stage.
1183 
1184  if(IOUNSTABLE>0){
1185 // Properties of "heavy fragment":
1186  ABU_SUM = ABU_SUM + G4double(afpnew) - BU_TAB[i][8];
1187  ZBU_SUM = ZBU_SUM + G4double(zfpnew) - BU_TAB[i][7];
1188  BU_TAB[i][8] = G4double(afpnew);
1189  BU_TAB[i][7] = G4double(zfpnew);
1190  BU_TAB[i][4] = VP1X;
1191  BU_TAB[i][5] = VP1Y;
1192  BU_TAB[i][6] = VP1Z;
1193 
1194 //Properties of "light" fragments:
1195  for(G4int IJ=0;IJ<ILOOP;IJ++){
1196  BU_TAB[IMULTBU+INEWLOOP+IJ][7] = BU_TAB_TEMP1[IJ][0];
1197  BU_TAB[IMULTBU+INEWLOOP+IJ][8] = BU_TAB_TEMP1[IJ][1];
1198  BU_TAB[IMULTBU+INEWLOOP+IJ][4] = BU_TAB_TEMP1[IJ][2];
1199  BU_TAB[IMULTBU+INEWLOOP+IJ][5] = BU_TAB_TEMP1[IJ][3];
1200  BU_TAB[IMULTBU+INEWLOOP+IJ][6] = BU_TAB_TEMP1[IJ][4];
1201  BU_TAB[IMULTBU+INEWLOOP+IJ][2] = 0.0;
1202  BU_TAB[IMULTBU+INEWLOOP+IJ][3] = 0.0;
1203  BU_TAB[IMULTBU+INEWLOOP+IJ][0] = BU_TAB[i][0];
1204  BU_TAB[IMULTBU+INEWLOOP+IJ][1] = BU_TAB[i][1];
1205  ABU_SUM = ABU_SUM + BU_TAB[IMULTBU+INEWLOOP+IJ][8];
1206  ZBU_SUM = ZBU_SUM + BU_TAB[IMULTBU+INEWLOOP+IJ][7];
1207  }// for ILOOP
1208 
1209  INEWLOOP = INEWLOOP + ILOOP;
1210  }// if(IOUNSTABLE>0)
1211  }// for IMULTBU unstable
1212 
1213 // Increased array of BU_TAB
1214  IMULTBU = IMULTBU + INEWLOOP;
1215 
1216 // Transform all velocities into the rest frame of the projectile
1217  lorentz_boost(VX_incl,VY_incl,VZ_incl,
1218  VX_PREF,VY_PREF,VZ_PREF,
1219  &VXOUT,&VYOUT,&VZOUT);
1220  VX_PREF = VXOUT;
1221  VY_PREF = VYOUT;
1222  VZ_PREF = VZOUT;
1223 
1224  for(G4int i=0;i<IMULTBU;i++){
1225  lorentz_boost(VX_incl,VY_incl,VZ_incl,
1226  BU_TAB[i][4],BU_TAB[i][5],BU_TAB[i][6],
1227  &VXOUT,&VYOUT,&VZOUT);
1228  BU_TAB[i][4] = VXOUT;
1229  BU_TAB[i][5] = VYOUT;
1230  BU_TAB[i][6] = VZOUT;
1231  }
1232  for(G4int i=0;i<IEV_TAB;i++){
1233  lorentz_boost(VX_incl,VY_incl,VZ_incl,
1234  EV_TAB[i][2],EV_TAB[i][3],EV_TAB[i][4],
1235  &VXOUT,&VYOUT,&VZOUT);
1236  EV_TAB[i][2] = VXOUT;
1237  EV_TAB[i][3] = VYOUT;
1238  EV_TAB[i][4] = VZOUT;
1239  }
1240 
1241 
1242  if(IMULTBU>200)std::cout << "IMULTBU>200 " << IMULTBU << std::endl;
1243  }// if(T_diff>0.1)
1244 // End of multi-fragmentation
1245  mult7777:
1246 
1247 // Start basic de-excitation of fragments
1248  aprfp = idnint(aprf);
1249  zprfp = idnint(zprf);
1250 
1251  if(IMULTIFR == 0){
1252 // These momenta are in the frame of the projectile (or target in case of direct kinematics)
1253  VX_PREF = VX_incl;
1254  VY_PREF = VY_incl;
1255  VZ_PREF = VZ_incl;
1256  }
1257 //
1258 // CALL THE EVAPORATION SUBROUTINE
1259 //
1260  opt->optimfallowed = 1; // IMF is allowed
1261  fiss->ifis = 1; // fission is allowed
1262  fimf=0;
1263  ff=0;
1264 
1265 // To spare computing time; these events in any case cannot decay
1266 // IF(ZPRFP.LE.2.AND.ZPRFP.LT.APRFP)THEN FIXME: <= or <
1267  if(zprfp<=2 && zprfp<aprfp){
1268  zf = zprf;
1269  af = aprf;
1270  ee = 0.0;
1271  ff = 0;
1272  fimf = 0;
1273  ftype = 0;
1274  aimf = 0.0;
1275  zimf = 0.0;
1276  tkeimf = 0.0;
1277  vx_eva = 0.0;
1278  vy_eva = 0.0;
1279  vz_eva = 0.0;
1280  jprf0 = jprf;
1281  goto a1972;
1282  }
1283 
1284 // if(ZPRFP.LE.2.AND.ZPRFP.EQ.APRFP)
1285  if(zprfp<=2 && zprfp==aprfp){
1286  unstable_nuclei(aprfp,zprfp,&afpnew,&zfpnew,IOUNSTABLE,
1287  VX_PREF, VY_PREF, VZ_PREF,
1288  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1289  af = G4double(afpnew);
1290  zf = G4double(zfpnew);
1291  VX_PREF = VP1X;
1292  VY_PREF = VP1Y;
1293  VZ_PREF = VP1Z;
1294  for(G4int I = 0;I<ILOOP;I++){
1295  for(G4int IJ = 0; IJ<5; IJ++)
1296  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1297  }
1298  IEV_TAB = IEV_TAB + ILOOP;
1299  ee = 0.0;
1300  ff = 0;
1301  fimf = 0;
1302  ftype = 0;
1303  aimf = 0.0;
1304  zimf = 0.0;
1305  tkeimf = 0.0;
1306  vx_eva = 0.0;
1307  vy_eva = 0.0;
1308  vz_eva = 0.0;
1309  jprf0 = jprf;
1310  goto a1972;
1311  }
1312 
1313 // IF(ZPRFP.EQ.APRFP)THEN
1314  if(zprfp==aprfp){
1315  unstable_nuclei(aprfp,zprfp,&afpnew,&zfpnew,IOUNSTABLE,
1316  VX_PREF, VY_PREF, VZ_PREF,
1317  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1318  af = G4double(afpnew);
1319  zf = G4double(zfpnew);
1320  VX_PREF = VP1X;
1321  VY_PREF = VP1Y;
1322  VZ_PREF = VP1Z;
1323  for(G4int I = 0;I<ILOOP;I++){
1324  for(G4int IJ = 0; IJ<5; IJ++)
1325  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1326  }
1327  IEV_TAB = IEV_TAB + ILOOP;
1328  ee = 0.0;
1329  ff = 0;
1330  fimf = 0;
1331  ftype = 0;
1332  aimf = 0.0;
1333  zimf = 0.0;
1334  tkeimf = 0.0;
1335  vx_eva = 0.0;
1336  vy_eva = 0.0;
1337  vz_eva = 0.0;
1338  jprf0 = jprf;
1339  goto a1972;
1340  }
1341 //
1342  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);
1343 //
1344  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1345  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1346  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1347 //
1348 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1349 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1350 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1351 // Lorentz transformation
1352  lorentz_boost(VX_PREF,VY_PREF,VZ_PREF,
1353  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1354  &VXOUT,&VYOUT,&VZOUT);
1355  EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1356  EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1357  EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1358  }
1359  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1360 
1361  a1972:
1362 
1363 // vi_pref - velocity of the prefragment; vi_eva - recoil due to evaporation
1364  lorentz_boost(VX_PREF,VY_PREF,VZ_PREF,
1365  vx_eva,vy_eva,vz_eva,
1366  &VXOUT,&VYOUT,&VZOUT);
1367  V_CM[0] = VXOUT;
1368  V_CM[1] = VYOUT;
1369  V_CM[2] = VZOUT;
1370 //
1371  if(ff == 0 && fimf == 0){
1372 // Evaporation of neutrons and LCP; no IMF, no fission
1373  ftype = 0;
1374  ZFP1 = idnint(zf);
1375  AFP1 = idnint(af);
1376  AFPIMF = 0;
1377  ZFPIMF = 0;
1378  ZFP2 = 0;
1379  AFP2 = 0;
1380  VFP1_CM[0] = V_CM[0];
1381  VFP1_CM[1] = V_CM[1];
1382  VFP1_CM[2] = V_CM[2];
1383  for(G4int j=0;j<3;j++){
1384  VIMF_CM[j] = 0.0;
1385  VFP2_CM[j] = 0.0;
1386  }
1387  }
1388 //
1389  if(ff == 1 && fimf == 0) ftype = 1; // fission
1390  if(ff == 0 && fimf == 1) ftype = 2; // IMF emission
1391 //
1392 // AFP,ZFP IS THE FINAL FRAGMENT IF NO FISSION OR IMF EMISSION OCCURS
1393 // IN CASE OF FISSION IT IS THE NUCLEUS THAT UNDERGOES FISSION OR IMF
1394 //
1395 
1396 //***************** FISSION ***************************************
1397 //
1398  if(ftype == 1){
1399  varntp->kfis = 1;
1400  // ftype1=0;
1401 
1402  G4int IEV_TAB_FIS = 0,imode=0;
1403 
1404  G4double vx1_fission=0.,vy1_fission=0.,vz1_fission=0.;
1405  G4double vx2_fission=0.,vy2_fission=0.,vz2_fission=0.;
1406  G4double vx_eva_sc=0.,vy_eva_sc=0.,vz_eva_sc=0.;
1407 
1408  fission(af,zf,ee,jprf0,
1409  &vx1_fission,&vy1_fission,&vz1_fission,
1410  &vx2_fission,&vy2_fission,&vz2_fission,
1411  &ZFP1,&AFP1,&ZFP2,&AFP2,&imode,
1412  &vx_eva_sc,&vy_eva_sc,&vz_eva_sc,EV_TEMP,&IEV_TAB_FIS);
1413 
1414  for(G4int IJ = 0; IJ< IEV_TAB_FIS;IJ++){
1415  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1416  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1417 // Lorentz kinematics
1418 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1419 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1420 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1421 // Lorentz transformation
1422  lorentz_boost(V_CM[0],V_CM[1],V_CM[2],
1423  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1424  &VXOUT,&VYOUT,&VZOUT);
1425  EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1426  EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1427  EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1428  }
1429  IEV_TAB = IEV_TAB + IEV_TAB_FIS;
1430 
1431  // if(imode==1) ftype1 = 1; // S1 mode
1432  // if(imode==2) ftype1 = 2; // S2 mode
1433 
1434  AFPIMF = 0;
1435  ZFPIMF = 0;
1436 
1437 // VX_EVA_SC,VY_EVA_SC,VZ_EVA_SC - recoil due to particle emisison
1438 // between saddle and scission
1439 // Lorentz kinematics
1440 // VFP1_CM(1) = V_CM(1) + VX1_FISSION + VX_EVA_SC ! Velocity of FF1 in x
1441 // VFP1_CM(2) = V_CM(2) + VY1_FISSION + VY_EVA_SC ! Velocity of FF1 in y
1442 // VFP1_CM(3) = V_CM(3) + VZ1_FISSION + VZ_EVA_SC ! Velocity of FF1 in x
1443  lorentz_boost(vx1_fission,vy1_fission,vz1_fission,
1444  V_CM[0],V_CM[1],V_CM[2],
1445  &VXOUT,&VYOUT,&VZOUT);
1446  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1447  VXOUT,VYOUT,VZOUT,
1448  &VX2OUT,&VY2OUT,&VZ2OUT);
1449  VFP1_CM[0] = VX2OUT;
1450  VFP1_CM[1] = VY2OUT;
1451  VFP1_CM[2] = VZ2OUT;
1452 
1453 // Lorentz kinematics
1454 // VFP2_CM(1) = V_CM(1) + VX2_FISSION + VX_EVA_SC ! Velocity of FF2 in x
1455 // VFP2_CM(2) = V_CM(2) + VY2_FISSION + VY_EVA_SC ! Velocity of FF2 in y
1456 // VFP2_CM(3) = V_CM(3) + VZ2_FISSION + VZ_EVA_SC ! Velocity of FF2 in x
1457  lorentz_boost(vx2_fission,vy2_fission,vz2_fission,
1458  V_CM[0],V_CM[1],V_CM[2],
1459  &VXOUT,&VYOUT,&VZOUT);
1460  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1461  VXOUT,VYOUT,VZOUT,
1462  &VX2OUT,&VY2OUT,&VZ2OUT);
1463  VFP2_CM[0] = VX2OUT;
1464  VFP2_CM[1] = VY2OUT;
1465  VFP2_CM[2] = VZ2OUT;
1466 
1467 //************** IMF EMISSION ************************************************
1468 //
1469  }else if(ftype == 2){
1470 // IMF emission: Heavy partner is allowed to fission and to emitt IMF, but ONLY once.
1471  G4int FF11 = 0;
1472  G4int FIMF11 = 0;
1473  opt->optimfallowed = 1; // IMF is allowed
1474  fiss->ifis = 1; // fission is allowed
1475 
1476 // Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
1477  G4double EkinR1 = tkeimf * aimf / (af+aimf);
1478  G4double EkinR2 = tkeimf * af / (af+aimf);
1479  G4double V1 = std::sqrt(EkinR1/af) * 1.3887;
1480  G4double V2 = std::sqrt(EkinR2/aimf) * 1.3887;
1481  G4double VZ1_IMF = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
1482  G4double VPERP1 = std::sqrt(V1*V1 - VZ1_IMF*VZ1_IMF);
1483  G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
1484  G4double VX1_IMF = VPERP1 * std::sin(ALPHA1);
1485  G4double VY1_IMF = VPERP1 * std::cos(ALPHA1);
1486  G4double VX2_IMF = - VX1_IMF / V1 * V2;
1487  G4double VY2_IMF = - VY1_IMF / V1 * V2;
1488  G4double VZ2_IMF = - VZ1_IMF / V1 * V2;
1489 
1490  G4double EEIMFP = ee * af /(af + aimf);
1491  G4double EEIMF = ee * aimf /(af + aimf);
1492 
1493 // Decay of heavy partner
1494  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.));
1495 
1496  G4double JPRFHEAVY = jprf0 * 0.4 * 931.49 * 1.16*1.16 * std::pow(af,5.0/3.0) / IINERTTOT;
1497  G4double JPRFLIGHT = jprf0 * 0.4 * 931.49 * 1.16*1.16 * std::pow(aimf,5.0/3.0) / IINERTTOT;
1498  if(af<2.0) std::cout << "RN117-4,AF,ZF,EE,JPRFheavy" << std::endl;
1499 
1500  G4double vx1ev_imf=0., vy1ev_imf=0., vz1ev_imf=0., zdummy=0., adummy=0., tkedummy=0.,jprf1=0.;
1501 
1502  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);
1503 
1504  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1505  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1506  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1507 //
1508 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1509 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1510 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1511 // Lorentz transformation
1512  lorentz_boost(V_CM[0],V_CM[1],V_CM[2],
1513  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1514  &VXOUT,&VYOUT,&VZOUT);
1515  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1516  VXOUT,VYOUT,VZOUT,
1517  &VX2OUT,&VY2OUT,&VZ2OUT);
1518  EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1519  EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1520  EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1521  }
1522  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1523 
1524 // For IMF - fission and IMF emission are not allowed
1525  G4int FF22 = 0;
1526  G4int FIMF22 = 0;
1527  opt->optimfallowed = 0; // IMF is not allowed
1528  fiss->ifis = 0; // fission is not allowed
1529 
1530 // Decay of IMF
1531  G4double zffimf, affimf,zdummy1, adummy1, tkedummy1,jprf2,vx2ev_imf,vy2ev_imf,
1532  vz2ev_imf;
1533 
1534  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);
1535 
1536  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1537  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1538  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1539 //
1540 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1541 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1542 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1543 // Lorentz transformation
1544  lorentz_boost(V_CM[0],V_CM[1],V_CM[2],
1545  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1546  &VXOUT,&VYOUT,&VZOUT);
1547  lorentz_boost(VX2_IMF,VY2_IMF,VZ2_IMF,
1548  VXOUT,VYOUT,VZOUT,
1549  &VX2OUT,&VY2OUT,&VZ2OUT);
1550  EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1551  EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1552  EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1553  }
1554  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1555 // As IMF is not allowed to emit IMF, adummy1=zdummy1=0
1556 
1557  AFPIMF = idnint(affimf);
1558  ZFPIMF = idnint(zffimf);
1559 
1560 // vi1_imf, vi2_imf - velocities of imf and partner from TKE;
1561 // vi1ev_imf, vi2_imf - recoil of partner and imf due to evaporation
1562 // Lorentz kinematics - DM 18/5/2010
1563 // VIMF_CM(1) = V_CM(1) + VX2_IMF + VX2EV_IMF
1564 // VIMF_CM(2) = V_CM(2) + VY2_IMF + VY2EV_IMF
1565 // VIMF_CM(3) = V_CM(3) + VZ2_IMF + VZ2EV_IMF
1566  lorentz_boost(VX2_IMF,VY2_IMF,VZ2_IMF,
1567  V_CM[0],V_CM[1],V_CM[2],
1568  &VXOUT,&VYOUT,&VZOUT);
1569  lorentz_boost(vx2ev_imf,vy2ev_imf,vz2ev_imf,
1570  VXOUT,VYOUT,VZOUT,
1571  &VX2OUT,&VY2OUT,&VZ2OUT);
1572  VIMF_CM[0] = VX2OUT;
1573  VIMF_CM[1] = VY2OUT;
1574  VIMF_CM[2] = VZ2OUT;
1575 // Lorentz kinematics
1576 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
1577 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
1578 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
1579  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1580  V_CM[0],V_CM[1],V_CM[2],
1581  &VXOUT,&VYOUT,&VZOUT);
1582  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1583  VXOUT,VYOUT,VZOUT,
1584  &VX2OUT,&VY2OUT,&VZ2OUT);
1585  VFP1_CM[0] = VX2OUT;
1586  VFP1_CM[1] = VY2OUT;
1587  VFP1_CM[2] = VZ2OUT;
1588 
1589  if(FF11==0 && FIMF11==0){
1590 // heavy partner deexcites by emission of light particles
1591  AFP1 = idnint(aff);
1592  ZFP1 = idnint(zff);
1593  ZFP2 = 0;
1594  AFP2 = 0;
1595  ftype = 2;
1596  AFPIMF = idnint(affimf);
1597  ZFPIMF = idnint(zffimf);
1598  for(G4int I=0;I<3;I++)
1599  VFP2_CM[I] = 0.0;
1600 
1601 
1602  } else if(FF11==1 && FIMF11==0){
1603 // Heavy partner fissions
1604  varntp->kfis = 1;
1605 //
1606  opt->optimfallowed = 0; // IMF is not allowed
1607  fiss->ifis = 0; // fission is not allowed
1608 //
1609  zf = zff;
1610  af = aff;
1611  ee = EEIMFP;
1612  // ftype1=0;
1613  ftype=21;
1614 
1615  G4int IEV_TAB_FIS = 0,imode=0;
1616 
1617  G4double vx1_fission=0.,vy1_fission=0.,vz1_fission=0.;
1618  G4double vx2_fission=0.,vy2_fission=0.,vz2_fission=0.;
1619  G4double vx_eva_sc=0.,vy_eva_sc=0.,vz_eva_sc=0.;
1620 
1621  fission(af,zf,ee,jprf1,
1622  &vx1_fission,&vy1_fission,&vz1_fission,
1623  &vx2_fission,&vy2_fission,&vz2_fission,
1624  &ZFP1,&AFP1,&ZFP2,&AFP2,&imode,
1625  &vx_eva_sc,&vy_eva_sc,&vz_eva_sc,EV_TEMP,&IEV_TAB_FIS);
1626 
1627  for(G4int IJ = 0; IJ< IEV_TAB_FIS;IJ++){
1628  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1629  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1630 // Lorentz kinematics
1631 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1632 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1633 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1634 // Lorentz transformation
1635  lorentz_boost(VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1636  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1637  &VXOUT,&VYOUT,&VZOUT);
1638  EV_TAB[IJ+IEV_TAB][2] = VXOUT;
1639  EV_TAB[IJ+IEV_TAB][3] = VYOUT;
1640  EV_TAB[IJ+IEV_TAB][4] = VZOUT;
1641  }
1642  IEV_TAB = IEV_TAB + IEV_TAB_FIS;
1643 
1644  // if(imode==1) ftype1 = 1; // S1 mode
1645  // if(imode==2) ftype1 = 2; // S2 mode
1646 
1647 // Lorentz kinematics
1648 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF + VX1_FISSION +
1649 // & VX_EVA_SC ! Velocity of FF1 in x
1650 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF + VY1_FISSION +
1651 // & VY_EVA_SC ! Velocity of FF1 in y
1652 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF + VZ1_FISSION +
1653 // & VZ_EVA_SC ! Velocity of FF1 in x
1654  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1655  V_CM[0],V_CM[1],V_CM[2],
1656  &VXOUT,&VYOUT,&VZOUT);
1657  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1658  VXOUT,VYOUT,VZOUT,
1659  &VX2OUT,&VY2OUT,&VZ2OUT);
1660  lorentz_boost(vx1_fission,vy1_fission,vz1_fission,
1661  VX2OUT,VY2OUT,VZ2OUT,
1662  &VXOUT,&VYOUT,&VZOUT);
1663  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1664  VXOUT,VYOUT,VZOUT,
1665  &VX2OUT,&VY2OUT,&VZ2OUT);
1666  VFP1_CM[0] = VX2OUT;
1667  VFP1_CM[1] = VY2OUT;
1668  VFP1_CM[2] = VZ2OUT;
1669 
1670 // Lorentz kinematics
1671 // VFP2_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF + VX2_FISSION +
1672 // & VX_EVA_SC ! Velocity of FF2 in x
1673 // VFP2_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF + VY2_FISSION +
1674 // & VY_EVA_SC ! Velocity of FF2 in y
1675 // VFP2_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF + VZ2_FISSION +
1676 // & VZ_EVA_SC ! Velocity of FF2 in x
1677  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1678  V_CM[0],V_CM[1],V_CM[2],
1679  &VXOUT,&VYOUT,&VZOUT);
1680  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1681  VXOUT,VYOUT,VZOUT,
1682  &VX2OUT,&VY2OUT,&VZ2OUT);
1683  lorentz_boost(vx2_fission,vy2_fission,vz2_fission,
1684  VX2OUT,VY2OUT,VZ2OUT,
1685  &VXOUT,&VYOUT,&VZOUT);
1686  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
1687  VXOUT,VYOUT,VZOUT,
1688  &VX2OUT,&VY2OUT,&VZ2OUT);
1689  VFP2_CM[0] = VX2OUT;
1690  VFP2_CM[1] = VY2OUT;
1691  VFP2_CM[2] = VZ2OUT;
1692 
1693 
1694 
1695  } else if(FF11==0 && FIMF11==1){
1696 // Heavy partner emits imf, consequtive imf emission or fission is not allowed
1697  opt->optimfallowed = 0; // IMF is not allowed
1698  fiss->ifis = 0; // fission is not allowed
1699 //
1700  zf = zff;
1701  af = aff;
1702  ee = EEIMFP;
1703  aimf = adummy;
1704  zimf = zdummy;
1705  tkeimf = tkedummy;
1706  FF11 = 0;
1707  FIMF11 = 0;
1708  ftype = 22;
1709 // Velocities of IMF and partner: 1 denotes partner, 2 denotes IMF
1710  EkinR1 = tkeimf * aimf / (af+aimf);
1711  EkinR2 = tkeimf * af / (af+aimf);
1712  V1 = std::sqrt(EkinR1/af) * 1.3887;
1713  V2 = std::sqrt(EkinR2/aimf) * 1.3887;
1714  G4double VZ1_IMFS = (2.0 * G4AblaRandom::flat() - 1.0) * V1;
1715  VPERP1 = std::sqrt(V1*V1 - VZ1_IMFS*VZ1_IMFS);
1716  ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
1717  G4double VX1_IMFS = VPERP1 * std::sin(ALPHA1);
1718  G4double VY1_IMFS = VPERP1 * std::cos(ALPHA1);
1719  G4double VX2_IMFS = - VX1_IMFS / V1 * V2;
1720  G4double VY2_IMFS = - VY1_IMFS / V1 * V2;
1721  G4double VZ2_IMFS = - VZ1_IMFS / V1 * V2;
1722 
1723  EEIMFP = ee * af /(af + aimf);
1724  EEIMF = ee * aimf /(af + aimf);
1725 
1726 // Decay of heavy partner
1727  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.));
1728 
1729  JPRFHEAVY = jprf1 * 0.4 * 931.49 * 1.16*1.16 * std::pow(af,5.0/3.0) / IINERTTOT;
1730  JPRFLIGHT = jprf1 * 0.4 * 931.49 * 1.16*1.16 * std::pow(aimf,5.0/3.0) / IINERTTOT;
1731 
1732  G4double zffs=0.,affs=0.,vx1ev_imfs=0.,vy1ev_imfs=0.,vz1ev_imfs=0.,jprf3=0.;
1733 
1734  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);
1735 
1736  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1737  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1738  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1739 //
1740 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1741 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1742 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1743 // Lorentz transformation
1744  lorentz_boost(VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1745  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1746  &VXOUT,&VYOUT,&VZOUT);
1747  lorentz_boost(vx1ev_imfs,vy1ev_imfs,vz1ev_imfs,
1748  VXOUT,VYOUT,VZOUT,
1749  &VX2OUT,&VY2OUT,&VZ2OUT);
1750  EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1751  EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1752  EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1753  }
1754  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1755 
1756 // For IMF - fission and IMF emission are not allowed
1757  opt->optimfallowed = 0; // IMF is not allowed
1758  fiss->ifis = 0; // fission is not allowed
1759 //
1760  FF22 = 0;
1761  FIMF22 = 0;
1762 // Decay of "second" IMF
1763  G4double zffimfs=0.,affimfs=0.,vx2ev_imfs=0.,vy2ev_imfs=0.,vz2ev_imfs=0.,jprf4=0.;
1764 
1765  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);
1766 
1767  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
1768  EV_TAB[IJ+IEV_TAB][0] = EV_TEMP[IJ][0];
1769  EV_TAB[IJ+IEV_TAB][1] = EV_TEMP[IJ][1];
1770 //
1771 // EV_TAB(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
1772 // EV_TAB(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
1773 // EV_TAB(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
1774 // Lorentz transformation
1775  lorentz_boost(VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1776  EV_TEMP[IJ][2],EV_TEMP[IJ][3],EV_TEMP[IJ][4],
1777  &VXOUT,&VYOUT,&VZOUT);
1778  lorentz_boost(vx2ev_imfs,vy2ev_imfs,vz2ev_imfs,
1779  VXOUT,VYOUT,VZOUT,
1780  &VX2OUT,&VY2OUT,&VZ2OUT);
1781  EV_TAB[IJ+IEV_TAB][2] = VX2OUT;
1782  EV_TAB[IJ+IEV_TAB][3] = VY2OUT;
1783  EV_TAB[IJ+IEV_TAB][4] = VZ2OUT;
1784  }
1785  IEV_TAB = IEV_TAB + IEV_TAB_TEMP;
1786 
1787  AFP1 = idnint(affs);
1788  ZFP1 = idnint(zffs);
1789  ZFP2 = idnint(zffimfs);
1790  AFP2 = idnint(affimfs);
1791 
1792 // Velocity of final heavy residue
1793 // Lorentz kinematics
1794 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
1795 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
1796 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
1797  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1798  V_CM[0],V_CM[1],V_CM[2],
1799  &VXOUT,&VYOUT,&VZOUT);
1800  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1801  VXOUT,VYOUT,VZOUT,
1802  &VX2OUT,&VY2OUT,&VZ2OUT);
1803  lorentz_boost(VX1_IMFS,VY1_IMFS,VZ1_IMFS,
1804  VX2OUT,VY2OUT,VZ2OUT,
1805  &VXOUT,&VYOUT,&VZOUT);
1806  lorentz_boost(vx1ev_imfs,vy1ev_imfs,vz1ev_imfs,
1807  VXOUT,VYOUT,VZOUT,
1808  &VX2OUT,&VY2OUT,&VZ2OUT);
1809  VFP1_CM[0] = VX2OUT;
1810  VFP1_CM[1] = VY2OUT;
1811  VFP1_CM[2] = VZ2OUT;
1812 
1813 // Velocity of the second IMF
1814 // Lorentz kinematics
1815 // VFP1_CM(1) = V_CM(1) + VX1_IMF + VX1EV_IMF
1816 // VFP1_CM(2) = V_CM(2) + VY1_IMF + VY1EV_IMF
1817 // VFP1_CM(3) = V_CM(3) + VZ1_IMF + VZ1EV_IMF
1818  lorentz_boost(VX1_IMF,VY1_IMF,VZ1_IMF,
1819  V_CM[0],V_CM[1],V_CM[2],
1820  &VXOUT,&VYOUT,&VZOUT);
1821  lorentz_boost(vx1ev_imf,vy1ev_imf,vz1ev_imf,
1822  VXOUT,VYOUT,VZOUT,
1823  &VX2OUT,&VY2OUT,&VZ2OUT);
1824  lorentz_boost(VX2_IMFS,VY2_IMFS,VZ2_IMFS,
1825  VX2OUT,VY2OUT,VZ2OUT,
1826  &VXOUT,&VYOUT,&VZOUT);
1827  lorentz_boost(vx2ev_imfs,vy2ev_imfs,vz2ev_imfs,
1828  VXOUT,VYOUT,VZOUT,
1829  &VX2OUT,&VY2OUT,&VZ2OUT);
1830  VFP2_CM[0] = VX2OUT;
1831  VFP2_CM[1] = VY2OUT;
1832  VFP2_CM[2] = VZ2OUT;
1833  }//second decay
1834  }// if(ftype == 2)
1835 
1836 // Only evaporation of light particles
1837  if(ftype!=1 && ftype!=21){
1838 
1839 // ----------- RESOLVE UNSTABLE NUCLEI
1840  IOUNSTABLE=0;
1841 
1842  unstable_nuclei(AFP1,ZFP1,&afpnew,&zfpnew,IOUNSTABLE,
1843  VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1844  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1845 
1846  if(IOUNSTABLE==1){
1847  AFP1 = afpnew;
1848  ZFP1 = zfpnew;
1849  VFP1_CM[0] = VP1X;
1850  VFP1_CM[1] = VP1Y;
1851  VFP1_CM[2] = VP1Z;
1852  for(G4int I = 0;I<ILOOP;I++){
1853  for(G4int IJ = 0; IJ<5; IJ++)
1854  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1855  }
1856  IEV_TAB = IEV_TAB + ILOOP;
1857  }
1858 
1859  if(ftype>1){
1860  IOUNSTABLE=0;
1861 
1862  unstable_nuclei(AFPIMF,ZFPIMF,&afpnew,&zfpnew,IOUNSTABLE,
1863  VIMF_CM[0],VIMF_CM[1],VIMF_CM[2],
1864  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1865 
1866  if(IOUNSTABLE==1){
1867  AFPIMF = afpnew;
1868  ZFPIMF = zfpnew;
1869  VIMF_CM[0] = VP1X;
1870  VIMF_CM[1] = VP1Y;
1871  VIMF_CM[2] = VP1Z;
1872  for(G4int I = 0;I<ILOOP;I++){
1873  for(G4int IJ = 0; IJ<5; IJ++)
1874  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1875  }
1876  IEV_TAB = IEV_TAB + ILOOP;
1877  }
1878 
1879  if(ftype>2){
1880  IOUNSTABLE=0;
1881 
1882  unstable_nuclei(AFP2,ZFP2,&afpnew,&zfpnew,IOUNSTABLE,
1883  VFP2_CM[0],VFP2_CM[1],VFP2_CM[2],
1884  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1885 
1886  if(IOUNSTABLE==1){
1887  AFP2 = afpnew;
1888  ZFP2 = zfpnew;
1889  VFP2_CM[0] = VP1X;
1890  VFP2_CM[1] = VP1Y;
1891  VFP2_CM[2] = VP1Z;
1892  for(G4int I = 0;I<ILOOP;I++){
1893  for(G4int IJ = 0; IJ<5; IJ++)
1894  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1895  }
1896  IEV_TAB = IEV_TAB + ILOOP;
1897  }
1898  }// ftype>2
1899  }// ftype>1
1900  }
1901 
1902 
1903 // For the case of fission:
1904  if(ftype==1 || ftype==21){
1905 // ----------- RESOLVE UNSTABLE NUCLEI
1906  IOUNSTABLE=0;
1907 // ----------- Fragment 1
1908  unstable_nuclei(AFP1,ZFP1,&afpnew,&zfpnew,IOUNSTABLE,
1909  VFP1_CM[0],VFP1_CM[1],VFP1_CM[2],
1910  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1911 
1912  if(IOUNSTABLE==1){
1913  AFP1 = afpnew;
1914  ZFP1 = zfpnew;
1915  VFP1_CM[0] = VP1X;
1916  VFP1_CM[1] = VP1Y;
1917  VFP1_CM[2] = VP1Z;
1918  for(G4int I = 0;I<ILOOP;I++){
1919  for(G4int IJ = 0; IJ<5; IJ++)
1920  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1921  }
1922  IEV_TAB = IEV_TAB + ILOOP;
1923  }
1924 
1925  IOUNSTABLE=0;
1926 // ----------- Fragment 2
1927  unstable_nuclei(AFP2,ZFP2,&afpnew,&zfpnew,IOUNSTABLE,
1928  VFP2_CM[0],VFP2_CM[1],VFP2_CM[2],
1929  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1930 
1931  if(IOUNSTABLE==1){
1932  AFP2 = afpnew;
1933  ZFP2 = zfpnew;
1934  VFP2_CM[0] = VP1X;
1935  VFP2_CM[1] = VP1Y;
1936  VFP2_CM[2] = VP1Z;
1937  for(G4int I = 0;I<ILOOP;I++){
1938  for(G4int IJ = 0; IJ<5; IJ++)
1939  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1940  }
1941  IEV_TAB = IEV_TAB + ILOOP;
1942  }
1943 
1944  if(ftype==21){
1945  IOUNSTABLE=0;
1946 // ----------- Fragment IMF
1947  unstable_nuclei(AFPIMF,ZFPIMF,&afpnew,&zfpnew,IOUNSTABLE,
1948  VIMF_CM[0],VIMF_CM[1],VIMF_CM[2],
1949  &VP1X,&VP1Y,&VP1Z,EV_TAB_TEMP,&ILOOP);
1950 
1951  if(IOUNSTABLE==1){
1952  AFPIMF = afpnew;
1953  ZFPIMF = zfpnew;
1954  VIMF_CM[0] = VP1X;
1955  VIMF_CM[1] = VP1Y;
1956  VIMF_CM[2] = VP1Z;
1957  for(G4int I = 0;I<ILOOP;I++){
1958  for(G4int IJ = 0; IJ<5; IJ++)
1959  EV_TAB[I+IEV_TAB][IJ] = EV_TAB_TEMP[I][IJ];
1960  }
1961  IEV_TAB = IEV_TAB + ILOOP;
1962  }
1963  }// ftype=21
1964  }
1965 
1966 // Cross check
1967  if((ftype == 1 || ftype == 21) && (AFP2<=0 || AFP1<=0 || ZFP2<=0 || ZFP1<=0)){
1968  std::cout << "ZFP1:" << ZFP1 << std::endl;
1969  std::cout << "AFP1:" << AFP1 << std::endl;
1970  std::cout << "ZFP2:" << ZFP2 << std::endl;
1971  std::cout << "AFP2:" << AFP2 << std::endl;
1972  }
1973 
1974 // Put heavy residues in the EV_TAB array
1975  EV_TAB[IEV_TAB][0] = ZFP1;
1976  EV_TAB[IEV_TAB][1] = AFP1;
1977  EV_TAB[IEV_TAB][2] = VFP1_CM[0];
1978  EV_TAB[IEV_TAB][3] = VFP1_CM[1];
1979  EV_TAB[IEV_TAB][4] = VFP1_CM[2];
1980  IEV_TAB = IEV_TAB + 1;
1981 
1982  if(AFP2>0){
1983  EV_TAB[IEV_TAB][0] = ZFP2;
1984  EV_TAB[IEV_TAB][1] = AFP2;
1985  EV_TAB[IEV_TAB][2] = VFP2_CM[0];
1986  EV_TAB[IEV_TAB][3] = VFP2_CM[1];
1987  EV_TAB[IEV_TAB][4] = VFP2_CM[2];
1988  IEV_TAB = IEV_TAB + 1;
1989  }
1990 
1991  if(AFPIMF>0){
1992  EV_TAB[IEV_TAB][0] = ZFPIMF;
1993  EV_TAB[IEV_TAB][1] = AFPIMF;
1994  EV_TAB[IEV_TAB][2] = VIMF_CM[0];
1995  EV_TAB[IEV_TAB][3] = VIMF_CM[1];
1996  EV_TAB[IEV_TAB][4] = VIMF_CM[2];
1997  IEV_TAB = IEV_TAB + 1;
1998  }
1999 
2000 // Put the array of particles in the root file of INCL
2001  FillData(IMULTBU,IEV_TAB);
2002  return;
2003 }
2004 
2005 // Evaporation code
2007 {
2008  // 37 C PROJECTILE AND TARGET PARAMETERS + CROSS SECTIONS
2009  // 38 C COMMON /ABLAMAIN/ AP,ZP,AT,ZT,EAP,BETA,BMAXNUC,CRTOT,CRNUC,
2010  // 39 C R_0,R_P,R_T, IMAX,IRNDM,PI,
2011  // 40 C BFPRO,SNPRO,SPPRO,SHELL
2012  // 41 C
2013  // 42 C AP,ZP,AT,ZT - PROJECTILE AND TARGET MASSES
2014  // 43 C EAP,BETA - BEAM ENERGY PER NUCLEON, V/C
2015  // 44 C BMAXNUC - MAX. IMPACT PARAMETER FOR NUCL. REAC.
2016  // 45 C CRTOT,CRNUC - TOTAL AND NUCLEAR REACTION CROSS SECTION
2017  // 46 C R_0,R_P,R_T, - RADIUS PARAMETER, PROJECTILE+ TARGET RADII
2018  // 47 C IMAX,IRNDM,PI - MAXIMUM NUMBER OF EVENTS, DUMMY, 3.141...
2019  // 48 C BFPRO - FISSION BARRIER OF THE PROJECTILE
2020  // 49 C SNPRO - NEUTRON SEPARATION ENERGY OF THE PROJECTILE
2021  // 50 C SPPRO - PROTON " " " " "
2022  // 51 C SHELL - GROUND STATE SHELL CORRECTION
2023  // 52 C---------------------------------------------------------------------
2024  // 53 C
2025  // 54 C ENERGIES WIDTHS AND CROSS SECTIONS FOR EM EXCITATION
2026  // 55 C COMMON /EMDPAR/ EGDR,EGQR,FWHMGDR,FWHMGQR,CREMDE1,CREMDE2,
2027  // 56 C AE1,BE1,CE1,AE2,BE2,CE2,SR1,SR2,XR
2028  // 57 C
2029  // 58 C EGDR,EGQR - MEAN ENERGY OF GDR AND GQR
2030  // 59 C FWHMGDR,FWHMGQR - FWHM OF GDR, GQR
2031  // 60 C CREMDE1,CREMDE2 - EM CROSS SECTION FOR E1 AND E2
2032  // 61 C AE1,BE1,CE1 - ARRAYS TO CALCULATE
2033  // 62 C AE2,BE2,CE2 - THE EXCITATION ENERGY AFTER E.M. EXC.
2034  // 63 C SR1,SR2,XR - WITH MONTE CARLO
2035  // 64 C---------------------------------------------------------------------
2036  // 65 C
2037  // 66 C DEFORMATIONS AND G.S. SHELL EFFECTS
2038  // 67 C COMMON /ECLD/ ECGNZ,ECFNZ,VGSLD,ALPHA
2039  // 68 C
2040  // 69 C ECGNZ - GROUND STATE SHELL CORR. FRLDM FOR A SPHERICAL G.S.
2041  // 70 C ECFNZ - SHELL CORRECTION FOR THE SADDLE POINT (NOW: == 0)
2042  // 71 C VGSLD - DIFFERENCE BETWEEN DEFORMED G.S. AND LDM VALUE
2043  // 72 C ALPHA - ALPHA GROUND STATE DEFORMATION (THIS IS NOT BETA2!)
2044  // 73 C BETA2 = SQRT(5/(4PI)) * ALPHA
2045  // 74 C---------------------------------------------------------------------
2046  // 75 C
2047  // 76 C ARRAYS FOR EXCITATION ENERGY BY STATISTICAL HOLE ENERY MODEL
2048  // 77 C COMMON /EENUC/ SHE, XHE
2049  // 78 C
2050  // 79 C SHE, XHE - ARRAYS TO CALCULATE THE EXC. ENERGY AFTER
2051  // 80 C ABRASION BY THE STATISTICAL HOLE ENERGY MODEL
2052  // 81 C---------------------------------------------------------------------
2053  // 82 C
2054  // 83 C G.S. SHELL EFFECT
2055  // 84 C COMMON /EC2SUB/ ECNZ
2056  // 85 C
2057  // 86 C ECNZ G.S. SHELL EFFECT FOR THE MASSES (IDENTICAL TO ECGNZ)
2058  // 87 C---------------------------------------------------------------------
2059  //
2060 
2061  G4double MN = 939.5653301;
2062  G4double MP = 938.7829835;
2063 
2064 #ifdef ABLAXX_IN_GEANT4_MODE
2065  G4AblaDataFile *dataInterface = new G4AblaDataFile();
2066 #else
2067  G4AblaDataFile *dataInterface = new G4AblaDataFile(theConfig);
2068 #endif
2069  if(dataInterface->readData() == true) {
2070  if(verboseLevel > 0) {
2071  // G4cout <<"G4Abla: Datafiles read successfully." << G4endl;
2072  }
2073  }
2074  else {
2075  // G4Exception("ERROR: Failed to read datafiles.");
2076  }
2077 
2078  for(G4int z = 0; z < 99; z++) { //do 30 z = 0,98,1
2079  for(G4int n = 0; n < 154; n++) { //do 31 n = 0,153,1
2080  ecld->ecfnz[n][z] = 0.e0;
2081  ec2sub->ecnz[n][z] = dataInterface->getEcnz(n,z);
2082  ecld->ecgnz[n][z] = dataInterface->getEcnz(n,z);
2083  ecld->alpha[n][z] = dataInterface->getAlpha(n,z);
2084  ecld->vgsld[n][z] = dataInterface->getVgsld(n,z);
2085  ecld->rms[n][z] = dataInterface->getRms(n,z);
2086  }
2087  }
2088 
2089  for(G4int z = 0; z < 137; z++){
2090  for(G4int n = 0; n < 251; n++){
2091  ecld->beta2[n][z] = dataInterface->getBeta2(n,z);
2092  ecld->beta4[n][z] = dataInterface->getBeta4(n,z);
2093  }
2094  }
2095 
2096  for(G4int z = 0; z < 500; z++) {
2097  for(G4int a = 0; a < 500; a++) {
2098  pace->dm[z][a] = dataInterface->getPace2(z,a);
2099  }
2100  }
2101 
2102 
2103 
2104  G4double mfrldm[154][13];
2105 // For 2 < Z < 12 we take "experimental" shell corrections instead of calculated
2106 // Read FRLDM tables
2107  for(G4int i=0;i<13;i++){
2108  for(G4int j=0;j<154;j++){
2109  if(dataInterface->getMexpID(j,i)==1){
2110  masses->mexpiop[j][i]=1;
2111  }else{
2112  masses->mexpiop[j][i]=0;
2113  }
2114 // LD masses (even-odd effect is later considered according to Ignatyuk)
2115  if(i==0 && j==0)
2116  mfrldm[j][i] = 0.;
2117  else
2118  mfrldm[j][i] = MP*i+MN*j+eflmac(i+j,i,1,0);
2119  }
2120  }
2121 
2122  G4double e0=0.;
2123  for(G4int i=1;i<13;i++){
2124  for(G4int j=1;j<154;j++){
2125  masses->bind[j][i]=0.;
2126  if(masses->mexpiop[j][i]==1){
2127  if(j<3){
2128 
2129  ec2sub->ecnz[j][i] = 0.0;
2130  ecld->ecgnz[j][i] = ec2sub->ecnz[j][i];
2131  masses->bind[j][i] = dataInterface->getMexp(j,i)-MP*i -MN*j;
2132  ecld->vgsld[j][i]=0.;
2133 
2134  e0=0.;
2135  }else{
2136 // For these nuclei, we take "experimental" ground-state shell corrections
2137 //
2138 // Parametrization of CT model by Ignatyuk; note that E0 is shifted to correspond
2139 // to pairing shift in Fermi-gas model (there, energy is shifted taking odd-odd nuclei as bassis)
2140  G4double para=0.;
2141  parite(j+i,&para);
2142  if(para<0.0){
2143 // e-o, o-e
2144  e0 = 0.285+11.17*std::pow(j+i,-0.464) -0.390-0.00058*(j+i);
2145  }else{
2146  G4double parz=0.;
2147  parite(i,&parz);
2148  if (parz>0.0){
2149 // e-e
2150  e0 = 22.34*std::pow(j+i,-0.464)-0.235;
2151  }else{
2152 // o-o
2153  e0 = 0.0;
2154  }
2155  }
2156 //
2157  if((j==i)&&mod(j,2)==1&&mod(i,2)==1){
2158  e0 = e0 - 30.0*(1.0/G4double(j+i));
2159  }
2160 
2161  G4double delta_tot = ec2sub->ecnz[j][i] - ecld->vgsld[j][i];
2162  ec2sub->ecnz[j][i] = dataInterface->getMexp(j,i) - (mfrldm[j][i] - e0);
2163 
2164  ecld->vgsld[j][i] = max(0.0,ec2sub->ecnz[j][i] - delta_tot);
2165  ecld->ecgnz[j][i] = ec2sub->ecnz[j][i];
2166 
2167  }//if j
2168  }//if mexpiop
2169  }
2170  }
2171 //
2172  delete dataInterface;
2173 }
2174 
2176 {
2177  //A and Z for the target
2178  fiss->at = a;
2179  fiss->zt = z;
2180 
2181  // shell+pairing.0-1-2-3 for IMFs
2182  opt->optshpimf = 0;
2183 
2184  //collective enhancement switched on 1 or off 0 in densn (qr=val or =1.)
2185  fiss->optcol = 1;
2186  if(fiss->zt<83 && fiss->zt>56){
2187  fiss->optshp = 1;
2188  }
2189  if(fiss->zt<=56){
2190  fiss->optcol = 0;
2191  fiss->optshp = 3;
2192  }
2193 }
2194 
2196 {
2197 /*
2198 C IFIS = INTEGER SWITCH FOR FISSION
2199 C OPTSHP = INTEGER SWITCH FOR SHELL CORRECTION IN MASSES/ENERGY
2200 C =0 NO MICROSCOPIC CORRECTIONS IN MASSES AND ENERGY
2201 C =1 SHELL , NO PAIRING CORRECTION
2202 C =2 PAIRING, NO SHELL CORRECTION
2203 C =3 SHELL AND PAIRING CORRECTION IN MASSES AND ENERGY
2204 C OPTCOL =0,1 COLLECTIVE ENHANCEMENT SWITCHED ON 1 OR OFF 0 IN DENSN
2205 C OPTAFAN=0,1 SWITCH FOR AF/AN = 1 IN DENSNIV 0 AF/AN>1 1 AF/AN=1
2206 C BET = REAL REDUCED FRICTION COEFFICIENT / 10**(+21) S**(-1)
2207 C OPTXFIS= INTEGER 0,1,2 FOR MYERS & SWIATECKI, DAHLINGER, ANDREYEV
2208 C FISSILITY PARAMETER.
2209 C
2210 C NUCLEAR LEVEL DENSITIES:
2211 C AV = REAL KOEFFICIENTS FOR CALCULATION OF A(TILDE)
2212 C AS = REAL LEVEL DENSITY PARAMETER
2213 C AK = REAL
2214 */
2215 
2216  // switch-fission.1=on.0=off
2217  fiss->ifis = 1;
2218 
2219  // shell+pairing.0-1-2-3
2220  fiss->optshp = 3;
2221 
2222  // optemd =0,1 0 no emd, 1 incl. emd
2223  opt->optemd = 1;
2224  // read(10,*,iostat=io) dum(10),optcha
2225  opt->optcha = 1;
2226 
2227  // shell+pairing.0-1-2-3 for IMFs
2228  opt->optshpimf = 0;
2229  opt->optimfallowed = 1;
2230 
2231  // nuclear.viscosity.(beta)
2232  fiss->bet = 4.5;
2233 
2234  //collective enhancement parameters
2235  fiss->ucr = 40.;
2236  fiss->dcr = 10.;
2237 
2238  // switch for temperature constant model (CTM)
2239  fiss->optct = 1;
2240 
2241  ald->optafan = 0;
2242 
2243  ald->av = 0.0730;
2244  ald->as = 0.0950;
2245  ald->ak = 0.0000;
2246 
2247  fiss->optxfis = 3;
2248 
2249 // Multi-fragmentation
2250  T_freeze_out_in = -6.5;
2251 
2252 }
2253 
2255 {
2256  // MODEL DE LA GOUTTE LIQUIDE DE C. F. WEIZSACKER.
2257  // USUALLY AN OBSOLETE OPTION
2258 
2259  G4double xv = 0.0, xs = 0.0, xc = 0.0, xa = 0.0;
2260 
2261  if ((a <= 0.01) || (z < 0.01)) {
2262  (*el) = 1.0e38;
2263  }
2264  else {
2265  xv = -15.56*a;
2266  xs = 17.23*std::pow(a,(2.0/3.0));
2267 
2268  if (a > 1.0) {
2269  xc = 0.7*z*(z-1.0)*std::pow((a-1.0),(-1.e0/3.e0));
2270  }
2271  else {
2272  xc = 0.0;
2273  }
2274  }
2275 
2276  xa = 23.6*(std::pow((a-2.0*z),2)/a);
2277  (*el) = xv+xs+xc+xa;
2278  return;
2279 }
2280 
2282 {
2283  // USING FUNCTION EFLMAC(IA,IZ,0)
2284  //
2285  // REFOPT4 = 0 : WITHOUT MICROSCOPIC CORRECTIONS
2286  // REFOPT4 = 1 : WITH SHELL CORRECTION
2287  // REFOPT4 = 2 : WITH PAIRING CORRECTION
2288  // REFOPT4 = 3 : WITH SHELL- AND PAIRING CORRECTION
2289 
2290  // 1839 C-----------------------------------------------------------------------
2291  // 1840 C A1 LOCAL MASS NUMBER (INTEGER VARIABLE OF A)
2292  // 1841 C Z1 LOCAL NUCLEAR CHARGE (INTEGER VARIABLE OF Z)
2293  // 1842 C REFOPT4 OPTION, SPECIFYING THE MASS FORMULA (SEE ABOVE)
2294  // 1843 C A MASS NUMBER
2295  // 1844 C Z NUCLEAR CHARGE
2296  // 1845 C DEL PAIRING CORRECTION
2297  // 1846 C EL BINDING ENERGY
2298  // 1847 C ECNZ( , ) TABLE OF SHELL CORRECTIONS
2299  // 1848 C-----------------------------------------------------------------------
2300  // 1849 C
2301  G4int a1 = idnint(a);
2302  G4int z1 = idnint(z);
2303  G4int n1 = a1-z1;
2304 
2305  if ( (a1 <= 0) || (z1 <= 0) || ((a1-z1) <= 0) ) { //then
2306  // modif pour recuperer une masse p et n correcte:
2307  (*el) = 1.e38;
2308  return;
2309  // goto mglms50;
2310  }
2311  else {
2312  // binding energy incl. pairing contr. is calculated from
2313  // function eflmac
2314  (*el) = eflmac(a1,z1,0,refopt4);
2315 
2316  if (refopt4 > 0) {
2317  if (refopt4 != 2) {
2318  (*el) = (*el) + ec2sub->ecnz[a1-z1][z1];
2319  }
2320  }
2321 
2322  if(z1>=90){
2323  if(n1<=145){
2324  (*el) = (*el) + (12.552-0.1436*z1);
2325  }else{
2326  if(n1>145&&n1<=152){
2327  (*el) = (*el) + ((152.4-1.77*z1)+(-0.972+0.0113*z1)*n1);
2328  }
2329  }
2330  }
2331 
2332  }
2333  return;
2334 }
2335 
2337 {
2338 
2339  // INPUT: A,Z,OPTXFIS MASS AND CHARGE OF A NUCLEUS,
2340  // OPTION FOR FISSILITY
2341  // OUTPUT: SPDEF
2342 
2343  // ALPHA2 SADDLE POINT DEF. COHEN&SWIATECKI ANN.PHYS. 22 (1963) 406
2344  // RANGING FROM FISSILITY X=0.30 TO X=1.00 IN STEPS OF 0.02
2345 
2346  G4int index = 0;
2347  G4double x = 0.0, v = 0.0, dx = 0.0;
2348 
2349  const G4int alpha2Size = 37;
2350  // The value 0.0 at alpha2[0] added by PK.
2351  G4double alpha2[alpha2Size] = {0.0, 2.5464e0, 2.4944e0, 2.4410e0, 2.3915e0, 2.3482e0,
2352  2.3014e0, 2.2479e0, 2.1982e0, 2.1432e0, 2.0807e0, 2.0142e0, 1.9419e0,
2353  1.8714e0, 1.8010e0, 1.7272e0, 1.6473e0, 1.5601e0, 1.4526e0, 1.3164e0,
2354  1.1391e0, 0.9662e0, 0.8295e0, 0.7231e0, 0.6360e0, 0.5615e0, 0.4953e0,
2355  0.4354e0, 0.3799e0, 0.3274e0, 0.2779e0, 0.2298e0, 0.1827e0, 0.1373e0,
2356  0.0901e0, 0.0430e0, 0.0000e0};
2357 
2358  dx = 0.02;
2359  x = fissility(a,z,optxfis);
2360 
2361  v = (x - 0.3)/dx + 1.0;
2362  index = idnint(v);
2363 
2364  if (index < 1) {
2365  return(alpha2[1]);
2366  }
2367 
2368  if (index == 36) {
2369  return(alpha2[36]);
2370  }
2371  else {
2372  return(alpha2[index] + (alpha2[index+1] - alpha2[index]) / dx * ( x - (0.3e0 + dx*(index-1))));
2373  }
2374 
2375  return alpha2[0]; // The algorithm is not supposed to reach this point.
2376 }
2377 
2379 {
2380  // CALCULATION OF FISSILITY PARAMETER
2381  //
2382  // INPUT: A,Z INTEGER MASS & CHARGE OF NUCLEUS
2383  // OPTXFIS = 0 : MYERS, SWIATECKI
2384  // 1 : DAHLINGER
2385  // 2 : ANDREYEV
2386 
2387  G4double aa = 0.0, zz = 0.0, i = 0.0,z2a,C_S,R,W,G,G1,G2,A_CC;
2388  G4double fissilityResult = 0.0;
2389 
2390  aa = G4double(a);
2391  zz = G4double(z);
2392  i = G4double(a-2*z) / aa;
2393  z2a= zz*zz/aa;
2394 
2395  // myers & swiatecki droplet modell
2396  if (optxfis == 0) { //then
2397  fissilityResult = std::pow(zz,2) / aa /50.8830e0 / (1.0e0 - 1.7826e0 * std::pow(i,2));
2398  }
2399 
2400  if (optxfis == 1) {
2401  // dahlinger fit:
2402  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));
2403  }
2404 
2405  if (optxfis == 2) {
2406  // dubna fit:
2407  fissilityResult = std::pow(zz,2) / aa /(48.e0*(1.e0 - 17.22e0*std::pow(i,4)));
2408  }
2409 
2410  if (optxfis == 3) {
2411 // Fissiilty is calculated according to FRLDM, see Sierk, PRC 1984.
2412  C_S = 21.13 * (1.0 - 2.3*i*i);
2413  R = 1.16 * std::pow(aa,1.0/3.0);
2414  W = 0.704/R;
2415  G1 = 1.0 - 15.0/8.0*W+21.0/8.0*W*W*W;
2416  G2 = 1.0 + 9.0/2.0*W + 7.0*W*W + 7.0/2.0*W*W*W;
2417  G = 1.0 - 5.0*W*W*(G1 - 3.0/4.0*G2*std::exp(-2.0/W));
2418  A_CC = 3.0/5.0 * 1.44 * G / 1.16;
2419  fissilityResult = z2a * A_CC/(2.0*C_S);
2420  }
2421 
2422  if (fissilityResult > 1.0) {
2423  fissilityResult = 1.0;
2424  }
2425 
2426  if (fissilityResult < 0.0) {
2427  fissilityResult = 0.0;
2428  }
2429 
2430  return fissilityResult;
2431 }
2432 
2433 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,
2434 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][5],G4int *iev_tab_temp_par)
2435 {
2436  G4double zf = zprf;
2437  G4double af = aprf;
2438  G4double ee = (*ee_par);
2439  G4double jprf = dint(jprf_par);
2440  G4double mtota = (*mtota_par);
2441  G4double vleva = 0.;
2442  G4double vxeva = 0.;
2443  G4double vyeva = 0.;
2444  G4int ff = (*ff_par);
2445  G4int fimf = (*fimf_par);
2446  G4double tkeimf = (*tkeimf_par);
2447  G4int inttype = (*inttype_par);
2448  G4int inum = (*inum_par);
2449 
2450  // 533 C
2451  // 534 C INPUT:
2452  // 535 C
2453  // 536 C ZPRF, APRF, EE(EE IS MODIFIED!), JPRF
2454  // 537 C
2455  // 538 C PROJECTILE AND TARGET PARAMETERS + CROSS SECTIONS
2456  // 539 C COMMON /ABRAMAIN/ AP,ZP,AT,ZT,EAP,BETA,BMAXNUC,CRTOT,CRNUC,
2457  // 540 C R_0,R_P,R_T, IMAX,IRNDM,PI,
2458  // 541 C BFPRO,SNPRO,SPPRO,SHELL
2459  // 542 C
2460  // 543 C AP,ZP,AT,ZT - PROJECTILE AND TARGET MASSES
2461  // 544 C EAP,BETA - BEAM ENERGY PER NUCLEON, V/C
2462  // 545 C BMAXNUC - MAX. IMPACT PARAMETER FOR NUCL. REAC.
2463  // 546 C CRTOT,CRNUC - TOTAL AND NUCLEAR REACTION CROSS SECTION
2464  // 547 C R_0,R_P,R_T, - RADIUS PARAMETER, PROJECTILE+ TARGET RADII
2465  // 548 C IMAX,IRNDM,PI - MAXIMUM NUMBER OF EVENTS, DUMMY, 3.141...
2466  // 549 C BFPRO - FISSION BARRIER OF THE PROJECTILE
2467  // 550 C SNPRO - NEUTRON SEPARATION ENERGY OF THE PROJECTILE
2468  // 551 C SPPRO - PROTON " " " " "
2469  // 552 C SHELL - GROUND STATE SHELL CORRECTION
2470  // 553 C
2471  // 554 C---------------------------------------------------------------------
2472  // 555 C FISSION BARRIERS
2473  // 556 C COMMON /FB/ EFA
2474  // 557 C EFA - ARRAY OF FISSION BARRIERS
2475  // 558 C---------------------------------------------------------------------
2476  // 559 C OUTPUT:
2477  // 560 C ZF, AF, MTOTA, PLEVA, PTEVA, FF, INTTYPE, INUM
2478  // 561 C
2479  // 562 C ZF,AF - CHARGE AND MASS OF FINAL FRAGMENT AFTER EVAPORATION
2480  // 563 C MTOTA _ NUMBER OF EVAPORATED ALPHAS
2481  // 564 C PLEVA,PXEVA,PYEVA - MOMENTUM RECOIL BY EVAPORATION
2482  // 565 C INTTYPE - TYPE OF REACTION 0/1 NUCLEAR OR ELECTROMAGNETIC
2483  // 566 C FF - 0/1 NO FISSION / FISSION EVENT
2484  // 567 C INUM - EVENTNUMBER
2485  // 568 C ____________________________________________________________________
2486  // 569 C /
2487  // 570 C / CALCUL DE LA MASSE ET CHARGE FINALES D'UNE CHAINE D'EVAPORATION
2488  // 571 C /
2489  // 572 C / PROCEDURE FOR CALCULATING THE FINAL MASS AND CHARGE VALUES OF A
2490  // 573 C / SPECIFIC EVAPORATION CHAIN, STARTING POINT DEFINED BY (APRF, ZPRF,
2491  // 574 C / EE)
2492  // 575 C / On ajoute les 3 composantes de l'impulsion (PXEVA,PYEVA,PLEVA)
2493  // 576 C / (actuellement PTEVA n'est pas correct; mauvaise norme...)
2494  // 577 C /____________________________________________________________________
2495  // 578 C
2496  // 612 C
2497  // 613 C-----------------------------------------------------------------------
2498  // 614 C IRNDM DUMMY ARGUMENT FOR RANDOM-NUMBER FUNCTION
2499  // 615 C SORTIE LOCAL HELP VARIABLE TO END THE EVAPORATION CHAIN
2500  // 616 C ZF NUCLEAR CHARGE OF THE FRAGMENT
2501  // 617 C ZPRF NUCLEAR CHARGE OF THE PREFRAGMENT
2502  // 618 C AF MASS NUMBER OF THE FRAGMENT
2503  // 619 C APRF MASS NUMBER OF THE PREFRAGMENT
2504  // 620 C EPSILN ENERGY BURNED IN EACH EVAPORATION STEP
2505  // 621 C MALPHA LOCAL MASS CONTRIBUTION TO MTOTA IN EACH EVAPORATION
2506  // 622 C STEP
2507  // 623 C EE EXCITATION ENERGY (VARIABLE)
2508  // 624 C PROBP PROTON EMISSION PROBABILITY
2509  // 625 C PROBN NEUTRON EMISSION PROBABILITY
2510  // 626 C PROBA ALPHA-PARTICLE EMISSION PROBABILITY
2511  // 627 C PTOTL TOTAL EMISSION PROBABILITY
2512  // 628 C E LOWEST PARTICLE-THRESHOLD ENERGY
2513  // 629 C SN NEUTRON SEPARATION ENERGY
2514  // 630 C SBP PROTON SEPARATION ENERGY PLUS EFFECTIVE COULOMB
2515  // 631 C BARRIER
2516  // 632 C SBA ALPHA-PARTICLE SEPARATION ENERGY PLUS EFFECTIVE
2517  // 633 C COULOMB BARRIER
2518  // 634 C BP EFFECTIVE PROTON COULOMB BARRIER
2519  // 635 C BA EFFECTIVE ALPHA COULOMB BARRIER
2520  // 636 C MTOTA TOTAL MASS OF THE EVAPORATED ALPHA PARTICLES
2521  // 637 C X UNIFORM RANDOM NUMBER FOR NUCLEAR CHARGE
2522  // 638 C AMOINS LOCAL MASS NUMBER OF EVAPORATED PARTICLE
2523  // 639 C ZMOINS LOCAL NUCLEAR CHARGE OF EVAPORATED PARTICLE
2524  // 640 C ECP KINETIC ENERGY OF PROTON WITHOUT COULOMB
2525  // 641 C REPULSION
2526  // 642 C ECN KINETIC ENERGY OF NEUTRON
2527  // 643 C ECA KINETIC ENERGY OF ALPHA PARTICLE WITHOUT COULOMB
2528  // 644 C REPULSION
2529  // 645 C PLEVA TRANSVERSAL RECOIL MOMENTUM OF EVAPORATION
2530  // 646 C PTEVA LONGITUDINAL RECOIL MOMENTUM OF EVAPORATION
2531  // 647 C FF FISSION FLAG
2532  // 648 C INTTYPE INTERACTION TYPE FLAG
2533  // 649 C RNDX RECOIL MOMENTUM IN X-DIRECTION IN A SINGLE STEP
2534  // 650 C RNDY RECOIL MOMENTUM IN Y-DIRECTION IN A SINGLE STEP
2535  // 651 C RNDZ RECOIL MOMENTUM IN Z-DIRECTION IN A SINGLE STEP
2536  // 652 C RNDN NORMALIZATION OF RECOIL MOMENTUM FOR EACH STEP
2537  // 653 C-----------------------------------------------------------------------
2538  // 654 C
2539  //
2540  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, ptotl = 0.0, e = 0.0, tcn = 0.0;
2541  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;
2542  G4double ecn = 0.0, ecp = 0.0, ecd = 0.0, ect = 0.0,eche = 0.0,eca = 0.0, ecg = 0.0, bp = 0.0, bd = 0.0, bt = 0.0, bhe = 0.0, ba = 0.0;
2543  G4double zimf= 0.0,aimf= 0.0,bimf= 0.0,sbimf= 0.0,timf= 0.0;
2544  G4int itest = 0, sortie=0;
2545  G4double probf = 0.0;
2546  G4double ctet1 = 0.0, stet1 = 0.0, phi1 = 0.0;
2547  G4double rnd = 0.0;
2548  G4double ef = 0.0;
2549  G4double ts1 = 0.0;
2550  G4int fgamma = 0, gammadecay = 0;
2551  G4double pc = 0.0, malpha = 0.0;
2552  G4double jprfn=0.0, jprfp=0.0, jprfd=0.0, jprft=0.0, jprfhe=0.0, jprfa=0.0;
2553  G4double tsum = 0.0;
2554 
2555  const G4double c = 29.9792458;
2556  const G4double mu = 931.494;
2557  const G4double mu2 = 931.494*931.494;
2558 
2559  G4double pleva = 0.0;
2560  G4double pxeva = 0.0;
2561  G4double pyeva = 0.0;
2562  G4int IEV_TAB_TEMP=0;
2563 
2564  for(G4int I1=0;I1<200;I1++)
2565  for(G4int I2=0;I2<5;I2++)
2566  EV_TEMP[I1][I2] = 0.0;
2567 //
2568  ff = 0;
2569  itest = 0;
2570 //
2571  evapora10:
2572  //
2573  // calculation of the probabilities for the different decay channels
2574  // plus separation energies and kinetic energies of the particles
2575  //
2576  if(ee<0.|| zf<3.)goto evapora100;
2577  direct(zf,af,ee,jprf,&probp,&probd,&probt,&probn,&probhe,&proba,&probg,&probimf,&probf,&ptotl,
2578  &sn,&sbp,&sbd,&sbt,&sbhe,&sba,
2579  &ecn,&ecp,&ecd,&ect,&eche,&eca,&ecg,
2580  &bp,&bd,&bt,&bhe,&ba,&sp,&sd,&st,&she,&sa,&ef,&ts1,inttype,inum,itest,&sortie,&tcn,
2581  &jprfn, &jprfp, &jprfd, &jprft, &jprfhe, &jprfa, &tsum);
2582 //
2583 // HERE THE FINAL STEPS OF THE EVAPORATION ARE CALCULATED
2584 //
2585  if(ptotl==0.0) goto evapora100;
2586 
2587  e = dmin1(sba,sbhe,dmin1(sbt,sbhe,dmin1(sn,sbp,sbd)));
2588 
2589  if(e>1e30)std::cout << "ERROR AT THE EXIT OF EVAPORA,E>1.D30,AF="<< af << " ZF=" << zf << std::endl;
2590 
2591  if(sortie==1){
2592  if (probn!=0.0) {
2593  amoins = 1.0;
2594  zmoins = 0.0;
2595  epsiln = sn + ecn;
2596  pc = std::sqrt(std::pow((1.0 + (ecn)/9.3956e2),2.) - 1.0) * 9.3956e2;
2597  malpha = 0.0;
2598  fgamma = 0;
2599  fimf = 0;
2600  gammadecay = 0;
2601  }
2602  else if(probp!=0.0){
2603  amoins = 1.0;
2604  zmoins = 1.0;
2605  epsiln = sp + ecp;
2606  pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2.) - 1.0) * 9.3827e2;
2607  malpha = 0.0;
2608  fgamma = 0;
2609  fimf = 0;
2610  gammadecay = 0;
2611  }
2612  else if(probd!=0.0){
2613  amoins = 2.0;
2614  zmoins = 1.0;
2615  epsiln = sd + ecd;
2616  pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
2617  malpha = 0.0;
2618  fgamma = 0;
2619  fimf = 0;
2620  gammadecay = 0;
2621  }
2622  else if(probt!=0.0){
2623  amoins = 3.0;
2624  zmoins = 1.0;
2625  epsiln = st + ect;
2626  pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
2627  malpha = 0.0;
2628  fgamma = 0;
2629  fimf = 0;
2630  gammadecay = 0;
2631  }
2632  else if(probhe!=0.0){
2633  amoins = 3.0;
2634  zmoins = 2.0;
2635  epsiln = she + eche;
2636  pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
2637  malpha = 0.0;
2638  fgamma = 0;
2639  fimf = 0;
2640  gammadecay = 0;
2641  }
2642  else{ if(proba!=0.0){
2643  amoins = 4.0;
2644  zmoins = 2.0;
2645  epsiln = sa + eca;
2646  pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
2647  malpha = 4.0;
2648  fgamma = 0;
2649  fimf = 0;
2650  gammadecay = 0;
2651  }
2652  }
2653  goto direct99;
2654  }
2655 
2656  // here the normal evaporation cascade starts
2657 
2658  // random number for the evaporation
2659  x = G4AblaRandom::flat() * ptotl;
2660 
2661  itest = 0;
2662  if (x < proba) {
2663  // alpha evaporation
2664  amoins = 4.0;
2665  zmoins = 2.0;
2666  epsiln = sa + eca;
2667  pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
2668  malpha = 4.0;
2669  fgamma = 0;
2670  fimf = 0;
2671  ff = 0;
2672  gammadecay = 0;
2673  jprf=jprfa;
2674  }
2675  else if (x < proba+probhe) {
2676  // He3 evaporation
2677  amoins = 3.0;
2678  zmoins = 2.0;
2679  epsiln = she + eche;
2680  pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
2681  malpha = 0.0;
2682  fgamma = 0;
2683  fimf = 0;
2684  ff = 0;
2685  gammadecay = 0;
2686  jprf=jprfhe;
2687  }
2688  else if (x < proba+probhe+probt) {
2689  // triton evaporation
2690  amoins = 3.0;
2691  zmoins = 1.0;
2692  epsiln = st + ect;
2693  pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
2694  malpha = 0.0;
2695  fgamma = 0;
2696  fimf = 0;
2697  ff = 0;
2698  gammadecay = 0;
2699  jprf=jprft;
2700  }
2701  else if (x < proba+probhe+probt+probd) {
2702  // deuteron evaporation
2703  amoins = 2.0;
2704  zmoins = 1.0;
2705  epsiln = sd + ecd;
2706  pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
2707  malpha = 0.0;
2708  fgamma = 0;
2709  fimf = 0;
2710  ff = 0;
2711  gammadecay = 0;
2712  jprf=jprfd;
2713  }
2714  else if (x < proba+probhe+probt+probd+probp) {
2715  // proton evaporation
2716  amoins = 1.0;
2717  zmoins = 1.0;
2718  epsiln = sp + ecp;
2719  pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2) - 1.0) * 9.3827e2;
2720  malpha = 0.0;
2721  fgamma = 0;
2722  fimf = 0;
2723  ff = 0;
2724  gammadecay = 0;
2725  jprf=jprfp;
2726  }
2727  else if (x < proba+probhe+probt+probd+probp+probn) {
2728  // neutron evaporation
2729  amoins = 1.0;
2730  zmoins = 0.0;
2731  epsiln = sn + ecn;
2732  pc = std::sqrt(std::pow((1.0 + (ecn)/9.3956e2),2.) - 1.0) * 9.3956e2;
2733  malpha = 0.0;
2734  fgamma = 0;
2735  fimf = 0;
2736  ff = 0;
2737  gammadecay = 0;
2738  jprf=jprfn;
2739  }
2740  else if (x < proba+probhe+probt+probd+probp+probn+probg) {
2741  // gamma evaporation
2742  amoins = 0.0;
2743  zmoins = 0.0;
2744  epsiln = ecg;
2745  pc = ecg;
2746  malpha = 0.0;
2747  gammadecay = 1;
2748  //Next IF command is to shorten the calculations when gamma-emission is the only
2749  //possible channel
2750  if(probp==0.0 && probn==0.0 && probd==0.0 && probt==0.0 && proba==0.0 && probhe==0.0 && probimf==0.0 && probf==0.0)fgamma = 1;
2751  fimf = 0;
2752  ff = 0;
2753  }
2754 //
2755  else if (x < proba+probhe+probt+probd+probp+probn+probg+probimf) {
2756  // imf evaporation
2757 // AIMF and ZIMF obtained from complete procedure (integration over all
2758 // possible Gamma(IMF) and then randomly picked
2759 
2760  G4int iloop=0;
2761  dir1973:
2762  imf(af,zf,tcn,ee,&zimf,&aimf,&bimf,&sbimf,&timf,jprf);
2763  iloop++;
2764  if(iloop>100)std::cout << "Problem in EVAPORA: IMF called > 100 times" << std::endl;
2765  if(zimf>=(zf-2.0)) goto dir1973;
2766  if(zimf>zf/2.0){
2767  zimf = zf - zimf;
2768  aimf = af - aimf;
2769  }
2770  // These cases should in principle never happen
2771  if(zimf==0.0 || aimf==0.0 || sbimf>ee)std::cout << "warning: Look in EVAPORA CALL IMF" << std::endl;
2772 
2773 // I sample the total kinetic energy consumed by the system of two nuclei
2774 // from the distribution determined with the temperature at saddle point
2775 // TKEIMF is the kinetic energy in the centre of mass of IMF and its partner
2776 
2777  G4int ii=0;
2778  dir1235:
2779  tkeimf= fmaxhaz(timf);
2780  ii++;
2781  if(ii>100){
2782  tkeimf=min(2.0*timf,ee-sbimf);
2783  goto dir1000;
2784  }
2785  if(tkeimf<=0.0)goto dir1235;
2786  if(tkeimf>(ee-sbimf) && timf>0.5)goto dir1235;
2787  dir1000:
2788  tkeimf = tkeimf + bimf;
2789 
2790  amoins = aimf;
2791  zmoins = zimf;
2792  epsiln = (sbimf-bimf) + tkeimf;
2793  pc = 0.0;
2794  malpha = 0.0;
2795  fgamma = 0;
2796  fimf = 1;
2797  ff = 0;
2798  gammadecay = 0;
2799  }
2800  else {
2801  // fission
2802  // in case of fission-events the fragment nucleus is the mother nucleus
2803  // before fission occurs with excitation energy above the fis.- barrier.
2804  // fission fragment mass distribution is calulated in subroutine fisdis
2805 
2806  amoins = 0.0;
2807  zmoins = 0.0;
2808  epsiln = ef;
2809 //
2810  malpha = 0.0;
2811  pc = 0.0;
2812  ff = 1;
2813  fimf = 0;
2814  fgamma = 0;
2815  gammadecay = 0;
2816  }
2817 //
2818  direct99:
2819  if (ee <= 0.01)ee = 0.01;
2820 // Davide Mancusi (DM) - 2010
2821  if(gammadecay==1 && ee<(epsiln+0.010)){
2822  epsiln = ee - 0.010;
2823  // fgamma = 1;
2824  }
2825 
2826  if(epsiln<0.0){
2827  std::cout << "***WARNING epsilon<0***" << std::endl;
2828  //epsiln=0.;
2829  //PRINT*,IDECAYMODE,IDNINT(AF),IDNINT(ZF),EE,EPSILN
2830  }
2831  // calculation of the daughter nucleus
2832  af = af - amoins;
2833  zf = zf - zmoins;
2834  ee = ee - epsiln;
2835  if (ee <= 0.01)ee = 0.01;
2836  mtota = mtota + malpha;
2837 
2838 // Determination of x,y,z components of momentum from known emission momentum PC
2839  if(ff==0 && fimf==0){
2840  //
2841  EV_TEMP[IEV_TAB_TEMP][0] = zmoins;
2842  EV_TEMP[IEV_TAB_TEMP][1] = amoins;
2843  rnd = G4AblaRandom::flat();
2844  ctet1 = 2.0*rnd - 1.0; // z component: uniform probability between -1 and 1
2845  stet1 = std::sqrt(1.0 - std::pow(ctet1,2)); // component perpendicular to z
2846  rnd = G4AblaRandom::flat();
2847  phi1 = rnd*2.0*3.141592654; // angle in x-y plane: uniform probability between 0 and 2*pi
2848  G4double xcv = stet1*std::cos(phi1);// x component
2849  G4double ycv = stet1*std::sin(phi1);// y component
2850  G4double zcv = ctet1; // z component
2851 // In the CM system
2852  if(gammadecay==0){
2853 // Light particle
2854  G4double ETOT_LP = std::sqrt(pc*pc + amoins*amoins * mu2);
2855  EV_TEMP[IEV_TAB_TEMP][2] = c * pc * xcv / ETOT_LP;
2856  EV_TEMP[IEV_TAB_TEMP][3] = c * pc * ycv / ETOT_LP;
2857  EV_TEMP[IEV_TAB_TEMP][4] = c * pc * zcv / ETOT_LP;
2858  }else{
2859 // gamma ray
2860  EV_TEMP[IEV_TAB_TEMP][2] = pc * xcv;
2861  EV_TEMP[IEV_TAB_TEMP][3] = pc * ycv;
2862  EV_TEMP[IEV_TAB_TEMP][4] = pc * zcv;
2863  }
2864  G4double VXOUT=0.,VYOUT=0.,VZOUT=0.;
2865  lorentz_boost(vxeva,vyeva,vleva,
2866  EV_TEMP[IEV_TAB_TEMP][2],EV_TEMP[IEV_TAB_TEMP][3],
2867  EV_TEMP[IEV_TAB_TEMP][4],
2868  &VXOUT,&VYOUT,&VZOUT);
2869  EV_TEMP[IEV_TAB_TEMP][2] = VXOUT;
2870  EV_TEMP[IEV_TAB_TEMP][3] = VYOUT;
2871  EV_TEMP[IEV_TAB_TEMP][4] = VZOUT;
2872 // Heavy residue
2873  if(gammadecay==0){
2874  G4double v2 = std::pow(EV_TEMP[IEV_TAB_TEMP][2],2.) +
2875  std::pow(EV_TEMP[IEV_TAB_TEMP][3],2.) +
2876  std::pow(EV_TEMP[IEV_TAB_TEMP][4],2.);
2877  G4double gamma = 1.0/std::sqrt(1.0 - v2 / (c*c));
2878  G4double etot_lp = amoins*mu * gamma;
2879  pxeva = pxeva - EV_TEMP[IEV_TAB_TEMP][2] * etot_lp / c;
2880  pyeva = pyeva - EV_TEMP[IEV_TAB_TEMP][3] * etot_lp / c;
2881  pleva = pleva - EV_TEMP[IEV_TAB_TEMP][4] * etot_lp / c;
2882  }else{
2883 // in case of gammas, EV_TEMP contains momentum components and not velocity
2884  pxeva = pxeva - EV_TEMP[IEV_TAB_TEMP][2];
2885  pyeva = pyeva - EV_TEMP[IEV_TAB_TEMP][3];
2886  pleva = pleva - EV_TEMP[IEV_TAB_TEMP][4];
2887  }
2888  G4double pteva = std::sqrt(pxeva*pxeva + pyeva*pyeva);
2889 // To be checked:
2890  G4double etot = std::sqrt ( pleva*pleva + pteva*pteva + af*af * mu2 );
2891  vxeva = c * pxeva / etot; // recoil velocity components of residue due to evaporation
2892  vyeva = c * pyeva / etot;
2893  vleva = c * pleva / etot;
2894  IEV_TAB_TEMP = IEV_TAB_TEMP + 1;
2895  }
2896  // condition for end of evaporation
2897  if (zf < 3. || (ff == 1) || (fgamma == 1) || (fimf==1)) {
2898  goto evapora100;
2899  }
2900  goto evapora10;
2901 
2902  evapora100:
2903  (*zf_par) = zf;
2904  (*af_par) = af;
2905  (*ee_par) = ee;
2906  (*faimf) = aimf;
2907  (*fzimf) = zimf;
2908  (*jprfout) = jprf;
2909  (*tkeimf_par) = tkeimf;
2910  (*mtota_par) = mtota;
2911  (*vleva_par) = vleva;
2912  (*vxeva_par) = vxeva;
2913  (*vyeva_par) = vyeva;
2914  (*ff_par) = ff;
2915  (*fimf_par) = fimf;
2916  (*inttype_par) = inttype;
2917  (*iev_tab_temp_par)= IEV_TAB_TEMP;
2918  (*inum_par) = inum;
2919  return;
2920 }
2921 
2922 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 *ptotl_par, G4double *sn_par, G4double *sbp_par, G4double *sbd_par, G4double *sbt_par, G4double *sbhe_par, G4double *sba_par, G4double *ecn_par, G4double *ecp_par, G4double *ecd_par, G4double *ect_par,G4double *eche_par,G4double *eca_par, G4double *ecg_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 *tsum_par)
2923 {
2924  G4double probp = (*probp_par);
2925  G4double probd = (*probd_par);
2926  G4double probt = (*probt_par);
2927  G4double probn = (*probn_par);
2928  G4double probhe = (*probhe_par);
2929  G4double proba = (*proba_par);
2930  G4double probg = (*probg_par);
2931  G4double probimf = (*probimf_par);
2932  G4double probf = (*probf_par);
2933  G4double ptotl = (*ptotl_par);
2934  G4double sn = (*sn_par);
2935  G4double sp = (*sp_par);
2936  G4double sd = (*sd_par);
2937  G4double st = (*st_par);
2938  G4double she = (*she_par);
2939  G4double sa = (*sa_par);
2940  G4double sbp = (*sbp_par);
2941  G4double sbd = (*sbd_par);
2942  G4double sbt = (*sbt_par);
2943  G4double sbhe = (*sbhe_par);
2944  G4double sba = (*sba_par);
2945  G4double ecn = (*ecn_par);
2946  G4double ecp = (*ecp_par);
2947  G4double ecd = (*ecd_par);
2948  G4double ect = (*ect_par);
2949  G4double eche = (*eche_par);
2950  G4double eca = (*eca_par);
2951  G4double ecg = (*ecg_par);
2952  G4double bp = (*bp_par);
2953  G4double bd = (*bd_par);
2954  G4double bt = (*bt_par);
2955  G4double bhe = (*bhe_par);
2956  G4double ba = (*ba_par);
2957  G4double tsum = (*tsum_par);
2958 
2959  // CALCULATION OF PARTICLE-EMISSION PROBABILITIES & FISSION /
2960  // BASED ON THE SIMPLIFIED FORMULAS FOR THE DECAY WIDTH BY /
2961  // MORETTO, ROCHESTER MEETING TO AVOID COMPUTING TIME /
2962  // INTENSIVE INTEGRATION OF THE LEVEL DENSITIES /
2963  // USES EFFECTIVE COULOMB BARRIERS AND AN AVERAGE KINETIC ENERGY/
2964  // OF THE EVAPORATED PARTICLES /
2965  // COLLECTIVE ENHANCMENT OF THE LEVEL DENSITY IS INCLUDED /
2966  // DYNAMICAL HINDRANCE OF FISSION IS INCLUDED BY A STEP FUNCTION/
2967  // APPROXIMATION. SEE A.R. JUNGHANS DIPLOMA THESIS /
2968  // SHELL AND PAIRING STRUCTURES IN THE LEVEL DENSITY IS INCLUDED/
2969 
2970  // INPUT:
2971  // ZPRF,A,EE CHARGE, MASS, EXCITATION ENERGY OF COMPOUND
2972  // NUCLEUS
2973  // JPRF ROOT-MEAN-SQUARED ANGULAR MOMENTUM
2974 
2975  // DEFORMATIONS AND G.S. SHELL EFFECTS
2976  // COMMON /ECLD/ ECGNZ,ECFNZ,VGSLD,ALPHA
2977 
2978  // ECGNZ - GROUND STATE SHELL CORR. FRLDM FOR A SPHERICAL G.S.
2979  // ECFNZ - SHELL CORRECTION FOR THE SADDLE POINT (NOW: == 0)
2980  // VGSLD - DIFFERENCE BETWEEN DEFORMED G.S. AND LDM VALUE
2981  // ALPHA - ALPHA GROUND STATE DEFORMATION (THIS IS NOT BETA2!)
2982  // BETA2 = SQRT((4PI)/5) * ALPHA
2983 
2984  //OPTIONS AND PARAMETERS FOR FISSION CHANNEL
2985  //COMMON /FISS/ AKAP,BET,HOMEGA,KOEFF,IFIS,
2986  // OPTSHP,OPTXFIS,OPTLES,OPTCOL
2987  //
2988  // AKAP - HBAR**2/(2* MN * R_0**2) = 10 MEV, R_0 = 1.4 FM
2989  // BET - REDUCED NUCLEAR FRICTION COEFFICIENT IN (10**21 S**-1)
2990  // HOMEGA - CURVATURE OF THE FISSION BARRIER = 1 MEV
2991  // KOEFF - COEFFICIENT FOR THE LD FISSION BARRIER == 1.0
2992  // IFIS - 0/1 FISSION CHANNEL OFF/ON
2993  // OPTSHP - INTEGER SWITCH FOR SHELL CORRECTION IN MASSES/ENERGY
2994  // = 0 NO MICROSCOPIC CORRECTIONS IN MASSES AND ENERGY
2995  // = 1 SHELL , NO PAIRING
2996  // = 2 PAIRING, NO SHELL
2997  // = 3 SHELL AND PAIRING
2998  // OPTCOL - 0/1 COLLECTIVE ENHANCEMENT SWITCHED ON/OFF
2999  // OPTXFIS- 0,1,2 FOR MYERS & SWIATECKI, DAHLINGER, ANDREYEV
3000  // FISSILITY PARAMETER.
3001  // OPTLES - CONSTANT TEMPERATURE LEVEL DENSITY FOR A,Z > TH-224
3002  // OPTCOL - 0/1 COLLECTIVE ENHANCEMENT OFF/ON
3003 
3004  // LEVEL DENSITY PARAMETERS
3005  // COMMON /ALD/ AV,AS,AK,OPTAFAN
3006  // AV,AS,AK - VOLUME,SURFACE,CURVATURE DEPENDENCE OF THE
3007  // LEVEL DENSITY PARAMETER
3008  // OPTAFAN - 0/1 AF/AN >=1 OR AF/AN ==1
3009  // RECOMMENDED IS OPTAFAN = 0
3010 
3011  // FISSION BARRIERS
3012  // COMMON /FB/ EFA
3013  // EFA - ARRAY OF FISSION BARRIERS
3014 
3015 
3016  // OUTPUT: PROBN,PROBP,PROBA,PROBF,PTOTL:
3017  // - EMISSION PROBABILITIES FOR N EUTRON, P ROTON, A LPHA
3018  // PARTICLES, F ISSION AND NORMALISATION
3019  // SN,SBP,SBA: SEPARATION ENERGIES N P A
3020  // INCLUDING EFFECTIVE BARRIERS
3021  // ECN,ECP,ECA,BP,BA
3022  // - AVERAGE KINETIC ENERGIES (2*T) AND EFFECTIVE BARRIERS
3023 
3024  G4double bk = 0.0;
3025  G4double bksp = 0.0;
3026  G4double bc = 0.0;
3027  G4int afp = 0;
3028  G4double het = 0.0;
3029  G4double at = 0.0;
3030  G4double bs = 0.0;
3031  G4double bssp = 0.0;
3032  G4double bshell = 0.0;
3033  G4double cf = 0.0;
3034  G4double defbet = 0.0;
3035  G4double densa = 0.0;
3036  G4double denshe = 0.0;
3037  G4double densg = 0.0;
3038  G4double densn = 0.0;
3039  G4double densp = 0.0;
3040  G4double densd = 0.0;
3041  G4double denst = 0.0;
3042  G4double eer = 0.0;
3043  G4double ecor = 0.0;
3044  G4double ef = 0.0;
3045  G4double ft = 0.0;
3046  G4double timf = 0.0;
3047  G4double qr = 0.0;
3048  G4double qrcn = 0.0;
3049  G4double omegap=0.0;
3050  G4double omegad=0.0;
3051  G4double omegat=0.0;
3052  G4double omegahe=0.0;
3053  G4double omegaa=0.0;
3054  G4double ga = 0.0;
3055  G4double ghe = 0.0;
3056  G4double gf = 0.0;
3057  G4double gff = 0.0;
3058  G4double gn = 0.0;
3059  G4double gp = 0.0;
3060  G4double gd = 0.0;
3061  G4double gt = 0.0;
3062  G4double gg = 0.0;
3063  G4double gimf = 0.0;
3064  G4double gimf3 = 0.0;
3065  G4double gimf5 = 0.0;
3066  G4double bimf = 0.0;
3067  G4double bsimf = 0.0;
3068  G4double sbimf = 0.0;
3069  G4double densimf = 0.0;
3070  G4double defbetimf = 0.0;
3071  G4double b_imf = 0.0;
3072  G4double a_imf = 0.0;
3073  G4double omegaimf = 0.0;
3074  G4int izimf = 0;
3075  G4double zimf = 0.0;
3076  G4double gsum = 0.0;
3077  G4double gtotal=0.0;
3078  G4double hbar = 6.582122e-22;
3079  G4double emin = 0.0;
3080  G4int il = 0;
3081  G4int choice_fisspart = 0;
3082  G4double t_lapse=0.0;
3083  G4int imaxwell = 0;
3084  G4int in = 0;
3085  G4int iz = 0;
3086  G4int ind = 0;
3087  G4int izd = 0;
3088  G4int j = 0;
3089  G4int k = 0;
3090  G4double ma1z = 0.0;
3091  G4double mazz = 0.0;
3092  G4double ma1z1 = 0.0;
3093  G4double ma2z1 = 0.0;
3094  G4double ma3z1 = 0.0;
3095  G4double ma3z2 = 0.0;
3096  G4double ma4z2 = 0.0;
3097  G4double maz = 0.0;
3098  G4double nt = 0.0;
3099  G4double pi = 3.1415926535;
3100  G4double pt = 0.0;
3101  G4double dt = 0.0;
3102  G4double tt = 0.0;
3103  G4double gtemp = 0.0;
3104  G4double rdt = 0.0;
3105  G4double rtt = 0.0;
3106  G4double rat = 0.0;
3107  G4double rhet = 0.0;
3108  G4double refmod = 0.0;
3109  G4double rnt = 0.0;
3110  G4double rpt = 0.0;
3111  G4double sbfis = 1.e40;
3112  G4double segs = 0.0;
3113  G4double selmax = 0.0;
3114  G4double tauc = 0.0;
3115  G4double temp = 0.0;
3116  G4double ts1 = 0.0;
3117  G4double xx = 0.0;
3118  G4double y = 0.0;
3119  G4double k1 = 0.0;
3120  G4double omegasp=0.0;
3121  G4double homegasp=0.0;
3122  G4double omegags=0.0;
3123  G4double homegags=0.0;
3124  G4double pa = 0.0;
3125  G4double gamma = 0.0;
3126  G4double gfactor = 0.0;
3127  G4double bscn;
3128  G4double bkcn;
3129  G4double bccn;
3130  G4double ftcn=0.0;
3131  G4double mfcd;
3132  G4double jprfn=jprf;
3133  G4double jprfp=jprf;
3134  G4double jprfd=jprf;
3135  G4double jprft=jprf;
3136  G4double jprfhe=jprf;
3137  G4double jprfa=jprf;
3138  G4double djprf=0.0;
3139  G4double dlout=0.0;
3140  G4double sdlout=0.0;
3141  G4double iinert=0.0;
3142  G4double erot=0.0;
3143  G4double erotn=0.0;
3144  G4double erotp=0.0;
3145  G4double erotd=0.0;
3146  G4double erott=0.0;
3147  G4double erothe=0.0;
3148  G4double erota=0.0;
3149  G4double erotcn=0.0;
3150  // G4double ecorcn=0.0;
3151  G4double imfarg=0.0;
3152  G4double width_imf=0.0;
3153  G4int IDjprf=0;
3154  G4int fimf_allowed=opt->optimfallowed;
3155 
3156  if(itest==1){
3157 
3158  }
3159  // Switch to calculate Maxwellian distribution of kinetic energies
3160  imaxwell = 1;
3161  *sortie = 0;
3162 
3163  // just a change of name until the end of this subroutine
3164  eer = ee;
3165  if (inum == 1) {
3166  ilast = 1;
3167  }
3168  // calculation of masses
3169  // refmod = 1 ==> myers,swiatecki model
3170  // refmod = 0 ==> weizsaecker model
3171  refmod = 1; // Default = 1
3172 //
3173  if (refmod == 1) {
3174  mglms(a,zprf,fiss->optshp,&maz);
3175  mglms(a-1.0,zprf,fiss->optshp,&ma1z);
3176  mglms(a-1.0,zprf-1.0,fiss->optshp,&ma1z1);
3177  mglms(a-2.0,zprf-1.0,fiss->optshp,&ma2z1);
3178  mglms(a-3.0,zprf-1.0,fiss->optshp,&ma3z1);
3179  mglms(a-3.0,zprf-2.0,fiss->optshp,&ma3z2);
3180  mglms(a-4.0,zprf-2.0,fiss->optshp,&ma4z2);
3181  }
3182  else {
3183  mglw(a,zprf,&maz);
3184  mglw(a-1.0,zprf,&ma1z);
3185  mglw(a-1.0,zprf-1.0,&ma1z1);
3186  mglw(a-2.0,zprf-1.0,&ma2z1);
3187  mglw(a-3.0,zprf-1.0,&ma3z1);
3188  mglw(a-3.0,zprf-2.0,&ma3z2);
3189  mglw(a-4.0,zprf-2.0,&ma4z2);
3190  }
3191 
3192  if((a-1.)==3.0 && (zprf-1.0)==2.0) ma1z1=-7.7181660;
3193  if((a-1.)==4.0 && (zprf-1.0)==2.0) ma1z1=-28.295992;
3194 
3195  // separation energies
3196  sn = ma1z - maz;
3197  sp = ma1z1 - maz;
3198  sd = ma2z1 - maz - 2.2246;
3199  st = ma3z1 - maz - 8.481977;
3200  she = ma3z2 - maz - 7.7181660;
3201  sa = ma4z2 - maz - 28.295992;
3202 
3203 // coulomb barriers
3204 //Proton
3205  if (zprf <= 1.0e0 || a <= 1.0e0 || (a-zprf) < 0.0) {
3206  sbp = 1.0e75;
3207  bp = 1.0e75;
3208  }else{
3209  barrs(idnint(zprf-1.),idnint(a-1.),1,1,&bp,&omegap);
3210  bp = max(bp,0.1);
3211  sbp = sp + bp;
3212  }
3213 
3214 //Deuteron
3215  if (zprf <= 1.0e0 || a <= 2.0e0 || (a-zprf) < 1.0) {
3216  sbd = 1.0e75;
3217  bd = 1.0e75;
3218  }else{
3219  barrs(idnint(zprf-1.),idnint(a-2.),1,2,&bd,&omegad);
3220  bd = max(bd,0.1);
3221  sbd = sd + bd;
3222  }
3223 
3224 //Triton
3225  if (zprf <= 1.0e0 || a <= 3.0e0 || (a-zprf) < 2.0) {
3226  sbt = 1.0e75;
3227  bt = 1.0e75;
3228  }else{
3229  barrs(idnint(zprf-1.),idnint(a-3.),1,3,&bt,&omegat);
3230  bt = max(bt,0.1);
3231  sbt = st + bt;
3232  }
3233 
3234 //Alpha
3235  if (a-4.0<=0.0 || zprf<=2.0 || (a-zprf)<2.0) {
3236  sba = 1.0e+75;
3237  ba = 1.0e+75;
3238  }else{
3239  barrs(idnint(zprf-2.),idnint(a-4.),2,4,&ba,&omegaa);
3240  ba = max(ba,0.1);
3241  sba = sa + ba;
3242  }
3243 
3244 //He3
3245  if (a-3.0 <= 0.0 || zprf<=2.0 || (a-zprf)<1.0) {
3246  sbhe = 1.0e+75;
3247  bhe = 1.0e+75;
3248  }else{
3249  barrs(idnint(zprf-2.),idnint(a-3.),2,3,&bhe,&omegahe);
3250  bhe = max(bhe,0.1);
3251  sbhe = she + bhe;
3252  }
3253 
3254 // Dealing with particle-unbound systems
3255  emin = dmin1(sba,sbhe,dmin1(sbt,sbhe,dmin1(sn,sbp,sbd)));
3256 
3257  if(emin<=0.0){
3258  *sortie = 1;
3259  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);
3260  goto direct70;
3261  }
3262 //
3263  k = idnint(zprf);
3264  j = idnint(a - zprf);
3265  if (fiss->ifis > 0) {
3266  // now ef is calculated from efa that depends on the subroutine
3267  // barfit which takes into account the modification on the ang. mom.
3268  // note *** shell correction (ecgnz)
3269  il = idnint(jprf);
3270  barfit(k,k+j,il,&sbfis,&segs,&selmax);
3271  if ((fiss->optshp == 1) || (fiss->optshp == 3)) {
3272  ef = double(sbfis) - ecld->ecgnz[j][k];
3273 // JLRS - Nov 2016 - Corrected values of fission barriers for actinides
3274  if(k==90){
3275  if(mod(j,2)==1){
3276  ef = ef*(4.5114-2.2687*(a-zprf)/zprf);
3277  }else{
3278  ef = ef*(3.3931-1.5338*(a-zprf)/zprf);
3279  }
3280  }
3281  if(k==92){
3282  if((a-zprf)/zprf>1.52)ef=ef*(1.1222-0.10886*(a-zprf)/zprf)-0.1;
3283  }
3284  if(k>=94&&k<=98&&j<158){// Data in this range have been tested
3285 // e-e
3286  if(mod(j,2)==0&&mod(k,2)==0){
3287  if(k>=94){ef = ef-(11.54108*(a-zprf)/zprf-18.074);}
3288  }
3289 // O-O
3290  if(mod(j,2)==1&&mod(k,2)==1){
3291  if(k>=95){ef = ef-(14.567*(a-zprf)/zprf-23.266);}
3292  }
3293 // Odd A
3294  if(mod(j,2)==0&&mod(k,2)==1){
3295  if(j>=144){ef = ef-(13.662*(a-zprf)/zprf-21.656);}
3296  }
3297 
3298  if(mod(j,2)==1&&mod(k,2)==0){
3299  if(j>=144){ef = ef-(13.662*(a-zprf)/zprf-21.656);}
3300  }
3301  }
3302  }
3303  else {
3304  ef = double(sbfis);
3305  }
3306 //
3307 // TO AVOID NEGATIVE VALUES FOR IMPOSSIBLE NUCLEI
3308 // THE FISSION BARRIER IS SET TO ZERO IF SMALLER THAN ZERO.
3309 //
3310  if (ef < 0.0)ef = 0.0;
3311  fb->efa[j][k]=ef;
3312  (*ef_par) = ef;
3313 
3314  // calculation of surface and curvature integrals needed to
3315  // to calculate the level density parameter at the saddle point
3316  xx = fissility((k+j),k,fiss->optxfis);
3317  y = 1.00 - xx;
3318  if(y<0.0) y = 0.0;
3319  if(y>1.0) y = 1.0;
3320  bssp = bipol(1,y);
3321  bksp = bipol(2,y);
3322  }
3323  else {
3324  ef = 1.0e40;
3325  sbfis = 1.0e40;
3326  bssp = 1.0;
3327  bksp = 1.0;
3328  }
3329 
3330 //
3331 // COMPOUND NUCLEUS LEVEL DENSITY
3332 //
3333 // AK 2007 - Now DENSNIV called with correct BS, BK
3334 
3335  afp = idnint(a);
3336  iz = idnint(zprf);
3337  in = afp - iz;
3338  bshell = ecld->ecgnz[in][iz]- ecld->vgsld[in][iz];
3339  defbet = ecld->beta2[in][iz];
3340 
3341  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);
3342  erot = jprf * jprf * 197.328 * 197.328 /(2. * iinert);
3343  erotcn = erot;
3344 
3345  bsbkbc(a,zprf,&bscn,&bkcn,&bccn);
3346 
3347  // if(ee > erot){
3348  densniv(a,zprf,ee,0.0,&densg,bshell,bscn,bkcn,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprf,0,&qrcn);
3349  ftcn = temp;
3350  //ecorcn = ecor;
3351 /*
3352  }else{
3353 // If EE < EROT, only gamma emission can take place
3354  probf = 0.0;
3355  probp = 0.0;
3356  probd = 0.0;
3357  probt = 0.0;
3358  probn = 0.0;
3359  probhe = 0.0;
3360  proba = 0.0;
3361  probg = 1.0;
3362  probimf = 0.0;
3363 //c JLRS 03/2017 - Added this calculation
3364 //C According to A. Ignatyuk, GG :
3365 //C Here BS=BK=1, as this was assumed in the parameterization
3366  pa = (ald->av)*a + (ald->as)*std::pow(a,2./3.) + (ald->ak)*std::pow(a,1./3.);
3367  gamma = 2.5 * pa * std::pow(a,-4./3.);
3368  gfactor = 1.+gamma*ecld->ecgnz[in][iz];
3369  if(gfactor<=0.){
3370  gfactor = 0.0;
3371  }
3372 //
3373  gtemp = 17.60/(std::pow(a,0.699) * std::sqrt(gfactor));
3374  ecg = 4.0 * gtemp;
3375 //
3376  goto direct70;
3377  }
3378 */
3379 
3380 // ---------------------------------------------------------------
3381 // LEVEL DENSITIES AND TEMPERATURES OF THE FINAL STATES
3382 // ---------------------------------------------------------------
3383 //
3384 // MVR - in case of charged particle emission temperature
3385 // comes from random kinetic energy from a Maxwelliam distribution
3386 // if option imaxwell = 1 (otherwise E=2T)
3387 //
3388 // AK - LEVEL DENSITY AND TEMPERATURE AT THE SADDLE POINT -> now calculated in the subroutine FISSION_WIDTH
3389 //
3390 //
3391 // LEVEL DENSITY AND TEMPERATURE IN THE NEUTRON DAUGHTER
3392 //
3393 // KHS, AK 2007 - Reduction of angular momentum due to orbital angular momentum of emitted fragment
3394 // JLRS Nov-2016 - Added these caculations in abla++
3395 
3396  if (in >= 2) {
3397  ind=idnint(a)-idnint(zprf)-1;
3398  izd=idnint(zprf);
3399  if(jprf>0.10){
3400  lorb(a,a-1.,jprf,ee-sn,&dlout,&sdlout);
3401  djprf = gausshaz(1,dlout,sdlout);
3402  if(IDjprf==1) djprf = 0.0;
3403  jprfn = jprf + djprf;
3404  jprfn = dint(std::abs(jprfn)); // The nucleus just turns the other way around
3405  }
3406  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3407  defbet = ecld->beta2[ind][izd];
3408 
3409  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);
3410  erotn = jprfn * jprfn * 197.328 * 197.328 /(2. * iinert);
3411  bsbkbc(a-1.,zprf,&bs,&bk,&bc);
3412 
3413  // level density and temperature in the neutron daughter
3414  densniv(a-1.0,zprf,ee,sn,&densn,bshell, bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfn,0,&qr);
3415  nt = temp;
3416  ecn=0.0;
3417  if(densn>0.){
3418  G4int IS=0;
3419  if(imaxwell == 1){
3420  rnt = nt;
3421  dir1234:
3422  ecn=fvmaxhaz_neut(rnt);
3423  IS++;
3424  if(IS>100){std::cout << "WARNING: FVMAXHAZ_NEUT CALLED MORE THAN 100 TIMES" << std::endl;
3425  goto exi1000;
3426  }
3427  if(ecn>(ee-sn)){
3428  if((ee-sn)<rnt)
3429  ecn = ee-sn;
3430  else
3431  goto dir1234;
3432  }
3433  if(ecn<=0.0) goto dir1234;
3434  }else{
3435  ecn = 2.0 * nt;
3436  }
3437  }
3438  }
3439  else {
3440  densn = 0.0;
3441  ecn = 0.0;
3442  nt = 0.0;
3443  }
3444  exi1000:
3445 
3446 // LEVEL DENSITY AND TEMPERATURE IN THE PROTON DAUGHTER
3447 //
3448 // Reduction of angular momentum due to orbital angular momentum of emitted fragment
3449  if (iz >= 2) {
3450  ind=idnint(a)-idnint(zprf);
3451  izd=idnint(zprf)-1;
3452  if(jprf>0.10){
3453  lorb(a,a-1.,jprf,ee-sbp,&dlout,&sdlout);
3454  djprf = gausshaz(1,dlout,sdlout);
3455  if(IDjprf==1) djprf = 0.0;
3456  jprfp = jprf + djprf;
3457  jprfp = dint(std::abs(jprfp)); // The nucleus just turns the other way around
3458  }
3459  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3460  defbet =ecld->beta2[ind][izd];
3461 
3462  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);
3463  erotp = jprfp * jprfp * 197.328 * 197.328 /(2. * iinert);
3464 
3465  bsbkbc(a-1.,zprf-1.,&bs,&bk,&bc);
3466 
3467  // level density and temperature in the proton daughter
3468  densniv(a-1.0,zprf-1.0,ee,sbp,&densp,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfp,0,&qr);
3469  pt = temp;
3470  ecp = 0.;
3471  if(densp>0.){
3472  G4int IS=0;
3473  if(imaxwell == 1){
3474  rpt = pt;
3475  dir1235:
3476  ecp=fvmaxhaz(rpt);
3477  IS++;
3478  if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3479  goto exi1001;
3480  }
3481  if(ecp>(ee-sbp)){
3482  if((ee-sbp)<rpt)
3483  ecp = ee-sbp;
3484  else
3485  goto dir1235;
3486  }
3487  if(ecp<=0.0) goto dir1235;
3488  ecp = ecp + bp;
3489  }else{
3490  ecp = 2.0 * pt + bp;
3491  }
3492  }
3493  }
3494  else {
3495  densp = 0.0;
3496  ecp = 0.0;
3497  pt = 0.0;
3498  }
3499  exi1001:
3500 
3501 // FINAL LEVEL DENSITY AND TEMPERATURE AFTER DEUTERON EMISSION
3502 //
3503 // Reduction of angular momentum due to orbital angular momentum of emitted fragment
3504  if ((in >= 2) && (iz >= 2)) {
3505  ind=idnint(a)-idnint(zprf)-1;
3506  izd=idnint(zprf)-1;
3507  if(jprf>0.10){
3508  lorb(a,a-2.,jprf,ee-sbd,&dlout,&sdlout);
3509  djprf = gausshaz(1,dlout,sdlout);
3510  if(IDjprf==1) djprf = 0.0;
3511  jprfd = jprf + djprf;
3512  jprfd = dint(std::abs(jprfd)); // The nucleus just turns the other way around
3513  }
3514  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3515  defbet = ecld->beta2[ind][izd];
3516 
3517  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);
3518  erotd = jprfd * jprfd * 197.328 * 197.328 /(2. * iinert);
3519 
3520  bsbkbc(a-2.,zprf-1.,&bs,&bk,&bc);
3521 
3522  // level density and temperature in the deuteron daughter
3523  densniv(a-2.0,zprf-1.0e0,ee,sbd,&densd,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfd,0,&qr);
3524 
3525  dt = temp;
3526  ecd = 0.0;
3527  if(densd>0.){
3528  G4int IS=0;
3529  if(imaxwell == 1){
3530  rdt = dt;
3531  dir1236:
3532  ecd=fvmaxhaz(rdt);
3533  IS++;
3534  if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3535  goto exi1002;
3536  }
3537  if(ecd>(ee-sbd)){
3538  if((ee-sbd)<rdt)
3539  ecd = ee-sbd;
3540  else
3541  goto dir1236;
3542  }
3543  if(ecd<=0.0) goto dir1236;
3544  ecd = ecd + bd;
3545  }else{
3546  ecd = 2.0 * dt + bd;
3547  }
3548  }
3549  }
3550  else {
3551  densd = 0.0;
3552  ecd = 0.0;
3553  dt = 0.0;
3554  }
3555  exi1002:
3556 
3557 // FINAL LEVEL DENSITY AND TEMPERATURE AFTER TRITON EMISSION
3558 //
3559 // Reduction of angular momentum due to orbital angular momentum of emitted fragment
3560  if ((in >= 3) && (iz >= 2)) {
3561  ind=idnint(a)-idnint(zprf)-2;
3562  izd=idnint(zprf)-1;
3563  if(jprf>0.10){
3564  lorb(a,a-3.,jprf,ee-sbt,&dlout,&sdlout);
3565  djprf = gausshaz(1,dlout,sdlout);
3566  if(IDjprf==1) djprf = 0.0;
3567  jprft = jprf + djprf;
3568  jprft = dint(std::abs(jprft)); // The nucleus just turns the other way around
3569  }
3570  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3571  defbet = ecld->beta2[ind][izd];
3572 
3573  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);
3574  erott = jprft * jprft * 197.328 * 197.328 /(2. * iinert);
3575 
3576  bsbkbc(a-3.,zprf-1.,&bs,&bk,&bc);
3577 
3578  // level density and temperature in the triton daughter
3579  densniv(a-3.0,zprf-1.0,ee,sbt,&denst,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprft,0,&qr);
3580 
3581  tt = temp;
3582  ect=0.;
3583  if(denst>0.){
3584  G4int IS=0;
3585  if(imaxwell == 1){
3586  rtt = tt;
3587  dir1237:
3588  ect=fvmaxhaz(rtt);
3589  IS++;
3590  if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3591  goto exi1003;
3592  }
3593  if(ect>(ee-sbt)){
3594  if((ee-sbt)<rtt)
3595  ect = ee-sbt;
3596  else
3597  goto dir1237;
3598  }
3599  if(ect<=0.0) goto dir1237;
3600  ect = ect + bt;
3601  }else{
3602  ect = 2.0 * tt + bt;
3603  }
3604  }
3605  }
3606  else {
3607  denst = 0.0;
3608  ect = 0.0;
3609  tt = 0.0;
3610  }
3611  exi1003:
3612 
3613 // LEVEL DENSITY AND TEMPERATURE IN THE ALPHA DAUGHTER
3614 //
3615 // Reduction of angular momentum due to orbital angular momentum of emitted fragment
3616  if ((in >= 3) && (iz >= 3)) {
3617  ind=idnint(a)-idnint(zprf)-2;
3618  izd=idnint(zprf)-2;
3619  if(jprf>0.10){
3620  lorb(a,a-4.,jprf,ee-sba,&dlout,&sdlout);
3621  djprf = gausshaz(1,dlout,sdlout);
3622  if(IDjprf==1) djprf = 0.0;
3623  jprfa = jprf + djprf;
3624  jprfa = dint(std::abs(jprfa)); // The nucleus just turns the other way around
3625  }
3626  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3627  defbet = ecld->beta2[ind][izd];
3628 
3629  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);
3630  erota = jprfa * jprfa * 197.328 * 197.328 /(2. * iinert);
3631 
3632  bsbkbc(a-4.,zprf-2.,&bs,&bk,&bc);
3633 
3634  // level density and temperature in the alpha daughter
3635  densniv(a-4.0,zprf-2.0,ee,sba,&densa,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfa,0,&qr);
3636 
3637  at = temp;
3638  eca = 0.0;
3639  if(densa>0.){
3640  G4int IS=0;
3641  if(imaxwell == 1){
3642  rat = at;
3643  dir1238:
3644  eca=fvmaxhaz(rat);
3645  IS++;
3646  if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3647  goto exi1004;
3648  }
3649  if(eca>(ee-sba)){
3650  if((ee-sba)<rat)
3651  eca = ee-sba;
3652  else
3653  goto dir1238;
3654  }
3655  if(eca<=0.0) goto dir1238;
3656  eca = eca + ba;
3657  }else{
3658  eca = 2.0 * at + ba;
3659  }
3660  }
3661  }
3662  else {
3663  densa = 0.0;
3664  eca = 0.0;
3665  at = 0.0;
3666  }
3667  exi1004:
3668 
3669 // FINAL LEVEL DENSITY AND TEMPERATURE AFTER 3HE EMISSION
3670 //
3671 // Reduction of angular momentum due to orbital angular momentum of emitted fragment
3672  if ((in >= 2) && (iz >= 3)) {
3673  ind=idnint(a)-idnint(zprf)-1;
3674  izd=idnint(zprf)-2;
3675  if(jprf>0.10){
3676  lorb(a,a-3.,jprf,ee-sbhe,&dlout,&sdlout);
3677  djprf = gausshaz(1,dlout,sdlout);
3678  if(IDjprf==1) djprf = 0.0;
3679  jprfhe = jprf + djprf;
3680  jprfhe = dint(std::abs(jprfhe)); // The nucleus just turns the other way around
3681  }
3682  bshell = ecld->ecgnz[ind][izd] - ecld->vgsld[ind][izd];
3683  defbet = ecld->beta2[ind][izd];
3684 
3685  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);
3686  erothe = jprfhe * jprfhe * 197.328 * 197.328 /(2. * iinert);
3687 
3688  bsbkbc(a-3.,zprf-2.,&bs,&bk,&bc);
3689 
3690  // level density and temperature in the he3 daughter
3691  densniv(a-3.0,zprf-2.0,ee,sbhe,&denshe,bshell,bs,bk,&temp,fiss->optshp,fiss->optcol,defbet,&ecor,jprfhe,0,&qr);
3692 
3693  het = temp;
3694  eche = 0.0;
3695  if(denshe>0.){
3696  G4int IS=0;
3697  if(imaxwell == 1){
3698  rhet = het;
3699  dir1239:
3700  eche=fvmaxhaz(rhet);
3701  IS++;
3702  if(IS>100){std::cout << "WARNING: FVMAXHAZ CALLED MORE THAN 100 TIMES" << std::endl;
3703  goto exi1005;
3704  }
3705  if(eche>(ee-sbhe)){
3706  if((ee-sbhe)<rhet)
3707  eche = ee-sbhe;
3708  else
3709  goto dir1239;
3710  }
3711  if(eche<=0.0) goto dir1239;
3712  eche = eche + bhe;
3713  }else{
3714  eche = 2.0 * het + bhe;
3715  }
3716  }
3717  }
3718  else {
3719  denshe = 0.0;
3720  eche = 0.0;
3721  het = 0.0;
3722  }
3723  exi1005:
3724 
3725 // Decay widths for particles
3726  if ( densg > 0.) {
3727 //
3728 // CALCULATION OF THE PARTIAL DECAY WIDTH
3729 // USED FOR BOTH THE TIME SCALE AND THE EVAPORATION DECAY WIDTH
3730 //
3731 // AKAP = HBAR**2/(2* MN * R_0**2) = 10 MEV *** input param ***
3732 //
3733 // AK, KHS 2005 - Energy-dependen inverse cross sections included, influence of
3734 // Coulomb barrier for LCP, tunnelling for LCP
3735 // JLRS 2017 - Implementation in abla++
3736 
3737  if(densn<=0.0){
3738  gn = 0.0;
3739  }else{
3740  gn = width(a,zprf,1.0,0.0,nt,0.0,sn,ee-erotn)* densn/densg;
3741  }
3742  if(densp<=0.0){
3743  gp = 0.0;
3744  }else{
3745  gp = width(a,zprf,1.0,1.0,pt,bp,sbp,ee-erotp)*densp/densg* pen(a, 1.0, omegap, pt);
3746  }
3747  if(densd<=0.0){
3748  gd = 0.0;
3749  }else{
3750  gd = width(a,zprf,2.0,1.0,dt,bd,sbd,ee-erotd)*densd/densg* pen(a, 2.0, omegad, dt);
3751  }
3752  if(denst<=0.0){
3753  gt = 0.0;
3754  }else{
3755  gt = width(a,zprf,3.0,1.0,tt,bt,sbt,ee-erott)*denst/densg* pen(a, 3.0, omegat, tt);
3756  }
3757  if(denshe<=0.0){
3758  ghe = 0.0;
3759  }else{
3760  ghe =width(a,zprf,3.0,2.0,het,bhe,sbhe,ee-erothe) * denshe/densg* pen(a, 3.0, omegahe, het);
3761  }
3762  if(densa<=0.0){
3763  ga = 0.0;
3764  }else{
3765  ga = width(a,zprf,4.0,2.0,at,ba,sba,ee-erota) * densa/densg* pen(a, 4.0, omegaa, at);
3766  }
3767 
3768 // **************************
3769 // * Treatment of IMFs *
3770 // * KHS, AK, MVR 2005-2006 *
3771 // **************************
3772 
3773  G4int izcn=0,incn=0,inmin=0,inmax=0,inmi=0,inma=0;
3774  G4double aimf,mares,maimf;
3775 
3776  if(fimf_allowed==0 || zprf<=5.0 || a<=7.0){
3777  gimf = 0.0;
3778  }else{
3779 // Estimate the total decay width for IMFs (Z >= 3)
3780 // By using the logarithmic slope between GIMF3 and GIMF5
3781 
3782  mglms(a,zprf,opt->optshpimf,&mazz);
3783 
3784  gimf3 = 0.0;
3785  zimf = 3.0;
3786  izimf = 3;
3787 // *** Find the limits that both IMF and partner are bound :
3788  izcn = idnint(zprf); // Z of CN
3789  incn = idnint(a) - izcn; // N of CN
3790 
3791  isostab_lim(izimf,&inmin,&inmax); // Bound isotopes for IZIMF from INMIN to INIMFMA
3792  isostab_lim(izcn-izimf,&inmi,&inma); // Daughter nucleus after IMF emission,
3793  // limits of bound isotopes
3794  inmin = max(inmin,incn-inma); // Both IMF and daughter must be bound
3795  inmax = min(inmax,incn-inmi); // "
3796 
3797  inmax = max(inmax,inmin); // In order to keep the variables below
3798 
3799  for(G4int iaimf=izimf+inmin;iaimf<=izimf+inmax;iaimf++){
3800  aimf=double(iaimf);
3801  if(aimf>=a || zimf>=zprf){
3802  width_imf = 0.0;
3803  }else{
3804  // Q-values
3805  mglms(a-aimf,zprf-zimf,opt->optshpimf,&mares);
3806  mglms(aimf,zimf,opt->optshpimf,&maimf);
3807  // Bass barrier
3808  barrs(idnint(zprf-zimf),idnint(a-aimf),izimf,idnint(aimf),&bimf,&omegaimf);
3809  sbimf = maimf+mares-mazz+bimf;
3810  // Rotation energy
3811  defbetimf = ecld->beta2[idnint(aimf-zimf)][idnint(zimf)]+ecld->beta2[idnint(a-aimf-zprf+zimf)][idnint(zprf-zimf)];
3812 
3813  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));
3814 
3815  erot = jprf * jprf * 197.328 * 197.328 /(2.0 * iinert);
3816 
3817  // Width
3818  if(densg==0.0 || ee < (sbimf + erot)){
3819  width_imf = 0.0;
3820  }else{
3821  // To take into account that at the barrier the system is deformed:
3822  // BSIMF = ((A-AIMF)**(2.D0/3.D0) + AIMF**(2.D0/3.D0))/A**(2.D0/3.D0)
3823  bsimf = bscn;
3824  densniv(a,zprf,ee,sbimf,&densimf,0.0,bsimf,1.0,&timf,0,0,defbetimf,&ecor,jprf,2,&qr);
3825 
3826  imfarg = (sbimf+erotcn-erot)/timf;
3827  if(imfarg > 200.0) imfarg = 200.0;
3828 
3829 // For IMF - The available phase space is given by the level densities in CN at the
3830 // barrier; applaying MOrretto -> G=WIDTH*ro_CN(E-SBIMF)/ro_CN(E).
3831 // Constant temperature approximation: ro(E+dE)/ro(E)=exp(dE/T)
3832 // Ratio DENSIMF/DENSCN is included to take into account that at the barrier system
3833 // is deformed. If (above) BSIMF = 1 no deformation is considered and this ratio
3834 // is equal to 1.
3835  width_imf = 0.0;
3836  //
3837  width_imf = width(a,zprf,aimf,zimf,timf,bimf,sbimf,ee-erot)*std::exp(-imfarg)*qr/qrcn;
3838  }// if densg
3839  }// if aimf
3840  gimf3 = gimf3 + width_imf;
3841  }// for IAIMF
3842 
3843 // zimf = 5
3844  gimf5 = 0.0;
3845  zimf = 5.0;
3846  izimf = 5;
3847 // *** Find the limits that both IMF and partner are bound :
3848  izcn = idnint(zprf); // Z of CN
3849  incn = idnint(a) - izcn; // N of CN
3850 
3851  isostab_lim(izimf,&inmin,&inmax); // Bound isotopes for IZIMF from INMIN to INIMFMA
3852  isostab_lim(izcn-izimf,&inmi,&inma); // Daughter nucleus after IMF emission,
3853  // limits of bound isotopes
3854  inmin = max(inmin,incn-inma); // Both IMF and daughter must be bound
3855  inmax = min(inmax,incn-inmi); // "
3856 
3857  inmax = max(inmax,inmin); // In order to keep the variables below
3858 
3859  for(G4int iaimf=izimf+inmin;iaimf<=izimf+inmax;iaimf++){
3860  aimf=G4double(iaimf);
3861  if(aimf>=a || zimf>=zprf){
3862  width_imf = 0.0;
3863  }else{
3864  // Q-values
3865  mglms(a-aimf,zprf-zimf,opt->optshpimf,&mares);
3866  mglms(aimf,zimf,opt->optshpimf,&maimf);
3867  // Bass barrier
3868  barrs(idnint(zprf-zimf),idnint(a-aimf),izimf,idnint(aimf),&bimf,&omegaimf);
3869  sbimf = maimf+mares-mazz+bimf;
3870  // Rotation energy
3871  defbetimf = ecld->beta2[idnint(aimf-zimf)][idnint(zimf)]+ecld->beta2[idnint(a-aimf-zprf+zimf)][idnint(zprf-zimf)];
3872 
3873  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));
3874 
3875  erot = jprf * jprf * 197.328 * 197.328 /(2.0 * iinert);
3876 //
3877  // Width
3878  if(densg==0.0 || ee < (sbimf + erot)){
3879  width_imf = 0.0;
3880  }else{
3881  // To take into account that at the barrier the system is deformed:
3882  // BSIMF = ((A-AIMF)**(2.D0/3.D0) + AIMF**(2.D0/3.D0))/A**(2.D0/3.D0)
3883  bsimf = bscn;
3884  densniv(a,zprf,ee,sbimf,&densimf,0.0,bsimf,1.0,&timf,0,0,defbetimf,&ecor,jprf,2,&qr);
3885 //
3886  imfarg = (sbimf+erotcn-erot)/timf;
3887  if(imfarg > 200.0) imfarg = 200.0;
3888 //
3889 // For IMF - The available phase space is given by the level densities in CN at the
3890 // barrier; applaying MOrretto -> G=WIDTH*ro_CN(E-SBIMF)/ro_CN(E).
3891 // Constant temperature approximation: ro(E+dE)/ro(E)=exp(dE/T)
3892 // Ratio DENSIMF/DENSCN is included to take into account that at the barrier system
3893 // is deformed. If (above) BSIMF = 1 no deformation is considered and this ratio
3894 // is equal to 1.
3895  width_imf = 0.0;
3896  width_imf = width(a,zprf,aimf,zimf,timf,bimf,sbimf,ee-erot)*std::exp(-imfarg)*qr/qrcn;//*densimf/densg;
3897  }// if densg
3898  }// if aimf
3899  gimf5 = gimf5 + width_imf;
3900  }// for IAIMF
3901 // It is assumed that GIMFi = A_IMF*ZIMF**B_IMF; to get the total GIMF one integrates
3902 // Int(A_IMF*ZIMF**B_IMF)(3->ZPRF)
3903 
3904  if(gimf3<=0.0 || gimf5<=0.0){
3905  gimf = 0.0;
3906  b_imf = -100.0;
3907  a_imf = 0.0;
3908  }else{
3909 //
3910  b_imf = (std::log10(gimf3) - std::log10(gimf5))/(std::log10(3.0)-std::log10(5.0));
3911 //
3912  if(b_imf >= -1.01) b_imf = -1.01;
3913  if(b_imf <= -100.0) {
3914  b_imf = -100.0;
3915  a_imf = 0.0;
3916  gimf = 0.0;
3917  goto direct2007;
3918  }
3919 //
3920  a_imf = gimf3 / std::pow(3.0,b_imf);
3921  gimf = a_imf * ( std::pow(zprf,b_imf+1.0) - std::pow(3.0,b_imf+1.0)) /(b_imf + 1.0);
3922  }
3923 
3924  direct2007:
3925  if(gimf < 1.e-10) gimf = 0.0;
3926  }// if fimf_allowed
3927 //
3928 //c JLRS 2016 - Added this calculation
3929 //C AK 2004 - Gamma width
3930 //C According to A. Ignatyuk, GG :
3931 //C Here BS=BK=1, as this was assumed in the parameterization
3932  pa = (ald->av)*a + (ald->as)*std::pow(a,2./3.) + (ald->ak)*std::pow(a,1./3.);
3933  gamma = 2.5 * pa * std::pow(a,-4./3.);
3934  gfactor = 1.+gamma*ecld->ecgnz[in][iz];
3935  if(gfactor<=0.){
3936  gfactor = 0.0;
3937  }
3938 //
3939  gtemp = 17.60/(std::pow(a,0.699) * std::sqrt(gfactor));
3940 //
3941 //C If one switches gammas off, one should also switch off tunneling through the fission barrier.
3942  gg = 0.624e-9*std::pow(a,1.6)*std::pow(gtemp,5.);
3943 //gammaemission==1
3944 //C For fission fragments, GG is ~ 2 times larger than for
3945 //c "oridnary" nuclei (A. Ignatyuk, private communication).
3946  if(gammaemission==1){
3947  gg = 2.0 * gg;
3948  }
3949  ecg = 4.0 * gtemp;
3950 //
3951 //
3952  gsum = ga + ghe + gd + gt + gp + gn + gimf + gg;
3953  if (gsum > 0.0) {
3954  ts1 = hbar / gsum;
3955  }
3956  else {
3957  ts1 = 1.0e99;
3958  goto direct69;
3959  }
3960 //
3961 //Case of nuclei below Businaro-Gallone mass asymmetry point
3962  if(fiss->ifis==0 || (zprf*zprf/a<=22.74 && zprf<60.)){
3963  goto direct69;
3964  }
3965 //
3966 // Calculation of the fission decay width
3967 // Deformation is calculated using the fissility
3968 //
3969  defbet = y;
3970  fission_width(zprf,a,ee,bssp,bksp,ef,y,&gf,&temp,jprf,0,1,fiss->optcol,fiss->optshp,densg);
3971  ft=temp;
3972 //
3973 // Case of very heavy nuclei that have no fission barrier
3974 // For them fission is the only decay channel available
3975  if(ef<=0.0){
3976  probf = 1.0;
3977  probp = 0.0;
3978  probd = 0.0;
3979  probt = 0.0;
3980  probn = 0.0;
3981  probhe = 0.0;
3982  proba = 0.0;
3983  probg = 0.0;
3984  probimf = 0.0;
3985  goto direct70;
3986  }
3987 
3988  if(fiss->bet<=0.){
3989  gtotal = ga + ghe + gp + gd + gt + gn + gg +gimf + gf;
3990  if(gtotal<=0.0){
3991  probf = 0.0;
3992  probp = 0.0;
3993  probd = 0.0;
3994  probt = 0.0;
3995  probn = 0.0;
3996  probhe = 0.0;
3997  proba = 0.0;
3998  probg = 0.0;
3999  probimf = 0.0;
4000  goto direct70;
4001  }else{
4002  probf = gf/gtotal;
4003  probn = gn/gtotal;
4004  probp = gp/gtotal;
4005  probd = gd/gtotal;
4006  probt = gt/gtotal;
4007  probhe = ghe/gtotal;
4008  proba = ga/gtotal;
4009  probg = gg/gtotal;
4010  probimf = gimf/gtotal;
4011  goto direct70;
4012  }
4013  }
4014  }else{
4015  goto direct69;
4016  }
4017 //
4018  if (inum > ilast) { // new event means reset the time scale
4019  tsum = 0.;
4020  }
4021 //
4022 // kramers factor for the dynamical hindrances of fission
4023  fomega_sp(a,y,&mfcd,&omegasp,&homegasp);
4024  cf = cram(fiss->bet,homegasp);
4025 //
4026 // We calculate the transient time
4027  fomega_gs(a,zprf,&k1,&omegags,&homegags);
4028  tauc=tau(fiss->bet,homegags,ef,ft);
4029  gf=gf*cf;
4030 //
4031 /*
4032 c The subroutine part_fiss calculates the fission width GFF that corresponds to the time
4033 c dependence of the probability distribution obtained by solving the FOKKER-PLANCK eq
4034 c using a nucleus potential that is approximated by a parabola. It also gives the
4035 c decay time for this step T_LAPSE that includes all particle decay channels and the
4036 c fission channel. And it decides whether the nucleus decays by particle evaporation
4037 c CHOICE_FISSPART = 1 or fission CHOICE_FISSPART = 2
4038 */
4039 //
4040  part_fiss(fiss->bet,gsum,gf,y,tauc,ts1,tsum, &choice_fisspart,zprf,a,ft,&t_lapse,&gff);
4041  gf = gff;
4042 //
4043 // We accumulate in TSUM the mean decay for this step including all particle decay channels and fission
4044  tsum = tsum + t_lapse;
4045 
4046 // If fission occurs
4047  if(choice_fisspart==2){
4048  probf = 1.0;
4049  probp = 0.0;
4050  probd = 0.0;
4051  probt = 0.0;
4052  probn = 0.0;
4053  probhe = 0.0;
4054  proba = 0.0;
4055  probg = 0.0;
4056  probimf = 0.0;
4057  goto direct70;
4058  }else{
4059 // If particle evaporation occurs
4060 // The probabilities for the different decays are calculated taking into account the fission width GFF that corresponds to this step
4061 
4062  gtotal=ga + ghe + gp + gd + gt + gn + gimf + gg;
4063  if(gtotal<=0.0){
4064  probf = 0.0;
4065  probp = 0.0;
4066  probd = 0.0;
4067  probt = 0.0;
4068  probn = 0.0;
4069  probhe = 0.0;
4070  proba = 0.0;
4071  probg = 0.0;
4072  probimf = 0.0;
4073  goto direct70;
4074  }else{
4075  probf = 0.0;
4076  probn = gn/gtotal;
4077  probp = gp/gtotal;
4078  probd = gd/gtotal;
4079  probt = gt/gtotal;
4080  probhe = ghe/gtotal;
4081  proba = ga/gtotal;
4082  probg = gg/gtotal;
4083  probimf = gimf/gtotal;
4084  goto direct70;
4085  }
4086  }
4087 
4088 
4089 
4090  if(gf<=0.0){
4091  goto direct69;
4092  }else{
4093  gtotal = ga + ghe + gp + gd + gt + gn + gg + gimf + gf;
4094  probf = gf/gtotal;
4095  probn = gn/gtotal;
4096  probp = gp/gtotal;
4097  probd = gd/gtotal;
4098  probt = gt/gtotal;
4099  probhe = ghe/gtotal;
4100  proba = ga/gtotal;
4101  probg = gg/gtotal;
4102  probimf = gimf/gtotal;
4103  goto direct70;
4104  }
4105 
4106  direct69:
4107  gtotal = ga + ghe + gp + gd + gt + gn + gg + gimf;
4108  if(gtotal<=0.0){
4109  probf = 0.0;
4110  probp = 0.0;
4111  probd = 0.0;
4112  probt = 0.0;
4113  probn = 0.0;
4114  probhe = 0.0;
4115  proba = 0.0;
4116  probg = 0.0;
4117  probimf = 0.0;
4118  }else{
4119  probf = 0.0;
4120  probn = gn/gtotal;
4121  probp = gp/gtotal;
4122  probd = gd/gtotal;
4123  probt = gt/gtotal;
4124  probhe = ghe/gtotal;
4125  proba = ga/gtotal;
4126  probg = gg/gtotal;
4127  probimf = gimf/gtotal;
4128  }
4129 
4130  direct70:
4131  ptotl = probp+probd+probt+probn+probhe+proba+probg+probimf+probf;
4132  //
4133  ee = eer;
4134  ilast = inum;
4135 
4136  // Return values:
4137  (*probp_par) = probp;
4138  (*probd_par) = probd;
4139  (*probt_par) = probt;
4140  (*probn_par) = probn;
4141  (*probhe_par) = probhe;
4142  (*proba_par) = proba;
4143  (*probg_par) = probg;
4144  (*probimf_par) = probimf;
4145  (*probf_par) = probf;
4146  (*ptotl_par) = ptotl;
4147  (*sn_par) = sn;
4148  (*sp_par) = sp;
4149  (*sd_par) = sd;
4150  (*st_par) = st;
4151  (*she_par) = she;
4152  (*sa_par) = sa;
4153  (*sbp_par) = sbp;
4154  (*sbd_par) = sbd;
4155  (*sbt_par) = sbt;
4156  (*sbhe_par) = sbhe;
4157  (*sba_par) = sba;
4158  (*ecn_par) = ecn;
4159  (*ecp_par) = ecp;
4160  (*ecd_par) = ecd;
4161  (*ect_par) = ect;
4162  (*eche_par) = eche;
4163  (*eca_par) = eca;
4164  (*ecg_par) = ecg;
4165  (*bp_par) = bp;
4166  (*bd_par) = bd;
4167  (*bt_par) = bt;
4168  (*bhe_par) = bhe;
4169  (*ba_par) = ba;
4170  (*tcn) = ftcn;
4171  (*ts1_par) = ts1;
4172  (*jprfn_par) = jprfn;
4173  (*jprfp_par) = jprfp;
4174  (*jprfd_par) = jprfd;
4175  (*jprft_par) = jprft;
4176  (*jprfhe_par) = jprfhe;
4177  (*jprfa_par) = jprfa;
4178  (*tsum_par) = tsum;
4179  return;
4180 }
4181 
4182 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)
4183 {
4184  // 1498 C
4185  // 1499 C INPUT:
4186  // 1500 C A,EE,ESOUS,OPTSHP,BS,BK,BSHELL,DEFBET
4187  // 1501 C
4188  // 1502 C LEVEL DENSITY PARAMETERS
4189  // 1503 C COMMON /ALD/ AV,AS,AK,OPTAFAN
4190  // 1504 C AV,AS,AK - VOLUME,SURFACE,CURVATURE DEPENDENCE OF THE
4191  // 1505 C LEVEL DENSITY PARAMETER
4192  // 1506 C OPTAFAN - 0/1 AF/AN >=1 OR AF/AN ==1
4193  // 1507 C RECOMMENDED IS OPTAFAN = 0
4194  // 1508 C---------------------------------------------------------------------
4195  // 1509 C OUTPUT: DENS,TEMP
4196  // 1510 C
4197  // 1511 C ____________________________________________________________________
4198  // 1512 C /
4199  // 1513 C / PROCEDURE FOR CALCULATING THE STATE DENSITY OF A COMPOUND NUCLEUS
4200  // 1514 C /____________________________________________________________________
4201  // 1515 C
4202  // 1516 INTEGER AFP,IZ,OPTSHP,OPTCOL,J,OPTAFAN
4203  // 1517 REAL*8 A,EE,ESOUS,DENS,E,Y0,Y1,Y2,Y01,Y11,Y21,PA,BS,BK,TEMP
4204  // 1518 C=====INSERTED BY KUDYAEV===============================================
4205  // 1519 COMMON /ALD/ AV,AS,AK,OPTAFAN
4206  // 1520 REAL*8 ECR,ER,DELTAU,Z,DELTPP,PARA,PARZ,FE,HE,ECOR,ECOR1,Pi6
4207  // 1521 REAL*8 BSHELL,DELTA0,AV,AK,AS,PONNIV,PONFE,DEFBET,QR,SIG,FP
4208  // 1522 C=======================================================================
4209  // 1523 C
4210  // 1524 C
4211  // 1525 C-----------------------------------------------------------------------
4212  // 1526 C A MASS NUMBER OF THE DAUGHTER NUCLEUS
4213  // 1527 C EE EXCITATION ENERGY OF THE MOTHER NUCLEUS
4214  // 1528 C ESOUS SEPARATION ENERGY PLUS EFFECTIVE COULOMB BARRIER
4215  // 1529 C DENS STATE DENSITY OF DAUGHTER NUCLEUS AT EE-ESOUS-EC
4216  // 1530 C BSHELL SHELL CORRECTION
4217  // 1531 C TEMP NUCLEAR TEMPERATURE
4218  // 1532 C E LOCAL EXCITATION ENERGY OF THE DAUGHTER NUCLEUS
4219  // 1533 C E1 LOCAL HELP VARIABLE
4220  // 1534 C Y0,Y1,Y2,Y01,Y11,Y21
4221  // 1535 C LOCAL HELP VARIABLES
4222  // 1536 C PA LOCAL STATE-DENSITY PARAMETER
4223  // 1537 C EC KINETIC ENERGY OF EMITTED PARTICLE WITHOUT
4224  // 1538 C COULOMB REPULSION
4225  // 1539 C IDEN FAKTOR FOR SUBSTRACTING KINETIC ENERGY IDEN*TEMP
4226  // 1540 C DELTA0 PAIRING GAP 12 FOR GROUND STATE
4227  // 1541 C 14 FOR SADDLE POINT
4228  // 1542 C EITERA HELP VARIABLE FOR TEMPERATURE ITERATION
4229  // 1543 C-----------------------------------------------------------------------
4230  // 1544 C
4231  // 1545 C
4232  G4double delta0 = 0.0;
4233  G4double deltau = 0.0;
4234  G4double deltpp = 0.0;
4235  G4double e = 0.0;
4236  G4double e0 = 0.0;
4237  G4double ecor1 = 0.0;
4238  G4double ecr = 10.0;
4239  G4double fe = 0.0;
4240  G4double he = 0.0;
4241  G4double pa = 0.0;
4242  G4double para = 0.0;
4243  G4double parz = 0.0;
4244  G4double ponfe = 0.0;
4245  G4double ponniv = 0.0;
4246  G4double fqr = 1.0;
4247  G4double y01 = 0.0;
4248  G4double y11 = 0.0;
4249  G4double y2 = 0.0;
4250  G4double y21 = 0.0;
4251  G4double y1 = 0.0;
4252  G4double y0 = 0.0;
4253  G4double fnorm=0.0;
4254  G4double fp_per=0.;
4255  G4double fp_par=0.;
4256  G4double sig_per=0.;
4257  G4double sig_par=0.;
4258  G4double sigma2;
4259  G4double jfact=1.;
4260  G4double erot=0.;
4261  G4double fdens=0.;
4262  G4double fecor=0.;
4263  G4double BSHELLCT=0.;
4264  G4double gamma=0.;
4265  G4double ftemp=0.0;
4266  G4double tempct=0.0;
4267  G4double densfm = 0.0;
4268  G4double densct = 0.0;
4269  G4double ein=0.;
4270  G4double elim;
4271  G4double tfm;
4272  G4double bs=bsin;
4273  G4double bk=bkin;
4274  G4int IPARITE;
4275  G4int IOPTCT=fiss->optct;
4276 //
4277  G4double pi6 = std::pow(3.1415926535,2) / 6.0;
4278  G4double pi = 3.1415926535;
4279 //
4280  G4int afp=idnint(a);
4281  G4int iz=idnint(z);
4282  G4int in=afp-iz;
4283 //
4284  if(ifis!=1){
4285  BSHELLCT = ecld->ecgnz[in][iz];
4286  }else{
4287  BSHELLCT = 0.0;
4288  }
4289  if(afp<=20) BSHELLCT = 0.0;
4290  //
4291  parite(a,&para);
4292  if (para < 0.0){
4293 // Odd A
4294  IPARITE=1;
4295  }else{
4296 // Even A
4297  parite(z,&parz);
4298  if(parz > 0.0){
4299 // Even Z, even N
4300  IPARITE=2;
4301  }else{
4302 // Odd Z, odd N
4303  IPARITE=0;
4304  }
4305  }
4306 //
4307  ein = ee - esous;
4308 //
4309  if(ein>1.e30){
4310  fdens = 0.0;
4311  ftemp = 0.5;
4312  goto densniv100;
4313  }
4314 //
4315  e = ee - esous;
4316 //
4317  if(e<0.0&&ifis!=1){ // TUNNELING
4318  fdens = 0.0;
4319  densfm = 0.0;
4320  densct = 0.0;
4321  if(ald->optafan == 1) {
4322  pa = (ald->av)*a + (ald->as)*std::pow(a,(2.e0/3.e0)) + (ald->ak)*std::pow(a,(1.e0/3.e0));
4323  }else {
4324  pa = (ald->av)*a + (ald->as)*bsin*std::pow(a,(2.e0/3.e0)) + (ald->ak)*bkin*std::pow(a,(1.e0/3.e0));
4325  }
4326  gamma = 2.5 * pa * std::pow(a,-4.0/3.0);
4327  fecor=0.0;
4328  goto densniv100;
4329  }
4330 //
4331  if(ifis==0&&bs!=1.0){
4332 // - With increasing excitation energy system in getting less and less deformed:
4333  G4double ponq = (e-100.0)/5.0;
4334  if(ponq>700.0) ponq = 700.0;
4335  bs = 1.0/(1.0+std::exp(-ponq)) + 1.0/(1.0+std::exp(ponq)) * bsin;
4336  bk = 1.0/(1.0+std::exp(-ponq)) + 1.0/(1.0+std::exp(ponq)) * bkin;
4337  }
4338 //
4339  // level density parameter
4340  if(ald->optafan == 1) {
4341  pa = (ald->av)*a + (ald->as)*std::pow(a,(2.e0/3.e0)) + (ald->ak)*std::pow(a,(1.e0/3.e0));
4342  }
4343  else {
4344  pa = (ald->av)*a + (ald->as)*bs*std::pow(a,(2.e0/3.e0)) + (ald->ak)*bk*std::pow(a,(1.e0/3.e0));
4345  }
4346 //
4347  gamma = 2.5 * pa * std::pow(a,-4.0/3.0);
4348 //
4349 // AK - 2009 - trial, in order to have transition to constant-temperature approach
4350 // Idea - at the phase transition superfluid-normal fluid, TCT = TEMP, and this
4351 // determines critical energy for pairing.
4352  if(a>0.0){
4353  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));
4354  }
4355 
4356  // pairing corrections
4357  if (ifis == 1) {
4358  delta0 = 14;
4359  }
4360  else {
4361  delta0 = 12;
4362  }
4363 
4364  // shell corrections
4365  if (optshp > 0) {
4366  deltau = bshell;
4367  if (optshp == 2) {
4368  deltau = 0.0;
4369  }
4370  if (optshp >= 2) {
4371  // pairing energy shift with condensation energy a.r.j. 10.03.97
4372  //deltpp = -0.25e0* (delta0/pow(sqrt(a),2)) * pa /pi6 + 2.e0*delta0/sqrt(a);
4373  deltpp = -0.25e0* std::pow((delta0/std::sqrt(a)),2) * pa /pi6 + 22.34e0*std::pow(a,-0.464)-0.235;
4374  // Odd A
4375  if (IPARITE == 1) {
4376  //e = e - delta0/sqrt(a);
4377  e=e-(0.285+11.17*std::pow(a,-0.464)-0.390-0.00058*a);//-30./a;//FIXME
4378  }
4379  // Even Z, even N
4380  if(IPARITE==2){
4381  e=e-(22.34*std::pow(a,-0.464)-0.235);//-30./a;//FIXME
4382  }
4383  // Odd Z, odd N
4384  if(IPARITE==0){
4385  if(in==iz){
4386  // e = e;
4387  }else{
4388  // e = e-30./a;
4389  }
4390  }
4391  } else {
4392  deltpp = 0.0;
4393  }
4394  }else {
4395  deltau = 0.0;
4396  deltpp = 0.0;
4397  }
4398 
4399  if(e < 0.0){
4400  e = 0.0;
4401  ftemp = 0.5;
4402  }
4403 
4404  // washing out is made stronger
4405  ponfe = -2.5*pa*e*std::pow(a,(-4.0/3.0));
4406 
4407  if (ponfe < -700.0) {
4408  ponfe = -700.0;
4409  }
4410  fe = 1.0 - std::exp(ponfe);
4411  if (e < ecr) {
4412  // priv. comm. k.-h. schmidt
4413  he = 1.0 - std::pow((1.0 - e/ecr),2);
4414  }
4415  else {
4416  he = 1.0;
4417  }
4418  // Excitation energy corrected for pairing and shell effects
4419  // washing out with excitation energy is included.
4420  fecor = e + deltau*fe + deltpp*he;
4421  if (fecor <= 0.1) {
4422  fecor = 0.1;
4423  }
4424  // iterative procedure according to grossjean and feldmeier
4425  // to avoid the singularity e = 0
4426  if (ee < 5.0) {
4427  y1 = std::sqrt(pa*fecor);
4428  for(G4int j = 0; j < 5; j++) {
4429  y2 = pa*fecor*(1.e0-std::exp(-y1));
4430  y1 = std::sqrt(y2);
4431  }
4432  y0 = pa/y1;
4433  ftemp=1.0/y0;
4434  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;
4435  if (fecor < 1.0) {
4436  ecor1=1.0;
4437  y11 = std::sqrt(pa*ecor1);
4438  for(G4int j = 0; j < 7; j++) {
4439  y21 = pa*ecor1*(1.0-std::exp(-y11));
4440  y11 = std::sqrt(y21);
4441  }
4442 
4443  y01 = pa/y11;
4444  fdens = fdens*std::pow((y01/y0),1.5);
4445  ftemp = ftemp*std::pow((y01/y0),1.5);
4446  }
4447  }
4448  else {
4449  ponniv = 2.0*std::sqrt(pa*fecor);
4450  if (ponniv > 700.0) {
4451  ponniv = 700.0;
4452  }
4453  // fermi gas state density
4454  fdens = 0.1477045 * std::exp(ponniv)/(std::pow(pa,0.25)*std::pow(fecor,1.25));
4455  ftemp = std::sqrt(fecor/pa);
4456  }
4457 //
4458  densfm = fdens;
4459  tfm = ftemp;
4460 //
4461  if(IOPTCT==0) goto densniv100;
4462  tempct = 17.60/( std::pow(a,0.699) * std::sqrt(1.+gamma*BSHELLCT));
4463  //tempct = 1.0 / ( (0.0570 + 0.00193*BSHELLCT) * pow(a,0.6666667)); // from PRC 80 (2009) 054310
4464 
4465 // - CONSTANT-TEMPERATURE LEVEL DENSITY PARAMETER (ONLY AT LOW ENERGIES)
4466  if(e<30.){
4467  if(a>0.0){
4468  if(optshp>=2){
4469 // Parametrization of CT model by Ignatyuk; note that E0 is shifted to correspond
4470 // to pairing shift in Fermi-gas model (there, energy is shifted taking odd-odd nuclei
4471 // as bassis)
4472 // e-o, o-e
4473  if (IPARITE == 1) { e0 = 0.285+11.17*std::pow(a,-0.464) - 0.390-0.00058*a;}
4474 // e-e
4475  if (IPARITE == 2) { e0 = 22.34*std::pow(a,-0.464)-0.235;}
4476 // o-o
4477  if (IPARITE == 0){ e0 = 0.0;}
4478 
4479  ponniv = (ein-e0)/tempct;
4480  if(ifis!=1) ponniv = max(0.0,(ein-e0)/tempct);
4481  if(ponniv>700.0){ ponniv = 700.0;}
4482  densct = std::exp(ponniv)/tempct*std::exp(0.079*BSHELLCT/tempct);
4483 
4484  elim = ein;
4485 
4486  if(elim>=ecr&&densfm<=densct){
4487  fdens = densfm;
4488  // IREGCT = 0;
4489  }else{
4490  fdens = densct;
4491  // IREGCT = 1;
4492 // ecor = min(ein-e0,0.10);
4493  }
4494  if(elim>=ecr&&tfm>=tempct){
4495  ftemp = tfm;
4496  }else{
4497  ftemp = tempct;
4498  }
4499  }else{
4500 // Case of no pairing considered
4501 // ETEST = PA * TEMPCT**2
4502  ponniv = (ein)/tempct;
4503  if(ponniv>700.0){ ponniv = 700.0;}
4504  densct = std::exp(ponniv)/tempct;
4505 
4506  if(ein>=ecr && densfm<=densct){
4507  fdens = densfm;
4508  ftemp = tfm;
4509  // IREGCT = 0;
4510  }else{
4511  fdens = densct;
4512  ftemp = tempct;
4513 // ECOR = DMIN1(EIN,0.1D0)
4514  }
4515 
4516  if(ein>=ecr && tfm>=tempct){
4517  ftemp = tfm;
4518  }else{
4519  ftemp = tempct;
4520  }
4521  }
4522  }
4523  }
4524 
4525 
4526  densniv100:
4527 
4528  if(fdens==0.0){
4529  if(a>0.0){
4530 // Parametrization of CT model by Ignatyuk done for masses > 20
4531  ftemp = 17.60/( std::pow(a,0.699) * std::sqrt(1.0+gamma*BSHELLCT));
4532  // ftemp = 1.0 / ( (0.0570 + 0.00193*BSHELLCT) * pow(a,0.6666667)); // from PRC 80 (2009) 054310
4533  }else{
4534  ftemp = 0.5;
4535  }
4536  }
4537 //
4538 // spin cutoff parameter
4539 /*
4540 C PERPENDICULAR AND PARALLEL MOMENT OF INERTIA
4541 c fnorm = R0*M0/hbar**2 = 1.16fm*931.49MeV/c**2 /(6.582122e-22 MeVs)**2 and is
4542 c in units 1/MeV
4543 */
4544  fnorm = std::pow(1.16,2)*931.49*1.e-2/(9.0* std::pow(6.582122,2));
4545 
4546  if(ifis==0 || ifis==2){
4547 /*
4548 C GROUND STATE:
4549 C FP_PER ~ 1+0.5*alpha2, FP_PAR ~ 1-alpha2 (Hasse & Myers, Geom. relat. macr. nucl. phys.)
4550 C alpha2 = std::sqrt(5/(4*pi))*beta2
4551 */
4552  fp_per = 0.4*std::pow(a,5.0/3.0)*fnorm*(1.0+0.50*defbet*std::sqrt(5.0/(4.0*pi)));
4553  fp_par = 0.40*std::pow(a,5.0/3.0)*fnorm*(1.0-defbet*std::sqrt(5.0/(4.0*pi)));
4554 
4555  }else{
4556  if(ifis==1){
4557 /*
4558 C SADDLE POINT
4559 C See Hasse&Myer, p. 100
4560 C Perpendicular moment of inertia
4561 */
4562  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));
4563 // Parallel moment of inertia
4564  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));
4565  }else{
4566  if(ifis==20){
4567 // IMF - two fragments in contact; it is asumed that both are spherical.
4568 // See Hasse&Myers, p.106
4569 // Here, DEFBET = R1/R2, where R1 and R2 are radii of IMF and its partner
4570 // Perpendicular moment of inertia
4571  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);
4572  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);
4573  }
4574  }
4575  }
4576  if(fp_par<0.0)fp_par=0.0;
4577  if(fp_per<0.0)fp_per=0.0;
4578 //
4579  sig_per = std::sqrt(fp_per * ftemp);
4580  sig_par = std::sqrt(fp_par * ftemp);
4581 //
4582  sigma2 = sig_per*sig_per + sig_par*sig_par;
4583  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));
4584  erot = jprf*jprf/(2.0*std::sqrt(fp_par*fp_par+fp_per*fp_per));
4585 //
4586  // collective enhancement
4587  if (optcol == 1) {
4588  qrot(z,a,defbet,sig_per,fecor-erot,&fqr);
4589  }
4590  else {
4591  fqr = 1.0;
4592  }
4593 //
4594  fdens = fdens * fqr *jfact;
4595 //
4596  if(fdens<1e-300)fdens=0.0;
4597 //
4598  *dens =fdens;
4599  *ecor=fecor;
4600  *temp=ftemp;
4601  *qr=fqr;
4602 }
4603 
4605 {
4606 /*
4607 C QROT INCLUDING DAMPING
4608 C
4609 C INPUT: Z,A,DEFBET,SIG,U
4610 C
4611 C OUTPUT: QR - COLLECTIVE ENHANCEMENT FACTOR
4612 C
4613 C SEE JUNGHANS ET AL., NUCL. PHYS. A 629 (1998) 635
4614 C
4615 C
4616 C FR(U) EXPONENTIAL FUNCTION TO DEFINE DAMPING
4617 C UCR CRITICAL ENERGY FOR DAMPING
4618 C DCR WIDTH OF DAMPING
4619 C DEFBET BETA-DEFORMATION !
4620 C SIG PERPENDICULAR SPIN CUTOFF FACTOR
4621 C U ENERGY
4622 C QR COEFFICIENT OF COLLECTIVE ENHANCEMENT
4623 C A MASS NUMBER
4624 C Z CHARGE NUMBER
4625 C
4626 */
4627 // JLRS: July 2016: new values for the collective parameters
4628 //
4629 
4630  G4double ucr = fiss->ucr; // Critical energy for damping.
4631  G4double dcr = fiss->dcr; // Width of damping.
4632  G4double ponq = 0.0, dn = 0.0, n = 0.0, dz = 0.0;
4633  G4int distn,distz,ndist, zdist;
4634  G4int nmn[8]= {2, 8, 14, 20, 28, 50, 82, 126};
4635  G4int nmz[8]= {2, 8, 14, 20, 28, 50, 82, 126};
4636 //
4637  sig = sig*sig;
4638 //
4639  if(std::abs(bet)<=0.15){
4640  goto qrot10;
4641  }else{
4642  goto qrot11;
4643  }
4644 //
4645  qrot10:
4646  n = a - z;
4647  distn = 10000000;
4648  distz = 10000000;
4649 
4650  for(G4int i =0;i<8;i++){
4651  ndist = std::fabs(idnint(n) - nmn[i]);
4652  if(ndist < distn) distn = ndist;
4653  zdist = std::fabs(idnint(z) - nmz[i]);
4654  if(zdist < distz) distz = zdist;
4655  }
4656 
4657  dz = G4float(distz);
4658  dn = G4float(distn);
4659 
4660  bet = 0.022 + 0.003*dn + 0.002*dz;
4661 
4662  sig = 75.0*std::pow(bet,2.) * sig;
4663 
4664 // NO VIBRATIONAL ENHANCEMENT
4665  qrot11:
4666  ponq = (u - ucr)/dcr;
4667 
4668  if (ponq > 700.0) {
4669  ponq = 700.0;
4670  }
4671  if (sig < 1.0) {
4672  sig = 1.0;
4673  }
4674  (*qr) = 1.0/(1.0 + std::exp(ponq)) * (sig - 1.0) + 1.0;
4675 
4676  if ((*qr) < 1.0) {
4677  (*qr) = 1.0;
4678  }
4679 
4680  return;
4681 }
4682 
4684 {
4685  // THIS SUBROUTINE CALCULATES THE ORDINARY LEGENDRE POLYNOMIALS OF
4686  // ORDER 0 TO N-1 OF ARGUMENT X AND STORES THEM IN THE VECTOR PL.
4687  // THEY ARE CALCULATED BY RECURSION RELATION FROM THE FIRST TWO
4688  // POLYNOMIALS.
4689  // WRITTEN BY A.J.SIERK LANL T-9 FEBRUARY, 1984
4690  // NOTE: PL AND X MUST BE G4double PRECISION ON 32-BIT COMPUTERS!
4691 
4692  pl[0] = 1.0;
4693  pl[1] = x;
4694 
4695  for(G4int i = 2; i < n; i++) {
4696  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);
4697  }
4698 }
4699 
4701 {
4702  // CHANGED TO CALCULATE TOTAL BINDING ENERGY INSTEAD OF MASS EXCESS.
4703  // SWITCH FOR PAIRING INCLUDED AS WELL.
4704  // BINDING = EFLMAC(IA,IZ,0,OPTSHP)
4705  // FORTRAN TRANSCRIPT OF /U/GREWE/LANG/EEX/FRLDM.C
4706  // A.J. 15.07.96
4707 
4708  // this function will calculate the liquid-drop nuclear mass for spheri
4709  // configuration according to the preprint NUCLEAR GROUND-STATE
4710  // MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
4711  // All constants are taken from this publication for consistency.
4712 
4713  // Parameters:
4714  // a: nuclear mass number
4715  // z: nuclear charge
4716  // flag: 0 - return mass excess
4717  // otherwise - return pairing (= -1/2 dpn + 1/2 (Dp + Dn))
4718 
4719  G4double eflmacResult = 0.0;
4720 
4721  G4int in = 0;
4722  G4double z = 0.0, n = 0.0, a = 0.0, av = 0.0, as = 0.0;
4723  G4double a0 = 0.0, c1 = 0.0, c4 = 0.0, b1 = 0.0, b3 = 0.0;
4724  G4double ff = 0.0, ca = 0.0, w = 0.0, efl = 0.0;
4725  G4double r0 = 0.0, kf = 0.0, ks = 0.0;
4726  G4double kv = 0.0, rp = 0.0, ay = 0.0, aden = 0.0, x0 = 0.0, y0 = 0.0;
4727  G4double esq = 0.0, ael = 0.0, i = 0.0, e0 = 0.0;
4728  G4double pi = 3.141592653589793238e0;
4729 
4730  // fundamental constants
4731  // electronic charge squared
4732  esq = 1.4399764;
4733 
4734  // constants from considerations other than nucl. masses
4735  // electronic binding
4736  ael = 1.433e-5;
4737 
4738  // proton rms radius
4739  rp = 0.8;
4740 
4741  // nuclear radius constant
4742  r0 = 1.16;
4743 
4744  // range of yukawa-plus-expon. potential
4745  ay = 0.68;
4746 
4747  // range of yukawa function used to generate
4748  // nuclear charge distribution
4749  aden= 0.70;
4750 
4751  // wigner constant
4752  w = 30.0;
4753 
4754  // adjusted parameters
4755  // volume energy
4756  av = 16.00126;
4757 
4758  // volume asymmetry
4759  kv = 1.92240;
4760 
4761  // surface energy
4762  as = 21.18466;
4763 
4764  // surface asymmetry
4765  ks = 2.345;
4766  // a^0 constant
4767  a0 = 2.615;
4768 
4769  // charge asymmetry
4770  ca = 0.10289;
4771 
4772  z = G4double(iz);
4773  a = G4double(ia);
4774  in = ia - iz;
4775  n = G4double(in);
4776 
4777  if(flag==1){goto eflmac311;}
4778 
4779  if(iz<13&&in<3){
4780  if(masses->mexpiop[in][iz]==1){
4781  return masses->bind[in][iz];
4782  }
4783  }
4784 
4785  eflmac311:
4786 
4787  c1 = 3.0/5.0*esq/r0;
4788  c4 = 5.0/4.0*std::pow((3.0/(2.0*pi)),(2.0/3.0)) * c1;
4789  kf = std::pow((9.0*pi*z/(4.0*a)),(1.0/3.0))/r0;
4790 
4791  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));
4792  i = (n-z)/a;
4793 
4794  x0 = r0 * std::pow(a,(1.0/3.0)) / ay;
4795  y0 = r0 * std::pow(a,(1.0/3.0)) / aden;
4796 
4797  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);
4798 
4799  b3 = 1.0 - 5.0/std::pow(y0,2) * (1.0 - 15.0/(8.0*y0) + 21.0/(8.0 * std::pow(y0,3))
4800  - 3.0/4.0 * (1.0 + 9.0/(2.0*y0) + 7.0/std::pow(y0,2)
4801  + 7.0/(2.0 * std::pow(y0,3))) * std::exp(-2.0*y0));
4802 
4803  // now calulation of total binding energy a.j. 16.7.96
4804 
4805  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
4806  + 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))
4807  + ff*std::pow(z,2)/a -ca*(n-z) - ael * std::pow(z,(2.39e0));
4808 
4809  efl = efl + w*std::abs(i);
4810 
4811  // pairing is made optional
4812  if (optshp >= 2) {
4813  // average pairing
4814  if (in==iz && (mod(in,2) == 1) && (mod(iz,2) == 1) && in>0.) {
4815  efl = efl + w/a;
4816  }
4817 
4818 // AK 2008 - Parametrization of CT model by Ignatyuk;
4819 // The following part has been introduced in order to have correspondance
4820 // between pairing in masses and level densities;
4821 // AK 2010 note that E0 is shifted to correspond to pairing shift in
4822 // Fermi-gas model (there, energy is shifted taking odd-odd nuclei
4823 // as bassis)
4824 
4825  G4double para=0.;
4826  parite(a,&para);
4827 
4828  if(para<0.0){
4829 // e-o, o-e
4830  e0 = 0.285+11.17*std::pow(a,-0.464) -0.390-0.00058*(a);
4831  }else{
4832  G4double parz=0.;
4833  parite(z,&parz);
4834  if (parz>0.0){
4835 // e-e
4836  e0 = 22.34*std::pow(a,-0.464)-0.235;
4837  }else{
4838 // o-o
4839  e0 = 0.0;
4840  }
4841  }
4842  efl = efl - e0;
4843  // end if for pairing term
4844  }
4845 
4846  eflmacResult = efl;
4847 
4848  return eflmacResult;
4849 }
4850 
4852 {
4853  // CALCUL DE LA CORRECTION, DUE A L'APPARIEMENT, DE L'ENERGIE DE
4854  // LIAISON D'UN NOYAU
4855  // PROCEDURE FOR CALCULATING THE PAIRING CORRECTION TO THE BINDING
4856  // ENERGY OF A SPECIFIC NUCLEUS
4857 
4858  G4double para = 0.0, parz = 0.0;
4859  // A MASS NUMBER
4860  // Z NUCLEAR CHARGE
4861  // PARA HELP VARIABLE FOR PARITY OF A
4862  // PARZ HELP VARIABLE FOR PARITY OF Z
4863  // DEL PAIRING CORRECTION
4864 
4865  parite(a, &para);
4866 
4867  if (para < 0.0) {
4868  (*del) = 0.0;
4869  }
4870  else {
4871  parite(z, &parz);
4872  if (parz > 0.0) {
4873  (*del) = -12.0/std::sqrt(a);
4874  }
4875  else {
4876  (*del) = 12.0/std::sqrt(a);
4877  }
4878  }
4879 }
4880 
4882 {
4883  // CALCUL DE LA PARITE DU NOMBRE N
4884  //
4885  // PROCEDURE FOR CALCULATING THE PARITY OF THE NUMBER N.
4886  // RETURNS -1 IF N IS ODD AND +1 IF N IS EVEN
4887 
4888  G4double n1 = 0.0, n2 = 0.0, n3 = 0.0;
4889 
4890  // N NUMBER TO BE TESTED
4891  // N1,N2 HELP VARIABLES
4892  // PAR HELP VARIABLE FOR PARITY OF N
4893 
4894  n3 = G4double(idnint(n));
4895  n1 = n3/2.0;
4896  n2 = n1 - dint(n1);
4897 
4898  if (n2 > 0.0) {
4899  (*par) = -1.0;
4900  }
4901  else {
4902  (*par) = 1.0;
4903  }
4904 }
4905 
4907 {
4908  // INPUT : BET, HOMEGA, EF, T
4909  // OUTPUT: TAU - RISE TIME IN WHICH THE FISSION WIDTH HAS REACHED
4910  // 90 PERCENT OF ITS FINAL VALUE
4911  //
4912  // BETA - NUCLEAR VISCOSITY
4913  // HOMEGA - CURVATURE OF POTENTIAL
4914  // EF - FISSION BARRIER
4915  // T - NUCLEAR TEMPERATURE
4916 
4917  G4double tauResult = 0.0;
4918 
4919  G4double tlim = 8.e0 * ef;
4920  if (t > tlim) {
4921  t = tlim;
4922  }
4923  //
4924  if (bet/(std::sqrt(2.0)*10.0*(homega/6.582122)) <= 1.0) {
4925  tauResult = std::log(10.0*ef/t)/(bet*1.0e21);
4926  }
4927  else {
4928  tauResult = std::log(10.0*ef/t)/ (2.0*std::pow((10.0*homega/6.582122),2))*(bet*1.0e-21);
4929  } //end if
4930 
4931  return tauResult;
4932 }
4933 
4935 {
4936  // INPUT : BET, HOMEGA NUCLEAR VISCOSITY + CURVATURE OF POTENTIAL
4937  // OUTPUT: KRAMERS FAKTOR - REDUCTION OF THE FISSION PROBABILITY
4938  // INDEPENDENT OF EXCITATION ENERGY
4939 
4940  G4double rel = bet/(20.0*homega/6.582122);
4941  G4double cramResult = std::sqrt(1.0 + std::pow(rel,2)) - rel;
4942  // limitation introduced 6.1.2000 by khs
4943 
4944  if (cramResult > 1.0) {
4945  cramResult = 1.0;
4946  }
4947 
4948  return cramResult;
4949 }
4950 
4952 {
4953  // CALCULATION OF THE SURFACE BS OR CURVATURE BK OF A NUCLEUS
4954  // RELATIVE TO THE SPHERICAL CONFIGURATION
4955  // BASED ON MYERS, DROPLET MODEL FOR ARBITRARY SHAPES
4956 
4957  // INPUT: IFLAG - 0/1 BK/BS CALCULATION
4958  // Y - (1 - X) COMPLEMENT OF THE FISSILITY
4959 
4960  // LINEAR INTERPOLATION OF BS BK TABLE
4961 
4962  G4int i = 0;
4963 
4964  G4double bipolResult = 0.0;
4965 
4966  const G4int bsbkSize = 54;
4967 
4968  G4double bk[bsbkSize] = {0.0, 1.00000,1.00087,1.00352,1.00799,1.01433,1.02265,1.03306,
4969  1.04576,1.06099,1.07910,1.10056,1.12603,1.15651,1.19348,
4970  1.23915,1.29590,1.35951,1.41013,1.44103,1.46026,1.47339,
4971  1.48308,1.49068,1.49692,1.50226,1.50694,1.51114,1.51502,
4972  1.51864,1.52208,1.52539,1.52861,1.53177,1.53490,1.53803,
4973  1.54117,1.54473,1.54762,1.55096,1.55440,1.55798,1.56173,
4974  1.56567,1.56980,1.57413,1.57860,1.58301,1.58688,1.58688,
4975  1.58688,1.58740,1.58740, 0.0}; //Zeroes at bk[0], and at the end added by PK
4976 
4977  G4double bs[bsbkSize] = {0.0, 1.00000,1.00086,1.00338,1.00750,1.01319,
4978  1.02044,1.02927,1.03974,
4979  1.05195,1.06604,1.08224,1.10085,1.12229,1.14717,1.17623,1.20963,
4980  1.24296,1.26532,1.27619,1.28126,1.28362,1.28458,1.28477,1.28450,
4981  1.28394,1.28320,1.28235,1.28141,1.28042,1.27941,1.27837,1.27732,
4982  1.27627,1.27522,1.27418,1.27314,1.27210,1.27108,1.27006,1.26906,
4983  1.26806,1.26707,1.26610,1.26514,1.26418,1.26325,1.26233,1.26147,
4984  1.26147,1.26147,1.25992,1.25992, 0.0};
4985 
4986  i = idint(y/(2.0e-02)) + 1;
4987 
4988  if((i + 1) >= bsbkSize) {
4989  if(verboseLevel > 2) {
4990  // G4cout <<"G4Abla error: index " << i + 1 << " is greater than array size permits." << G4endl;
4991  }
4992  bipolResult = 0.0;
4993  }
4994  else {
4995  if (iflag == 1) {
4996  bipolResult = bs[i] + (bs[i+1] - bs[i])/2.0e-02 * (y - 2.0e-02*(i - 1));
4997  }
4998  else {
4999  bipolResult = bk[i] + (bk[i+1] - bk[i])/2.0e-02 * (y - 2.0e-02*(i - 1));
5000  }
5001  }
5002 
5003  return bipolResult;
5004 }
5005 
5007 {
5008 /*
5009 c Y 1 - Fissility
5010 c OMEGA Frequency at the ground state, in units 1.e-21 s
5011 */
5012  G4double OMEGA,HOMEGA,ES0,MR02;
5013 
5014  ES0 = 20.760*std::pow(AF,2.0/3.0);
5015 // In units 1.e-42 MeVs**2; r0 = 1.175e-15 m, u=931.49MeV/c**2=103.4MeV*s**2/m**2
5016 // divided by 1.e-4 to go from 1.e-46 to 1.e-42
5017  MR02 = std::pow(AF,5.0/3.0)*1.0340*0.010*1.175*1.175;
5018 // Determination of the inertia of the fission collective degree of freedom
5019  (*MFCD) = MR02 * 3.0/10.0*(1.0+3.0*Y);
5020 // Omega at saddle
5021  OMEGA = std::sqrt(ES0/MR02)*std::sqrt(8.0/3.0*Y*(1.0+304.0*Y/255.0));
5022 //
5023  HOMEGA = 6.58122*OMEGA/10.0;
5024 //
5025  (*sOMEGA)=OMEGA;
5026  (*sHOMEGA)=HOMEGA;
5027 //
5028  return;
5029 }
5030 
5031 
5033 {
5034 /*
5035 c Y 1 - Fissility
5036 c OMEGA Frequency at the ground state, in units 1.e-21 s
5037 */
5038  G4double OMEGA,HOMEGA,MR02,MINERT,C,fk1;
5039 //
5040  MR02 = std::pow(AF,5.0/3.0)*1.0340*0.01*1.175*1.175;
5041  MINERT = 3.*MR02/10.0;
5042  C = 17.9439*(1.-1.7826*std::pow((AF-2.0*ZF)/AF,2));
5043  fk1 = 0.4*C*std::pow(AF,2.0/3.0)-0.1464*std::pow(ZF,2)/std::pow(AF,1./3.);
5044  OMEGA = std::sqrt(fk1/MINERT);
5045  HOMEGA = 6.58122*OMEGA/10.0;
5046 //
5047  (*K1)=fk1;
5048  (*sOMEGA)=OMEGA;
5049  (*sHOMEGA)=HOMEGA;
5050 //
5051  return;
5052 }
5053 
5055 {/*
5056 C AK 2004 - Barriers for LCP and IMF are calculated now according to the
5057 C Bass model (Nucl. Phys. A (1974))
5058 C KHS 2007 - To speed up, barriers are read from tabels; in case thermal
5059 C expansion is considered, barriers are calculated.
5060 C INPUT:
5061 C EA - Excitation energy per nucleon
5062 C Z11, A11 - Charge and mass of daughter nucleus
5063 C Z22, A22 - Charge and mass of LCP or IMF
5064 C
5065 C OUTPUT:
5066 C BARR - Barrier
5067 C OMEGA - Curvature of the potential
5068 C
5069 C BASS MODEL NPA 1974 - used only if expansion is considered (OPTEXP=1)
5070 C or one wants this model explicitely (OPTBAR=1)
5071 C October 2011 - AK - new parametrization of the barrier and its position,
5072 C see W.W. Qu et al., NPA 868 (2011) 1; this is now
5073 C default option (OPTBAR=0)
5074 c
5075 c November 2016 - JLRS - Added this function from abla07v4
5076 c
5077 */
5078  G4double BARR, OMEGA, RMAX;
5079  RMAX = 1.1 * (ecld->rms[A1-Z1][Z1]+ecld->rms[A2-Z2][Z2]) + 2.8;
5080  BARR = 1.345 * Z1 * Z2 / RMAX;
5081 //C Omega according to Avishai:
5082  OMEGA = 4.5 / 197.3287;
5083 //
5084  (*sOMEGA)=OMEGA;
5085  (*sBARR)=BARR;
5086 //
5087  return;
5088 }
5089 
5090 void G4Abla::barfit(G4int iz, G4int ia, G4int il, G4double *sbfis, G4double *segs, G4double *selmax)
5091 {
5092  // 2223 C VERSION FOR 32BIT COMPUTER
5093  // 2224 C THIS SUBROUTINE RETURNS THE BARRIER HEIGHT BFIS, THE
5094  // 2225 C GROUND-STATE ENERGY SEGS, IN MEV, AND THE ANGULAR MOMENTUM
5095  // 2226 C AT WHICH THE FISSION BARRIER DISAPPEARS, LMAX, IN UNITS OF
5096  // 2227 C H-BAR, WHEN CALLED WITH INTEGER AGUMENTS IZ, THE ATOMIC
5097  // 2228 C NUMBER, IA, THE ATOMIC MASS NUMBER, AND IL, THE ANGULAR
5098  // 2229 C MOMENTUM IN UNITS OF H-BAR. (PLANCK'S CONSTANT DIVIDED BY
5099  // 2230 C 2*PI).
5100  // 2231 C
5101  // 2232 C THE FISSION BARRIER FO IL = 0 IS CALCULATED FROM A 7TH
5102  // 2233 C ORDER FIT IN TWO VARIABLES TO 638 CALCULATED FISSION
5103  // 2234 C BARRIERS FOR Z VALUES FROM 20 TO 110. THESE 638 BARRIERS ARE
5104  // 2235 C FIT WITH AN RMS DEVIATION OF 0.10 MEV BY THIS 49-PARAMETER
5105  // 2236 C FUNCTION.
5106  // 2237 C IF BARFIT IS CALLED WITH (IZ,IA) VALUES OUTSIDE THE RANGE OF
5107  // 2238 C THE BARRIER HEIGHT IS SET TO 0.0, AND A MESSAGE IS PRINTED
5108  // 2239 C ON THE DEFAULT OUTPUT FILE.
5109  // 2240 C
5110  // 2241 C FOR IL VALUES NOT EQUAL TO ZERO, THE VALUES OF L AT WHICH
5111  // 2242 C THE BARRIER IS 80% AND 20% OF THE L=0 VALUE ARE RESPECTIVELY
5112  // 2243 C FIT TO 20-PARAMETER FUNCTIONS OF Z AND A, OVER A MORE
5113  // 2244 C RESTRICTED RANGE OF A VALUES, THAN IS THE CASE FOR L = 0.
5114  // 2245 C THE VALUE OF L WHERE THE BARRIER DISAPPEARS, LMAX IS FIT TO
5115  // 2246 C A 24-PARAMETER FUNCTION OF Z AND A, WITH THE SAME RANGE OF
5116  // 2247 C Z AND A VALUES AS L-80 AND L-20.
5117  // 2248 C ONCE AGAIN, IF AN (IZ,IA) PAIR IS OUTSIDE OF THE RANGE OF
5118  // 2249 C VALIDITY OF THE FIT, THE BARRIER VALUE IS SET TO 0.0 AND A
5119  // 2250 C MESSAGE IS PRINTED. THESE THREE VALUES (BFIS(L=0),L-80, AND
5120  // 2251 C L-20) AND THE CONSTRINTS OF BFIS = 0 AND D(BFIS)/DL = 0 AT
5121  // 2252 C L = LMAX AND L=0 LEAD TO A FIFTH-ORDER FIT TO BFIS(L) FOR
5122  // 2253 C L>L-20. THE FIRST THREE CONSTRAINTS LEAD TO A THIRD-ORDER FIT
5123  // 2254 C FOR THE REGION L < L-20.
5124  // 2255 C
5125  // 2256 C THE GROUND STATE ENERGIES ARE CALCULATED FROM A
5126  // 2257 C 120-PARAMETER FIT IN Z, A, AND L TO 214 GROUND-STATE ENERGIES
5127  // 2258 C FOR 36 DIFFERENT Z AND A VALUES.
5128  // 2259 C (THE RANGE OF Z AND A IS THE SAME AS FOR L-80, L-20, AND
5129  // 2260 C L-MAX)
5130  // 2261 C
5131  // 2262 C THE CALCULATED BARRIERS FROM WHICH THE FITS WERE MADE WERE
5132  // 2263 C CALCULATED IN 1983-1984 BY A. J. SIERK OF LOS ALAMOS
5133  // 2264 C NATIONAL LABORATORY GROUP T-9, USING YUKAWA-PLUS-EXPONENTIAL
5134  // 2265 C G4DOUBLE FOLDED NUCLEAR ENERGY, EXACT COULOMB DIFFUSENESS
5135  // 2266 C CORRECTIONS, AND DIFFUSE-MATTER MOMENTS OF INERTIA.
5136  // 2267 C THE PARAMETERS OF THE MODEL R-0 = 1.16 FM, AS 21.13 MEV,
5137  // 2268 C KAPPA-S = 2.3, A = 0.68 FM.
5138  // 2269 C THE DIFFUSENESS OF THE MATTER AND CHARGE DISTRIBUTIONS USED
5139  // 2270 C CORRESPONDS TO A SURFACE DIFFUSENESS PARAMETER (DEFINED BY
5140  // 2271 C MYERS) OF 0.99 FM. THE CALCULATED BARRIERS FOR L = 0 ARE
5141  // 2272 C ACCURATE TO A LITTLE LESS THAN 0.1 MEV; THE OUTPUT FROM
5142  // 2273 C THIS SUBROUTINE IS A LITTLE LESS ACCURATE. WORST ERRORS MAY BE
5143  // 2274 C AS LARGE AS 0.5 MEV; CHARACTERISTIC UNCERTAINY IS IN THE RANGE
5144  // 2275 C OF 0.1-0.2 MEV. THE RMS DEVIATION OF THE GROUND-STATE FIT
5145  // 2276 C FROM THE 214 INPUT VALUES IS 0.20 MEV. THE MAXIMUM ERROR
5146  // 2277 C OCCURS FOR LIGHT NUCLEI IN THE REGION WHERE THE GROUND STATE
5147  // 2278 C IS PROLATE, AND MAY BE GREATER THAN 1.0 MEV FOR VERY NEUTRON
5148  // 2279 C DEFICIENT NUCLEI, WITH L NEAR LMAX. FOR MOST NUCLEI LIKELY TO
5149  // 2280 C BE ENCOUNTERED IN REAL EXPERIMENTS, THE MAXIMUM ERROR IS
5150  // 2281 C CLOSER TO 0.5 MEV, AGAIN FOR LIGHT NUCLEI AND L NEAR LMAX.
5151  // 2282 C
5152  // 2283 C WRITTEN BY A. J. SIERK, LANL T-9
5153  // 2284 C VERSION 1.0 FEBRUARY, 1984
5154  // 2285 C
5155  // 2286 C THE FOLLOWING IS NECESSARY FOR 32-BIT MACHINES LIKE DEC VAX,
5156  // 2287 C IBM, ETC
5157 
5158  G4double pa[7],pz[7],pl[10];
5159  for(G4int init_i = 0; init_i < 7; init_i++) {
5160  pa[init_i] = 0.0;
5161  pz[init_i] = 0.0;
5162  }
5163  for(G4int init_i = 0; init_i < 10; init_i++) {
5164  pl[init_i] = 0.0;
5165  }
5166 
5167  G4double a = 0.0, z = 0.0, amin = 0.0, amax = 0.0, amin2 = 0.0;
5168  G4double amax2 = 0.0, aa = 0.0, zz = 0.0, bfis = 0.0;
5169  G4double bfis0 = 0.0, ell = 0.0, el = 0.0, egs = 0.0, el80 = 0.0, el20 = 0.0;
5170  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;
5171  G4double aj = 0.0, ak = 0.0, a1 = 0.0, a2 = 0.0;
5172 
5173  G4int i = 0, j = 0, k = 0, m = 0;
5174  G4int l = 0;
5175 
5176  G4double emncof[4][5] = {{-9.01100e+2,-1.40818e+3, 2.77000e+3,-7.06695e+2, 8.89867e+2},
5177  {1.35355e+4,-2.03847e+4, 1.09384e+4,-4.86297e+3,-6.18603e+2},
5178  {-3.26367e+3, 1.62447e+3, 1.36856e+3, 1.31731e+3, 1.53372e+2},
5179  {7.48863e+3,-1.21581e+4, 5.50281e+3,-1.33630e+3, 5.05367e-2}};
5180 
5181  G4double elmcof[4][5] = {{1.84542e+3,-5.64002e+3, 5.66730e+3,-3.15150e+3, 9.54160e+2},
5182  {-2.24577e+3, 8.56133e+3,-9.67348e+3, 5.81744e+3,-1.86997e+3},
5183  {2.79772e+3,-8.73073e+3, 9.19706e+3,-4.91900e+3, 1.37283e+3},
5184  {-3.01866e+1, 1.41161e+3,-2.85919e+3, 2.13016e+3,-6.49072e+2}};
5185 
5186  G4double emxcof[4][6] = {{9.43596e4,-2.241997e5,2.223237e5,-1.324408e5,4.68922e4,-8.83568e3},
5187  {-1.655827e5,4.062365e5,-4.236128e5,2.66837e5,-9.93242e4,1.90644e4},
5188  {1.705447e5,-4.032e5,3.970312e5,-2.313704e5,7.81147e4,-1.322775e4},
5189  {-9.274555e4,2.278093e5,-2.422225e5,1.55431e5,-5.78742e4,9.97505e3}};
5190 
5191  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},
5192  {-1.13269453e+6, 2.97764590e+6,-4.54326326e+6, 3.00464870e+6, -1.44989274e+6,-1.02026610e+5, 6.27959815e+4},
5193  {1.37543304e+6,-3.65808988e+6, 5.47798999e+6,-3.78109283e+6, 1.84131765e+6, 1.53669695e+4,-6.96817834e+4},
5194  {-8.56559835e+5, 2.48872266e+6,-4.07349128e+6, 3.12835899e+6, -1.62394090e+6, 1.19797378e+5, 4.25737058e+4},
5195  {3.28723311e+5,-1.09892175e+6, 2.03997269e+6,-1.77185718e+6, 9.96051545e+5,-1.53305699e+5,-1.12982954e+4},
5196  {4.15850238e+4, 7.29653408e+4,-4.93776346e+5, 6.01254680e+5, -4.01308292e+5, 9.65968391e+4,-3.49596027e+3},
5197  {-1.82751044e+5, 3.91386300e+5,-3.03639248e+5, 1.15782417e+5, -4.24399280e+3,-6.11477247e+3, 3.66982647e+2}};
5198 
5199  const G4int sizex = 5;
5200  const G4int sizey = 6;
5201  const G4int sizez = 4;
5202 
5203  G4double egscof[sizey][sizey][sizez];
5204 
5205  G4double egs1[sizey][sizex] = {{1.927813e5, 7.666859e5, 6.628436e5, 1.586504e5,-7.786476e3},
5206  {-4.499687e5,-1.784644e6,-1.546968e6,-4.020658e5,-3.929522e3},
5207  {4.667741e5, 1.849838e6, 1.641313e6, 5.229787e5, 5.928137e4},
5208  {-3.017927e5,-1.206483e6,-1.124685e6,-4.478641e5,-8.682323e4},
5209  {1.226517e5, 5.015667e5, 5.032605e5, 2.404477e5, 5.603301e4},
5210  {-1.752824e4,-7.411621e4,-7.989019e4,-4.175486e4,-1.024194e4}};
5211 
5212  G4double egs2[sizey][sizex] = {{-6.459162e5,-2.903581e6,-3.048551e6,-1.004411e6,-6.558220e4},
5213  {1.469853e6, 6.564615e6, 6.843078e6, 2.280839e6, 1.802023e5},
5214  {-1.435116e6,-6.322470e6,-6.531834e6,-2.298744e6,-2.639612e5},
5215  {8.665296e5, 3.769159e6, 3.899685e6, 1.520520e6, 2.498728e5},
5216  {-3.302885e5,-1.429313e6,-1.512075e6,-6.744828e5,-1.398771e5},
5217  {4.958167e4, 2.178202e5, 2.400617e5, 1.167815e5, 2.663901e4}};
5218 
5219  G4double egs3[sizey][sizex] = {{3.117030e5, 1.195474e6, 9.036289e5, 6.876190e4,-6.814556e4},
5220  {-7.394913e5,-2.826468e6,-2.152757e6,-2.459553e5, 1.101414e5},
5221  {7.918994e5, 3.030439e6, 2.412611e6, 5.228065e5, 8.542465e3},
5222  {-5.421004e5,-2.102672e6,-1.813959e6,-6.251700e5,-1.184348e5},
5223  {2.370771e5, 9.459043e5, 9.026235e5, 4.116799e5, 1.001348e5},
5224  {-4.227664e4,-1.738756e5,-1.795906e5,-9.292141e4,-2.397528e4}};
5225 
5226  G4double egs4[sizey][sizex] = {{-1.072763e5,-5.973532e5,-6.151814e5, 7.371898e4, 1.255490e5},
5227  {2.298769e5, 1.265001e6, 1.252798e6,-2.306276e5,-2.845824e5},
5228  {-2.093664e5,-1.100874e6,-1.009313e6, 2.705945e5, 2.506562e5},
5229  {1.274613e5, 6.190307e5, 5.262822e5,-1.336039e5,-1.115865e5},
5230  {-5.715764e4,-2.560989e5,-2.228781e5,-3.222789e3, 1.575670e4},
5231  {1.189447e4, 5.161815e4, 4.870290e4, 1.266808e4, 2.069603e3}};
5232 
5233  for(i = 0; i < sizey; i++) {
5234  for(j = 0; j < sizex; j++) {
5235  egscof[i][j][0] = egs1[i][j];
5236  egscof[i][j][1] = egs2[i][j];
5237  egscof[i][j][2] = egs3[i][j];
5238  egscof[i][j][3] = egs4[i][j];
5239  }
5240  }
5241 
5242  // the program starts here
5243  if (iz < 19 || iz > 111) {
5244  goto barfit900;
5245  }
5246 
5247  if(iz > 102 && il > 0) {
5248  goto barfit902;
5249  }
5250 
5251  z=G4double(iz);
5252  a=G4double(ia);
5253  el=G4double(il);
5254  amin= 1.2e0*z + 0.01e0*z*z;
5255  amax= 5.8e0*z - 0.024e0*z*z;
5256 
5257  if(a < amin || a > amax) {
5258  goto barfit910;
5259  }
5260 
5261  // angul.mom.zero barrier
5262  aa=2.5e-3*a;
5263  zz=1.0e-2*z;
5264  ell=1.0e-2*el;
5265  bfis0 = 0.0;
5266  lpoly(zz,7,pz);
5267  lpoly(aa,7,pa);
5268 
5269  for(i = 0; i < 7; i++) { //do 10 i=1,7
5270  for(j = 0; j < 7; j++) { //do 10 j=1,7
5271  bfis0=bfis0+elzcof[j][i]*pz[i]*pa[j];
5272  }
5273  }
5274 
5275  bfis=bfis0;
5276 
5277  (*sbfis)=bfis;
5278  egs=0.0;
5279  (*segs)=egs;
5280 
5281  // values of l at which the barrier
5282  // is 20%(el20) and 80%(el80) of l=0 value
5283  amin2 = 1.4e0*z + 0.009e0*z*z;
5284  amax2 = 20.e0 + 3.0e0*z;
5285 
5286  if((a < amin2-5.e0 || a > amax2+10.e0) && il > 0) {
5287  goto barfit920;
5288  }
5289 
5290  lpoly(zz,5,pz);
5291  lpoly(aa,4,pa);
5292  el80=0.0;
5293  el20=0.0;
5294  elmax=0.0;
5295 
5296  for(i = 0; i < 4; i++) {
5297  for(j = 0; j < 5; j++) {
5298  el80 = el80 + elmcof[i][j]*pz[j]*pa[i];
5299  el20 = el20 + emncof[i][j]*pz[j]*pa[i];
5300  }
5301  }
5302 
5303  sel80 = el80;
5304  sel20 = el20;
5305 
5306  // value of l (elmax) where barrier disapp.
5307  lpoly(zz,6,pz);
5308  lpoly(ell,9,pl);
5309 
5310  for(i = 0; i < 4; i++) { //do 30 i= 1,4
5311  for(j = 0; j < 6; j++) { //do 30 j=1,6
5312  elmax = elmax + emxcof[i][j]*pz[j]*pa[i];
5313  }
5314  }
5315 
5316  (*selmax)=elmax;
5317 
5318  // value of barrier at ang.mom. l
5319  if(il < 1){
5320  return;
5321  }
5322 
5323  x = sel20/(*selmax);
5324  y = sel80/(*selmax);
5325 
5326  if(el <= sel20) {
5327  // low l
5328  q = 0.2/(std::pow(sel20,2)*std::pow(sel80,2)*(sel20-sel80));
5329  qa = q*(4.0*std::pow(sel80,3) - std::pow(sel20,3));
5330  qb = -q*(4.0*std::pow(sel80,2) - std::pow(sel20,2));
5331  bfis = bfis*(1.0 + qa*std::pow(el,2) + qb*std::pow(el,3));
5332  }
5333  else {
5334  // high l
5335  aj = (-20.0*std::pow(x,5) + 25.e0*std::pow(x,4) - 4.0)*std::pow((y-1.0),2)*y*y;
5336  ak = (-20.0*std::pow(y,5) + 25.0*std::pow(y,4) - 1.0) * std::pow((x-1.0),2)*x*x;
5337  q = 0.2/(std::pow((y-x)*((1.0-x)*(1.0-y)*x*y),2));
5338  qa = q*(aj*y - ak*x);
5339  qb = -q*(aj*(2.0*y + 1.0) - ak*(2.0*x + 1.0));
5340  z = el/(*selmax);
5341  a1 = 4.0*std::pow(z,5) - 5.0*std::pow(z,4) + 1.0;
5342  a2 = qa*(2.e0*z + 1.e0);
5343  bfis=bfis*(a1 + (z - 1.e0)*(a2 + qb*z)*z*z*(z - 1.e0));
5344  }
5345 
5346  if(bfis <= 0.0) {
5347  bfis=0.0;
5348  }
5349 
5350  if(el > (*selmax)) {
5351  bfis=0.0;
5352  }
5353  (*sbfis)=bfis;
5354 
5355  // now calculate rotating ground state energy
5356  if(el > (*selmax)) {
5357  return;
5358  }
5359 
5360  for(k = 0; k < 4; k++) {
5361  for(l = 0; l < 6; l++) {
5362  for(m = 0; m < 5; m++) {
5363  egs = egs + egscof[l][m][k]*pz[l]*pa[k]*pl[2*m];
5364  }
5365  }
5366  }
5367 
5368  (*segs)=egs;
5369  if((*segs) < 0.0) {
5370  (*segs)=0.0;
5371  }
5372 
5373  return;
5374 
5375  barfit900: //continue
5376  (*sbfis)=0.0;
5377  // for z<19 sbfis set to 1.0e3
5378  if (iz < 19) {
5379  (*sbfis) = 1.0e3;
5380  }
5381  (*segs)=0.0;
5382  (*selmax)=0.0;
5383  return;
5384 
5385  barfit902:
5386  (*sbfis)=0.0;
5387  (*segs)=0.0;
5388  (*selmax)=0.0;
5389  return;
5390 
5391  barfit910:
5392  (*sbfis)=0.0;
5393  (*segs)=0.0;
5394  (*selmax)=0.0;
5395  return;
5396 
5397  barfit920:
5398  (*sbfis)=0.0;
5399  (*segs)=0.0;
5400  (*selmax)=0.0;
5401  return;
5402 }
5403 
5405 {
5406  G4double ferf;
5407 
5408  if(x<0.){
5409  ferf=-gammp(0.5,x*x);
5410  }else{
5411  ferf=gammp(0.5,x*x);;
5412  }
5413  return ferf;
5414 }
5415 
5417 {
5418  G4double fgammp;
5419  G4double gammcf,gamser,gln=0.;
5420 
5421  if(x<0.0 || a<=0.0)std::cout << "G4Abla::gammp = bad arguments in gammp" << std::endl;
5422  if(x<a+1.){
5423  gser(&gamser,a,x,gln);
5424  fgammp=gamser;
5425  }else{
5426  gcf(&gammcf,a,x,gln);
5427  fgammp=1.-gammcf;
5428  }
5429  return fgammp;
5430 }
5431 
5433 {
5434  G4double fgammcf,del;
5435  G4double eps=3e-7;
5436  G4double fpmin=1e-30;
5437  G4int itmax=100;
5438  G4double an,b,c,d,h;
5439 
5440  gln=gammln(a);
5441  b=x+1.-a;
5442  c=1./fpmin;
5443  d=1./b;
5444  h=d;
5445  for(G4int i=1;i<=itmax;i++){
5446  an=-i*(i-a);
5447  b=b+2.;
5448  d=an*d+b;
5449  if(std::fabs(d)<fpmin)d=fpmin;
5450  c=b+an/c;
5451  if(std::fabs(c)<fpmin)c=fpmin;
5452  d=1.0/d;
5453  del=d*c;
5454  h=h*del;
5455  if(std::fabs(del-1.)<eps)goto dir1;
5456  }
5457  std::cout << "a too large, ITMAX too small in gcf" << std::endl;
5458  dir1:
5459  fgammcf=std::exp(-x+a*std::log(x)-gln)*h;
5460  (*gammcf)=fgammcf;
5461  return;
5462 }
5463 
5465 {
5466  G4double fgamser,ap,sum,del;
5467  G4double eps=3e-7;
5468  G4int itmax=100;
5469 
5470  gln=gammln(a);
5471  if(x<=0.){
5472  if(x<0.)std::cout << "G4Abla::gser = x < 0 in gser" << std::endl;
5473  (*gamser)=0.0;
5474  return;
5475  }
5476  ap=a;
5477  sum=1./a;
5478  del=sum;
5479  for(G4int n=0;n<itmax;n++){
5480  ap=ap+1.;
5481  del=del*x/ap;
5482  sum=sum+del;
5483  if(std::fabs(del)<std::fabs(sum)*eps)goto dir1;
5484  }
5485  std::cout << "a too large, ITMAX too small in gser" << std::endl;
5486  dir1:
5487  fgamser=sum*std::exp(-x+a*std::log(x)-gln);
5488  (*gamser)=fgamser;
5489  return;
5490 }
5491 
5493 {
5494  G4double fgammln,x,ser,tmp,y;
5495  G4double cof[6]={76.18009172947146,-86.50532032941677,24.01409824083091,
5496 -1.231739572450155,0.1208650973866179e-2,-0.5395239384953e-5};
5497  G4double stp=2.5066282746310005;
5498 
5499  x=xx;
5500  y=x;
5501  tmp=x+5.5;
5502  tmp=(x+0.5)*std::log(tmp)-tmp;
5503  ser=1.000000000190015;
5504  for(G4int j=0;j<6;j++){
5505  y=y+1.;
5506  ser=ser+cof[j]/y;
5507  }
5508 
5509  return fgammln=tmp+std::log(stp*ser/x);
5510 }
5511 
5512 
5514 {
5515  // DISTRIBUTION DE MAXWELL
5516 
5517  return (E*std::exp(-E));
5518 }
5519 
5521 {
5522  // FONCTION INTEGRALE DE FD(E)
5523  return (1.0 - (E + 1.0) * std::exp(-E));
5524 }
5525 
5527 {
5528  return ( -x*std::log(G4AblaRandom::flat()) -x*std::log(G4AblaRandom::flat()) -x*std::log(G4AblaRandom::flat()) ) ;
5529 }
5530 
5532 {
5533  // tirage aleatoire dans une maxwellienne
5534  // t : temperature
5535  //
5536  // declaration des variables
5537  //
5538 
5539  const G4int pSize = 101;
5540  G4double p[pSize];
5541 
5542  // ial generateur pour le cascade (et les iy pour eviter les correlations)
5543  G4int i = 0;
5544  G4int itest = 0;
5545  // programme principal
5546 
5547  // calcul des p(i) par approximation de newton
5548  p[pSize-1] = 8.0;
5549  G4double x = 0.1;
5550  G4double x1 = 0.0;
5551  G4double y = 0.0;
5552 
5553  if (itest == 1) {
5554  goto fmaxhaz120;
5555  }
5556 
5557  for(i = 1; i <= 99; i++) {
5558  fmaxhaz20:
5559  x1 = x - (f(x) - G4double(i)/100.0)/fd(x);
5560  x = x1;
5561  if (std::fabs(f(x) - G4double(i)/100.0) < 1e-5) {
5562  goto fmaxhaz100;
5563  }
5564  goto fmaxhaz20;
5565  fmaxhaz100:
5566  p[i] = x;
5567  } //end do
5568 
5569  // itest = 1;
5570  itest = 0;
5571  // tirage aleatoire et calcul du x correspondant
5572  // par regression lineaire
5573  fmaxhaz120:
5574  y = G4AblaRandom::flat();
5575  i = nint(y*100);
5576 
5577  // 2590 c ici on evite froidement les depassements de tableaux....(a.b. 3/9/99)
5578  if(i == 0) {
5579  goto fmaxhaz120;
5580  }
5581 
5582  if (i == 1) {
5583  x = p[i]*y*100;
5584  }
5585  else {
5586  x = (p[i] - p[i-1])*(y*100 - i) + p[i];
5587  }
5588 
5589  return(x*T);
5590 }
5591 
5593 {
5594  // PACE2
5595  // Cette fonction retourne le defaut de masse du noyau A,Z en MeV
5596  // Revisee pour a, z flottants 25/4/2002 =
5597 
5598  G4double fpace2 = 0.0;
5599 
5600  G4int ii = idint(a+0.5);
5601  G4int jj = idint(z+0.5);
5602 
5603  if(ii <= 0 || jj < 0) {
5604  fpace2=0.;
5605  return fpace2;
5606  }
5607 
5608  if(jj > 300) {
5609  fpace2=0.0;
5610  }
5611  else {
5612  fpace2=pace->dm[ii][jj];
5613  }
5614  fpace2=fpace2/1000.;
5615 
5616  if(pace->dm[ii][jj] == 0.) {
5617  if(ii < 12) {
5618  fpace2=-500.;
5619  }
5620  else {
5621  guet(&a, &z, &fpace2);
5622  fpace2=fpace2-ii*931.5;
5623  fpace2=fpace2/1000.;
5624  }
5625  }
5626 
5627  return fpace2;
5628 }
5629 
5630 void G4Abla::guet(G4double *x_par, G4double *z_par, G4double *find_par)
5631 {
5632  // TABLE DE MASSES ET FORMULE DE MASSE TIRE DU PAPIER DE BRACK-GUET
5633  // Gives the theoritical value for mass excess...
5634  // Revisee pour x, z flottants 25/4/2002
5635 
5636  //real*8 x,z
5637  // dimension q(0:50,0:70)
5638  G4double x = (*x_par);
5639  G4double z = (*z_par);
5640  G4double find = (*find_par);
5641 
5642  const G4int qrows = 50;
5643  const G4int qcols = 70;
5644  G4double q[qrows][qcols];
5645  for(G4int init_i = 0; init_i < qrows; init_i++) {
5646  for(G4int init_j = 0; init_j < qcols; init_j++) {
5647  q[init_i][init_j] = 0.0;
5648  }
5649  }
5650 
5651  G4int ix=G4int(std::floor(x+0.5));
5652  G4int iz=G4int(std::floor(z+0.5));
5653  G4double zz = iz;
5654  G4double xx = ix;
5655  find = 0.0;
5656  G4double avol = 15.776;
5657  G4double asur = -17.22;
5658  G4double ac = -10.24;
5659  G4double azer = 8.0;
5660  G4double xjj = -30.03;
5661  G4double qq = -35.4;
5662  G4double c1 = -0.737;
5663  G4double c2 = 1.28;
5664 
5665  if(ix <= 7) {
5666  q[0][1]=939.50;
5667  q[1][1]=938.21;
5668  q[1][2]=1876.1;
5669  q[1][3]=2809.39;
5670  q[2][4]=3728.34;
5671  q[2][3]=2809.4;
5672  q[2][5]=4668.8;
5673  q[2][6]=5606.5;
5674  q[3][5]=4669.1;
5675  q[3][6]=5602.9;
5676  q[3][7]=6535.27;
5677  q[4][6]=5607.3;
5678  q[4][7]=6536.1;
5679  q[5][7]=6548.3;
5680  find=q[iz][ix];
5681  }
5682  else {
5683  G4double xneu=xx-zz;
5684  G4double si=(xneu-zz)/xx;
5685  G4double x13=std::pow(xx,.333);
5686  G4double ee1=c1*zz*zz/x13;
5687  G4double ee2=c2*zz*zz/xx;
5688  G4double aux=1.+(9.*xjj/4./qq/x13);
5689  G4double ee3=xjj*xx*si*si/aux;
5690  G4double ee4=avol*xx+asur*(std::pow(xx,.666))+ac*x13+azer;
5691  G4double tota = ee1 + ee2 + ee3 + ee4;
5692  find = 939.55*xneu+938.77*zz - tota;
5693  }
5694 
5695  (*x_par) = x;
5696  (*z_par) = z;
5697  (*find_par) = find;
5698 }
5699 //
5700 
5701 void G4Abla::FillData(G4int IMULTBU,G4int IEV_TAB){
5702 
5703  const G4double c = 29.9792458;
5704  const G4double fmp = 938.27231,fmn=939.56563;
5705 
5706  varntp->ntrack = IMULTBU + IEV_TAB;
5707 
5708  G4int intp=0;
5709 
5710  for(G4int i=0;i<IMULTBU;i++){
5711 
5712  G4int iz = nint(BU_TAB[i][7]);
5713  G4int ia = nint(BU_TAB[i][8]);
5714 
5715  varntp->zvv[intp] = iz;
5716  varntp->avv[intp] = ia;
5717  varntp->itypcasc[intp] = 0;
5718 
5719  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];
5720  G4double gamma = std::sqrt(1.0 - v2 / (c*c));
5721  G4double avvmass = iz*fmp + (ia-iz)*fmn + eflmac(ia,iz,0,3);
5722  G4double etot = avvmass / gamma;
5723  varntp->pxlab[intp] = etot * BU_TAB[i][4] / c;
5724  varntp->pylab[intp] = etot * BU_TAB[i][5] / c;
5725  varntp->pzlab[intp] = etot * BU_TAB[i][6] / c;
5726  varntp->enerj[intp] = etot - avvmass;
5727  intp++;
5728  }
5729 
5730 
5731  for(G4int i=0;i<IEV_TAB;i++){
5732 
5733  G4int iz = nint(EV_TAB[i][0]);
5734  G4int ia = nint(EV_TAB[i][1]);
5735 
5736  varntp->zvv[intp] = iz;
5737  varntp->avv[intp] = ia;
5738  varntp->itypcasc[intp] = 0;
5739 
5740  if(ia>0){
5741  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];
5742  G4double gamma = std::sqrt(1.0 - v2 / (c*c));
5743  G4double avvmass = iz*fmp + (ia-iz)*fmn + eflmac(ia,iz,0,3);
5744  G4double etot = avvmass / gamma;
5745  varntp->pxlab[intp] = etot * EV_TAB[i][2] / c;
5746  varntp->pylab[intp] = etot * EV_TAB[i][3] / c;
5747  varntp->pzlab[intp] = etot * EV_TAB[i][4] / c;
5748  varntp->enerj[intp] = etot - avvmass;
5749  }else{
5750  varntp->pxlab[intp] = EV_TAB[i][2];
5751  varntp->pylab[intp] = EV_TAB[i][3];
5752  varntp->pzlab[intp] = EV_TAB[i][4];
5753  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]);
5754  }
5755  intp++;
5756  }
5757 
5758 return;
5759 }
5760 
5761 // Utilities
5762 
5764 {
5765  if(a < b) {
5766  return a;
5767  }
5768  else {
5769  return b;
5770  }
5771 }
5772 
5774 {
5775  if(a < b) {
5776  return a;
5777  }
5778  else {
5779  return b;
5780  }
5781 }
5782 
5784 {
5785  if(a > b) {
5786  return a;
5787  }
5788  else {
5789  return b;
5790  }
5791 }
5792 
5794 {
5795  if(a > b) {
5796  return a;
5797  }
5798  else {
5799  return b;
5800  }
5801 }
5802 
5804 // A function that assigns the sign of the second argument to the
5805 // absolute value of the first
5806 
5807  if(b>=0){
5808  return std::abs(a);
5809  }else{
5810  return -1.0*std::abs(a);
5811  }
5812  return 0;
5813 }
5814 
5816 // A function that assigns the sign of the second argument to the
5817 // absolute value of the first
5818 
5819  if(b>=0){
5820  return std::abs(a);
5821  }else{
5822  return -1*std::abs(a);
5823  }
5824  return 0;
5825 }
5826 
5828 {
5829  G4double intpart = 0.0;
5830  G4double fractpart = 0.0;
5831  fractpart = std::modf(number, &intpart);
5832  if(number == 0) {
5833  return 0;
5834  }
5835  if(number > 0) {
5836  if(fractpart < 0.5) {
5837  return G4int(std::floor(number));
5838  }
5839  else {
5840  return G4int(std::ceil(number));
5841  }
5842  }
5843  if(number < 0) {
5844  if(fractpart < -0.5) {
5845  return G4int(std::floor(number));
5846  }
5847  else {
5848  return G4int(std::ceil(number));
5849  }
5850  }
5851 
5852  return G4int(std::floor(number));
5853 }
5854 
5856 {
5857  time_t mytime;
5858  tm *mylocaltime;
5859 
5860  time(&mytime);
5861  mylocaltime = localtime(&mytime);
5862 
5863  if(x == 0) {
5864  return(mylocaltime->tm_hour*60*60 + mylocaltime->tm_min*60 + mylocaltime->tm_sec);
5865  }
5866  else {
5867  return(mytime - x);
5868  }
5869 }
5870 
5872 {
5873  if(b != 0) {
5874  return a%b;
5875  }
5876  else {
5877  return 0;
5878  }
5879 }
5880 
5882 {
5883  G4double value = 0.0;
5884 
5885  if(x-std::floor(x) <= std::ceil(x)-x)
5886  value = double(std::floor(x));
5887  else
5888  value = double(std::ceil(x));
5889 
5890  return value;
5891 }
5892 
5894 {
5895  G4int value = 0;
5896 
5897  if(x-std::floor(x) <= std::ceil(x)-x)
5898  value = G4int(std::floor(x));
5899  else
5900  value = G4int(std::ceil(x));
5901 
5902  return value;
5903 }
5904 
5906 {
5907  if(x-std::floor(x) <= std::ceil(x)-x)
5908  return G4int(std::floor(x));
5909  else
5910  return G4int(std::ceil(x));
5911 }
5912 
5914 {
5915  if(a < b && a < c) {
5916  return a;
5917  }
5918  if(b < a && b < c) {
5919  return b;
5920  }
5921  if(c < a && c < b) {
5922  return c;
5923  }
5924  return a;
5925 }
5926 
5928 {
5929  return std::abs(a);
5930 }
5931 
5932 
5934 {
5935 /*
5936 * Implemented by JLRS for Abla c++: 06/11/2016
5937 *
5938 C Last update:
5939 C 28/10/13 - JLRS - from abrablav4 (AK)
5940 */
5941  G4int IZPART,IAPART,NMOTHER;
5942  G4double B,HBAR,PI,RGEOM,MPART,SB;
5943  G4double BKONST,C,C2,G,APARTNER,MU;
5944  G4double INT1,INT2,INT3,AKONST,EARG,R0,MPARTNER;
5945  G4double AEXP;
5946  G4double ARG;
5947  G4double PAR_A1=0.,PAR_B1=0.,FACT=1.;
5948  G4double fwidth=0.;
5949  PI=3.141592654;
5950 
5951  IZPART = idnint(ZPART);
5952  IAPART = idnint(APART);
5953 
5954  B = B1;
5955  SB = SB1;
5956  NMOTHER = idnint(AMOTHER-ZMOTHER);
5957 
5958  PAR_A1 = 0.0;
5959  PAR_B1 = 0.0;
5960 
5961  if(SB>EXC){
5962  return fwidth=0.0;
5963  }else{
5964 // in MeV*s
5965  HBAR = 6.582122e-22;
5966 // HBAR2 = HBAR * HBAR
5967 // in m/s
5968  C = 2.99792458e8;
5969  C2 = C * C;
5970  APARTNER = AMOTHER - APART;
5971  MPARTNER = APARTNER * 931.49 / C2;
5972 
5973 // g=(2s+1)
5974  if(IAPART==1&&IZPART==0){
5975  G = 2.0;
5976  MPART = 939.56 / C2;
5977  }else{
5978  if(IAPART==1&&IZPART==1){
5979  G = 2.0;
5980  MPART = 938.27 / C2;
5981  }
5982  else{
5983  if(IAPART==2&&IZPART==1){
5984  G = 3.0;
5985  MPART = 1876.10 / C2;
5986  }else{
5987  if(IAPART==3&&IZPART==1){
5988  G = 2.0;
5989  MPART = 2809.39 / C2;
5990  }else{
5991  if(IAPART==3&&IZPART==2){
5992  G = 2.0;
5993  MPART = 2809.37 / C2;
5994  }else{
5995  if(IAPART==4&&IZPART==2){
5996  G = 1.0;
5997  MPART = 3728.35 / C2;
5998  }else{
5999  // IMF
6000  G = 1.0;
6001  MPART = APART * 931.49 / C2;
6002  }
6003  }
6004  }
6005  }
6006  }
6007  }//end g
6008 
6009 // Relative mass in MeV*s^2/m^2
6010  MU = MPARTNER * MPART / (MPARTNER + MPART);
6011 // in m
6012  R0 = 1.16e-15;
6013 
6014  RGEOM = R0 * (std::pow(APART,1.0/3.0)+std::pow(AMOTHER-APART,1.0/3.0));
6015 
6016 // in m*sqrt(MeV)
6017  AKONST = HBAR*std::sqrt(1.0 / MU);
6018 
6019 // in 1/(MeV*m^2)
6020  BKONST = MPART / ( PI * PI * HBAR * HBAR);
6021 //
6022 // USING ANALYTICAL APPROXIMATION
6023 
6024  INT1 = 2.0 * std::pow(TEMP,3.) / (2.0 * TEMP + B);
6025 
6026  ARG = std::sqrt(B/TEMP);
6027  EARG = (erf(ARG) - 1.0);
6028  if(std::abs(EARG)<1.e-9) EARG = 0.0;
6029  if(B==0.0){
6030  INT2 = 0.5 * std::sqrt(PI) * std::pow(TEMP,3.0/2.0);
6031  }else{
6032  AEXP = B/TEMP;
6033  if(AEXP>700.0) AEXP = 700.0;
6034  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;
6035  if(INT2<0.0) INT2 = 0.0;
6036 // For very low temperatures when EARG=0, INT2 get unreasonably high values
6037 // comming from the first term. Therefore, for these cases INT2 is set to 0.
6038  if(EARG==0.0) INT2 = 0.0;
6039  }//if B
6040 
6041  INT3 = 2.0*TEMP*TEMP*TEMP / (2.0*TEMP*TEMP + 4.0*B*TEMP + B*B);
6042 
6043  if(IZPART<-1.0&&ZMOTHER<151.0){
6044 // IF(IZPART.LT.1)THEN
6045 // For neutrons, the width is given by a mean value between geometrical and QM values;
6046 // Only QM contribution (Rgeom -> Rgeom + Rlamda) seems to be too strong for neutrons
6047  fwidth = PI * BKONST * G * std::sqrt((RGEOM * RGEOM * INT1 + 2.0 * AKONST * RGEOM * INT2 + AKONST * AKONST * INT3) * RGEOM * RGEOM * INT1);
6048 
6049  }else{
6050  fwidth = PI * BKONST * G *(RGEOM * RGEOM * INT1 + 2.0 * AKONST * RGEOM * INT2 + AKONST * AKONST * INT3);
6051  }
6052 
6053 
6054 // To correct for too high values of analytical width compared to
6055 // numerical solution for energies close to the particle threshold:
6056  if(IZPART<3.0){
6057  if(AMOTHER<155.0){
6058  PAR_A1=std::exp(2.302585*0.2083*std::exp(-0.01548472*AMOTHER))-0.05;
6059  PAR_B1 = 0.59939389 + 0.00915657 * AMOTHER;
6060  }else{
6061  if(AMOTHER>154.0&&AMOTHER<195.0){
6062  PAR_A1=1.0086961-8.629e-5*AMOTHER;
6063  PAR_B1 = 1.5329331 + 0.00302074 * AMOTHER;
6064  }else{
6065  if(AMOTHER>194.0&&AMOTHER<208.0){
6066  PAR_A1=9.8356347-0.09294663*AMOTHER+2.441e-4*AMOTHER*AMOTHER;
6067  PAR_B1 = 7.7701987 - 0.02897401 * AMOTHER;
6068  }else{
6069  if(AMOTHER>207.0&&AMOTHER<228.0){
6070  PAR_A1=15.107385-0.12414415*AMOTHER+2.7222e-4*AMOTHER*AMOTHER;
6071  PAR_B1=-64.078009+0.56813179*AMOTHER-0.00121078*AMOTHER*AMOTHER;
6072  }else{
6073  if(AMOTHER>227.0){
6074  if(mod(NMOTHER,2)==0&&NMOTHER>147.){
6075  PAR_A1 = 2.0*(0.9389118 + 6.4559e-5 * AMOTHER);
6076  }else{
6077  if(mod(NMOTHER,2)==1)PAR_A1 = 3.0*(0.9389118 + 6.4559e-5 * AMOTHER);
6078  }
6079  PAR_B1 = 2.1507177 + 0.00146119 * AMOTHER;
6080  }
6081  }
6082  }
6083  }
6084  }
6085  FACT = std::exp((2.302585*PAR_A1*std::exp(-PAR_B1*(EXC-SB))));
6086  if(FACT<1.0) FACT = 1.0;
6087  if(IZPART<-1.&&ZMOTHER<151.0){
6088 // IF(IZPART.LT.1)THEN
6089  fwidth = fwidth / std::sqrt(FACT);
6090  }else{
6091  fwidth = fwidth / FACT;
6092  }
6093  }//if IZPART<3.0
6094 
6095  if(fwidth<=0.0){
6096  std::cout <<"LOOK IN PARTICLE_WIDTH!" << std::endl;
6097  std::cout <<"ACN,APART :"<< AMOTHER << APART << std::endl;
6098  std::cout <<"EXC,TEMP,B,SB :" << EXC << " " << TEMP << " " << B << " " << SB << std::endl;
6099  std::cout <<"INTi, i=1-3 :" << INT1 << " " << INT2 << " " << INT3 << std::endl;
6100  std::cout <<" " << std::endl;
6101  }
6102 
6103  }//if SB>EXC
6104  return fwidth;
6105 }
6106 
6108 {
6109 // JLRS: 06/11/2016
6110 // CORRECTIONS FOR BARRIER PENETRATION
6111 // AK, KHS 2005 - Energy-dependen inverse cross sections included, influence of
6112 // Coulomb barrier for LCP, tunnelling for LCP
6113 
6114  G4double fpen=0., MU, HO;
6115 
6116 // REDUCED MASSES (IN MeV/C**2)
6117  MU = (A - ap) * ap / A;
6118 
6119 // ENERGY OF THE INVERSE PARABOLA AT THE POTENTIAL BARRIER (hbar*omega);
6120 // HERE hbar = 197.3287 fm*MeV/c, omega is in c/fm
6121  HO = 197.3287 * omega;
6122 
6123  if(T<=0.0){
6124  fpen = 0.0;
6125  }else{
6126  fpen=std::pow(10.0,4.e-4*std::pow(T/(HO*HO*std::pow(MU,0.25)),-4.3/2.3026));
6127  }
6128 
6129  return fpen;
6130 }
6131 
6133 {
6134 // Calculate BS and BK needed for a level-density parameter:
6135 // BETA2 and BETA4 = quadrupole and hexadecapole deformation
6136 
6137  G4double PI = 3.14159265;
6138  G4int IZ = idnint(Z);
6139  G4int IN = idnint(A - Z);
6140 // alphaN = sqrt(2*N/(4*pi))*BetaN
6141  G4double ALPHA2 = std::sqrt(5.0/(4.0*PI))*ecld->beta2[IN][IZ];
6142  G4double ALPHA4 = std::sqrt(9.0/(4.0*PI))*ecld->beta4[IN][IZ];
6143 
6144  (*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;
6145 
6146  (*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;
6147 
6148  (*BC)=0.0;
6149 
6150  return;
6151 }
6152 
6154 {
6155 // Random generator according to a distribution similar to a
6156 // Maxwell distribution with quantum-mech. x-section for charged particles according to KHS
6157 // Y = X**(1.5E0) / (B+X) * EXP(-X/T) (approximation:)
6158 
6159 return (3.0 * T * std::pow(-1.*std::log(G4AblaRandom::flat()) * std::log(G4AblaRandom::flat())*std::log(G4AblaRandom::flat()),0.333333));
6160 }
6161 
6163 {
6164 /*
6165 c This function determines the fission width as a function o time
6166 c according to the analytical solution of the FPE for the probability distribution
6167 c at the barrier when the nucleus potential is aproximated by a parabolic
6168 c potential. It is taken from S. Chandrasekhar, Rev. Mod. Phys. 15 (1943) 1
6169 c
6170 c***********************INPUT PARAMETERS*********************************
6171 c Time Time at which we evaluate the fission width
6172 c ZF Z of nucleus
6173 C AF A of nucleus
6174 c BET Reduced dissipation coefficient
6175 c FT Nuclear temperature
6176 C**************************************************************************
6177 C********************************OUTPUT***********************************
6178 C Fission decay width at the corresponding time of the decay cascade
6179 C*************************************************************************
6180 c****************************OTHER VARIABLES******************************
6181 C SIGMA_SQR Square of the width of the prob. distribution
6182 C XB Deformation of the nucleus at the saddle point
6183 c NORM Normalization factor of the probability distribution
6184 c W Probability distribution at the saddle deformation XB
6185 c W_INFIN Probability distr. at XB at infinite time
6186 c MFCD Mass of the fission collective degree of freedom
6187 C*************************************************************************
6188 */
6189  G4double PI = 3.14159;
6190  G4double DEFO_INIT,OMEGA,HOMEGA,OMEGA_GS,HOMEGA_GS,K1,MFCD;
6191  G4double BET1,XACT,SIGMA_SQR,W_EXP,XB,NORM,SIGMA_SQR_INF,W_INFIN,W;
6192  G4double FUNC_TRANS,LOG_SLOPE_INF,LOG_SLOPE_ABS;
6193 //
6194 // Influence of initial deformation
6195 // Initial alpha2 deformation (GS)
6196  DEFO_INIT = std::sqrt(5.0/(4.0*PI))*ecld->beta2[fiss->at-fiss->zt][fiss->zt];
6197 //
6198  fomega_sp(AF,Y,&MFCD,&OMEGA,&HOMEGA);
6199  fomega_gs(AF,ZF,&K1,&OMEGA_GS,&HOMEGA_GS);
6200 //
6201 // Determination of the square of the width of the probability distribution
6202 // For the overdamped regime BET**2 > 4*OMEGA**2
6203  if((bet*bet)>4.0*OMEGA_GS*OMEGA_GS){
6204  BET1=std::sqrt(bet*bet-4.0*OMEGA_GS*OMEGA_GS);
6205 //
6206 // REMEMBER THAT HOMEGA IS ACTUALLY HBAR*HOMEGA1=1MeV
6207 // SO THAT HOMEGA1 = HOMEGA/HBAR
6208 //
6209  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)));
6210 //
6211 // Evolution of the mean x-value (KHS March 2006)
6212  XACT = DEFO_INIT *std::exp(-0.5*(bet-BET1)*1.e21*(TIME-T_0));
6213 //
6214  }else{
6215 // For the underdamped regime BET**2 < 4*HOMEGA**2 BET1 becomes a complex number
6216 // and the expression with sinh and cosh can be transformed in one with sin and cos
6217  BET1=std::sqrt(4.0*OMEGA_GS*OMEGA_GS-bet*bet);
6218  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));
6219  XACT = DEFO_INIT*std::cos(0.5*BET1*1.e21*(TIME-T_0))*std::exp(-bet*1.e21*(TIME-T_0));
6220  }
6221 
6222 // Determination of the deformation at the saddle point according to
6223 // "Geometrical relationships of Macroscopic Nucl. Phys." from Hass and Myers page 100
6224 // This corresponds to alpha2 deformation.
6225  XB = 7./3.*Y-938./765.*Y*Y+9.499768*Y*Y*Y-8.050944*Y*Y*Y*Y;
6226 //
6227 // Determination of the probability distribution at the saddle deformation
6228 //
6229  if(SIGMA_SQR>0.0){
6230  NORM = 1./std::sqrt(2.*PI*SIGMA_SQR);
6231 //
6232  W_EXP = -1.*(XB - XACT)*(XB - XACT)/(2.0 * SIGMA_SQR);
6233  if(W_EXP<(-708.0) ) W_EXP = -708.0;
6234  W = NORM * std::exp( W_EXP ) * FT / (K1 * SIGMA_SQR);
6235  }else{
6236  W = 0.0;
6237  }
6238 //
6239 // Determination of the fission decay width, we assume we are in the overdamped regime
6240 //
6241  SIGMA_SQR_INF = FT/K1;
6242  W_EXP = -XB*XB/(2.0 * SIGMA_SQR_INF);
6243  if(W_EXP<(-708.0))W_EXP = -708.0;
6244  W_INFIN = std::exp(W_EXP)/std::sqrt(2.0*PI*SIGMA_SQR_INF);
6245  FUNC_TRANS = W / W_INFIN;
6246 //
6247 // Correction for the variation of the mean velocity at the fission barrier
6248 // (see B. Jurado et al, Nucl. Phys. A747, p. 14)
6249 //
6250  LOG_SLOPE_INF = cram(bet,HOMEGA)*bet*MFCD*OMEGA/FT;
6251  LOG_SLOPE_ABS = (XB-XACT)/SIGMA_SQR-XB/SIGMA_SQR_INF+cram(bet,HOMEGA)*bet*MFCD*OMEGA/FT;
6252 //
6253  FUNC_TRANS = FUNC_TRANS * LOG_SLOPE_ABS/LOG_SLOPE_INF;
6254 //
6255  return FUNC_TRANS;
6256 }
6257 
6258 
6260 {
6261 /*
6262 C THIS SUBROUTINE IS AIMED TO CHOOSE BETWEEN PARTICLE EMISSION
6263 C AND FISSION
6264 C WE USE MONTE-CARLO METHODS AND SAMPLE TIME BETWEEN T=0 AND T=1.5*TAUF
6265 c TO SIMULATE THE TRANSIENT TIME WITH 30 STEPS (0.05*TAUF EACH)
6266 C FOR t>1.5*TAUF , GF=CONSTANT=ASYMPTOTICAL VALUE (INCLUDING KRAMERS FACTOR)
6267 c------------------------------------------------------------------------
6268 c Modifications introduced by BEATRIZ JURADO 18/10/01:
6269 c 1. Now this subrutine is included in the rutine direct
6270 c 2. TSUM does not include the current particle decay time
6271 C 3. T_LAPSE is the time until decay, taken as an output variable
6272 C 4. GF_LOC is also taken as an output variable
6273 C 5. BET (Diss. Coeff.) and HOMEGA (Frequency at the ground state
6274 c are included as input variables because they are needed for FUNC_TRANS
6275 C-----------------------------------------------------------------------
6276 C ON INPUT:
6277 C GP Partial particle decay width
6278 C GF Asymptotic value of Gamma-f, including Kramers factor
6279 C AF Mass number of nucleus
6280 C TAUF Transient time
6281 C TS1 Partial particle decay time for the next step
6282 C TSUM Total sum of partial particle decay times, including
6283 C the next expected one, which is in competition