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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:33  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
*-- Author :
      FUNCTION GPRSGM(Z,T,CCUT)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       To calculate cross-section in barn/atom for direct       *
C.    *       pair production by muons.                                *
C.    *                                                                *
C.    *    ==>Called by : GPRSGA                                       *
C.    *       Author    L.Urban  *********                             *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gconsp.inc"
C
      PARAMETER (AKSI=1.16,ALFA=3.46,GAM=0.06,VS=0.019)
      PARAMETER (ECMIN=2.044E-3,CONMX=0.130653)
C        CONMX=0.75*SQRT(2.7182...)*EMMU
C
      DIMENSION C(100),C1(60),C2(40)
      EQUIVALENCE (C(1),C1(1)),(C(61),C2(1))
      DATA C1/0.230181E-08,-0.280842E-08, 0.137525E-08,-0.156503E-09
     +      , 0.728088E-11,-0.122631E-12, 0.133014E-08,-0.160591E-09
     +      ,-0.390814E-09, 0.314492E-10, 0.251296E-12,-0.574223E-13
     +      , 0.604923E-09,-0.560766E-09, 0.660253E-09,-0.103474E-09
     +      , 0.621338E-11,-0.135273E-12, 0.103739E-09, 0.710290E-09
     +      ,-0.544755E-10,-0.211241E-11, 0.286443E-12,-0.644602E-14
     +      , 0.332492E-09,-0.484785E-10, 0.126921E-10,-0.165217E-11
     +      , 0.845273E-13,-0.143180E-14,-0.112267E-13, 0.113308E-11
     +      , 0.292577E-12,-0.733441E-13, 0.475747E-14,-0.976279E-16
     +      ,-0.112856E-07, 0.936398E-08,-0.291882E-08, 0.422266E-09
     +      ,-0.279042E-10, 0.678485E-12, 0.112383E-07,-0.964400E-08
     +      , 0.313121E-08,-0.440224E-09, 0.278668E-10,-0.643012E-12
     +      ,-0.414131E-08, 0.355112E-08,-0.115035E-08, 0.158539E-09
     +      ,-0.976788E-11, 0.216911E-12, 0.521380E-09,-0.442265E-09
     +      , 0.141753E-09,-0.190826E-10, 0.114038E-11,-0.242085E-13/
      DATA C2/0.572943E-10,-0.296824E-10, 0.630217E-11,-0.623179E-12
     +      , 0.211467E-13,-0.143579E-10,-0.137247E-11, 0.118670E-11
     +      ,-0.793091E-13, 0.124745E-14,-0.269884E-10, 0.125314E-10
     +      ,-0.239259E-11, 0.181151E-12,-0.470277E-14,-0.342454E-11
     +      , 0.976666E-12,-0.236792E-12, 0.213290E-13,-0.607799E-15
     +      ,-0.748844E-12, 0.178214E-12,-0.226827E-13, 0.148441E-14
     +      ,-0.367972E-16, 0.840330E-12, 0.820025E-11,-0.294797E-11
     +      , 0.294669E-12,-0.970294E-14,-0.830636E-12,-0.309273E-11
     +      , 0.124169E-11,-0.135879E-12, 0.481683E-14, 0.438223E-12
     +      , 0.259162E-12,-0.149284E-12, 0.180170E-13,-0.677948E-15/
C.
C.    ------------------------------------------------------------------
C.
      GPRSGM=0.
      CUT=CCUT
      IF(CUT.LT.ECMIN) CUT=ECMIN
C
      E=T+EMMU
      ECMAX=E-CONMX*Z**0.333333
      IF(CUT.GE.ECMAX) GOTO 99
C
      X=LOG(E/EMMU)
      Y=LOG(CUT/(VS*E))
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
C     DE/DX SHOULD BE MONOTON INCREASING AS A
C     FUNCTION OF THE CUT
C     SOLUTION: LIN. INTERPOLATION FOR 0.2*ECMAX<CUT<ECMAX
C
      FAC=2.*(LOG(ECMAX/CUT))**ALFA
      FAC=Z*(Z+AKSI*(1.+GAM*LOG(Z)))*FAC
      GPRSGM=FAC*S
C
  99  RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:21:33 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	FUNCTION GPRSGM(Z,T,CCUT)
	13	C.
	14	C. ******************************************************************
	15	C. * *
	16	C. * To calculate cross-section in barn/atom for direct *
	17	C. * pair production by muons. *
	18	C. * *
	19	C. * ==>Called by : GPRSGA *
	20	C. * Author L.Urban ********* *
	21	C. * *
	22	C. ******************************************************************
	23	C.
	24	#include "geant321/gconsp.inc"
	25	C
	26	PARAMETER (AKSI=1.16,ALFA=3.46,GAM=0.06,VS=0.019)
	27	PARAMETER (ECMIN=2.044E-3,CONMX=0.130653)
	28	C CONMX=0.75SQRT(2.7182...)EMMU
	29	C
	30	DIMENSION C(100),C1(60),C2(40)
	31	EQUIVALENCE (C(1),C1(1)),(C(61),C2(1))
	32	DATA C1/0.230181E-08,-0.280842E-08, 0.137525E-08,-0.156503E-09
	33	+ , 0.728088E-11,-0.122631E-12, 0.133014E-08,-0.160591E-09
	34	+ ,-0.390814E-09, 0.314492E-10, 0.251296E-12,-0.574223E-13
	35	+ , 0.604923E-09,-0.560766E-09, 0.660253E-09,-0.103474E-09
	36	+ , 0.621338E-11,-0.135273E-12, 0.103739E-09, 0.710290E-09
	37	+ ,-0.544755E-10,-0.211241E-11, 0.286443E-12,-0.644602E-14
	38	+ , 0.332492E-09,-0.484785E-10, 0.126921E-10,-0.165217E-11
	39	+ , 0.845273E-13,-0.143180E-14,-0.112267E-13, 0.113308E-11
	40	+ , 0.292577E-12,-0.733441E-13, 0.475747E-14,-0.976279E-16
	41	+ ,-0.112856E-07, 0.936398E-08,-0.291882E-08, 0.422266E-09
	42	+ ,-0.279042E-10, 0.678485E-12, 0.112383E-07,-0.964400E-08
	43	+ , 0.313121E-08,-0.440224E-09, 0.278668E-10,-0.643012E-12
	44	+ ,-0.414131E-08, 0.355112E-08,-0.115035E-08, 0.158539E-09
	45	+ ,-0.976788E-11, 0.216911E-12, 0.521380E-09,-0.442265E-09
	46	+ , 0.141753E-09,-0.190826E-10, 0.114038E-11,-0.242085E-13/
	47	DATA C2/0.572943E-10,-0.296824E-10, 0.630217E-11,-0.623179E-12
	48	+ , 0.211467E-13,-0.143579E-10,-0.137247E-11, 0.118670E-11
	49	+ ,-0.793091E-13, 0.124745E-14,-0.269884E-10, 0.125314E-10
	50	+ ,-0.239259E-11, 0.181151E-12,-0.470277E-14,-0.342454E-11
	51	+ , 0.976666E-12,-0.236792E-12, 0.213290E-13,-0.607799E-15
	52	+ ,-0.748844E-12, 0.178214E-12,-0.226827E-13, 0.148441E-14
	53	+ ,-0.367972E-16, 0.840330E-12, 0.820025E-11,-0.294797E-11
	54	+ , 0.294669E-12,-0.970294E-14,-0.830636E-12,-0.309273E-11
	55	+ , 0.124169E-11,-0.135879E-12, 0.481683E-14, 0.438223E-12
	56	+ , 0.259162E-12,-0.149284E-12, 0.180170E-13,-0.677948E-15/
	57	C.
	58	C. ------------------------------------------------------------------
	59	C.
	60	GPRSGM=0.
	61	CUT=CCUT
	62	IF(CUT.LT.ECMIN) CUT=ECMIN
	63	C
	64	E=T+EMMU
65	ECMAX=E-CONMXZ*0.333333
66	IF(CUT.GE.ECMAX) GOTO 99
67	C
68	X=LOG(E/EMMU)
69	Y=LOG(CUT/(VS*E))
70	C
71	S=0.
72	YY=1.
73	DO 30 I=1,2
74	XX=1.
75	DO 20 J=1,6
76	K=6*I+J-6
77	S=S+C(K)XXYY
78	XX=XX*X
79	20 CONTINUE
80	YY=YY*Y
81	30 CONTINUE
82	DO 50 I=3,6
83	XX=1.
84	DO 40 J=1,6
85	K=6*I+J-6
86	IF(Y.LE.0.) THEN
87	S=S+C(K)XXYY
88	ELSE
89	S=S+C(K+24)XXYY
90	ENDIF
91	XX=XX*X
92	40 CONTINUE
93	YY=YY*Y
94	50 CONTINUE
95	SS=0.
96	YY=1.
97	DO 70 I=1,2
98	XX=1.
99	DO 60 J=1,5
100	K=5*I+J+55
101	SS=SS+C(K)XXYY
102	XX=XX*X
103	60 CONTINUE
104	YY=YY*Y
105	70 CONTINUE
106	DO 90 I=3,5
107	XX=1.
108	DO 80 J=1,5
109	K=5*I+J+55
110	IF(Y.LE.0.) THEN
111	SS=SS+C(K)XXYY
112	ELSE
113	SS=SS+C(K+15)XXYY
114	ENDIF
115	XX=XX*X
116	80 CONTINUE
117	YY=YY*Y
118	90 CONTINUE
119	C
120	S=S+Z*SS
121	IF(S.LE.0.) GOTO 99
122	C
123	C DE/DX SHOULD BE MONOTON INCREASING AS A
124	C FUNCTION OF THE CUT
125	C SOLUTION: LIN. INTERPOLATION FOR 0.2*ECMAX<CUT<ECMAX
126	C
127	FAC=2.(LOG(ECMAX/CUT))*ALFA
128	FAC=Z(Z+AKSI(1.+GAMLOG(Z)))FAC
129	GPRSGM=FAC*S
130	C
131	99 RETURN
132	END