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