| 1 | SUBROUTINE BOX3
|
|---|
| 2 |
|
|---|
| 3 | C-----------------------------------------------------------------------
|
|---|
| 4 | C
|
|---|
| 5 | C CHECKS PASSAGE THROUGH OBSERVATION LEVEL(S)
|
|---|
| 6 | C IRET1=1 KILLS PARTICLE
|
|---|
| 7 | C IRET2=1 PARTICLE HAS BEEN CUTTED IN UPDATE
|
|---|
| 8 | C THIS SUBROUTINE IS CALLED FROM MAIN
|
|---|
| 9 | C-----------------------------------------------------------------------
|
|---|
| 10 |
|
|---|
| 11 | IMPLICIT NONE
|
|---|
| 12 | *KEEP,GENER.
|
|---|
| 13 | COMMON /GENER/ GEN,ALEVEL
|
|---|
| 14 | DOUBLE PRECISION GEN,ALEVEL
|
|---|
| 15 | *KEEP,IRET.
|
|---|
| 16 | COMMON /IRET/ IRET1,IRET2
|
|---|
| 17 | INTEGER IRET1,IRET2
|
|---|
| 18 | *KEEP,LONGI.
|
|---|
| 19 | COMMON /LONGI/ APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
|
|---|
| 20 | * NSTEP,LLONGI,FLGFIT
|
|---|
| 21 | DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
|
|---|
| 22 | * SPLONG(0:1040,9),THSTEP,THSTPI
|
|---|
| 23 | INTEGER NSTEP
|
|---|
| 24 | LOGICAL LLONGI,FLGFIT
|
|---|
| 25 | *KEEP,OBSPAR.
|
|---|
| 26 | COMMON /OBSPAR/ OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
|
|---|
| 27 | * THETPR,PHIPR,NOBSLV
|
|---|
| 28 | DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
|
|---|
| 29 | * THETAP,THETPR(2),PHIP,PHIPR(2)
|
|---|
| 30 | INTEGER NOBSLV
|
|---|
| 31 | *KEEP,PAM.
|
|---|
| 32 | COMMON /PAM/ PAMA,SIGNUM
|
|---|
| 33 | DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
|
|---|
| 34 | *KEEP,PARPAR.
|
|---|
| 35 | COMMON /PARPAR/ CURPAR,SECPAR,PRMPAR,OUTPAR,C,
|
|---|
| 36 | * E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
|
|---|
| 37 | DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
|
|---|
| 38 | * C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
|
|---|
| 39 | INTEGER ITYPE,LEVL
|
|---|
| 40 | *KEEP,PARPAE.
|
|---|
| 41 | DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
|
|---|
| 42 | EQUIVALENCE (CURPAR(2),GAMMA), (CURPAR(3),COSTHE),
|
|---|
| 43 | * (CURPAR(4), PHI ), (CURPAR(5), H ),
|
|---|
| 44 | * (CURPAR(6), T ), (CURPAR(7), X ),
|
|---|
| 45 | * (CURPAR(8), Y ), (CURPAR(9), CHI ),
|
|---|
| 46 | * (CURPAR(10),BETA), (CURPAR(11),GCM ),
|
|---|
| 47 | * (CURPAR(12),ECM )
|
|---|
| 48 | *KEEP,RANDPA.
|
|---|
| 49 | COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
|
|---|
| 50 | DOUBLE PRECISION FAC,U1,U2
|
|---|
| 51 | REAL RD(3000)
|
|---|
| 52 | INTEGER ISEED(103,10),NSEQ
|
|---|
| 53 | LOGICAL KNOR
|
|---|
| 54 | *KEEP,RUNPAR.
|
|---|
| 55 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
|---|
| 56 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
|---|
| 57 | * MONIOU,MDEBUG,NUCNUC,
|
|---|
| 58 | * CETAPE,
|
|---|
| 59 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 60 | * N1STTR,MDBASE,
|
|---|
| 61 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 62 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 63 | * ,GHEISH,GHESIG
|
|---|
| 64 | COMMON /RUNPAC/ DSN,HOST,USER
|
|---|
| 65 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
|---|
| 66 | REAL STEPFC
|
|---|
| 67 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
|---|
| 68 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
|---|
| 69 | * N1STTR,MDBASE
|
|---|
| 70 | INTEGER CETAPE
|
|---|
| 71 | CHARACTER*79 DSN
|
|---|
| 72 | CHARACTER*20 HOST,USER
|
|---|
| 73 |
|
|---|
| 74 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
|---|
| 75 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
|---|
| 76 | * ,GHEISH,GHESIG
|
|---|
| 77 | *KEND.
|
|---|
| 78 |
|
|---|
| 79 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 80 | c Simulate more precisely muons Cherenkov light
|
|---|
| 81 | c------------------------------------------------------------
|
|---|
| 82 | integer k
|
|---|
| 83 | double precision chloop,savpar(8),oldchi,oldthk,oldh
|
|---|
| 84 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 85 |
|
|---|
| 86 | DOUBLE PRECISION HEIGH,HNEW,PROPAR(8),THCKHN
|
|---|
| 87 | INTEGER I,IRET3,J,L,LPCT1,LPCT2
|
|---|
| 88 | EXTERNAL HEIGH
|
|---|
| 89 | C-----------------------------------------------------------------------
|
|---|
| 90 |
|
|---|
| 91 | IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
|
|---|
| 92 | 444 FORMAT(' BOX3 : CURPAR=',1P,9E10.3)
|
|---|
| 93 |
|
|---|
| 94 | IF ( ITYPE .EQ. 7 ) THEN
|
|---|
| 95 | C PI 0 DECAYS INTO 2 PHOTONS IN SUBROUTINE PI0DEC
|
|---|
| 96 | CALL TSTINI
|
|---|
| 97 | CALL PI0DEC
|
|---|
| 98 | CALL TSTEND
|
|---|
| 99 | IRET1 = 1
|
|---|
| 100 | RETURN
|
|---|
| 101 |
|
|---|
| 102 | ELSEIF ( ITYPE .EQ. 5 .OR. ITYPE .EQ. 6 ) THEN
|
|---|
| 103 | C MUONS ARE TRACKED WITHIN ROUTINE MUTRAC
|
|---|
| 104 | CALL TSTINI
|
|---|
| 105 | CALL MUTRAC
|
|---|
| 106 | CALL TSTEND
|
|---|
| 107 | IRET1 = 1
|
|---|
| 108 | RETURN
|
|---|
| 109 |
|
|---|
| 110 | ELSEIF ( ITYPE .LE. 3 ) THEN
|
|---|
| 111 | C ELECTRONS OR PHOTONS ARE TREATED IN SUBROUTINE EM
|
|---|
| 112 | CALL EM
|
|---|
| 113 | IRET1 = 1
|
|---|
| 114 | RETURN
|
|---|
| 115 |
|
|---|
| 116 | ELSEIF ( ITYPE .EQ. 17 .OR.
|
|---|
| 117 | * (ITYPE .GE. 71 .AND. ITYPE .LE. 74)) THEN
|
|---|
| 118 | C ETA DECAYS WITHIN ROUTINE ETADEC
|
|---|
| 119 | CALL TSTINI
|
|---|
| 120 | CALL ETADEC
|
|---|
| 121 | CALL TSTEND
|
|---|
| 122 | IRET1 = 1
|
|---|
| 123 | RETURN
|
|---|
| 124 |
|
|---|
| 125 | ELSEIF ( ITYPE .GE. 51 .AND. ITYPE .LE. 65 ) THEN
|
|---|
| 126 | C RESONANCES DECAY WITHIN ROUTINE RESDEC
|
|---|
| 127 | CALL TSTINI
|
|---|
| 128 | CALL RESDEC
|
|---|
| 129 | CALL TSTEND
|
|---|
| 130 | IRET1 = 1
|
|---|
| 131 | RETURN
|
|---|
| 132 |
|
|---|
| 133 | ENDIF
|
|---|
| 134 |
|
|---|
| 135 | C FOR ALL THE OTHER PARTICLES THE PLACE OF NEXT INTERACTION WAS
|
|---|
| 136 | C DETERMINED IN BOX2
|
|---|
| 137 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 138 | c This is just a first approach to the problem
|
|---|
| 139 | c------------------------------------------------------------
|
|---|
| 140 |
|
|---|
| 141 | c goto 5991
|
|---|
| 142 | if ( itype .eq. 5 .or. itype .eq. 6 ) then
|
|---|
| 143 | oldthk = thickh
|
|---|
| 144 | do 5101 i = 1,9
|
|---|
| 145 | savpar(i) = curpar(i)
|
|---|
| 146 | 5101 continue
|
|---|
| 147 | chi = 0.2d0 * chi
|
|---|
| 148 | do 5100 k = 1,5
|
|---|
| 149 | c calculate hight difference in cm from given chi in g/cm**2
|
|---|
| 150 | thckhn = thickh + costhe * chi
|
|---|
| 151 | hnew = heigh(thckhn)
|
|---|
| 152 | c update particle to interaction point (if it reaches so far)
|
|---|
| 153 | c and store coordinates in propar
|
|---|
| 154 | call update( hnew, thckhn, 0 )
|
|---|
| 155 | if ( iret2 .ne. 0 ) goto 5104
|
|---|
| 156 | do 5103 i = 1,8
|
|---|
| 157 | curpar(i) = outpar(i)
|
|---|
| 158 | 5103 continue
|
|---|
| 159 | thickh = thckhn
|
|---|
| 160 | 5100 continue
|
|---|
| 161 | 5104 continue
|
|---|
| 162 | thickh = oldthk
|
|---|
| 163 | do 5102 i = 1,9
|
|---|
| 164 | curpar(i) = savpar(i)
|
|---|
| 165 | 5102 continue
|
|---|
| 166 |
|
|---|
| 167 | else
|
|---|
| 168 | c calculate hight difference in cm from given chi in g/cm**2
|
|---|
| 169 | thckhn = thickh + costhe * chi
|
|---|
| 170 | hnew = heigh(thckhn)
|
|---|
| 171 | c update particle to interaction point (if it reaches so far)
|
|---|
| 172 | c and store coordinates in propar
|
|---|
| 173 | call update( hnew, thckhn, 0 )
|
|---|
| 174 |
|
|---|
| 175 | endif
|
|---|
| 176 |
|
|---|
| 177 | goto 5992
|
|---|
| 178 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 179 | c 5991 continue
|
|---|
| 180 | c
|
|---|
| 181 | cC CALCULATE HIGHT DIFFERENCE IN CM FROM GIVEN CHI IN G/CM**2
|
|---|
| 182 | c THCKHN = THICKH + COSTHE * CHI
|
|---|
| 183 | c HNEW = HEIGH(THCKHN)
|
|---|
| 184 | cC UPDATE PARTICLE TO INTERACTION POINT (IF IT REACHES SO FAR)
|
|---|
| 185 | cC AND STORE COORDINATES IN PROPAR
|
|---|
| 186 | c CALL UPDATE( HNEW, THCKHN, 0 )
|
|---|
| 187 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 188 |
|
|---|
| 189 | 5992 continue
|
|---|
| 190 | c>>> it was : >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 191 | cC CALCULATE HIGHT DIFFERENCE IN CM FROM GIVEN CHI IN G/CM**2
|
|---|
| 192 | c THCKHN = THICKH + COSTHE * CHI
|
|---|
| 193 | c HNEW = HEIGH(THCKHN)
|
|---|
| 194 | c IF (DEBUG) WRITE(MDEBUG,*)'BOX3 : THICKH,THCKHN,HNEW=',
|
|---|
| 195 | c * SNGL(THICKH),SNGL(THCKHN),SNGL(HNEW)
|
|---|
| 196 | cC UPDATE PARTICLE TO INTERACTION POINT (IF IT REACHES SO FAR)
|
|---|
| 197 | cC AND STORE COORDINATES IN PROPAR
|
|---|
| 198 | c CALL UPDATE( HNEW, THCKHN, 0 )
|
|---|
| 199 | c>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
|---|
| 200 |
|
|---|
| 201 | IF ( DEBUG ) THEN
|
|---|
| 202 | WRITE(MDEBUG,455) IRET1,IRET2
|
|---|
| 203 | 455 FORMAT(' BOX3 : IRET1..2=',2I5)
|
|---|
| 204 | IF ( IRET2 .EQ. 0 ) WRITE(MDEBUG,454) (OUTPAR(I),I=1,8)
|
|---|
| 205 | 454 FORMAT(' BOX3 : OUTPAR=',1P,8E10.3)
|
|---|
| 206 | ENDIF
|
|---|
| 207 | C STORE PARTICLE FOR FURTHER TREATMENT
|
|---|
| 208 | IF ( IRET2 .EQ. 0 ) THEN
|
|---|
| 209 | DO 3 I = 1,8
|
|---|
| 210 | PROPAR(I) = OUTPAR(I)
|
|---|
| 211 | 3 CONTINUE
|
|---|
| 212 | IRET3 = 0
|
|---|
| 213 | ELSE
|
|---|
| 214 | C PARTICLE CUTTED AT INTERACTION POINT; IT MAY HOWEVER PASS SOME OF THE
|
|---|
| 215 | C OBSERVATION LEVELS
|
|---|
| 216 | IRET3 = 1
|
|---|
| 217 | ENDIF
|
|---|
| 218 |
|
|---|
| 219 | C HERE THE ENDPOINT OF THE CURRENT TRACKING STEP IS WELL DEFINED.
|
|---|
| 220 | C THE PARTICLE IS TRACKED FROM THICKH DOWN TO THCKHN
|
|---|
| 221 | C COUNT THE PARTICLES FOR THE LONGITUDINAL DEVELOPMENT
|
|---|
| 222 | IF ( LLONGI ) THEN
|
|---|
| 223 | LPCT1 = INT(THICKH*THSTPI + 1.D0)
|
|---|
| 224 | LPCT2 = INT(THCKHN*THSTPI)
|
|---|
| 225 | LPCT2 = MIN(NSTEP,LPCT2)
|
|---|
| 226 | C ALL HADRONS
|
|---|
| 227 | IF ( ITYPE .GE. 7 .AND. ITYPE .LE. 41 ) THEN
|
|---|
| 228 | DO 5004 L = LPCT1,LPCT2
|
|---|
| 229 | PLONG(L,6) = PLONG(L,6) + 1.D0
|
|---|
| 230 | 5004 CONTINUE
|
|---|
| 231 | C CHARGED HADRONS
|
|---|
| 232 | IF ( SIGNUM(ITYPE) .NE. 0.D0 ) THEN
|
|---|
| 233 | DO 5005 L = LPCT1,LPCT2
|
|---|
| 234 | PLONG(L,7) = PLONG(L,7) + 1.D0
|
|---|
| 235 | 5005 CONTINUE
|
|---|
| 236 | ENDIF
|
|---|
| 237 | C NUCLEI
|
|---|
| 238 | ELSEIF ( ITYPE .GT. 100 ) THEN
|
|---|
| 239 | DO 5006 L = LPCT1,LPCT2
|
|---|
| 240 | PLONG(L,8) = PLONG(L,8) + 1.D0
|
|---|
| 241 | 5006 CONTINUE
|
|---|
| 242 | ENDIF
|
|---|
| 243 | ENDIF
|
|---|
| 244 |
|
|---|
| 245 | C CHECK OBSERVATION LEVEL PASSAGE AND UPDATE PARTICLE COORDINATES
|
|---|
| 246 | DO 1 J = 1,NOBSLV
|
|---|
| 247 | IF ( HNEW .GT. OBSLEV(J) ) GOTO 2
|
|---|
| 248 | IF ( H .LT. OBSLEV(J) ) GOTO 1
|
|---|
| 249 | C REMEMBER NUMBER OF LEVEL FOR OUTPUT
|
|---|
| 250 | LEVL = J
|
|---|
| 251 | CALL UPDATE( OBSLEV(J), THCKOB(J), J )
|
|---|
| 252 | IF (DEBUG) WRITE(MDEBUG,456) J,IRET1,IRET2
|
|---|
| 253 | 456 FORMAT(' BOX3 : LEVEL ',I5,' IRET1,2=',2I5)
|
|---|
| 254 |
|
|---|
| 255 | C IF PARTICLE IS NOT CUTTED, BRING IT TO OUTPUT
|
|---|
| 256 | IF ( IRET2 .EQ. 0 ) THEN
|
|---|
| 257 | CALL OUTPUT
|
|---|
| 258 | ENDIF
|
|---|
| 259 | 1 CONTINUE
|
|---|
| 260 |
|
|---|
| 261 | C KILL PARTICLE AS IT DECAYS OR INTERACTS BELOW LOWEST OBSLEVEL
|
|---|
| 262 | IRET1 = 1
|
|---|
| 263 | RETURN
|
|---|
| 264 |
|
|---|
| 265 | C PARTICLE INTERACTS OR DECAYS BEFORE PASSING OBSLEVEL
|
|---|
| 266 | 2 CONTINUE
|
|---|
| 267 |
|
|---|
| 268 | C PARTICLE IS NOW UPDATED TO POINT OF INTERACTION
|
|---|
| 269 | IF ( IRET3 .EQ. 0 ) THEN
|
|---|
| 270 | DO 5 J = 1,8
|
|---|
| 271 | CURPAR(J) = PROPAR(J)
|
|---|
| 272 | 5 CONTINUE
|
|---|
| 273 | ALEVEL = H
|
|---|
| 274 | BETA = SQRT( GAMMA**2 - 1.D0 ) / GAMMA
|
|---|
| 275 | ELSE
|
|---|
| 276 | C ELIMINATE PARTICLE IF BELOW CUTS
|
|---|
| 277 | IRET1 = 1
|
|---|
| 278 | ENDIF
|
|---|
| 279 |
|
|---|
| 280 | RETURN
|
|---|
| 281 | END
|
|---|
