--- /dev/null
+*
+* $Id$
+*
+* $Log$
+* Revision 1.1.1.1 1995/10/24 10:21:00 cernlib
+* Geant
+*
+*
+#include "geant321/pilot.h"
+*CMZ : 3.21/02 29/03/94 15.41.39 by S.Giani
+*-- Author :
+ SUBROUTINE CASKM(K,INT,NFL)
+C
+C *** CASCADE OF K- ***
+C *** NVE 04-MAY-1988 CERN GENEVA ***
+C
+C ORIGIN : H.FESEFELDT (13-SEP-1987)
+C
+C K- UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
+C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
+C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
+C IS DEGRADED IN ENERGY. NO OTHER PARTICLES PRODUCED.
+C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
+C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
+C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
+C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
+C
+#include "geant321/mxgkgh.inc"
+#include "geant321/s_consts.inc"
+#include "geant321/s_curpar.inc"
+#include "geant321/s_result.inc"
+#include "geant321/s_prntfl.inc"
+#include "geant321/s_kginit.inc"
+#include "geant321/limits.inc"
+C
+ REAL N
+ DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),CNK0(20),PIY1(4),
+ $ PIY2(3),IPIY1(2,4),IPIY2(2,3),IPIY3(2,3),B(2)
+ DIMENSION RNDM(1)
+ SAVE PMUL,ANORM
+ DATA CECH/1.,1.,1.,0.70,0.60,0.55,0.35,0.25,0.18,0.15/
+ DATA CNK0/0.17,0.18,0.17,0.24,0.26,0.20,0.22,0.21,0.34,0.45
+ $ ,0.58,0.55,0.36,0.29,0.29,0.32,0.32,0.33,0.33,0.33/
+ DATA PIY1/0.67,0.78,0.89,1.00/,PIY2/0.68,0.84,1.00/
+ DATA IPIY1/8,18,9,20,8,21,7,22/
+ DATA IPIY2/9,18,9,21,8,22/,IPIY3/7,18,8,20,7,21/
+ DATA B/0.7,0.7/,C/1.25/
+C
+C --- INITIALIZATION INDICATED BY KGINIT(4) ---
+ IF (KGINIT(4) .NE. 0) GO TO 10
+ KGINIT(4)=1
+C
+C --- INITIALIZE PMUL AND ANORM ARRAYS ---
+ DO 9000 J=1,1200
+ DO 9001 I=1,2
+ PMUL(I,J)=0.0
+ IF (J .LE. 60) ANORM(I,J)=0.0
+ 9001 CONTINUE
+ 9000 CONTINUE
+C
+C** COMPUTE NORMALIZATION CONSTANTS
+C** FOR P AS TARGET
+C
+ L=0
+ DO 1 NP1=1,20
+ NP=NP1-1
+ NMM1=NP1-1
+ IF(NMM1.LE.1) NMM1=1
+ NPP1=NP1+1
+ DO 1 NM1=NMM1,NPP1
+ NM=NM1-1
+ DO 1 NZ1=1,20
+ NZ=NZ1-1
+ L=L+1
+ IF(L.GT.1200) GOTO 1
+ NT=NP+NM+NZ
+ IF(NT.LE.0.OR.NT.GT.60) GOTO 1
+ PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
+ ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
+ 1 CONTINUE
+C** FOR N AS TARGET
+ L=0
+ DO 2 NP1=1,20
+ NP=NP1-1
+ NPP1=NP1+2
+ DO 2 NM1=NP1,NPP1
+ NM=NM1-1
+ DO 2 NZ1=1,20
+ NZ=NZ1-1
+ L=L+1
+ IF(L.GT.1200) GOTO 2
+ NT=NP+NM+NZ
+ IF(NT.LE.0.OR.NT.GT.60) GOTO 2
+ PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
+ ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
+ 2 CONTINUE
+ DO 3 I=1,60
+ IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
+ IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
+ 3 CONTINUE
+ IF(.NOT.NPRT(10)) GOTO 10
+ WRITE(NEWBCD,2001)
+ DO 4 NFL=1,2
+ WRITE(NEWBCD,2002) NFL
+ WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
+ WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
+ 4 CONTINUE
+C** CHOOSE PROTON OR NEUTRON AS TARGET
+ 10 NFL=2
+ CALL GRNDM(RNDM,1)
+ IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
+ TARMAS=RMASS(14)
+ IF (NFL .EQ. 2) TARMAS=RMASS(16)
+ S=AMASQ+TARMAS**2+2.0*TARMAS*EN
+ RS=SQRT(S)
+ ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
+ ENP(9)=SQRT(ENP(8))
+ EAB=RS-TARMAS-RMASS(13)
+C
+C** ELASTIC SCATTERING
+ NP=0
+ NM=0
+ NZ=0
+ N=0.
+ IPA(1)=13
+ IPA(2)=14
+ IF(NFL.EQ.2) IPA(2)=16
+ IF(INT.EQ.2) GOTO 20
+ GOTO 100
+C** CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
+ 20 IPLAB=IFIX(P*5.)+1
+ IF(IPLAB.GT.10) GOTO 22
+ CALL GRNDM(RNDM,1)
+ IF(RNDM(1).LT.CECH(IPLAB)) GOTO 19
+ IF (EAB .LT. RMASS(7)) GOTO 55
+ GOTO 22
+C** CHARGE EXCHANGE REACTION (IS INCLUDED IN INELASTIC CROSS SECTION)
+ 19 IPLAB=IFIX(P*10.)+1
+ IF(IPLAB.GT.20) IPLAB=20
+ CALL GRNDM(RNDM,1)
+ IF(RNDM(1).GT.CNK0(IPLAB)) GOTO 24
+ IF(NFL.EQ.1) GOTO 23
+C** FOR K- N REACTION NO K N STRANGENESS EXCHANGE POSSIBLE
+ INT=1
+ IPA(1)=13
+ IPA(2)=16
+ GOTO 100
+ 23 INT=1
+ IPA(1)=12
+ IPA(2)=16
+ GOTO 100
+C** P L, P S REACTIONS
+ 24 CALL GRNDM(RNDM,1)
+ RAN=RNDM(1)
+ IF(RAN.LT.0.25) GOTO 25
+ IF(RAN.LT.0.50) GOTO 26
+ IF(RAN.LT.0.75) GOTO 27
+C** K- P --> PI0 L OR K- N --> PI- L
+ IPA(1)=8
+ IF(NFL.EQ.2) IPA(1)=9
+ IPA(2)=18
+ GOTO 100
+C** K- P --> PI- S+
+ 25 IPA(1)=9
+ IPA(2)=20
+ IF(NFL.EQ.1) GOTO 100
+ IPA(1)=13
+ IPA(2)=16
+ GOTO 100
+C** K- P --> PI0 S0 OR K- N --> PI- S0
+ 26 IPA(1)=8
+ IF(NFL.EQ.2) IPA(1)=9
+ IPA(2)=21
+ GOTO 100
+C** K- P --> PI+ S- OR K- N --> PI0 S-
+ 27 IPA(1)=7
+ IF(NFL.EQ.2) IPA(1)=8
+ IPA(2)=22
+ GOTO 100
+C
+ 22 ALEAB=LOG(EAB)
+C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
+ N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
+ * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
+ N=N-2.
+C** NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION
+ ANPN=0.
+ DO 21 NT=1,60
+ TEST=-(PI/4.0)*(NT/N)**2
+ IF (TEST .LT. EXPXL) TEST=EXPXL
+ IF (TEST .GT. EXPXU) TEST=EXPXU
+ DUM1=PI*NT/(2.0*N*N)
+ DUM2=ABS(DUM1)
+ DUM3=EXP(TEST)
+ ADDNVE=0.0
+ IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+ IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+ ANPN=ANPN+ADDNVE
+ 21 CONTINUE
+ ANPN=1./ANPN
+C** P OR N AS TARGET
+ CALL GRNDM(RNDM,1)
+ RAN=RNDM(1)
+ EXCS=0.
+ GOTO (30,40),NFL
+C** FOR P AS TARGET
+ 30 L=0
+ DO 31 NP1=1,20
+ NP=NP1-1
+ NMM1=NP1-1
+ IF(NMM1.LE.1) NMM1=1
+ NPP1=NP1+1
+ DO 31 NM1=NMM1,NPP1
+ NM=NM1-1
+ DO 31 NZ1=1,20
+ NZ=NZ1-1
+ L=L+1
+ IF(L.GT.1200) GOTO 31
+ NT=NP+NM+NZ
+ IF(NT.LE.0.OR.NT.GT.60) GOTO 31
+ TEST=-(PI/4.0)*(NT/N)**2
+ IF (TEST .LT. EXPXL) TEST=EXPXL
+ IF (TEST .GT. EXPXU) TEST=EXPXU
+ DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
+ DUM2=ABS(DUM1)
+ DUM3=EXP(TEST)
+ ADDNVE=0.0
+ IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+ IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+ EXCS=EXCS+ADDNVE
+ IF(RAN.LT.EXCS) GOTO 50
+ 31 CONTINUE
+ GOTO 80
+C** FOR N AS TARGET
+ 40 L=0
+ DO 41 NP1=1,20
+ NP=NP1-1
+ NPP1=NP1+2
+ DO 41 NM1=NP1,NPP1
+ NM=NM1-1
+ DO 41 NZ1=1,20
+ NZ=NZ1-1
+ L=L+1
+ IF(L.GT.1200) GOTO 41
+ NT=NP+NM+NZ
+ IF(NT.LE.0.OR.NT.GT.60) GOTO 41
+ TEST=-(PI/4.0)*(NT/N)**2
+ IF (TEST .LT. EXPXL) TEST=EXPXL
+ IF (TEST .GT. EXPXU) TEST=EXPXU
+ DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
+ DUM2=ABS(DUM1)
+ DUM3=EXP(TEST)
+ ADDNVE=0.0
+ IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
+ IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
+ EXCS=EXCS+ADDNVE
+ IF(RAN.LT.EXCS) GOTO 50
+ 41 CONTINUE
+ GOTO 80
+ 50 GOTO (60,65),NFL
+ 60 IF(NP.EQ.NM) GOTO 61
+ IF(NP.EQ.1+NM) GOTO 63
+ IPA(1)=12
+ IPA(2)=14
+ GOTO 90
+ 61 CALL GRNDM(RNDM,1)
+ IF(RNDM(1).LT.0.75) GOTO 62
+ IPA(1)=12
+ IPA(2)=16
+ GOTO 90
+ 62 IPA(1)=13
+ IPA(2)=14
+ GOTO 90
+ 63 IPA(1)=13
+ IPA(2)=16
+ GOTO 90
+ 65 IF(NP.EQ.-1+NM) GOTO 66
+ IF(NP.EQ.NM) GOTO 68
+ IPA(1)=12
+ IPA(2)=16
+ GOTO 90
+ 66 CALL GRNDM(RNDM,1)
+ IF(RNDM(1).LT.0.50) GOTO 67
+ IPA(1)=12
+ IPA(2)=16
+ GOTO 90
+ 67 IPA(1)=13
+ IPA(2)=14
+ GOTO 90
+ 68 IPA(1)=13
+ IPA(2)=16
+C** PI Y PRODUCTION INSTEAD OF K N
+ 90 CALL GRNDM(RNDM,1)
+ IF(RNDM(1).LT.0.5) GOTO 100
+ IF(IPA(1).EQ.13.AND.IPA(2).EQ.16) GOTO 95
+ IF(IPA(1).EQ.11.AND.IPA(2).EQ.14) GOTO 95
+ IF(IPA(1).EQ.12.AND.IPA(2).EQ.14) GOTO 95
+ CALL GRNDM(RNDM,1)
+ RAN=RNDM(1)
+ DO 91 I=1,4
+ IF(RAN.LT.PIY1(I)) GOTO 92
+ 91 CONTINUE
+ GOTO 100
+ 92 IPA(1)=IPIY1(1,I)
+ IPA(2)=IPIY1(2,I)
+ GOTO 100
+ 95 CALL GRNDM(RNDM,1)
+ RAN=RNDM(1)
+ DO 96 I=1,3
+ IF(RAN.LT.PIY2(I)) GOTO 97
+ 96 CONTINUE
+ GOTO 100
+ 97 IF(IPA(2).EQ.14) GOTO 98
+ IPA(1)=IPIY2(1,I)
+ IPA(2)=IPIY2(2,I)
+ GOTO 100
+ 98 IPA(1)=IPIY3(1,I)
+ IPA(2)=IPIY3(2,I)
+ GOTO 100
+ 70 IF(NPRT(4))
+ *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
+ CALL STPAIR
+ IF(INT.EQ.1) CALL TWOB(13,NFL,N)
+ IF(INT.EQ.2) CALL GENXPT(13,NFL,N)
+ GO TO 9999
+C** NUCLEAR EXCITATION
+ 55 IF(NPRT(4))
+ *WRITE(NEWBCD,1001)
+ GOTO 53
+C** EXCLUSIVE REACTION NOT FOUND
+ 80 IF(NPRT(4))
+ *WRITE(NEWBCD,1004) RS,N
+ 53 INT=1
+ NP=0
+ NM=0
+ NZ=0
+ N=0.
+ IPA(1)=13
+ IPA(2)=14
+ IF(NFL.EQ.2) IPA(2)=16
+ 100 DO 101 I=3,60
+ 101 IPA(I)=0
+ IF(INT.LE.0) GOTO 131
+ 120 NT=2
+ IF(NP.EQ.0) GOTO 122
+ DO 121 I=1,NP
+ NT=NT+1
+ 121 IPA(NT)=7
+ 122 IF(NM.EQ.0) GOTO 124
+ DO 123 I=1,NM
+ NT=NT+1
+ 123 IPA(NT)=9
+ 124 IF(NZ.EQ.0) GOTO 130
+ DO 125 I=1,NZ
+ NT=NT+1
+ 125 IPA(NT)=8
+ 130 IF(NPRT(4))
+ *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
+ DO 132 I=1,NT
+ IF(IPA(I).NE.12) GOTO 132
+ CALL GRNDM(RNDM,1)
+ IF(RNDM(1).LT.0.5) GOTO 132
+ IPA(I)=11
+ 132 CONTINUE
+ GOTO 70
+ 131 IF(NPRT(4))
+ *WRITE(NEWBCD,2005)
+C
+1001 FORMAT('0*CASKM* CASCADE ENERGETICALLY NOT POSSIBLE',
+ $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
+1003 FORMAT(' *CASKM* KAON- -INDUCED CASCADE,',
+ $ ' AVAIL. ENERGY',2X,F8.4,
+ $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
+1004 FORMAT(' *CASKM* KAON- -INDUCED CASCADE,',
+ $ ' EXCLUSIVE REACTION NOT FOUND',
+ $ ' TRY ELASTIC SCATTERING AVAIL. ENERGY',2X,F8.4,2X,
+ $ '<NTOT>',2X,F8.4)
+2001 FORMAT('0*CASKM* TABLES FOR MULT. DATA KAON- INDUCED REACTION',
+ $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
+2002 FORMAT(' *CASKM* TARGET PARTICLE FLAG',2X,I5)
+2003 FORMAT(1H ,10E12.4)
+2004 FORMAT(' *CASKM* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
+2005 FORMAT(' *CASKM* NO PARTICLES PRODUCED')
+C
+ 9999 CONTINUE
+ END
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff