[u/mrichter/AliRoot.git] / GEANT321 / fluka / shptot.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:04  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.45  by  S.Giani
*-- Author :
*$ CREATE SHPTOT.FOR
*COPY SHPTOT
*
*=== shptot ===========================================================*
*
      FUNCTION SHPTOT(IT,PO)
 
#include "geant321/dblprc.inc"
#include "geant321/dimpar.inc"
#include "geant321/iounit.inc"
C********************************************************************
C   LAST CHANGE 25.11 -86 BY PERTTI AARNIO
C
C
C   TOTAL HADRON-PROTON CROSS SECTIONS
C   PLAB.GE.10 GEV
C
C********************************************************************
#include "geant321/paprop.inc"
      REAL RNDM(1)
C
      F1=1.D0
      ITT=IT
      AMIT2=AM(ITT)**2
      UMO2=AMIT2 + AM(1)**2 + 2.D0*AM(1)*(PO+0.5D0*AMIT2/PO)
      UMO=SQRT(UMO2)
C
      A4=0.D0
      A5=0.D0
      A6=0.D0
C
      GO TO
     * (1,1,50,50,50,50,50,2,2,50,50,5,3,3,4,4,8,8,5,8,8,8,50,6,7,
     *  1,1,1,1,1,1,1,1,1,1,1,1,1,1), ITT
C
 1    CONTINUE
      A1=38.4D0
      A2=0.46D0
      A3=125.D0
      IF(ITT.EQ.1) GOTO 100
      A5=84.1D0
      A6=0.43D0
      GOTO 100
C
 2    CONTINUE
      A1=38.5D0
      A2=0.46D0
      A3=125.D0
      A4=15.D0
      IF(ITT.EQ.8) GOTO 100
      A5=77.43D0
      A6=0.40D0
      GOTO 100
C
 3    CONTINUE
      IF(UMO.LT.47.D0) GOTO 31
      F1=0.6667D0
      ITT=1
      GOTO 1
 31   CONTINUE
      A1=24.D0
      A2=0.60D0
      A3=160.D0
*   Very very crude patch for the pion- elastic xsec problem
*     IF(ITT.EQ.13) GOTO 100
      IF(ITT.EQ.13.OR.ITT.EQ.14) GOTO 100
      A5=7.9D0
      A6=0.54D0
      GOTO 100
C
 4    CONTINUE
      IF(UMO.LT.110.D0) GOTO 41
      F1=0.6667D0
      ITT=1
      GOTO 1
 41   CONTINUE
      A1=20.3D0
      A2=0.59D0
      A3=140.D0
      IF(ITT.EQ.15) GOTO 100
      A5=30.13D0
      A6=0.42D0
      GOTO 100
C
 5    CONTINUE
      ITT=15
      CALL GRNDM(RNDM,1)
      IF(RNDM(1).LT.0.5D0) ITT=16
      GOTO 4
C
 6    CONTINUE
C***
C   K-ZERO:  SET EQUAL TO K-/PROTON
C            (SHOULD BE K-/NEUTRON)
C***
      ITT=16
      GOTO 4
C
 7    CONTINUE
C***
C   K-ZERO BAR:  SET EQUAL TO K+/PROTON
C                (SHOULD BE K+/NEUTRON)
C***
      ITT=15
      GOTO 4
C
 8    CONTINUE
C***
C   SIGMA +/-/0  AND  LAMBDA/LAMBDA BAR:  SET EQUAL TO P-P
C***
      ITT=1
      GOTO 1
C
 50   CONTINUE
C***
C   LEPTONS AND PI0
C***
      SHPTOT=1.D-10
      RETURN
C
 100  CONTINUE
C
      SHPTOT=A1+A2*(LOG(UMO2/A3))**2+A4/UMO2+A5*UMO2**A6
      SHPTOT=F1*SHPTOT
      RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:20:04 cernlib
	6	* Geant
	7	*
	8	*
	9	#include "geant321/pilot.h"
	10	*CMZ : 3.21/02 29/03/94 15.41.45 by S.Giani
	11	*-- Author :
	12	*$ CREATE SHPTOT.FOR
	13	*COPY SHPTOT
	14	*
	15	=== shptot ===========================================================
	16	*
	17	FUNCTION SHPTOT(IT,PO)
	18
	19	#include "geant321/dblprc.inc"
	20	#include "geant321/dimpar.inc"
	21	#include "geant321/iounit.inc"
	22	C********************************************************************
	23	C LAST CHANGE 25.11 -86 BY PERTTI AARNIO
	24	C
	25	C
	26	C TOTAL HADRON-PROTON CROSS SECTIONS
	27	C PLAB.GE.10 GEV
	28	C
	29	C********************************************************************
	30	#include "geant321/paprop.inc"
	31	REAL RNDM(1)
	32	C
	33	F1=1.D0
	34	ITT=IT
	35	AMIT2=AM(ITT)**2
	36	UMO2=AMIT2 + AM(1)*2 + 2.D0AM(1)(PO+0.5D0AMIT2/PO)
	37	UMO=SQRT(UMO2)
	38	C
	39	A4=0.D0
	40	A5=0.D0
	41	A6=0.D0
	42	C
	43	GO TO
	44	* (1,1,50,50,50,50,50,2,2,50,50,5,3,3,4,4,8,8,5,8,8,8,50,6,7,
	45	* 1,1,1,1,1,1,1,1,1,1,1,1,1,1), ITT
	46	C
	47	1 CONTINUE
	48	A1=38.4D0
	49	A2=0.46D0
	50	A3=125.D0
	51	IF(ITT.EQ.1) GOTO 100
	52	A5=84.1D0
	53	A6=0.43D0
	54	GOTO 100
	55	C
	56	2 CONTINUE
	57	A1=38.5D0
	58	A2=0.46D0
	59	A3=125.D0
	60	A4=15.D0
	61	IF(ITT.EQ.8) GOTO 100
	62	A5=77.43D0
	63	A6=0.40D0
	64	GOTO 100
65	C
66	3 CONTINUE
67	IF(UMO.LT.47.D0) GOTO 31
68	F1=0.6667D0
69	ITT=1
70	GOTO 1
71	31 CONTINUE
72	A1=24.D0
73	A2=0.60D0
74	A3=160.D0
75	* Very very crude patch for the pion- elastic xsec problem
76	* IF(ITT.EQ.13) GOTO 100
77	IF(ITT.EQ.13.OR.ITT.EQ.14) GOTO 100
78	A5=7.9D0
79	A6=0.54D0
80	GOTO 100
81	C
82	4 CONTINUE
83	IF(UMO.LT.110.D0) GOTO 41
84	F1=0.6667D0
85	ITT=1
86	GOTO 1
87	41 CONTINUE
88	A1=20.3D0
89	A2=0.59D0
90	A3=140.D0
91	IF(ITT.EQ.15) GOTO 100
92	A5=30.13D0
93	A6=0.42D0
94	GOTO 100
95	C
96	5 CONTINUE
97	ITT=15
98	CALL GRNDM(RNDM,1)
99	IF(RNDM(1).LT.0.5D0) ITT=16
100	GOTO 4
101	C
102	6 CONTINUE
103	C***
104	C K-ZERO: SET EQUAL TO K-/PROTON
105	C (SHOULD BE K-/NEUTRON)
106	C***
107	ITT=16
108	GOTO 4
109	C
110	7 CONTINUE
111	C***
112	C K-ZERO BAR: SET EQUAL TO K+/PROTON
113	C (SHOULD BE K+/NEUTRON)
114	C***
115	ITT=15
116	GOTO 4
117	C
118	8 CONTINUE
119	C***
120	C SIGMA +/-/0 AND LAMBDA/LAMBDA BAR: SET EQUAL TO P-P
121	C***
122	ITT=1
123	GOTO 1
124	C
125	50 CONTINUE
126	C***
127	C LEPTONS AND PI0
128	C***
129	SHPTOT=1.D-10
130	RETURN
131	C
132	100 CONTINUE
133	C
134	SHPTOT=A1+A2(LOG(UMO2/A3))2+A4/UMO2+A5UMO2**A6
135	SHPTOT=F1*SHPTOT
136	RETURN
137	END