This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gphys / gprsga.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:33  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 GPRSGA
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *  Calculates cross-section in current material                  *
17 C.    *  for photon pair production and muon direct pair production.   *
18 C.    *                                                                *
19 C     *  semiempirical cross section formula of L.Urban is used        *
20 C     *  to estimate the photon mean free path in a given material     *
21 C     *            (see WRITEUP)                                       *
22 C.    *                                                                *
23 C.    *    ==>Called by : GPHYSI                                       *
24 C.    *       Authors    R.Brun, G.Patrick, L.Urban  *********         *
25 C.    *                                                                *
26 C.    ******************************************************************
27 C.
28 #include "geant321/gcbank.inc"
29 #include "geant321/gconsp.inc"
30 #include "geant321/gctrak.inc"
31 #include "geant321/gcmate.inc"
32 #include "geant321/gcjloc.inc"
33 #include "geant321/gcmulo.inc"
34 #include "geant321/gccuts.inc"
35 C.
36 C.    ------------------------------------------------------------------
37 C.
38 C======>     A, Pair production by photons
39 C               ==========================
40 C               Cut on threshold kinetic energy. Special case for vacuum
41 C
42       SST=0.
43       IF(Z.LT.1.)GO TO 90
44       EGAM   = ELOW(IEKBIN)
45       IF (EGAM.LT.0.00099) GO TO 90
46       IF (EGAM.LT.0.00199) EGAM=0.0014
47 C
48       JPROB=LQ(JMA-4)
49       IF(JMIXT.EQ.0)THEN
50 C
51 C             simple material (element)
52 C
53           SST=GPRSGG(Z,EGAM)/A
54       ELSE
55 C
56 C             compound or mixture
57 C
58          NLMAT=Q(JMA+11)
59          NLM=IABS(NLMAT)
60          DO 10 I=1,NLM
61             II=JMIXT+NLM+I
62             AA=Q(II-NLM)
63             ZZ=Q(II)
64             W=Q(II+NLM)
65             SST=SST+W*GPRSGG(ZZ,EGAM)/AA
66   10     CONTINUE
67       ENDIF
68 C
69       SST=AVO*DENS*SST
70 C
71   90  IF(SST.GT.0.)THEN
72          Q(JPAIR+IEKBIN)=1./SST
73       ELSE
74          Q(JPAIR+IEKBIN)=BIG
75       ENDIF
76 C
77 C======>     B, Direct pair production by muons
78 C               ===============================
79 C
80       SST=0.
81       IF(Z.LT.1.)GO TO 190
82       T=ELOW(IEKBIN)
83       IF(T.LT.1.)GO TO 190
84       IF(T.LE.PPCUTM)GO TO 190
85       IF(JMIXT.EQ.0)THEN
86 C
87 C            Element
88 C
89          SST=GPRSGM(Z,T,PPCUTM)
90          SST=SST/A
91       ELSE
92 C
93 C            Compound/Mixture
94 C
95          NLMAT=Q(JMA+11)
96          NLM  =IABS(NLMAT)
97          SST  =0.
98          DO 110 I=1,NLM
99             II   = JMIXT+NLM+I
100             AA   = Q(II-NLM)
101             ZZ   = Q(II)
102             WMAT = Q(II+NLM)
103             SST  = SST+WMAT*GPRSGM(ZZ,T,PPCUTM)/AA
104  110     CONTINUE
105       ENDIF
106       SST=AVO*DENS*SST
107 C
108  190  IF(SST.GT.0.)THEN
109          Q(JPAIR+IEKBIN+NEK1)=1./SST
110       ELSE
111          Q(JPAIR+IEKBIN+NEK1)=BIG
112       ENDIF
113 C
114       END