This commit was generated by cvs2svn to compensate for changes in r2,

[u/mrichter/AliRoot.git] / GEANT321 / neutron / evaplr.F

diff --git a/GEANT321/neutron/evaplr.F b/GEANT321/neutron/evaplr.F
new file mode 100644 (file)
index 0000000..41d52b0
--- /dev/null
+++ b/GEANT321/neutron/evaplr.F
@@ -0,0 +1,54 @@
+*
+* $Id$
+*
+* $Log$
+* Revision 1.1.1.1  1995/10/24 10:21:56  cernlib
+* Geant
+*
+*
+#include "geant321/pilot.h"
+*CMZ :  3.21/04 23/02/95  14.46.01  by  S.Giani
+*-- Author :
+      SUBROUTINE EVAPLR(E,Q,SQ,ATAR,CB,EX)
+C       THIS ROUTINE SAMPLES AN EXIT ENERGY FROM AN
+C       EVAPORATION SPECTRUM FOR AN LR-FLAG (N,N-PRIME X) REACTION
+#include "geant321/minput.inc"
+      SAVE
+C       CONVERT THE COULOMB BARRIER (CB) TO UNITS OF EV
+      CB=CB*1.00E+06
+C       SET THE EXCITATION ENERGY (Q) TO ITS ABSOLUTE VALUE
+      QA=ABS(Q)
+C       CALCULATE THE MAXIMUM ENERGY AVAILABLE
+      CBI=CB
+      EMAX=QA+SQ-CB
+      IF(EMAX.GT.0.0)GO TO 10
+      CB=0.5*CB
+      EMAX=QA+SQ-CB
+      IF(EMAX.GT.0.0)GO TO 10
+      CB=0.0
+      EMAX=QA+SQ-CB
+      IF(EMAX.GT.0.0)GO TO 10
+      WRITE(IOUT,10000)E,EMAX,QA,SQ,CBI
+10000 FORMAT(' MICAP: NEGATIVE MAXIMUM ENERGY CALCULATED IN ROUTINE ',
+     1'EVAPLR --- INDICATING PROBABLE CROSS SECTION ERROR ALLOWING ',
+     2'THE REACTION TO OCCUR',/,10X,'E,EMAX,QA,SQ,CB=',1P5E13.5)
+      WRITE(6,*) ' CALOR: ERROR in EVAPLR ====> STOP '
+      STOP
+C       CALCULATE THE NUCLEAR TEMPERATURE (THETA)
+   10 THETA=4.0161E+03*(SQRT(QA+SQ-CB)/(ATAR**0.8333333))
+C       SELECT THE EXIT ENERGY FROM AN EVAPORATION SPECTRUM
+   20 R1=FLTRNF(0)
+      R2=FLTRNF(0)
+      W=-ALOG(R1*R2)
+      EX=THETA*W
+      IF(EX.LE.EMAX)RETURN
+C       RESAMPLE 75% OF THE TIME IF EX IS GREATER THAN EMAX
+      R=FLTRNF(0)
+      IF(R.LE.0.75)GO TO 20
+#if defined(CERNLIB_MDEBUG)
+      WRITE(IOUT,10100)EX,EMAX
+10100 FORMAT(' MICAP: WARNING-EX,EMAX=',1P2E13.5,' IN ROUTINE EVAPLR')
+#endif
+      EX=EMAX
+      RETURN
+      END