]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gphys/gmulof.F
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gphys / gmulof.F
CommitLineData
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
5C.
6C. ******************************************************************
7C. * *
8C. * Calculates table of steps for multiple scattering *
9C. * energy loss and magnetic field for electrons,muons *
10C. * (cannot be tabuled for hadrons) *
11C. * : smuls = min (Tbethe , 10*radl) *
12C. * : sloss = DEEMAX*GEKIN/DEDX *
13C. * : sfield = CFLD*P *
14C. * *
15C. * ==>Called by : GPHYSI *
16C. * Authors R.Brun, Y.Dufour, M.Maire ********* *
17C. * *
18C. ******************************************************************
19C.
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