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

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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:59  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/04 28/02/95  17.12.29  by  S.Giani
*-- Author :
      SUBROUTINE THRMSC(D,LD,ITHRMS,LTHRM,E,U,V,W,TEMP,FM,AWR,IIN,
     +                  IFLG,IOUT)
C      THIS ROUTINE CONTROLS SELECTION OF THE NEUTRON EXIT ENERGY
C      IN THE THERMAL DATA RANGE
#include "geant321/mupsca.inc"
      DIMENSION D(*),LD(*),ITHRMS(*),LTHRM(*),AWR(*)
      REAL HMASSN, SPI
      DATA HMASSN, SPI/0.5044905, 1.1283792/
 
C       HMASSN EQUALS ONE-HALF THE NEUTRON MASS
C       SPI EQUALS TWO DIVIDED BY THE SQUARE ROOT OF PI
C       CONVERT TEMPERATURE FROM DEGREES KELVIN TO EV
      DATA BK/8.6167E-5/
      SAVE
C
      TDK=BK*TEMP
      AAWR=AWR(IIN)
      IFLG=0
      NE=ITHRMS(IIN)
      IF(NE.LE.0)GO TO 10
      EO=E
      NP7=ITHRMS(IIN+1)
      NB7=ITHRMS(IIN+2)
      CT=ITHRMS(IIN+3)
      LENMD=ITHRMS(IIN+4)
      N=NB7*NE
      CALL THRSEL(NE,NP7,NB7,E,EOUT,FM,CT,ITHRMS(IIN+5),
     + ITHRMS(IIN+5+NE),ITHRMS(IIN+5+NE+NP7),
     + ITHRMS(IIN+5+NE+NP7+NB7),
     + ITHRMS(IIN+5+2*NE+NP7+NB7),ITHRMS(IIN+5+2*NE+NP7+NB7+N),
     + ITHRMS(IIN+5+2*NE+NP7+NB7+N+LENMD),AWR,IIN,
     + ITHRMS(IIN+5+2*NE+NP7+NB7+N+LENMD+NP7*NB7),
     + ITHRMS(IIN+5+2*NE+NP7+NB7+N),IOUT)
      E=EOUT
C       IFLG EQUAL TO ONE IMPLIES (FM) IN LABORATORY SYSTEM
      IFLG=1
      RETURN
C       FREE GAS MODEL
   10 CONTINUE
C       SPD IS THE SPEED OF THE INCIDENT NEUTRON
      SPD=SQRT(E/HMASSN)
      TAUN=SPI*SQRT(2.0*TDK/AAWR)
      PTEST=SPD/(SPD+TAUN)
C       UO, VO, AND WO ARE THE VELOCITY COMPONENTS OF THE INCIDENT
C       NEUTRON IN TERMS OF THE NEUTRON SPEED
      UO=SPD*U
      VO=SPD*V
      WO=SPD*W
   20 CONTINUE
      IF(PTEST.GT.FLTRNF(0))GO TO 30
      ETA=-ALOG(FLTRNF(0)*FLTRNF(0))*TDK
      GO TO 40
   30 CONTINUE
      ETA=RNMAXF(TDK)
   40 CONTINUE
C       ERFGM IS THE INITIAL ENERGY OF THE TARGET NUCLEUS
      ERFGM=ETA
C       ETA IS THE SPEED OF THE TARGET NUCLEUS
      ETA=SQRT(2.0*ETA/AAWR)
C       UN, VN, AND WN ARE THE VELOCITY COMPONENTS OF THE TARGET
C       NUCLEUS IN TERMS OF THE TARGET NUCLEUS SPEED
      CALL GTISO(UN,VN,WN)
      UN=UN*ETA
      VN=VN*ETA
      WN=WN*ETA
      VRELSQ=(UO-UN)**2+(VO-VN)**2+(WO-WN)**2
      F2=FLTRNF(0)**2
      V2=VRELSQ/(SPD+ETA)**2
      IF(F2.GT.V2)GO TO 20
      VREL=SQRT(VRELSQ)
      ALPHA=1.0/(AAWR+1.0)
      BETA=1.0-ALPHA
      CALL GTISO(UA,VA,WA)
      UO=UO*ALPHA+BETA*(UN+VREL*UA)
      VO=VO*ALPHA+BETA*(VN+VREL*VA)
      WO=WO*ALPHA+BETA*(WN+VREL*WA)
      SPDSQ=UO*UO+VO*VO+WO*WO
C       E IS THE EXIT ENERGY OF THE NEUTRON
      E=HMASSN*SPDSQ
      SPD=1.0/SQRT(SPDSQ)
      FM=(U*UO+V*VO+W*WO)*SPD
C       U, V, AND W ARE THE EXIT NEUTRON DIRECTION COSINES
      U=UO*SPD
      V=VO*SPD
      W=WO*SPD
C       IFLG EQUAL TO TWO IMPLIES (U,V,W) IN LABORATORY SYSTEM
      IFLG=2
      RETURN
      END