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

*
* $Id$
*
* $Log$
* Revision 1.2  1996/09/30 13:30:03  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/02 29/03/94  15.41.21  by  S.Giani
*-- Author :
      FUNCTION GBRELE(ZZ,T,BCUT)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *  Calculates energy loss by soft Bremsstrahlung                 *
C.    *         (in GeV barn/atom)                                     *
C.    *                                                                *
C.    *    ==>Called by : GBRELA                                       *
C.    *       Author  L.Urban  *********                               *
C.    *    ( correction for T>100. GeV)                                *
C.    *                                                                *
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))
#if !defined(CERNLIB_BETHE)
      DATA C1/-0.960613E-01, 0.631029E-01,-0.142819E-01, 0.150437E-02
     +      ,-0.733286E-04, 0.131404E-05, 0.859343E-01,-0.529023E-01
     +      , 0.131899E-01,-0.159201E-02, 0.926958E-04,-0.208439E-05
     +      ,-0.684096E+01, 0.370364E+01,-0.786752E+00, 0.822670E-01
     +      ,-0.424710E-02, 0.867980E-04,-0.200856E+01, 0.129573E+01
     +      ,-0.306533E+00, 0.343682E-01,-0.185931E-02, 0.392432E-04
     +      , 0.127538E+01,-0.515705E+00, 0.820644E-01,-0.641997E-02
     +      , 0.245913E-03,-0.365789E-05, 0.115792E+00,-0.463143E-01
     +      , 0.725442E-02,-0.556266E-03, 0.208049E-04,-0.300895E-06
     +      ,-0.271082E-01, 0.173949E-01,-0.452531E-02, 0.569405E-03
     +      ,-0.344856E-04, 0.803964E-06, 0.419855E-02,-0.277188E-02
     +      , 0.737658E-03,-0.939463E-04, 0.569748E-05,-0.131737E-06
     +      ,-0.318752E-03, 0.215144E-03,-0.579787E-04, 0.737972E-05
     +      ,-0.441485E-06, 0.994726E-08, 0.938233E-05,-0.651642E-05
     +      , 0.177303E-05,-0.224680E-06, 0.132080E-07,-0.288593E-09/
      DATA C2/-0.245667E-03, 0.833406E-04,-0.129217E-04, 0.915099E-06
     +      ,-0.247179E-07, 0.147696E-03,-0.498793E-04, 0.402375E-05
     +      , 0.989281E-07,-0.133378E-07,-0.737702E-02, 0.333057E-02
     +      ,-0.553141E-03, 0.402464E-04,-0.107977E-05,-0.641533E-02
     +      , 0.290113E-02,-0.477641E-03, 0.342008E-04,-0.900582E-06
     +      , 0.574303E-05, 0.908521E-04,-0.256900E-04, 0.239921E-05
     +      ,-0.741271E-07,-0.341260E-04, 0.971711E-05,-0.172031E-06
     +      ,-0.119455E-06, 0.704166E-08, 0.341740E-05,-0.775867E-06
     +      ,-0.653231E-07, 0.225605E-07,-0.114860E-08,-0.119391E-06
     +      , 0.194885E-07, 0.588959E-08,-0.127589E-08, 0.608247E-10/
      DATA AKSI,BETA,VE/2.51,0.99,0.00004/
#endif
#if defined(CERNLIB_BETHE)
      DATA C1/ 0.834459E-02, 0.443979E-02,-0.101420E-02, 0.963240E-04
     +      ,-0.409769E-05, 0.642589E-07, 0.464473E-02,-0.290378E-02
     +      , 0.547457E-03,-0.426949E-04, 0.137760E-05,-0.131050E-07
     +      ,-0.547866E-02, 0.156218E-02,-0.167352E-03, 0.101026E-04
     +      ,-0.427518E-06, 0.949555E-08,-0.406862E-02, 0.208317E-02
     +      ,-0.374766E-03, 0.317610E-04,-0.130533E-05, 0.211051E-07
     +      , 0.158941E-02,-0.385362E-03, 0.315564E-04,-0.734968E-06
     +      ,-0.230387E-07, 0.971174E-09, 0.467219E-03,-0.154047E-03
     +      , 0.202400E-04,-0.132438E-05, 0.431474E-07,-0.559750E-09
     +      ,-0.220958E-02, 0.100698E-02,-0.596464E-04,-0.124653E-04
     +      , 0.142999E-05,-0.394378E-07, 0.477447E-03,-0.184952E-03
     +      ,-0.152614E-04, 0.848418E-05,-0.736136E-06, 0.190192E-07
     +      ,-0.552930E-04, 0.209858E-04, 0.290001E-05,-0.133254E-05
     +      , 0.116971E-06,-0.309716E-08, 0.212117E-05,-0.103884E-05
     +      ,-0.110912E-06, 0.655143E-07,-0.613013E-08, 0.169207E-09/
      DATA C2/ 0.301125E-04,-0.461920E-04, 0.871485E-05,-0.622331E-06
     +      , 0.151800E-07,-0.478023E-04, 0.247530E-04,-0.381763E-05
     +      , 0.232819E-06,-0.494487E-08,-0.336230E-04, 0.223822E-04
     +      ,-0.384583E-05, 0.252867E-06,-0.572599E-08, 0.105335E-04
     +      ,-0.567074E-06,-0.216564E-06, 0.237268E-07,-0.658131E-09
     +      , 0.282025E-05,-0.671965E-06, 0.565858E-07,-0.193843E-08
     +      , 0.211839E-10, 0.157544E-04,-0.304104E-05,-0.624410E-06
     +      , 0.120124E-06,-0.457445E-08,-0.188222E-05,-0.407118E-06
     +      , 0.375106E-06,-0.466881E-07, 0.158312E-08, 0.945037E-07
     +      , 0.564718E-07,-0.319231E-07, 0.371926E-08,-0.123111E-09/
      DATA AKSI,BETA,VE/2.10,1.00,0.001/
#endif
      DATA CORFAC/0.805485E-10/
C.
      DATA THIGH,CHIGH/100.,50./
C.    ------------------------------------------------------------------
C.
      GBRELE=0.

      IF(BCUT.LE.0.) GOTO 99
************************************
      CUTSAV=BCUT
      IF(BCUT.GT.T) BCUT=T
*************************************
      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
      IF(BCUT.GT.TT) EC=TT
C
      X=LOG(TT/EMASS)
      Y=LOG(EC/(E*VE))
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
#if !defined(CERNLIB_BETHE)
      CORR=1./(1.+CORFAC*DENS*Z*E*E/(A*EC*EC))
#endif
#if defined(CERNLIB_BETHE)
      CORR=1.
#endif
      FAC=ZZ*(ZZ+AKSI)*E*E*(EC*CORR/TT)**BETA/(E+EMASS)
      IF(FAC.LE.0.) GOTO 99
C
      GBRELE=FAC*S

      IF(T.GT.THIGH) THEN

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

        GBRELE=GBRELE*S
      ENDIF
******************************************
      BCUT=CUTSAV
******************************************
C
  99  RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.2 1996/09/30 13:30:03 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/02 29/03/94 15.41.21 by S.Giani
	14	*-- Author :
	15	FUNCTION GBRELE(ZZ,T,BCUT)
	16	C.
	17	C. ******************************************************************
	18	C. * *
	19	C. * Calculates energy loss by soft Bremsstrahlung *
	20	C. * (in GeV barn/atom) *
	21	C. * *
	22	C. * ==>Called by : GBRELA *
	23	C. * Author L.Urban ********* *
	24	C. * ( correction for T>100. GeV) *
	25	C. * *
	26	C. ******************************************************************
	27	C.
	28	#include "geant321/gconsp.inc"
	29	#include "geant321/gcmate.inc"
	30	DIMENSION C(100),C1(60),C2(40)
	31	EQUIVALENCE (C(1),C1(1)),(C(61),C2(1))
	32	#if !defined(CERNLIB_BETHE)
	33	DATA C1/-0.960613E-01, 0.631029E-01,-0.142819E-01, 0.150437E-02
	34	+ ,-0.733286E-04, 0.131404E-05, 0.859343E-01,-0.529023E-01
	35	+ , 0.131899E-01,-0.159201E-02, 0.926958E-04,-0.208439E-05
	36	+ ,-0.684096E+01, 0.370364E+01,-0.786752E+00, 0.822670E-01
	37	+ ,-0.424710E-02, 0.867980E-04,-0.200856E+01, 0.129573E+01
	38	+ ,-0.306533E+00, 0.343682E-01,-0.185931E-02, 0.392432E-04
	39	+ , 0.127538E+01,-0.515705E+00, 0.820644E-01,-0.641997E-02
	40	+ , 0.245913E-03,-0.365789E-05, 0.115792E+00,-0.463143E-01
	41	+ , 0.725442E-02,-0.556266E-03, 0.208049E-04,-0.300895E-06
	42	+ ,-0.271082E-01, 0.173949E-01,-0.452531E-02, 0.569405E-03
	43	+ ,-0.344856E-04, 0.803964E-06, 0.419855E-02,-0.277188E-02
	44	+ , 0.737658E-03,-0.939463E-04, 0.569748E-05,-0.131737E-06
	45	+ ,-0.318752E-03, 0.215144E-03,-0.579787E-04, 0.737972E-05
	46	+ ,-0.441485E-06, 0.994726E-08, 0.938233E-05,-0.651642E-05
	47	+ , 0.177303E-05,-0.224680E-06, 0.132080E-07,-0.288593E-09/
	48	DATA C2/-0.245667E-03, 0.833406E-04,-0.129217E-04, 0.915099E-06
	49	+ ,-0.247179E-07, 0.147696E-03,-0.498793E-04, 0.402375E-05
	50	+ , 0.989281E-07,-0.133378E-07,-0.737702E-02, 0.333057E-02
	51	+ ,-0.553141E-03, 0.402464E-04,-0.107977E-05,-0.641533E-02
	52	+ , 0.290113E-02,-0.477641E-03, 0.342008E-04,-0.900582E-06
	53	+ , 0.574303E-05, 0.908521E-04,-0.256900E-04, 0.239921E-05
	54	+ ,-0.741271E-07,-0.341260E-04, 0.971711E-05,-0.172031E-06
	55	+ ,-0.119455E-06, 0.704166E-08, 0.341740E-05,-0.775867E-06
	56	+ ,-0.653231E-07, 0.225605E-07,-0.114860E-08,-0.119391E-06
	57	+ , 0.194885E-07, 0.588959E-08,-0.127589E-08, 0.608247E-10/
	58	DATA AKSI,BETA,VE/2.51,0.99,0.00004/
	59	#endif
	60	#if defined(CERNLIB_BETHE)
	61	DATA C1/ 0.834459E-02, 0.443979E-02,-0.101420E-02, 0.963240E-04
	62	+ ,-0.409769E-05, 0.642589E-07, 0.464473E-02,-0.290378E-02
	63	+ , 0.547457E-03,-0.426949E-04, 0.137760E-05,-0.131050E-07
	64	+ ,-0.547866E-02, 0.156218E-02,-0.167352E-03, 0.101026E-04
65	+ ,-0.427518E-06, 0.949555E-08,-0.406862E-02, 0.208317E-02
66	+ ,-0.374766E-03, 0.317610E-04,-0.130533E-05, 0.211051E-07
67	+ , 0.158941E-02,-0.385362E-03, 0.315564E-04,-0.734968E-06
68	+ ,-0.230387E-07, 0.971174E-09, 0.467219E-03,-0.154047E-03
69	+ , 0.202400E-04,-0.132438E-05, 0.431474E-07,-0.559750E-09
70	+ ,-0.220958E-02, 0.100698E-02,-0.596464E-04,-0.124653E-04
71	+ , 0.142999E-05,-0.394378E-07, 0.477447E-03,-0.184952E-03
72	+ ,-0.152614E-04, 0.848418E-05,-0.736136E-06, 0.190192E-07
73	+ ,-0.552930E-04, 0.209858E-04, 0.290001E-05,-0.133254E-05
74	+ , 0.116971E-06,-0.309716E-08, 0.212117E-05,-0.103884E-05
75	+ ,-0.110912E-06, 0.655143E-07,-0.613013E-08, 0.169207E-09/
76	DATA C2/ 0.301125E-04,-0.461920E-04, 0.871485E-05,-0.622331E-06
77	+ , 0.151800E-07,-0.478023E-04, 0.247530E-04,-0.381763E-05
78	+ , 0.232819E-06,-0.494487E-08,-0.336230E-04, 0.223822E-04
79	+ ,-0.384583E-05, 0.252867E-06,-0.572599E-08, 0.105335E-04
80	+ ,-0.567074E-06,-0.216564E-06, 0.237268E-07,-0.658131E-09
81	+ , 0.282025E-05,-0.671965E-06, 0.565858E-07,-0.193843E-08
82	+ , 0.211839E-10, 0.157544E-04,-0.304104E-05,-0.624410E-06
83	+ , 0.120124E-06,-0.457445E-08,-0.188222E-05,-0.407118E-06
84	+ , 0.375106E-06,-0.466881E-07, 0.158312E-08, 0.945037E-07
85	+ , 0.564718E-07,-0.319231E-07, 0.371926E-08,-0.123111E-09/
86	DATA AKSI,BETA,VE/2.10,1.00,0.001/
87	#endif
88	DATA CORFAC/0.805485E-10/
89	C.
90	DATA THIGH,CHIGH/100.,50./
91	C. ------------------------------------------------------------------
92	C.
93	GBRELE=0.
94
95	IF(BCUT.LE.0.) GOTO 99
96	************************************
97	CUTSAV=BCUT
98	IF(BCUT.GT.T) BCUT=T
99	*************************************
100	IF(T.GT.THIGH) THEN
101	TT=THIGH
102	IF(BCUT.GE.THIGH) THEN
103	EC=CHIGH
104	ELSE
105	EC=BCUT
106	ENDIF
107	ELSE
108	TT=T
109	EC=BCUT
110	ENDIF
111
112	E=TT+EMASS
113	IF(BCUT.GT.TT) EC=TT
114	C
115	X=LOG(TT/EMASS)
116	Y=LOG(EC/(E*VE))
117	C
118	S=0.
119	YY=1.
120	DO 30 I=1,2
121	XX=1.
122	DO 20 J=1,6
123	K=6*I+J-6
124	S=S+C(K)XXYY
125	XX=XX*X
126	20 CONTINUE
127	YY=YY*Y
128	30 CONTINUE
129	DO 50 I=3,6
130	XX=1.
131	DO 40 J=1,6
132	K=6*I+J-6
133	IF(Y.LE.0.) THEN
134	S=S+C(K)XXYY
135	ELSE
136	S=S+C(K+24)XXYY
137	ENDIF
138	XX=XX*X
139	40 CONTINUE
140	YY=YY*Y
141	50 CONTINUE
142	SS=0.
143	YY=1.
144	DO 70 I=1,2
145	XX=1.
146	DO 60 J=1,5
147	K=5*I+J+55
148	SS=SS+C(K)XXYY
149	XX=XX*X
150	60 CONTINUE
151	YY=YY*Y
152	70 CONTINUE
153	DO 90 I=3,5
154	XX=1.
155	DO 80 J=1,5
156	K=5*I+J+55
157	IF(Y.LE.0.) THEN
158	SS=SS+C(K)XXYY
159	ELSE
160	SS=SS+C(K+15)XXYY
161	ENDIF
162	XX=XX*X
163	80 CONTINUE
164	YY=YY*Y
165	90 CONTINUE
166	C
167	S=S+Z*SS
168	IF(S.LE.0.) GOTO 99
169	C
170	#if !defined(CERNLIB_BETHE)
171	CORR=1./(1.+CORFACDENSZEE/(AECEC))
172	#endif
173	#if defined(CERNLIB_BETHE)
174	CORR=1.
175	#endif
176	FAC=ZZ(ZZ+AKSI)EE(ECCORR/TT)*BETA/(E+EMASS)
177	IF(FAC.LE.0.) GOTO 99
178	C
179	GBRELE=FAC*S
180
181	IF(T.GT.THIGH) THEN
182
183	IF(BCUT.LT.THIGH) THEN
184	RAT=BCUT/T
185	S=(1.-0.5RAT+2.RAT*RAT/9.)
186	RAT=BCUT/TT
187	S=S/(1.-0.5RAT+2.RAT*RAT/9.)
188	ELSE
189	RAT=BCUT/T
190	S=BCUT(1.-0.5RAT+2.RATRAT/9.)
191	RAT=EC/TT
192	S=S/(EC(1.-0.5RAT+2.RATRAT/9.))
193	ENDIF
194
195	GBRELE=GBRELE*S
196	ENDIF
197	******************************************
198	BCUT=CUTSAV
199	******************************************
200	C
201	99 RETURN
202	END
203