This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gphys / gprela.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:32  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
11 *-- Author :
12       SUBROUTINE GPRELA
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *  Initialise energy loss due to direct pair-production  and     *
17 C.    *  nuclear interactions by muons.                                *
18 C.    *                                                                *
19 C     *       A, Direct pair production  <=======                      *
20 C     *                                                                *
21 C.    *  The DE/DX expression of MANDO and RONCHI(NUOVO CIMENTO        *
22 C.    *  9(1952),517) is used which attempts to account for the effect *
23 C.    *  of atomic electron screening. The screening correction is     *
24 C.    *  applied above the energy limit defined by C. RICHARD-SERRE    *
25 C.    *  (CERN 71-18).                                                 *
26 C.    *                                                                *
27 C     *       B, Nuclear interactions  <=======                        *
28 C.    *                                                                *
29 C.    *  the following expression derived from the Williams-Weizsacker *
30 C.    *  relation for the virtual photon flux is used :                *
31 C.    *                                                                *
32 C.    *      DE/DX = FACTOR * XSEC * E                                 *
33 C.    *                                                                *
34 C.    *      where,                                                    *
35 C.    *      FACTOR  =  2. * N * ALPHA / PI                            *
36 C.    *      XSEC    =  total photo-nuclear cross-section assumed to   *
37 C.    *                 be independent of energy. Value of 140 mubarns *
38 C.    *                 calculated by averaging the results of Hesse   *
39 C.    *                 et al(Phys. Rev. Lett 25(1970),613).           *
40 C.    *                                                                *
41 C.    *    ==>Called by : GPHYSI                                       *
42 C.    *       Author    G.Patrick  *********                           *
43 C.    *                                                                *
44 C.    ******************************************************************
45 C.
46 #include "geant321/gcbank.inc"
47 #include "geant321/gcjloc.inc"
48 #include "geant321/gcmulo.inc"
49 #include "geant321/gcmate.inc"
50 #include "geant321/gcphys.inc"
51 #include "geant321/gconsp.inc"
52 #include "geant321/gccuts.inc"
53 #include "geant321/gctrak.inc"
54       DATA XSEC  /140.E-30/
55       DATA FACTOR/2.7976238E+21/
56 C.
57 C.    ------------------------------------------------------------------
58 C.
59       IF(Z.LT.1.) GOTO 999
60       ICHAN=IEKBIN
61       T    = ELOW(ICHAN)
62       T1   = 10.**(EKBIN(1)+(ICHAN-0.5)/GEKA)
63       IF(T.LT.1.)GO TO 999
64       E    = T+EMMU
65       E1   = T1+EMMU
66       IF(JMIXT.EQ.0)THEN
67 C
68 C           Element
69 C
70          DEDX = GPRELM(Z,T,PPCUTM)
71          DEDX = AVO*DENS*DEDX/A
72 *
73 * *** auxiliary integration point for Range tables
74          IF(ICHAN.NE.NEK1) THEN
75             DEDX1 = GPRELM(Z,T1,PPCUTM)
76             DEDX1 = AVO*DENS*DEDX1/A
77          ENDIF
78       ELSE
79 C
80 C          Compound/Mixture
81 C
82          NLMAT = Q(JMA+11)
83          NLM   = IABS(NLMAT)
84          DEDX  = 0.
85          DEDX1 = 0.
86          DO 10 L=1,NLM
87             J    = JMIXT+NLM+L
88             AA   = Q(J-NLM)
89             ZZ   = Q(J)
90             WMAT = Q(J+NLM)
91             S    = GPRELM(ZZ,T,PPCUTM)
92             S    = WMAT*S/AA
93             DEDX = DEDX+AVO*DENS*S
94 *
95 * *** auxiliary integration point for Range tables
96             IF(ICHAN.NE.NEK1) THEN
97                S = GPRELM(ZZ,T1,PPCUTM)
98                S = WMAT*S/AA
99                DEDX1 = DEDX1+AVO*DENS*S
100             ENDIF
101    10    CONTINUE
102       ENDIF
103 C
104 C             Nuclear interactions
105 C
106       IF(IMUNU.EQ.0.AND.E.GE.10.) THEN
107          DENU=DENS*FACTOR*XSEC*E
108 *
109 * *** auxiliary integration point for Range tables
110          IF(ICHAN.NE.NEK1) THEN
111             DENU1=DENS*FACTOR*XSEC*E1
112          ENDIF
113       ELSE
114          DENU=0.0
115          DENU1=0.0
116       ENDIF
117       IF(DEDX.LT.0.)DEDX=0.
118       IF(DENU.LT.0.)DENU=0.
119       JEL2=LQ(JMA-2)
120       Q(JEL2+ICHAN)=Q(JEL2+ICHAN)+DEDX+DENU
121 *
122 * *** auxiliary integration point for Range tables
123       IF(ICHAN.NE.NEK1) THEN
124          IF(DEDX1.LT.0.)DEDX1=0.
125          IF(DENU1.LT.0.)DENU1=0.
126          WS(NEKBIN*2+ICHAN)=WS(NEKBIN*2+ICHAN)+DEDX1+DENU1
127       ENDIF
128 C
129   999 END