]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | #include "geant321/pilot.h" |
2 | *CMZ : 3.21/02 29/03/94 15.41.22 by S.Giani | |
3 | *-- Author : | |
4 | SUBROUTINE GMULOF | |
5 | C. | |
6 | C. ****************************************************************** | |
7 | C. * * | |
8 | C. * Calculates table of steps for multiple scattering * | |
9 | C. * energy loss and magnetic field for electrons,muons * | |
10 | C. * (cannot be tabuled for hadrons) * | |
11 | C. * : smuls = min (Tbethe , 10*radl) * | |
12 | C. * : sloss = DEEMAX*GEKIN/DEDX * | |
13 | C. * : sfield = CFLD*P * | |
14 | C. * * | |
15 | C. * ==>Called by : GPHYSI * | |
16 | C. * Authors R.Brun, Y.Dufour, M.Maire ********* * | |
17 | C. * * | |
18 | C. ****************************************************************** | |
19 | C. | |
20 | #include "geant321/gcbank.inc" | |
21 | #include "geant321/gcjloc.inc" | |
22 | #include "geant321/gconsp.inc" | |
23 | #include "geant321/gcmulo.inc" | |
24 | #include "geant321/gckine.inc" | |
25 | #include "geant321/gcmate.inc" | |
26 | #include "geant321/gctrak.inc" | |
27 | #include "geant321/gcking.inc" | |
28 | #include "geant321/gctmed.inc" | |
29 | #include "geant321/gccuts.inc" | |
30 | #include "geant321/gcphys.inc" | |
31 | * | |
32 | LOGICAL CERKOV | |
33 | * | |
34 | *----------------------------------------------------------------------- | |
35 | * | |
36 | SMULS = BIG | |
37 | SLOSS = BIG | |
38 | SFIELD = BIG | |
39 | STOPMX = BIG | |
40 | STCKOV = BIG | |
41 | JPROB = LQ(JMA-4) | |
42 | JMIXT = LQ(JMA-5) | |
43 | OMC = Q(JPROB+21) | |
44 | CHC2 = Q(JPROB+25)**2 | |
45 | NLMAT=Q(JMA+11) | |
46 | NLM=IABS(NLMAT) | |
47 | IF (FIELDM.NE.0.) CFLD = 3333.*DEGRAD*TMAXFD/ABS(FIELDM) | |
48 | * | |
49 | IF(ITCKOV.NE.0.AND.IQ(JTM-2).GE.3.AND. LQ(JTM-3) | |
50 | +.NE.0.AND.LQ(LQ(JTM-3)-3).NE.0) THEN | |
51 | * | |
52 | * *** In this tracking medium Cerenkov photons are generated and | |
53 | * *** tracked. Set to 1 the corresponding flag and calculate the | |
54 | * *** relevant pointers. | |
55 | * | |
56 | CERKOV = .TRUE. | |
57 | JTCKOV = LQ(JTM-3) | |
58 | JABSCO = LQ(JTCKOV-1) | |
59 | JEFFIC = LQ(JTCKOV-2) | |
60 | JINDEX = LQ(JTCKOV-3) | |
61 | JCURIN = LQ(JTCKOV-4) | |
62 | NPCKOV = Q(JTCKOV+1) | |
63 | ELSE | |
64 | CERKOV = .FALSE. | |
65 | ENDIF | |
66 | * | |
67 | * *** Electrons | |
68 | * | |
69 | JRANG = LQ(JMA-15) | |
70 | IKCUT = MAX((GEKA*LOG10(CUTELE) + GEKB),1.) | |
71 | GKC = (CUTELE-ELOW(IKCUT))/(ELOW(IKCUT+1)-ELOW(IKCUT)) | |
72 | STOPC = (1.-GKC)*Q(JRANG+IKCUT) + GKC*Q(JRANG+IKCUT+1) | |
73 | JMULOF = LQ(JTM-1) | |
74 | Q(JMULOF+NEK1+1) = IKCUT | |
75 | Q(JMULOF+NEK1+2) = STOPC | |
76 | * | |
77 | * *** Recompute STMIN ? | |
78 | * set STMIN to the range of an electron at energy=CUTELE + 200KeV | |
79 | * divided by sqrt(RADL) (important for light materials) | |
80 | * | |
81 | IF(STMIN.LT.0.)THEN | |
82 | XES=CUTELE+2.E-4 | |
83 | IKS = MAX((GEKA*LOG10(XES) + GEKB),1.) | |
84 | GKS = (XES-ELOW(IKS))/(ELOW(IKS+1)-ELOW(IKS)) | |
85 | STMIN = (1.-GKS)*Q(JRANG+IKS) + GKS*Q(JRANG+IKS+1) - STOPC | |
86 | IF(Q(JTM+7).EQ.0.)THEN | |
87 | STMIN = 2.*STMIN/SQRT(RADL) | |
88 | ELSE | |
89 | STMIN = 5.*STMIN/RADL | |
90 | ENDIF | |
91 | ENDIF | |
92 | Q(JTM+14)=STMIN | |
93 | * | |
94 | DO 10 IEKBIN=1,NEK1 | |
95 | GEKIN = ELOW(IEKBIN) | |
96 | GETOT = GEKIN + EMASS | |
97 | PMOM2 = GEKIN*(GETOT+EMASS) | |
98 | PMOM = SQRT(PMOM2) | |
99 | BETA2 = PMOM2/(GETOT**2) | |
100 | * | |
101 | IF (IMULS.GT.0.) THEN | |
102 | IF(JMIXT.LE.0)THEN | |
103 | CALL GMOLIO(A,Z,1.,1,DENS,BETA2,1.,OMC) | |
104 | ELSE | |
105 | CALL GMOLIO(Q(JMIXT+1),Q(JMIXT+NLM+1),Q(JMIXT+2*NLM+1), | |
106 | + NLM,DENS,BETA2,1.,OMC) | |
107 | ENDIF | |
108 | PMCH2 = PMOM2/CHC2 | |
109 | TBETHE = (PMCH2*BETA2)/LOG(OMC*PMCH2) | |
110 | TMXCOR = 2232.*RADL*PMOM2*BETA2 | |
111 | SMULS = MIN(TBETHE,TMXCOR,10.*RADL) | |
112 | ENDIF | |
113 | * | |
114 | IF (IFIELD*FIELDM.NE.0.) THEN | |
115 | SFIELD = CFLD*PMOM | |
116 | ENDIF | |
117 | * | |
118 | IF (ILOSS*DEEMAX.GT.0.) THEN | |
119 | IF (IEKBIN.LE.IKCUT) THEN | |
120 | STOPMX = 0. | |
121 | SLOSS = 0. | |
122 | ELSE | |
123 | STOPMX = Q(JRANG+IEKBIN) | |
124 | EKF = (1.-DEEMAX)*GEKIN | |
125 | IF (EKF.LE.ELOW(1)) EKF = ELOW(1) | |
126 | IKF = MAX((GEKA*LOG10(EKF) + GEKB),1.) | |
127 | GKR = (EKF-ELOW(IKF))/(ELOW(IKF+1)-ELOW(IKF)) | |
128 | SLOSS = STOPMX-(1.-GKR)*Q(JRANG+IKF)-GKR*Q(JRANG+IKF+1) | |
129 | IF (SLOSS.LE.0.) SLOSS = 0. | |
130 | STOPMX = STOPMX-STOPC | |
131 | IF (STOPMX.LE.0.) STOPMX = 0. | |
132 | ENDIF | |
133 | ENDIF | |
134 | IF(CERKOV) THEN | |
135 | CHARGE = 1. | |
136 | VECT(7) = PMOM | |
137 | CALL GNCKOV | |
138 | STCKOV = MXPHOT/MAX(3.*DNDL,1E-10) | |
139 | ENDIF | |
140 | * | |
141 | STEP = MIN(SMULS,SLOSS,SFIELD,STCKOV) | |
142 | IF (STEP.LT.STMIN) THEN | |
143 | STEP = MIN(STMIN,STOPMX) | |
144 | ENDIF | |
145 | Q(JMULOF+IEKBIN) = STEP | |
146 | 10 CONTINUE | |
147 | DO 20 I=1,IKCUT | |
148 | Q(JMULOF+I)=0.5*Q(JMULOF+IKCUT+1) | |
149 | 20 CONTINUE | |
150 | * | |
151 | * *** Muons | |
152 | * | |
153 | JRANG = LQ(JMA-16) | |
154 | IKCUT = GEKA*LOG10(CUTMUO) + GEKB | |
155 | GKC = (CUTMUO-ELOW(IKCUT))/(ELOW(IKCUT+1)-ELOW(IKCUT)) | |
156 | STOPC = (1.-GKC)*Q(JRANG+IKCUT) + GKC*Q(JRANG+IKCUT+1) | |
157 | JMULOF = LQ(JTM-2) | |
158 | Q(JMULOF+NEK1+1)=IKCUT | |
159 | Q(JMULOF+NEK1+2)=STOPC | |
160 | * | |
161 | DO 30 IEKBIN=1,NEK1 | |
162 | GEKIN = ELOW(IEKBIN) | |
163 | GETOT = GEKIN + EMMU | |
164 | PMOM2 = GEKIN*(GETOT+EMMU) | |
165 | PMOM = SQRT(PMOM2) | |
166 | BETA2 = PMOM2/(GETOT**2) | |
167 | * | |
168 | IF (IMULS.GT.0.) THEN | |
169 | IF(JMIXT.LE.0)THEN | |
170 | CALL GMOLIO(A,Z,1.,1,DENS,BETA2,1.,OMC) | |
171 | ELSE | |
172 | CALL GMOLIO(Q(JMIXT+1),Q(JMIXT+NLM+1),Q(JMIXT+2*NLM+1), | |
173 | + NLM,DENS,BETA2,1.,OMC) | |
174 | ENDIF | |
175 | PMCH2 = PMOM2/CHC2 | |
176 | TBETHE = (PMCH2*BETA2)/LOG(OMC*PMCH2) | |
177 | TMXCOR = 2232.*RADL*PMOM2*BETA2 | |
178 | SMULS = MIN(TBETHE,TMXCOR,10.*RADL) | |
179 | ENDIF | |
180 | * | |
181 | IF (IFIELD*FIELDM.NE.0.) THEN | |
182 | SFIELD = CFLD*PMOM | |
183 | ENDIF | |
184 | * | |
185 | IF (ILOSS*DEEMAX.GT.0.) THEN | |
186 | IF (IEKBIN.LE.IKCUT) THEN | |
187 | STOPMX = 0. | |
188 | SLOSS = 0. | |
189 | ELSE | |
190 | STOPMX = Q(JRANG+IEKBIN) | |
191 | EKF = (1.-DEEMAX)*GEKIN | |
192 | IF (EKF.LE.ELOW(1)) EKF = ELOW(1) | |
193 | IKF = GEKA*LOG10(EKF) + GEKB | |
194 | GKR = (EKF-ELOW(IKF))/(ELOW(IKF+1)-ELOW(IKF)) | |
195 | SLOSS = STOPMX-(1.-GKR)*Q(JRANG+IKF)-GKR*Q(JRANG+IKF+1) | |
196 | IF (SLOSS.LE.0.) SLOSS = 0. | |
197 | STOPMX = STOPMX-STOPC | |
198 | IF (STOPMX.LE.0.) STOPMX = 0. | |
199 | ENDIF | |
200 | ENDIF | |
201 | IF(CERKOV) THEN | |
202 | CHARGE = 1. | |
203 | VECT(7) = PMOM | |
204 | CALL GNCKOV | |
205 | STCKOV = MXPHOT/MAX(3.*DNDL,1E-10) | |
206 | ENDIF | |
207 | * | |
208 | STEP = MIN(SMULS,SLOSS,SFIELD,STCKOV) | |
209 | IF (STEP.LT.STMIN) THEN | |
210 | STEP = MIN(STMIN,STOPMX) | |
211 | ENDIF | |
212 | Q(JMULOF+IEKBIN) = STEP | |
213 | 30 CONTINUE | |
214 | DO 40 I=1,IKCUT | |
215 | Q(JMULOF+I)=0.5*Q(JMULOF+IKCUT+1) | |
216 | 40 CONTINUE | |
217 | * | |
218 | END |