COSMOS v7.655  COSMOSv7655
(AirShowerMC)
cppTotXs.f
Go to the documentation of this file.
1 ! pp total xsection, pp ela.xs
2  subroutine cpptotxs(p, xs)
3  implicit none
4 #include "Zmass.h"
5  real*8 p ! input. momentum of n. in GeV
6  real*8 xs ! output. total np cross section in mb
7  integer np, i, m
8  real*8 error
9  parameter(np=39, m=5)
10  real*8 px(np), mb(np)
11  real*8 Z, Y1, Y2, B, s, rts, s0, eta1, eta2
12  parameter(z= 35.45, y1=42.53, y2=33.34, b=0.308,
13  * s0=5.38**2, eta1=0.458, eta2=0.545)
14 
15  data ( px(i), i= 1 , np )/
16  1 0.1015 , 0.1370 , 0.1900 , 0.2363 ,
17  2 0.2746 , 0.3147 , 0.3706 , 0.4306 ,
18  3 0.5003 , 0.5892 , 0.7329 , 0.8871 ,
19  4 0.9894 , 1.089 , 1.150 , 1.248 ,
20  5 1.336 , 1.552 , 1.904 , 2.305 ,
21  6 2.752 , 3.331 , 4.376 , 5.908 ,
22  7 7.760 , 10.62 , 15.56 , 21.88 ,
23  8 29.54 , 38.80 , 68.81 , 100.8 ,
24  9 151.8 , 213.4 , 292.1 , 433.8 ,
25  a 671.2 , 1067. , 2082.
26  * /
27  data ( mb(i), i= 1 , np )/
28  1 486.6 , 316.8 , 155.7 , 91.67 ,
29  2 69.23 , 52.00 , 35.88 , 28.12 ,
30  3 24.76 , 23.61 , 23.11 , 24.89 ,
31  4 27.97 , 31.60 , 35.69 , 39.47 ,
32  5 44.59 , 47.77 , 48.02 , 46.77 ,
33  6 44.83 , 43.19 , 42.07 , 40.75 ,
34  7 40.53 , 40.11 , 39.26 , 39.06 ,
35  8 39.06 , 38.65 , 38.65 , 38.65 ,
36  9 38.85 , 39.26 , 39.47 , 40.53 ,
37  a 40.97 , 42.07 , 43.42
38  * /
39 
40  save
41  if(p .gt. 2000.) then
42 ! s =(m+E)^2 - p^2 = m^2 + p^2+m^2+2mE-p^2
43 ! = 2m(m+E)
44  s = (masp + sqrt(p**2+masp**2))*masp*2.
45  rts = sqrt(s)
46  xs =z + b*log(s/s0)**2 + y1*(1./s)**eta1 -y2*(1./s)**eta2
47  elseif( p .gt. 0.4) then
48  call kpolintplogxyfe(px, 1, mb, 1, np, m, 3, p, xs, error)
49  else
50  call cppelaxs(p, xs)
51  endif
52  end
53 !
54  subroutine cppelaxs(p, xs)
55 ! pp elastic cross section in mb
56  implicit none
57  real*8 p ! input. momentum of n in GeV
58  real*8 xs ! output np elastic xs. mb.
59 
60  integer np, m, i
61  parameter(np=38, m=5)
62  real*8 px(np), mb(np)
63  real*8 error
64  real*8 xssave/-1./
65 
66  data ( px(i), i= 1 , np )/
67  1 9.9947e-02, 0.1382 , 0.1875 , 0.2380 ,
68  2 0.2746 , 0.3108 , 0.3452 , 0.3834 ,
69  3 0.4258 , 0.4638 , 0.5349 , 0.6110 ,
70  4 0.7181 , 0.8682 , 0.9637 , 1.132 ,
71  5 1.396 , 1.656 , 1.984 , 2.399 ,
72  6 2.929 , 3.823 , 4.802 , 6.510 ,
73  7 9.982 , 13.79 , 20.35 , 30.91 ,
74  8 45.20 , 68.65 , 102.3 , 145.4 ,
75  9 204.6 , 296.3 , 490.0 , 1067. ,
76  a 1621. , 2055.
77  * /
78  data ( mb(i), i= 1 , np )/
79  1 499.9 , 316.6 , 155.5 , 92.89 ,
80  2 70.49 , 53.77 , 42.57 , 33.88 ,
81  3 28.44 , 25.84 , 23.86 , 23.11 ,
82  4 22.74 , 23.35 , 23.97 , 24.74 ,
83  5 24.09 , 23.21 , 21.77 , 19.58 ,
84  6 16.96 , 14.61 , 12.39 , 10.74 ,
85  7 9.910 , 9.394 , 8.535 , 7.631 ,
86  8 7.311 , 6.967 , 6.817 , 6.851 ,
87  9 6.776 , 6.992 , 7.062 , 7.284 ,
88  a 7.516 , 7.716
89  * /
90 
91  save
92 !
93  if( p .gt. 2000.) then
94 ! assume prop.to total
95  if( xssave .lt. 0.) then
96  call cpptotxs(px(np), xssave)
97  endif
98  call cpptotxs(p, xs)
99  xs = xs * mb(np)/xssave
100  elseif(p .gt. 0.1) then
101  call kpolintplogxyfe(px, 1, mb, 1, np, m, 3, p, xs, error)
102  else
103 ! get value at 0.1
104  xs = mb(1)
105  endif
106  end
107  subroutine cppinelaxs(p, xs)
108  implicit none
109  real(8),intent(in)::p
110  real(8),intent(out)::xs
111 
112  real(8)::txs, exs
113  call cpptotxs(p, txs)
114  call cppelaxs(p, exs)
115  xs =max( txs - exs, 0.d0)
116  end
parameter
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
e
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
cpptotxs
subroutine cpptotxs(p, xs)
Definition: cppTotXs.f:3
kpolintplogxyfe
subroutine kpolintplogxyfe(xa, xstep, ya, ystep, nt, m, logxy, x, y, error)
Definition: kpolintp.f:22
d0
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
cppelaxs
subroutine cppelaxs(p, xs)
Definition: cppTotXs.f:68
a
nodes a
Definition: cstdatmos0.fNew2.h:93
masp
masp
Definition: Zmass.h:5
cppinelaxs
subroutine cppinelaxs(p, xs)
Definition: cppTotXs.f:124