| fe4da5cc |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 5 | * Revision 1.1.1.1 1995/10/24 10:21:05 cernlib |
| 6 | * Geant |
| 7 | * |
| 8 | * |
| 9 | #include "geant321/pilot.h" |
| 10 | *CMZ : 3.21/02 29/03/94 15.41.40 by S.Giani |
| 11 | *-- Author : |
| 12 | SUBROUTINE CASXM(K,INT,NFL) |
| 13 | C |
| 14 | C *** CASCADE OF XI- *** |
| 15 | C *** NVE 17-JAN-1989 CERN GENEVA *** |
| 16 | C |
| 17 | C XI- UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS. |
| 18 | C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS. |
| 19 | C IF NOT, ASSUME NUCLEAR EXCITATION OCCURS, DEGRADE INPUT PARTICLE |
| 20 | C IN ENERGY AND NO OTHER PARTICLES ARE PRODUCED. |
| 21 | C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/ |
| 22 | C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA. |
| 23 | C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS |
| 24 | C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS. |
| 25 | C |
| 26 | #include "geant321/mxgkgh.inc" |
| 27 | #include "geant321/s_consts.inc" |
| 28 | #include "geant321/s_curpar.inc" |
| 29 | #include "geant321/s_result.inc" |
| 30 | #include "geant321/s_prntfl.inc" |
| 31 | #include "geant321/s_kginit.inc" |
| 32 | #include "geant321/limits.inc" |
| 33 | C |
| 34 | REAL N |
| 35 | DIMENSION PMUL(2,1200),ANORM(2,60),CECH(10),IIPA(12,2),B(2) |
| 36 | DIMENSION RNDM(1) |
| 37 | SAVE PMUL,ANORM |
| 38 | DATA CECH/0.50,0.45,0.40,0.35,0.30,0.25,0.06,0.04,0.005,0./ |
| 39 | C --- ARRAY IIPA DENOTES THE STRANGENESS AND CHARGE EXCHAGE REACTIONS --- |
| 40 | C XI- P --> XI0 N, XI- P --> N XI0 |
| 41 | C XI- P --> S0 S0, XI- P --> L0 L0 |
| 42 | C XI- P --> S0 L0, XI- P --> L0 S0 |
| 43 | C XI- P --> P XI- |
| 44 | C XI- N --> N XI- |
| 45 | C XI- N --> S0 S-, XI- N --> S- S0 |
| 46 | C XI- N --> L0 S-, XI- N --> S- L0 |
| 47 | DATA IIPA/26,16,21,18,21,18,14, 16,21,22,18,22, |
| 48 | * 16,26,21,18,18,21,27, 27,22,21,22,18/ |
| 49 | DATA B/0.7,0.7/,C/1.25/ |
| 50 | C |
| 51 | C --- INITIALIZATION INDICATED BY KGINIT(19) --- |
| 52 | IF (KGINIT(19) .NE. 0) GO TO 10 |
| 53 | KGINIT(19)=1 |
| 54 | C |
| 55 | C --- INITIALIZE PMUL AND ANORM ARRAYS --- |
| 56 | DO 9000 J=1,1200 |
| 57 | DO 9001 I=1,2 |
| 58 | PMUL(I,J)=0.0 |
| 59 | IF (J .LE. 60) ANORM(I,J)=0.0 |
| 60 | 9001 CONTINUE |
| 61 | 9000 CONTINUE |
| 62 | C |
| 63 | C *** COMPUTE NORMALIZATION CONSTANTS *** |
| 64 | C |
| 65 | C --- FOR P TARGET --- |
| 66 | L=0 |
| 67 | DO 1 NP1=1,20 |
| 68 | NP=NP1-1 |
| 69 | NMM1=NP1-1 |
| 70 | IF (NMM1 .LE. 0) NMM1=1 |
| 71 | NPP1=NP1+1 |
| 72 | DO 1 NM1=NMM1,NPP1 |
| 73 | NM=NM1-1 |
| 74 | DO 1 NZ1=1,20 |
| 75 | NZ=NZ1-1 |
| 76 | L=L+1 |
| 77 | IF (L .GT. 1200) GO TO 1 |
| 78 | NT=NP+NM+NZ |
| 79 | IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 1 |
| 80 | PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(2),C) |
| 81 | ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L) |
| 82 | 1 CONTINUE |
| 83 | C --- FOR N TARGET --- |
| 84 | L=0 |
| 85 | DO 2 NP1=1,20 |
| 86 | NP=NP1-1 |
| 87 | NMM1=NP1 |
| 88 | NPP1=NP1+2 |
| 89 | DO 2 NM1=NMM1,NPP1 |
| 90 | NM=NM1-1 |
| 91 | DO 2 NZ1=1,20 |
| 92 | NZ=NZ1-1 |
| 93 | L=L+1 |
| 94 | IF (L .GT. 1200) GO TO 2 |
| 95 | NT=NP+NM+NZ |
| 96 | IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 2 |
| 97 | PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(1),C) |
| 98 | ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L) |
| 99 | 2 CONTINUE |
| 100 | C |
| 101 | DO 3 I=1,60 |
| 102 | IF (ANORM(1,I) .GT. 0.) ANORM(1,I)=1./ANORM(1,I) |
| 103 | IF (ANORM(2,I) .GT. 0.) ANORM(2,I)=1./ANORM(2,I) |
| 104 | 3 CONTINUE |
| 105 | C |
| 106 | IF (.NOT. NPRT(10)) GO TO 10 |
| 107 | C |
| 108 | WRITE(NEWBCD,2001) |
| 109 | 2001 FORMAT('0*CASXM* TABLES FOR MULT. DATA XI- INDUCED REACTION', |
| 110 | $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING') |
| 111 | DO 4 NFL=1,2 |
| 112 | WRITE(NEWBCD,2002) NFL |
| 113 | 2002 FORMAT(' *CASXM* TARGET PARTICLE FLAG',2X,I5) |
| 114 | WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60) |
| 115 | WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200) |
| 116 | 2003 FORMAT(1H ,10E12.4) |
| 117 | 4 CONTINUE |
| 118 | C |
| 119 | C --- SELECT TARGET NUCLEON --- |
| 120 | 10 CONTINUE |
| 121 | NFL=2 |
| 122 | CALL GRNDM(RNDM,1) |
| 123 | IF (RNDM(1) .LT. (ZNO2/ATNO2)) NFL=1 |
| 124 | TARMAS=RMASS(14) |
| 125 | IF (NFL .EQ. 2) TARMAS=RMASS(16) |
| 126 | S=AMASQ+TARMAS**2+2.0*TARMAS*EN |
| 127 | RS=SQRT(S) |
| 128 | ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6) |
| 129 | ENP(9)=SQRT(ENP(8)) |
| 130 | EAB=RS-TARMAS-RMASS(27) |
| 131 | C |
| 132 | C --- RESET STRANGENESS FIXING FLAG --- |
| 133 | NVEFIX=0 |
| 134 | C |
| 135 | C *** ELASTIC SCATTERING *** |
| 136 | NP=0 |
| 137 | NM=0 |
| 138 | NZ=0 |
| 139 | N=0. |
| 140 | IPA(1)=27 |
| 141 | IPA(2)=14 |
| 142 | IF (NFL .EQ. 2) IPA(2)=16 |
| 143 | C |
| 144 | IF (INT .EQ. 2) GO TO 20 |
| 145 | C |
| 146 | C *** INTRODUCE CHARGE AND STRANGENESS EXCHANGE REACTIONS *** |
| 147 | IPLAB=IFIX(P*2.5)+1 |
| 148 | IF (IPLAB .GT. 10) IPLAB=10 |
| 149 | CALL GRNDM(RNDM,1) |
| 150 | IF (RNDM(1) .GT. (CECH(IPLAB)/ATNO2**0.42)) GO TO 120 |
| 151 | CALL GRNDM(RNDM,1) |
| 152 | RAN=RNDM(1) |
| 153 | IRN=IFIX(RAN*7.)+1 |
| 154 | IF (NFL .EQ. 2) IRN=7+IFIX(RAN*5.)+1 |
| 155 | IF (NFL .EQ. 1) IRN=MAX(IRN,7) |
| 156 | IF (NFL .EQ. 2) IRN=MAX(IRN,12) |
| 157 | IPA(1)=IIPA(IRN,1) |
| 158 | IPA(2)=IIPA(IRN,2) |
| 159 | GO TO 120 |
| 160 | C |
| 161 | C --- CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION --- |
| 162 | 20 CONTINUE |
| 163 | IF (EAB .LE. RMASS(7)) GO TO 55 |
| 164 | C |
| 165 | C --- NO. OF TOTAL PARTICLES VS SQRT(S)-MP-MSM --- |
| 166 | ALEAB=LOG(EAB) |
| 167 | N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB |
| 168 | * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB |
| 169 | N=N-2. |
| 170 | C |
| 171 | C --- NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION --- |
| 172 | ANPN=0. |
| 173 | DO 21 NT=1,60 |
| 174 | TEST=-(PI/4.0)*(NT/N)**2 |
| 175 | IF (TEST .LT. EXPXL) TEST=EXPXL |
| 176 | IF (TEST .GT. EXPXU) TEST=EXPXU |
| 177 | DUM1=PI*NT/(2.0*N*N) |
| 178 | DUM2=ABS(DUM1) |
| 179 | DUM3=EXP(TEST) |
| 180 | ADDNVE=0.0 |
| 181 | IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 |
| 182 | IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3 |
| 183 | ANPN=ANPN+ADDNVE |
| 184 | 21 CONTINUE |
| 185 | ANPN=1./ANPN |
| 186 | C |
| 187 | C --- CHECK FOR TARGET NUCLEON TYPE --- |
| 188 | CALL GRNDM(RNDM,1) |
| 189 | RAN=RNDM(1) |
| 190 | EXCS=0. |
| 191 | GO TO (30,40),NFL |
| 192 | C |
| 193 | C --- PROTON TARGET --- |
| 194 | 30 CONTINUE |
| 195 | L=0 |
| 196 | DO 31 NP1=1,20 |
| 197 | NP=NP1-1 |
| 198 | NMM1=NP1-1 |
| 199 | IF (NMM1 .LE. 0) NMM1=1 |
| 200 | NPP1=NP1+1 |
| 201 | DO 31 NM1=NMM1,NPP1 |
| 202 | NM=NM1-1 |
| 203 | DO 31 NZ1=1,20 |
| 204 | NZ=NZ1-1 |
| 205 | L=L+1 |
| 206 | IF (L .GT. 1200) GO TO 31 |
| 207 | NT=NP+NM+NZ |
| 208 | IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 31 |
| 209 | TEST=-(PI/4.0)*(NT/N)**2 |
| 210 | IF (TEST .LT. EXPXL) TEST=EXPXL |
| 211 | IF (TEST .GT. EXPXU) TEST=EXPXU |
| 212 | DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N) |
| 213 | DUM2=ABS(DUM1) |
| 214 | DUM3=EXP(TEST) |
| 215 | ADDNVE=0.0 |
| 216 | IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 |
| 217 | IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3 |
| 218 | EXCS=EXCS+ADDNVE |
| 219 | IF (RAN .LT. EXCS) GO TO 100 |
| 220 | 31 CONTINUE |
| 221 | GO TO 80 |
| 222 | C |
| 223 | C --- NEUTRON TARGET --- |
| 224 | 40 CONTINUE |
| 225 | L=0 |
| 226 | DO 41 NP1=1,20 |
| 227 | NP=NP1-1 |
| 228 | NMM1=NP1 |
| 229 | NPP1=NP1+2 |
| 230 | DO 41 NM1=NMM1,NPP1 |
| 231 | NM=NM1-1 |
| 232 | DO 41 NZ1=1,20 |
| 233 | NZ=NZ1-1 |
| 234 | L=L+1 |
| 235 | IF (L .GT. 1200) GO TO 41 |
| 236 | NT=NP+NM+NZ |
| 237 | IF ((NT .LE. 0) .OR. (NT .GT. 60)) GO TO 41 |
| 238 | TEST=-(PI/4.0)*(NT/N)**2 |
| 239 | IF (TEST .LT. EXPXL) TEST=EXPXL |
| 240 | IF (TEST .GT. EXPXU) TEST=EXPXU |
| 241 | DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N) |
| 242 | DUM2=ABS(DUM1) |
| 243 | DUM3=EXP(TEST) |
| 244 | ADDNVE=0.0 |
| 245 | IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 |
| 246 | IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3 |
| 247 | EXCS=EXCS+ADDNVE |
| 248 | IF (RAN .LT. EXCS) GO TO 100 |
| 249 | 41 CONTINUE |
| 250 | GO TO 80 |
| 251 | C |
| 252 | 50 CONTINUE |
| 253 | IF (NPRT(4)) WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ |
| 254 | 1003 FORMAT(' *CASXM* XI- -INDUCED CASCADE,', |
| 255 | $ ' AVAIL. ENERGY',2X,F8.4, |
| 256 | $ 2X,'<NTOT>',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES') |
| 257 | IF (INT .EQ. 1) CALL TWOB(27,NFL,N) |
| 258 | IF (INT .EQ. 2) CALL GENXPT(27,NFL,N) |
| 259 | GO TO 9999 |
| 260 | C |
| 261 | C *** ENERGETICALLY NOT POSSIBLE TO PRODUCE ONE EXTRA PION *** |
| 262 | 55 CONTINUE |
| 263 | IF (NPRT(4)) WRITE(NEWBCD,1001) |
| 264 | 1001 FORMAT('0*CASXM* CASCADE ENERGETICALLY NOT POSSIBLE', |
| 265 | $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING') |
| 266 | GO TO 53 |
| 267 | C |
| 268 | C *** EXCLUSIVE REACTION NOT FOUND *** |
| 269 | 80 CONTINUE |
| 270 | IF (NPRT(4)) WRITE(NEWBCD,1004) RS,N |
| 271 | 1004 FORMAT(' *CASXM* XI- -INDUCED CASCADE,', |
| 272 | $ ' EXCLUSIVE REACTION NOT FOUND', |
| 273 | $ ' TRY ELASTIC SCATTERING AVAIL. ENERGY',2X,F8.4,2X, |
| 274 | $ '<NTOT>',2X,F8.4) |
| 275 | C |
| 276 | 53 CONTINUE |
| 277 | INT=1 |
| 278 | NP=0 |
| 279 | NM=0 |
| 280 | NZ=0 |
| 281 | IPA(1)=27 |
| 282 | IPA(2)=14 |
| 283 | IF (NFL .EQ. 2) IPA(2)=16 |
| 284 | GO TO 120 |
| 285 | C |
| 286 | C *** INELASTIC INTERACTION HAS OCCURRED *** |
| 287 | C *** NUMBER OF SECONDARY MESONS DETERMINED BY KNO DISTRIBUTION *** |
| 288 | 100 CONTINUE |
| 289 | DO 101 I=1,60 |
| 290 | IPA(I)=0 |
| 291 | 101 CONTINUE |
| 292 | C |
| 293 | IF (INT .LE. 0) GO TO 131 |
| 294 | C |
| 295 | C --- TAKE TARGET NUCLEON TYPE INTO ACCOUNT --- |
| 296 | GO TO (102,112),NFL |
| 297 | C |
| 298 | C --- PROTON TARGET --- |
| 299 | 102 CONTINUE |
| 300 | C --- CHECK FOR TOTAL CHARGE OF FINAL STATE MESONS TO DETERMINE --- |
| 301 | C --- THE KIND OF BARYONS TO BE PRODUCED TAKING INTO ACCOUNT --- |
| 302 | C --- CHARGE AND STRANGENESS CONSERVATION --- |
| 303 | NCHT=NP-NM |
| 304 | IF (NCHT .LT. 0) GO TO 103 |
| 305 | IF (NCHT .EQ. 0) GO TO 104 |
| 306 | IF (NCHT .GT. 0) GO TO 105 |
| 307 | C |
| 308 | 103 CONTINUE |
| 309 | C --- XI0 P --- |
| 310 | IPA(1)=26 |
| 311 | IPA(2)=14 |
| 312 | IF (NCHT .EQ. -1) GO TO 120 |
| 313 | C --- CHARGE MISMATCH ==> TAKE A S+ AND CORRECT THE STRANGENESS --- |
| 314 | C --- BY REPLACING A PI- BY K- --- |
| 315 | C --- S+ P --- |
| 316 | IPA(1)=20 |
| 317 | IPA(2)=14 |
| 318 | NVEFIX=1 |
| 319 | GO TO 120 |
| 320 | C |
| 321 | 104 CONTINUE |
| 322 | C --- XI- P --- |
| 323 | IPA(1)=27 |
| 324 | IPA(2)=14 |
| 325 | CALL GRNDM(RNDM,1) |
| 326 | IF (RNDM(1) .LT. 0.5) GO TO 120 |
| 327 | C --- XI0 N --- |
| 328 | IPA(1)=26 |
| 329 | IPA(2)=16 |
| 330 | GO TO 120 |
| 331 | C |
| 332 | 105 CONTINUE |
| 333 | C --- XI- N --- |
| 334 | IPA(1)=27 |
| 335 | IPA(2)=16 |
| 336 | GO TO 120 |
| 337 | C |
| 338 | C --- NEUTRON TARGET --- |
| 339 | 112 CONTINUE |
| 340 | C --- CHECK FOR TOTAL CHARGE OF FINAL STATE MESONS TO DETERMINE --- |
| 341 | C --- THE KIND OF BARYONS TO BE PRODUCED TAKING INTO ACCOUNT --- |
| 342 | C --- CHARGE AND STRANGENESS CONSERVATION --- |
| 343 | NCHT=NP-NM |
| 344 | IF (NCHT .LT. -1) GO TO 113 |
| 345 | IF (NCHT .EQ. -1) GO TO 114 |
| 346 | IF (NCHT .GT. -1) GO TO 115 |
| 347 | C |
| 348 | 113 CONTINUE |
| 349 | C --- XI0 P --- |
| 350 | IPA(1)=26 |
| 351 | IPA(2)=14 |
| 352 | IF (NCHT .EQ. -2) GO TO 120 |
| 353 | C --- CHARGE MISMATCH ==> TAKE A S+ AND CORRECT THE STRANGENESS --- |
| 354 | C --- BY REPLACING A PI- BY K- --- |
| 355 | C --- S+ P --- |
| 356 | IPA(1)=20 |
| 357 | IPA(2)=14 |
| 358 | NVEFIX=1 |
| 359 | GO TO 120 |
| 360 | C |
| 361 | 114 CONTINUE |
| 362 | C --- XI0 N --- |
| 363 | IPA(1)=26 |
| 364 | IPA(2)=16 |
| 365 | CALL GRNDM(RNDM,1) |
| 366 | IF (RNDM(1) .LT. 0.5) GO TO 120 |
| 367 | C --- XI- P --- |
| 368 | IPA(1)=27 |
| 369 | IPA(2)=14 |
| 370 | GO TO 120 |
| 371 | C |
| 372 | 115 CONTINUE |
| 373 | C --- XI- N --- |
| 374 | IPA(1)=27 |
| 375 | IPA(2)=16 |
| 376 | C |
| 377 | C --- TAKE PIONS FOR ALL SECONDARY MESONS --- |
| 378 | 120 CONTINUE |
| 379 | NT=2 |
| 380 | C |
| 381 | IF (NP .EQ. 0) GO TO 122 |
| 382 | C |
| 383 | C --- PI+ --- |
| 384 | DO 121 I=1,NP |
| 385 | NT=NT+1 |
| 386 | IPA(NT)=7 |
| 387 | 121 CONTINUE |
| 388 | C |
| 389 | 122 CONTINUE |
| 390 | IF (NM .EQ. 0) GO TO 124 |
| 391 | C |
| 392 | C --- PI- --- |
| 393 | DO 123 I=1,NM |
| 394 | NT=NT+1 |
| 395 | IPA(NT)=9 |
| 396 | IF (NVEFIX .GE. 1) IPA(NT)=13 |
| 397 | IF (NPRT(4) .AND. (NVEFIX .GE. 1)) PRINT 3000 |
| 398 | 3000 FORMAT(' *CASXM* K- INTRODUCED') |
| 399 | NVEFIX=NVEFIX-1 |
| 400 | 123 CONTINUE |
| 401 | C |
| 402 | 124 CONTINUE |
| 403 | IF (NZ .EQ. 0) GO TO 130 |
| 404 | C |
| 405 | C --- PI0 --- |
| 406 | DO 125 I=1,NZ |
| 407 | NT=NT+1 |
| 408 | IPA(NT)=8 |
| 409 | 125 CONTINUE |
| 410 | C |
| 411 | C --- ALL SECONDARY PARTICLES HAVE BEEN DEFINED --- |
| 412 | C --- NOW GO FOR MOMENTA AND X VALUES --- |
| 413 | 130 CONTINUE |
| 414 | IF (NPRT(4)) WRITE(NEWBCD,2004) NT,(IPA(I),I=1,60) |
| 415 | 2004 FORMAT(' *CASXM* ',I3,' PARTICLES PRODUCED. MASS INDEX ARRAY : '/ |
| 416 | $ 3(1H ,20(I3,1X)/)) |
| 417 | GO TO 50 |
| 418 | C |
| 419 | 131 CONTINUE |
| 420 | IF (NPRT(4)) WRITE(NEWBCD,2005) |
| 421 | 2005 FORMAT(' *CASXM* NO PARTICLES PRODUCED') |
| 422 | C |
| 423 | 9999 CONTINUE |
| 424 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame