| 1 | SUBROUTINE SDPM
|
|---|
| 2 |
|
|---|
| 3 | C-----------------------------------------------------------------------
|
|---|
| 4 | C S(TARTING) D(UAL) P(ARTON) M(ODEL)
|
|---|
| 5 | C
|
|---|
| 6 | C THIS ROUTINE DETERMINES THE TARGET NUCLEUS.
|
|---|
| 7 | C IT CALLS ALSO THE VARIOUS INTERACTION MODELS.
|
|---|
| 8 | C FOR HDPM, THIS ROUTINE LOOKS, HOW MANY NUCLEONS INTERACT AND WHICH
|
|---|
| 9 | C RESIDUAL FRAGMENT OF THE PROJECTILE NUCLEUS REMAINS.
|
|---|
| 10 | C THIS SUBROUTINE IS CALLED FROM NUCINT AND PIGEN
|
|---|
| 11 | C
|
|---|
| 12 | C REDESIGN: D. HECK IK3 FZK KARLSRUHE
|
|---|
| 13 | C-----------------------------------------------------------------------
|
|---|
| 14 |
|
|---|
| 15 | IMPLICIT NONE
|
|---|
| 16 | *KEEP,AIR.
|
|---|
| 17 | COMMON /AIR/ COMPOS,PROBTA,AVERAW,AVOGAD
|
|---|
| 18 | DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
|
|---|
| 19 | *KEEP,CONST.
|
|---|
| 20 | COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER
|
|---|
| 21 | DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
|
|---|
| 22 | *KEEP,DPMFLG.
|
|---|
| 23 | COMMON /DPMFLG/ NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
|
|---|
| 24 | INTEGER NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
|
|---|
| 25 | *KEEP,GENER.
|
|---|
| 26 | COMMON /GENER/ GEN,ALEVEL
|
|---|
| 27 | DOUBLE PRECISION GEN,ALEVEL
|
|---|
| 28 | *KEEP,INTER.
|
|---|
| 29 | COMMON /INTER/ AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
|
|---|
| 30 | * FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
|
|---|
| 31 | * RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
|
|---|
| 32 | * WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
|
|---|
| 33 | * IDIF,ITAR
|
|---|
| 34 | DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
|
|---|
| 35 | * FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
|
|---|
| 36 | * RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
|
|---|
| 37 | * WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
|
|---|
| 38 | INTEGER IDIF,ITAR
|
|---|
| 39 | *KEEP,ISTA.
|
|---|
| 40 | COMMON /ISTA/ IFINET,IFINNU,IFINKA,IFINPI,IFINHY
|
|---|
| 41 | INTEGER IFINET,IFINNU,IFINKA,IFINPI,IFINHY
|
|---|
| 42 | *KEEP,MULT.
|
|---|
| 43 | COMMON /MULT/ EKINL,MSMM,MULTMA,MULTOT
|
|---|
| 44 | DOUBLE PRECISION EKINL
|
|---|
| 45 | INTEGER MSMM,MULTMA(37,13),MULTOT(37,13)
|
|---|
| 46 | *KEEP,NCSNCS.
|
|---|
| 47 | COMMON /NCSNCS/ SIGN30,SIGN45,SIGN60,SIGO30,SIGO45,SIGO60,
|
|---|
| 48 | * SIGA30,SIGA45,SIGA60,PNOA30,PNOA45,PNOA60,
|
|---|
| 49 | * SIG30A,SIG45A,SIG60A
|
|---|
| 50 | DOUBLE PRECISION SIGN30(56),SIGN45(56),SIGN60(56),
|
|---|
| 51 | * SIGO30(56),SIGO45(56),SIGO60(56),
|
|---|
| 52 | * SIGA30(56),SIGA45(56),SIGA60(56),
|
|---|
| 53 | * PNOA30(1540,3),PNOA45(1540,3),PNOA60(1540,3),
|
|---|
| 54 | * SIG30A(56),SIG45A(56),SIG60A(56)
|
|---|
| 55 | *KEEP,PAM.
|
|---|
| 56 | COMMON /PAM/ PAMA,SIGNUM
|
|---|
| 57 | DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
|
|---|
| 58 | *KEEP,PARPAR.
|
|---|
| 59 | COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
|
|---|
| 60 | * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
|
|---|
| 61 | DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
|
|---|
| 62 | * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
|
|---|
| 63 | INTEGER ITYPE,LEVL
|
|---|
| 64 | *KEEP,PARPAE.
|
|---|
| 65 | DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
|
|---|
| 66 | EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
|
|---|
| 67 | * (CURPAR(4), PHI ), (CURPAR(5), H ),
|
|---|
| 68 | * (CURPAR(6), T ), (CURPAR(7), X ),
|
|---|
| 69 | * (CURPAR(8), Y ), (CURPAR(9), CHI ),
|
|---|
| 70 | * (CURPAR(10),BETA), (CURPAR(11),GCM ),
|
|---|
| 71 | * (CURPAR(12),ECM )
|
|---|
| 72 | *KEEP,RANDPA.
|
|---|
| 73 | COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
|
|---|
| 74 | DOUBLE PRECISION FAC,U1,U2
|
|---|
| 75 | REAL RD(3000)
|
|---|
| 76 | INTEGER ISEED(103,10),NSEQ
|
|---|
| 77 | LOGICAL KNOR
|
|---|
| 78 | *KEEP,RANGE.
|
|---|
| 79 | COMMON /RANGE/ CC
|
|---|
| 80 | DOUBLE PRECISION CC(20)
|
|---|
| 81 | *KEEP,REST.
|
|---|
| 82 | COMMON /REST/ CONTNE,TAR,LT
|
|---|
| 83 | DOUBLE PRECISION CONTNE(3),TAR
|
|---|
| 84 | INTEGER LT
|
|---|
| 85 | *KEEP,RUNPAR.
|
|---|
| 86 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
|---|
| 87 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
|---|
| 88 | * MONIOU,MDEBUG,NUCNUC,
|
|---|
| 89 | * CETAPE,
|
|---|
| 90 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 91 | * N1STTR,MDBASE,
|
|---|
| 92 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 93 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 94 | * ,GHEISH,GHESIG
|
|---|
| 95 | COMMON /RUNPAC/ DSN,HOST,USER
|
|---|
| 96 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
|---|
| 97 | REAL STEPFC
|
|---|
| 98 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
|---|
| 99 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 100 | * N1STTR,MDBASE
|
|---|
| 101 | INTEGER CETAPE
|
|---|
| 102 | CHARACTER*79 DSN
|
|---|
| 103 | CHARACTER*20 HOST,USER
|
|---|
| 104 |
|
|---|
| 105 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 106 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 107 | * ,GHEISH,GHESIG
|
|---|
| 108 | *KEEP,SIGM.
|
|---|
| 109 | COMMON /SIGM/ SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
|
|---|
| 110 | DOUBLE PRECISION SIGMA,SIGANN,SIGAIR,FRACTN,FRCTNO
|
|---|
| 111 | *KEEP,VKIN.
|
|---|
| 112 | COMMON /VKIN/ BETACM
|
|---|
| 113 | DOUBLE PRECISION BETACM
|
|---|
| 114 | *KEEP,VENUS.
|
|---|
| 115 | COMMON /VENUS/ ISH0,IVERVN,MTAR99,FVENUS,FVENSG
|
|---|
| 116 | INTEGER ISH0,IVERVN,MTAR99
|
|---|
| 117 | LOGICAL FVENUS,FVENSG
|
|---|
| 118 | *KEND.
|
|---|
| 119 |
|
|---|
| 120 | DOUBLE PRECISION PFRX(60),PFRY(60)
|
|---|
| 121 | DOUBLE PRECISION COSTET,EA,P,PHIV,PTM,PT2,
|
|---|
| 122 | * SIGMAA,SIGMAN,SIGMAO,SIG45,S45SQ,S4530
|
|---|
| 123 | DOUBLE PRECISION CGHSIG,EKIN
|
|---|
| 124 | EXTERNAL CGHSIG
|
|---|
| 125 | INTEGER ITYP(60),I,IA,IANEW,INACTA,INACTZ,INDEX,INEUTR,
|
|---|
| 126 | * IZ,IZNEW,J,JFIN,KNEW,L,LL,NPRPRO,NNEPRO
|
|---|
| 127 | C-----------------------------------------------------------------------
|
|---|
| 128 |
|
|---|
| 129 | IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
|
|---|
| 130 | 444 FORMAT(' SDPM : CURPAR=',1P,9E10.3)
|
|---|
| 131 |
|
|---|
| 132 | C IA IS MASS NUMBER OF PROJECTILE
|
|---|
| 133 | IA = ITYPE / 100
|
|---|
| 134 | IF ( IA .GT. 56 ) THEN
|
|---|
| 135 | WRITE(MONIOU,*) 'SDPM : NOT FORESEEN PARTICLE TYPE=',ITYPE
|
|---|
| 136 | STOP
|
|---|
| 137 | ENDIF
|
|---|
| 138 |
|
|---|
| 139 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 140 | C TREATMENT OF GAMMAS COMING FROM EGS4 (PIGEN)
|
|---|
| 141 | IF ( ITYPE .EQ. 1 ) THEN
|
|---|
| 142 | C RATIOS OF CROSS SECTIONS GO LIKE A**0.91
|
|---|
| 143 | FRACTN = COMPOS(1) * 11.04019D0
|
|---|
| 144 | FRCTNO = FRACTN + COMPOS(2) * 12.46663D0
|
|---|
| 145 | SIGAIR = FRCTNO + COMPOS(3) * 28.69952D0
|
|---|
| 146 | C TARGET IS CHOSEN AT RANDOM
|
|---|
| 147 | CALL RMMAR( RD,1,1 )
|
|---|
| 148 | IF ( RD(1)*SIGAIR .LE. FRACTN ) THEN
|
|---|
| 149 | C INTERACTION WITH NITROGEN
|
|---|
| 150 | LT = 1
|
|---|
| 151 | TAR = 14.D0
|
|---|
| 152 | ELSEIF ( RD(1)*SIGAIR .LE. FRCTNO ) THEN
|
|---|
| 153 | C INTERACTION WITH OXYGEN
|
|---|
| 154 | LT = 2
|
|---|
| 155 | TAR = 16.D0
|
|---|
| 156 | ELSE
|
|---|
| 157 | C INTERACTION WITH ARGON
|
|---|
| 158 | LT = 3
|
|---|
| 159 | TAR = 40.D0
|
|---|
| 160 | ENDIF
|
|---|
| 161 |
|
|---|
| 162 | C GAMMAS ARE TREATED BY VENUS, IF SUFFICIENT ENERGY
|
|---|
| 163 | IF ( FVENUS .AND. CURPAR(2) .GT. HILOELB ) THEN
|
|---|
| 164 | CALL VENLNK
|
|---|
| 165 | ELSE
|
|---|
| 166 | CALL HDPM
|
|---|
| 167 | ENDIF
|
|---|
| 168 |
|
|---|
| 169 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 170 | C NORMAL HADRON PROJECTILE
|
|---|
| 171 | ELSEIF ( ITYPE .LT. 100 ) THEN
|
|---|
| 172 |
|
|---|
| 173 | C WITH WHAT KIND OF TARGET DOES PROJECTILE INTERACT?
|
|---|
| 174 | IF ( FIXTAR ) THEN
|
|---|
| 175 | C TARGET OF FIRST INTERACTION IS FIXED
|
|---|
| 176 | LT = N1STTR
|
|---|
| 177 | IF ( N1STTR .EQ. 1 ) THEN
|
|---|
| 178 | TAR = 14.D0
|
|---|
| 179 | ELSEIF ( N1STTR .EQ. 2 ) THEN
|
|---|
| 180 | TAR = 16.D0
|
|---|
| 181 | ELSE
|
|---|
| 182 | TAR = 40.D0
|
|---|
| 183 | ENDIF
|
|---|
| 184 | FIXTAR = .FALSE.
|
|---|
| 185 | ELSE
|
|---|
| 186 | C TARGET IS CHOSEN AT RANDOM ACCORDING TO CROSS SECTION
|
|---|
| 187 | C SIGMA IS ENERGY DEPENDENT INELASTIC NUCLEON-NUCLEON CROSS SECTION
|
|---|
| 188 | C AND IS SET IN BOX2
|
|---|
| 189 | C AUXIL. QUANTITIES FOR INTERPOLATION
|
|---|
| 190 | SIG45 = SIGMA - 45.D0
|
|---|
| 191 | S45SQ = SIG45**2 / 450.D0
|
|---|
| 192 | S4530 = SIG45 / 30.D0
|
|---|
| 193 | C INELASTIC CROSS SECTIONS FOR PROJECTICLE WITH MASS NUMBER 1
|
|---|
| 194 | SIGMAN = (1.D0 - 2.D0 * S45SQ) * SIGN45(1)
|
|---|
| 195 | * +(S45SQ - S4530) * SIGN30(1)
|
|---|
| 196 | * +(S45SQ + S4530) * SIGN60(1)
|
|---|
| 197 | FRACTN = COMPOS(1) * SIGMAN
|
|---|
| 198 | SIGMAO = (1.D0 - 2.D0 * S45SQ) * SIGO45(1)
|
|---|
| 199 | * +(S45SQ - S4530) * SIGO30(1)
|
|---|
| 200 | * +(S45SQ + S4530) * SIGO60(1)
|
|---|
| 201 | FRCTNO = FRACTN + COMPOS(2) * SIGMAO
|
|---|
| 202 | SIGMAA = (1.D0 - 2.D0 * S45SQ) * SIGA45(1)
|
|---|
| 203 | * +(S45SQ - S4530) * SIGA30(1)
|
|---|
| 204 | * +(S45SQ + S4530) * SIGA60(1)
|
|---|
| 205 | C INELASTIC CROSS SECTIONS OF AIR FOR PROJECTILE WITH MASS NUMBER 1
|
|---|
| 206 | SIGAIR = FRCTNO + COMPOS(3)*SIGMAA
|
|---|
| 207 | 333 CONTINUE
|
|---|
| 208 | CALL RMMAR( RD,1,1 )
|
|---|
| 209 | IF(DEBUG)WRITE(MDEBUG,*)'SDPM : FRACTN=',SNGL(FRACTN),
|
|---|
| 210 | * 'FRCTNO=',SNGL(FRCTNO),'RD=',RD(1)
|
|---|
| 211 | IF ( RD(1)*SIGAIR .LE. FRACTN ) THEN
|
|---|
| 212 | C INTERACTION WITH NITROGEN
|
|---|
| 213 | LT = 1
|
|---|
| 214 | TAR = 14.D0
|
|---|
| 215 | ELSEIF ( RD(1)*SIGAIR .LE. FRCTNO ) THEN
|
|---|
| 216 | C INTERACTION WITH OXYGEN
|
|---|
| 217 | LT = 2
|
|---|
| 218 | TAR = 16.D0
|
|---|
| 219 | ELSE
|
|---|
| 220 | C INTERACTION WITH ARGON
|
|---|
| 221 | LT = 3
|
|---|
| 222 | TAR = 40.D0
|
|---|
| 223 | ENDIF
|
|---|
| 224 | ENDIF
|
|---|
| 225 |
|
|---|
| 226 | IF ( FVENUS ) THEN
|
|---|
| 227 | C MESONS, NUCLEONS AND STRANGE BARYONS ARE TREATED BY VENUS (JAN 95)
|
|---|
| 228 | IF ( (ITYPE .GE. 7 .AND. ITYPE .LE. 16) .OR.
|
|---|
| 229 | * (ITYPE .GE. 18 .AND. ITYPE .LE. 32) )THEN
|
|---|
| 230 | CALL VENLNK
|
|---|
| 231 | ELSE
|
|---|
| 232 | CALL HDPM
|
|---|
| 233 | ENDIF
|
|---|
| 234 | ELSE
|
|---|
| 235 | CALL HDPM
|
|---|
| 236 | ENDIF
|
|---|
| 237 |
|
|---|
| 238 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 239 | C HEAVY PRIMARY INCIDENT WITH IA NUCLEONS
|
|---|
| 240 | ELSEIF ( IA .LE. 56 ) THEN
|
|---|
| 241 |
|
|---|
| 242 | IZ = MOD(ITYPE,100)
|
|---|
| 243 | C WITH WHAT KIND OF TARGET DOES PROJECTILE INTERACT?
|
|---|
| 244 | IF ( FIXTAR ) THEN
|
|---|
| 245 | C TARGET OF FIRST INTERACTION IS FIXED
|
|---|
| 246 | LT = N1STTR
|
|---|
| 247 | IF ( N1STTR .EQ. 1 ) THEN
|
|---|
| 248 | TAR = 14.D0
|
|---|
| 249 | ELSEIF ( N1STTR .EQ. 2 ) THEN
|
|---|
| 250 | TAR = 16.D0
|
|---|
| 251 | ELSE
|
|---|
| 252 | TAR = 40.D0
|
|---|
| 253 | ENDIF
|
|---|
| 254 | FIXTAR = .FALSE.
|
|---|
| 255 | CALL RMMAR( RD,2,1 )
|
|---|
| 256 | ELSE
|
|---|
| 257 | C ONLY INELASTIC INTERACTIONS WITH HEAVY PRIMARY/FRAGMENT
|
|---|
| 258 | C SIGMA IS ENERGY DEPENDENT INELASTIC NUCLEON-NUCLEON CROSS SECTION
|
|---|
| 259 | C AND IS SET IN BOX2
|
|---|
| 260 | C AUXIL. QUANTITIES FOR INTERPOLATION
|
|---|
| 261 | SIG45 = SIGMA - 45.D0
|
|---|
| 262 | S45SQ = SIG45**2 / 450.D0
|
|---|
| 263 | S4530 = SIG45 / 30.D0
|
|---|
| 264 | C INELASTIC CROSS SECTIONS FOR PROJECTICLE WITH MASS NUMBER IA
|
|---|
| 265 | SIGMAN = (1.D0 - 2.D0 * S45SQ) * SIGN45(IA)
|
|---|
| 266 | * +(S45SQ - S4530) * SIGN30(IA)
|
|---|
| 267 | * +(S45SQ + S4530) * SIGN60(IA)
|
|---|
| 268 | FRACTN = COMPOS(1) * SIGMAN
|
|---|
| 269 | SIGMAO = (1.D0 - 2.D0 * S45SQ) * SIGO45(IA)
|
|---|
| 270 | * +(S45SQ - S4530) * SIGO30(IA)
|
|---|
| 271 | * +(S45SQ + S4530) * SIGO60(IA)
|
|---|
| 272 | FRCTNO = FRACTN + COMPOS(2) * SIGMAO
|
|---|
| 273 | SIGMAA = (1.D0 - 2.D0 * S45SQ) * SIGA45(IA)
|
|---|
| 274 | * +(S45SQ - S4530) * SIGA30(IA)
|
|---|
| 275 | * +(S45SQ + S4530) * SIGA60(IA)
|
|---|
| 276 | C INELASTIC CROSS SECTIONS OF AIR FOR PROJECTILE WITH MASS NUMBER IA
|
|---|
| 277 | SIGAIR = FRCTNO +COMPOS(3)*SIGMAA
|
|---|
| 278 | C TARGET IS CHOSEN AT RANDOM
|
|---|
| 279 | CALL RMMAR( RD,2,1 )
|
|---|
| 280 | IF(DEBUG)WRITE(MDEBUG,*)'SDPM : FRACTN=',SNGL(FRACTN),
|
|---|
| 281 | * 'FRCTNO=',SNGL(FRCTNO),'RD=',RD(1)
|
|---|
| 282 | IF ( RD(1)*SIGAIR .LE. FRACTN ) THEN
|
|---|
| 283 | C INTERACTION WITH NITROGEN
|
|---|
| 284 | LT = 1
|
|---|
| 285 | TAR = 14.D0
|
|---|
| 286 | ELSEIF ( RD(1)*SIGAIR .LE. FRCTNO ) THEN
|
|---|
| 287 | C INTERACTION WITH OXYGEN
|
|---|
| 288 | LT = 2
|
|---|
| 289 | TAR = 16.D0
|
|---|
| 290 | ELSE
|
|---|
| 291 | C INTERACTION WITH ARGON
|
|---|
| 292 | LT = 3
|
|---|
| 293 | TAR = 40.D0
|
|---|
| 294 | ENDIF
|
|---|
| 295 | ENDIF
|
|---|
| 296 | C TREAT NUCLEUS BY VENUS, IF SELECTED AND ENERGY/NUCLEON HIGH ENOUGH
|
|---|
| 297 | IF ( FVENUS .AND. PAMA(ITYPE)*GAMMA .GT. HILOELB*IA ) THEN
|
|---|
| 298 | CALL VENLNK
|
|---|
| 299 | RETURN
|
|---|
| 300 | ENDIF
|
|---|
| 301 |
|
|---|
| 302 | C TREATMENT OF NUCLEUS-NUCLEUS INTERACTION IN HDPM BY SUPERPOSITION
|
|---|
| 303 | C
|
|---|
| 304 | C INDEX CALCULATION 1<I=<56 NUCLEONS IN PROJECTILE
|
|---|
| 305 | C 1<J<I INTERACTING NUCLEONS
|
|---|
| 306 | C P(I,I)=1 CUMULATIVE PROBABILITIES
|
|---|
| 307 | C P(I,J) ---> P( I*(I-3)*0.5+J+1 )
|
|---|
| 308 | C IZ IS NUMBER OF PROTONS IN PROJECTILE
|
|---|
| 309 | C LT IS INDEX FOR TARGET 1 = N, 2 = O, 3 = AR
|
|---|
| 310 | C INACTA IS NUMBER OF INTERACTING NUCLEONS
|
|---|
| 311 | C INACTZ IS NUMBER OF INTERACTING PROTONS
|
|---|
| 312 |
|
|---|
| 313 | C LOOK, HOW MANY NUCLEONS INTERACT
|
|---|
| 314 | DO 100 J = 1,IA-1
|
|---|
| 315 | INACTA = J
|
|---|
| 316 | INDEX = IA * (IA-3) * 0.5 + 1 + J
|
|---|
| 317 | P = ( 1.D0 - S45SQ *2.D0 ) * PNOA45(INDEX,LT)
|
|---|
| 318 | * +( S45SQ - S4530 ) * PNOA30(INDEX,LT)
|
|---|
| 319 | * +( S45SQ + S4530 ) * PNOA60(INDEX,LT)
|
|---|
| 320 | IF ( RD(2) .LT. P ) GO TO 110
|
|---|
| 321 | 100 CONTINUE
|
|---|
| 322 | C ALL NUCLEONS INTERACT (INACTA EQUAL IA)
|
|---|
| 323 | INACTA = INACTA + 1
|
|---|
| 324 |
|
|---|
| 325 | 110 CONTINUE
|
|---|
| 326 | IANEW = IA - INACTA
|
|---|
| 327 |
|
|---|
| 328 | C REMAINING PROJECTILE WITH IANEW NUCLEONS
|
|---|
| 329 | DO 120 L = 2,8
|
|---|
| 330 | SECPAR(L) = CURPAR(L)
|
|---|
| 331 | 120 CONTINUE
|
|---|
| 332 |
|
|---|
| 333 |
|
|---|
| 334 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 335 | C PROJECTILE NUCLEUS FRAGMENTS COMPLETELY, WRITE SPECTATOR NUCLEONS
|
|---|
| 336 | C ONTO STACK
|
|---|
| 337 | IF ( NFRAGM .EQ. 0 ) THEN
|
|---|
| 338 | C LOOK, HOW MANY PROTONS AND NEUTRONS ARE FORMED
|
|---|
| 339 | IZNEW = IANEW / 2.15D0 + 0.7D0
|
|---|
| 340 | INEUTR = IANEW - IZNEW
|
|---|
| 341 | INACTZ = MAX( IZ-IZNEW, 0 )
|
|---|
| 342 |
|
|---|
| 343 | IF ( IZNEW .GT. 0 ) THEN
|
|---|
| 344 | C PROTONS
|
|---|
| 345 | SECPAR(1) = 14.D0
|
|---|
| 346 | DO 300 L = 1,IZNEW
|
|---|
| 347 | CALL TSTACK
|
|---|
| 348 | 300 CONTINUE
|
|---|
| 349 | ENDIF
|
|---|
| 350 | IF ( INEUTR .GT. 0 ) THEN
|
|---|
| 351 | C NEUTRONS
|
|---|
| 352 | SECPAR(1) = 13.D0
|
|---|
| 353 | DO 310 L = 1,INEUTR
|
|---|
| 354 | CALL TSTACK
|
|---|
| 355 | 310 CONTINUE
|
|---|
| 356 | ENDIF
|
|---|
| 357 |
|
|---|
| 358 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 359 | C NO FRAGMENTATION, BUT SUCCESSIVE ABRASION OF PROJECTILE NUCLEUS
|
|---|
| 360 | ELSE
|
|---|
| 361 | IF ( DEBUG ) WRITE( MDEBUG,111 ) TAR,INACTA,IANEW
|
|---|
| 362 | 111 FORMAT(' SDPM : TARGET=',F4.0,' INACTA=',I4,' IANEW=',I4)
|
|---|
| 363 |
|
|---|
| 364 | C ALL NUCLEONS INTERACT, NO RESIDUAL NUCLEUS
|
|---|
| 365 | IF ( IANEW .EQ. 0 ) THEN
|
|---|
| 366 | INACTZ = IZ
|
|---|
| 367 | IF ( DEBUG ) WRITE(MDEBUG,554) (CURPAR(I),I=1,9)
|
|---|
| 368 | 554 FORMAT (' SDPM : CURPAR=',1P,9E10.3)
|
|---|
| 369 | KNEW = 0
|
|---|
| 370 |
|
|---|
| 371 | C REMAINING NUCLEUS IS A NUCLEON
|
|---|
| 372 | ELSEIF ( IANEW .EQ. 1 ) THEN
|
|---|
| 373 | CALL RMMAR( RD,1,1 )
|
|---|
| 374 | IZNEW = NINT(RD(1))
|
|---|
| 375 | INACTZ = IZ - IZNEW
|
|---|
| 376 | KNEW = 13 + IZNEW
|
|---|
| 377 |
|
|---|
| 378 | C REMAINING NUCLEUS GETS A CHARGE WHICH IS ABOUT HALF THE MASS NUMBER
|
|---|
| 379 | ELSEIF ( IANEW .GT. 1 ) THEN
|
|---|
| 380 | IZNEW = FLOAT(IANEW) / 2.15D0 + 0.7D0
|
|---|
| 381 | INACTZ = MAX( IZ - IZNEW, 0 )
|
|---|
| 382 | KNEW = IANEW*100 + IZNEW
|
|---|
| 383 |
|
|---|
| 384 | C REMAINING NUCLEUS DEEXCITES BY EVAPORATION OF NUCLEONS/ALPHA PARTCLS.
|
|---|
| 385 | IF ( NFRAGM .GE. 2 ) THEN
|
|---|
| 386 | JFIN=0
|
|---|
| 387 | CALL VAPOR(IA,KNEW,JFIN,ITYP,PFRX,PFRY)
|
|---|
| 388 | IF ( JFIN .LE. 0 ) GOTO 190
|
|---|
| 389 | KNEW = 0
|
|---|
| 390 | DO 135 J=1,JFIN
|
|---|
| 391 | EA = GAMMA * PAMA(ITYP(J))
|
|---|
| 392 | IF (DEBUG) WRITE (MDEBUG,*)'SDPM : J,ITYP,EA=',
|
|---|
| 393 | * J,ITYP,SNGL(EA)
|
|---|
| 394 | PTM = EA**2 - PAMA(ITYP(J))**2
|
|---|
| 395 | PT2 = PFRX(J)**2 + PFRY(J)**2
|
|---|
| 396 | IF ( PT2 .GE. PTM ) THEN
|
|---|
| 397 | IF (DEBUG) WRITE(MDEBUG,*)'SDPM : PT REJECT ',J
|
|---|
| 398 | GOTO 135
|
|---|
| 399 | ENDIF
|
|---|
| 400 | IF ( PTM .GT. 0.D0 ) THEN
|
|---|
| 401 | COSTET = SQRT( 1.D0 - PT2/PTM )
|
|---|
| 402 | ELSE
|
|---|
| 403 | COSTET = 1.D0
|
|---|
| 404 | ENDIF
|
|---|
| 405 | IF ( PFRX(J) .NE. 0.D0 .OR. PFRY(J) .NE. 0.D0 ) THEN
|
|---|
| 406 | PHIV = ATAN2( PFRY(J), PFRX(J) )
|
|---|
| 407 | ELSE
|
|---|
| 408 | PHIV = 0.D0
|
|---|
| 409 | ENDIF
|
|---|
| 410 | CALL ADDANG( COSTHE,PHI, COSTET,PHIV,
|
|---|
| 411 | * SECPAR(3),SECPAR(4) )
|
|---|
| 412 | IF ( SECPAR(3) .GE. C(29) ) THEN
|
|---|
| 413 | IF ( J .LT. JFIN ) THEN
|
|---|
| 414 | SECPAR(1) = ITYP(J)
|
|---|
| 415 | CALL TSTACK
|
|---|
| 416 | ELSE
|
|---|
| 417 | KNEW = ITYP(JFIN)
|
|---|
| 418 | IANEW = KNEW/100
|
|---|
| 419 | ENDIF
|
|---|
| 420 | ELSE
|
|---|
| 421 | IF (DEBUG) WRITE(MDEBUG,*)'SDPM : ANGLE REJECT ',J
|
|---|
| 422 | ENDIF
|
|---|
| 423 | 135 CONTINUE
|
|---|
| 424 | ENDIF
|
|---|
| 425 | ENDIF
|
|---|
| 426 |
|
|---|
| 427 | C REMAINING NUCLEUS: MASS 5 CANNOT BE TREATED IN BOX2
|
|---|
| 428 | IF ( KNEW/100 .EQ. 5 ) THEN
|
|---|
| 429 | IF ( MOD(KNEW,100) .GE. 3 ) THEN
|
|---|
| 430 | C MASS 5: SPLIT OFF ONE PROTON
|
|---|
| 431 | SECPAR(1) = 14.D0
|
|---|
| 432 | CALL TSTACK
|
|---|
| 433 | KNEW = KNEW - 101
|
|---|
| 434 | ELSE
|
|---|
| 435 | C MASS 5: SPLIT OFF ONE NEUTRON
|
|---|
| 436 | SECPAR(1) = 13.D0
|
|---|
| 437 | CALL TSTACK
|
|---|
| 438 | KNEW = KNEW - 100
|
|---|
| 439 | ENDIF
|
|---|
| 440 |
|
|---|
| 441 | C REMAINING NUCLEUS: MASS 8 CANNOT BE TREATED IN BOX2
|
|---|
| 442 | ELSEIF ( KNEW/100 .EQ. 8 ) THEN
|
|---|
| 443 | IF ( MOD(KNEW,100) .GE. 5 ) THEN
|
|---|
| 444 | C MASS 8: SPLIT OFF ONE PROTON
|
|---|
| 445 | SECPAR(1) = 14.D0
|
|---|
| 446 | CALL TSTACK
|
|---|
| 447 | KNEW = KNEW - 101
|
|---|
| 448 | ELSEIF ( MOD(KNEW,100) .LE. 3 ) THEN
|
|---|
| 449 | C MASS 8: SPLIT OFF ONE NEUTRON
|
|---|
| 450 | SECPAR(1) = 13.D0
|
|---|
| 451 | CALL TSTACK
|
|---|
| 452 | KNEW = KNEW - 100
|
|---|
| 453 | ELSE
|
|---|
| 454 | C MASS 8: SPLIT OFF ONE ALPHA PARTICLE
|
|---|
| 455 | SECPAR(1) = 402.D0
|
|---|
| 456 | CALL TSTACK
|
|---|
| 457 | KNEW = KNEW - 402
|
|---|
| 458 | ENDIF
|
|---|
| 459 | ENDIF
|
|---|
| 460 |
|
|---|
| 461 | IF ( KNEW .GT. 0 ) THEN
|
|---|
| 462 | SECPAR(1) = KNEW
|
|---|
| 463 | CALL TSTACK
|
|---|
| 464 | IF ( DEBUG ) WRITE(MDEBUG,555) (SECPAR(I),I=1,9)
|
|---|
| 465 | 555 FORMAT (' SDPM : SECPAR=',1P,9E10.3)
|
|---|
| 466 | ENDIF
|
|---|
| 467 | ENDIF
|
|---|
| 468 |
|
|---|
| 469 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|---|
| 470 | C HERE THE REACTING NUCLEONS ARE TREATED
|
|---|
| 471 | 190 NPRPRO = INACTZ
|
|---|
| 472 | NNEPRO = INACTA - INACTZ
|
|---|
| 473 |
|
|---|
| 474 | C TREAT INTERACTING NEUTRONS FROM PROJECTILE
|
|---|
| 475 | IF ( NNEPRO .GE. 1 ) THEN
|
|---|
| 476 | CURPAR(1) = 13.D0
|
|---|
| 477 | ITYPE = 13
|
|---|
| 478 | C CALCULATE GAMMA, BETA AND ENERGY IN CENTER OF MASS
|
|---|
| 479 | GCM = SQRT( GAMMA * 0.5D0 + 0.5D0 )
|
|---|
| 480 | ECM = PAMA(ITYPE) * GCM * 2.D0
|
|---|
| 481 | BETACM = SQRT( 1.D0 - 1.D0 / GCM**2 )
|
|---|
| 482 | DO 200 LL = 1,NNEPRO
|
|---|
| 483 | C USE GHEISHA IF THE CROSS SECTION HAS BEEN CALCULATED FOR GHEISHA
|
|---|
| 484 | IF ( GHEISH .AND. ECM .LE. HILOECM ) THEN
|
|---|
| 485 | ELAB = PAMA(ITYPE) * GAMMA
|
|---|
| 486 | PLAB = ELAB * BETA
|
|---|
| 487 | EKIN = ELAB - PAMA(ITYPE)
|
|---|
| 488 | SIGAIR = CGHSIG(SNGL(PLAB),SNGL(EKIN),ITYPE)
|
|---|
| 489 | CALL CGHEI
|
|---|
| 490 | ELSE
|
|---|
| 491 | C DETERMINE TYPE OF INTERACTION FOR NUCLEONS AND ANTINUCLEONS
|
|---|
| 492 | IF ( ECM .GT. CC(4) ) THEN
|
|---|
| 493 | C DUAL PARTON MODEL
|
|---|
| 494 | CALL HDPM
|
|---|
| 495 | ELSEIF ( ECM .GT. CC(3) ) THEN
|
|---|
| 496 | C USE THE INTERACTION ROUTINES OF PKF GRIEDER
|
|---|
| 497 | C 2 HEAVY ISOBARS AND ANNIHILATION
|
|---|
| 498 | CALL BOX63
|
|---|
| 499 | ELSEIF ( ECM .GT. CC(2) ) THEN
|
|---|
| 500 | C 1 HEAVY ISOBAR + NUCLEON AND ANNIHILATION
|
|---|
| 501 | CALL BOX62
|
|---|
| 502 | ELSEIF ( ECM .GT. CC(1) ) THEN
|
|---|
| 503 | C 1 LIGHT ISOBAR + NUCLEON AND ANNIHILATION
|
|---|
| 504 | CALL BOX61
|
|---|
| 505 | ELSE
|
|---|
| 506 | C ELASTIC SCATTERING AND ANNIHILATION
|
|---|
| 507 | CALL BOX60
|
|---|
| 508 | ENDIF
|
|---|
| 509 | ENDIF
|
|---|
| 510 | 200 CONTINUE
|
|---|
| 511 | ENDIF
|
|---|
| 512 |
|
|---|
| 513 | C TREAT INTERACTING PROTONS FROM PROJECTILE IN ROUTINE HDPM
|
|---|
| 514 | IF ( NPRPRO .GE. 1 ) THEN
|
|---|
| 515 | CURPAR(1) = 14.D0
|
|---|
| 516 | ITYPE = 14
|
|---|
| 517 | C CALCULATE GAMMA, BETA AND ENERGY IN CENTER OF MASS
|
|---|
| 518 | GCM = SQRT( GAMMA * 0.5D0 + 0.5D0 )
|
|---|
| 519 | ECM = PAMA(ITYPE) * GCM * 2.D0
|
|---|
| 520 | BETACM = SQRT( 1.D0 - 1.D0 / GCM**2 )
|
|---|
| 521 | DO 210 LL = 1,NPRPRO
|
|---|
| 522 | C USE GHEISHA IF THE CROSS SECTION HAS BEEN CALCULATED FOR GHEISHA
|
|---|
| 523 | IF ( GHEISH .AND. ECM .LE. HILOECM ) THEN
|
|---|
| 524 | ELAB = PAMA(ITYPE) * GAMMA
|
|---|
| 525 | PLAB = ELAB * BETA
|
|---|
| 526 | EKIN = ELAB - PAMA(ITYPE)
|
|---|
| 527 | SIGAIR = CGHSIG(SNGL(PLAB),SNGL(EKIN),ITYPE)
|
|---|
| 528 | CALL CGHEI
|
|---|
| 529 | ELSE
|
|---|
| 530 | C DETERMINE TYPE OF INTERACTION FOR NUCLEONS AND ANTINUCLEONS
|
|---|
| 531 | IF ( ECM .GT. CC(4) ) THEN
|
|---|
| 532 | C DUAL PARTON MODEL
|
|---|
| 533 | CALL HDPM
|
|---|
| 534 | ELSEIF ( ECM .GT. CC(3) ) THEN
|
|---|
| 535 | C USE THE INTERACTION ROUTINES OF PKF GRIEDER
|
|---|
| 536 | C 2 HEAVY ISOBARS AND ANNIHILATION
|
|---|
| 537 | CALL BOX63
|
|---|
| 538 | ELSEIF ( ECM .GT. CC(2) ) THEN
|
|---|
| 539 | C 1 HEAVY ISOBAR + NUCLEON AND ANNIHILATION
|
|---|
| 540 | CALL BOX62
|
|---|
| 541 | ELSEIF ( ECM .GT. CC(1) ) THEN
|
|---|
| 542 | C 1 LIGHT ISOBAR + NUCLEON AND ANNIHILATION
|
|---|
| 543 | CALL BOX61
|
|---|
| 544 | ELSE
|
|---|
| 545 | C ELASTIC SCATTERING AND ANNIHILATION
|
|---|
| 546 | CALL BOX60
|
|---|
| 547 | ENDIF
|
|---|
| 548 | ENDIF
|
|---|
| 549 | 210 CONTINUE
|
|---|
| 550 | ENDIF
|
|---|
| 551 |
|
|---|
| 552 | C ALL PARTICLES, INCLUDING THE LEADING ONE, ARE NOW WRITTEN TO STACK
|
|---|
| 553 |
|
|---|
| 554 | ELSE
|
|---|
| 555 | WRITE(MONIOU,*) 'SDPM : NOT FORESEEN PARTICLE TYPE=',ITYPE
|
|---|
| 556 | STOP
|
|---|
| 557 | ENDIF
|
|---|
| 558 |
|
|---|
| 559 | RETURN
|
|---|
| 560 | END
|
|---|
