This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gphys / gmulof.F
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