This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / fluka / shptot.F
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.D0*AM(1)*(PO+0.5D0*AMIT2/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+A5*UMO2**A6
135       SHPTOT=F1*SHPTOT
136       RETURN
137       END