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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:32  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
*-- Author :
      SUBROUTINE GPRELA
C.
C.    ******************************************************************
C.    *                                                                *
C.    *  Initialise energy loss due to direct pair-production  and     *
C.    *  nuclear interactions by muons.                                *
C.    *                                                                *
C     *       A, Direct pair production  <=======                      *
C     *                                                                *
C.    *  The DE/DX expression of MANDO and RONCHI(NUOVO CIMENTO        *
C.    *  9(1952),517) is used which attempts to account for the effect *
C.    *  of atomic electron screening. The screening correction is     *
C.    *  applied above the energy limit defined by C. RICHARD-SERRE    *
C.    *  (CERN 71-18).                                                 *
C.    *                                                                *
C     *       B, Nuclear interactions  <=======                        *
C.    *                                                                *
C.    *  the following expression derived from the Williams-Weizsacker *
C.    *  relation for the virtual photon flux is used :                *
C.    *                                                                *
C.    *      DE/DX = FACTOR * XSEC * E                                 *
C.    *                                                                *
C.    *      where,                                                    *
C.    *      FACTOR  =  2. * N * ALPHA / PI                            *
C.    *      XSEC    =  total photo-nuclear cross-section assumed to   *
C.    *                 be independent of energy. Value of 140 mubarns *
C.    *                 calculated by averaging the results of Hesse   *
C.    *                 et al(Phys. Rev. Lett 25(1970),613).           *
C.    *                                                                *
C.    *    ==>Called by : GPHYSI                                       *
C.    *       Author    G.Patrick  *********                           *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcjloc.inc"
#include "geant321/gcmulo.inc"
#include "geant321/gcmate.inc"
#include "geant321/gcphys.inc"
#include "geant321/gconsp.inc"
#include "geant321/gccuts.inc"
#include "geant321/gctrak.inc"
      DATA XSEC  /140.E-30/
      DATA FACTOR/2.7976238E+21/
C.
C.    ------------------------------------------------------------------
C.
      IF(Z.LT.1.) GOTO 999
      ICHAN=IEKBIN
      T    = ELOW(ICHAN)
      T1   = 10.**(EKBIN(1)+(ICHAN-0.5)/GEKA)
      IF(T.LT.1.)GO TO 999
      E    = T+EMMU
      E1   = T1+EMMU
      IF(JMIXT.EQ.0)THEN
C
C           Element
C
         DEDX = GPRELM(Z,T,PPCUTM)
         DEDX = AVO*DENS*DEDX/A
*
* *** auxiliary integration point for Range tables
         IF(ICHAN.NE.NEK1) THEN
            DEDX1 = GPRELM(Z,T1,PPCUTM)
            DEDX1 = AVO*DENS*DEDX1/A
         ENDIF
      ELSE
C
C          Compound/Mixture
C
         NLMAT = Q(JMA+11)
         NLM   = IABS(NLMAT)
         DEDX  = 0.
         DEDX1 = 0.
         DO 10 L=1,NLM
            J    = JMIXT+NLM+L
            AA   = Q(J-NLM)
            ZZ   = Q(J)
            WMAT = Q(J+NLM)
            S    = GPRELM(ZZ,T,PPCUTM)
            S    = WMAT*S/AA
            DEDX = DEDX+AVO*DENS*S
*
* *** auxiliary integration point for Range tables
            IF(ICHAN.NE.NEK1) THEN
               S = GPRELM(ZZ,T1,PPCUTM)
               S = WMAT*S/AA
               DEDX1 = DEDX1+AVO*DENS*S
            ENDIF
   10    CONTINUE
      ENDIF
C
C             Nuclear interactions
C
      IF(IMUNU.EQ.0.AND.E.GE.10.) THEN
         DENU=DENS*FACTOR*XSEC*E
*
* *** auxiliary integration point for Range tables
         IF(ICHAN.NE.NEK1) THEN
            DENU1=DENS*FACTOR*XSEC*E1
         ENDIF
      ELSE
         DENU=0.0
         DENU1=0.0
      ENDIF
      IF(DEDX.LT.0.)DEDX=0.
      IF(DENU.LT.0.)DENU=0.
      JEL2=LQ(JMA-2)
      Q(JEL2+ICHAN)=Q(JEL2+ICHAN)+DEDX+DENU
*
* *** auxiliary integration point for Range tables
      IF(ICHAN.NE.NEK1) THEN
         IF(DEDX1.LT.0.)DEDX1=0.
         IF(DENU1.LT.0.)DENU1=0.
         WS(NEKBIN*2+ICHAN)=WS(NEKBIN*2+ICHAN)+DEDX1+DENU1
      ENDIF
C
  999 END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:21:32 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 GPRELA
	13	C.
	14	C. ******************************************************************
	15	C. * *
	16	C. * Initialise energy loss due to direct pair-production and *
	17	C. * nuclear interactions by muons. *
	18	C. * *
	19	C * A, Direct pair production <======= *
	20	C * *
	21	C. * The DE/DX expression of MANDO and RONCHI(NUOVO CIMENTO *
	22	C. * 9(1952),517) is used which attempts to account for the effect *
	23	C. * of atomic electron screening. The screening correction is *
	24	C. * applied above the energy limit defined by C. RICHARD-SERRE *
	25	C. * (CERN 71-18). *
	26	C. * *
	27	C * B, Nuclear interactions <======= *
	28	C. * *
	29	C. * the following expression derived from the Williams-Weizsacker *
	30	C. * relation for the virtual photon flux is used : *
	31	C. * *
	32	C. * DE/DX = FACTOR * XSEC * E *
	33	C. * *
	34	C. * where, *
	35	C. * FACTOR = 2. * N * ALPHA / PI *
	36	C. * XSEC = total photo-nuclear cross-section assumed to *
	37	C. * be independent of energy. Value of 140 mubarns *
	38	C. * calculated by averaging the results of Hesse *
	39	C. * et al(Phys. Rev. Lett 25(1970),613). *
	40	C. * *
	41	C. * ==>Called by : GPHYSI *
	42	C. * Author G.Patrick ********* *
	43	C. * *
	44	C. ******************************************************************
	45	C.
	46	#include "geant321/gcbank.inc"
	47	#include "geant321/gcjloc.inc"
	48	#include "geant321/gcmulo.inc"
	49	#include "geant321/gcmate.inc"
	50	#include "geant321/gcphys.inc"
	51	#include "geant321/gconsp.inc"
	52	#include "geant321/gccuts.inc"
	53	#include "geant321/gctrak.inc"
	54	DATA XSEC /140.E-30/
	55	DATA FACTOR/2.7976238E+21/
	56	C.
	57	C. ------------------------------------------------------------------
	58	C.
	59	IF(Z.LT.1.) GOTO 999
	60	ICHAN=IEKBIN
	61	T = ELOW(ICHAN)
	62	T1 = 10.**(EKBIN(1)+(ICHAN-0.5)/GEKA)
	63	IF(T.LT.1.)GO TO 999
	64	E = T+EMMU
65	E1 = T1+EMMU
66	IF(JMIXT.EQ.0)THEN
67	C
68	C Element
69	C
70	DEDX = GPRELM(Z,T,PPCUTM)
71	DEDX = AVODENSDEDX/A
72	*
73	* *** auxiliary integration point for Range tables
74	IF(ICHAN.NE.NEK1) THEN
75	DEDX1 = GPRELM(Z,T1,PPCUTM)
76	DEDX1 = AVODENSDEDX1/A
77	ENDIF
78	ELSE
79	C
80	C Compound/Mixture
81	C
82	NLMAT = Q(JMA+11)
83	NLM = IABS(NLMAT)
84	DEDX = 0.
85	DEDX1 = 0.
86	DO 10 L=1,NLM
87	J = JMIXT+NLM+L
88	AA = Q(J-NLM)
89	ZZ = Q(J)
90	WMAT = Q(J+NLM)
91	S = GPRELM(ZZ,T,PPCUTM)
92	S = WMAT*S/AA
93	DEDX = DEDX+AVODENSS
94	*
95	* *** auxiliary integration point for Range tables
96	IF(ICHAN.NE.NEK1) THEN
97	S = GPRELM(ZZ,T1,PPCUTM)
98	S = WMAT*S/AA
99	DEDX1 = DEDX1+AVODENSS
100	ENDIF
101	10 CONTINUE
102	ENDIF
103	C
104	C Nuclear interactions
105	C
106	IF(IMUNU.EQ.0.AND.E.GE.10.) THEN
107	DENU=DENSFACTORXSEC*E
108	*
109	* *** auxiliary integration point for Range tables
110	IF(ICHAN.NE.NEK1) THEN
111	DENU1=DENSFACTORXSEC*E1
112	ENDIF
113	ELSE
114	DENU=0.0
115	DENU1=0.0
116	ENDIF
117	IF(DEDX.LT.0.)DEDX=0.
118	IF(DENU.LT.0.)DENU=0.
119	JEL2=LQ(JMA-2)
120	Q(JEL2+ICHAN)=Q(JEL2+ICHAN)+DEDX+DENU
121	*
122	* *** auxiliary integration point for Range tables
123	IF(ICHAN.NE.NEK1) THEN
124	IF(DEDX1.LT.0.)DEDX1=0.
125	IF(DENU1.LT.0.)DENU1=0.
126	WS(NEKBIN2+ICHAN)=WS(NEKBIN2+ICHAN)+DEDX1+DENU1
127	ENDIF
128	C
129	999 END