[u/mrichter/AliRoot.git] / GEANT321 / gphys / gbrsge.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/09/30 13:30:10  ravndal
* Bremsstrahlung extension for higher energies
*
* Revision 1.1.1.1  1995/10/24 10:21:22  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/04 24/02/95  14.50.31  by  S.Giani
*-- Author :
      FUNCTION GBRSGE(ZZ,T,BCUT)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *  Calculates cross-section in current material                  *
C.    *  for discrete(hard) electron BREMSSTRAHLUNG.                   *
C.    *         (SIG in barn/atom)                                     *
C.    *                                                                *
C.    *    ==>Called by : GBRSGA                                       *
C.    *       Author  L.Urban  *********                               *
C.    *                                                                *
C.    *  correction for T> 100 GeV !  (by L.Urban on 23/09/96)         *
C.    ******************************************************************
C.
#include "geant321/gconsp.inc"
#include "geant321/gcmate.inc"
      DIMENSION C(100),C1(60),C2(40)
      EQUIVALENCE (C(1),C1(1)),(C(61),C2(1))
      SAVE C
#if !defined(CERNLIB_BETHE)
      PARAMETER (AKSI=1.80,ALFA=0.98,VS=0.0001)
      DATA C1/ 0.430748E-02, 0.576058E-02,-0.122564E-02, 0.114843E-03
     +      ,-0.489452E-05, 0.795991E-07, 0.326746E-02,-0.132872E-02
     +      , 0.217197E-03,-0.179769E-04, 0.766114E-06,-0.125603E-07
     +      , 0.326452E-02,-0.175331E-02, 0.415488E-03,-0.507652E-04
     +      , 0.297569E-05,-0.651741E-07, 0.847189E-03,-0.433923E-03
     +      , 0.116672E-03,-0.166799E-04, 0.110237E-05,-0.263383E-07
     +      , 0.846052E-04,-0.415764E-04, 0.129610E-04,-0.212844E-05
     +      , 0.152871E-06,-0.384393E-08, 0.300838E-05,-0.136833E-05
     +      , 0.507296E-06,-0.943623E-07, 0.720305E-08,-0.187210E-09
     +      , 0.448230E-01,-0.210048E-01, 0.379434E-02,-0.328431E-03
     +      , 0.136710E-04,-0.220593E-06,-0.539248E-02, 0.330244E-02
     +      ,-0.733726E-03, 0.732312E-04,-0.336810E-05, 0.583913E-07
     +      ,-0.106983E-02, 0.378021E-03,-0.384854E-04, 0.978156E-06
     +      , 0.410622E-07,-0.174250E-08,-0.117501E-04,-0.983887E-05
     +      , 0.239644E-05,-0.190104E-06, 0.619226E-08,-0.680932E-10/
      DATA C2/ 0.168074E-03,-0.934609E-04, 0.141293E-04,-0.854216E-06
     +      , 0.183287E-07, 0.932144E-04,-0.234926E-04, 0.136656E-05
     +      , 0.351109E-07,-0.330189E-08, 0.174523E-04, 0.253854E-05
     +      ,-0.171643E-05, 0.183074E-06,-0.566331E-08, 0.111970E-05
     +      , 0.112776E-05,-0.386924E-06, 0.367597E-07,-0.108504E-08
     +      , 0.171604E-07, 0.738801E-07,-0.218761E-07, 0.199032E-08
     +      ,-0.576173E-10,-0.105531E-03, 0.362995E-04,-0.433334E-05
     +      , 0.207664E-06,-0.330250E-08,-0.168293E-05,-0.773204E-06
     +      , 0.227974E-06,-0.159385E-07, 0.321958E-09, 0.167046E-05
     +      ,-0.440761E-06, 0.396377E-07,-0.151053E-08, 0.215624E-10/
#endif
#if defined(CERNLIB_BETHE)
      PARAMETER (AKSI=1.80,ALFA=1.00,VS=0.0001)
      DATA C1/ 0.111394E-01, 0.138592E-02,-0.274910E-03, 0.198389E-04
     +      ,-0.472291E-06,-0.668760E-09, 0.839876E-02,-0.449619E-02
     +      , 0.917722E-03,-0.874992E-04, 0.390015E-05,-0.653499E-07
     +      , 0.464718E-02,-0.260321E-02, 0.582582E-03,-0.631769E-04
     +      , 0.325801E-05,-0.638109E-07, 0.101243E-02,-0.532089E-03
     +      , 0.129100E-03,-0.161260E-04, 0.958116E-06,-0.212606E-07
     +      , 0.926006E-04,-0.455288E-04, 0.124755E-04,-0.182510E-05
     +      , 0.122078E-06,-0.294182E-08, 0.308111E-05,-0.134712E-05
     +      , 0.436230E-06,-0.751770E-07, 0.552327E-08,-0.140541E-09
     +      , 0.292552E-02,-0.830719E-03, 0.210705E-04, 0.103750E-04
     +      ,-0.953318E-06, 0.236453E-07, 0.110907E-02,-0.219463E-03
     +      , 0.128517E-04,-0.554575E-06, 0.507378E-07,-0.182214E-08
     +      ,-0.639866E-03, 0.209918E-03,-0.250183E-04, 0.138030E-05
     +      ,-0.358845E-07, 0.366305E-09, 0.300095E-04,-0.133668E-04
     +      , 0.198606E-05,-0.133100E-06, 0.414062E-08,-0.485929E-10/
      DATA C2/ 0.938677E-04,-0.613470E-04, 0.981984E-05,-0.646289E-06
     +      , 0.150731E-07, 0.331764E-04, 0.447248E-05,-0.313021E-05
     +      , 0.329777E-06,-0.997210E-08, 0.876484E-08, 0.110042E-04
     +      ,-0.313406E-05, 0.280040E-06,-0.794116E-08,-0.103097E-05
     +      , 0.220550E-05,-0.569158E-06, 0.491359E-07,-0.136987E-08
     +      ,-0.781963E-07, 0.123162E-06,-0.302825E-07, 0.255485E-08
     +      ,-0.702300E-10,-0.193213E-03, 0.640349E-04,-0.720586E-05
     +      , 0.329673E-06,-0.514682E-08, 0.362138E-04,-0.142783E-04
     +      , 0.184063E-05,-0.967983E-07, 0.179386E-08, 0.496130E-06
     +      , 0.210105E-06,-0.538512E-07, 0.372388E-08,-0.812734E-10/
#endif
C.
      DATA THIGH,CHIGH/100.,50./
C.    ------------------------------------------------------------------
C.
      GBRSGE=0.
*
      IF(BCUT.LE.0.) GOTO 99
      IF(BCUT.GE.T) GOTO 99
*
      IF(T.GT.THIGH) THEN
          TT=THIGH
        IF(BCUT.GE.THIGH) THEN
            EC=CHIGH
        ELSE
            EC=BCUT
        ENDIF
      ELSE
          TT=T
          EC=BCUT
      ENDIF
*
      E=TT+EMASS
*
C
      X=LOG(E/EMASS)
      Y=LOG(E*VS/EC)
C
      S=0.
      YY=1.
      DO 30 I=1,2
         XX=1.
         DO 20 J=1,6
            K=6*I+J-6
            S=S+C(K)*XX*YY
            XX=XX*X
  20     CONTINUE
         YY=YY*Y
  30  CONTINUE
      DO 50 I=3,6
         XX=1.
         DO 40 J=1,6
            K=6*I+J-6
            IF(Y.LE.0.) THEN
               S=S+C(K)*XX*YY
            ELSE
               S=S+C(K+24)*XX*YY
            ENDIF
            XX=XX*X
  40     CONTINUE
         YY=YY*Y
  50  CONTINUE
      SS=0.
      YY=1.
      DO 70 I=1,2
         XX=1.
         DO 60 J=1,5
            K=5*I+J+55
            SS=SS+C(K)*XX*YY
            XX=XX*X
  60     CONTINUE
         YY=YY*Y
  70  CONTINUE
      DO 90 I=3,5
         XX=1.
         DO 80 J=1,5
            K=5*I+J+55
            IF(Y.LE.0.) THEN
               SS=SS+C(K)*XX*YY
            ELSE
               SS=SS+C(K+15)*XX*YY
            ENDIF
            XX=XX*X
  80     CONTINUE
         YY=YY*Y
  90  CONTINUE
C
      S=S+Z*SS
      IF(S.LE.0.) GOTO 99
C
      FAC=ZZ*(ZZ+AKSI)*E*E*(LOG(TT/EC))**ALFA/(TT*(E+EMASS))
      IF(FAC.LE.0.) GOTO 99
C
      GBRSGE=FAC*S
*
      IF(T.GT.THIGH) THEN

       IF(BCUT.LT.THIGH) THEN
        RAT=BCUT/T
        S=(-LOG(RAT)-2./3.+RAT-RAT*RAT/3.)
        RAT=BCUT/TT
        S=S/(-LOG(RAT)-2./3.+RAT-RAT*RAT/3.)
       ELSE
        RAT=BCUT/T
        S=(-LOG(RAT)-2./3.+RAT-RAT*RAT/3.)
        RAT=EC/TT
        S=S/(-LOG(RAT)-2./3.+RAT-RAT*RAT/3.)
       ENDIF

        GBRSGE=GBRSGE*S
      ENDIF
*
99    RETURN
*
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.2 1996/09/30 13:30:10 ravndal
	6	* Bremsstrahlung extension for higher energies
	7	*
	8	* Revision 1.1.1.1 1995/10/24 10:21:22 cernlib
	9	* Geant
	10	*
	11	*
	12	#include "geant321/pilot.h"
	13	*CMZ : 3.21/04 24/02/95 14.50.31 by S.Giani
	14	*-- Author :
	15	FUNCTION GBRSGE(ZZ,T,BCUT)
	16	C.
	17	C. ******************************************************************
	18	C. * *
	19	C. * Calculates cross-section in current material *
	20	C. * for discrete(hard) electron BREMSSTRAHLUNG. *
	21	C. * (SIG in barn/atom) *
	22	C. * *
	23	C. * ==>Called by : GBRSGA *
	24	C. * Author L.Urban ********* *
	25	C. * *
	26	C. * correction for T> 100 GeV ! (by L.Urban on 23/09/96) *
	27	C. ******************************************************************
	28	C.
	29	#include "geant321/gconsp.inc"
	30	#include "geant321/gcmate.inc"
	31	DIMENSION C(100),C1(60),C2(40)
	32	EQUIVALENCE (C(1),C1(1)),(C(61),C2(1))
	33	SAVE C
	34	#if !defined(CERNLIB_BETHE)
	35	PARAMETER (AKSI=1.80,ALFA=0.98,VS=0.0001)
	36	DATA C1/ 0.430748E-02, 0.576058E-02,-0.122564E-02, 0.114843E-03
	37	+ ,-0.489452E-05, 0.795991E-07, 0.326746E-02,-0.132872E-02
	38	+ , 0.217197E-03,-0.179769E-04, 0.766114E-06,-0.125603E-07
	39	+ , 0.326452E-02,-0.175331E-02, 0.415488E-03,-0.507652E-04
	40	+ , 0.297569E-05,-0.651741E-07, 0.847189E-03,-0.433923E-03
	41	+ , 0.116672E-03,-0.166799E-04, 0.110237E-05,-0.263383E-07
	42	+ , 0.846052E-04,-0.415764E-04, 0.129610E-04,-0.212844E-05
	43	+ , 0.152871E-06,-0.384393E-08, 0.300838E-05,-0.136833E-05
	44	+ , 0.507296E-06,-0.943623E-07, 0.720305E-08,-0.187210E-09
	45	+ , 0.448230E-01,-0.210048E-01, 0.379434E-02,-0.328431E-03
	46	+ , 0.136710E-04,-0.220593E-06,-0.539248E-02, 0.330244E-02
	47	+ ,-0.733726E-03, 0.732312E-04,-0.336810E-05, 0.583913E-07
	48	+ ,-0.106983E-02, 0.378021E-03,-0.384854E-04, 0.978156E-06
	49	+ , 0.410622E-07,-0.174250E-08,-0.117501E-04,-0.983887E-05
	50	+ , 0.239644E-05,-0.190104E-06, 0.619226E-08,-0.680932E-10/
	51	DATA C2/ 0.168074E-03,-0.934609E-04, 0.141293E-04,-0.854216E-06
	52	+ , 0.183287E-07, 0.932144E-04,-0.234926E-04, 0.136656E-05
	53	+ , 0.351109E-07,-0.330189E-08, 0.174523E-04, 0.253854E-05
	54	+ ,-0.171643E-05, 0.183074E-06,-0.566331E-08, 0.111970E-05
	55	+ , 0.112776E-05,-0.386924E-06, 0.367597E-07,-0.108504E-08
	56	+ , 0.171604E-07, 0.738801E-07,-0.218761E-07, 0.199032E-08
	57	+ ,-0.576173E-10,-0.105531E-03, 0.362995E-04,-0.433334E-05
	58	+ , 0.207664E-06,-0.330250E-08,-0.168293E-05,-0.773204E-06
	59	+ , 0.227974E-06,-0.159385E-07, 0.321958E-09, 0.167046E-05
	60	+ ,-0.440761E-06, 0.396377E-07,-0.151053E-08, 0.215624E-10/
	61	#endif
	62	#if defined(CERNLIB_BETHE)
	63	PARAMETER (AKSI=1.80,ALFA=1.00,VS=0.0001)
	64	DATA C1/ 0.111394E-01, 0.138592E-02,-0.274910E-03, 0.198389E-04
65	+ ,-0.472291E-06,-0.668760E-09, 0.839876E-02,-0.449619E-02
66	+ , 0.917722E-03,-0.874992E-04, 0.390015E-05,-0.653499E-07
67	+ , 0.464718E-02,-0.260321E-02, 0.582582E-03,-0.631769E-04
68	+ , 0.325801E-05,-0.638109E-07, 0.101243E-02,-0.532089E-03
69	+ , 0.129100E-03,-0.161260E-04, 0.958116E-06,-0.212606E-07
70	+ , 0.926006E-04,-0.455288E-04, 0.124755E-04,-0.182510E-05
71	+ , 0.122078E-06,-0.294182E-08, 0.308111E-05,-0.134712E-05
72	+ , 0.436230E-06,-0.751770E-07, 0.552327E-08,-0.140541E-09
73	+ , 0.292552E-02,-0.830719E-03, 0.210705E-04, 0.103750E-04
74	+ ,-0.953318E-06, 0.236453E-07, 0.110907E-02,-0.219463E-03
75	+ , 0.128517E-04,-0.554575E-06, 0.507378E-07,-0.182214E-08
76	+ ,-0.639866E-03, 0.209918E-03,-0.250183E-04, 0.138030E-05
77	+ ,-0.358845E-07, 0.366305E-09, 0.300095E-04,-0.133668E-04
78	+ , 0.198606E-05,-0.133100E-06, 0.414062E-08,-0.485929E-10/
79	DATA C2/ 0.938677E-04,-0.613470E-04, 0.981984E-05,-0.646289E-06
80	+ , 0.150731E-07, 0.331764E-04, 0.447248E-05,-0.313021E-05
81	+ , 0.329777E-06,-0.997210E-08, 0.876484E-08, 0.110042E-04
82	+ ,-0.313406E-05, 0.280040E-06,-0.794116E-08,-0.103097E-05
83	+ , 0.220550E-05,-0.569158E-06, 0.491359E-07,-0.136987E-08
84	+ ,-0.781963E-07, 0.123162E-06,-0.302825E-07, 0.255485E-08
85	+ ,-0.702300E-10,-0.193213E-03, 0.640349E-04,-0.720586E-05
86	+ , 0.329673E-06,-0.514682E-08, 0.362138E-04,-0.142783E-04
87	+ , 0.184063E-05,-0.967983E-07, 0.179386E-08, 0.496130E-06
88	+ , 0.210105E-06,-0.538512E-07, 0.372388E-08,-0.812734E-10/
89	#endif
90	C.
91	DATA THIGH,CHIGH/100.,50./
92	C. ------------------------------------------------------------------
93	C.
94	GBRSGE=0.
95	*
96	IF(BCUT.LE.0.) GOTO 99
97	IF(BCUT.GE.T) GOTO 99
98	*
99	IF(T.GT.THIGH) THEN
100	TT=THIGH
101	IF(BCUT.GE.THIGH) THEN
102	EC=CHIGH
103	ELSE
104	EC=BCUT
105	ENDIF
106	ELSE
107	TT=T
108	EC=BCUT
109	ENDIF
110	*
111	E=TT+EMASS
112	*
113	C
114	X=LOG(E/EMASS)
115	Y=LOG(E*VS/EC)
116	C
117	S=0.
118	YY=1.
119	DO 30 I=1,2
120	XX=1.
121	DO 20 J=1,6
122	K=6*I+J-6
123	S=S+C(K)XXYY
124	XX=XX*X
125	20 CONTINUE
126	YY=YY*Y
127	30 CONTINUE
128	DO 50 I=3,6
129	XX=1.
130	DO 40 J=1,6
131	K=6*I+J-6
132	IF(Y.LE.0.) THEN
133	S=S+C(K)XXYY
134	ELSE
135	S=S+C(K+24)XXYY
136	ENDIF
137	XX=XX*X
138	40 CONTINUE
139	YY=YY*Y
140	50 CONTINUE
141	SS=0.
142	YY=1.
143	DO 70 I=1,2
144	XX=1.
145	DO 60 J=1,5
146	K=5*I+J+55
147	SS=SS+C(K)XXYY
148	XX=XX*X
149	60 CONTINUE
150	YY=YY*Y
151	70 CONTINUE
152	DO 90 I=3,5
153	XX=1.
154	DO 80 J=1,5
155	K=5*I+J+55
156	IF(Y.LE.0.) THEN
157	SS=SS+C(K)XXYY
158	ELSE
159	SS=SS+C(K+15)XXYY
160	ENDIF
161	XX=XX*X
162	80 CONTINUE
163	YY=YY*Y
164	90 CONTINUE
165	C
166	S=S+Z*SS
167	IF(S.LE.0.) GOTO 99
168	C
169	FAC=ZZ(ZZ+AKSI)EE(LOG(TT/EC))*ALFA/(TT(E+EMASS))
170	IF(FAC.LE.0.) GOTO 99
171	C
172	GBRSGE=FAC*S
173	*
174	IF(T.GT.THIGH) THEN
175
176	IF(BCUT.LT.THIGH) THEN
177	RAT=BCUT/T
178	S=(-LOG(RAT)-2./3.+RAT-RAT*RAT/3.)
179	RAT=BCUT/TT
180	S=S/(-LOG(RAT)-2./3.+RAT-RAT*RAT/3.)
181	ELSE
182	RAT=BCUT/T
183	S=(-LOG(RAT)-2./3.+RAT-RAT*RAT/3.)
184	RAT=EC/TT
185	S=S/(-LOG(RAT)-2./3.+RAT-RAT*RAT/3.)
186	ENDIF
187
188	GBRSGE=GBRSGE*S
189	ENDIF
190	*
191	99 RETURN
192	*
193	END