Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gphys / gbrela.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:22  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.21  by  S.Giani
11 *-- Author :
12       SUBROUTINE GBRELA
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *  Initialize the bremsstrahlung energy loss tables              *
17 C.    *            ( See L.Urban report)                               *
18 C.    *                                                                *
19 C.    *    ==>Called by : GPHYSI                                       *
20 C.    *       Author    G.Patrick, L.Urban  *********                  *
21 C.    *                                                                *
22 C.    ******************************************************************
23 C.
24 #include "geant321/gcbank.inc"
25 #include "geant321/gcmulo.inc"
26 #include "geant321/gcjloc.inc"
27 #include "geant321/gctrak.inc"
28 #include "geant321/gccuts.inc"
29 #include "geant321/gcmate.inc"
30 #include "geant321/gconsp.inc"
31 #include "geant321/gcphys.inc"
32       DIMENSION DEM(8)
33       DATA DEM/-6.76228E-1,4.35611E-1,-4.69224E-1,-7.05133E-3,
34      +        1.31200,-8.07563E-1,-6.96166E-1,3.62549E-1/
35 C.
36 C.    ------------------------------------------------------------------
37 C.
38 C            Number of constituents(ie. element,mixture or compound).
39 C
40       NLMAT = Q(JMA+11)
41       NLM    = IABS(NLMAT)
42       IF (NLMAT.EQ.0)                             GO TO 999
43       IF(Z.LT.1.)                                 GO TO 999
44 C
45       JEL1=LQ(JMA-1)
46       JEL2=LQ(JMA-2)
47       ICHAN=IEKBIN
48       XE     = ELOW(ICHAN)
49       XE1    = 10.**(EKBIN(1)+(ICHAN-0.5)/GEKA)
50 C
51 C==========>  A,Bremsstrahlung losses for electrons
52 C             special treatment for compounds/mixtures
53 C
54       IF(JMIXT.EQ.0)THEN
55 C
56 C             simple material (element)
57 C
58          DEDX=GBRELE(Z,XE,BCUTE)
59          DEDX=AVO*DENS*DEDX/A
60 *
61 * *** auxiliary integration point for Range tables
62          IF(ICHAN.NE.NEK1) THEN
63             DEDX1=GBRELE(Z,XE1,BCUTE)
64             DEDX1=AVO*DENS*DEDX1/A
65          ENDIF
66       ELSE
67 C
68 C             compound/mixture
69 C
70          DEDX=0.
71          DEDX1=0.
72          DO 10 L=1,NLM
73             J = JMIXT+NLM+L
74             AA = Q(J-NLM)
75             ZZ = Q(J)
76             WMAT= Q(J+NLM)
77             S = GBRELE(ZZ,XE,BCUTE)
78             S = WMAT*S/AA
79             DEDX= DEDX+AVO*DENS*S
80 *
81 * *** auxiliary integration point for Range tables
82             IF(ICHAN.NE.NEK1) THEN
83                S = GBRELE(ZZ,XE1,BCUTE)
84                S = WMAT*S/AA
85                DEDX1= DEDX1+AVO*DENS*S
86             ENDIF
87    10    CONTINUE
88       ENDIF
89 C
90       IF(DEDX.LT.0.)DEDX=0.
91       Q(JEL1+ICHAN)=Q(JEL1+ICHAN)+DEDX
92       FACT = GBFLOS(XE,BCUTE)
93       Q(JEL1+ICHAN+NEK1)=Q(JEL1+ICHAN+NEK1)+FACT*DEDX
94 *
95       IF(ISTRA.NE.0) Q(JEL1+ICHAN+2*NEK1) = DEDX
96 *
97 * *** auxiliary integration point for Range tables
98       IF(ICHAN.NE.NEK1) THEN
99          IF(DEDX1.LT.0.)DEDX1=0.
100          WS(ICHAN)=WS(ICHAN)+DEDX1
101          FACT = GBFLOS(XE1,BCUTE)
102          WS(NEKBIN+ICHAN)=WS(NEKBIN+ICHAN)+FACT*DEDX1
103       ENDIF
104 C
105 C===========>  B, Bremsstrahlung losses for muons
106 C
107       IF(XE.GE.1.)GO TO 20
108       CONS1=3.26485E-8*Z*Z*DENS/A
109       CONS2=LOG(2.70511)-LOG(A)/3.
110       R=EMMU/(XE+EMMU)
111       RL=LOG(R)
112       DEDX=DEM(1)+RL*DEM(3)+R*(DEM(5)+R*DEM(7))
113       DEDX=DEDX+CONS2*(DEM(2)+RL*DEM(4)+R*(DEM(6)+R*DEM(8)))
114       DEDX=CONS1*XE*DEDX
115       IF(DEDX.LT.0.)DEDX=0.
116       Q(JEL2+ICHAN)=Q(JEL2+ICHAN)+DEDX
117 *
118       IF(ISTRA.NE.0) Q(JEL2+ICHAN+NEK1) = DEDX
119 *
120 * *** auxiliary integration point for Range tables
121       IF(ICHAN.NE.NEK1) THEN
122          R=EMMU/(XE1+EMMU)
123          RL=LOG(R)
124          DEDX1=DEM(1)+RL*DEM(3)+R*(DEM(5)+R*DEM(7))
125          DEDX1=DEDX1+CONS2*(DEM(2)+RL*DEM(4)+R*(DEM(6)+R*DEM(8)))
126          DEDX1=CONS1*XE1*DEDX1
127          IF(DEDX1.LT.0.)DEDX1=0.
128          WS(NEKBIN*2+ICHAN) = WS(NEKBIN*2+ICHAN)+DEDX1
129       ENDIF
130       GO TO 999
131 C
132    20 IF(JMIXT.EQ.0)THEN
133 C
134 C             simple material (element)
135 C
136          DEDX=GBRELM(Z,XE,BCUTM)
137          DEDX=AVO*DENS*DEDX/A
138 *
139 * *** auxiliary integration point for Range tables
140          IF(ICHAN.NE.NEK1) THEN
141             DEDX1=GBRELM(Z,XE1,BCUTM)
142             DEDX1=AVO*DENS*DEDX1/A
143          ENDIF
144       ELSE
145 C
146 C             compound/mixture
147 C
148          DEDX=0.
149          DEDX1=0.
150          DO 30 L=1,NLM
151             J = JMIXT+NLM+L
152             AA = Q(J-NLM)
153             ZZ = Q(J)
154             WMAT= Q(J+NLM)
155             S = GBRELM(ZZ,XE,BCUTM)
156             S = WMAT*S/AA
157             DEDX= DEDX+AVO*DENS*S
158 *
159 * *** auxiliary integration point for Range tables
160             IF(ICHAN.NE.NEK1) THEN
161                S = GBRELM(ZZ,XE1,BCUTM)
162                S = WMAT*S/AA
163                DEDX1= DEDX1+AVO*DENS*S
164             ENDIF
165    30    CONTINUE
166       ENDIF
167 C
168       IF(DEDX.LT.0.)DEDX=0.
169       Q(JEL2+ICHAN)=Q(JEL2+ICHAN)+DEDX
170 *
171       IF(ISTRA.NE.0) Q(JEL2+ICHAN+NEK1) = DEDX
172 *
173 * *** auxiliary integration point for Range tables
174       IF(ICHAN.NE.NEK1) THEN
175          IF(DEDX1.LT.0.)DEDX1=0.
176          WS(NEKBIN*2+ICHAN)=WS(NEKBIN*2+ICHAN)+DEDX1
177       ENDIF
178 C
179   999 END