| 1 | SUBROUTINE VSTORE
|
|---|
| 2 |
|
|---|
| 3 | C-----------------------------------------------------------------------
|
|---|
| 4 | C V(ENUS PARTICLES) STORE (INTO CORSIKA STACK)
|
|---|
| 5 | C
|
|---|
| 6 | C STORES VENUS OUTPUT PARTICLES INTO CORSIKA STACK
|
|---|
| 7 | C THIS SUBROUTINE IS CALLED FROM VENLNK
|
|---|
| 8 | C
|
|---|
| 9 | C DESIGN : D. HECK IK3 FZK KARLSRUHE
|
|---|
| 10 | C-----------------------------------------------------------------------
|
|---|
| 11 |
|
|---|
| 12 | *KEEP,CONST.
|
|---|
| 13 | COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER
|
|---|
| 14 | DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
|
|---|
| 15 | *KEEP,DPMFLG.
|
|---|
| 16 | COMMON /DPMFLG/ NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
|
|---|
| 17 | INTEGER NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
|
|---|
| 18 | *KEEP,ELADPM.
|
|---|
| 19 | COMMON /ELADPM/ ELMEAN,ELMEAA,IELDPM,IELDPA
|
|---|
| 20 | DOUBLE PRECISION ELMEAN(37),ELMEAA(37)
|
|---|
| 21 | INTEGER IELDPM(37,13),IELDPA(37,13)
|
|---|
| 22 | *KEEP,ELASTY.
|
|---|
| 23 | COMMON /ELASTY/ ELAST,IELIS,IELHM,IELNU,IELPI
|
|---|
| 24 | DOUBLE PRECISION ELAST
|
|---|
| 25 | INTEGER IELIS(20),IELHM(20),IELNU(20),IELPI(20)
|
|---|
| 26 | *KEEP,INTER.
|
|---|
| 27 | COMMON /INTER/ AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
|
|---|
| 28 | * FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
|
|---|
| 29 | * RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
|
|---|
| 30 | * WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
|
|---|
| 31 | * IDIF,ITAR
|
|---|
| 32 | DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
|
|---|
| 33 | * FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
|
|---|
| 34 | * RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
|
|---|
| 35 | * WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
|
|---|
| 36 | INTEGER IDIF,ITAR
|
|---|
| 37 | *KEEP,ISTA.
|
|---|
| 38 | COMMON /ISTA/ IFINET,IFINNU,IFINKA,IFINPI,IFINHY
|
|---|
| 39 | INTEGER IFINET,IFINNU,IFINKA,IFINPI,IFINHY
|
|---|
| 40 | *KEEP,MULT.
|
|---|
| 41 | COMMON /MULT/ EKINL,MSMM,MULTMA,MULTOT
|
|---|
| 42 | DOUBLE PRECISION EKINL
|
|---|
| 43 | INTEGER MSMM,MULTMA(37,13),MULTOT(37,13)
|
|---|
| 44 | *KEEP,PAM.
|
|---|
| 45 | COMMON /PAM/ PAMA,SIGNUM
|
|---|
| 46 | DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
|
|---|
| 47 | *KEEP,PARPAR.
|
|---|
| 48 | COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
|
|---|
| 49 | * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
|
|---|
| 50 | DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
|
|---|
| 51 | * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
|
|---|
| 52 | INTEGER ITYPE,LEVL
|
|---|
| 53 | *KEEP,PARPAE.
|
|---|
| 54 | DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
|
|---|
| 55 | EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
|
|---|
| 56 | * (CURPAR(4), PHI ), (CURPAR(5), H ),
|
|---|
| 57 | * (CURPAR(6), T ), (CURPAR(7), X ),
|
|---|
| 58 | * (CURPAR(8), Y ), (CURPAR(9), CHI ),
|
|---|
| 59 | * (CURPAR(10),BETA), (CURPAR(11),GCM ),
|
|---|
| 60 | * (CURPAR(12),ECM )
|
|---|
| 61 | *KEEP,RANDPA.
|
|---|
| 62 | COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
|
|---|
| 63 | DOUBLE PRECISION FAC,U1,U2
|
|---|
| 64 | REAL RD(3000)
|
|---|
| 65 | INTEGER ISEED(103,10),NSEQ
|
|---|
| 66 | LOGICAL KNOR
|
|---|
| 67 | *KEEP,REST.
|
|---|
| 68 | COMMON /REST/ CONTNE,TAR,LT
|
|---|
| 69 | DOUBLE PRECISION CONTNE(3),TAR
|
|---|
| 70 | INTEGER LT
|
|---|
| 71 | *KEEP,RUNPAR.
|
|---|
| 72 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
|---|
| 73 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
|---|
| 74 | * MONIOU,MDEBUG,NUCNUC,
|
|---|
| 75 | * CETAPE,
|
|---|
| 76 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 77 | * N1STTR,MDBASE,
|
|---|
| 78 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 79 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 80 | * ,GHEISH,GHESIG
|
|---|
| 81 | COMMON /RUNPAC/ DSN,HOST,USER
|
|---|
| 82 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
|---|
| 83 | REAL STEPFC
|
|---|
| 84 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
|---|
| 85 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 86 | * N1STTR,MDBASE
|
|---|
| 87 | INTEGER CETAPE
|
|---|
| 88 | CHARACTER*79 DSN
|
|---|
| 89 | CHARACTER*20 HOST,USER
|
|---|
| 90 |
|
|---|
| 91 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 92 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 93 | * ,GHEISH,GHESIG
|
|---|
| 94 | *KEND.
|
|---|
| 95 |
|
|---|
| 96 | PARAMETER (KOLLMX=2500)
|
|---|
| 97 | PARAMETER (MXPTL=70000)
|
|---|
| 98 | PARAMETER (MXSTR=3000)
|
|---|
| 99 | PARAMETER (NDEP=129)
|
|---|
| 100 | PARAMETER (NDET=129)
|
|---|
| 101 | COMMON /ACCUM/ AMSAC,ILAMAS,IMSG,INOIAC,IPAGE,JERR,NAEVT,NREVT
|
|---|
| 102 | * ,NRPTL,NRSTR,NTEVT
|
|---|
| 103 | COMMON /CEVT/ BIMEVT,COLEVT,EGYEVT,PHIEVT,PMXEVT
|
|---|
| 104 | * ,KOLEVT,NEVT,NPJEVT,NTGEVT
|
|---|
| 105 | COMMON /COL/ BIMP,BMAX,COORD(4,KOLLMX),DISTCE(KOLLMX)
|
|---|
| 106 | * ,QDEP(NDEP),QDET14(NDET),QDET16(NDET),QDET40(NDET)
|
|---|
| 107 | * ,QDET99(NDET),RMPROJ,RMTARG(4),XDEP(NDEP)
|
|---|
| 108 | * ,XDET14(NDET),XDET16(NDET),XDET40(NDET)
|
|---|
| 109 | * ,XDET99(NDET)
|
|---|
| 110 | * ,KOLL,LTARG,NORD(KOLLMX),NPROJ,NRPROJ(KOLLMX)
|
|---|
| 111 | * ,NRTARG(KOLLMX),NTARG
|
|---|
| 112 | COMMON /CPTL/ PPTL(5,MXPTL),TIVPTL(2,MXPTL),XORPTL(4,MXPTL)
|
|---|
| 113 | * ,IBPTL(4,MXPTL),ICLPTL(MXPTL),IDPTL(MXPTL)
|
|---|
| 114 | * ,IFRPTL(2,MXPTL),IORPTL(MXPTL),ISTPTL(MXPTL)
|
|---|
| 115 | * ,JORPTL(MXPTL),NPTL,NQJPTL(MXPTL)
|
|---|
| 116 | COMMON /CSTR/ PSTR(5,MXSTR),ROTSTR(3,MXSTR),XORSTR(4,MXSTR)
|
|---|
| 117 | * ,ICSTR(4,MXSTR),IORSTR(MXSTR),IRLSTR(MXSTR),NSTR
|
|---|
| 118 | COMMON /FILES/ IFCH,IFDT,IFHI,IFMT,IFOP
|
|---|
| 119 | COMMON /PARO2/ AMPROJ,AMTARG,ANGMUE,ELEPTI,ELEPTO,ENGY
|
|---|
| 120 | * ,PNLL,PNLLX,PROB(99),PROSEA,RHOPHI,TAUREA
|
|---|
| 121 | * ,YHAHA,YMXIMI,YPJTL
|
|---|
| 122 | * ,ICBAC(99,2),ICFOR(99,2),ICHOIC,ICLHIS,IDPM
|
|---|
| 123 | * ,IDPROJ,IDTARG,IENTRO,IJPHIS,IMIHIS,IPAGI,ISH
|
|---|
| 124 | * ,ISHEVT,ISHSUB,ISPALL,ISPHIS,ISTMAX,ISUP,IVI
|
|---|
| 125 | * ,JPSI,JPSIFI,KUTDIQ,LAPROJ,LATARG,MAPROJ,MATARG
|
|---|
| 126 | * ,MODSHO,NDECAX,NDECAY,NEVENT
|
|---|
| 127 | COMMON /PARO3/ ASUHAX(7),ASUHAY(7),OMEGA,SIGPPD,SIGPPE,UENTRO
|
|---|
| 128 | * ,IWZZZZ
|
|---|
| 129 |
|
|---|
| 130 | DOUBLE PRECISION EA,ELASTI,EMAX,GAMMAX,COSTET,PHIV,PL2,PT2,PTM
|
|---|
| 131 | DOUBLE PRECISION PFRX(60),PFRY(60)
|
|---|
| 132 | INTEGER ITYP(60),NRPTLA(MXPTL)
|
|---|
| 133 | C-----------------------------------------------------------------------
|
|---|
| 134 |
|
|---|
| 135 | IF ( DEBUG ) WRITE(MDEBUG,*) 'VSTORE:'
|
|---|
| 136 |
|
|---|
| 137 | C NUMBER OF SPECTATORS OF REMAINING NUCLEUS IS NREST
|
|---|
| 138 | NREST = ITYPE/100 - NPJEVT
|
|---|
| 139 | IREST = ITYPE
|
|---|
| 140 | NNEW = 0
|
|---|
| 141 | INEW = 0
|
|---|
| 142 | ETOT = 0.
|
|---|
| 143 |
|
|---|
| 144 | LEVT = 1
|
|---|
| 145 | LPTL = 3
|
|---|
| 146 | NPTLS = 0
|
|---|
| 147 | DO 1 I=1,NPTL
|
|---|
| 148 | NRPTLA(I) = -999
|
|---|
| 149 | IF ( ISTPTL(I) .GT. ISTMAX ) GOTO 1
|
|---|
| 150 | NPTLS = NPTLS+1
|
|---|
| 151 | NRPTLA(I) = NPTLS
|
|---|
| 152 | 1 CONTINUE
|
|---|
| 153 |
|
|---|
| 154 | C EVENT VARIABLES:
|
|---|
| 155 | C LEVT................... RECORD LABEL (LEVT=1)
|
|---|
| 156 | C NREVT.................. EVENT NUMBER
|
|---|
| 157 | C NPTLS ................. NUMBER OF (STORED!) PARTICLES PER EVENT
|
|---|
| 158 | C BIMEVT ................ IMPACT PARAMETER
|
|---|
| 159 | C KOLEVT,COLEVT ......... REAL/EFFECTIVE # OF COLLISIONS
|
|---|
| 160 | C PMXEVT ................ REFERENCE MOMENTUM
|
|---|
| 161 | C EGYEVT ................ PP CM ENERGY (HAD) OR STRING ENERGY (STR)
|
|---|
| 162 | C NPJEVT,NTGEVT ......... # OF PROJ/TARG PARTICIPANTS
|
|---|
| 163 |
|
|---|
| 164 | GNU = KOLEVT
|
|---|
| 165 | GNU = COLEVT
|
|---|
| 166 | C SET COORDINATES, WHICH ARE IDENTICAL FOR ALL SECONDARY PARTICLES
|
|---|
| 167 | DO 6 I=5,8
|
|---|
| 168 | SECPAR(I) = CURPAR(I)
|
|---|
| 169 | 6 CONTINUE
|
|---|
| 170 | CC GAMMAX = 0.D0
|
|---|
| 171 | EMAX = 0.D0
|
|---|
| 172 |
|
|---|
| 173 | C PARTICLE LOOP
|
|---|
| 174 | DO 5 I=1,NPTL
|
|---|
| 175 | IF ( NRPTLA(I) .LE. 0 ) GOTO 5
|
|---|
| 176 |
|
|---|
| 177 | C PARTICLE VARIABLES:
|
|---|
| 178 | C LPTL ......... RECORD LABEL (LPTL=3)
|
|---|
| 179 | C NREVT ........ EVENT NUMBER
|
|---|
| 180 | C NRPTL ........ PARTICLE NUMBER
|
|---|
| 181 | C I ............ ORIGINAL PTL NUMBER
|
|---|
| 182 | C IDPTL ........ PARTICLE ID
|
|---|
| 183 | C PPTL ......... 5-MOMENTUM (PX,PY,PZ,EN,MASS) IN LAB
|
|---|
| 184 | C IOPTL ........ ORIGIN (-999:PARENT NOT STORED, -1,0:NO PARENT)
|
|---|
| 185 | C JOPTL ........ ORIGIN (SECOND PARENT)
|
|---|
| 186 | C ISTPTL ....... STABLE (=0) OR NOT (=1)
|
|---|
| 187 | C XORPTL ....... SPACE-TIME POINT (X,Y,Z,T) ON PTL TRACK (PP-CM)
|
|---|
| 188 | C TIVPTL ....... TIME INTERVAL OF EXISTENCE
|
|---|
| 189 | C NQJPTL ....... QUARK NUMBERS OF JETS
|
|---|
| 190 |
|
|---|
| 191 | C ELIMINATE TARGET SPECTATORS
|
|---|
| 192 | IF ( PPTL(3,I) .EQ. 0. ) GOTO 5
|
|---|
| 193 |
|
|---|
| 194 | C ELIMINATE BACKWARD GOING PARTICLES
|
|---|
| 195 | IF ( PPTL(3,I) .LT. 0. ) GOTO 5
|
|---|
| 196 | C CONVERT PARTICLE CODE VEN(US) ---> C(O)RS(IKA)
|
|---|
| 197 | C MOST FREQUENT PARTICLES COME FIRST
|
|---|
| 198 | KODVEN = IDPTL(I)
|
|---|
| 199 | C MESONS
|
|---|
| 200 | IF ( KODVEN .EQ. 110 ) THEN
|
|---|
| 201 | KODCRS = 7
|
|---|
| 202 | ELSEIF ( KODVEN .EQ. 120 ) THEN
|
|---|
| 203 | KODCRS = 8
|
|---|
| 204 | ELSEIF ( KODVEN .EQ. -120 ) THEN
|
|---|
| 205 | KODCRS = 9
|
|---|
| 206 | ELSEIF ( KODVEN .EQ. 220 ) THEN
|
|---|
| 207 | KODCRS = 17
|
|---|
| 208 | C NUCLEONS
|
|---|
| 209 | ELSEIF ( KODVEN .EQ. 1220 ) THEN
|
|---|
| 210 | KODCRS = 13
|
|---|
| 211 | ELSEIF ( KODVEN .EQ. 1120 ) THEN
|
|---|
| 212 | KODCRS = 14
|
|---|
| 213 | ELSEIF ( KODVEN .EQ. -1120 ) THEN
|
|---|
| 214 | KODCRS = 15
|
|---|
| 215 | ELSEIF ( KODVEN .EQ. -1220 ) THEN
|
|---|
| 216 | KODCRS = 25
|
|---|
| 217 | C STRANGE MESONS
|
|---|
| 218 | ELSEIF ( KODVEN .EQ. -20 ) THEN
|
|---|
| 219 | KODCRS = 10
|
|---|
| 220 | ELSEIF ( KODVEN .EQ. 130 ) THEN
|
|---|
| 221 | KODCRS = 11
|
|---|
| 222 | ELSEIF ( KODVEN .EQ. -130 ) THEN
|
|---|
| 223 | KODCRS = 12
|
|---|
| 224 | ELSEIF ( KODVEN .EQ. 20 ) THEN
|
|---|
| 225 | KODCRS = 16
|
|---|
| 226 | C STRANGE BARYONS
|
|---|
| 227 | ELSEIF ( KODVEN .EQ. 2130 ) THEN
|
|---|
| 228 | KODCRS = 18
|
|---|
| 229 | ELSEIF ( KODVEN .EQ. 1130 ) THEN
|
|---|
| 230 | KODCRS = 19
|
|---|
| 231 | ELSEIF ( KODVEN .EQ. 1230 ) THEN
|
|---|
| 232 | KODCRS = 20
|
|---|
| 233 | ELSEIF ( KODVEN .EQ. 2230 ) THEN
|
|---|
| 234 | KODCRS = 21
|
|---|
| 235 | ELSEIF ( KODVEN .EQ. 1330 ) THEN
|
|---|
| 236 | KODCRS = 22
|
|---|
| 237 | ELSEIF ( KODVEN .EQ. 2330 ) THEN
|
|---|
| 238 | KODCRS = 23
|
|---|
| 239 | ELSEIF ( KODVEN .EQ. 3331 ) THEN
|
|---|
| 240 | KODCRS = 24
|
|---|
| 241 | ELSEIF ( KODVEN .EQ. -2130 ) THEN
|
|---|
| 242 | KODCRS = 26
|
|---|
| 243 | ELSEIF ( KODVEN .EQ. -1130 ) THEN
|
|---|
| 244 | KODCRS = 27
|
|---|
| 245 | ELSEIF ( KODVEN .EQ. -1230 ) THEN
|
|---|
| 246 | KODCRS = 28
|
|---|
| 247 | ELSEIF ( KODVEN .EQ. -2230 ) THEN
|
|---|
| 248 | KODCRS = 29
|
|---|
| 249 | ELSEIF ( KODVEN .EQ. -1330 ) THEN
|
|---|
| 250 | KODCRS = 30
|
|---|
| 251 | ELSEIF ( KODVEN .EQ. -2330 ) THEN
|
|---|
| 252 | KODCRS = 31
|
|---|
| 253 | ELSEIF ( KODVEN .EQ. -3331 ) THEN
|
|---|
| 254 | KODCRS = 32
|
|---|
| 255 | C LEPTONS
|
|---|
| 256 | ELSEIF ( KODVEN .EQ. 10 ) THEN
|
|---|
| 257 | KODCRS = 1
|
|---|
| 258 | ELSEIF ( KODVEN .EQ. -12 ) THEN
|
|---|
| 259 | KODCRS = 2
|
|---|
| 260 | ELSEIF ( KODVEN .EQ. 12 ) THEN
|
|---|
| 261 | KODCRS = 3
|
|---|
| 262 | ELSEIF ( KODVEN .EQ. -14 ) THEN
|
|---|
| 263 | KODCRS = 5
|
|---|
| 264 | ELSEIF ( KODVEN .EQ. 14 ) THEN
|
|---|
| 265 | KODCRS = 6
|
|---|
| 266 | C NEUTRINOS ARE SKIPPED
|
|---|
| 267 | ELSEIF ( KODVEN .EQ. 11 ) THEN
|
|---|
| 268 | GOTO 5
|
|---|
| 269 | ELSEIF ( KODVEN .EQ. -11 ) THEN
|
|---|
| 270 | GOTO 5
|
|---|
| 271 | ELSEIF ( KODVEN .EQ. 13 ) THEN
|
|---|
| 272 | GOTO 5
|
|---|
| 273 | ELSEIF ( KODVEN .EQ. -13 ) THEN
|
|---|
| 274 | GOTO 5
|
|---|
| 275 | ELSE
|
|---|
| 276 | WRITE(MONIOU,*)'VSTORE: UNKNOWN PARTICLE CODE IDPTL=',IDPTL(I)
|
|---|
| 277 | GOTO 5
|
|---|
| 278 | ENDIF
|
|---|
| 279 | SECPAR(1) = KODCRS
|
|---|
| 280 |
|
|---|
| 281 | IF ( KODCRS .NE. 1 .AND. KODCRS .LE. 65 ) THEN
|
|---|
| 282 | C ORDINARY SECONDARY PARTICLES
|
|---|
| 283 | SECPAR(2) = PPTL(4,I)/PAMA(KODCRS)
|
|---|
| 284 | C LOOK FOR SPECTATOR NUCLEONS
|
|---|
| 285 | IF ( KODCRS .EQ. 13 .OR. KODCRS .EQ. 14 ) THEN
|
|---|
| 286 | C ELIMINATE TARGET SPECTATORS
|
|---|
| 287 | IF ( SECPAR(2) .LE. 1.002D0 ) GOTO 5
|
|---|
| 288 | C TREAT PROJECTILE SPECTATORS
|
|---|
| 289 | IF ( SECPAR(2) .GT. 0.999D0*GAMMA .AND.
|
|---|
| 290 | * SECPAR(2) .LT. 1.001D0*GAMMA .AND.
|
|---|
| 291 | * PPTL(1,I).EQ.0. .AND. PPTL(2,I).EQ.0. ) THEN
|
|---|
| 292 | IF ( NFRAGM .NE. 0 ) THEN
|
|---|
| 293 | C COMPOSE PROJECTILE SPECTATORS TO REMAINING NUCLEUS
|
|---|
| 294 | NREST = NREST - 1
|
|---|
| 295 | NNEW = NNEW + 1
|
|---|
| 296 | IF ( KODCRS .EQ. 14 ) THEN
|
|---|
| 297 | INEW = INEW + 101
|
|---|
| 298 | IREST = IREST - 101
|
|---|
| 299 | ELSEIF ( KODCRS .EQ. 13 ) THEN
|
|---|
| 300 | INEW = INEW + 100
|
|---|
| 301 | IREST = IREST - 100
|
|---|
| 302 | ENDIF
|
|---|
| 303 | GOTO 5
|
|---|
| 304 | ENDIF
|
|---|
| 305 | C DISREGARD PROJECTILE SPECTATORS FOR ELASTICITY
|
|---|
| 306 | GOTO 7
|
|---|
| 307 | ENDIF
|
|---|
| 308 | ENDIF
|
|---|
| 309 |
|
|---|
| 310 | CC IF ( SECPAR(2) .GT. GAMMAX ) THEN
|
|---|
| 311 | CC GAMMAX = SECPAR(2)
|
|---|
| 312 | C CALCULATE ELASTICITY FROM ENERGY OF FASTEST PARTICLE (LEADER)
|
|---|
| 313 | CC ELASTI = GAMMAX * PAMA(KODCRS) / ELAB
|
|---|
| 314 | CC ENDIF
|
|---|
| 315 | IF ( SECPAR(2)*PAMA(KODCRS) .GT. EMAX ) THEN
|
|---|
| 316 | EMAX = SECPAR(2)*PAMA(KODCRS)
|
|---|
| 317 | C CALCULATE ELASTICITY FROM MOST ENERGETIC PARTICLE (LEADER)
|
|---|
| 318 | ELASTI = EMAX / ELAB
|
|---|
| 319 | ENDIF
|
|---|
| 320 | ELSE
|
|---|
| 321 | C GAMMAS AND NEUTRINOS
|
|---|
| 322 | SECPAR(2) = PPTL(4,I)
|
|---|
| 323 | ENDIF
|
|---|
| 324 |
|
|---|
| 325 | C COUNTER FOR ENERGY-MULTIPLICITY MATRIX
|
|---|
| 326 | MSMM = MSMM + 1
|
|---|
| 327 |
|
|---|
| 328 | C DETERMINE ANGLES FROM LONGITUDINAL AND TRANSVERSAL MOMENTA
|
|---|
| 329 | 7 CONTINUE
|
|---|
| 330 | PT2 = DBLE(PPTL(1,I))**2 + DBLE(PPTL(2,I))**2
|
|---|
| 331 | PL2 = DBLE(PPTL(3,I))**2
|
|---|
| 332 |
|
|---|
| 333 | IF ( PL2+PT2 .LE. 0.D0 ) THEN
|
|---|
| 334 | COSTET = 0.D0
|
|---|
| 335 | ELSE
|
|---|
| 336 | COSTET = PPTL(3,I) / SQRT(PL2+PT2)
|
|---|
| 337 | ENDIF
|
|---|
| 338 | COSTET = MAX( MIN(COSTET, 1.D0), -1.D0 )
|
|---|
| 339 | IF ( PPTL(1,I) .NE. 0. .OR. PPTL(2,I) .NE. 0. ) THEN
|
|---|
| 340 | PHIV = ATAN2( DBLE(PPTL(1,I)), DBLE(PPTL(2,I)) )
|
|---|
| 341 | ELSE
|
|---|
| 342 | PHIV = 0.D0
|
|---|
| 343 | ENDIF
|
|---|
| 344 |
|
|---|
| 345 |
|
|---|
| 346 | ETOT = ETOT + PPTL(4,I)
|
|---|
| 347 | CALL ADDANG( COSTHE,PHI, COSTET,PHIV, SECPAR(3),SECPAR(4) )
|
|---|
| 348 | IF ( SECPAR(3) .GE. C(29) ) THEN
|
|---|
| 349 | CALL TSTACK
|
|---|
| 350 | ENDIF
|
|---|
| 351 |
|
|---|
| 352 | C COUNTERS FOR FIRST INTERACTION
|
|---|
| 353 | IF ( FIRSTI ) THEN
|
|---|
| 354 | IF ( SECPAR(1) .EQ. 7.D0 .OR. SECPAR(1) .EQ. 8.D0
|
|---|
| 355 | * .OR. SECPAR(1) .EQ. 9.D0 ) THEN
|
|---|
| 356 | IFINPI = IFINPI + 1
|
|---|
| 357 | ELSEIF ( SECPAR(1) .EQ. 13.D0 .OR. SECPAR(1) .EQ. 14.D0
|
|---|
| 358 | * .OR. SECPAR(1) .EQ. 15.D0 .OR. SECPAR(1) .EQ. 25.D0 ) THEN
|
|---|
| 359 | IFINNU = IFINNU + 1
|
|---|
| 360 | ELSEIF ( SECPAR(1) .EQ. 10.D0 .OR. SECPAR(1) .EQ. 11.D0
|
|---|
| 361 | * .OR. SECPAR(1) .EQ. 12.D0 .OR. SECPAR(1) .EQ. 16.D0 ) THEN
|
|---|
| 362 | IFINKA = IFINKA + 1
|
|---|
| 363 | ELSEIF ( SECPAR(1) .EQ. 17.D0 ) THEN
|
|---|
| 364 | IFINET = IFINET + 1
|
|---|
| 365 | ELSEIF ((SECPAR(1) .GE. 18.D0 .AND. SECPAR(1) .LE. 24.D0)
|
|---|
| 366 | * .OR. (SECPAR(1) .GE. 26.D0 .AND. SECPAR(1) .LE. 32.D0))THEN
|
|---|
| 367 | IFINHY = IFINHY + 1
|
|---|
| 368 | ENDIF
|
|---|
| 369 | ENDIF
|
|---|
| 370 |
|
|---|
| 371 | 5 CONTINUE
|
|---|
| 372 |
|
|---|
| 373 | IF (DEBUG) WRITE(MDEBUG,*) 'VSTORE: NTGEVT,ETOT =',NTGEVT,ETOT
|
|---|
| 374 |
|
|---|
| 375 | IF ( NFRAGM .NE. 0 .AND. INEW .GT. 0 ) THEN
|
|---|
| 376 | C TREAT REMAINING NUCLEUS
|
|---|
| 377 | IF ( DEBUG ) WRITE(MDEBUG,150) INEW,(CURPAR(I),I=2,8)
|
|---|
| 378 | 150 FORMAT(' VSTORE: REMNNT=',1P,I10,7E10.3)
|
|---|
| 379 | SECPAR(2) = CURPAR(2)
|
|---|
| 380 | SECPAR(3) = CURPAR(3)
|
|---|
| 381 | SECPAR(4) = CURPAR(4)
|
|---|
| 382 |
|
|---|
| 383 | IF ( INEW .EQ. 100 ) THEN
|
|---|
| 384 | C REMAINING NUCLEUS IS SINGLE NEUTRON
|
|---|
| 385 | SECPAR(1) = 13.D0
|
|---|
| 386 | CALL TSTACK
|
|---|
| 387 | ETOT = ETOT + SECPAR(2) * PAMA(13)
|
|---|
| 388 | GOTO 140
|
|---|
| 389 |
|
|---|
| 390 | ELSEIF ( INEW .EQ. 101 ) THEN
|
|---|
| 391 | C REMAINING NUCLEUS IS SINGLE PROTON
|
|---|
| 392 | SECPAR(1) = 14.D0
|
|---|
| 393 | CALL TSTACK
|
|---|
| 394 | ETOT = ETOT + SECPAR(2) * PAMA(14)
|
|---|
| 395 | GOTO 140
|
|---|
| 396 |
|
|---|
| 397 | ELSEIF ( NFRAGM .GE. 2 ) THEN
|
|---|
| 398 | C REMAINING NUCLEUS IS EVAPORATING NUCLEONS AND ALPHA PARTICLES
|
|---|
| 399 | NZNEW = MOD(INEW,100)
|
|---|
| 400 | NNNEW = INEW/100 - NZNEW
|
|---|
| 401 | JFIN = 0
|
|---|
| 402 | CALL VAPOR(MAPROJ,INEW,JFIN,ITYP,PFRX,PFRY)
|
|---|
| 403 | IF ( JFIN .EQ. 0 ) GOTO 139
|
|---|
| 404 | C LOOP TO TREAT THE REMANENTS OF THE DESINTEGRATED FRAGMENT
|
|---|
| 405 | KNEW = 0
|
|---|
| 406 | DO 135 J=1,JFIN
|
|---|
| 407 | EA = GAMMA * PAMA(ITYP(J))
|
|---|
| 408 | IF(DEBUG)WRITE(MDEBUG,*)'VSTORE: J,ITYP,EA=',J,ITYP(J),EA
|
|---|
| 409 | C MOMENTA SQUARED
|
|---|
| 410 | PTM = EA**2 - PAMA(ITYP(J))**2
|
|---|
| 411 | PT2 = PFRX(J)**2 + PFRY(J)**2
|
|---|
| 412 | IF ( PT2 .GE. PTM ) THEN
|
|---|
| 413 | IF(DEBUG)WRITE(MDEBUG,*)'VSTORE: PT REJECT PARTICLE',J
|
|---|
| 414 | GOTO 135
|
|---|
| 415 | ENDIF
|
|---|
| 416 | IF ( PTM .GT. 0.D0 ) THEN
|
|---|
| 417 | COSTET = SQRT( 1.D0 - PT2/PTM )
|
|---|
| 418 | ELSE
|
|---|
| 419 | COSTET = 1.D0
|
|---|
| 420 | ENDIF
|
|---|
| 421 | IF ( PFRX(J) .NE. 0.D0 .OR. PFRY(J) .NE. 0.D0 ) THEN
|
|---|
| 422 | PHIV = ATAN2( PFRY(J), PFRX(J) )
|
|---|
| 423 | ELSE
|
|---|
| 424 | PHIV = 0.D0
|
|---|
| 425 | ENDIF
|
|---|
| 426 | CALL ADDANG( COSTHE,PHI, COSTET,PHIV, SECPAR(3),SECPAR(4) )
|
|---|
| 427 | IF ( SECPAR(3) .GE. C(29) ) THEN
|
|---|
| 428 | IF ( J .LT. JFIN ) THEN
|
|---|
| 429 | SECPAR(1) = ITYP(J)
|
|---|
| 430 | CALL TSTACK
|
|---|
| 431 | ELSE
|
|---|
| 432 | KNEW = ITYP(JFIN)
|
|---|
| 433 | ENDIF
|
|---|
| 434 | ELSE
|
|---|
| 435 | IF(DEBUG)WRITE(MDEBUG,*)'VSTORE: ANGLE REJECT PARTICLE',J
|
|---|
| 436 | ENDIF
|
|---|
| 437 | 135 CONTINUE
|
|---|
| 438 |
|
|---|
| 439 | ELSEIF ( NFRAGM .EQ. 1 ) THEN
|
|---|
| 440 | C REMAINING NUCLEUS IS ONE FRAGMENT
|
|---|
| 441 | NZNEW = MOD(INEW,100)
|
|---|
| 442 | NNNEW = INEW/100 - NZNEW
|
|---|
| 443 | KNEW = INEW
|
|---|
| 444 | ENDIF
|
|---|
| 445 |
|
|---|
| 446 | IF ( KNEW/100 .EQ. 5 ) THEN
|
|---|
| 447 | C REMAINING NUCLEUS: MASS 5 CANNOT BE TREATED IN BOX2
|
|---|
| 448 | IF ( MOD(KNEW,100) .GE. 3 ) THEN
|
|---|
| 449 | C MASS 5: SPLIT OFF ONE PROTON
|
|---|
| 450 | SECPAR(1) = 14.D0
|
|---|
| 451 | CALL TSTACK
|
|---|
| 452 | KNEW = KNEW - 101
|
|---|
| 453 | ELSE
|
|---|
| 454 | C MASS 5: SPLIT OFF ONE NEUTRON
|
|---|
| 455 | SECPAR(1) = 13.D0
|
|---|
| 456 | CALL TSTACK
|
|---|
| 457 | KNEW = KNEW - 100
|
|---|
| 458 | ENDIF
|
|---|
| 459 | ELSEIF ( KNEW/100 .EQ. 8 ) THEN
|
|---|
| 460 | C REMAINING NUCLEUS: MASS 8 CANNOT BE TREATED IN BOX2
|
|---|
| 461 | IF ( MOD(KNEW,100) .GE. 5 ) THEN
|
|---|
| 462 | C MASS 8: SPLIT OFF ONE PROTON
|
|---|
| 463 | SECPAR(1) = 14.D0
|
|---|
| 464 | CALL TSTACK
|
|---|
| 465 | KNEW = KNEW - 101
|
|---|
| 466 | ELSEIF ( MOD(KNEW,100) .LE. 3 ) THEN
|
|---|
| 467 | C MASS 8: SPLIT OFF ONE NEUTRON
|
|---|
| 468 | SECPAR(1) = 13.D0
|
|---|
| 469 | CALL TSTACK
|
|---|
| 470 | KNEW = KNEW - 100
|
|---|
| 471 | ELSE
|
|---|
| 472 | C MASS 8: SPLIT OFF ONE ALPHA PARTICLE
|
|---|
| 473 | SECPAR(1) = 402.D0
|
|---|
| 474 | CALL TSTACK
|
|---|
| 475 | KNEW = KNEW - 402
|
|---|
| 476 | ENDIF
|
|---|
| 477 | ENDIF
|
|---|
| 478 |
|
|---|
| 479 | SECPAR(1) = KNEW
|
|---|
| 480 | CALL TSTACK
|
|---|
| 481 | ENDIF
|
|---|
| 482 |
|
|---|
| 483 | 139 ETOT = ETOT + SECPAR(2)*(PAMA(13)*NNNEW + PAMA(14)*NZNEW)
|
|---|
| 484 | 140 CONTINUE
|
|---|
| 485 | IF ( DEBUG ) WRITE(MDEBUG,*)'VSTORE: ELASTI,ETOT,ELAB=',
|
|---|
| 486 | * SNGL(ELASTI),ETOT,ELAB
|
|---|
| 487 |
|
|---|
| 488 | C FILL ELASTICITY IN MATRICES
|
|---|
| 489 | MEL = MIN ( 1.D0+10.D0* MAX( 0.D0, ELASTI ) , 11.D0 )
|
|---|
| 490 | MEN = MIN ( 4.D0+ 3.D0*LOG10(MAX( .1D0, EKINL )), 37.D0 )
|
|---|
| 491 | IELDPM(MEN,MEL) = IELDPM(MEN,MEL) + 1
|
|---|
| 492 | IELDPA(MEN,MEL) = IELDPA(MEN,MEL) + 1
|
|---|
| 493 | IF ( ELASTI .LT. 1.D0 ) THEN
|
|---|
| 494 | ELMEAN(MEN) = ELMEAN(MEN) + ELASTI
|
|---|
| 495 | ELMEAA(MEN) = ELMEAA(MEN) + ELASTI
|
|---|
| 496 | ENDIF
|
|---|
| 497 |
|
|---|
| 498 | IF ( FIRSTI ) THEN
|
|---|
| 499 | ELAST = ELASTI
|
|---|
| 500 | FIRSTI = .FALSE.
|
|---|
| 501 | ENDIF
|
|---|
| 502 |
|
|---|
| 503 | RETURN
|
|---|
| 504 | END
|
|---|
