GEANT321/gheisha/casl0.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:02  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.39  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE CASL0(K,INT,NFL)
  13 C
  14 C *** CASCADE OF LAMBDA ***
  15 C *** NVE 04-MAY-1988 CERN GENEVA ***
  16 C
  17 C ORIGIN : H.FESEFELDT (13-SEP-1987)
  18 C
  19 C L0  UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS.
  20 C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS.
  21 C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE
  22 C IS DEGRADED IN ENERGY.    NO OTHER PARTICLES PRODUCED.
  23 C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/
  24 C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA.
  25 C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS
  26 C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS.
  27 C
  28 #include "geant321/mxgkgh.inc"
  29 #include "geant321/s_consts.inc"
  30 #include "geant321/s_curpar.inc"
  31 #include "geant321/s_result.inc"
  32 #include "geant321/s_prntfl.inc"
  33 #include "geant321/s_kginit.inc"
  34 #include "geant321/limits.inc"
  35 C
  36       REAL N
  37       DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),IIPA(10,2),B(2)
  38       DIMENSION RNDM(2)
  39       SAVE PMUL,ANORM
  40       DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./
  41       DATA IIPA/20,21,14,14,16,21,22,16,16,14,
  42      *          16,14,18,21,20,16,14,18,21,22/
  43       DATA B/0.7,0.7/,C/1.25/
  44 C
  45 C --- INITIALIZATION INDICATED BY KGINIT(8) ---
  46       IF (KGINIT(8) .NE. 0) GO TO 10
  47       KGINIT(8)=1
  48 C
  49 C --- INITIALIZE PMUL AND ANORM ARRAYS ---
  50       DO 9000 J=1,1200
  51       DO 9001 I=1,2
  52       PMUL(I,J)=0.0
  53       IF (J .LE. 60) ANORM(I,J)=0.0
  54  9001 CONTINUE
  55  9000 CONTINUE
  56 C
  57 C** COMPUTE NORMALIZATION CONSTANTS
  58 C** FOR N AS TARGET
  59 C
  60       L=0
  61       DO 1 NP1=1,20
  62       NP=NP1-1
  63       NMM1=NP1-1
  64       IF(NMM1.LE.0) NMM1=1
  65       NPP1=NP1+2
  66       DO 1 NM1=NMM1,NPP1
  67       NM=NM1-1
  68       DO 1 NZ1=1,20
  69       NZ=NZ1-1
  70       L=L+1
  71       IF(L.GT.1200) GOTO 1
  72       NT=NP+NM+NZ
  73       IF(NT.LE.0.OR.NT.GT.60) GOTO 1
  74       PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
  75       ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
  76     1 CONTINUE
  77 C** FOR P AS TARGET
  78       L=0
  79       DO 2 NP1=1,20
  80       NP=NP1-1
  81       NMM1=NP1-2
  82       IF(NMM1.LE.1) NMM1=1
  83       NPP1=NP1+1
  84       DO 2 NM1=NMM1,NPP1
  85       NM=NM1-1
  86       DO 2 NZ1=1,20
  87       NZ=NZ1-1
  88       L=L+1
  89       IF(L.GT.1200) GOTO 2
  90       NT=NP+NM+NZ
  91       IF(NT.LE.0.OR.NT.GT.60) GOTO 2
  92       PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
  93       ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
  94     2 CONTINUE
  95       DO 3 I=1,60
  96       IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
  97       IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
  98     3 CONTINUE
  99       IF(.NOT.NPRT(10)) GOTO 10
 100       WRITE(NEWBCD,2001)
 101       DO 4 NFL=1,2
 102       WRITE(NEWBCD,2002) NFL
 103       WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
 104       WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
 105     4 CONTINUE
 106 C**  CHOOSE PROTON OR NEUTRON AS TARGET
 107    10 NFL=2
 108       CALL GRNDM(RNDM,1)
 109       IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
 110       TARMAS=RMASS(14)
 111       IF (NFL .EQ. 2) TARMAS=RMASS(16)
 112       S=AMASQ+TARMAS**2+2.0*TARMAS*EN
 113       RS=SQRT(S)
 114       ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
 115       ENP(9)=SQRT(ENP(8))
 116       EAB=RS-TARMAS-RMASS(18)
 117 C**  ELASTIC SCATTERING
 118       NP=0
 119       NM=0
 120       NZ=0
 121       N=0.
 122       IPA(1)=18
 123       IPA(2)=14
 124       IF(NFL.EQ.2) IPA(2)=16
 125       IF(INT.EQ.2) GOTO 20
 126 C** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTIONS
 127 C** LP --> S+N, LP --> S0 P , LN --> S0 N , LN --> S- P
 128 C** LP --> P L, LP --> P S0 , LP --> N S+
 129 C** LN --> N L, LN --> N S0 , LN --> P S-
 130       IPLAB=IFIX(P*2.5)+1
 131       IF(IPLAB.GT.10) IPLAB=10
 132       CALL GRNDM(RNDM,1)
 133       IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 120
 134       CALL GRNDM(RNDM,1)
 135       RAN=RNDM(1)
 136       IRN=IFIX(RAN/0.2)+1
 137       IF(IRN.GT.5) IRN=5
 138       IRN=IRN+(NFL-1)*5
 139       IPA(1)=IIPA(IRN,1)
 140       IPA(2)=IIPA(IRN,2)
 141       GOTO 120
 142 C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
 143   20  IF (EAB .LE. RMASS(7)) GOTO 55
 144       ALEAB=LOG(EAB)
 145 C** NO. OF TOTAL PARTICLES VS SQRT(S)-MP-MSM
 146       N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
 147      * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
 148       N=N-2.
 149 C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
 150       ANPN=0.
 151       DO 21 NT=1,60
 152       TEST=-(PI/4.0)*(NT/N)**2
 153       IF (TEST .LT. EXPXL) TEST=EXPXL
 154       IF (TEST .GT. EXPXU) TEST=EXPXU
 155       DUM1=PI*NT/(2.0*N*N)
 156       DUM2=ABS(DUM1)
 157       DUM3=EXP(TEST)
 158       ADDNVE=0.0
 159       IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
 160       IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
 161       ANPN=ANPN+ADDNVE
 162    21 CONTINUE
 163       ANPN=1./ANPN
 164 C** P OR N AS TARGET
 165       CALL GRNDM(RNDM,1)
 166       RAN=RNDM(1)
 167       EXCS=0.
 168       GOTO (40,30),NFL
 169 C** FOR N AS TARGET
 170    30 L=0
 171       DO 31 NP1=1,20
 172       NP=NP1-1
 173       NMM1=NP1-1
 174       IF(NMM1.LE.0) NMM1=1
 175       NPP1=NP1+2
 176       DO 31 NM1=NMM1,NPP1
 177       NM=NM1-1
 178       DO 31 NZ1=1,20
 179       NZ=NZ1-1
 180       L=L+1
 181       IF(L.GT.1200) GOTO 31
 182       NT=NP+NM+NZ
 183       IF(NT.LE.0.OR.NT.GT.60) GOTO 31
 184       TEST=-(PI/4.0)*(NT/N)**2
 185       IF (TEST .LT. EXPXL) TEST=EXPXL
 186       IF (TEST .GT. EXPXU) TEST=EXPXU
 187       DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
 188       DUM2=ABS(DUM1)
 189       DUM3=EXP(TEST)
 190       ADDNVE=0.0
 191       IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
 192       IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
 193       EXCS=EXCS+ADDNVE
 194       IF(RAN.LT.EXCS) GOTO 100
 195    31 CONTINUE
 196       GOTO 80
 197 C** FOR P AS TARGET
 198    40 L=0
 199       DO 41 NP1=1,20
 200       NP=NP1-1
 201       NMM1=NP1-2
 202       IF(NMM1.LE.1) NMM1=1
 203       NPP1=NP1+1
 204       DO 41 NM1=NMM1,NPP1
 205       NM=NM1-1
 206       DO 41 NZ1=1,20
 207       NZ=NZ1-1
 208       L=L+1
 209       IF(L.GT.1200) GOTO 41
 210       NT=NP+NM+NZ
 211       IF(NT.LE.0.OR.NT.GT.60) GOTO 41
 212       TEST=-(PI/4.0)*(NT/N)**2
 213       IF (TEST .LT. EXPXL) TEST=EXPXL
 214       IF (TEST .GT. EXPXU) TEST=EXPXU
 215       DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
 216       DUM2=ABS(DUM1)
 217       DUM3=EXP(TEST)
 218       ADDNVE=0.0
 219       IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3
 220       IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
 221       EXCS=EXCS+ADDNVE
 222       IF(RAN.LT.EXCS) GOTO 100
 223    41 CONTINUE
 224       GOTO 80
 225    50 IF(NPRT(4))
 226      *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
 227       IF(INT.EQ.1) CALL TWOB(18,NFL,N)
 228       IF(INT.EQ.2) CALL GENXPT(18,NFL,N)
 229       GO TO 9999
 230    55 IF(NPRT(4))
 231      *WRITE(NEWBCD,1001)
 232       GOTO 53
 233 C** EXCLUSIVE REACTION NOT FOUND
 234    80 IF(NPRT(4))
 235      *WRITE(NEWBCD,1004) RS,N
 236    53 INT=1
 237       NP=0
 238       NM=0
 239       NZ=0
 240       IPA(1)=18
 241       IPA(2)=14
 242       IF(NFL.EQ.2) IPA(2)=16
 243       GOTO 120
 244   100 DO 101 I=1,60
 245   101 IPA(I)=0
 246       IF(INT.LE.0) GOTO 131
 247       GOTO (112,102),NFL
 248   102 NCHT=NP-NM
 249       NCHT=NCHT+3
 250       IF(NCHT.LE.0) NCHT=1
 251       IF(NCHT.GT.4) NCHT=4
 252       GOTO (103,104,105,106),NCHT
 253   103 IPA(1)=20
 254       IPA(2)=14
 255       GOTO 120
 256   104 IPA(1)=18
 257       CALL GRNDM(RNDM,2)
 258       IF(RNDM(1).LT.0.5) IPA(1)=21
 259       IPA(2)=14
 260       IF(RNDM(2).LT.0.5) GOTO 120
 261       IPA(1)=20
 262       IPA(2)=16
 263       GOTO 120
 264   105 IPA(1)=18
 265       CALL GRNDM(RNDM,2)
 266       IF(RNDM(1).LT.0.5) IPA(1)=21
 267       IPA(2)=16
 268       IF(RNDM(2).LT.0.5) GOTO 120
 269       IPA(1)=22
 270       IPA(2)=14
 271       GOTO 120
 272   106 IPA(1)=22
 273       IPA(2)=16
 274       GOTO 120
 275   112 NCHT=NP-NM
 276       NCHT=NCHT+2
 277       IF(NCHT.LE.0) NCHT=1
 278       IF(NCHT.GT.4) NCHT=4
 279       GOTO (113,114,115,116),NCHT
 280   113 IPA(1)=20
 281       IPA(2)=14
 282       GOTO 120
 283   114 IPA(1)=18
 284       CALL GRNDM(RNDM,2)
 285       IF(RNDM(1).LT.0.5) IPA(1)=21
 286       IPA(2)=14
 287       IF(RNDM(2).LT.0.5) GOTO 120
 288       IPA(1)=20
 289       IPA(2)=16
 290       GOTO 120
 291   115 IPA(1)=18
 292       CALL GRNDM(RNDM,2)
 293       IF(RNDM(1).LT.0.5) IPA(1)=21
 294       IPA(2)=16
 295       IF(RNDM(2).LT.0.5) GOTO 120
 296       IPA(1)=22
 297       IPA(2)=14
 298       GOTO 120
 299   116 IPA(1)=22
 300       IPA(2)=16
 301   120 NT=2
 302       IF(NP.EQ.0) GOTO 122
 303       DO 121 I=1,NP
 304       NT=NT+1
 305   121 IPA(NT)=7
 306   122 IF(NM.EQ.0) GOTO 124
 307       DO 123 I=1,NM
 308       NT=NT+1
 309   123 IPA(NT)=9
 310   124 IF(NZ.EQ.0) GOTO 130
 311       DO 125 I=1,NZ
 312       NT=NT+1
 313   125 IPA(NT)=8
 314   130 IF(NPRT(4))
 315      *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
 316       GOTO 50
 317   131 IF(NPRT(4))
 318      *WRITE(NEWBCD,2005)
 319 C
 320 1001  FORMAT('0*CASL0* CASCADE ENERGETICALLY NOT POSSIBLE',
 321      $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
 322 1003  FORMAT(' *CASL0* LAMBDA-INDUCED CASCADE,',
 323      $ ' AVAIL. ENERGY',2X,F8.4,
 324      $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
 325 1004  FORMAT(' *CASL0* LAMBDA-INDUCED CASCADE,',
 326      $ ' EXCLUSIVE REACTION NOT FOUND',
 327      $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,2X,
 328      $ '<NTOT>',2X,F8.4)
 329 2001  FORMAT('0*CASL0* TABLES FOR MULT. DATA LAMBDA INDUCED REACTION',
 330      $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
 331 2002  FORMAT(' *CASL0* TARGET PARTICLE FLAG',2X,I5)
 332 2003  FORMAT(1H ,10E12.4)
 333 2004  FORMAT(' *CASL0* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
 334 2005  FORMAT(' *CASL0* NO PARTICLES PRODUCED')
 335 C
 336  9999 CONTINUE
 337       END