GEANT321/fluka/nuprel.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:04  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.44  by  S.Giani
  11 *-- Author :
  12 *$ CREATE NUPREL.FOR
  13 *COPY NUPREL
  14 *
  15 *=== nuprel ===========================================================*
  16 *
  17       SUBROUTINE NUPREL(KPROJ,EKIN,PLAB,CTX,CTY,CTZ)
  18
  19 #include "geant321/dblprc.inc"
  20 #include "geant321/dimpar.inc"
  21 #include "geant321/iounit.inc"
  22 C
  23 C     Last change on  16  september  1991  by  Alfredo Ferrari
  24 C
  25 C  HJM  24/10/88
  26 C
  27 C                 NUCLEON-PROTON ELASTIC SCATTERING EVENTS
  28 C                 PARAMETRIZATION FOR COS(THETA) SAMPLING
  29 C                                 FROM HETKFA2 / CLOTH VERSION
  30 C
  31 C ( Now also antiproton, antineutron - proton scattering )
  32 C-------------------------------------------------------------------
  33 C
  34 #include "geant321/paprop.inc"
  35 #include "geant321/finuc.inc"
  36 C
  37       AMP=AM(KPROJ)
  38       AMP2=AMP**2
  39       AMT=AM(1)
  40       AMT2=AMT**2
  41       ELAB=EKIN + AMP
  42       S=AMT2 + AMP2 + 2.D0*AMT*ELAB
  43       WS=SQRT(S)
  44       BGAM=PLAB/WS
  45       GAM=(ELAB + AMT)/WS
  46       ECMP=(S + AMP2 - AMT2)*0.5D0/WS
  47       PCM=SQRT((ECMP + AMP)*(ECMP - AMP))
  48       ECMT=WS - ECMP
  49 *  +-------------------------------------------------------------------*
  50 *  |  Horrible patch for ap, an
  51       IF ( KPROJ .EQ. 2 ) THEN
  52          KSAMC = 8
  53 *  |
  54 *  +-------------------------------------------------------------------*
  55 *  |
  56       ELSE IF ( KPROJ .EQ. 9 ) THEN
  57          KSAMC = 1
  58 *  |
  59 *  +-------------------------------------------------------------------*
  60 *  |
  61       ELSE
  62          KSAMC = KPROJ
  63       END IF
  64 *  |
  65 *  +-------------------------------------------------------------------*
  66 C
  67       CALL SAMCST(KSAMC,EKIN,CST)
  68 C
  69       PCPL=PCM*CST
  70       EPF=GAM*ECMP + BGAM*PCPL
  71       PPLF=BGAM*ECMP + GAM*PCPL
  72       ETF=GAM*ECMT - BGAM*PCPL
  73       PTLF=BGAM*ECMT - GAM*PCPL
  74 C
  75       PPF=SQRT((EPF+AMP)*(EPF-AMP))
  76       CTPR=PPLF/PPF
  77       STPR=SQRT((1.D0-CTPR)*(1.D0+CTPR))
  78       PTF=SQRT((ETF+AMT)*(ETF-AMT))
  79       CTTA=PTLF/PTF
  80       STTA=SQRT((1.D0-CTTA)*(1.D0+CTTA))
  81 C
  82       CALL SFECFE(SFE,CFE)
  83       CALL TTRANS(CTX,CTY,CTZ,CTPR,STPR,SFE,CFE,CXR(1),CYR(1),CZR(1))
  84       SFE=-SFE
  85       CFE=-CFE
  86       CALL TTRANS(CTX,CTY,CTZ,CTTA,STTA,SFE,CFE,CXR(2),CYR(2),CZR(2))
  87 C
  88       NP=2
  89       KPART(1)=KPROJ
  90       KPART(2)=1
  91       TKI(1)=EPF - AMP
  92       PLR(1)=PPF
  93       TKI(2)=ETF - AMT
  94       PLR(2)=PTF
  95       TV=0.D0
  96 C
  97       RETURN
  98       END