| 1 | SUBROUTINE UPDATE( HNEW,THCKHN,IPAS )
|
|---|
| 2 |
|
|---|
| 3 | C-----------------------------------------------------------------------
|
|---|
| 4 | C UPDATE(S PARTICLE PARAMETERS)
|
|---|
| 5 | C
|
|---|
| 6 | C UPDATES PARTICLE PARAMETERS TO OBSERVATION LEVEL WITH NUMBER IPAS
|
|---|
| 7 | C OR TO POINT OF INTERACTION OR DECAY (IPAS=0)
|
|---|
| 8 | C FOR CHARGED PARTICLES THE ENERGY LOSS IS COMPUTED FOR THE WHOLE STEP,
|
|---|
| 9 | C SUBDIVIDED BY THE BOUNDARIES OF THE ATMOSPHERIC LAYERS.
|
|---|
| 10 | C THE PARTICLE IS FLYING THE 1ST HALF (DH/2) WITH INITIAL ENERGY
|
|---|
| 11 | C AND ANGLE AND THE 2ND HALF WITH FINAL ENERGY AND ANGLE.
|
|---|
| 12 | C THE TIME CALCULATION FOLLOWS THIS SIMPLIFICATION.
|
|---|
| 13 | C CHARGED PARTICLES ARE DEFLECTED IN THE EARTH MAGNETIC FIELD.
|
|---|
| 14 | C THE ANGLE OF DEFLECTION BY MULTIPLE SCATTERING IS COMPUTED ONLY
|
|---|
| 15 | C FOR MUONS AND ONLY ONCE FOR THE WHOLE STEP.
|
|---|
| 16 | C IF PARTICLES COME TO REST BY STOPPING, THEIR PATH TO THE STOPPING
|
|---|
| 17 | C POINT IS CALCULATED.
|
|---|
| 18 | C CERENKOV RADIATION IS CALCULATED ONLY FOR LOWEST OBSERVATION LEVEL
|
|---|
| 19 | C THIS SUBROUTINE IS CALLED FROM MAIN, BOX3, AND MUTRAC
|
|---|
| 20 | C ARGUMENTS:
|
|---|
| 21 | C HNEW = ALTITUDE OF PARTICLE AFTER UPDATE
|
|---|
| 22 | C THCKHN = THICKNESS OF HNEW
|
|---|
| 23 | C IPAS = 0 TRANSPORT TO END OF RANGE OF PARTICLE
|
|---|
| 24 | C .NE. 0 TRANSPORT TO PASSAGE OF OBSERVATION LEVEL IPAS
|
|---|
| 25 | C
|
|---|
| 26 | C REDESIGN: D. HECK IK3 FZK KARLSRUHE
|
|---|
| 27 | C-----------------------------------------------------------------------
|
|---|
| 28 |
|
|---|
| 29 | IMPLICIT NONE
|
|---|
| 30 | *KEEP,ATMOS2.
|
|---|
| 31 | COMMON /ATMOS2/ HLAY,THICKL
|
|---|
| 32 | DOUBLE PRECISION HLAY(5),THICKL(5)
|
|---|
| 33 | *KEEP,CONST.
|
|---|
| 34 | COMMON /CONST/ PI,PI2,OB3,TB3,ENEPER
|
|---|
| 35 | DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
|
|---|
| 36 | *KEEP,ELABCT.
|
|---|
| 37 | COMMON /ELABCT/ ELCUT
|
|---|
| 38 | DOUBLE PRECISION ELCUT(4)
|
|---|
| 39 | *KEEP,GENER.
|
|---|
| 40 | COMMON /GENER/ GEN,ALEVEL
|
|---|
| 41 | DOUBLE PRECISION GEN,ALEVEL
|
|---|
| 42 | *KEEP,IRET.
|
|---|
| 43 | COMMON /IRET/ IRET1,IRET2
|
|---|
| 44 | INTEGER IRET1,IRET2
|
|---|
| 45 | *KEEP,MAGNET.
|
|---|
| 46 | COMMON /MAGNET/ BX,BZ,BVAL,BNORMC,BNORM,COSB,SINB,BLIMIT
|
|---|
| 47 | DOUBLE PRECISION BX,BZ,BVAL,BNORMC
|
|---|
| 48 | REAL BNORM,COSB,SINB,BLIMIT
|
|---|
| 49 | *KEEP,MUMULT.
|
|---|
| 50 | COMMON /MUMULT/ CHC,OMC,FMOLI
|
|---|
| 51 | DOUBLE PRECISION CHC,OMC
|
|---|
| 52 | LOGICAL FMOLI
|
|---|
| 53 | *KEEP,OBSPAR.
|
|---|
| 54 | COMMON /OBSPAR/ OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
|
|---|
| 55 | * THETPR,PHIPR,NOBSLV
|
|---|
| 56 | DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
|
|---|
| 57 | * THETAP,THETPR(2),PHIP,PHIPR(2)
|
|---|
| 58 | INTEGER NOBSLV
|
|---|
| 59 | *KEEP,PAM.
|
|---|
| 60 | COMMON /PAM/ PAMA,SIGNUM
|
|---|
| 61 | DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
|
|---|
| 62 | *KEEP,PARPAR.
|
|---|
| 63 | COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
|
|---|
| 64 | * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
|
|---|
| 65 | DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
|
|---|
| 66 | * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
|
|---|
| 67 | INTEGER ITYPE,LEVL
|
|---|
| 68 | *KEEP,PARPAE.
|
|---|
| 69 | DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
|
|---|
| 70 | EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
|
|---|
| 71 | * (CURPAR(4), PHI ), (CURPAR(5), H ),
|
|---|
| 72 | * (CURPAR(6), T ), (CURPAR(7), X ),
|
|---|
| 73 | * (CURPAR(8), Y ), (CURPAR(9), CHI ),
|
|---|
| 74 | * (CURPAR(10),BETA), (CURPAR(11),GCM ),
|
|---|
| 75 | * (CURPAR(12),ECM )
|
|---|
| 76 | *KEEP,RANDPA.
|
|---|
| 77 | COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
|
|---|
| 78 | DOUBLE PRECISION FAC,U1,U2
|
|---|
| 79 | REAL RD(3000)
|
|---|
| 80 | INTEGER ISEED(103,10),NSEQ
|
|---|
| 81 | LOGICAL KNOR
|
|---|
| 82 | *KEEP,RUNPAR.
|
|---|
| 83 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
|---|
| 84 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
|---|
| 85 | * MONIOU,MDEBUG,NUCNUC,
|
|---|
| 86 | * CETAPE,
|
|---|
| 87 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 88 | * N1STTR,MDBASE,
|
|---|
| 89 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 90 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 91 | * ,GHEISH,GHESIG
|
|---|
| 92 | COMMON /RUNPAC/ DSN,HOST,USER
|
|---|
| 93 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
|---|
| 94 | REAL STEPFC
|
|---|
| 95 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
|---|
| 96 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 97 | * N1STTR,MDBASE
|
|---|
| 98 | INTEGER CETAPE
|
|---|
| 99 | CHARACTER*79 DSN
|
|---|
| 100 | CHARACTER*20 HOST,USER
|
|---|
| 101 |
|
|---|
| 102 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 103 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 104 | * ,GHEISH,GHESIG
|
|---|
| 105 | *KEEP,CERHDR.
|
|---|
| 106 | COMMON/CERHDR/ TPART,UPART,VPART,WPART,XPART,YPART,ZPART
|
|---|
| 107 | DOUBLE PRECISION TPART,UPART,VPART,WPART,XPART,YPART,ZPART
|
|---|
| 108 | *KEND.
|
|---|
| 109 |
|
|---|
| 110 | DOUBLE PRECISION ALPHA1,ALPHA2,BETAN,DENS,DH,DR,DTHICK,ELOSS,
|
|---|
| 111 | * FNORM1,FNORM2,F1COS1,F1COS2,F1SIN1,F1SIN2,
|
|---|
| 112 | * GAMMAN,GAMSQ,GLCUT,GMSQM1,GAM0,HMIDDL,HNEW,OMEGA,
|
|---|
| 113 | * PHISCT,PHI1,RADINV,RANNOR,RHOF,
|
|---|
| 114 | * SINTH1,SINTH2,SN,SN1,SN2,SN3,SN4,
|
|---|
| 115 | * THCKHN,TH0,U10,U12,U20,U22,V,VSCAT,VVV,
|
|---|
| 116 | * V10,V12,V20,V22,W10,W12,W20,W22
|
|---|
| 117 | INTEGER I,IL,ILAY,IPAS
|
|---|
| 118 | LOGICAL MUS
|
|---|
| 119 | SAVE VSCAT,PHISCT
|
|---|
| 120 | EXTERNAL RANNOR,RHOF
|
|---|
| 121 | DOUBLE PRECISION CHIT,DT,GAMK,HEIGH,HNEWC,RATIO,THCKHC
|
|---|
| 122 | INTEGER ICRNKV
|
|---|
| 123 | LOGICAL TFLAG
|
|---|
| 124 | EXTERNAL HEIGH
|
|---|
| 125 | C-----------------------------------------------------------------------
|
|---|
| 126 |
|
|---|
| 127 | IF (DEBUG) WRITE(MDEBUG,457) (CURPAR(I),I=1,9),HNEW
|
|---|
| 128 | 457 FORMAT(' UPDATE: CURPAR=',1P,9E10.3/
|
|---|
| 129 | * ' TO HEIGHT ',0P,F11.1)
|
|---|
| 130 |
|
|---|
| 131 | IRET2 = 1
|
|---|
| 132 | C TOTAL HEIGHT DIFFERENCE
|
|---|
| 133 | DH = MAX( H - HNEW, 1.D-10 )
|
|---|
| 134 | C ATMOSPHERE THICKNESS TRAVERSED
|
|---|
| 135 | DTHICK = (THCKHN - THICKH) / COSTHE
|
|---|
| 136 | C TOTAL PATH FOR UNDEFLECTED PARTICLE
|
|---|
| 137 | SN = DH / COSTHE
|
|---|
| 138 | SN1 = 0.25D0 * SN
|
|---|
| 139 |
|
|---|
| 140 |
|
|---|
| 141 | C CALCULATE KINETIC ENERGY CUT
|
|---|
| 142 | IF ( ITYPE .EQ. 5 .OR. ITYPE .EQ. 6 ) THEN
|
|---|
| 143 | MUS = .TRUE.
|
|---|
| 144 | GLCUT = ELCUT(2) / PAMA(ITYPE) + 1.D0
|
|---|
| 145 | ELSE
|
|---|
| 146 | MUS = .FALSE.
|
|---|
| 147 | GLCUT = ELCUT(1) / PAMA(ITYPE) + 1.D0
|
|---|
| 148 | ENDIF
|
|---|
| 149 |
|
|---|
| 150 | C CALCULATE THE ENERGY LOSS FOR CHARGED PARTICLES
|
|---|
| 151 | IF ( SIGNUM(ITYPE) .NE. 0.D0 ) THEN
|
|---|
| 152 | C LOOK WITHIN WHICH LAYER THE PARTICLE STARTS
|
|---|
| 153 | IF ( H .LE. HLAY(2) ) THEN
|
|---|
| 154 | ILAY = 1
|
|---|
| 155 | TH0 = THICKH
|
|---|
| 156 | ELSEIF ( H .LE. HLAY(3) ) THEN
|
|---|
| 157 | ILAY = 2
|
|---|
| 158 | TH0 = THICKH
|
|---|
| 159 | ELSEIF ( H .LE. HLAY(4) ) THEN
|
|---|
| 160 | ILAY = 3
|
|---|
| 161 | TH0 = THICKH
|
|---|
| 162 | ELSE
|
|---|
| 163 | ILAY = 4
|
|---|
| 164 | TH0 = MAX( THICKH, 2.D-4 )
|
|---|
| 165 | ENDIF
|
|---|
| 166 | C SET START VALUES FOR ITERATION
|
|---|
| 167 | GAM0 = GAMMA
|
|---|
| 168 | IL = ILAY
|
|---|
| 169 | 1 CONTINUE
|
|---|
| 170 | GAM0 = MAX( GAM0, 1.0001D0 )
|
|---|
| 171 | GAMSQ = GAM0**2
|
|---|
| 172 | GMSQM1 = GAMSQ - 1.D0
|
|---|
| 173 | C ENERGY LOSS BY IONIZATION
|
|---|
| 174 | ELOSS = SIGNUM(ITYPE)**2 * C(22) *
|
|---|
| 175 | * ( GAMSQ * (LOG(GMSQM1) + C(23)) / GMSQM1 - 1.D0 )
|
|---|
| 176 | C LOOK WETHER PARTICLE PENETRATES LAYER BOUNDARY
|
|---|
| 177 | IF ( THICKL(IL) .LT. THCKHN .AND. IL .GT. 1 ) THEN
|
|---|
| 178 | C CALCULATE NEW START VALUES AT LAYER BOUNDARY
|
|---|
| 179 | GAM0 = GAM0 - ELOSS * (THICKL(IL) - TH0)
|
|---|
| 180 | * / (PAMA(ITYPE)*COSTHE)
|
|---|
| 181 | IF ( GAM0 .LE. 1.D0 ) THEN
|
|---|
| 182 | GAMMAN = 1.0001D0
|
|---|
| 183 | GOTO 3
|
|---|
| 184 | ENDIF
|
|---|
| 185 | TH0 = THICKL(IL)
|
|---|
| 186 | IL = IL - 1
|
|---|
| 187 | GOTO 1
|
|---|
| 188 | ENDIF
|
|---|
| 189 | C GAMMA VALUE FOR CHARGED PARTICLES AT END OF STEP
|
|---|
| 190 | GAMMAN = GAM0 - ELOSS * (THCKHN-TH0) / (PAMA(ITYPE)*COSTHE)
|
|---|
| 191 | 3 CONTINUE
|
|---|
| 192 |
|
|---|
| 193 | ELSE
|
|---|
| 194 | C NO LOSS FOR NEUTRAL PARTICLES
|
|---|
| 195 | GAMMAN = GAMMA
|
|---|
| 196 | ENDIF
|
|---|
| 197 |
|
|---|
| 198 | C PARTICLE HAS TO BE TRACKED TO THE CUTOFF ENERGY FOR CERENKOV PHOTONS
|
|---|
| 199 | C (AS NEUTRAL DO NOT LOOSE ENERGY IN UPDATE, THIS CONDITION IS
|
|---|
| 200 | C FULFILLED BY CHARGED PARTICLES ONLY)
|
|---|
| 201 | C (AS CERENKOV RUNS NOT WITH HORIZONT, NO PROGRAMMING FOR HORIZONT)
|
|---|
| 202 | IF ( GAMMAN .LT. GLCUT ) THEN
|
|---|
| 203 | GAMMAN = 0.9D0 + GLCUT * 0.1D0
|
|---|
| 204 |
|
|---|
| 205 | C SET START VALUES FOR ITERATION
|
|---|
| 206 | IL = ILAY
|
|---|
| 207 | CHIT = 0.D0
|
|---|
| 208 | GAM0 = GAMMA
|
|---|
| 209 | TH0 = MAX( THICKH, 2.D-4 )
|
|---|
| 210 | 2 CONTINUE
|
|---|
| 211 | GAM0 = MAX( GAM0, 1.0001D0 )
|
|---|
| 212 | GAMSQ = GAM0**2
|
|---|
| 213 | GMSQM1 = GAMSQ - 1.D0
|
|---|
| 214 | C ENERGY LOSS BY IONIZATION
|
|---|
| 215 | ELOSS = SIGNUM(ITYPE)**2 * C(22) *
|
|---|
| 216 | * ( GAMSQ * (LOG(GMSQM1) + C(23)) / GMSQM1 -1.D0 )
|
|---|
| 217 | ELOSS = ELOSS / (PAMA(ITYPE) * COSTHE)
|
|---|
| 218 | GAMK = GAM0 - ELOSS * (THICKL(ILAY) - TH0)
|
|---|
| 219 | C LOOK WETHER PARTICLE PENETRATES LAYER BOUNDARY
|
|---|
| 220 | IF (GAMMAN .LT. GAMK .AND. IL. GT. 1 ) THEN
|
|---|
| 221 | C CALCULATE PORTION OF RANGE AND NEW START VALUES AT LAYER BOUNDARY
|
|---|
| 222 | CHIT = CHIT + (THICKL(IL) - TH0) / COSTHE
|
|---|
| 223 | GAM0 = GAMK
|
|---|
| 224 | TH0 = THICKL(IL)
|
|---|
| 225 | IL = IL - 1
|
|---|
| 226 | GOTO 2
|
|---|
| 227 | ENDIF
|
|---|
| 228 | C PENETRATED MATTER THICKNESS
|
|---|
| 229 | CHI = CHIT + (GAM0 - GAMMAN) / (ELOSS*COSTHE)
|
|---|
| 230 | IF ( DEBUG ) WRITE(MDEBUG,*)'UPDATE: GAMMAN,CHI=',
|
|---|
| 231 | * SNGL(GAMMAN),SNGL(CHI)
|
|---|
| 232 | C CALCULATE CORRECTED PATH PARAMETERS
|
|---|
| 233 | THCKHC = THICKH + COSTHE * CHI
|
|---|
| 234 | HNEWC = HEIGH(THCKHC)
|
|---|
| 235 | DT = SN / (C(25) * BETA * GAMMA)
|
|---|
| 236 | RATIO = .5D0 * (H-HNEWC) / DH
|
|---|
| 237 | DH = H - HNEWC
|
|---|
| 238 | SN = DH / COSTHE
|
|---|
| 239 | SN1 = 0.25D0 * SN
|
|---|
| 240 | TFLAG = .TRUE.
|
|---|
| 241 | ELSE
|
|---|
| 242 | TFLAG = .FALSE.
|
|---|
| 243 | ENDIF
|
|---|
| 244 |
|
|---|
| 245 | C-----------------------------------------------------------------------
|
|---|
| 246 | IF ( IPAS .EQ. 0 ) THEN
|
|---|
| 247 | C UPDATE TO THE END POINT OF THE TRACK
|
|---|
| 248 |
|
|---|
| 249 | IF ( MUS ) THEN
|
|---|
| 250 | C COULOMB SCATTERING ANGLE (FOR MUONS ONLY)
|
|---|
| 251 | IF ( FMOLI) THEN
|
|---|
| 252 | C TREAT MUON MULTIPLE SCATTERING BY MOLIERE THEORY (SEE GEANT)
|
|---|
| 253 | C CALCULATE AVERAGE DENSITY AND NUMBER OF SCATTERING (OMEGA)
|
|---|
| 254 | DENS = CHI/DH * COSTHE
|
|---|
| 255 | OMEGA = OMC * CHI / BETA**2
|
|---|
| 256 | IF ( OMEGA .LE. 20.D0 ) THEN
|
|---|
| 257 | C FEW SCATTERING EVENTS, APPLY PLURAL COULOMB SCATTERING
|
|---|
| 258 | CALL MUCOUL(OMEGA,DENS,VSCAT)
|
|---|
| 259 | ELSE
|
|---|
| 260 | C ENOUGH SCATTERING EVENTS, APPLY MOLIERE'S THEORY
|
|---|
| 261 | CALL MMOLIE(OMEGA,DENS,VSCAT)
|
|---|
| 262 | ENDIF
|
|---|
| 263 | ELSE
|
|---|
| 264 | C TREAT MUON MULTIPLE SCATTERING BY GAUSS DISTRIBUTION
|
|---|
| 265 | VSCAT = RANNOR( 0.D0, C(30) * SQRT( CHI/C(21) )
|
|---|
| 266 | * / (PAMA(5) * GAMMA * BETA**2) )
|
|---|
| 267 | ENDIF
|
|---|
| 268 | V = VSCAT
|
|---|
| 269 | CALL RMMAR( RD,1,1 )
|
|---|
| 270 | PHISCT = RD(1) * PI2
|
|---|
| 271 | IF(DEBUG)WRITE(MDEBUG,*)'UPDATE: VSCAT=',SNGL(VSCAT),
|
|---|
| 272 | * ' PHISCT=',SNGL(PHISCT)
|
|---|
| 273 | ENDIF
|
|---|
| 274 |
|
|---|
| 275 | C CERENKOV RADIATION: LOOK, WHETHER PATH ENDS ABOVE LOWEST OBSERV.LEVEL
|
|---|
| 276 | IF ( TFLAG ) THEN
|
|---|
| 277 | HNEW = HNEWC
|
|---|
| 278 | THCKHN = THCKHC
|
|---|
| 279 | IF (DEBUG) WRITE(MDEBUG,*)'UPDATE: CHANGED HNEW =',SNGL(HNEW)
|
|---|
| 280 | ENDIF
|
|---|
| 281 | IF ( HNEW .GT. OBSLEV(NOBSLV) ) THEN
|
|---|
| 282 | ICRNKV = 1
|
|---|
| 283 | ELSE
|
|---|
| 284 | ICRNKV = 0
|
|---|
| 285 | ENDIF
|
|---|
| 286 |
|
|---|
| 287 | C UPDATE TO THE OBSERVATION LEVELS
|
|---|
| 288 | ELSE
|
|---|
| 289 | IF ( MUS ) THEN
|
|---|
| 290 | C COULOMB SCATTERING ANGLE (FOR MUONS ONLY)
|
|---|
| 291 | V = VSCAT * SQRT( DTHICK / CHI )
|
|---|
| 292 | ENDIF
|
|---|
| 293 |
|
|---|
| 294 | C CERENKOV RADIATION: LOOK, WHETHER LOWEST OBSERVATION LEVEL
|
|---|
| 295 | IF ( IPAS .EQ. NOBSLV ) THEN
|
|---|
| 296 | ICRNKV = 1
|
|---|
| 297 | ELSE
|
|---|
| 298 | ICRNKV = 0
|
|---|
| 299 | ENDIF
|
|---|
| 300 | ENDIF
|
|---|
| 301 |
|
|---|
| 302 | C REJECT ALL PARTICLES IF BELOW KINETIC ENERGY CUT
|
|---|
| 303 | IF ( GAMMAN .LT. GLCUT .AND. ICRNKV .EQ. 0 ) THEN
|
|---|
| 304 | IF (DEBUG)
|
|---|
| 305 | * WRITE(MDEBUG,*) 'UPDATE: PARTICLE ',ITYPE,' BELOW ENERGY CUT'
|
|---|
| 306 | * ,' CERENKOV LIGHT NOT CALCULATED'
|
|---|
| 307 | RETURN
|
|---|
| 308 | ENDIF
|
|---|
| 309 |
|
|---|
| 310 | C-----------------------------------------------------------------------
|
|---|
| 311 | C CHARGED PARTICLES SUFFER IONIZATION LOSS, DEFLECTION IN MAGNETIC
|
|---|
| 312 | C FIELD AND MUONS IN ADDITION DO MULTIPLE COULOMB SCATTERING
|
|---|
| 313 |
|
|---|
| 314 | IF ( SIGNUM(ITYPE) .NE. 0.D0 ) THEN
|
|---|
| 315 | C DEFLECTION IN EARTH MAGNETIC FIELD ON FIRST HALF OF STEP
|
|---|
| 316 | ALPHA1 = SIGNUM(ITYPE) *
|
|---|
| 317 | * MIN( 1.D0, 2.D0*SN1*BNORMC /(PAMA(ITYPE)*BETA*GAMMA) )
|
|---|
| 318 | SINTH1 = SQRT( 1.D0 - COSTHE**2 )
|
|---|
| 319 | U10 = SINTH1 * COS(-PHI)
|
|---|
| 320 | V10 = SINTH1 * SIN(-PHI)
|
|---|
| 321 | W10 = COSTHE
|
|---|
| 322 | FNORM1 = 1.D0 - 0.5D0*ALPHA1**2 * (1.D0 - 0.75D0*ALPHA1**2)
|
|---|
| 323 | F1COS1 = ( 1.D0 - FNORM1 ) * COSB
|
|---|
| 324 | F1SIN1 = ( 1.D0 - FNORM1 ) * SINB
|
|---|
| 325 | VVV = V10 * ALPHA1 * FNORM1
|
|---|
| 326 | U12 = U10 * (1.D0 - F1SIN1*SINB) + W10*F1SIN1*COSB + VVV*SINB
|
|---|
| 327 | V12 = FNORM1 * ( V10 - ALPHA1 * (U10 * SINB - W10 * COSB) )
|
|---|
| 328 | W12 = W10 * (1.D0 - F1COS1*COSB) + U10*F1COS1*SINB - VVV*COSB
|
|---|
| 329 | RADINV = 1.5D0 - 0.5D0 * ( U12**2 + V12**2 + W12**2 )
|
|---|
| 330 | W12 = MIN( 1.D0, RADINV * W12 )
|
|---|
| 331 | IF ( W12 .LE. C(29) ) THEN
|
|---|
| 332 | IF (DEBUG)
|
|---|
| 333 | * WRITE(MDEBUG,*) 'UPDATE: PARTICLE ',ITYPE,' BELOW ANGLE CUT 1'
|
|---|
| 334 | RETURN
|
|---|
| 335 | ENDIF
|
|---|
| 336 | SN2 = 0.25D0 * DH / W12
|
|---|
| 337 | U12 = RADINV * U12
|
|---|
| 338 | V12 = RADINV * V12
|
|---|
| 339 | IF ( U12**2 + V12**2 .GT. 3.D-38 ) THEN
|
|---|
| 340 | PHI1 = -ATAN2( V12, U12 )
|
|---|
| 341 | ELSE
|
|---|
| 342 | PHI1 = 0.D0
|
|---|
| 343 | ENDIF
|
|---|
| 344 | C CERENKOV RADIATION: FILL PARTICLE COORDINATES INTO COMMON CERHDR
|
|---|
| 345 | IF ( ICRNKV .EQ. 1 ) THEN
|
|---|
| 346 | XPART = X + SN1 * U10 + SN2 * U12
|
|---|
| 347 | YPART = Y - SN1 * V10 - SN2 * V12
|
|---|
| 348 | TPART = T + ( SN1 + SN2 ) / ( C(25) * BETA )
|
|---|
| 349 | ZPART = H - DH * 0.5D0
|
|---|
| 350 | WPART = W12
|
|---|
| 351 | UPART = U12
|
|---|
| 352 | VPART = -V12
|
|---|
| 353 | CALL CERENH( SN1+SN2, BETA )
|
|---|
| 354 | ENDIF
|
|---|
| 355 |
|
|---|
| 356 | C CHANGE DIRECTION BY COULOMB SCATTERING (FOR MUONS ONLY)
|
|---|
| 357 | C BEFORE SCATTERING : DIRECTION COSINES ARE U12,V12,W12
|
|---|
| 358 | C AFTER SCATTERING : DIRECTION COSINES ARE U20,V20,W20
|
|---|
| 359 | IF ( MUS ) THEN
|
|---|
| 360 | CALL ADDANG( W12,PHI1, COS(V),PHISCT, W20,PHI1 )
|
|---|
| 361 | IF ( W20 .LT. C(29) ) THEN
|
|---|
| 362 | IF (DEBUG) WRITE(MDEBUG,*) 'UPDATE: MUON BELOW ANGLE CUT'
|
|---|
| 363 | RETURN
|
|---|
| 364 | ENDIF
|
|---|
| 365 | SINTH2 = SQRT( 1.D0 - W20**2 )
|
|---|
| 366 | U20 = SINTH2 * COS( -PHI1 )
|
|---|
| 367 | V20 = SINTH2 * SIN( -PHI1 )
|
|---|
| 368 | ELSE
|
|---|
| 369 | U20 = U12
|
|---|
| 370 | V20 = V12
|
|---|
| 371 | W20 = W12
|
|---|
| 372 | ENDIF
|
|---|
| 373 |
|
|---|
| 374 | C NEW PATH LENGTH, NEW BETA VALUE BECAUSE OF IONIZATION ENERGY LOSS
|
|---|
| 375 | SN3 = 0.25D0 * DH / W20
|
|---|
| 376 | BETAN = SQRT( GAMMAN**2 - 1.D0 ) / GAMMAN
|
|---|
| 377 | C DEFLECTION IN EARTH MAGNETIC FIELD ON SECOND HALF OF STEP
|
|---|
| 378 | ALPHA2 = SIGNUM(ITYPE) *
|
|---|
| 379 | * MIN(1.D0,2.D0*SN3*BNORMC / (PAMA(ITYPE)*BETAN*GAMMAN))
|
|---|
| 380 | FNORM2 = 1.D0 - 0.5D0*ALPHA2**2 * (1.D0 - 0.75D0*ALPHA2**2)
|
|---|
| 381 | F1SIN2 = ( 1.D0 - FNORM2 ) * SINB
|
|---|
| 382 | F1COS2 = ( 1.D0 - FNORM2 ) * COSB
|
|---|
| 383 | VVV = V20 * ALPHA2 * FNORM2
|
|---|
| 384 | U22 = U20*(1.D0 - F1SIN2*SINB) + W20*F1SIN2*COSB + VVV*SINB
|
|---|
| 385 | V22 = FNORM2 * ( V20 - ALPHA2 * (U20 * SINB - W20 * COSB) )
|
|---|
| 386 | W22 = W20*(1.D0 - F1COS2*COSB) + U20*F1COS2*SINB - VVV*COSB
|
|---|
| 387 | RADINV = 1.5D0 - 0.5D0 * ( U22**2 + V22**2 + W22**2 )
|
|---|
| 388 | W22 = MIN( 1.D0, RADINV * W22 )
|
|---|
| 389 | IF ( W22 .LT. C(29) ) THEN
|
|---|
| 390 | IF (DEBUG)
|
|---|
| 391 | * WRITE(MDEBUG,*) 'UPDATE: PARTICLE ',ITYPE,' BELOW ANGLE CUT 2'
|
|---|
| 392 | RETURN
|
|---|
| 393 | ENDIF
|
|---|
| 394 | SN4 = 0.25D0 * DH / W22
|
|---|
| 395 | U22 = RADINV * U22
|
|---|
| 396 | V22 = RADINV * V22
|
|---|
| 397 | OUTPAR(3) = W22
|
|---|
| 398 | IF ( U22**2 + V22**2 .GT. 3.D-38 ) THEN
|
|---|
| 399 | OUTPAR(4) = -ATAN2( V22, U22 )
|
|---|
| 400 | ELSE
|
|---|
| 401 | OUTPAR(4) = 0.D0
|
|---|
| 402 | ENDIF
|
|---|
| 403 | C UPDATE COORDINATES AND TIME TO THE END OF DISTANCE
|
|---|
| 404 | IF ( TFLAG ) THEN
|
|---|
| 405 | OUTPAR(6) = T + DT* ( RATIO*GAMMA + (1.D0-RATIO)*GAMMAN)
|
|---|
| 406 | ELSE
|
|---|
| 407 | OUTPAR(6) = T + (SN1 + SN2)/(BETA *C(25)) +
|
|---|
| 408 | * (SN3 + SN4)/(BETAN*C(25))
|
|---|
| 409 | ENDIF
|
|---|
| 410 | OUTPAR(7) = X + SN1*U10 + SN2*U12 + SN3*U20 + SN4*U22
|
|---|
| 411 | OUTPAR(8) = Y - SN1*V10 - SN2*V12 - SN3*V20 - SN4*V22
|
|---|
| 412 | C CERENKOV RADIATION: FILL PARTICLE COORDINATES INTO COMMON CERHDR
|
|---|
| 413 | IF ( ICRNKV .EQ. 1 ) THEN
|
|---|
| 414 | XPART = OUTPAR(7)
|
|---|
| 415 | YPART = OUTPAR(8)
|
|---|
| 416 | ZPART = HNEW
|
|---|
| 417 | TPART = OUTPAR(6)
|
|---|
| 418 | WPART = W22
|
|---|
| 419 | UPART = U22
|
|---|
| 420 | VPART = -V22
|
|---|
| 421 | CALL CERENH( SN3+SN4, BETAN )
|
|---|
| 422 | C REJECT PARTICLES AFTER PRODUCTION OF CERENKOV LIGHT
|
|---|
| 423 | IF ( GAMMAN .LT. GLCUT ) THEN
|
|---|
| 424 | IF (DEBUG) WRITE(MDEBUG,*) 'UPDATE: PARTICLE ',ITYPE,
|
|---|
| 425 | * ' BELOW ENERGY CUT AFTER CREATION OF CERENKOV LIGHT'
|
|---|
| 426 | RETURN
|
|---|
| 427 | ENDIF
|
|---|
| 428 | ENDIF
|
|---|
| 429 | ELSE
|
|---|
| 430 |
|
|---|
| 431 | C-----------------------------------------------------------------------
|
|---|
| 432 | C NEUTRAL PARTICLES
|
|---|
| 433 | C NO COULOMB SCATTERING, NO DEFLECTION IN MAGNETIC FIELD
|
|---|
| 434 |
|
|---|
| 435 | C HORIZONTAL PATH LENGTH
|
|---|
| 436 | DR = SN * SQRT( 1.D0 - COSTHE**2 )
|
|---|
| 437 | C UPDATE COORDINATES AND TIME
|
|---|
| 438 | OUTPAR(3) = COSTHE
|
|---|
| 439 | OUTPAR(4) = PHI
|
|---|
| 440 | OUTPAR(6) = T + SN / ( C(25) * BETA )
|
|---|
| 441 | OUTPAR(7) = X + DR * COS(PHI)
|
|---|
| 442 | OUTPAR(8) = Y + DR * SIN(PHI)
|
|---|
| 443 | ENDIF
|
|---|
| 444 |
|
|---|
| 445 | C-----------------------------------------------------------------------
|
|---|
| 446 | OUTPAR( 1) = CURPAR(1)
|
|---|
| 447 | OUTPAR( 2) = GAMMAN
|
|---|
| 448 | OUTPAR( 5) = HNEW
|
|---|
| 449 | OUTPAR( 9) = GEN
|
|---|
| 450 | OUTPAR(10) = ALEVEL
|
|---|
| 451 |
|
|---|
| 452 | C REGULAR END OF UPDATE
|
|---|
| 453 | IRET2 = 0
|
|---|
| 454 |
|
|---|
| 455 |
|
|---|
| 456 | IF (DEBUG) WRITE(MDEBUG,458) (OUTPAR(I),I=1,9)
|
|---|
| 457 | 458 FORMAT(' UPDATE: OUTPAR=',1P,9E10.3)
|
|---|
| 458 |
|
|---|
| 459 | RETURN
|
|---|
| 460 | END
|
|---|
