GEANT321/gheisha/cask0.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:01  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 CASK0(K,INT,NFL)
  13 C
  14 C *** CASCADE OF K0 ***
  15 C *** NVE 04-MAY-1988 CERN GENEVA ***
  16 C
  17 C ORIGIN : H.FESEFELDT (13-SEP-1987)
  18 C
  19 C K0  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),SUPP(10),CECH(10),B(2)
  38       DIMENSION RNDM(1)
  39       SAVE PMUL,ANORM
  40       DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/
  41       DATA CECH/0.33,0.27,0.29,0.31,0.27,0.18,0.13,0.10,0.09,0.07/
  42       DATA B/0.7,0.7/,C/1.25/
  43 C
  44 C --- INITIALIZATION INDICATED BY KGINIT(6) ---
  45       IF (KGINIT(6) .NE. 0) GO TO 10
  46       KGINIT(6)=1
  47 C
  48 C --- INITIALIZE PMUL AND ANORM ARRAYS ---
  49       DO 9000 J=1,1200
  50       DO 9001 I=1,2
  51       PMUL(I,J)=0.0
  52       IF (J .LE. 60) ANORM(I,J)=0.0
  53  9001 CONTINUE
  54  9000 CONTINUE
  55 C
  56 C** COMPUTE NORMALIZATION CONSTANTS
  57 C** FOR P AS TARGET
  58 C
  59       L=0
  60       DO 1 NP1=1,20
  61       NP=NP1-1
  62       NMM1=NP1-1
  63       IF(NMM1.LE.1) NMM1=1
  64       NPP1=NP1+1
  65       DO 1 NM1=NMM1,NPP1
  66       NM=NM1-1
  67       DO 1 NZ1=1,20
  68       NZ=NZ1-1
  69       L=L+1
  70       IF(L.GT.1200) GOTO 1
  71       NT=NP+NM+NZ
  72       IF(NT.LE.0.OR.NT.GT.60) GOTO 1
  73       PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C)
  74       ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L)
  75     1 CONTINUE
  76 C** FOR N AS TARGET
  77       L=0
  78       DO 2 NP1=1,20
  79       NP=NP1-1
  80       NMM1=NP1-2
  81       IF(NMM1.LE.1) NMM1=1
  82       DO 2 NM1=NMM1,NP1
  83       NM=NM1-1
  84       DO 2 NZ1=1,20
  85       NZ=NZ1-1
  86       L=L+1
  87       IF(L.GT.1200) GOTO 2
  88       NT=NP+NM+NZ
  89       IF(NT.LE.0.OR.NT.GT.60) GOTO 2
  90       PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C)
  91       ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L)
  92     2 CONTINUE
  93       DO 3 I=1,60
  94       IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I)
  95       IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I)
  96     3 CONTINUE
  97       IF(.NOT.NPRT(10)) GOTO 10
  98       WRITE(NEWBCD,2001)
  99       DO 4 NFL=1,2
 100       WRITE(NEWBCD,2002) NFL
 101       WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60)
 102       WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200)
 103     4 CONTINUE
 104 C**  CHOOSE PROTON OR NEUTRON AS TARGET
 105    10 NFL=2
 106       CALL GRNDM(RNDM,1)
 107       IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1
 108       TARMAS=RMASS(14)
 109       IF (NFL .EQ. 2) TARMAS=RMASS(16)
 110       S=AMASQ+TARMAS**2+2.0*TARMAS*EN
 111       RS=SQRT(S)
 112       ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6)
 113       ENP(9)=SQRT(ENP(8))
 114       EAB=RS-TARMAS-RMASS(11)
 115 C
 116 C**  ELASTIC SCATTERING
 117       NP=0
 118       NM=0
 119       NZ=0
 120       N=0.
 121       IPA(1)=11
 122       IPA(2)=14
 123       IF(NFL.EQ.2) IPA(2)=16
 124       IF(INT.EQ.2) GOTO 20
 125 C**  FOR K0 P REACTIONS CHANGE SOME OF THE ELASTIC CROSS SECTION
 126 C**  TO K0 P --> K+ N
 127       IF(NFL.EQ.2) GOTO 100
 128       IPLAB=IFIX(P   *5.)+1
 129       IF(IPLAB.GT.10) IPLAB=10
 130       CALL GRNDM(RNDM,1)
 131       IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100
 132       IPA(1)=10
 133       IPA(2)=16
 134       GOTO 100
 135 C**  CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT.
 136   20  IF (EAB .LE. RMASS(7)) GOTO 55
 137 C**  SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM
 138       IEAB=IFIX(EAB*5.)+1
 139       IF(IEAB.GT.10) GOTO 22
 140       CALL GRNDM(RNDM,1)
 141       IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22
 142       N=1.
 143       GOTO (24,23),NFL
 144  23   CONTINUE
 145       TEST=-(1+B(1))**2/(2.0*C**2)
 146       IF (TEST .LT. EXPXL) TEST=EXPXL
 147       IF (TEST .GT. EXPXU) TEST=EXPXU
 148       W0=EXP(TEST)
 149       TEST=-(-1+B(1))**2/(2.0*C**2)
 150       IF (TEST .LT. EXPXL) TEST=EXPXL
 151       IF (TEST .GT. EXPXU) TEST=EXPXU
 152       WM=EXP(TEST)
 153       W0=W0/2.0
 154       WM=WM*1.5
 155       CALL GRNDM(RNDM,1)
 156       RAN=RNDM(1)
 157       NP=0
 158       NM=0
 159       NZ=1
 160       IF(RAN.LT.W0/(W0+WM)) GOTO 50
 161       NP=0
 162       NM=1
 163       NZ=0
 164       GOTO 50
 165  24   CONTINUE
 166       TEST=-(1+B(2))**2/(2.0*C**2)
 167       IF (TEST .LT. EXPXL) TEST=EXPXL
 168       IF (TEST .GT. EXPXU) TEST=EXPXU
 169       W0=EXP(TEST)
 170       WP=EXP(TEST)
 171       TEST=-(-1+B(2))**2/(2.0*C**2)
 172       IF (TEST .LT. EXPXL) TEST=EXPXL
 173       IF (TEST .GT. EXPXU) TEST=EXPXU
 174       WM=EXP(TEST)
 175       WT=W0+WP+WM
 176       WP=W0+WP
 177       CALL GRNDM(RNDM,1)
 178       RAN=RNDM(1)
 179       NP=0
 180       NM=0
 181       NZ=1
 182       IF(RAN.LT.W0/WT) GOTO 50
 183       NP=1
 184       NM=0
 185       NZ=0
 186       IF(RAN.LT.WP/WT) GOTO 50
 187       NP=0
 188       NM=1
 189       NZ=0
 190       GOTO 50
 191 C
 192    22 ALEAB=LOG(EAB)
 193 C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP
 194       N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB
 195      * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB
 196       N=N-2.
 197 C** NORMALIZATION CONSTANT FOR  KNO-DISTRIBUTION
 198       ANPN=0.
 199       DO 21 NT=1,60
 200       TEST=-(PI/4.0)*(NT/N)**2
 201       IF (TEST .LT. EXPXL) TEST=EXPXL
 202       IF (TEST .GT. EXPXU) TEST=EXPXU
 203       DUM1=PI*NT/(2.0*N*N)
 204       DUM2=ABS(DUM1)
 205       DUM3=EXP(TEST)
 206       ADDNVE=0.0
 207       IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
 208       IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
 209       ANPN=ANPN+ADDNVE
 210    21 CONTINUE
 211       ANPN=1./ANPN
 212 C** P OR N AS TARGET
 213       CALL GRNDM(RNDM,1)
 214       RAN=RNDM(1)
 215       EXCS=0.
 216       GOTO (30,40),NFL
 217 C** FOR P AS TARGET
 218    30 L=0
 219       DO 31 NP1=1,20
 220       NP=NP1-1
 221       NMM1=NP1-1
 222       IF(NMM1.LE.1) NMM1=1
 223       NPP1=NP1+1
 224       DO 31 NM1=NMM1,NPP1
 225       NM=NM1-1
 226       DO 31 NZ1=1,20
 227       NZ=NZ1-1
 228       L=L+1
 229       IF(L.GT.1200) GOTO 31
 230       NT=NP+NM+NZ
 231       IF(NT.LE.0.OR.NT.GT.60) GOTO 31
 232       TEST=-(PI/4.0)*(NT/N)**2
 233       IF (TEST .LT. EXPXL) TEST=EXPXL
 234       IF (TEST .GT. EXPXU) TEST=EXPXU
 235       DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N)
 236       DUM2=ABS(DUM1)
 237       DUM3=EXP(TEST)
 238       ADDNVE=0.0
 239       IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
 240       IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
 241       EXCS=EXCS+ADDNVE
 242       IF(RAN.LT.EXCS) GOTO 50
 243    31 CONTINUE
 244       GOTO 80
 245 C** FOR N AS TARGET
 246    40 L=0
 247       DO 41 NP1=1,20
 248       NP=NP1-1
 249       NMM1=NP1-2
 250       IF(NMM1.LE.1) NMM1=1
 251       DO 41 NM1=NMM1,NP1
 252       NM=NM1-1
 253       DO 41 NZ1=1,20
 254       NZ=NZ1-1
 255       L=L+1
 256       IF(L.GT.1200) GOTO 41
 257       NT=NP+NM+NZ
 258       IF(NT.LE.0.OR.NT.GT.60) GOTO 41
 259       TEST=-(PI/4.0)*(NT/N)**2
 260       IF (TEST .LT. EXPXL) TEST=EXPXL
 261       IF (TEST .GT. EXPXU) TEST=EXPXU
 262       DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N)
 263       DUM2=ABS(DUM1)
 264       DUM3=EXP(TEST)
 265       ADDNVE=0.0
 266       IF (DUM2 .GE. 1) ADDNVE=DUM1*DUM3
 267       IF ((DUM2 .LT. 1) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3
 268       EXCS=EXCS+ADDNVE
 269       IF(RAN.LT.EXCS) GOTO 50
 270    41 CONTINUE
 271       GOTO 80
 272    50 GOTO (65,60),NFL
 273    60 IF(NP.EQ.1+NM) GOTO 61
 274       IF(NP.EQ.2+NM) GOTO 63
 275       IPA(1)=11
 276       IPA(2)=16
 277       GOTO 100
 278    61 CALL GRNDM(RNDM,1)
 279       IF(RNDM(1).LT.0.5) GOTO 62
 280       IPA(1)=11
 281       IPA(2)=14
 282       GOTO 100
 283    62 IPA(1)=10
 284       IPA(2)=16
 285       GOTO 100
 286    63 IPA(1)=10
 287       IPA(2)=14
 288       GOTO 100
 289    65 IF(NP.EQ.NM) GOTO 66
 290       IF(NP.EQ.1+NM) GOTO 68
 291       IPA(1)=11
 292       IPA(2)=16
 293       GOTO 100
 294    66 CALL GRNDM(RNDM,1)
 295       IF(RNDM(1).LT.0.25) GOTO 67
 296       IPA(1)=11
 297       IPA(2)=14
 298       GOTO 100
 299    67 IPA(1)=10
 300       IPA(2)=16
 301       GOTO 100
 302    68 IPA(1)=11
 303       IPA(2)=16
 304       GOTO 100
 305    70 IF(NPRT(4))
 306      *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ
 307       CALL STPAIR
 308       IF(INT.EQ.1) CALL TWOB(11,NFL,N)
 309       IF(INT.EQ.2) CALL GENXPT(11,NFL,N)
 310       GO TO 9999
 311    55 IF(NPRT(4))
 312      *WRITE(NEWBCD,1001)
 313       GOTO 53
 314 C** EXCLUSIVE REACTION NOT FOUND
 315    80 IF(NPRT(4))
 316      *WRITE(NEWBCD,1004) RS,N
 317    53 INT=1
 318       NP=0
 319       NM=0
 320       NZ=0
 321       N=0.
 322       IPA(1)=11
 323       IPA(2)=14
 324       IF(NFL.EQ.2) IPA(2)=16
 325   100 DO 101 I=3,60
 326   101 IPA(I)=0
 327       IF(INT.LE.0) GOTO 131
 328   120 NT=2
 329       IF(NP.EQ.0) GOTO 122
 330       DO 121 I=1,NP
 331       NT=NT+1
 332   121 IPA(NT)=7
 333   122 IF(NM.EQ.0) GOTO 124
 334       DO 123 I=1,NM
 335       NT=NT+1
 336   123 IPA(NT)=9
 337   124 IF(NZ.EQ.0) GOTO 130
 338       DO 125 I=1,NZ
 339       NT=NT+1
 340   125 IPA(NT)=8
 341   130 IF(NPRT(4))
 342      *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20)
 343       DO 132 I=1,NT
 344       IF(IPA(I).NE.11) GOTO 132
 345       CALL GRNDM(RNDM,1)
 346       IF(RNDM(1).LT.0.5) GOTO 132
 347       IPA(I)=12
 348   132 CONTINUE
 349       GOTO 70
 350   131 IF(NPRT(4))
 351      *WRITE(NEWBCD,2005)
 352 C
 353 1001  FORMAT('0*CASK0* CASCADE ENERGETICALLY NOT POSSIBLE',
 354      $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING')
 355 1003  FORMAT(' *CASK0* K0 -INDUCED CASCADE,',
 356      $ ' AVAIL. ENERGY',2X,F8.4,
 357      $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES')
 358 1004  FORMAT(' *CASK0* K0 -INDUCED CASCADE,',
 359      $ ' EXCLUSIVE REACTION NOT FOUND',
 360      $ ' TRY ELASTIC SCATTERING  AVAIL. ENERGY',2X,F8.4,2X,
 361      $ '<NTOT>',2X,F8.4)
 362 2001  FORMAT('0*CASK0* TABLES FOR MULT. DATA K0  INDUCED REACTION',
 363      $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING')
 364 2002  FORMAT(' *CASK0* TARGET PARTICLE FLAG',2X,I5)
 365 2003  FORMAT(1H ,10E12.4)
 366 2004  FORMAT(' *CASK0* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4)
 367 2005  FORMAT(' *CASK0* NO PARTICLES PRODUCED')
 368 C
 369  9999 CONTINUE
 370       END