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
6284 C with fission now
6285 C ZF Z of nucleus
6286 C AF A of nucleus
6287 C-----------------------------------------------------------------------
6288 C ON OUTPUT:
6289 C CHOICE Key for decay mode: 0 = no decay (only internal)
6290 C 1 = evaporation
6291 C 2 = fission
6292 C-----------------------------------------------------------------------
6293 C VARIABLES:
6294 C GP Partial particle decay width
6295 C GF Asymptotic value of Gamma-f, including Kramers factor
6296 C TAUF Transient time
6297 C TS1 Partial particle decay time
6298 C TSUM Total sum of partial particle decay times
6299 C CHOICE Key for decay mode
6300 C ZF Z of nucleus
6301 C AF A of nucleus
6302 C FT Used for Fermi function in FUNC_TRANS
6303 C STEP_LENGTH Step in time to sample different decays
6304 C BEGIN_TIME Total sum of partial particle decay times, excluding
6305 C the next expected one, which is in competition
6306 C with fission now
6307 C LOC_TIME_BEGIN Begin of time interval considered in one step
6308 C LOC_TIME_END End of time interval considered in one step
6309 C GF_LOC In-grow function for fission width,
6310 c normalized to asymptotic value
6311 C TS2 Effective partial fission decay time in one time step
6312 C HBAR hbar
6313 C T_LAPSE Effective decay time in one time step
6314 C REAC_PROB Reaction probability in one time step
6315 C X Help variable for random generator
6316 C------------------------------------------------------------------------
6317 */
6318  G4double K1,OMEGA,HOMEGA,t_0,STEP_LENGTH,LOC_TIME_BEGIN,LOC_TIME_END=0.,BEGIN_TIME=0.,FISS_PROB,X,TS2,LAMBDA,REAC_PROB;
6319  G4double HBAR=6.582122e-22;
6320  G4int fchoice=0;
6321  G4double fGF_LOC=0.,fT_LAPSE=0.;
6322 //
6323  if(GF<=0.0){
6324  *CHOICE = 1;
6325  *T_LAPSE=TS1;
6326  *GF_LOC = 0.0;
6327  goto direct107;
6328  }
6329 //
6330  fomega_gs(AF,ZF,&K1,&OMEGA,&HOMEGA);
6331 //
6332 // ****************************************************************
6333 // Calculation of the shift in time due to the initial conditions
6334 //
6335 // Overdamped regime
6336  if(BET*BET>4.0*OMEGA*OMEGA){
6337 // REMEMBER THAT HOMEGA IS ACTUALLY HBAR*HOMEGA1=1MeV
6338 // SO THAT HOMEGA1 = HOMEGA/HBAR
6339 // Additional factor 1/16 proposed by KHS on 14/7/2010. Takes into
6340 // account the fact that the curvature of the potential is ~16 times
6341 // larger than what predicted by the liquid drop model, because of
6342 // shell effects.
6343  t_0 = BET*1.e21*HBAR*HBAR/(4.*HOMEGA*FT)/16.;
6344  }else{
6345 // Underdamped regime
6346  if(((2.*FT-HOMEGA/16.)>0.000001) && BET>0.0){
6347 // Additional factor 1/16 proposed by KHS on 14/7/2010. Takes into
6348 // account the fact that the curvature of the potential is ~16 times
6349 // larger than what predicted by the liquid drop model, because of
6350 // shell effects.
6351  t_0 = (std::log(2.*FT/(2.*FT-HOMEGA/16.)))/(BET*1.e21);
6352  }else{
6353 // Neglect fission transients if the time shift t_0 is too
6354 // large. Suppresses large, spurious fission cross section at very
6355 // low excitation energy in p+Ta.
6356 //
6357  fchoice = 0;
6358  goto direct106;
6359  }
6360  }
6361 // ********************************************************************+
6362  fchoice = 0;
6363  STEP_LENGTH = 1.5*TAUF/50.;
6364 //
6365 // AT FIRST WE CACULATE THE REAL CURRENT TIME
6366 // TSUM includes only the time elapsed in the previous steps
6367 //
6368  BEGIN_TIME = TSUM + t_0;
6369 //
6370  if(BEGIN_TIME<0.0) std::cout << "CURRENT TIME < 0" << BEGIN_TIME << std::endl;
6371 //
6372  if(BEGIN_TIME<1.50*TAUF){
6373  LOC_TIME_BEGIN = BEGIN_TIME;
6374 //
6375  while((LOC_TIME_BEGIN<1.5*TAUF)&&fchoice==0){
6376 
6377  LOC_TIME_END = LOC_TIME_BEGIN + STEP_LENGTH;
6378 //
6379 // NOW WE ESTIMATE THE MEAN VALUE OF THE FISSION WIDTH WITHIN THE SMALL INTERVAL
6380  fGF_LOC=(func_trans(LOC_TIME_BEGIN,ZF,AF,BET,Y,FT,t_0)+func_trans(LOC_TIME_END,ZF,AF,BET,Y,FT,t_0))/2.0;
6381 //
6382  fGF_LOC = fGF_LOC * GF;
6383 
6384 // TS2 IS THE MEAN DECAY TIME OF THE FISSION CHANNEL
6385  if(fGF_LOC>0.0){
6386  TS2 = HBAR/fGF_LOC;
6387  }else{
6388  TS2 = 0.0;
6389  }
6390 //
6391  if(TS2>0.0){
6392  LAMBDA = 1.0/TS1 + 1.0/TS2;
6393  }else{
6394  LAMBDA = 1.0/TS1;
6395  }
6396 //
6397 // This is the probability to survive the decay at this step
6398  REAC_PROB = std::exp(-1.0*STEP_LENGTH*LAMBDA);
6399 // I GENERATE A RANDOM NUMBER
6400  X = G4AblaRandom::flat();
6401  if(X>REAC_PROB){
6402 // THEN THE EVAPORATION OR FISSION HAS OCCURED
6403  FISS_PROB = fGF_LOC / (fGF_LOC+GP);
6404  X = G4AblaRandom::flat();
6405 // WRITE(6,*)'X=',X
6406  if(X<FISS_PROB){
6407 // FISSION OCCURED
6408  fchoice = 2;
6409  }else{
6410 // EVAPORATION OCCURED
6411  fchoice = 1;
6412  }
6413  }// if x
6414  LOC_TIME_BEGIN = LOC_TIME_END;
6415  }// while
6416 // Take the real decay time of this decay step
6417  fT_LAPSE = LOC_TIME_END - BEGIN_TIME;
6418  }// if BEGIN_TIME
6419 //
6420 // NOW, IF NOTHING HAPPENED DURING TRANSIENT TIME
6421  direct106:
6422  if(fchoice==0){
6423  fGF_LOC=GF;
6424  FISS_PROB = GF / (GF+GP);
6425 
6426 // Added for cases where already at the beginning BEGIN_TIME > 1.5d0*TAUF
6427  if(GF>0.0){
6428  TS2 = HBAR/GF;
6429  }else{
6430  TS2 = 0.0;
6431  }
6432 
6433  if(TS2>0.0){
6434  LAMBDA = 1./TS1 + 1./TS2;
6435  }else{
6436  LAMBDA = 1./TS1;
6437  }
6438 //
6439  X = G4AblaRandom::flat();
6440 
6441  if(X<FISS_PROB){
6442 // FISSION OCCURED
6443  fchoice = 2;
6444  }else{
6445 // EVAPORATION OCCURED
6446  fchoice = 1;
6447  }
6448 //
6449 //TIRAGE ALEATOIRE DANS UNE EXPONENTIELLLE : Y=EXP(-X/T)
6450 // EXPOHAZ=-T*LOG(HAZ(K))
6451  fT_LAPSE = fT_LAPSE -1.0/LAMBDA*std::log(G4AblaRandom::flat());
6452  }
6453 //
6454  direct107:
6455 
6456  (*T_LAPSE)=fT_LAPSE;
6457  (*GF_LOC)=fGF_LOC;
6458  (*CHOICE)=fchoice;
6459  return;
6460 }
6461 
6463 {
6464 // Subroutine to caluclate fission width with included effects
6465 // of tunnelling through the fission barrier
6466 
6467  G4double PI = 3.14159;
6468  G4int IZ, IN;
6469  G4double MFCD,OMEGA,HOMEGA1,HOMEGA2=0.,GFTUN;
6470  G4double E1,E2,EXP_FACT,CORR_FUNCT,FACT1,FACT2,FACT3;
6471 
6472  IZ = idnint(ZPRF);
6473  IN = idnint(A-ZPRF);
6474 
6475 // For low energies system "sees" LD barrier
6476  fomega_sp(A,Y,&MFCD,&OMEGA,&HOMEGA1);
6477 
6478  if(mod(IN,2)==0&&mod(IZ,2)==0){ // e-e
6479 // Due to pairing gap, even-even nuclei cannot tunnel for excitation energy lower
6480 // than pairing gap (no levels at which system can be)
6481  EE = EE - 12.0/std::sqrt(A);
6482  HOMEGA2 = 1.04;
6483  }
6484 
6485  if(mod(IN,2)==1&&mod(IZ,2)==1){ // o-o
6486  HOMEGA2 = 0.65;
6487  }
6488 
6489  if(mod(IN,2)==1&&mod(IZ,2)==0){ // o-e
6490  HOMEGA2 = 0.8;
6491  }
6492 
6493  if(mod(IN,2)==0&&mod(IZ,2)==1){ // e-0
6494  HOMEGA2 = 0.8;
6495  }
6496 
6497  E1 = EF + HOMEGA1/2.0/PI*std::log(HOMEGA1*(2.0*PI+HOMEGA2)/4.0/PI/PI);
6498 
6499  E2 = EF + HOMEGA2/(2.0*PI)*std::log(1.0+2.0*PI/HOMEGA2);
6500 
6501 // AKH May 2013 - Due to approximations in the analytical integration, at energies
6502 // just above barrier Pf was to low, at energies below
6503 // barrier it was somewhat higher. LInes below are supposed to correct for this.
6504 // Factor 0.20 in EXP_FACT comes from the slope of the Pf(Eexc) (Gavron's data)
6505 // around fission barrier.
6506  EXP_FACT = (EE-EF)/(HOMEGA2/(2.0*PI));
6507  if(EXP_FACT>700.0) EXP_FACT = 700.0;
6508  CORR_FUNCT = HOMEGA1 * (1.0-1.0/(1.0+std::exp(EXP_FACT)));
6509  if(mod(IN,2)==0&&mod(IZ,2)==0){
6510  CORR_FUNCT = HOMEGA1 * (1.0-1.0/(1.0+std::exp(EXP_FACT)));
6511  }
6512 
6513  FACT1 = HOMEGA1/(2.0*PI*TEMP+HOMEGA1);
6514  FACT2 = (2.0*PI/(2.0*PI+HOMEGA2)-HOMEGA1*(2.0*PI+HOMEGA2)/4.0/PI/PI)/(E2-E1);
6515  FACT3 = HOMEGA2/(2.0*PI*TEMP-HOMEGA2);
6516 
6517  if(EE<E1){
6518  GFTUN = FACT1*(std::exp(EE/TEMP)*std::exp(2.0*PI*(EE-EF)/HOMEGA1)-std::exp(-2.0*PI*EF/HOMEGA1));
6519  }else{
6520  if(EE>=E1&&EE<E2){
6521  GFTUN = std::exp(EE/TEMP)*(0.50+FACT2*(EE-EF-TEMP))-std::exp(E1/TEMP)*(0.5+FACT2*(E1-EF-TEMP))+FACT1*(std::exp(E1/TEMP)*std::exp(2.0*PI*(E1-EF)/HOMEGA1)-std::exp(-2.0*PI*EF/HOMEGA1));
6522  }else{
6523  GFTUN = std::exp(EE/TEMP)*(1.0+FACT3*std::exp(-2.0*PI*(EE-EF)/HOMEGA2))-std::exp(E2/TEMP)*(1.0+FACT3*std::exp(-2.0*PI*(E2-EF)/HOMEGA2))+std::exp(E2/TEMP)*(0.5+FACT2*(E2-EF-TEMP))-std::exp(E1/TEMP)*(0.5+FACT2*(E1-EF-TEMP))+FACT1*(std::exp(E1/TEMP)*std::exp(2.0*PI*(E1-EF)/HOMEGA1)-std::exp(-2.0*PI*EF/HOMEGA1));
6524  }
6525  }
6526  GFTUN = GFTUN/std::exp(EE/TEMP)*DENSF*ENH_FACT/DENSG/2.0/PI;
6527  GFTUN = GFTUN * CORR_FUNCT;
6528  return GFTUN;
6529 }
6530 
6531 
6532 void G4Abla::fission_width(G4double ZPRF,G4double A,G4double EE,G4double BS,G4double BK,G4double EF,G4double Y,G4double *GF,G4double *TEMP,G4double JPR,G4int IEROT,G4int FF_ALLOWED,G4int OPTCOL,G4int OPTSHP,G4double DENSG)
6533 {
6534 //
6535  G4double FNORM,MASS_ASYM_SADD_B,FP_PER,FP_PAR,SIG_PER_SP,SIG_PAR_SP;
6536  G4double Z2OVERA,ftemp,fgf,DENSF,ECOR,EROT,qr;
6537  G4double DCR,UCR,ENH_FACTA,ENH_FACTB,ENH_FACT,PONFE;
6538  G4double PI = 3.14159;
6539 
6540  DCR = fiss->dcr;
6541  UCR = fiss->ucr;
6542  Z2OVERA = ZPRF * ZPRF / A;
6543 
6544 // Nuclei below Businaro-Gallone point do not go through fission
6545  if((ZPRF<=55.0) || (FF_ALLOWED==0)){
6546  (*GF) = 0.0;
6547  (*TEMP) = 0.5;
6548  return;
6549  }
6550 
6551 // Level density above SP
6552 // Saddle-point deformation is defbet as above. But, FP_PER and FP_PAR
6553 // are calculated for fission in DENSNIV acc to Myers and Hasse, and their
6554 // parametrization is done as function of y
6555  densniv(A,ZPRF,EE,EF,&DENSF,0.0,BS,BK,&ftemp,OPTSHP,0,Y,&ECOR,JPR,1,&qr);
6556 
6557  if(OPTCOL==0){
6558  fgf= DENSF/DENSG/PI/2.0*ftemp;
6559  (*TEMP)=ftemp;
6560  (*GF)= fgf;
6561  return;
6562  }
6563 
6564 // FP = 2/5*M0*R0**2/HBAR**2 * A**(5/3) * (1 + DEFBET/3)
6565 // FP is used to calculate the spin-cutoff parameter SIG=FP*TEMP/hbar**2; hbar**2
6566 // is, therefore, included in FP in order to avoid problems with large exponents
6567 // The factor fnorm inlcudes then R0, M0 and hbar**2 -
6568 // fnorm = R0*M0/hbar**2 = 1.2fm*931.49MeV/c**2 /(6.582122e-22 MeVs)**2 and is
6569 // in units 1/MeV
6570  FNORM = 1.2*1.2 * 931.49 * 1.e-2 / (9.0 * 6.582122*6.582122);
6571 // FP_PER ~ 1+7*y/6, FP_PAR ~ 1-7*y/3 (Hasse & Myers, Geom. relat. macr. nucl. phys.)
6572 // Perpendicular moment of inertia
6573  FP_PER = 2.0/5.0*std::pow(A,5.0/3.0)*FNORM*(1. + 7.0/6.0*Y*(1.0+1396.0/255.*Y));
6574 
6575 // AK - Jan 2011 - following line is needed, as for these nuclei it seems that
6576 // FP_PER calculated according to above formula has too large values, leading to too
6577 // large ENH_FACT
6578  if(Z2OVERA<=30.0) FP_PER = 6.50;
6579 
6580 // Parallel moment of inertia
6581  FP_PAR = 2.0/5.0*std::pow(A,5.0/3.0)*FNORM*(1.0 - 7.0/3.0*Y*(1.0-389.0/255.0*Y));
6582  if(FP_PAR<0.0) FP_PAR = 0.0;
6583 
6584  EROT = JPR * JPR / (2.0 * std::sqrt(FP_PAR*FP_PAR + FP_PER*FP_PER));
6585  if(IEROT==1) EROT = 0.0;
6586 
6587 // Perpendicular spin cut-off parameter
6588  SIG_PER_SP = std::sqrt(FP_PER * ftemp);
6589 
6590  if(SIG_PER_SP<1.0) SIG_PER_SP = 1.0;
6591 
6592 // Parallel spin cut-off parameter
6593  SIG_PAR_SP = std::sqrt(FP_PAR * ftemp);
6594  ENH_FACT = 1.0;
6595 //
6596  if(A>223.0){
6597  MASS_ASYM_SADD_B = 2.0;
6598  }else{
6599  MASS_ASYM_SADD_B = 1.0;
6600  }
6601 
6602 // actinides with low barriers
6603  if(Z2OVERA>35.&&Z2OVERA<=(110.*110./298.0)){
6604 // Barrier A is axial asymmetric
6605  ENH_FACTA = std::sqrt(8.0*PI) * SIG_PER_SP*SIG_PER_SP * SIG_PAR_SP;
6606 // Barrier B is axial symmetric
6607  ENH_FACTB = MASS_ASYM_SADD_B * SIG_PER_SP*SIG_PER_SP;
6608 // Total enhancement
6609  ENH_FACT = ENH_FACTA * ENH_FACTB / (ENH_FACTA + ENH_FACTB);
6610  }else{
6611 // nuclei with high fission barriers (only barrier B plays a role, axial symmetric)
6612  if(Z2OVERA<=35.){
6613  ENH_FACT = MASS_ASYM_SADD_B*SIG_PER_SP*SIG_PER_SP;
6614  }else{
6615 // super-heavy nuclei (only barrier A plays a role, axial asymmetric)
6616  ENH_FACT = std::sqrt(8.0*PI) * SIG_PER_SP*SIG_PER_SP* SIG_PAR_SP;
6617  }
6618  }
6619 
6620 // Fading-out with excitation energy above the saddle point:
6621  PONFE = (ECOR-UCR-EROT)/DCR;
6622  if(PONFE>700.) PONFE = 700.0;
6623 // Fading-out according to Junghans:
6624  ENH_FACT = 1.0/(1.0+std::exp(PONFE))*ENH_FACT+1.0;
6625 
6626  if(ENH_FACT<1.0)ENH_FACT = 1.0;
6627  fgf= DENSF/DENSG/PI/2.0*ftemp*ENH_FACT;
6628 
6629 // Tunneling
6630  if(EE<EF+1.){
6631  fgf=tunnelling(A,ZPRF,Y,EE,EF,ftemp,DENSG,DENSF,ENH_FACT);
6632  }
6633 //
6634  (*GF)= fgf;
6635  (*TEMP)=ftemp;
6636  return;
6637 }
6638 
6639 
6640 void G4Abla::lorb(G4double AMOTHER,G4double ADAUGHTER,G4double LMOTHER,G4double EEFINAL,G4double *LORBITAL,G4double *SIGMA_LORBITAL)
6641 {
6642 
6643  G4double AFRAGMENT,S4FINAL,ALEVDENS;
6644  G4double THETA_MOTHER,THETA_ORBITAL;
6645 
6646 /*
6647 C Values on input:
6648 C AMOTHER mass of mother nucleus
6649 C ADAUGHTER mass of daughter fragment
6650 C LMOTHER angular momentum of mother (may be real)
6651 C EEFINAL excitation energy after emission
6652 C (sum of daughter and fragment)
6653 C
6654 C Values on output:
6655 C LORBITAL mean value of orbital angular momentum
6656 C (assumed to be fully aligned with LMOTHER)
6657 C SIGMA_LORBITAL standard deviation of the orbital angular momentum
6658 */
6659  if (EEFINAL<=0.01) EEFINAL = 0.01;
6660  AFRAGMENT = AMOTHER - ADAUGHTER;
6661  ALEVDENS = 0.073*AMOTHER + 0.095*std::pow(AMOTHER,2.0/3.0);
6662  S4FINAL = ALEVDENS * EEFINAL;
6663  if(S4FINAL <= 0.0 || S4FINAL > 100000.){
6664  std::cout<< "S4FINAL:" << S4FINAL << ALEVDENS << EEFINAL << idnint(AMOTHER) << idnint(AFRAGMENT) << std::endl;
6665  }
6666  THETA_MOTHER = 0.0111 * std::pow(AMOTHER,1.66667);
6667  THETA_ORBITAL = 0.0323 / std::pow(AMOTHER,2.) *std::pow(std::pow(AFRAGMENT,0.33333) + std::pow(ADAUGHTER,0.33333),2.) * AFRAGMENT*ADAUGHTER*(AFRAGMENT+ADAUGHTER);
6668 
6669  *LORBITAL = -1.* THETA_ORBITAL * (LMOTHER / THETA_MOTHER + std::sqrt(S4FINAL) /(ALEVDENS*LMOTHER));
6670 
6671  *SIGMA_LORBITAL = std::sqrt(std::sqrt(S4FINAL) * THETA_ORBITAL / ALEVDENS);
6672 
6673  return;
6674 }
6675 
6676 // Random generator according to a distribution similar to a
6677 // Maxwell distribution with quantum-mech. x-section for neutrons according to KHS
6678 // Y = SQRT(X) * EXP(-X/T) (approximation:)
6680 
6681  return (2.0 * x * std::sqrt(std::log(G4AblaRandom::flat()) * std::log(G4AblaRandom::flat())));
6682 }
6683 
6684 void G4Abla::imf(G4double ACN,G4double ZCN,G4double TEMP,G4double EE,G4double *ZIMF,G4double *AIMF,G4double *BIMF,G4double *SBIMF,G4double *TIMF,G4double JPRF)
6685 {
6686 // input variables (compound nucleus) Acn, Zcn, Temp, EE
6687 // output variable (IMF) Zimf,Aimf,Bimf,Sbimf,IRNDM
6688 //
6689 // SBIMF = separation energy + coulomb barrier
6690 //
6691 // SDW(Z) is the sum over all isotopes for a given Z of the decay widths
6692 // DW(Z,A) is the decay width of a certain nuclide
6693 //
6694 // Last update:
6695 // 28/10/13 - JLRS - from abrablav4 (AK)
6696 // 13/11/16 - JLRS - Included this function in Abla++
6697 
6698  G4int IZIMFMAX=0;
6699  G4int iz=0,in=0,IZIMF=0,INMI=0,INMA=0,IZCN=0,INCN=0,INIMFMI=0,INIMFMA=0,ILIMMAX=0,INNMAX=0,INMIN=0,IAIMF=0,IZSTOP=3,IZMEM=0,IA=0,INMINMEM=0,INMAXMEM=0,IIA=0;
6700  G4double BS=0,BK=0,BC=0,BSHELL=0,DEFBET=0,DEFBETIMF=0,EROT=0,MAIMF=0,MAZ=0,MARES=0,AIMF_1,OMEGAP=0,fBIMF=0.0,BSIMF=0,A1PAR=0,A2PAR=0,SUM_A,EEDAUG;
6701  G4double DENSCN=0,TEMPCN=0,ECOR=0,IINERT=0,EROTCN=0,WIDTH_IMF=0.0,WIDTH1=0,IMFARG=0,QR=0,QRCN=0,DENSIMF=0,fTIMF=0,fZIMF=0,fAIMF=0.0,NIMF=0,fSBIMF=0;
6702  G4double PI = 3.141592653589793238;
6703  G4double ZIMF_1=0.0;
6704  G4double SDWprevious=0,SUMDW_TOT=0,SUM_Z=0,X=0,SUMDW_N_TOT=0,XX=0;
6705  G4double SDW[98];
6706  G4double DW[98][251];
6707  G4double BBIMF[98][251];
6708  G4double SSBIMF[98][251];
6709  G4int OPTSHPIMF=opt->optshpimf;
6710 
6711 // take the half of the CN and transform it in integer (floor it)
6712  IZIMFMAX = idnint(ZCN / 2.0);
6713 
6714  if(IZIMFMAX<3){
6715  std::cout << "CHARGE_IMF line 46" << std::endl;
6716  std::cout << "Problem: IZIMFMAX < 3 " << std::endl;
6717  std::cout << "ZCN,IZIMFMAX," << ZCN << "," << IZIMFMAX << std::endl;
6718  }
6719 
6720  iz = idnint(ZCN);
6721  in = idnint(ACN) - iz;
6722  BSHELL = ecld->ecgnz[in][iz]- ecld->vgsld[in][iz];
6723  DEFBET = ecld->beta2[in][iz];
6724 
6725  bsbkbc(ACN,ZCN,&BS,&BK,&BC);
6726 
6727  densniv(ACN,ZCN,EE,0.0,&DENSCN,BSHELL,BS,BK,&TEMPCN,0,0,DEFBET,&ECOR,JPRF,0,&QRCN);
6728 
6729  IINERT = 0.4 * 931.49 * 1.16*1.16 * std::pow(ACN,5.0/3.0)*(1.0 + 0.5*std::sqrt(5./(4.*PI))*DEFBET);
6730  EROTCN = JPRF * JPRF * 197.328 * 197.328 /(2. * IINERT);
6731 //
6732  for(IZIMF=3;IZIMF<=IZIMFMAX;IZIMF++){
6733 
6734  SDW[IZIMF] = 0.0;
6735  ZIMF_1 = 1.0*IZIMF;
6736 
6737 // *** Find the limits that both IMF and partner are bound :
6738 
6739  isostab_lim(IZIMF,&INIMFMI,&INIMFMA);// Bound isotopes for IZIMF from INMIN to INIMFMA
6740 // Idea - very proton-rich nuclei can live long enough to evaporate IMF before decaying:
6741  INIMFMI = max(1,INIMFMI-2);
6742 
6743  IZCN = idnint(ZCN); // Z of CN
6744  INCN = idnint(ACN) - IZCN; // N of CN
6745 
6746  isostab_lim(IZCN-IZIMF,&INMI,&INMA); // Daughter nucleus after IMF emission,
6747  // limits of bound isotopes
6748  INMI = max(1,INMI-2);
6749  INMIN = max(INIMFMI,INCN-INMA); // Both IMF and daughter must be bound
6750  INNMAX = min(INIMFMA,INCN-INMI); // "
6751 
6752  ILIMMAX = max(INNMAX,INMIN); // In order to keep the variables below
6753 // ***
6754 
6755  for(G4int INIMF=INMIN;INIMF<=ILIMMAX;INIMF++){ // Range of possible IMF isotopes
6756  IAIMF = IZIMF + INIMF;
6757  DW[IZIMF][IAIMF] = 0.0;
6758  AIMF_1 = 1.0*(IAIMF);
6759 
6760 // Q-values
6761  mglms(ACN-AIMF_1,ZCN-ZIMF_1,OPTSHPIMF,&MARES);
6762  mglms(AIMF_1,ZIMF_1,OPTSHPIMF,&MAIMF);
6763  mglms(ACN,ZCN,OPTSHPIMF,&MAZ);
6764 
6765 // Barrier
6766  if(ACN<=AIMF_1){
6767  SSBIMF[IZIMF][IAIMF] = 1.e37;
6768  }else{
6769  barrs(idnint(ZCN-ZIMF_1),idnint(ACN-AIMF_1),idnint(ZIMF_1),idnint(AIMF_1),&fBIMF,&OMEGAP);
6770  SSBIMF[IZIMF][IAIMF] = MAIMF + MARES - MAZ + fBIMF;
6771  BBIMF[IZIMF][IAIMF] = fBIMF;
6772  }
6773 
6774 // ***** Width *********************
6775  DEFBETIMF = ecld->beta2[idnint(AIMF_1-ZIMF_1)][idnint(ZIMF_1)]+ecld->beta2[idnint(ACN-AIMF_1-ZCN+ZIMF_1)][idnint(ZCN-ZIMF_1)];
6776 
6777  IINERT = 0.40 * 931.490 * 1.160*1.160 * std::pow(ACN,5.0/3.0)*(std::pow(AIMF_1,5.0/3.0) + std::pow(ACN - AIMF_1,5.0/3.0)) + 931.490 * 1.160*1.160 * AIMF_1 * (ACN-AIMF_1) / ACN *(std::pow(AIMF_1,1.0/3.0) + std::pow(ACN - AIMF_1,1.0/3.0))*(std::pow(AIMF_1,1.0/3.0) + std::pow(ACN - AIMF_1,1.0/3.0));
6778 
6779  EROT = JPRF * JPRF * 197.328 * 197.328 /(2.0 * IINERT);
6780 
6781  // IF(IEROT.EQ.1) EROT = 0.D0
6782  if (EE<(SSBIMF[IZIMF][IAIMF]+EROT) || DENSCN<=0.0){
6783  WIDTH_IMF = 0.0;
6784 // PRINT*,IDNINT(ACN),IDNINT(ZCN),IZIMF,IAIMF
6785  }else{
6786 // here the temperature at "saddle point" is used
6787 // Increase of the level densitiy at the barrier due to deformation; see comment in ABLA
6788 // BSIMF = ((ACN-AIMF_1)**(2.D0/3.D0) + AIMF_1**(2.D0/3.D0))/
6789 // & ACN**(2.D0/3.D0)
6790  BSIMF = BS;
6791  densniv(ACN,ZCN,EE,SSBIMF[IZIMF][IAIMF],&DENSIMF,0.0,BSIMF,1.0,&fTIMF,0,0,DEFBETIMF,&ECOR,JPRF,2,&QR);
6792  IMFARG = (SSBIMF[IZIMF][IAIMF]+EROTCN-EROT)/fTIMF;
6793  if(IMFARG>200.0) IMFARG = 200.0;
6794 
6795  WIDTH1 = width(ACN,ZCN,AIMF_1,ZIMF_1,fTIMF,fBIMF,SSBIMF[IZIMF][IAIMF],EE-EROT);
6796 
6797  WIDTH_IMF = WIDTH1 * std::exp(-IMFARG) * QR / QRCN;
6798 
6799  if(WIDTH_IMF<=0.0){
6800  std::cout << "GAMMA_IMF=0 -> LOOK IN GAMMA_IMF CALCULATIONS!" << std::endl;
6801  std::cout << "ACN,ZCN,AIMF,ZIMF:" << idnint(ACN) << "," << idnint(ZCN) << "," << idnint(AIMF_1) << "," << idnint(ZIMF_1) << std::endl;
6802  std::cout << "SSBIMF,TIMF :" << SSBIMF[IZIMF][IAIMF] << "," << fTIMF << std::endl;
6803  std::cout << "DEXP(-IMFARG) = " << std::exp(-IMFARG) << std::endl;
6804  std::cout << "WIDTH1 =" << WIDTH1 << std::endl;
6805  }
6806  }// if ee
6807 
6808  SDW[IZIMF] = SDW[IZIMF] + WIDTH_IMF;
6809 
6810  DW[IZIMF][IAIMF] = WIDTH_IMF;
6811 
6812  }// for INIMF
6813  }// for IZIMF
6814 // End loop to calculate the decay widths ************************
6815 // ***************************************************************
6816 
6817 // Loop to calculate where the gamma of IMF has the minimum ******
6818  SDWprevious = 1.e20;
6819  IZSTOP = 0;
6820 
6821  for(G4int III_ZIMF=3;III_ZIMF<=IZIMFMAX;III_ZIMF++){
6822 
6823  if(SDW[III_ZIMF]==0.0){
6824  IZSTOP = III_ZIMF - 1;
6825  goto imfs30;
6826  }
6827 
6828  if(SDW[III_ZIMF]>SDWprevious){
6829  IZSTOP = III_ZIMF - 1;
6830  goto imfs30;
6831  }else{
6832  SDWprevious = SDW[III_ZIMF];
6833  }
6834 
6835  }// for III_ZIMF
6836 
6837  imfs30:
6838 
6839  if(IZSTOP<=6){
6840  IZSTOP = IZIMFMAX;
6841  goto imfs15;
6842  }
6843 
6844  A1PAR = std::log10(SDW[IZSTOP]/SDW[IZSTOP-2])/std::log10((1.0*IZSTOP)/(1.0*IZSTOP-2.0));
6845  A2PAR = std::log10(SDW[IZSTOP]) - A1PAR * std::log10(1.0*(IZSTOP));
6846  if(A2PAR>0.)A2PAR=-1.*A2PAR;
6847  if(A1PAR>0.)A1PAR=-1.*A1PAR;
6848 
6849 // End loop to calculate where gamma of IMF has the minimum
6850 
6851  for(G4int II_ZIMF = IZSTOP;II_ZIMF<=IZIMFMAX;II_ZIMF++){
6852  SDW[II_ZIMF] = std::pow(10.0,A2PAR) * std::pow(1.0*II_ZIMF,A1PAR); // Power-low
6853  if(SDW[II_ZIMF]<0.0) SDW[II_ZIMF] = 0.0;
6854  }
6855 
6856  imfs15:
6857 
6858 // Sum of all decay widths (for normalisation)
6859  SUMDW_TOT = 0.0;
6860  for(G4int I_ZIMF = 3;I_ZIMF<=IZIMFMAX;I_ZIMF++){
6861  SUMDW_TOT = SUMDW_TOT + SDW[I_ZIMF];
6862  }
6863  if(SUMDW_TOT<=0.0){
6864  std::cout << "*********************" << std::endl;
6865  std::cout << "IMF function" << std::endl;
6866  std::cout << "SUM of decay widths = " << SUMDW_TOT << " IZIMFMAX = " << IZIMFMAX << std::endl;
6867  std::cout << "IZSTOP = " << IZSTOP << std::endl;
6868  }
6869 
6870 // End of Sum of all decay widths (for normalisation)
6871 
6872 // Loop to sample the nuclide that is emitted ********************
6873 // ------- sample Z -----------
6874  imfs10:
6875  X = haz(1)*SUMDW_TOT;
6876 
6877 // IF(X.EQ.0.D0) PRINT*,'WARNING: X=0',XRNDM,SUMDW_TOT
6878  SUM_Z = 0.0;
6879  fZIMF = 0.0;
6880  IZMEM = 0;
6881 
6882  for(G4int IZ = 3;IZ<=IZIMFMAX;IZ++){
6883  SUM_Z = SUM_Z + SDW[IZ];
6884  if(X<SUM_Z){
6885  fZIMF = 1.0*IZ;
6886  IZMEM = IZ;
6887  goto imfs20;
6888  }
6889  }//for IZ
6890 
6891  imfs20:
6892 
6893 // ------- sample N -----------
6894 
6895  isostab_lim(IZMEM,&INMINMEM,&INMAXMEM);
6896  INMINMEM = max(1,INMINMEM-2);
6897 
6898  isostab_lim(IZCN-IZMEM,&INMI,&INMA); // Daughter nucleus after IMF emission,
6899  INMI = max(1,INMI-2);
6900  // limits of bound isotopes
6901 
6902  INMINMEM = max(INMINMEM,INCN-INMA); // Both IMF and daughter must be bound
6903  INMAXMEM = min(INMAXMEM,INCN-INMI); // "
6904 
6905  INMAXMEM = max(INMINMEM,INMAXMEM);
6906 
6907  IA = 0;
6908  SUMDW_N_TOT = 0.0;
6909  for(G4int IIINIMF = INMINMEM;IIINIMF<=INMAXMEM;IIINIMF++){
6910  IA = IZMEM + IIINIMF;
6911  if(IZMEM>=3&&IZMEM<=95&&IA>=4&&IA<=250){
6912  SUMDW_N_TOT = SUMDW_N_TOT + DW[IZMEM][IA];
6913  }else{
6914  std::cout << "CHARGE IMF OUT OF RANGE" << IZMEM << ", " << IA << ", " << idnint(ACN) << ", " << idnint(ZCN) << ", " << TEMP << std::endl;
6915  }
6916  }
6917 
6918  XX = haz(1)*SUMDW_N_TOT;
6919  IIA = 0;
6920  SUM_A = 0.0;
6921  for(G4int IINIMF = INMINMEM;IINIMF<=INMAXMEM; IINIMF++){
6922  IIA = IZMEM + IINIMF;
6923  // SUM_A = SUM_A + DW[IZ][IIA]; //FIXME
6924  SUM_A = SUM_A + DW[IZMEM][IIA];
6925  if(XX<SUM_A){
6926  fAIMF = G4double(IIA);
6927  goto imfs25;
6928  }
6929  }
6930 
6931  imfs25:
6932 // CHECK POINT 1
6933  NIMF = fAIMF - fZIMF;
6934 
6935  if((ACN-ZCN-NIMF)<=0.0 || (ZCN-fZIMF) <= 0.0){
6936  std::cout << "IMF Partner unstable:" << std::endl;
6937  std::cout << "System: Acn,Zcn,NCN:" << std::endl;
6938  std::cout << idnint(ACN) << ", " << idnint(ZCN) << ", " << idnint(ACN-ZCN) << std::endl;
6939  std::cout << "IMF: A,Z,N:" << std::endl;
6940  std::cout << idnint(fAIMF) << ", " << idnint(fZIMF) << ", " << idnint(fAIMF-fZIMF) << std::endl;
6941  std::cout << "Partner: A,Z,N:" << std::endl;
6942  std::cout << idnint(ACN-fAIMF) << ", " << idnint(ZCN-fZIMF) << ", " << idnint(ACN-ZCN-NIMF) << std::endl;
6943  std::cout << "----nmin,nmax" << INMINMEM << ", " << INMAXMEM << std::endl;
6944  std::cout << "----- warning: Zimf=" << fZIMF << " Aimf=" << fAIMF << std::endl;
6945  std::cout << "----- look in subroutine IMF" << std::endl;
6946  std::cout << "ACN,ZCN,ZIMF,AIMF,temp,EE,JPRF::" << ACN << ", " << ZCN << ", " << fZIMF << ", " << fAIMF << ", " << TEMP << ", " << EE << ", " << JPRF << std::endl;
6947 std::cout << "-IZSTOP,IZIMFMAX:" << IZSTOP << ", " << IZIMFMAX << std::endl;
6948 std::cout << "----X,SUM_Z,SUMDW_TOT:" << X << ", " << SUM_Z << ", " << SUMDW_TOT << std::endl;
6949 
6950  goto imfs10;
6951  }
6952  if(fZIMF>=ZCN || fAIMF>=ACN || fZIMF<=2 || fAIMF<=3){
6953  std::cout << "----nmin,nmax" << INMINMEM << ", " << INMAXMEM << std::endl;
6954  std::cout << "----- warning: Zimf=" << fZIMF << " Aimf=" << fAIMF << std::endl;
6955  std::cout << "----- look in subroutine IMF" << std::endl;
6956  std::cout << "ACN,ZCN,ZIMF,AIMF,temp,EE,JPRF:" << ACN << ", " << ZCN << ", " << fZIMF << ", " << fAIMF << ", " << TEMP << ", " << EE << ", " << JPRF << std::endl;
6957 std::cout << "-IZSTOP,IZIMFMAX:" << IZSTOP << ", " << IZIMFMAX << std::endl;
6958 std::cout << "----X,SUM_Z,SUMDW_TOT:" << X << ", " << SUM_Z << ", " << SUMDW_TOT << std::endl;
6959 for(G4int III_ZIMF=3;III_ZIMF<=IZIMFMAX;III_ZIMF++)
6960  std::cout << "-**Z,SDW:" << III_ZIMF << ", " << SDW[III_ZIMF] << std::endl;
6961 
6962  fZIMF = 3.0; // provisorisch AK
6963  fAIMF = 4.0;
6964  }
6965 
6966 // Characteristics of selected IMF (AIMF, ZIMF, BIMF, SBIMF, TIMF)
6967  fSBIMF = SSBIMF[idnint(fZIMF)][idnint(fAIMF)];
6968  fBIMF = BBIMF[idnint(fZIMF)][idnint(fAIMF)];
6969 
6970  if((ZCN-fZIMF)<=0.0)std::cout << "CHARGE_IMF ZIMF > ZCN" << std::endl;
6971  if((ACN-fAIMF)<=0.0)std::cout << "CHARGE_IMF AIMF > ACN" << std::endl;
6972 
6973  BSHELL = ecld->ecgnz[idnint(ACN-ZCN-NIMF)][idnint(ZCN-fZIMF)] -ecld->vgsld[idnint(ACN-ZCN-NIMF)][idnint(ZCN-fZIMF)];
6974 
6975  DEFBET = ecld->beta2[idnint(ACN-ZCN-NIMF)][idnint(ZCN-fZIMF)];
6976  EEDAUG = (EE - fSBIMF) * (ACN - fAIMF) / ACN;
6977  bsbkbc(ACN - fAIMF,ZCN-fZIMF,&BS,&BK,&BC);
6978  densniv(ACN-fAIMF,ZCN-fZIMF,EEDAUG,0.0,&DENSIMF,BSHELL,BS,BK,&fTIMF,0,0,DEFBET,&ECOR,0.0,0,&QR);
6979 
6980  if(fSBIMF>EE){
6981  std::cout << "----- warning: EE=" << EE << "," << " S+Bimf=" << fSBIMF << std::endl;
6982  std::cout << "----- look in subroutine IMF" << std::endl;
6983  std::cout << "IMF will be resampled" << std::endl;
6984  goto imfs10;
6985  }
6986  (*ZIMF) = fZIMF;
6987  (*AIMF) = fAIMF;
6988  (*SBIMF) = fSBIMF;
6989  (*BIMF) = fBIMF;
6990  (*TIMF) = fTIMF;
6991  return;
6992 }
6993 
6995 {
6996 
6997 G4int VISOSTAB[191][2]={
6998  {0 , 7 },
6999  {1 , 8 },
7000  {1 , 9 },
7001  {2 , 12 },
7002  {2 , 14 },
7003  {2 , 16 },
7004  {3 , 18 },
7005  {4 , 22 },
7006  {6 , 22 },
7007  {6 , 28 },
7008  {7 , 28 },
7009  {7 , 30 },
7010  {8 , 28 },
7011  {8 , 36 },
7012  {10 , 38 },
7013  {10 , 40 },
7014  {11 , 38 },
7015  {10 , 42 },
7016  {13 , 50 },
7017  {14 , 50 },
7018  {15 , 52 },
7019  {16 , 52 },
7020  {17 , 54 },
7021  {18 , 54 },
7022  {19 , 60 },
7023  {19 , 62 },
7024  {21 , 64 },
7025  {20 , 66 },
7026  {23 , 66 },
7027  {24 , 70 },
7028  {25 , 70 },
7029  {26 , 74 },
7030  {27 , 78 },
7031  {29 , 82 },
7032  {33 , 82 },
7033  {31 , 82 },
7034  {35 , 82 },
7035  {34 , 84 },
7036  {40 , 84 },
7037  {36 , 86 },
7038  {40 , 92 },
7039  {38 , 96 },
7040  {42 , 102 },
7041  {42 , 102 },
7042  {44 , 102 },
7043  {42 , 106 },
7044  {47 , 112 },
7045  {44 , 114 },
7046  {49 , 116 },
7047  {46 , 118 },
7048  {52 , 120 },
7049  {52 , 124 },
7050  {55 , 126 },
7051  {54 , 126 },
7052  {57 , 126 },
7053  {57 , 126 },
7054  {60 , 126 },
7055  {58 , 130 },
7056  { 62 , 132 },
7057  { 60 , 140 },
7058  { 67 , 138 },
7059  { 64 , 142 },
7060  { 67 , 144 },
7061  { 68 , 146 },
7062  { 70 , 148 },
7063  { 70 , 152 },
7064  { 73 , 152 },
7065  { 72 , 154 },
7066  { 75 , 156 },
7067  { 77 , 162 },
7068  { 79 , 164 },
7069  { 78 , 164 },
7070  { 82 , 166 },
7071  { 80 , 166 },
7072  { 85 , 168 },
7073  { 83 , 176 },
7074  { 87 , 178 },
7075  { 88 , 178 },
7076  { 91 , 182 },
7077  { 90 , 184 },
7078  { 96 , 184 },
7079  { 95 , 184 },
7080  { 99 , 184 },
7081  { 98 , 184 },
7082  { 105 , 194 },
7083  { 102 , 194 },
7084  { 108 , 196 },
7085  { 106 , 198 },
7086  { 115 , 204 },
7087  { 110 , 206 },
7088  { 119 , 210 },
7089  { 114 , 210 },
7090  { 124 , 210 },
7091  { 117 , 212 },
7092  { 130 , 212 }
7093  };
7094 
7095  if (z<0){
7096  *nmin = 0;
7097  *nmax = 0;
7098  }else{
7099  if(z==0){
7100  *nmin = 1;
7101  *nmax = 1;
7102 // AK (Dez2010) - Just to avoid numerical problems
7103  }else{
7104  if(z>95){
7105  *nmin = 130;
7106  *nmax = 200;
7107  }else{
7108  *nmin = VISOSTAB[z-1][0];
7109  *nmax = VISOSTAB[z-1][1];
7110  }
7111  }
7112  }
7113 
7114  return;
7115 }
7116 
7117 
7118 void G4Abla::evap_postsaddle(G4double A, G4double Z, G4double EXC, G4double *E_scission_post, G4double *A_scission, G4double *Z_scission,G4double &vx_eva,G4double &vy_eva,G4double &vz_eva){
7119 
7120 // AK 2006 - Now in case of fission deexcitation between saddle and scission
7121 // is explicitely calculated. Langevin calculations made by P. Nadtochy
7122 // used to parametrise saddle-to-scission time
7123 
7124  G4double af,zf,ee;
7125  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, tcn = 0.0;
7126  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;
7127  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;
7128 
7129  G4double xcv=0.,ycv=0.,zcv=0.,VXOUT=0.,VYOUT=0.,VZOUT=0.;
7130 
7131  G4double jprfn=0.0, jprfp=0.0, jprfd=0.0, jprft=0.0, jprfhe=0.0, jprfa=0.0;
7132  G4double ctet1 = 0.0, stet1 = 0.0, phi1 = 0.0;
7133  G4double rnd = 0.0;
7134 
7135  G4int itest = 0, sortie=0;
7136  G4double probf = 0.0;
7137 
7138  G4double ef = 0.0;
7139  G4double pc = 0.0;
7140 
7141  G4double time,tauf,tau0,a0,a1,emin,ts1,tsum=0.;
7142  G4int inttype=0,inum=0,gammadecay = 0;
7143  G4double pleva = 0.0;
7144  G4double pxeva = 0.0;
7145  G4double pyeva = 0.0;
7146  G4double pteva = 0.0;
7147  G4double etot = 0.0;
7148 
7149  const G4double c = 29.9792458;
7150  const G4double mu = 931.494;
7151  const G4double mu2 = 931.494*931.494;
7152 
7153  vx_eva=0.;
7154  vy_eva=0.;
7155  vz_eva=0.;
7156  IEV_TAB_SSC = 0;
7157 
7158 
7159  af = dint(A);
7160  zf = dint(Z);
7161  ee = EXC;
7162 
7163  fiss->ifis = 0;
7164  opt->optimfallowed = 0;
7165  gammaemission=0;
7166 // Initialsation
7167  time = 0.0;
7168 
7169 // in sec
7170  tau0 = 1.0e-21;
7171  a0 = 0.66482503 - 3.4678935 * std::exp(-0.0104002*ee);
7172  a1 = 5.6846e-04 + 0.00574515 * std::exp(-0.01114307*ee);
7173  tauf = (a0 + a1 * zf*zf/std::pow(af,0.3333333)) * tau0;
7174 //
7175  post10:
7176  direct(zf,af,ee,0.,&probp,&probd,&probt,&probn,&probhe,&proba,&probg,&probimf,&probf,&ptotl,
7177  &sn,&sbp,&sbd,&sbt,&sbhe,&sba,
7178  &ecn,&ecp,&ecd,&ect,&eche,&eca,&ecg,
7179  &bp,&bd,&bt,&bhe,&ba,&sp,&sd,&st,&she,&sa,&ef,&ts1,inttype,inum,itest,&sortie,&tcn,
7180  &jprfn, &jprfp, &jprfd, &jprft, &jprfhe, &jprfa, &tsum); //:::FIXME::: Call
7181 //
7182 // HERE THE FINAL STEPS OF THE EVAPORATION ARE CALCULATED
7183 //
7184  if(ptotl<=0.)goto post100;
7185 
7186  emin = dmin1(sba,sbhe,dmin1(sbt,sbhe,dmin1(sn,sbp,sbd)));
7187 
7188  if(emin>1e30)std::cout << "ERROR AT THE EXIT OF EVAPORA,E>1.D30,AF" << std::endl;
7189 
7190  if(sortie==1){
7191  if (probn!=0.0) {
7192  amoins = 1.0;
7193  zmoins = 0.0;
7194  epsiln = sn + ecn;
7195  pc = std::sqrt(std::pow((1.0 + ecn/9.3956e2),2.) - 1.0) * 9.3956e2;
7196  gammadecay = 0;
7197  }
7198  else if(probp!=0.0){
7199  amoins = 1.0;
7200  zmoins = 1.0;
7201  epsiln = sp + ecp;
7202  pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2.) - 1.0) * 9.3827e2;
7203  gammadecay = 0;
7204  }
7205  else if(probd!=0.0){
7206  amoins = 2.0;
7207  zmoins = 1.0;
7208  epsiln = sd + ecd;
7209  pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
7210  gammadecay = 0;
7211  }
7212  else if(probt!=0.0){
7213  amoins = 3.0;
7214  zmoins = 1.0;
7215  epsiln = st + ect;
7216  pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
7217  gammadecay = 0;
7218  }
7219  else if(probhe!=0.0){
7220  amoins = 3.0;
7221  zmoins = 2.0;
7222  epsiln = she + eche;
7223  pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
7224  gammadecay = 0;
7225  }
7226  else{ if(proba!=0.0){
7227  amoins = 4.0;
7228  zmoins = 2.0;
7229  epsiln = sa + eca;
7230  pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
7231  gammadecay = 0;
7232  }
7233  }
7234  goto post99;
7235  }
7236 
7237  // IRNDM = IRNDM+1;
7238 //
7239 // HERE THE NORMAL EVAPORATION CASCADE STARTS
7240 // RANDOM NUMBER FOR THE EVAPORATION
7241 
7242 
7243  // random number for the evaporation
7244  x = G4AblaRandom::flat() * ptotl;
7245 
7246  itest = 0;
7247  if (x < proba) {
7248  // alpha evaporation
7249  amoins = 4.0;
7250  zmoins = 2.0;
7251  epsiln = sa + eca;
7252  pc = std::sqrt(std::pow((1.0 + eca/3.72834e3),2) - 1.0) * 3.72834e3;
7253  gammadecay = 0;
7254  }
7255  else if (x < proba+probhe) {
7256  // He3 evaporation
7257  amoins = 3.0;
7258  zmoins = 2.0;
7259  epsiln = she + eche;
7260  pc = std::sqrt(std::pow((1.0 + eche/2.80826e3),2) - 1.0) * 2.80826e3;
7261  gammadecay = 0;
7262  }
7263  else if (x < proba+probhe+probt) {
7264  // triton evaporation
7265  amoins = 3.0;
7266  zmoins = 1.0;
7267  epsiln = st + ect;
7268  pc = std::sqrt(std::pow((1.0 + ect/2.80828e3),2) - 1.0) * 2.80828e3;
7269  gammadecay = 0;
7270  }
7271  else if (x < proba+probhe+probt+probd) {
7272  // deuteron evaporation
7273  amoins = 2.0;
7274  zmoins = 1.0;
7275  epsiln = sd + ecd;
7276  pc = std::sqrt(std::pow((1.0 + ecd/1.875358e3),2) - 1.0) * 1.875358e3;
7277  gammadecay = 0;
7278  }
7279  else if (x < proba+probhe+probt+probd+probp) {
7280  // proton evaporation
7281  amoins = 1.0;
7282  zmoins = 1.0;
7283  epsiln = sp + ecp;
7284  pc = std::sqrt(std::pow((1.0 + ecp/9.3827e2),2) - 1.0) * 9.3827e2;
7285  gammadecay = 0;
7286  }
7287  else if (x < proba+probhe+probt+probd+probp+probn) {
7288  // neutron evaporation
7289  amoins = 1.0;
7290  zmoins = 0.0;
7291  epsiln = sn + ecn;
7292  pc = std::sqrt(std::pow((1.0 + ecn/9.3956e2),2.) - 1.0) * 9.3956e2;
7293  gammadecay = 0;
7294  }
7295  else if (x < proba+probhe+probt+probd+probp+probn+probg) {
7296  // gamma evaporation
7297  amoins = 0.0;
7298  zmoins = 0.0;
7299  epsiln = ecg;
7300  pc = ecg;
7301  gammadecay = 1;
7302  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){
7303  //ee = ee-epsiln;
7304  //if(ee<=0.01) ee = 0.010;
7305  goto post100;
7306  }
7307  }
7308 
7309 // CALCULATION OF THE DAUGHTER NUCLEUS
7310 //
7311  post99:
7312 
7313  if(gammadecay==1 && ee<=0.01+epsiln){
7314  epsiln = ee-0.01;
7315  time = tauf + 1.;
7316  }
7317 
7318  af = af-amoins;
7319  zf = zf-zmoins;
7320  ee = ee-epsiln;
7321 
7322  if(ee<=0.01) ee = 0.010;
7323 
7324  if(af<2.5) goto post100;
7325 
7326  time = time + ts1;
7327 
7328 // Determination of x,y,z components of momentum from known emission momentum
7329  EV_TAB_SSC[IEV_TAB_SSC][0] = zmoins;
7330  EV_TAB_SSC[IEV_TAB_SSC][1] = amoins;
7331  rnd = G4AblaRandom::flat();
7332  ctet1 = 2.0*rnd - 1.0; // z component: uniform probability between -1 and 1
7333  stet1 = std::sqrt(1.0 - std::pow(ctet1,2));// component perpendicular to z
7334  rnd = G4AblaRandom::flat();
7335  phi1 = rnd*2.0*3.141592654; // angle in x-y plane: uniform probability between 0 and 2*pi
7336  xcv = stet1*std::cos(phi1); // x component
7337  ycv = stet1*std::sin(phi1); // y component
7338  zcv = ctet1; // z component
7339 // In the CM system
7340  if(gammadecay==0){
7341 // Light particle
7342  G4double ETOT_LP = std::sqrt(pc*pc + amoins*amoins * mu2);
7343  EV_TAB_SSC[IEV_TAB_SSC][2] = c * pc * xcv / ETOT_LP;
7344  EV_TAB_SSC[IEV_TAB_SSC][3] = c * pc * ycv / ETOT_LP;
7345  EV_TAB_SSC[IEV_TAB_SSC][4] = c * pc * zcv / ETOT_LP;
7346  }else{
7347 // gamma ray
7348  EV_TAB_SSC[IEV_TAB_SSC][2] = pc * xcv;
7349  EV_TAB_SSC[IEV_TAB_SSC][3] = pc * ycv;
7350  EV_TAB_SSC[IEV_TAB_SSC][4] = pc * zcv;
7351  }
7352  lorentz_boost(vx_eva,vy_eva,vz_eva,
7353  EV_TAB_SSC[IEV_TAB_SSC][2],EV_TAB_SSC[IEV_TAB_SSC][3],
7354  EV_TAB_SSC[IEV_TAB_SSC][4],
7355  &VXOUT,&VYOUT,&VZOUT);
7356  EV_TAB_SSC[IEV_TAB_SSC][2] = VXOUT;
7357  EV_TAB_SSC[IEV_TAB_SSC][3] = VYOUT;
7358  EV_TAB_SSC[IEV_TAB_SSC][4] = VZOUT;
7359 
7360 // Heavy residue
7361  if(gammadecay==0){
7362  G4double v2 = std::pow(EV_TAB_SSC[IEV_TAB_SSC][2],2.) +
7363  std::pow(EV_TAB_SSC[IEV_TAB_SSC][3],2.) +
7364  std::pow(EV_TAB_SSC[IEV_TAB_SSC][4],2.);
7365  G4double gamma = 1.0/std::sqrt(1.0 - v2 / (c*c));
7366  G4double etot_lp = amoins*mu * gamma;
7367  pxeva = pxeva - EV_TAB_SSC[IEV_TAB_SSC][2] * etot_lp / c;
7368  pyeva = pyeva - EV_TAB_SSC[IEV_TAB_SSC][3] * etot_lp / c;
7369  pleva = pleva - EV_TAB_SSC[IEV_TAB_SSC][4] * etot_lp / c;
7370  }else{
7371 // in case of gammas, EV_TEMP contains momentum components and not velocity
7372  pxeva = pxeva - EV_TAB_SSC[IEV_TAB_SSC][2];
7373  pyeva = pyeva - EV_TAB_SSC[IEV_TAB_SSC][3];
7374  pleva = pleva - EV_TAB_SSC[IEV_TAB_SSC][4];
7375  }
7376  pteva = std::sqrt(pxeva*pxeva + pyeva*pyeva);
7377 // To be checked:
7378  etot = std::sqrt ( pleva*pleva + pteva*pteva + af*af * mu2 );
7379  vx_eva = c * pxeva / etot; // recoil velocity components of residue due to evaporation
7380  vy_eva = c * pyeva / etot;
7381  vz_eva = c * pleva / etot;
7382 
7383  IEV_TAB_SSC = IEV_TAB_SSC +1;
7384 
7385  if(time<tauf)goto post10;
7386 //
7387  post100:
7388 //
7389  *A_scission= af;
7390  *Z_scission= zf;
7391  *E_scission_post = ee;
7392 
7393  return;
7394 }
7395 
7396 
7397 
7398 void G4Abla::unbound(G4double SN,G4double SP,G4double SD,G4double ST,G4double SHE,G4double SA,G4double BP,G4double BD,G4double BT,G4double BHE,G4double BA,G4double *PROBF,G4double *PROBN,G4double *PROBP,G4double *PROBD,G4double *PROBT,G4double *PROBHE,G4double *PROBA,G4double *PROBIMF,G4double *PROBG,G4double *ECN,G4double *ECP,G4double *ECD,G4double *ECT,G4double *ECHE,G4double *ECA)
7399 {
7400  G4double SBP = SP + BP;
7401  G4double SBD = SD + BD;
7402  G4double SBT = ST + BT;
7403  G4double SBHE = SHE + BHE;
7404  G4double SBA = SA + BA;
7405 
7406  G4double e = dmin1(SBP,SBD,SBT);
7407  e = dmin1(SBHE,SN,e);
7408  e = dmin1(SBHE,SBA,e);
7409 //
7410  if(SN==e){
7411  *ECN = (-1.0)*SN;
7412  *ECP = 0.0;
7413  *ECD = 0.0;
7414  *ECT = 0.0;
7415  *ECHE = 0.0;
7416  *ECA = 0.0;
7417  *PROBN = 1.0;
7418  *PROBP = 0.0;
7419  *PROBD = 0.0;
7420  *PROBT = 0.0;
7421  *PROBHE = 0.0;
7422  *PROBA = 0.0;
7423  *PROBIMF = 0.0;
7424  *PROBF = 0.0;
7425  *PROBG = 0.0;
7426  }
7427  else if(SBP==e){
7428  *ECN = 0.0;
7429  *ECP = (-1.0)*SP + BP;
7430  *ECD = 0.0;
7431  *ECT = 0.0;
7432  *ECHE = 0.0;
7433  *ECA = 0.0;
7434  *PROBN = 0.0;
7435  *PROBP = 1.0;
7436  *PROBD = 0.0;
7437  *PROBT = 0.0;
7438  *PROBHE = 0.0;
7439  *PROBA = 0.0;
7440  *PROBIMF = 0.0;
7441  *PROBF = 0.0;
7442  *PROBG = 0.0;
7443  }
7444  else if(SBD==e){
7445  *ECN = 0.0;
7446  *ECD = (-1.0)*SD + BD;
7447  *ECP = 0.0;
7448  *ECT = 0.0;
7449  *ECHE = 0.0;
7450  *ECA = 0.0;
7451  *PROBN = 0.0;
7452  *PROBP = 0.0;
7453  *PROBD = 1.0;
7454  *PROBT = 0.0;
7455  *PROBHE = 0.0;
7456  *PROBA = 0.0;
7457  *PROBIMF = 0.0;
7458  *PROBF = 0.0;
7459  *PROBG = 0.0;
7460  }
7461  else if(SBT==e){
7462  *ECN = 0.0;
7463  *ECT = (-1.0)*ST + BT;
7464  *ECD = 0.0;
7465  *ECP = 0.0;
7466  *ECHE = 0.0;
7467  *ECA = 0.0;
7468  *PROBN = 0.0;
7469  *PROBP = 0.0;
7470  *PROBD = 0.0;
7471  *PROBT = 1.0;
7472  *PROBHE = 0.0;
7473  *PROBA = 0.0;
7474  *PROBIMF = 0.0;
7475  *PROBF = 0.0;
7476  *PROBG = 0.0;
7477  }
7478  else if(SBHE==e){
7479  *ECN = 0.0;
7480  *ECHE= (-1.0)*SHE + BHE;
7481  *ECD = 0.0;
7482  *ECT = 0.0;
7483  *ECP = 0.0;
7484  *ECA = 0.0;
7485  *PROBN = 0.0;
7486  *PROBP = 0.0;
7487  *PROBD = 0.0;
7488  *PROBT = 0.0;
7489  *PROBHE = 1.0;
7490  *PROBA = 0.0;
7491  *PROBIMF = 0.0;
7492  *PROBF = 0.0;
7493  *PROBG = 0.0;
7494  }
7495  else{
7496  if(SBA==e){
7497  *ECN = 0.0;
7498  *ECA = (-1.0)*SA + BA;
7499  *ECD = 0.0;
7500  *ECT = 0.0;
7501  *ECHE = 0.0;
7502  *ECP = 0.0;
7503  *PROBN = 0.0;
7504  *PROBP = 0.0;
7505  *PROBD = 0.0;
7506  *PROBT = 0.0;
7507  *PROBHE = 0.0;
7508  *PROBA = 1.0;
7509  *PROBIMF = 0.0;
7510  *PROBF = 0.0;
7511  *PROBG = 0.0;
7512  }
7513  }
7514 
7515  return;
7516 }
7517 
7519  G4double &a1,G4double &z1,G4double &e1,G4double &v1,
7520  G4double &a2,G4double &z2,G4double &e2,G4double &v2,
7521  G4double &vx_eva_sc,G4double &vy_eva_sc,G4double &vz_eva_sc)
7522 {
7523 /*
7524  Last update:
7525 
7526  21/01/17 - J.L.R.S. - Implementation of this fission model in C++
7527 
7528 
7529  Authors: K.-H. Schmidt, A. Kelic, M. V. Ricciardi,J. Benlliure, and
7530  J.L.Rodriguez-Sanchez(1995 - 2017)
7531 
7532  On input: A, Z, E (mass, atomic number and exc. energy of compound nucleus
7533  before fission)
7534  On output: Ai, Zi, Ei (mass, atomic number and (absolute) exc. energy of
7535  fragment 1 and 2 after fission)
7536 
7537 */
7538  /* This program calculates isotopic distributions of fission fragments */
7539  /* with a semiempirical model */
7540  /* The width and eventually a shift in N/Z (polarization) follows the */
7541  /* following rules: */
7542  /* */
7543  /* The line N/Z following UCD has an angle of atan(Zcn/Ncn) */
7544  /* to the horizontal axis on a chart of nuclides. */
7545 /* (For 238U the angle is 32.2 deg.) */
7546 /* */
7547 /* The following relations hold: (from Armbruster)
7548 c
7549 c sigma(N) (A=const) = sigma(Z) (A=const)
7550 c sigma(A) (N=const) = sigma(Z) (N=const)
7551 c sigma(A) (Z=const) = sigma(N) (Z=const)
7552 c
7553 c From this we get:
7554 c sigma(Z) (N=const) * N = sigma(N) (Z=const) * Z
7555 c sigma(A) (Z=const) = sigma(Z) (A=const) * A/Z
7556 c sigma(N) (Z=const) = sigma(Z) (A=const) * A/Z
7557 c Z*sigma(N) (Z=const) = N*sigma(Z) (N=const) = A*sigma(Z) (A=const) */
7558 //
7559 
7560 /* Model parameters:
7561 C These parameters have been adjusted to the compound nucleus 238U.
7562 c For the fission of another compound nucleus, it might be
7563 c necessary to slightly adjust some parameter values.
7564 c The most important ones are
7565 C Delta_U1_shell_max and
7566 c Delta_u2_shell.
7567 */
7568  G4double Nheavy1_in; // 'position of shell for Standard 1'
7569  Nheavy1_in = 83.0;
7570 
7571  G4double Zheavy1_in; // 'position of shell for Standard 1'
7572  Zheavy1_in = 50.0;
7573 
7574  G4double Nheavy2; // 'position of heavy peak valley 2'
7575  Nheavy2 = 89.0;
7576 
7577  G4double Delta_U1_shell_max; // 'Shell effect for valley 1'
7578  Delta_U1_shell_max = -2.45;
7579 
7580  G4double U1NZ_SLOPE; // Reduction of shell effect with distance to 132Sn
7581  U1NZ_SLOPE = 0.2;
7582 
7583  G4double Delta_U2_shell; // 'Shell effect for valley 2'
7584  Delta_U2_shell = -2.45;
7585 
7586  G4double X_s2s; // 'Ratio (C_sad/C_scis) of curvature of potential'
7587  X_s2s = 0.8;
7588 
7589  G4double hbom1,hbom2,hbom3; // 'Curvature of potential at saddle'
7590  hbom1 = 0.2; // hbom1 is hbar * omega1 / (2 pi) !!!
7591  hbom2 = 0.2; // hbom2 is hbar * omega2 / (2 pi) !!!
7592  hbom3 = 0.2; // hbom3 is hbar * omega3 / (2 pi) !!!
7593 
7594  G4double Fwidth_asymm1,Fwidth_asymm2,Fwidth_symm;
7595 // 'Factors for widths of distr. valley 1 and 2'
7596  Fwidth_asymm1 = 0.65;
7597  Fwidth_asymm2 = 0.65;
7598  Fwidth_symm = 1.16;
7599 
7600  G4double xLevdens; // 'Parameter x: a = A/x'
7601  xLevdens = 10.75;
7602 // The value of 1/0.093 = 10.75 is consistent with the
7603 // systematics of the mass widths of Ref. (RuI97).
7604 
7605  G4double FGAMMA; // 'Factor to gamma'
7606  FGAMMA = 1.; // Theoretical expectation, not adjusted to data.
7607 // Additional factor to attenuation coefficient of shell effects
7608 // with increasing excitation energy
7609 
7610  G4double FGAMMA1; // 'Factor to gamma_heavy1'
7611  FGAMMA1 = 2.;
7612 // Adjusted to reduce the weight of Standard 1 with increasing
7613 // excitation energies, as required by experimental data.
7614 
7615  G4double FREDSHELL;
7616  FREDSHELL = 0.;
7617 // Adjusted to the reduced attenuation of shells in the superfluid region.
7618 // If FGAMMA is modified,
7619 // FGAMMA * FREADSHELL should remain constant (0.65) to keep
7620 // the attenuation of the shell effects below the critical
7621 // pairing energy ECRIT unchanged, which has been carefully
7622 // adjusted to the mass yields of Vives and Zoeller in this
7623 // energy range. A high value of FGAMMA leads ot a stronger
7624 // attenuation of shell effects above the superfluid region.
7625 
7626  G4double Ecrit;
7627  Ecrit = 5.;
7628 // The value of ECRIT determines the transition from a weak
7629 // decrease of the shell effect below ECRIT to a stronger
7630 // decrease above the superfluid range.
7631  const G4double d = 2.0; // 'Surface distance of scission configuration'
7632  // d = 2.0;
7633 // Charge polarisation from Wagemanns p. 397:
7634  G4double cpol1; // Charge polarisation standard I
7635  cpol1 = 0.35; // calculated internally with shells
7636  G4double cpol2; // Charge polarisation standard II
7637  cpol2 = 0.; // calculated internally from LDM
7638  G4double Friction_factor;
7639  Friction_factor = 1.0;
7640  G4double Nheavy1; // position of valley St 1 in Z and N
7641  G4double Delta_U1,Delta_U2; // used shell effects
7642  G4double cN_asymm1_shell, cN_asymm2_shell;
7643  G4double gamma,gamma_heavy1,gamma_heavy2; // fading of shells
7644  G4double E_saddle_scission; // friction from saddle to scission
7645  G4double Ysymm=0.; // Yield of symmetric mode
7646  G4double Yasymm1=0.; // Yield of asymmetric mode 1
7647  G4double Yasymm2=0.; // Yield of asymmetric mode 2
7648  G4double Nheavy1_eff; // Effective position of valley 1
7649  G4double Nheavy2_eff; // Effective position of valley 2
7650  G4double eexc1_saddle; // Excitation energy above saddle 1
7651  G4double eexc2_saddle; // Excitation energy above saddle 2
7652  G4double EEXC_MAX; // Excitation energy above lowest saddle
7653  G4double r_e_o; // Even-odd effect in Z
7654  G4double cN_symm; // Curvature of symmetric valley
7655  G4double CZ; // Curvature of Z distribution for fixed A
7656  G4double Nheavy2_NZ; // Position of Shell 2, combined N and Z
7657  G4double N;
7658  G4double Aheavy1,Aheavy2;
7659  G4double Sasymm1=0.,Sasymm2=0.,Ssymm=0.,Ysum=0.,Yasymm=0.;
7660  G4double Ssymm_mode1,Ssymm_mode2;
7661  G4double wNasymm1_saddle, wNasymm2_saddle, wNsymm_saddle;
7662  G4double wNasymm2_scission, wNsymm_scission;
7663  G4double wNasymm1, wNasymm2, wNsymm;
7664  G4int imode;
7665  G4double rmode;
7666  G4double ZA1width;
7667  G4double N1r,N2r,A1r,N1,N2;
7668  G4double Zsymm,Nsymm;
7669  G4double N1mean, N1width;
7670  G4double dUeff;
7671  /* effective shell effect at lowest barrier */
7672  G4double Eld;
7673  /* Excitation energy with respect to ld barrier */
7674  G4double re1,re2,re3;
7675  G4double eps1,eps2;
7676  G4double Z1UCD,Z2UCD;
7677  G4double beta,beta1,beta2;
7678  // G4double betacomplement;
7679  G4double DN1_POL;
7680  /* shift of most probable neutron number for given Z,
7681  according to polarization */
7682  G4int i_help;
7683  G4double A_levdens;
7684  /* level-density parameter */
7685  // G4double A_levdens_light1,A_levdens_light2;
7686  G4double A_levdens_heavy1,A_levdens_heavy2;
7687 
7688  G4double R0=1.16;
7689 
7690  G4double epsilon_1_saddle,epsilon0_1_saddle;
7691  G4double epsilon_2_saddle,epsilon0_2_saddle,epsilon_symm_saddle;
7692  G4double epsilon_1_scission;//,epsilon0_1_scission;
7693  G4double epsilon_2_scission;//,epsilon0_2_scission;
7694  G4double epsilon_symm_scission;
7695  /* modified energy */
7696  G4double E_eff1_saddle,E_eff2_saddle;
7697  G4double Epot0_mode1_saddle,Epot0_mode2_saddle,Epot0_symm_saddle;
7698  G4double Epot_mode1_saddle,Epot_mode2_saddle,Epot_symm_saddle;
7699  G4double E_defo,E_defo1,E_defo2,E_scission_pre,E_scission_post;
7700  G4double E_asym;
7701  G4double E1exc,E2exc;
7702  G4double E1exc_sigma,E2exc_sigma;
7703  G4double TKER;
7704  G4double EkinR1,EkinR2;
7705  G4double MassCurv_scis, MassCurv_sadd;
7706  G4double cN_symm_sadd;
7707  G4double Nheavy1_shell,Nheavy2_shell;
7708  G4double wNasymm1_scission;
7709  G4double Aheavy1_eff,Aheavy2_eff;
7710  G4double Z1rr,Z1r;
7711  G4double E_HELP;
7712  G4double Z_scission,N_scission,A_scission;
7713  G4double Z2_over_A_eff;
7714  G4double beta1gs,beta2gs,betags;
7715  G4double sigZmin; // 'Minimum neutron width for constant Z'
7716  G4double DSN132,Delta_U1_shell,E_eff0_saddle;//,e_scission;
7717  //
7718  sigZmin = 0.5;
7719  N = A - Z; /* neutron number of the fissioning nucleus */
7720 //
7721  cN_asymm1_shell = 0.700 * N/Z;
7722  cN_asymm2_shell = 0.040 * N/Z;
7723 
7724 //*********************************************************************
7725 
7726  DSN132 = Nheavy1_in - N/Z * Zheavy1_in;
7727  Aheavy1 = Nheavy1_in + Zheavy1_in + 0.340 * DSN132;
7728  /* Neutron number of valley Standard 1 */
7729  /* It is assumed that the 82-neutron shell effect is stronger than
7730 c the 50-proton shell effect. Therefore, the deviation in N/Z of
7731 c the fissioning nucleus from the N/Z of 132Sn will
7732 c change the position of the combined shell in mass. For neutron-
7733 c deficient fissioning nuclei, the mass will increase and vice
7734 c versa. */
7735 
7736  Delta_U1_shell = Delta_U1_shell_max + U1NZ_SLOPE * std::abs(DSN132);
7737  Delta_U1_shell = min(0.,Delta_U1_shell);
7738  /* Empirical reduction of shell effect with distance in N/Z of CN to 132Sn */
7739  /* Fits (239U,n)f and 226Th e.-m.-induced fission */
7740 
7741  Nheavy1 = N/A * Aheavy1; /* UCD */
7742  Aheavy2 = Nheavy2 * A/N;
7743 
7744  Zsymm = Z / 2.0; /* proton number in symmetric fission (centre) */
7745  Nsymm = N / 2.0;
7746  A_levdens = A / xLevdens;
7747  gamma = A_levdens / (0.40 * std::pow(A,1.3333)) * FGAMMA;
7748  A_levdens_heavy1 = Aheavy1 / xLevdens;
7749  gamma_heavy1 = A_levdens_heavy1 / (0.40 * std::pow(Aheavy1,1.3333)) * FGAMMA * FGAMMA1;
7750  A_levdens_heavy2 = Aheavy2 / xLevdens;
7751  gamma_heavy2 = A_levdens_heavy2 / (0.40 * std::pow(Aheavy2,1.3333)) * FGAMMA;
7752 
7753 // Energy dissipated from saddle to scission
7754 // F. Rejmund et al., Nucl. Phys. A 678 (2000) 215, fig. 4 b */
7755  E_saddle_scission = (-24. + 0.02227 * Z*Z/std::pow(A,0.33333))*Friction_factor;
7756  E_saddle_scission = max( 0.0, E_saddle_scission );
7757 
7758 // Fit to experimental result on curvature of potential at saddle
7759 // Parametrization of T. Enqvist according to Mulgin et al. 1998
7760 // MassCurv taken at scission. */
7761 
7762  Z2_over_A_eff = Z*Z/A;
7763 
7764  if( Z2_over_A_eff< 34.0 )
7765  MassCurv_scis = std::pow(10., -1.093364 + 0.082933 * Z2_over_A_eff - 0.0002602 * Z2_over_A_eff*Z2_over_A_eff);
7766  else
7767  MassCurv_scis = std::pow(10., 3.053536 - 0.056477 * Z2_over_A_eff+ 0.0002454 * Z2_over_A_eff*Z2_over_A_eff );
7768 
7769 // to do:
7770 // fix the X with the channel intensities of 226Th (KHS at SEYSSINS,1998)
7771 // replace then (all) cN_symm by cN_symm_saddle (at least for Yields)
7772  MassCurv_sadd = X_s2s * MassCurv_scis;
7773 
7774  cN_symm = 8.0 / std::pow(N,2.) * MassCurv_scis;
7775  cN_symm_sadd = 8.0 / std::pow(N,2.) * MassCurv_sadd;
7776 
7777  Nheavy1_shell = Nheavy1;
7778 
7779  if(E < 100.0)
7780  Nheavy1_eff = (cN_symm_sadd*Nsymm + cN_asymm1_shell *
7781  Uwash(E/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1) *
7782  Nheavy1_shell)
7783  / (cN_symm_sadd +
7784  cN_asymm1_shell *
7785  Uwash(E/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1));
7786  else
7787  Nheavy1_eff = (cN_symm_sadd*Nsymm +
7788  cN_asymm1_shell*Nheavy1_shell)
7789  / (cN_symm_sadd +
7790  cN_asymm1_shell);
7791 
7792  /* Position of Standard II defined by neutron shell */
7793  Nheavy2_NZ = Nheavy2;
7794  Nheavy2_shell = Nheavy2_NZ;
7795  if (E < 100.)
7796  Nheavy2_eff = (cN_symm_sadd*Nsymm +
7797  cN_asymm2_shell*
7798  Uwash(E/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2) *
7799  Nheavy2_shell)
7800  / (cN_symm_sadd +
7801  cN_asymm2_shell*
7802  Uwash(E/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2));
7803  else
7804  Nheavy2_eff = (cN_symm_sadd*Nsymm +
7805  cN_asymm2_shell*Nheavy2_shell)
7806  / (cN_symm_sadd +
7807  cN_asymm2_shell);
7808 
7809  Delta_U1 = Delta_U1_shell + (Nheavy1_shell - Nheavy1_eff)*(Nheavy1_shell - Nheavy1_eff) * cN_asymm1_shell; /* shell effect in valley of mode 1 */
7810  Delta_U1 = min(Delta_U1,0.0);
7811  Delta_U2 = Delta_U2_shell + (Nheavy2_shell - Nheavy2_eff)*(Nheavy2_shell - Nheavy2_eff) * cN_asymm2_shell; /* shell effect in valley of mode 2 */
7812  Delta_U2 = min(Delta_U2,0.0);
7813 
7814 // liquid drop energies at the centres of the different shell effects
7815 // with respect to liquid drop at symmetry
7816  Epot0_mode1_saddle = (Nheavy1_eff-Nsymm)*(Nheavy1_eff-Nsymm) * cN_symm_sadd;
7817  Epot0_mode2_saddle = (Nheavy2_eff-Nsymm)*(Nheavy2_eff-Nsymm) * cN_symm_sadd;
7818  Epot0_symm_saddle = 0.0;
7819 
7820 // energies including shell effects at the centres of the different
7821 // shell effects with respect to liquid drop at symmetry */
7822  Epot_mode1_saddle = Epot0_mode1_saddle + Delta_U1;
7823  Epot_mode2_saddle = Epot0_mode2_saddle + Delta_U2;
7824  Epot_symm_saddle = Epot0_symm_saddle;
7825 
7826 // minimum of potential with respect to ld potential at symmetry
7827  dUeff = min( Epot_mode1_saddle, Epot_mode2_saddle);
7828  dUeff = min( dUeff, Epot_symm_saddle);
7829  dUeff = dUeff - Epot_symm_saddle;
7830 
7831  Eld = E + dUeff;
7832 // E = energy above lowest effective barrier
7833 // Eld = energy above liquid-drop barrier
7834 // Due to this treatment the energy E on input means the excitation
7835 // energy above the lowest saddle. */
7836 
7837 // excitation energies at saddle modes 1 and 2 without shell effect */
7838  epsilon0_1_saddle = Eld - Epot0_mode1_saddle;
7839  epsilon0_2_saddle = Eld - Epot0_mode2_saddle;
7840 
7841 // excitation energies at saddle modes 1 and 2 with shell effect */
7842  epsilon_1_saddle = Eld - Epot_mode1_saddle;
7843  epsilon_2_saddle = Eld - Epot_mode2_saddle;
7844 
7845  epsilon_symm_saddle = Eld - Epot_symm_saddle;
7846 // epsilon_symm_saddle = Eld - dUeff;
7847 
7848  eexc1_saddle = epsilon_1_saddle;
7849  eexc2_saddle = epsilon_2_saddle;
7850 
7851 // EEXC_MAX is energy above the lowest saddle */
7852  EEXC_MAX = max( eexc1_saddle, eexc2_saddle);
7853  EEXC_MAX = max( EEXC_MAX, Eld);
7854 
7855 // excitation energy at scission */
7856  epsilon_1_scission = Eld + E_saddle_scission - Epot_mode1_saddle;
7857  epsilon_2_scission = Eld + E_saddle_scission - Epot_mode2_saddle;
7858 
7859 // excitation energy of symmetric fragment at scission */
7860  epsilon_symm_scission = Eld + E_saddle_scission - Epot_symm_saddle;
7861 
7862 // calculate widhts at the saddle
7863  E_eff1_saddle = epsilon0_1_saddle - Delta_U1 *
7864  Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1);
7865 
7866  if( E_eff1_saddle < A_levdens * hbom1*hbom1)
7867  E_eff1_saddle = A_levdens * hbom1*hbom1;
7868 
7869  wNasymm1_saddle =
7870  std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_eff1_saddle) /
7871  (cN_asymm1_shell *
7872  Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)+
7873  cN_symm_sadd));
7874 
7875  E_eff2_saddle = epsilon0_2_saddle -
7876  Delta_U2 *
7877  Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2);
7878 
7879  if(E_eff2_saddle < A_levdens * hbom2*hbom2)
7880  E_eff2_saddle = A_levdens * hbom2*hbom2;
7881 
7882  wNasymm2_saddle =
7883  std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_eff2_saddle) /
7884  (cN_asymm2_shell *
7885  Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)+
7886  cN_symm_sadd));
7887 
7888  E_eff0_saddle = epsilon_symm_saddle;
7889  if(E_eff0_saddle < A_levdens * hbom3*hbom3)
7890  E_eff0_saddle = A_levdens * hbom3*hbom3;
7891 
7892  wNsymm_saddle =
7893  std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_eff0_saddle) /
7894  cN_symm_sadd);
7895 
7896  if(epsilon_symm_scission > 0.0 ){
7897  E_HELP = max(E_saddle_scission,epsilon_symm_scission);
7898  wNsymm_scission =
7899  std::sqrt(0.50 * std::sqrt(1.0/A_levdens*(E_HELP)) /
7900  cN_symm);
7901  }else{
7902  wNsymm_scission =
7903  std::sqrt(0.50 * std::sqrt(1.0/A_levdens*E_saddle_scission) /
7904  cN_symm);
7905  }
7906 
7907 // Calculate widhts at the scission point:
7908 // fits of ref. Beizin 1991 (Plots by Sergei Zhdanov)
7909 
7910  if( E_saddle_scission == 0.0 ){
7911  wNasymm1_scission = wNasymm1_saddle;
7912  wNasymm2_scission = wNasymm2_saddle;
7913  }else{
7914  if( Nheavy1_eff > 75.0 ){
7915  wNasymm1_scission = std::sqrt(21.0)*N/A;
7916  wNasymm2_scission = max( 12.8 - 1.0 *(92.0 - Nheavy2_eff),1.0)*N/A;
7917 
7918  }else{
7919  wNasymm1_scission = wNasymm1_saddle;
7920  wNasymm2_scission = wNasymm2_saddle;
7921  }
7922  }
7923 
7924  wNasymm1_scission = max( wNasymm1_scission, wNasymm1_saddle );
7925  wNasymm2_scission = max( wNasymm2_scission, wNasymm2_saddle );
7926 
7927  wNasymm1 = wNasymm1_scission * Fwidth_asymm1;
7928  wNasymm2 = wNasymm2_scission * Fwidth_asymm2;
7929  wNsymm = wNsymm_scission * Fwidth_symm;
7930 
7931 // mass and charge of fragments using UCD, needed for level densities
7932  Aheavy1_eff = Nheavy1_eff * A/N;
7933  Aheavy2_eff = Nheavy2_eff * A/N;
7934 
7935  A_levdens_heavy1 = Aheavy1_eff / xLevdens;
7936  A_levdens_heavy2 = Aheavy2_eff / xLevdens;
7937  gamma_heavy1 = A_levdens_heavy1 / (0.40 * std::pow(Aheavy1_eff,1.3333)) * FGAMMA * FGAMMA1;
7938  gamma_heavy2 = A_levdens_heavy2 / (0.40 * std::pow(Aheavy2_eff,1.3333)) * FGAMMA;
7939 
7940  if( epsilon_symm_saddle < A_levdens * hbom3*hbom3)
7941  Ssymm = 2.0 * std::sqrt(A_levdens*A_levdens * hbom3*hbom3) +
7942  (epsilon_symm_saddle - A_levdens * hbom3*hbom3)/hbom3;
7943  else
7944  Ssymm = 2.0 * std::sqrt(A_levdens*epsilon_symm_saddle);
7945 
7946  Ysymm = 1.0;
7947 
7948  if( epsilon0_1_saddle < A_levdens * hbom1*hbom1 )
7949  Ssymm_mode1 = 2.0 * std::sqrt(A_levdens*A_levdens * hbom1*hbom1) +
7950  (epsilon0_1_saddle - A_levdens * hbom1*hbom1)/hbom1;
7951  else
7952  Ssymm_mode1 = 2.0 * std::sqrt( A_levdens*epsilon0_1_saddle );
7953 
7954  if( epsilon0_2_saddle < A_levdens * hbom2*hbom2 )
7955  Ssymm_mode2 = 2.0 * std::sqrt(A_levdens*A_levdens * hbom2*hbom2) +
7956  (epsilon0_2_saddle - A_levdens * hbom2*hbom2)/hbom2;
7957  else
7958  Ssymm_mode2 = 2.0 * std::sqrt(A_levdens*epsilon0_2_saddle);
7959 
7960 
7961  if( epsilon0_1_saddle -
7962  Delta_U1*
7963  Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)
7964  < A_levdens * hbom1*hbom1 )
7965  Sasymm1 = 2.0 * std::sqrt( A_levdens*A_levdens * hbom1*hbom1 ) +
7966  (epsilon0_1_saddle - Delta_U1 *
7967  Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)
7968  - A_levdens * hbom1*hbom1)/hbom1;
7969  else
7970  Sasymm1 = 2.0 *std::sqrt( A_levdens*(epsilon0_1_saddle - Delta_U1 *
7971  Uwash(epsilon_1_saddle/A*Aheavy1,Ecrit,FREDSHELL,gamma_heavy1)));
7972 
7973  if( epsilon0_2_saddle -
7974  Delta_U2*
7975  Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)
7976  < A_levdens * hbom2*hbom2 )
7977  Sasymm2 = 2.0 * std::sqrt( A_levdens*A_levdens * hbom2*hbom2 ) +
7978  (epsilon0_1_saddle-Delta_U1 *
7979  Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)
7980  - A_levdens * hbom2*hbom2)/hbom2;
7981  else
7982  Sasymm2 = 2.0 *
7983  std::sqrt( A_levdens*(epsilon0_2_saddle - Delta_U2 *
7984  Uwash(epsilon_2_saddle/A*Aheavy2,Ecrit,FREDSHELL,gamma_heavy2)));
7985 
7986  Yasymm1 = ( std::exp(Sasymm1 - Ssymm) - std::exp(Ssymm_mode1 - Ssymm) ) *
7987  wNasymm1_saddle / wNsymm_saddle * 2.0;
7988 
7989  Yasymm2 = ( std::exp(Sasymm2 - Ssymm) - std::exp(Ssymm_mode2 - Ssymm) ) *
7990  wNasymm2_saddle / wNsymm_saddle * 2.0;
7991 
7992  Ysum = Ysymm + Yasymm1 + Yasymm2; /* normalize */
7993 
7994  if( Ysum > 0.00 ){
7995  Ysymm = Ysymm / Ysum;
7996  Yasymm1 = Yasymm1 / Ysum;
7997  Yasymm2 = Yasymm2 / Ysum;
7998  Yasymm = Yasymm1 + Yasymm2;
7999  }else{
8000  Ysymm = 0.0;
8001  Yasymm1 = 0.0;
8002  Yasymm2 = 0.0;
8003 // search minimum threshold and attribute all events to this mode */
8004  if( (epsilon_symm_saddle < epsilon_1_saddle) &&
8005  (epsilon_symm_saddle < epsilon_2_saddle) )
8006  Ysymm = 1.0;
8007  else
8008  if( epsilon_1_saddle < epsilon_2_saddle )
8009  Yasymm1 = 1.0;
8010  else
8011  Yasymm2 = 1.0;
8012  }
8013  // even-odd effect
8014  // Parametrization from Rejmund et al.
8015  if (mod(Z,2.0)== 0)
8016  r_e_o = std::pow(10.0,-0.0170 * (E_saddle_scission + Eld)*(E_saddle_scission + Eld));
8017  else
8018  r_e_o = 0.0;
8019 
8020 /* -------------------------------------------------------
8021 c selecting the fission mode using the yields at scission
8022 c -------------------------------------------------------
8023 c random decision: symmetric or asymmetric
8024 c IMODE = 1 means asymmetric fission, mode 1
8025 c IMODE = 2 means asymmetric fission, mode 2
8026 c IMODE = 3 means symmetric fission
8027 c testcase: 238U, E*= 6 MeV : 6467 8781 4752 (20000)
8028 c 127798 176480 95722 (400000)
8029 c 319919 440322 239759 (1000000)
8030 c E*=12 MeV : 153407 293063 553530 (1000000) */
8031 
8032  fiss321: // rmode = DBLE(HAZ(k))
8033  rmode = G4AblaRandom::flat();
8034  if( rmode < Yasymm1 )
8035  imode = 1;
8036  else
8037  if( (rmode > Yasymm1) && (rmode < Yasymm) )
8038  imode = 2;
8039  else
8040  imode = 3;
8041 
8042 // determine parameters of the neutron distribution of each mode
8043 // at scission
8044 
8045  if( imode == 1){
8046  N1mean = Nheavy1_eff;
8047  N1width = wNasymm1;
8048  }else{
8049  if( imode == 2 ){
8050  N1mean = Nheavy2_eff;
8051  N1width = wNasymm2;
8052  }else{
8053  //if( imode == 3 ) then
8054  N1mean = Nsymm;
8055  N1width = wNsymm;
8056  }
8057  }
8058 
8059 // N2mean needed by CZ below
8060  // N2mean = N - N1mean;
8061 
8062 // fission mode found, then the determination of the
8063 // neutron numbers N1 and N2 at scission by randon decision
8064  N1r = 1.0;
8065  N2r = 1.0;
8066  while( N1r < 5.0 || N2r < 5.0 ){
8067  // N1r = DBLE(GaussHaz(k,sngl(N1mean), sngl(N1width) ))
8068  // N1r = N1mean+G4AblaRandom::gaus(N1width);//
8069  N1r = gausshaz(0,N1mean,N1width);
8070  N2r = N - N1r;
8071  }
8072 
8073 // --------------------------------------------------
8074 // first approximation of fission fragments using UCD at saddle
8075 // --------------------------------------------------
8076  Z1UCD = Z/N * N1r;
8077  Z2UCD = Z/N * N2r;
8078  A1r = A/N * N1r;
8079 //
8080 // --------------------------
8081 // deformations: starting ...
8082 // -------------------------- */
8083  if( imode == 1 ){
8084 // --- N = 82 */
8085  E_scission_pre = max( epsilon_1_scission, 1.0 );
8086 // ! Eexc at scission, neutron evaporation from saddle to scission not considered */
8087  if( N1mean > N*0.50 ){
8088  beta1 = 0.0; /* 1. fragment is spherical */
8089  beta2 = 0.55; /* 2. fragment is deformed 0.5*/
8090  }else{
8091  beta1 = 0.55; /* 1. fragment is deformed 0.5*/
8092  beta2 = 0.00; /* 2. fragment is spherical */
8093  }
8094  }
8095  if( imode == 2 ){
8096 // --- N appr. 86 */
8097  E_scission_pre = max( epsilon_2_scission, 1.0 );
8098  if( N1mean > N*0.50 ){
8099  beta1 = (N1r - 92.0) * 0.030 + 0.60;
8100 
8101  beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
8102  beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
8103 
8104  beta1 = max(beta1,beta1gs);
8105  beta2 = 1.0 - beta1;
8106  beta2 = max(beta2,beta2gs);
8107  }else{
8108 
8109  beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
8110  beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
8111 
8112  beta2 = (N2r -92.0) * 0.030 + 0.60;
8113  beta2 = max(beta2,beta2gs);
8114  beta1 = 1.0 - beta2;
8115  beta1 = max(beta1,beta1gs);
8116  }
8117  }
8118  beta = 0.0;
8119  if( imode == 3 ){
8120 // if( imode >0 ){
8121 // --- Symmetric fission channel
8122 // the fit function for beta is the deformation for optimum energy
8123 // at the scission point, d = 2
8124 // beta : deformation of symmetric fragments
8125 // beta1 : deformation of first fragment
8126 // beta2 : deformation of second fragment
8127  betags = ecld->beta2[idint(Nsymm)][idint(Zsymm)];
8128  beta1gs = ecld->beta2[idint(N1r)][idint(Z1UCD)];
8129  beta2gs = ecld->beta2[idint(N2r)][idint(Z2UCD)];
8130  beta = max(0.177963+0.0153241*Zsymm-1.62037e-4*Zsymm*Zsymm,betags);
8131  beta1 = max(0.177963+0.0153241*Z1UCD-1.62037e-4*Z1UCD*Z1UCD,beta1gs);
8132  beta2 = max(0.177963+0.0153241*Z2UCD-1.62037e-4*Z2UCD*Z2UCD,beta2gs);
8133 
8134  E_asym = frldm( Z1UCD, N1r, beta1 ) +
8135  frldm( Z2UCD, N2r, beta2 ) +
8136  ecoul( Z1UCD, N1r, beta1, Z2UCD, N2r, beta2, 2.0 ) -
8137  2.0 * frldm( Zsymm, Nsymm, beta ) -
8138  ecoul( Zsymm, Nsymm, beta, Zsymm, Nsymm, beta, 2.0 );
8139  E_scission_pre = max( epsilon_symm_scission - E_asym, 1. );
8140  }
8141 // -----------------------
8142 // ... end of deformations
8143 // -----------------------
8144 
8145 // ------------------------------------------
8146 // evaporation from saddle to scission ...
8147 // ------------------------------------------
8148  if(E_scission_pre>5.){
8149  evap_postsaddle(A,Z,E_scission_pre,&E_scission_post,
8150  &A_scission,&Z_scission,vx_eva_sc,vy_eva_sc,vz_eva_sc);
8151  N_scission = A_scission - Z_scission;
8152  }else{
8153  A_scission = A;
8154  Z_scission = Z;
8155  E_scission_post = E_scission_pre;
8156  N_scission = A_scission - Z_scission;
8157  }
8158 // ---------------------------------------------------
8159 // second approximation of fission fragments using UCD
8160 // --------------------------------------------------- */
8161 //
8162  N1r = N1r * N_scission / N;
8163  N2r = N2r * N_scission / N;
8164  Z1UCD = Z1UCD * Z_scission / Z;
8165  Z2UCD = Z2UCD * Z_scission / Z;
8166  A1r = Z1UCD + N1r;
8167 
8168 // ---------------------------------------------------------
8169 // determination of the charge and mass of the fragments ...
8170 // ---------------------------------------------------------
8171 
8172 // - CZ is the curvature of charge distribution for fixed mass,
8173 // common to all modes, gives the width of the charge distribution.
8174 // The physics picture behind is that the division of the
8175 // fissioning nucleus in N and Z is slow when mass transport from
8176 // one nascent fragment to the other is concerned but fast when the
8177 // N/Z degree of freedom is concernded. In addition, the potential
8178 // minima in direction of mass transport are broad compared to the
8179 // potential minimum in N/Z direction.
8180 // The minima in direction of mass transport are calculated
8181 // by the liquid-drop (LD) potential (for superlong mode),
8182 // by LD + N=82 shell (for standard 1 mode) and
8183 // by LD + N=86 shell (for standard 2 mode).
8184 // Since the variation of N/Z is fast, it can quickly adjust to
8185 // the potential and is thus determined close to scission.
8186 // Thus, we calculate the mean N/Z and its width for fixed mass
8187 // at scission.
8188 // For the SL mode, the mean N/Z is calculated by the
8189 // minimum of the potential at scission as a function of N/Z for
8190 // fixed mass.
8191 // For the S1 and S2 modes, this correlation is imposed by the
8192 // empirical charge polarisation.
8193 // For the SL mode, the fluctuation in this width is calculated
8194 // from the curvature of the potential at scission as a function
8195 // of N/Z. This value is also used for the widths of S1 and S2.
8196 
8197 
8198 // Polarisation assumed for standard I and standard II:
8199 // Z - Zucd = cpol (for A = const);
8200 // from this we get (see remarks above)
8201 // Z - Zucd = Acn/Ncn * cpol (for N = const) */
8202 //
8203  CZ = ( frldm( Z1UCD-1.0, N1r+1.0, beta1 ) +
8204  frldm( Z2UCD+1.0, N2r-1.0, beta2 ) +
8205  frldm( Z1UCD+1.0, N1r-1.0, beta1 ) +
8206  frldm( Z2UCD-1.0, N2r+1.0, beta2 ) +
8207  ecoul( Z1UCD-1.0, N1r+1.0, beta1,
8208  Z2UCD+1.0, N2r-1.0, beta2, 2.0) +
8209  ecoul( Z1UCD+1.0, N1r-1.0, beta1,
8210  Z2UCD-1.0, N2r+1.0, beta2, 2.0) -
8211  2.0*ecoul( Z1UCD, N1r, beta1, Z2UCD, N2r, beta2, 2.0) -
8212  2.0*frldm( Z1UCD, N1r, beta1 ) -
8213  2.0*frldm( Z2UCD, N2r, beta2) ) * 0.50;
8214 //
8215  if(1.0/A_levdens*E_scission_post < 0.0)
8216  std::cout << "DSQRT 1 < 0" << A_levdens << " " << E_scission_post << std::endl;
8217 
8218  if(0.50 * std::sqrt(1.0/A_levdens*E_scission_post) / CZ < 0.0){
8219  std::cout << "DSQRT 2 < 0 " << CZ << std::endl;
8220  std::cout << "This event was not considered" << std::endl;
8221  goto fiss321;
8222  }
8223 
8224  ZA1width = std::sqrt(0.5*std::sqrt(1.0/A_levdens*E_scission_post)/CZ);
8225 
8226 // Minimum width in N/Z imposed.
8227 // Value of minimum width taken from 235U(nth,f) data
8228 // sigma_Z(A=const) = 0.4 to 0.5 (from Lang paper Nucl Phys. A345 (1980) 34)
8229 // sigma_N(Z=const) = 0.45 * A/Z (= 1.16 for 238U)
8230 // therefore: SIGZMIN = 1.16
8231 // Physics; variation in N/Z for fixed A assumed.
8232 // Thermal energy at scission is reduced by
8233 // pre-scission neutron evaporation"
8234 
8235  ZA1width = max(ZA1width,sigZmin);
8236 
8237  if(imode == 1 && cpol1 != 0.0){
8238 // --- asymmetric fission, mode 1 */
8239  G4int IS = 0;
8240  fiss2801:
8241  Z1rr = Z1UCD - cpol1 * A_scission/N_scission;
8242  // Z1r = DBLE(GaussHaz(k,sngl(Z1rr), sngl(ZA1width) ));
8243  // Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);//
8244  Z1r =gausshaz(0,Z1rr,ZA1width);
8245  IS = IS +1;
8246  if(IS>100){
8247  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED" << std::endl;
8248  Z1r = Z1rr;
8249  }
8250  if ((utilabs(Z1rr - Z1r) > 3.0*ZA1width) || Z1r<1.0)goto fiss2801;
8251  N1r = A1r - Z1r;
8252  }else{
8253  if( imode == 2 && cpol2 != 0.0 ){
8254 // --- asymmetric fission, mode 2 */
8255  G4int IS = 0;
8256  fiss2802:
8257  Z1rr = Z1UCD - cpol2 * A_scission/N_scission;
8258  //Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);//
8259  Z1r = gausshaz(0,Z1rr,ZA1width);
8260  IS = IS +1;
8261  if(IS>100){
8262  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED" << std::endl;
8263  Z1r = Z1rr;
8264  }
8265  if( (utilabs(Z1rr - Z1r) > 3.0*ZA1width) || Z1r < 1.0 ) goto fiss2802;
8266  N1r = A1r - Z1r;
8267  }else{
8268 // Otherwise do; /* Imode = 3 in any case; imode = 1 and 2 for CPOL = 0 */
8269 // and symmetric case */
8270 // We treat a simultaneous split in Z and N to determine
8271 // polarisation */
8272 
8273  re1 = frldm( Z1UCD-1.0, N1r+1.0, beta1 ) +
8274  frldm( Z2UCD+1.0, N2r-1.0, beta2 ) +
8275  ecoul( Z1UCD-1.0, N1r+1.0, beta1,
8276  Z2UCD+1.0, N2r-1.0, beta2, d ); /* d = 2 fm */
8277  re2 = frldm( Z1UCD, N1r, beta1) +
8278  frldm( Z2UCD, N2r, beta2 ) +
8279  ecoul( Z1UCD, N1r, beta1,
8280  Z2UCD, N2r, beta2, d ); /* d = 2 fm */
8281  re3 = frldm( Z1UCD+1.0, N1r-1.0, beta1 ) +
8282  frldm( Z2UCD-1.0, N2r+1.0, beta2 ) +
8283  ecoul( Z1UCD+1.0, N1r-1.0, beta1,
8284  Z2UCD-1.0, N2r+1.0, beta2, d ); /* d = 2 fm */
8285  eps2 = ( re1 - 2.0*re2 + re3 ) / 2.0;
8286  eps1 = ( re3 - re1 ) / 2.0;
8287  DN1_POL = -eps1 / ( 2.0 * eps2 );
8288 //
8289  Z1rr = Z1UCD + DN1_POL;
8290 
8291 // Polarization of Standard 1 from shell effects around 132Sn
8292  if ( imode == 1 ){
8293  if ( Z1rr > 50.0 ){
8294  DN1_POL = DN1_POL - 0.6 * Uwash(E_scission_post,Ecrit,FREDSHELL,gamma);
8295  Z1rr = Z1UCD + DN1_POL;
8296  if ( Z1rr < 50. ) Z1rr = 50.0;
8297  }else{
8298  DN1_POL = DN1_POL + 0.60 * Uwash(E_scission_post,Ecrit,FREDSHELL,gamma);
8299  Z1rr = Z1UCD + DN1_POL;
8300  if ( Z1rr > 50.0 ) Z1rr = 50.0;
8301  }
8302  }
8303 
8304  G4int IS = 0;
8305  fiss2803:
8306  //Z1r = Z1rr+G4AblaRandom::gaus(ZA1width);
8307  Z1r = gausshaz(0,Z1rr,ZA1width);
8308  IS = IS +1;
8309  if(IS>100){
8310  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING Z1R IN PROFI.FOR. A VALUE WILL BE FORCED" << std::endl;
8311  Z1r = Z1rr;
8312  }
8313 
8314  if( (utilabs(Z1rr - Z1r) > 3.0*ZA1width) || (Z1r < 1.0) )goto fiss2803;
8315  N1r = A1r - Z1r;
8316 
8317  }
8318  }
8319 
8320 // ------------------------------------------
8321 // Integer proton number with even-odd effect
8322 // ------------------------------------------
8323  even_odd(Z1r, r_e_o, i_help);
8324 
8325  z1 = G4double(i_help);
8326  z2 = dint( Z_scission ) - z1;
8327  N1 = dint( N1r );
8328  N2 = dint( N_scission ) - N1;
8329  a1 = z1 + N1;
8330  a2 = z2 + N2;
8331 
8332  if( (z1 < 0) || (z2 < 0) || (a1 < 0) || (a2 < 0) ){
8333  std::cout << " -------------------------------" << std::endl;
8334  std::cout << " Z, A, N : " << Z << " " << A << " " << N << std::endl;
8335  std::cout << z1 << " " << z2 << " " << a1 << " " << a2 << std::endl;
8336  std::cout << E_scission_post << " " << A_levdens << " " << CZ << std::endl;
8337 
8338  std::cout << " -------------------------------" << std::endl;
8339  }
8340 
8341 // -----------------------
8342 // excitation energies ...
8343 // -----------------------
8344 //
8345  if( imode == 1 ){
8346 // ---- N = 82
8347  if( N1mean > N*0.50 ){
8348 // (a) 1. fragment is spherical and 2. fragment is deformed */
8349  E_defo = 0.0;
8350  beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8351  if(beta2< beta2gs) beta2 = beta2gs;
8352  E1exc = E_scission_pre * a1 / A + E_defo;
8353  E_defo = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8354  E2exc = E_scission_pre * a2 / A + E_defo;
8355  }else{
8356 // (b) 1. fragment is deformed and 2. fragment is spherical */
8357  beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8358  if(beta1< beta1gs) beta1 = beta1gs;
8359  E_defo = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8360  E1exc = E_scission_pre * a1 / A + E_defo;
8361  E_defo = 0.0;
8362  E2exc = E_scission_pre * a2 / A + E_defo;
8363  }
8364  }
8365 
8366 
8367  if( imode == 2 ){
8368 // --- N appr. 86 */
8369  if( N1mean > N*0.5 ){
8370  /* 2. fragment is spherical */
8371  beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8372  if(beta1< beta1gs) beta1 = beta1gs;
8373  E_defo = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8374  E1exc = E_scission_pre * a1 / A + E_defo;
8375  beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8376  if(beta2< beta2gs) beta2 = beta2gs;
8377  E_defo = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8378  E2exc = E_scission_pre * a2 / A + E_defo;
8379  }else{
8380  /* 1. fragment is spherical */
8381  beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8382  if(beta2< beta2gs) beta2 = beta2gs;
8383  E_defo = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8384  E2exc = E_scission_pre * a2 / A + E_defo;
8385  beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8386  if(beta1< beta1gs) beta1 = beta1gs;
8387  E_defo = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8388  E1exc = E_scission_pre * a1 / A + E_defo;
8389  }
8390  }
8391 
8392  if( imode == 3 ){
8393 // --- Symmetric fission channel
8394  beta1gs = ecld->beta2[idint(N1)][idint(z1)];
8395  if(beta1< beta1gs) beta1 = beta1gs;
8396  beta2gs = ecld->beta2[idint(N2)][idint(z2)];
8397  if(beta2< beta2gs) beta2 = beta2gs;
8398  E_defo1 = frldm( z1, N1, beta1 ) - frldm( z1, N1, beta1gs );
8399  E_defo2 = frldm( z2, N2, beta2 ) - frldm( z2, N2, beta2gs );
8400  E1exc = E_scission_pre * a1 / A + E_defo1;
8401  E2exc = E_scission_pre * a2 / A + E_defo2;
8402  }
8403 
8404 
8405 // pre-neutron-emission total kinetic energy */
8406  TKER = ( z1 * z2 * 1.440 ) /
8407  ( R0 * std::pow(a1,0.333330) * (1.0 + 2.0/3.0 * beta1 ) +
8408  R0 * std::pow(a2,0.333330) * (1.0 + 2.0/3.0 * beta2 ) + 2.0 );
8409 // Pre-neutron-emission kinetic energies of the fragments */
8410  EkinR1 = TKER * a2 / A;
8411  EkinR2 = TKER * a1 / A;
8412  v1 = std::sqrt(EkinR1/a1) * 1.3887;
8413  v2 = std::sqrt(EkinR2/a2) * 1.3887;
8414 
8415 // Extracted from Lang et al. Nucl. Phys. A 345 (1980) 34 */
8416  E1exc_sigma = 5.50;
8417  E2exc_sigma = 5.50;
8418 
8419  fis987:
8420  //e1 = E1exc+G4AblaRandom::gaus(E1exc_sigma);//
8421  e1 = gausshaz(0,E1exc,E1exc_sigma);
8422  if(e1<0.)goto fis987;
8423  fis988:
8424  //e2 = E2exc+G4AblaRandom::gaus(E2exc_sigma);//
8425  e2 = gausshaz(0,E2exc,E2exc_sigma);
8426  if(e2<0.)goto fis988;
8427 
8428  return;
8429 }
8430 
8431 
8432 void G4Abla::even_odd(G4double r_origin,G4double r_even_odd,G4int &i_out)
8433 {
8434  // Procedure to calculate I_OUT from R_IN in a way that
8435  // on the average a flat distribution in R_IN results in a
8436  // fluctuating distribution in I_OUT with an even-odd effect as
8437  // given by R_EVEN_ODD
8438 
8439  // /* ------------------------------------------------------------ */
8440  // /* EXAMPLES : */
8441  // /* ------------------------------------------------------------ */
8442  // /* If R_EVEN_ODD = 0 : */
8443  // /* CEIL(R_IN) ---- */
8444  // /* */
8445  // /* R_IN -> */
8446  // /* (somewhere in between CEIL(R_IN) and FLOOR(R_IN)) */ */
8447  // /* */
8448  // /* FLOOR(R_IN) ---- --> I_OUT */
8449  // /* ------------------------------------------------------------ */
8450  // /* If R_EVEN_ODD > 0 : */
8451  // /* The interval for the above treatment is */
8452  // /* larger for FLOOR(R_IN) = even and */
8453  // /* smaller for FLOOR(R_IN) = odd */
8454  // /* For R_EVEN_ODD < 0 : just opposite treatment */
8455  // /* ------------------------------------------------------------ */
8456 
8457  // /* ------------------------------------------------------------ */
8458  // /* On input: R_ORIGIN nuclear charge (real number) */
8459  // /* R_EVEN_ODD requested even-odd effect */
8460  // /* Intermediate quantity: R_IN = R_ORIGIN + 0.5 */
8461  // /* On output: I_OUT nuclear charge (integer) */
8462  // /* ------------------------------------------------------------ */
8463 
8464  // G4double R_ORIGIN,R_IN,R_EVEN_ODD,R_REST,R_HELP;
8465  G4double r_in = 0.0, r_rest = 0.0, r_help = 0.0;
8466  G4double r_floor = 0.0;
8467  G4double r_middle = 0.0;
8468  // G4int I_OUT,N_FLOOR;
8469  G4int n_floor = 0;
8470 
8471  r_in = r_origin + 0.5;
8472  r_floor = (G4double)((G4int)(r_in));
8473  if (r_even_odd < 0.001) {
8474  i_out = (G4int)(r_floor);
8475  }
8476  else {
8477  r_rest = r_in - r_floor;
8478  r_middle = r_floor + 0.5;
8479  n_floor = (G4int)(r_floor);
8480  if (n_floor%2 == 0) {
8481  // even before modif.
8482  r_help = r_middle + (r_rest - 0.5) * (1.0 - r_even_odd);
8483  }
8484  else {
8485  // odd before modification
8486  r_help = r_middle + (r_rest - 0.5) * (1.0 + r_even_odd);
8487  }
8488  i_out = (G4int)(r_help);
8489  }
8490 }
8491 
8493 {
8494  // liquid-drop mass, Myers & Swiatecki, Lysekil, 1967
8495  // pure liquid drop, without pairing and shell effects
8496 
8497  // On input: Z nuclear charge of nucleus
8498  // N number of neutrons in nucleus
8499  // beta deformation of nucleus
8500  // On output: binding energy of nucleus
8501 
8502  G4double a = 0.0, fumass = 0.0;
8503  G4double alpha = 0.0;
8504  G4double xcom = 0.0, xvs = 0.0, xe = 0.0;
8505  const G4double pi = 3.1416;
8506 
8507  a = n + z;
8508  alpha = ( std::sqrt(5.0/(4.0*pi)) ) * beta;
8509 
8510  xcom = 1.0 - 1.7826 * ((a - 2.0*z)/a)*((a - 2.0*z)/a);
8511  // factor for asymmetry dependence of surface and volume term
8512  xvs = - xcom * ( 15.4941 * a -
8513  17.9439 * std::pow(a,2.0/3.0) * (1.0+0.4*alpha*alpha) );
8514  // sum of volume and surface energy
8515  xe = z*z * (0.7053/(std::pow(a,1.0/3.0)) * (1.0-0.2*alpha*alpha) - 1.1529/a);
8516  fumass = xvs + xe;
8517 
8518  return fumass;
8519 }
8520 
8521 
8523 {
8524  // Coulomb potential between two nuclei
8525  // surfaces are in a distance of d
8526  // in a tip to tip configuration
8527 
8528  // approximate formulation
8529  // On input: Z1 nuclear charge of first nucleus
8530  // N1 number of neutrons in first nucleus
8531  // beta1 deformation of first nucleus
8532  // Z2 nuclear charge of second nucleus
8533  // N2 number of neutrons in second nucleus
8534  // beta2 deformation of second nucleus
8535  // d distance of surfaces of the nuclei
8536 
8537  // G4double Z1,N1,beta1,Z2,N2,beta2,d,ecoul;
8538  G4double fecoul = 0;
8539  G4double dtot = 0;
8540  const G4double r0 = 1.16;
8541 
8542  dtot = r0 * ( std::pow((z1+n1),1.0/3.0) * (1.0+0.6666667*beta1)
8543  + std::pow((z2+n2),1.0/3.0) * (1.0+0.6666667*beta2) ) + d;
8544  fecoul = z1 * z2 * 1.44 / dtot;
8545 
8546  return fecoul;
8547 }
8548 
8549 
8551  // E excitation energy
8552  // Ecrit critical pairing energy
8553  // Freduction reduction factor for shell washing in superfluid region
8554  G4double R_wash,uwash;
8555  if(E < Ecrit)
8556  R_wash = std::exp(-E * Freduction * gamma);
8557  else
8558  R_wash = std::exp(- Ecrit * Freduction * gamma -(E-Ecrit) * gamma);
8559 
8560  uwash = R_wash;
8561  return uwash;
8562 }
8563 
8564 
8566 
8567 // Liquid-drop mass, Myers & Swiatecki, Lysekil, 1967
8568 // pure liquid drop, without pairing and shell effects
8569 //
8570 // On input: Z nuclear charge of nucleus
8571 // N number of neutrons in nucleus
8572 // beta deformation of nucleus
8573 // On output: binding energy of nucleus
8574 // The idea is to use FRLDM model for beta=0 and using Lysekil
8575 // model to get the deformation energy
8576 
8577  G4double a;
8578  a = n + z;
8579  return eflmac_profi(a,z) + umass(z,n,beta) - umass(z,n,0.0);
8580 }
8581 
8582 
8583 //**********************************************************************
8584 // *
8585 // * this function will calculate the liquid-drop nuclear mass for spheri
8586 // * configuration according to the preprint NUCLEAR GROUND-STATE
8587 // * MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
8588 // * All constants are taken from this publication for consistency.
8589 // *
8590 // * Parameters:
8591 // * a: nuclear mass number
8592 // * z: nuclear charge
8593 // **********************************************************************
8594 
8595 
8597 {
8598  // CHANGED TO CALCULATE TOTAL BINDING ENERGY INSTEAD OF MASS EXCESS.
8599  // SWITCH FOR PAIRING INCLUDED AS WELL.
8600  // BINDING = EFLMAC(IA,IZ,0,OPTSHP)
8601  // FORTRAN TRANSCRIPT OF /U/GREWE/LANG/EEX/FRLDM.C
8602  // A.J. 15.07.96
8603 
8604  // this function will calculate the liquid-drop nuclear mass for spheri
8605  // configuration according to the preprint NUCLEAR GROUND-STATE
8606  // MASSES and DEFORMATIONS by P. M"oller et al. from August 16, 1993 p.
8607  // All constants are taken from this publication for consistency.
8608 
8609  // Parameters:
8610  // a: nuclear mass number
8611  // z: nuclear charge
8612 
8613  G4double eflmacResult = 0.0;
8614 
8615  G4int in = 0;
8616  G4double z = 0.0, n = 0.0, a = 0.0, av = 0.0, as = 0.0;
8617  G4double a0 = 0.0, c1 = 0.0, c4 = 0.0, b1 = 0.0, b3 = 0.0;
8618  G4double ff = 0.0, ca = 0.0, w = 0.0, efl = 0.0;
8619  G4double r0 = 0.0, kf = 0.0, ks = 0.0;
8620  G4double kv = 0.0, rp = 0.0, ay = 0.0, aden = 0.0, x0 = 0.0, y0 = 0.0;
8621  G4double esq = 0.0, ael = 0.0, i = 0.0;
8622  G4double pi = 3.141592653589793238e0;
8623 
8624  // fundamental constants
8625  // electronic charge squared
8626  esq = 1.4399764;
8627 
8628  // constants from considerations other than nucl. masses
8629  // electronic binding
8630  ael = 1.433e-5;
8631 
8632  // proton rms radius
8633  rp = 0.8;
8634 
8635  // nuclear radius constant
8636  r0 = 1.16;
8637 
8638  // range of yukawa-plus-expon. potential
8639  ay = 0.68;
8640 
8641  // range of yukawa function used to generate
8642  // nuclear charge distribution
8643  aden= 0.70;
8644 
8645  // wigner constant
8646  w = 30.0;
8647 
8648  // adjusted parameters
8649  // volume energy
8650  av = 16.00126;
8651 
8652  // volume asymmetry
8653  kv = 1.92240;
8654 
8655  // surface energy
8656  as = 21.18466;
8657 
8658  // surface asymmetry
8659  ks = 2.345;
8660  // a^0 constant
8661  a0 = 2.615;
8662 
8663  // charge asymmetry
8664  ca = 0.10289;
8665 
8666  z = G4double(iz);
8667  a = G4double(ia);
8668  in = ia - iz;
8669  n = G4double(in);
8670 
8671 
8672  c1 = 3.0/5.0*esq/r0;
8673  c4 = 5.0/4.0*std::pow((3.0/(2.0*pi)),(2.0/3.0)) * c1;
8674  kf = std::pow((9.0*pi*z/(4.0*a)),(1.0/3.0))/r0;
8675 
8676  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));
8677 
8678  i = (n-z)/a;
8679 
8680  x0 = r0 * std::pow(a,(1.0/3.0)) / ay;
8681  y0 = r0 * std::pow(a,(1.0/3.0)) / aden;
8682 
8683  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);
8684 
8685  b3 = 1.0 - 5.0/std::pow(y0,2) * (1.0 - 15.0/(8.0*y0) + 21.0/(8.0 * std::pow(y0,3))
8686  - 3.0/4.0 * (1.0 + 9.0/(2.0*y0) + 7.0/std::pow(y0,2)
8687  + 7.0/(2.0 * std::pow(y0,3))) * std::exp(-2.0*y0));
8688 
8689  // now calulation of total binding energy
8690 
8691  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
8692  + 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))
8693  + ff*std::pow(z,2)/a -ca*(n-z) - ael * std::pow(z,(2.39e0));
8694 
8695  efl = efl + w*utilabs(i);
8696 
8697  eflmacResult = efl;
8698 
8699  return eflmacResult;
8700 }
8701 //
8702 //
8703 //
8704 void G4Abla::unstable_nuclei(G4int AFP,G4int ZFP,G4int *AFPNEW,G4int *ZFPNEW,G4int &IOUNSTABLE,G4double VX,G4double VY,G4double VZ,G4double *VP1X,G4double *VP1Y,G4double *VP1Z,G4double BU_TAB_TEMP[200][5],G4int *ILOOP){
8705 //
8706  G4int INMIN,INMAX,NDIF=0,IMEM;
8707  G4int NEVA=0,PEVA=0;
8708  G4double VP2X,VP2Y,VP2Z;
8709 
8710  *AFPNEW = AFP;
8711  *ZFPNEW = ZFP;
8712  IOUNSTABLE = 0;
8713  *ILOOP = 0;
8714  IMEM = 0;
8715  for(G4int i=0;i<200;i++){
8716  BU_TAB_TEMP[i][0] = 0.0;
8717  BU_TAB_TEMP[i][1] = 0.0;
8718  BU_TAB_TEMP[i][2] = 0.0;
8719  BU_TAB_TEMP[i][3] = 0.0;
8720  BU_TAB_TEMP[i][4] = 0.0;
8721  }
8722  *VP1X = 0.0;
8723  *VP1Y = 0.0;
8724  *VP1Z = 0.0;
8725 
8726  if(AFP==0 && ZFP==0){
8727 // PRINT*,'UNSTABLE NUCLEI, AFP=0, ZFP=0'
8728  return;
8729  }
8730  if((AFP==1 && ZFP==0) ||
8731  (AFP==1 && ZFP==1) ||
8732  (AFP==2 && ZFP==1) ||
8733  (AFP==3 && ZFP==1) ||
8734  (AFP==3 && ZFP==2) ||
8735  (AFP==4 && ZFP==2) ||
8736  (AFP==6 && ZFP==2) ||
8737  (AFP==8 && ZFP==2)
8738  ){
8739  *VP1X = VX;
8740  *VP1Y = VY;
8741  *VP1Z = VZ;
8742  return;
8743  }
8744 
8745  if ((AFP-ZFP)==0 && ZFP>1){
8746  for(G4int I = 0;I<=AFP-2;I++){
8747  unstable_tke(double(AFP-I),double(AFP-I),double(AFP-I-1),double(AFP-I-1),VX,VY,VZ,
8748  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8749  BU_TAB_TEMP[*ILOOP][0] = 1.0;
8750  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8751  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8752  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8753  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8754  *ILOOP = *ILOOP + 1;
8755  VX = *VP1X;
8756  VY = *VP1Y;
8757  VZ = *VP1Z;
8758  }
8759  PEVA = PEVA + ZFP - 1;
8760  AFP = 1;
8761  ZFP = 1;
8762  IOUNSTABLE = 1;
8763  }
8764 //
8765 //*** Find the limits nucleus is bound :
8766  isostab_lim(ZFP,&INMIN,&INMAX);
8767  NDIF = AFP - ZFP;
8768  if(NDIF<INMIN){
8769 // Proton unbound
8770  IOUNSTABLE = 1;
8771  for(G4int I = 1;I<=10; I++){
8772  isostab_lim(ZFP-I,&INMIN,&INMAX);
8773  if(INMIN<=NDIF){
8774  IMEM = I;
8775  ZFP = ZFP - I;
8776  AFP = ZFP + NDIF;
8777  PEVA = I;
8778  goto u10;
8779  }
8780  }
8781 //
8782  u10:
8783  for(G4int I = 0;I< IMEM;I++){
8784  unstable_tke(G4double(NDIF+ZFP+IMEM-I),
8785  G4double(ZFP+IMEM-I),
8786  G4double(NDIF+ZFP+IMEM-I-1),
8787  G4double(ZFP+IMEM-I-1),
8788  VX,VY,VZ,
8789  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8790  BU_TAB_TEMP[I+1+*ILOOP][0] = 1.0;
8791  BU_TAB_TEMP[I+1+*ILOOP][1] = 1.0;
8792  BU_TAB_TEMP[I+1+*ILOOP][2] = VP2X;
8793  BU_TAB_TEMP[I+1+*ILOOP][3] = VP2Y;
8794  BU_TAB_TEMP[I+1+*ILOOP][4] = VP2Z;
8795  VX = *VP1X;
8796  VY = *VP1Y;
8797  VZ = *VP1Z;
8798  }
8799  *ILOOP = *ILOOP + IMEM;
8800 
8801  }
8802  if(NDIF>INMAX){
8803 // Neutron unbound
8804  NEVA = NDIF - INMAX;
8805  AFP = ZFP + INMAX;
8806  IOUNSTABLE = 1;
8807  for(G4int I = 0;I<NEVA;I++){
8808  unstable_tke(G4double(ZFP+NDIF-I),
8809  G4double(ZFP),
8810  G4double(ZFP+NDIF-I-1),
8811  G4double(ZFP),
8812  VX,VY,VZ,
8813  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8814 
8815  BU_TAB_TEMP[*ILOOP][0] = 0.0;
8816  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8817  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8818  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8819  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8820  *ILOOP = *ILOOP + 1;
8821  VX = *VP1X;
8822  VY = *VP1Y;
8823  VZ = *VP1Z;
8824  }
8825  }
8826 
8827  if ((AFP>=2) && (ZFP==0)){
8828  for(G4int I = 0;I<= AFP-2;I++){
8829  unstable_tke(G4double(AFP-I),G4double(ZFP),
8830  G4double(AFP-I-1),G4double(ZFP),
8831  VX,VY,VZ,
8832  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8833 
8834  BU_TAB_TEMP[*ILOOP][0] = 0.0;
8835  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8836  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8837  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8838  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8839  *ILOOP = *ILOOP + 1;
8840  VX = *VP1X;
8841  VY = *VP1Y;
8842  VZ = *VP1Z;
8843  }
8844 
8845  NEVA = NEVA + (AFP - 1);
8846  AFP = 1;
8847  ZFP = 0;
8848  IOUNSTABLE = 1;
8849  }
8850  if (AFP<ZFP){
8851  std::cout << "WARNING - BU UNSTABLE: AF < ZF" << std::endl;
8852  AFP = 0;
8853  ZFP = 0;
8854  IOUNSTABLE = 1;
8855  }
8856  if ((AFP>=4) && (ZFP==1)){
8857 // Heavy residue is treated as 3H and the rest of mass is emitted as neutrons:
8858  for(G4int I = 0; I<AFP-3;I++){
8859  unstable_tke(double(AFP-I),double(ZFP),
8860  double(AFP-I-1),double(ZFP),
8861  VX,VY,VZ,
8862  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8863 
8864  BU_TAB_TEMP[*ILOOP][0] = 0.0;
8865  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8866  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8867  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8868  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8869  *ILOOP = *ILOOP + 1;
8870  VX = *VP1X;
8871  VY = *VP1Y;
8872  VZ = *VP1Z;
8873  }
8874 
8875  NEVA = NEVA + (AFP - 3);
8876  AFP = 3;
8877  ZFP = 1;
8878  IOUNSTABLE = 1;
8879  }
8880 
8881  if ((AFP==4) && (ZFP==3)){
8882 // 4Li -> 3He + p ->
8883  AFP = 3;
8884  ZFP = 2;
8885  PEVA = PEVA + 1;
8886  IOUNSTABLE = 1;
8887  unstable_tke(4.0,3.0,3.0,2.0,
8888  VX,VY,VZ,
8889  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8890 
8891  BU_TAB_TEMP[*ILOOP][0] = 1.0;
8892  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8893  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8894  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8895  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8896  *ILOOP = *ILOOP + 1;
8897  }
8898  if ((AFP==5) && (ZFP==2)){
8899 // 5He -> 4He + n ->
8900  AFP = 4;
8901  ZFP = 2;
8902  NEVA = NEVA + 1;
8903  IOUNSTABLE = 1;
8904  unstable_tke(5.0,2.0,4.0,2.0,
8905  VX,VY,VZ,
8906  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8907  BU_TAB_TEMP[*ILOOP][0] = 0.0;
8908  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8909  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8910  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8911  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8912  *ILOOP = *ILOOP + 1;
8913  }
8914 
8915  if ((AFP==5) && (ZFP==3)){
8916 // 5Li -> 4He + p
8917  AFP = 4;
8918  ZFP = 2;
8919  PEVA = PEVA + 1;
8920  IOUNSTABLE = 1;
8921  unstable_tke(5.0,3.0,4.0,2.0,
8922  VX,VY,VZ,
8923  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8924  BU_TAB_TEMP[*ILOOP][0] = 1.0;
8925  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8926  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8927  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8928  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8929  *ILOOP = *ILOOP + 1;
8930  }
8931 
8932  if ((AFP==6) && (ZFP==4)){
8933 // 6Be -> 4He + 2p (velocity in two steps: 6Be->5Li->4He)
8934  AFP = 4;
8935  ZFP = 2;
8936  PEVA = PEVA + 2;
8937  IOUNSTABLE = 1;
8938 // 6Be -> 5Li + p
8939  unstable_tke(6.0,4.0,5.0,3.0,
8940  VX,VY,VZ,
8941  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8942  BU_TAB_TEMP[*ILOOP][0] = 1.0;
8943  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8944  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8945  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8946  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8947  *ILOOP = *ILOOP + 1;
8948  VX = *VP1X;
8949  VY = *VP1Y;
8950  VZ = *VP1Z;
8951 
8952 // 5Li -> 4He + p
8953  unstable_tke(5.0,3.0,4.0,2.0,
8954  VX,VY,VZ,
8955  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8956  BU_TAB_TEMP[*ILOOP][0] = 1.0;
8957  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8958  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8959  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8960  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8961  *ILOOP = *ILOOP + 1;
8962  }
8963  if ((AFP==7)&&(ZFP==2)){
8964 // 7He -> 6He + n
8965  AFP = 6;
8966  ZFP = 2;
8967  NEVA = NEVA + 1;
8968  IOUNSTABLE = 1;
8969  unstable_tke(7.0,2.0,6.0,2.0,
8970  VX,VY,VZ,
8971  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8972  BU_TAB_TEMP[*ILOOP][0] = 0.0;
8973  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8974  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8975  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8976  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8977  *ILOOP = *ILOOP + 1;
8978  }
8979 
8980  if ((AFP==7) && (ZFP==5)){
8981 // 7B -> 6Be + p -> 4He + 3p
8982  for(G4int I = 0; I<= AFP-5;I++){
8983  unstable_tke(double(AFP-I),double(ZFP-I),
8984  double(AFP-I-1),double(ZFP-I-1),
8985  VX,VY,VZ,
8986  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
8987  BU_TAB_TEMP[*ILOOP][0] = 1.0;
8988  BU_TAB_TEMP[*ILOOP][1] = 1.0;
8989  BU_TAB_TEMP[*ILOOP][2] = VP2X;
8990  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
8991  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
8992  *ILOOP = *ILOOP + 1;
8993  VX = *VP1X;
8994  VY = *VP1Y;
8995  VZ = *VP1Z;
8996  }
8997 
8998  AFP = 4;
8999  ZFP = 2;
9000  PEVA = PEVA + 3;
9001  IOUNSTABLE = 1;
9002  }
9003  if ((AFP==8) && (ZFP==4)){
9004 // 8Be -> 4He + 4He
9005  AFP = 4;
9006  ZFP = 2;
9007  IOUNSTABLE = 1;
9008  unstable_tke(8.0,4.0,4.0,2.0,
9009  VX,VY,VZ,
9010  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9011  BU_TAB_TEMP[*ILOOP][0] = 2.0;
9012  BU_TAB_TEMP[*ILOOP][1] = 4.0;
9013  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9014  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9015  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9016  *ILOOP = *ILOOP + 1;
9017  }
9018  if ((AFP==8) && (ZFP==6)){
9019 // 8C -> 2p + 6Be
9020  AFP = 6;
9021  ZFP = 4;
9022  PEVA = PEVA + 2;
9023  IOUNSTABLE = 1;
9024 
9025  unstable_tke(8.0,6.0,7.0,5.0,
9026  VX,VY,VZ,
9027  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9028  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9029  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9030  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9031  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9032  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9033  *ILOOP = *ILOOP + 1;
9034  VX = *VP1X;
9035  VY = *VP1Y;
9036  VZ = *VP1Z;
9037 
9038  unstable_tke(7.0,5.0,6.0,4.0,
9039  VX,VY,VZ,
9040  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9041  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9042  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9043  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9044  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9045  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9046  *ILOOP = *ILOOP + 1;
9047  VX = *VP1X;
9048  VY = *VP1Y;
9049  VZ = *VP1Z;
9050  }
9051 
9052  if((AFP==9) && (ZFP==2)){
9053 // 9He -> 8He + n
9054  AFP = 8;
9055  ZFP = 2;
9056  NEVA = NEVA + 1;
9057  IOUNSTABLE = 1;
9058 
9059  unstable_tke(9.0,2.0,8.0,2.0,
9060  VX,VY,VZ,
9061  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9062  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9063  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9064  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9065  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9066  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9067  *ILOOP = *ILOOP + 1;
9068  VX = *VP1X;
9069  VY = *VP1Y;
9070  VZ = *VP1Z;
9071  }
9072 
9073  if((AFP==9) && (ZFP==5)){
9074 // 9B -> 4He + 4He + p ->
9075  AFP = 4;
9076  ZFP = 2;
9077  PEVA = PEVA + 1;
9078  IOUNSTABLE = 1;
9079  unstable_tke(9.0,5.0,8.0,4.0,
9080  VX,VY,VZ,
9081  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9082  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9083  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9084  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9085  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9086  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9087  *ILOOP = *ILOOP + 1;
9088  VX = *VP1X;
9089  VY = *VP1Y;
9090  VZ = *VP1Z;
9091 
9092  unstable_tke(8.0,4.0,4.0,2.0,
9093  VX,VY,VZ,
9094  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9095  BU_TAB_TEMP[*ILOOP][0] = 2.0;
9096  BU_TAB_TEMP[*ILOOP][1] = 4.0;
9097  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9098  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9099  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9100  *ILOOP = *ILOOP + 1;
9101  VX = *VP1X;
9102  VY = *VP1Y;
9103  VZ = *VP1Z;
9104  }
9105 
9106  if((AFP==10) && (ZFP==2)){
9107 // 10He -> 8He + 2n
9108  AFP = 8;
9109  ZFP = 2;
9110  NEVA = NEVA + 2;
9111  IOUNSTABLE = 1;
9112 // 10He -> 9He + n
9113  unstable_tke(10.0,2.0,9.0,2.0,
9114  VX,VY,VZ,
9115  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9116  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9117  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9118  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9119  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9120  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9121  *ILOOP = *ILOOP + 1;
9122  VX = *VP1X;
9123  VY = *VP1Y;
9124  VZ = *VP1Z;
9125 
9126 // 9He -> 8He + n
9127  unstable_tke(9.0,2.0,8.0,2.0,
9128  VX,VY,VZ,
9129  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9130  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9131  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9132  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9133  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9134  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9135  *ILOOP = *ILOOP + 1;
9136  VX = *VP1X;
9137  VY = *VP1Y;
9138  VZ = *VP1Z;
9139  }
9140  if ((AFP==10) && (ZFP==3)){
9141 // 10Li -> 9Li + n ->
9142  AFP = 9;
9143  ZFP = 3;
9144  NEVA = NEVA + 1;
9145  IOUNSTABLE = 1;
9146  unstable_tke(10.0,3.0,9.0,3.0,
9147  VX,VY,VZ,
9148  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9149  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9150  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9151  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9152  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9153  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9154  *ILOOP = *ILOOP + 1;
9155  VX = *VP1X;
9156  VY = *VP1Y;
9157  VZ = *VP1Z;
9158  }
9159  if ((AFP==10) && (ZFP==7)){
9160 // 10N -> 9C + p ->
9161  AFP = 9;
9162  ZFP = 6;
9163  PEVA = PEVA + 1;
9164  IOUNSTABLE = 1;
9165  unstable_tke(10.0,7.0,9.0,6.0,
9166  VX,VY,VZ,
9167  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9168  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9169  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9170  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9171  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9172  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9173  *ILOOP = *ILOOP + 1;
9174  VX = *VP1X;
9175  VY = *VP1Y;
9176  VZ = *VP1Z;
9177  }
9178 
9179  if((AFP==11) && (ZFP==7)){
9180 // 11N -> 10C + p ->
9181  AFP = 10;
9182  ZFP = 6;
9183  PEVA = PEVA + 1;
9184  IOUNSTABLE = 1;
9185  unstable_tke(11.0,7.0,10.0,6.0,
9186  VX,VY,VZ,
9187  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9188  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9189  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9190  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9191  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9192  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9193  *ILOOP = *ILOOP + 1;
9194  VX = *VP1X;
9195  VY = *VP1Y;
9196  VZ = *VP1Z;
9197  }
9198  if ((AFP==12) && (ZFP==8)){
9199 // 12O -> 10C + 2p ->
9200  AFP = 10;
9201  ZFP = 6;
9202  PEVA = PEVA + 2;
9203  IOUNSTABLE = 1;
9204 
9205  unstable_tke(12.0,8.0,11.0,7.0,
9206  VX,VY,VZ,
9207  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9208  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9209  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9210  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9211  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9212  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9213  *ILOOP = *ILOOP + 1;
9214  VX = *VP1X;
9215  VY = *VP1Y;
9216  VZ = *VP1Z;
9217 
9218  unstable_tke(11.0,7.0,10.0,6.0,
9219  VX,VY,VZ,
9220  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9221  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9222  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9223  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9224  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9225  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9226  *ILOOP = *ILOOP + 1;
9227  VX = *VP1X;
9228  VY = *VP1Y;
9229  VZ = *VP1Z;
9230  }
9231  if ((AFP==15) && (ZFP==9)){
9232 // 15F -> 14O + p ->
9233  AFP = 14;
9234  ZFP = 8;
9235  PEVA = PEVA + 1;
9236  IOUNSTABLE = 1;
9237  unstable_tke(15.0,9.0,14.0,8.0,
9238  VX,VY,VZ,
9239  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9240  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9241  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9242  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9243  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9244  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9245  *ILOOP = *ILOOP + 1;
9246  VX = *VP1X;
9247  VY = *VP1Y;
9248  VZ = *VP1Z;
9249  }
9250 
9251  if ((AFP==16) && (ZFP==9)){
9252 // 16F -> 15O + p ->
9253  AFP = 15;
9254  ZFP = 8;
9255  PEVA = PEVA + 1;
9256  IOUNSTABLE = 1;
9257  unstable_tke(16.0,9.0,15.0,8.0,
9258  VX,VY,VZ,
9259  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9260  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9261  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9262  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9263  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9264  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9265  *ILOOP = *ILOOP + 1;
9266  VX = *VP1X;
9267  VY = *VP1Y;
9268  VZ = *VP1Z;
9269  }
9270 
9271  if ((AFP==16) && (ZFP==10)){
9272 // 16Ne -> 14O + 2p ->
9273  AFP = 14;
9274  ZFP = 8;
9275  PEVA = PEVA + 2;
9276  IOUNSTABLE = 1;
9277  unstable_tke(16.0,10.0,15.0,9.0,
9278  VX,VY,VZ,
9279  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9280  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9281  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9282  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9283  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9284  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9285  *ILOOP = *ILOOP + 1;
9286  VX = *VP1X;
9287  VY = *VP1Y;
9288  VZ = *VP1Z;
9289 
9290  unstable_tke(15.0,9.0,14.0,8.0,
9291  VX,VY,VZ,
9292  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9293  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9294  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9295  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9296  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9297  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9298  *ILOOP = *ILOOP + 1;
9299  VX = *VP1X;
9300  VY = *VP1Y;
9301  VZ = *VP1Z;
9302  }
9303  if((AFP==18) && (ZFP==11)){
9304 // 18Na -> 17Ne + p ->
9305  AFP = 17;
9306  ZFP = 10;
9307  PEVA = PEVA + 1;
9308  IOUNSTABLE = 1;
9309  unstable_tke(18.0,11.0,17.0,10.0,
9310  VX,VY,VZ,
9311  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9312  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9313  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9314  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9315  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9316  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9317  *ILOOP = *ILOOP + 1;
9318  VX = *VP1X;
9319  VY = *VP1Y;
9320  VZ = *VP1Z;
9321  }
9322  if((AFP==19) && (ZFP==11)){
9323 // 19Na -> 18Ne + p ->
9324  AFP = 18;
9325  ZFP = 10;
9326  PEVA = PEVA + 1;
9327  IOUNSTABLE = 1;
9328  unstable_tke(19.0,11.0,18.0,10.0,
9329  VX,VY,VZ,
9330  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9331  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9332  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9333  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9334  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9335  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9336  *ILOOP = *ILOOP + 1;
9337  VX = *VP1X;
9338  VY = *VP1Y;
9339  VZ = *VP1Z;
9340  }
9341  if (ZFP>=4 && (AFP-ZFP)==1){
9342 // Heavy residue is treated as 3He
9343  NEVA = AFP - 3;
9344  PEVA = ZFP - 2;
9345 
9346  for(G4int I = 0;I< NEVA;I++){
9347  unstable_tke(G4double(AFP-I),G4double(ZFP),
9348  G4double(AFP-I-1),G4double(ZFP),
9349  VX,VY,VZ,
9350  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9351  BU_TAB_TEMP[*ILOOP][0] = 0.0;
9352  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9353  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9354  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9355  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9356  *ILOOP = *ILOOP + 1;
9357  VX = *VP1X;
9358  VY = *VP1Y;
9359  VZ = *VP1Z;
9360  }
9361  for(G4int I = 0;I<PEVA;I++){
9362  unstable_tke(G4double(AFP-NEVA-I),G4double(ZFP-I),
9363  G4double(AFP-NEVA-I-1),G4double(ZFP-I-1),
9364  VX,VY,VZ,
9365  &(*VP1X),&(*VP1Y),&(*VP1Z),&VP2X,&VP2Y,&VP2Z);
9366  BU_TAB_TEMP[*ILOOP][0] = 1.0;
9367  BU_TAB_TEMP[*ILOOP][1] = 1.0;
9368  BU_TAB_TEMP[*ILOOP][2] = VP2X;
9369  BU_TAB_TEMP[*ILOOP][3] = VP2Y;
9370  BU_TAB_TEMP[*ILOOP][4] = VP2Z;
9371  *ILOOP = *ILOOP + 1;
9372  VX = *VP1X;
9373  VY = *VP1Y;
9374  VZ = *VP1Z;
9375  }
9376 
9377  AFP = 3;
9378  ZFP = 2;
9379  IOUNSTABLE = 1;
9380  }
9381 //
9382  *AFPNEW = AFP;
9383  *ZFPNEW = ZFP;
9384  return;
9385 }
9386 
9387 //
9388 //
9390 //
9391  G4double EKIN_P1=0.,ekin_tot=0.;
9392  G4double PX1,PX2,PY1,PY2,PZ1,PZ2,PTOT;
9393  G4double RNDT,CTET1,STET1,RNDP,PHI1,ETOT_P1,ETOT_P2;
9394  G4double MASS,MASS1,MASS2;
9395  G4double vxout=0.,vyout=0.,vzout=0.;
9396  G4int iain,izin,ianew,iznew,inin,innew;
9397 //
9398  G4double C = 29.97924580;// cm/ns
9399  G4double AMU = 931.4940; // MeV/C^2
9400 //
9401  iain = idnint(ain);
9402  izin = idnint(zin);
9403  inin = iain - izin;
9404  ianew = idnint(anew);
9405  iznew = idnint(znew);
9406  innew = ianew - iznew;
9407 //
9408  if(izin>12){
9409  mglms(ain,zin,3,&MASS);
9410  mglms(anew,znew,3,&MASS1);
9411  mglms(ain-anew,zin-znew,3,&MASS2);
9412  ekin_tot = MASS-MASS1-MASS2;
9413  }else{
9414  // ekin_tot = MEXP(ININ,IZIN)-(MEXP(INNEW,IZNEW)+MEXP(ININ-INNEW,IZIN-IZNEW));
9415  ekin_tot = masses->massexp[inin][izin]-(masses->massexp[innew][iznew]+masses->massexp[inin-innew][izin-iznew]);
9416  if(izin>12)std::cout << "*** ZIN > 12 ***" << izin << std::endl;
9417  }
9418 
9419  if( ekin_tot<0.00 ){
9420 // if( iain.ne.izin .and. izin.ne.0 ){
9421 // print *,"Negative Q-value in UNSTABLE_TKE"
9422 // print *,"ekin_tot=",ekin_tot
9423 // print *,"ain,zin=",ain,zin,MEXP(ININ,IZIN)
9424 // print *,"anew,znew=",anew,znew,MEXP(INNEW,IZNEW)
9425 // print *
9426 // }
9427  ekin_tot=0.0;
9428  }
9429 //
9430  EKIN_P1 = ekin_tot*(ain-anew)/ ain;
9431  ETOT_P1 = EKIN_P1 + anew * AMU;
9432  PTOT = anew*AMU*std::sqrt((EKIN_P1/(anew*AMU)+1.0)*(EKIN_P1/(anew*AMU)+1.0)-1.0); // MeV/C
9433 //
9434  RNDT = G4AblaRandom::flat();
9435  CTET1 = 2.0*RNDT-1.0;
9436  STET1 = std::sqrt(1.0-CTET1*CTET1);
9437  RNDP = G4AblaRandom::flat();
9438  PHI1 = RNDP*2.0*3.141592654;
9439  PX1 = PTOT * STET1*std::cos(PHI1);
9440  PY1 = PTOT * STET1*std::sin(PHI1);
9441  PZ1 = PTOT * CTET1;
9442  *v1x = C * PX1 / ETOT_P1;
9443  *v1y = C * PY1 / ETOT_P1;
9444  *v1z = C * PZ1 / ETOT_P1;
9445  lorentz_boost(vxin,vyin,vzin,*v1x,*v1y,*v1z,&vxout,&vyout,&vzout);
9446  *v1x = vxout;
9447  *v1y = vyout;
9448  *v1z = vzout;
9449 //
9450  PX2 = - PX1;
9451  PY2 = - PY1;
9452  PZ2 = - PZ1;
9453  ETOT_P2 = (ekin_tot - EKIN_P1) + (ain-anew) * AMU;
9454  *v2x = C * PX2 / ETOT_P2;
9455  *v2y = C * PY2 / ETOT_P2;
9456  *v2z = C * PZ2 / ETOT_P2;
9457  lorentz_boost(vxin,vyin,vzin,*v2x,*v2y,*v2z,&vxout,&vyout,&vzout);
9458  *v2x = vxout;
9459  *v2y = vyout;
9460  *v2z = vzout;
9461 //
9462  return;
9463 }
9464 //
9465 //**************************************************************************
9466 //
9467 void G4Abla::lorentz_boost(G4double VXRIN,G4double VYRIN,G4double VZRIN,G4double VXIN,G4double VYIN,G4double VZIN,G4double *VXOUT,G4double *VYOUT,G4double *VZOUT){
9468 //
9469 // Calculate velocities of a given fragment from frame 1 into frame 2.
9470 // Frame 1 is moving with velocity v=(vxr,vyr,vzr) relative to frame 2.
9471 // Velocity of the fragment in frame 1 -> vxin,vyin,vzin
9472 // Velocity of the fragment in frame 2 -> vxout,vyout,vzout
9473 //
9474  G4double VXR,VYR,VZR;
9475  G4double GAMMA,VR,C,CC,DENO,VXNOM,VYNOM,VZNOM;
9476 //
9477  C = 29.9792458; // cm/ns
9478  CC = C*C;
9479 //
9480 // VXR,VYR,VZR are velocities of frame 1 relative to frame 2; to go from 1 to 2
9481 // we need to multiply them by -1
9482  VXR = -1.0 * VXRIN;
9483  VYR = -1.0 * VYRIN;
9484  VZR = -1.0 * VZRIN;
9485 //
9486  VR = std::sqrt(VXR*VXR + VYR*VYR + VZR*VZR);
9487  if(VR<1e-9){
9488  *VXOUT = VXIN;
9489  *VYOUT = VYIN;
9490  *VZOUT = VZIN;
9491  return;
9492  }
9493  GAMMA = 1.0/std::sqrt(1.0 - VR*VR/CC);
9494  DENO = 1.0 - VXR*VXIN/CC - VYR*VYIN/CC - VZR*VZIN/CC;
9495 
9496 // X component
9497  VXNOM = -GAMMA*VXR + (1.0+(GAMMA-1.0)*VXR*VXR/(VR*VR))*VXIN + (GAMMA-1.0)*VXR*VYR/(VR*VR)*VYIN + (GAMMA-1.0)*VXR*VZR/(VR*VR)*VZIN;
9498 
9499  *VXOUT = VXNOM / (GAMMA * DENO);
9500 
9501 // Y component
9502  VYNOM = -GAMMA*VYR + (1.0+(GAMMA-1.0)*VYR*VYR/(VR*VR))*VYIN + (GAMMA-1.0)*VXR*VYR/(VR*VR)*VXIN + (GAMMA-1.0)*VYR*VZR/(VR*VR)*VZIN;
9503 
9504  *VYOUT = VYNOM / (GAMMA * DENO);
9505 
9506 // Z component
9507  VZNOM = -GAMMA*VZR + (1.0+(GAMMA-1.0)*VZR*VZR/(VR*VR))*VZIN + (GAMMA-1.0)*VXR*VZR/(VR*VR)*VXIN + (GAMMA-1.0)*VYR*VZR/(VR*VR)*VYIN;
9508 
9509  *VZOUT = VZNOM / (GAMMA * DENO);
9510 
9511  return;
9512 }
9513 
9515  G4double *VX1_FISSION_par,G4double *VY1_FISSION_par,G4double *VZ1_FISSION_par,
9516  G4double *VX2_FISSION_par,G4double *VY2_FISSION_par,G4double *VZ2_FISSION_par,
9517  G4int *ZFP1,G4int *AFP1,G4int *ZFP2,G4int *AFP2,G4int *imode_par,
9518  G4double *VX_EVA_SC_par, G4double *VY_EVA_SC_par, G4double *VZ_EVA_SC_par,
9519  G4double EV_TEMP[200][5],G4int *IEV_TAB_FIS_par){
9521  G4double EFF1=0.,EFF2=0.,VFF1=0.,VFF2=0.,
9522  AF1=0.,ZF1=0.,AF2=0.,ZF2=0.,
9523  AFF1=0.,ZFF1=0.,AFF2=0.,ZFF2=0.,
9524  vz1_eva=0., vx1_eva=0.,vy1_eva=0.,
9525  vz2_eva=0., vx2_eva=0.,vy2_eva=0.,
9526  vx_eva_sc=0.,vy_eva_sc=0.,vz_eva_sc=0.,
9527  VXOUT=0.,VYOUT=0.,VZOUT=0.,
9528  VX2OUT=0.,VY2OUT=0.,VZ2OUT=0.;
9529  G4int IEV_TAB_FIS=0,IEV_TAB_TEMP=0;
9530  G4double EV_TEMP1[200][5], EV_TEMP2[200][5],mtota;
9531  G4int inttype = 0,inum=0;
9532  IEV_TAB_SSC=0;
9533  (*imode_par)=0;
9534 
9535  for(G4int I1=0;I1<200;I1++)
9536  for(G4int I2=0;I2<5;I2++){
9537  EV_TEMP[I1][I2] = 0.0;
9538  EV_TEMP1[I1][I2] = 0.0;
9539  EV_TEMP2[I1][I2] = 0.0;
9540  }
9541 
9542  G4double et = EE - JPRF * JPRF * 197. * 197./(2.*0.4*931.*std::pow(AF,5.0/3.0)*1.16*1.16);
9543 
9544  fissionDistri(AF,ZF,et,AF1,ZF1,EFF1,VFF1,AF2,ZF2,EFF2,VFF2,
9545  vx_eva_sc,vy_eva_sc,vz_eva_sc);
9546 
9547 // Copy of the evaporated particles from saddle to scission
9548  for(G4int IJ = 0; IJ< IEV_TAB_SSC;IJ++){
9549  EV_TEMP[IJ][0] = EV_TAB_SSC[IJ][0];
9550  EV_TEMP[IJ][1] = EV_TAB_SSC[IJ][1];
9551  EV_TEMP[IJ][2] = EV_TAB_SSC[IJ][2];
9552  EV_TEMP[IJ][3] = EV_TAB_SSC[IJ][3];
9553  EV_TEMP[IJ][4] = EV_TAB_SSC[IJ][4];
9554  }
9555  IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_SSC;
9556 
9557 // Velocities
9558  G4double VZ1_FISSION = (2.0 * G4AblaRandom::flat() - 1.0) * VFF1;
9559  G4double VPERP1 = std::sqrt(VFF1*VFF1 - VZ1_FISSION*VZ1_FISSION);
9560  G4double ALPHA1 = G4AblaRandom::flat() * 2. * 3.142;
9561  G4double VX1_FISSION = VPERP1 * std::sin(ALPHA1);
9562  G4double VY1_FISSION = VPERP1 * std::cos(ALPHA1);
9563  G4double VX2_FISSION = - VX1_FISSION / VFF1 * VFF2;
9564  G4double VY2_FISSION = - VY1_FISSION / VFF1 * VFF2;
9565  G4double VZ2_FISSION = - VZ1_FISSION / VFF1 * VFF2;
9566 //
9567 // Fission fragment 1
9568  if( (ZF1<=0.0) || (AF1<=0.0) || (AF1<ZF1) ){
9569  std::cout << "F1 unphysical: "<<ZF<< " "<<AF<< " "<<EE<< " "<<ZF1<< " "<<AF1 << std::endl;
9570  }else{
9571 // fission and IMF emission are not allowed
9572  opt->optimfallowed = 0; // IMF is not allowed
9573  fiss->ifis = 0; // fission is not allowed
9574  gammaemission=1;
9575  G4int FF11=0, FIMF11=0;
9576  G4double ZIMFF1=0., AIMFF1=0.,TKEIMF1=0.,JPRFOUT=0.;
9577 //
9578  evapora(ZF1,AF1,&EFF1,0., &ZFF1, &AFF1, &mtota, &vz1_eva, &vx1_eva,&vy1_eva, &FF11, &FIMF11, &ZIMFF1, &AIMFF1,&TKEIMF1, &JPRFOUT, &inttype, &inum,EV_TEMP1,&IEV_TAB_TEMP);
9579 
9580  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
9581  EV_TEMP[IJ+IEV_TAB_FIS][0] = EV_TEMP1[IJ][0];
9582  EV_TEMP[IJ+IEV_TAB_FIS][1] = EV_TEMP1[IJ][1];
9583 // Lorentz kinematics
9584 // EV_TEMP(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
9585 // EV_TEMP(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
9586 // EV_TEMP(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
9587 // Lorentz transformation
9588  lorentz_boost(VX1_FISSION,VY1_FISSION,VZ1_FISSION,
9589  EV_TEMP1[IJ][2],EV_TEMP1[IJ][3],EV_TEMP1[IJ][4],
9590  &VXOUT,&VYOUT,&VZOUT);
9591  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
9592  VXOUT,VYOUT,VZOUT,
9593  &VX2OUT,&VY2OUT,&VZ2OUT);
9594  EV_TEMP[IJ+IEV_TAB_FIS][2] = VX2OUT;
9595  EV_TEMP[IJ+IEV_TAB_FIS][3] = VY2OUT;
9596  EV_TEMP[IJ+IEV_TAB_FIS][4] = VZ2OUT;
9597  //
9598  }
9599  IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_TEMP;
9600 
9601  }
9602 //
9603 // Fission fragment 2
9604  if( (ZF2<=0.0) || (AF2<=0.0) || (AF2<ZF2) ){
9605  std::cout << "F2 unphysical: "<<ZF<< " "<<AF<< " "<<EE<< " "<<ZF2<< " "<<AF2 << std::endl;
9606  }else{
9607 // fission and IMF emission are not allowed
9608  opt->optimfallowed = 0; // IMF is not allowed
9609  fiss->ifis = 0; // fission is not allowed
9610  gammaemission=1;
9611  G4int FF22=0, FIMF22=0;
9612  G4double ZIMFF2=0., AIMFF2=0.,TKEIMF2=0.,JPRFOUT=0.;
9613 //
9614  evapora(ZF2,AF2,&EFF2,0., &ZFF2, &AFF2, &mtota, &vz2_eva, &vx2_eva,&vy2_eva, &FF22, &FIMF22, &ZIMFF2, &AIMFF2,&TKEIMF2, &JPRFOUT, &inttype, &inum,EV_TEMP2,&IEV_TAB_TEMP);
9615 
9616  for(G4int IJ = 0; IJ< IEV_TAB_TEMP;IJ++){
9617  EV_TEMP[IJ+IEV_TAB_FIS][0] = EV_TEMP2[IJ][0];
9618  EV_TEMP[IJ+IEV_TAB_FIS][1] = EV_TEMP2[IJ][1];
9619 // Lorentz kinematics
9620 // EV_TEMP(IJ+IEV_TAB,3) = EV_TEMP(IJ,3) + VX_PREF
9621 // EV_TEMP(IJ+IEV_TAB,4) = EV_TEMP(IJ,4) + VY_PREF
9622 // EV_TEMP(IJ+IEV_TAB,5) = EV_TEMP(IJ,5) + VZ_PREF
9623 // Lorentz transformation
9624  lorentz_boost(VX2_FISSION,VY2_FISSION,VZ2_FISSION,
9625  EV_TEMP2[IJ][2],EV_TEMP2[IJ][3],EV_TEMP2[IJ][4],
9626  &VXOUT,&VYOUT,&VZOUT);
9627  lorentz_boost(vx_eva_sc,vy_eva_sc,vz_eva_sc,
9628  VXOUT,VYOUT,VZOUT,
9629  &VX2OUT,&VY2OUT,&VZ2OUT);
9630  EV_TEMP[IJ+IEV_TAB_FIS][2] = VX2OUT;
9631  EV_TEMP[IJ+IEV_TAB_FIS][3] = VY2OUT;
9632  EV_TEMP[IJ+IEV_TAB_FIS][4] = VZ2OUT;
9633  //
9634  }
9635  IEV_TAB_FIS = IEV_TAB_FIS + IEV_TAB_TEMP;
9636  }
9637 //
9638 // Lorentz kinematics
9639 // vx1_fission = vx1_fission + vx1_eva
9640 // vy1_fission = vy1_fission + vy1_eva
9641 // vz1_fission = vz1_fission + vz1_eva
9642 // vx2_fission = vx2_fission + vx2_eva
9643 // vy2_fission = vy2_fission + vy2_eva
9644 // vz2_fission = vz2_fission + vz2_eva
9645 // The v_eva_sc contribution is considered in the calling subroutine
9646 // Lorentz transformations
9647  lorentz_boost(vx1_eva,vy1_eva,vz1_eva,
9648  VX1_FISSION,VY1_FISSION,VZ1_FISSION,
9649  &VXOUT,&VYOUT,&VZOUT);
9650  VX1_FISSION = VXOUT;
9651  VY1_FISSION = VYOUT;
9652  VZ1_FISSION = VZOUT;
9653  lorentz_boost(vx2_eva,vy2_eva,vz2_eva,
9654  VX2_FISSION,VY2_FISSION,VZ2_FISSION,
9655  &VXOUT,&VYOUT,&VZOUT);
9656  VX2_FISSION = VXOUT;
9657  VY2_FISSION = VYOUT;
9658  VZ2_FISSION = VZOUT;
9659 //
9660  (*ZFP1) = idnint(ZFF1);
9661  (*AFP1) = idnint(AFF1);
9662  (*VX1_FISSION_par) = VX1_FISSION;
9663  (*VY1_FISSION_par) = VY1_FISSION;
9664  (*VZ1_FISSION_par) = VZ1_FISSION;
9665  (*VX_EVA_SC_par)=vx_eva_sc;
9666  (*VY_EVA_SC_par)=vy_eva_sc;
9667  (*VZ_EVA_SC_par)=vz_eva_sc;
9668  (*ZFP2) = idnint(ZFF2);
9669  (*AFP2) = idnint(AFF2);
9670  (*VX2_FISSION_par) = VX2_FISSION;
9671  (*VY2_FISSION_par) = VY2_FISSION;
9672  (*VZ2_FISSION_par) = VZ2_FISSION;
9673  (*IEV_TAB_FIS_par) = IEV_TAB_FIS;
9674  return;
9675 }
9676 //*************************************************************************
9677 //
9679 
9680  G4double V_over_V0,R0,RALL,RHAZ,R,TKE,Ekin,V,VPERP,ALPHA1;
9681 
9682  V_over_V0 = 6.0;
9683  R0 = 1.16;
9684 
9685  if(Z < 1.0){
9686  *VX = 0.0;
9687  *VY = 0.0;
9688  *VZ = 0.0;
9689  return;
9690  }
9691 
9692  RALL = R0 * std::pow(V_over_V0,1.0/3.0) * std::pow(AAL,1.0/3.0);
9693  RHAZ = G4double(haz(1));
9694  R = std::pow(RHAZ,1.0/3.0) * RALL;
9695  TKE = 1.44 * Z * ZALL * R*R * (1.0 - A/AAL)*(1.0 - A/AAL) / std::pow(RALL,3.0);
9696 
9697  Ekin = TKE * (AAL - A) / AAL;
9698 // print*,'!!!',IDNINT(AAl),IDNINT(A),IDNINT(ZALL),IDNINT(Z)
9699  V = std::sqrt(Ekin/A) * 1.3887;
9700  *VZ = (2.0 * G4double(haz(1)) - 1.0) * V;
9701  VPERP = std::sqrt(V*V - (*VZ)*(*VZ));
9702  ALPHA1 = G4double(haz(1)) * 2.0 * 3.142;
9703  *VX = VPERP * std::sin(ALPHA1);
9704  *VY = VPERP * std::cos(ALPHA1);
9705  return;
9706 }
9707 
9709 {
9710  // const G4int pSize = 110;
9711  // static G4ThreadLocal G4double p[pSize];
9712  static G4ThreadLocal G4long ix = 0;
9713  static G4ThreadLocal G4double x = 0.0, y = 0.0;
9714  // k =< -1 on initialise
9715  // k = -1 c'est reproductible
9716  // k < -1 || k > -1 ce n'est pas reproductible
9717 /*
9718  // Zero is invalid random seed. Set proper value from our random seed collection:
9719  if(ix == 0) {
9720  // ix = hazard->ial;
9721  }
9722 */
9723  if (k <= -1) { //then
9724  if(k == -1) { //then
9725  ix = 0;
9726  }
9727  else {
9728  x = 0.0;
9729  y = secnds(G4int(x));
9730  ix = G4int(y * 100 + 43543000);
9731  if(mod(ix,2) == 0) {
9732  ix = ix + 1;
9733  }
9734  }}
9735 
9736  return G4AblaRandom::flat();
9737 }
9738 
9739 // Random generator according to the
9740 // powerfunction y = x**(lambda) in the range from xmin to xmax
9741 // xmin, xmax and y are integers.
9742 // lambda must be different from -1 !
9744  G4double y,l_plus,rxmin,rxmax;
9745  l_plus = lambda + 1.;
9746  rxmin = G4double(xmin) - 0.5;
9747  rxmax = G4double(xmax) + 0.5;
9748 // y=(HAZ(k)*(rxmax**l_plus-rxmin**l_plus)+ rxmin**l_plus)**(1.E0/l_plus)
9749  y=std::pow(G4AblaRandom::flat()*(std::pow(rxmax,l_plus)-std::pow(rxmin,l_plus))+ std::pow(rxmin,l_plus),1.0/l_plus);
9750  return nint(y);
9751 }
9752 
9753 void G4Abla::AMOMENT(G4double AABRA,G4double APRF, G4int IMULTIFR,G4double *PX,G4double *PY,G4double *PZ){
9754 
9755  G4int ISIGOPT = 0;
9756  G4double GOLDHA_BU=0.,GOLDHA=0.;
9757  G4double PI = 3.141592653589793;
9758 // In MeV/C
9759  G4double V0_over_VBU = 1.0 / 6.0;
9760  G4double SIGMA_0 = 118.50;
9761  G4double Efermi = 5.0 * SIGMA_0 * SIGMA_0 / (2.0 * 931.4940);
9762 
9763  if(IMULTIFR==1){
9764  if(ISIGOPT == 0){
9765 // "Fermi model" picture:
9766 // Influence of expansion:
9767  SIGMA_0 = SIGMA_0 * std::pow(V0_over_VBU,1.0/3.0);
9768 // To take into account the influence of thermal motion of nucleons (see W. Bauer,
9769 // PRC 51 (1995) 803)
9770 // Efermi = 5.D0 * SIGMA_0 * SIGMA_0 / (2.D0 * 931.49D0)
9771 
9772  GOLDHA_BU = SIGMA_0 * std::sqrt((APRF*(AABRA-APRF))/(AABRA-1.0));
9773  GOLDHA = GOLDHA_BU*std::sqrt(1.0 +
9774  5.0 * PI*PI / 12.0 * (T_freeze_out / Efermi)*(T_freeze_out / Efermi));
9775 // PRINT*,'AFTER BU fermi:',IDNINT(AABRA),IDNINT(APRF),GOLDHA,
9776 // & GOLDHA_BU
9777  }else{
9778 // Thermal equilibrium picture (<=> to Boltzmann distribution in momentum with sigma2=M*T)
9779 // The factor (AABRA-APRF)/AP comes from momentum conservation:
9780  GOLDHA_BU = std::sqrt(APRF * T_freeze_out * 931.494 *
9781  (AABRA - APRF) / AABRA);
9782  GOLDHA = GOLDHA_BU;
9783 // PRINT*,'AFTER BU therm:',IDNINT(AABRA),IDNINT(APRF),GOLDHA,
9784 // & GOLDHA_BU
9785  }
9786  }else{
9787  GOLDHA = SIGMA_0 * std::sqrt((APRF*(AABRA-APRF))/(AABRA-1.0));
9788  }
9789 
9790  G4int IS = 0;
9791  mom123:
9792  *PX = G4double(gausshaz(1,0.0,GOLDHA));
9793  IS = IS +1;
9794  if(IS>100){
9795  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING PX IN Rn07.FOR. A VALUE WILL BE FORCED." << std::endl;
9796  *PX = (AABRA-1.0)*931.4940;
9797  }
9798  if(std::abs(*PX)>= AABRA*931.494){
9799 // PRINT*,'VX > C',PX,IDNINT(APRF)
9800  goto mom123;
9801  }
9802  IS = 0;
9803  mom456:
9804  *PY = G4double(gausshaz(1,0.0,GOLDHA));
9805  IS = IS +1;
9806  if(IS>100){
9807  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING PY IN Rn07.FOR. A VALUE WILL BE FORCED." << std::endl;
9808  *PY = (AABRA-1.0)*931.4940;
9809  }
9810  if(std::abs(*PY)>= AABRA*931.494){
9811 // PRINT*,'VX > C',PX,IDNINT(APRF)
9812  goto mom456;
9813  }
9814  IS = 0;
9815  mom789:
9816  *PZ = G4double(gausshaz(1,0.0,GOLDHA));
9817  IS = IS +1;
9818  if(IS>100){
9819  std::cout << "WARNING: GAUSSHAZ CALLED MORE THAN 100 TIMES WHEN CALCULATING PZ IN Rn07.FOR. A VALUE WILL BE FORCED." << std::endl;
9820  *PZ = (AABRA-1.0)*931.4940;
9821  }
9822  if(std::abs(*PZ)>= AABRA*931.494){
9823 // PRINT*,'VX > C',PX,IDNINT(APRF)
9824  goto mom789;
9825  }
9826  return;
9827 }
9828 
9830 {
9831  // Gaussian random numbers:
9832 
9833  // 1005 C*** TIRAGE ALEATOIRE DANS UNE GAUSSIENNE DE LARGEUR SIG ET MOYENNE XMOY
9834  static G4ThreadLocal G4int iset = 0;
9835  static G4ThreadLocal G4double v1,v2,r,fac,gset,fgausshaz;
9836 
9837  if(iset == 0) { //then
9838  do {
9839  v1 = 2.0*haz(k) - 1.0;
9840  v2 = 2.0*haz(k) - 1.0;
9841  r = std::pow(v1,2) + std::pow(v2,2);
9842  } while(r >= 1);
9843 
9844  fac = std::sqrt(-2.*std::log(r)/r);
9845  gset = v1*fac;
9846  fgausshaz = v2*fac*sig+xmoy;
9847  iset = 1;
9848  }
9849  else {
9850  fgausshaz=gset*sig+xmoy;
9851  iset=0;
9852  }
9853  return fgausshaz;
9854 }
void AMOMENT(G4double AABRA, G4double APRF, G4int IMULTIFR, G4double *PX, G4double *PY, G4double *PZ)
Definition: G4Abla.cc:9753
Float_t x
Definition: compare.C:6
G4double erf(G4double x)
Definition: G4Abla.cc:5404
G4double fmaxhaz_old(G4double T)
Definition: G4Abla.cc:5531
void FillData(G4int IMULTBU, G4int IEV_TAB)
Definition: G4Abla.cc:5701
G4int gammaemission
Definition: G4Abla.hh:462
Double_t xx
G4double gausshaz(int k, double xmoy, double sig)
Definition: G4Abla.cc:9829
std::vector< ExP01TrackerHit * > a
Definition: ExP01Classes.hh:33
void part_fiss(G4double BET, G4double GP, G4double GF, G4double Y, G4double TAUF, G4double TS1, G4double TSUM, G4int *CHOICE, G4double ZF, G4double AF, G4double FT, G4double *T_LAPSE, G4double *GF_LOC)
Definition: G4Abla.cc:6259
G4double tau(G4double bet, G4double homega, G4double ef, G4double t)
Definition: G4Abla.cc:4906
G4double getMexp(G4int A, G4int Z)
void unbound(G4double SN, G4double SP, G4double SD, G4double ST, G4double SHE, G4double SA, G4double BP, G4double BD, G4double BT, G4double BHE, G4double BA, G4double *PROBF, G4double *PROBN, G4double *PROBP, G4double *PROBD, G4double *PROBT, G4double *PROBHE, G4double *PROBA, G4double *PROBIMF, G4double *PROBG, G4double *ECN, G4double *ECP, G4double *ECD, G4double *ECT, G4double *ECHE, G4double *ECA)
Definition: G4Abla.cc:7398
G4double tunnelling(G4double A, G4double ZPRF, G4double Y, G4double EE, G4double EF, G4double TEMP, G4double DENSG, G4double DENSF, G4double ENH_FACT)
Definition: G4Abla.cc:6462
G4int IEV_TAB_SSC
Definition: G4Abla.hh:460
void qrot(G4double z, G4double a, G4double bet, G4double sig, G4double u, G4double *qr)
Definition: G4Abla.cc:4604
Float_t y1[n_points_granero]
Definition: compare.C:5
G4double EV_TAB[200][5]
Definition: G4Abla.hh:461
#define V1(a, b, c)
G4double massexp[MASSIZEROWS][MASSIZECOLS]
void mglw(G4double a, G4double z, G4double *el)
Definition: G4Abla.cc:2254
void mglms(G4double a, G4double z, G4int refopt4, G4double *el)
Definition: G4Abla.cc:2281
Float_t x1[n_points_granero]
Definition: compare.C:5
Float_t y
Definition: compare.C:6
G4double T_freeze_out_in
Definition: G4Abla.hh:459
void SetParametersG4(G4int z, G4int a)
Definition: G4Abla.cc:2175
const char * p
Definition: xmltok.h:285
void appariem(G4double a, G4double z, G4double *del)
Definition: G4Abla.cc:4851
void fissionDistri(G4double &a, G4double &z, G4double &e, G4double &a1, G4double &z1, G4double &e1, G4double &v1, G4double &a2, G4double &z2, G4double &e2, G4double &v2, G4double &vx_eva_sc, G4double &vy_eva_sc, G4double &vz_eva_sc)
Definition: G4Abla.cc:7518
float G4float
Definition: G4Types.hh:77
Double_t z
Float_t Y
void bsbkbc(G4double A, G4double Z, G4double *BS, G4double *BK, G4double *BC)
Definition: G4Abla.cc:6132
G4double umass(G4double z, G4double n, G4double beta)
Definition: G4Abla.cc:8492
void DeexcitationAblaxx(G4int nucleusA, G4int nucleusZ, G4double excitationEnergy, G4double angularMomentum, G4double momX, G4double momY, G4double momZ, G4int eventnumber)
Definition: G4Abla.cc:95
void guet(G4double *x_par, G4double *z_par, G4double *find_par)
Definition: G4Abla.cc:5630
G4double pen(G4double A, G4double ap, G4double omega, G4double T)
Definition: G4Abla.cc:6107
G4Eenuc * eenuc
Definition: G4Abla.hh:466
G4double getEcnz(G4int A, G4int Z)
G4int idnint(G4double value)
Definition: G4Abla.cc:5905
G4Pace * pace
Definition: G4Abla.hh:464
G4Ecld * ecld
Definition: G4Abla.hh:468
G4int verboseLevel
Definition: G4Abla.hh:457
Double_t zz
void even_odd(G4double r_origin, G4double r_even_odd, G4int &i_out)
Definition: G4Abla.cc:8432
G4int nint(G4double number)
Definition: G4Abla.cc:5827
void unstable_tke(G4double AIN, G4double ZIN, G4double ANEW, G4double ZNEW, G4double VXIN, G4double VYIN, G4double VZIN, G4double *V1X, G4double *V1Y, G4double *V1Z, G4double *V2X, G4double *V2Y, G4double *V2Z)
Definition: G4Abla.cc:9389
Float_t tmp
Double_t beta
G4int avv[VARNTPSIZE]
G4double f(G4double E)
Definition: G4Abla.cc:5520
#define G4ThreadLocal
Definition: tls.hh:69
G4double cram(G4double bet, G4double homega)
Definition: G4Abla.cc:4934
void fission(G4double AF, G4double ZF, G4double EE, G4double JPRF, G4double *VX1_FISSION, G4double *VY1_FISSION, G4double *VZ1_FISSION, G4double *VX2_FISSION, G4double *VY2_FISSION, G4double *VZ2_FISSION, G4int *ZFP1, G4int *AFP1, G4int *ZFP2, G4int *AFP2, G4int *imode, G4double *VX_EVA_SC, G4double *VY_EVA_SC, G4double *VZ_EVA_SC, G4double EV_TEMP[200][5], G4int *IEV_TAB_FIS)
Definition: G4Abla.cc:9514
G4int ilast
Definition: G4Abla.hh:458
G4Ec2sub * ec2sub
Definition: G4Abla.hh:467
G4double ecoul(G4double z1, G4double n1, G4double beta1, G4double z2, G4double n2, G4double beta2, G4double d)
Definition: G4Abla.cc:8522
G4double func_trans(G4double TIME, G4double ZF, G4double AF, G4double BET, G4double Y, G4double FT, G4double T_0)
Definition: G4Abla.cc:6162
void clear()
Float_t y2[n_points_geant4]
Definition: compare.C:26
const G4int nmax
void lpoly(G4double x, G4int n, G4double pl[])
Definition: G4Abla.cc:4683
G4double beta2[ECLDROWSbeta][ECLDCOLSbeta]
G4int optcha
Float_t Z
G4Fiss * fiss
Definition: G4Abla.hh:471
G4double dint(G4double a)
Definition: G4Abla.cc:5881
G4int optemd
G4int secnds(G4int x)
Definition: G4Abla.cc:5855
static constexpr double m
Definition: G4SIunits.hh:129
double G4double
Definition: G4Types.hh:76
static constexpr double pc
Definition: G4SIunits.hh:137
G4double ak
G4double ecgnz[ECLDROWS][ECLDCOLS]
**D E S C R I P T I O N
G4int getMexpID(G4int A, G4int Z)
void evap_postsaddle(G4double A, G4double Z, G4double E_scission_pre, G4double *E_scission_post, G4double *A_scission, G4double *Z_scission, G4double &vx_eva, G4double &vy_eva, G4double &vz_eva)
Definition: G4Abla.cc:7118
G4double eflmac(G4int ia, G4int iz, G4int flag, G4int optshp)
Definition: G4Abla.cc:4700
TCanvas * c2
Definition: plot_hist.C:75
G4double enerj[VARNTPSIZE]
G4double pzlab[VARNTPSIZE]
G4double getAlpha(G4int A, G4int Z)
const XML_Char int const XML_Char * value
Definition: expat.h:331
G4double av
long G4long
Definition: G4Types.hh:80
G4int min(G4int a, G4int b)
Definition: G4Abla.cc:5773
G4double pylab[VARNTPSIZE]
G4double frldm(double z, double n, double beta)
Definition: G4Abla.cc:8565
G4int mod(G4int a, G4int b)
Definition: G4Abla.cc:5871
G4int idint(G4double a)
Definition: G4Abla.cc:5893
G4double getBeta2(G4int A, G4int Z)
G4fissionEvent * fe
G4double gammp(G4double a, G4double x)
Definition: G4Abla.cc:5416
G4double ucr
static const G4double alpha
G4int itypcasc[VARNTPSIZE]
Definition: inflate.h:23
void fission_width(G4double ZPRF, G4double A, G4double EE, G4double BS, G4double BK, G4double EF, G4double Y, G4double *GF, G4double *TEMP, G4double JPR, G4int IEROT, G4int FF_ALLOWED, G4int OPTCOL, G4int OPTSHP, G4double DENSG)
Definition: G4Abla.cc:6532
TMarker * pt
Definition: egs.C:25
Double_t R
double A(double temperature)
void barrs(G4int Z1, G4int A1, G4int Z2, G4int A2, G4double *sBARR, G4double *sOMEGA)
Definition: G4Abla.cc:5054
G4int optshp
G4double fd(G4double E)
Definition: G4Abla.cc:5513
Float_t d
G4int ISIGN(G4int a, G4int b)
Definition: G4Abla.cc:5815
G4int optcol
void fomega_sp(G4double AF, G4double Y, G4double *MFCD, G4double *sOMEGA, G4double *sHOMEGA)
Definition: G4Abla.cc:5006
G4double haz(G4int k)
Definition: G4Abla.cc:9708
G4double pxlab[VARNTPSIZE]
void gcf(G4double *gammcf, G4double a, G4double x, G4double gln)
Definition: G4Abla.cc:5432
G4double alpha[ECLDROWS][ECLDCOLS]
G4double dmin1(G4double a, G4double b, G4double c)
Definition: G4Abla.cc:5913
G4double getRms(G4int A, G4int Z)
void setVerboseLevel(G4int level)
Definition: G4Abla.cc:75
void densniv(G4double a, G4double z, G4double ee, G4double ef, G4double *dens, G4double bshell, G4double bs, G4double bk, G4double *temp, G4int optshp, G4int optcol, G4double defbet, G4double *ecor, G4double jprf, G4int ifis, G4double *qr)
Definition: G4Abla.cc:4182
G4double BU_TAB[200][11]
Definition: G4Abla.hh:461
#define V2(a, b, c)
G4int optimfallowed
G4double utilabs(G4double a)
Definition: G4Abla.cc:5927
G4double rms[ECLDROWS][ECLDCOLS]
G4double DSIGN(G4double a, G4double b)
Definition: G4Abla.cc:5803
TFile fb("Li6.root")
Double_t Z2
void parite(G4double n, G4double *par)
Definition: G4Abla.cc:4881
G4double dcr
Double_t Z1
G4double eflmac_profi(double a, double z)
Definition: G4Abla.cc:8596
void imf(G4double ACN, G4double ZCN, G4double TEMP, G4double EE, G4double *ZIMF, G4double *AIMF, G4double *BIMF, G4double *SBIMF, G4double *TIMF, G4double JPRF)
Definition: G4Abla.cc:6684
G4Fb * fb
Definition: G4Abla.hh:470
G4Abla(G4Volant *aVolant, G4VarNtp *aVarntp)
Definition: G4Abla.cc:45
const G4double a0
static const G4double bp
G4double spdef(G4int a, G4int z, G4int optxfis)
Definition: G4Abla.cc:2336
G4double vgsld[ECLDROWS][ECLDCOLS]
G4double getBeta4(G4int A, G4int Z)
int G4int
Definition: G4Types.hh:78
G4double dm[PACESIZEROWS][PACESIZECOLS]
void lorentz_boost(G4double VXRIN, G4double VYRIN, G4double VZRIN, G4double VXIN, G4double VYIN, G4double VZIN, G4double *VXOUT, G4double *VYOUT, G4double *VZOUT)
Definition: G4Abla.cc:9467
G4int max(G4int a, G4int b)
Definition: G4Abla.cc:5793
ifstream in
Definition: comparison.C:7
G4VarNtp * varntp
Definition: G4Abla.hh:474
double C(double temp)
void isostab_lim(G4int z, G4int *nmin, G4int *nmax)
Definition: G4Abla.cc:6994
G4int IPOWERLIMHAZ(G4double lambda, G4int xmin, G4int xmax)
Definition: G4Abla.cc:9743
static const G4double fac
G4double as
G4double fvmaxhaz_neut(G4double x)
Definition: G4Abla.cc:6679
G4Ald * ald
Definition: G4Abla.hh:465
G4double getPace2(G4int A, G4int Z)
G4double EV_TAB_SSC[200][5]
Definition: G4Abla.hh:461
void fomega_gs(G4double AF, G4double ZF, G4double *K1, G4double *sOMEGA, G4double *sHOMEGA)
Definition: G4Abla.cc:5032
void clear()
void direct(G4double zprf, G4double a, G4double ee, G4double jprf, G4double *probp_par, G4double *probd_par, G4double *probt_par, G4double *probn_par, G4double *probhe_par, G4double *proba_par, G4double *probg_par, G4double *probimf_par, G4double *probf_par, G4double *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, G4double *sd, G4double *st, G4double *she, G4double *sa, G4double *ef, G4double *ts1, G4int inttype, G4int inum, G4int itest, G4int *sortie, G4double *tcn, G4double *jprfn, G4double *jprfp, G4double *jprfd, G4double *jprft, G4double *jprfhe, G4double *jprfa, G4double *tsum)
Definition: G4Abla.cc:2922
G4double gammln(G4double xx)
Definition: G4Abla.cc:5492
G4double pace2(G4double a, G4double z)
Definition: G4Abla.cc:5592
void gser(G4double *gamser, G4double a, G4double x, G4double gln)
Definition: G4Abla.cc:5464
G4double T_freeze_out
Definition: G4Abla.hh:463
Char_t n[5]
G4double fvmaxhaz(G4double T)
Definition: G4Abla.cc:6153
G4int zvv[VARNTPSIZE]
void evapora(G4double zprf, G4double aprf, G4double *ee_par, G4double jprf, G4double *zf_par, G4double *af_par, G4double *mtota_par, G4double *vleva_par, G4double *vxeva_par, G4double *vyeva_par, G4int *ff_par, G4int *fimf_par, G4double *fzimf, G4double *faimf, G4double *tkeimf_par, G4double *jprfout, G4int *inttype_par, G4int *inum_par, G4double EV_TEMP[200][5], G4int *iev_tab_temp_par)
Definition: G4Abla.cc:2433
static constexpr double pi
Definition: G4SIunits.hh:75
TFile ff[ntarg]
Definition: Style.C:26
void SetParameters()
Definition: G4Abla.cc:2195
G4int optshpimf
static constexpr double amu
void unstable_nuclei(G4int AFP, G4int ZFP, G4int *AFPNEW, G4int *ZFPNEW, G4int &IOUNSTABLE, G4double VX, G4double VY, G4double VZ, G4double *VP1X, G4double *VP1Y, G4double *VP1Z, G4double BU_TAB_TEMP[200][5], G4int *ILOOP)
Definition: G4Abla.cc:8704
static const G4double eps
static unsigned bk
Definition: csz_inflate.cc:345
G4double efa[FBCOLS][FBROWS]
G4double fmaxhaz(G4double T)
Definition: G4Abla.cc:5526
~G4Abla()
Definition: G4Abla.cc:80
void initEvapora()
Definition: G4Abla.cc:2006
G4double ecfnz[ECLDROWS][ECLDCOLS]
void lorb(G4double AMOTHER, G4double ADAUGHTER, G4double LMOTHER, G4double EEFINAL, G4double *LORBITAL, G4double *SIGMA_LORBITAL)
Definition: G4Abla.cc:6640
G4Mexp * masses
Definition: G4Abla.hh:469
G4double getVgsld(G4int A, G4int Z)
void tke_bu(G4double Z, G4double A, G4double ZALL, G4double AAL, G4double *VX, G4double *VY, G4double *VZ)
Definition: G4Abla.cc:9678
Float_t X
G4Volant * volant
Definition: G4Abla.hh:473
double B(double temperature)
G4double bind[MASSIZEROWS][MASSIZECOLS]
G4double bipol(int iflag, G4double y)
Definition: G4Abla.cc:4951
G4int optct
G4double fissility(int a, int z, int optxfis)
Definition: G4Abla.cc:2378
void barfit(G4int iz, G4int ia, G4int il, G4double *sbfis, G4double *segs, G4double *selmax)
Definition: G4Abla.cc:5090
G4int optxfis
double flat()
Definition: G4AblaRandom.cc:48
G4double bet
G4int mexpiop[MASSIZEROWS][MASSIZECOLS]
G4double ecnz[EC2SUBROWS][EC2SUBCOLS]
G4double beta4[ECLDROWSbeta][ECLDCOLSbeta]
G4double width(G4double AMOTHER, G4double ZMOTHER, G4double APART, G4double ZPART, G4double TEMP, G4double B1, G4double SB1, G4double EXC)
Definition: G4Abla.cc:5933
G4double Uwash(double E, double Ecrit, double Freduction, double gamma)
Definition: G4Abla.cc:8550
const double C2
G4Opt * opt
Definition: G4Abla.hh:472
G4double optafan
G4double ifis