]> git.uio.no Git - u/mrichter/AliRoot.git/blobdiff - GEANT321/neutron/cmlabi.F
Merging the VirtualMC branch to the main development branch (HEAD)
[u/mrichter/AliRoot.git] / GEANT321 / neutron / cmlabi.F
diff --git a/GEANT321/neutron/cmlabi.F b/GEANT321/neutron/cmlabi.F
deleted file mode 100644 (file)
index bf50ffc..0000000
+++ /dev/null
@@ -1,128 +0,0 @@
-*
-* $Id$
-*
-* $Log$
-* Revision 1.1.1.1  1995/10/24 10:21:55  cernlib
-* Geant
-*
-*
-#include "geant321/pilot.h"
-*CMZ :  3.21/02 29/03/94  15.41.48  by  S.Giani
-*-- Author :
-      SUBROUTINE CMLABI(D,LD,AWR,KZ,ID,FM,Q,IFLG,LIFLAG,LRI)
-C       THIS ROUTINE CONVERTS THE EXIT NEUTRON SCATTERING ANGLE
-C       FROM THE CENTER OF MASS COORDINATE SYSTEM TO THE LABORATORY
-C       COORDINATE SYSTEM FOR AN INELASTIC SCATTERING REACTION. IT
-C       ALSO CALCULATES THE EXIT ENERGIES AND DIRECTIONAL COSINES
-C       FOR THE NEUTRON AND RECOIL NUCLEUS AS WELL AS SETTING ALL
-C       EXIT PARAMETERS FOR THE RECOIL NUCLEUS.
-#include "geant321/minput.inc"
-#include "geant321/mconst.inc"
-#include "geant321/mnutrn.inc"
-#include "geant321/mrecoi.inc"
-#include "geant321/mapoll.inc"
-#include "geant321/mmass.inc"
-#include "geant321/mpstor.inc"
-      DIMENSION D(*),LD(*)
-      SAVE
-      MT=0
-      IF((ID.GE.14).AND.(ID.LE.54))MT=51
-      IF(MT.NE.51)GO TO 10
-      IMT=ID-14
-      MT=MT+IMT
-   10 IF(ID.EQ.11)MT=22
-      IF(ID.EQ.13)MT=28
-C       IFLG EQUAL TO ONE IMPLIES LABORATORY COORDINATE SYSTEM
-      IF(LIFLAG.EQ.1)GO TO 60
-      IF(IFLG.EQ.1)GO TO 20
-C       E1 EQUALS THE EXIT ENERGY IN THE COM SYSTEM
-      E1=((AWR/(AWR+1.0))**2)*EOLD+Q*(AWR/(AWR+1.0))
-C re-sample in COLISN E1<0.0 (Q-value = -EOLD) !!!
-      IF(E1.LT.0.0) THEN
-         IFLG = -1
-         RETURN
-      ENDIF
-C       E2 EQUALS THE EXIT ENERGY IN THE LAB SYSTEM
-      E2=E1+(EOLD+2.0*FM*(AWR+1.0)*SQRT(EOLD*E1))/((AWR+1.0)**2)
-C       CALCULATE COSINE OF SCATTERING ANGLE FM IN LAB SYSTEM
-      FM=(SQRT(E1/E2))*FM+(SQRT(EOLD/E2))*(1.0/(AWR+1.0))
-      E=E2
-C       CALCULATE THE NEUTRON EXIT DIRECTIONAL COSINES
-   20 SINPSI=SQRT(1.0-FM**2)
-      CALL AZIRN(SINETA,COSETA)
-      STHETA=1.0-UOLD**2
-      IF(STHETA)40,40,30
-   30 STHETA=SQRT(STHETA)
-      COSPHI=VOLD/STHETA
-      SINPHI=WOLD/STHETA
-      GO TO 50
-   40 COSPHI=1.0
-      SINPHI=0.0
-      STHETA=0.0
-   50 U=UOLD*FM-COSETA*SINPSI*STHETA
-      V=VOLD*FM+UOLD*COSPHI*COSETA*SINPSI-SINPHI*SINPSI*SINETA
-      W=WOLD*FM+UOLD*SINPHI*COSETA*SINPSI+COSPHI*SINPSI*SINETA
-      S=1.0/SQRT(U**2+V**2+W**2)
-      U=U*S
-      V=V*S
-      W=W*S
-      IF(MT.EQ.91)LIFLAG=1
-      IF(MT.EQ.22)LIFLAG=1
-      IF(MT.EQ.28)LIFLAG=1
-      IF(LIFLAG.EQ.1)GO TO 60
-C       CALCULATE AND SET THE RECOIL NUCLEUS EXIT PARAMETERS
-      ER=EOLD-E+Q
-   60 XR=X
-      YR=Y
-      ZR=Z
-      WATER=WTBC
-      NZR=KZ
-      AGER=AGE
-      NCOLR=NCOL
-      MTNR=MT
-      AR=AWR*AN
-      ENIR=EOLD
-      UNIR=UOLD
-      VNIR=VOLD
-      WNIR=WOLD
-      ENOR=E
-      UNOR=U
-      VNOR=V
-      WNOR=W
-      WTNR=WATE
-      QR=Q
-C       CALCULATE THE NEUTRON MOMENTUM BEFORE AND AFTER COLLISION
-C       NEUTRON MOMENTUM BEFORE COLLISION (PI) EQUALS TOTAL MOMENTUM
-      PI=SQRT(2.0*ZN*EOLD)
-      PO=SQRT(2.0*ZN*E)
-C       CALCULATE THE DIRECTIONAL MOMENTUM OF THE RECOIL NUCLEUS
-      PRX=PI*UOLD-PO*U
-      PRY=PI*VOLD-PO*V
-      PRZ=PI*WOLD-PO*W
-C       CALCULATE THE TOTAL MOMENTUM OF THE RECOIL NUCLEUS
-      PR=SQRT(PRX**2+PRY**2+PRZ**2)
-C       CALCULATE THE RECOIL NUCLEUS DIRECTIONAL COSINES
-      UR=PRX/PR
-      VR=PRY/PR
-      WR=PRZ/PR
-C       CALCULATE THE RECOIL HEAVY ION ENERGY FOR MT-91
-      IF(LIFLAG.EQ.0)GO TO 70
-      XM = AR*931.075E6
-      ER= SQRT(PR**2 + XM**2) - XM
-   70 CONTINUE
-C       IF LR-FLAG IS USED, DO NOT STORE RECOIL ION AT THIS TIME
-      IF(LRI.EQ.22)RETURN
-      IF(LRI.EQ.23)RETURN
-      IF(LRI.EQ.28)RETURN
-C       STORE THE  RECOIL HEAVY ION IN THE RECOIL BANK
-      EP = ER
-      UP = UR
-      VP = VR
-      WP = WR
-      AGEP = AGE
-      MTP = MT
-      AMP = AR
-      ZMP = FLOAT(NZR)
-      CALL STOPAR(IDHEVY,NHEVY)
-      RETURN
-      END