+++ /dev/null
-*
-* $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
-