COSMOS v7.655  COSMOSv7655
(AirShowerMC)
cgpxs1.f
Go to the documentation of this file.
1 ! gp xsection
2  subroutine cgpxs1(Eg, xs)
3  implicit none
4 #include "Zmass.h"
5  real*8 Eg ! input. momentum /Energy of gamma in GeV
6  real*8 xs ! output. total np cross section in mb
7  integer np, i, m
8  real*8 error, s, rts
9 
10  real*8 delta, s0, Z, Y1, eta1, B
11  parameter( delta = 0.00308, s0=5.38**2, z = delta*35.45,
12  * y1 =0.0317, eta1 = 0.458, b = delta*0.308)
13 
14  parameter(np=66, m=5)
15  real*8 roots(np), mb(np)
16  data ( roots(i), i= 1 , np )/
17  1 1.0705 , 1.1016 , 1.1256 ,
18  2 1.1501 , 1.1625 , 1.1878 , 1.2049 ,
19  3 1.2179 , 1.2355 , 1.2534 , 1.2715 ,
20  4 1.2898 , 1.3179 , 1.3274 , 1.3369 ,
21  5 1.3660 , 1.3758 , 1.4158 , 1.4570 ,
22  6 1.4887 , 1.5431 , 1.5823 , 1.6167 ,
23  7 1.6518 , 1.6877 , 1.7121 , 1.7306 ,
24  8 1.7556 , 1.7873 , 1.8460 , 1.9133 ,
25  9 1.9761 , 2.0046 , 2.0778 , 2.1769 ,
26  a 2.2563 , 2.3981 , 2.5672 , 2.7187 ,
27  b 2.9208 , 3.1718 , 3.4692 , 3.7809 ,
28  c 4.1801 , 4.6049 , 5.1094 , 5.8132 ,
29  d 6.6377 , 7.6611 , 8.7165 , 9.7759 ,
30  e 11.243 , 13.070 , 15.468 , 17.917 ,
31  f 20.239 , 23.360 , 26.865 , 32.956 ,
32  g 39.995 , 52.520 , 68.968 , 93.871 ,
33  h 116.40 , 151.76 , 199.28
34  * /
35  data ( mb(i), i= 1 , np )/
36  1 0.34130e-01, 0.79199e-01, 0.11944 ,
37  2 0.25327 , 0.33197 , 0.45290 , 0.52636 ,
38  3 0.56460 , 0.51589 , 0.43072 , 0.32208 ,
39  4 0.25321 , 0.20721 , 0.18008 , 0.16455 ,
40  5 0.18372 , 0.20513 , 0.22674 , 0.25316 ,
41  6 0.27704 , 0.25313 , 0.22670 , 0.21133 ,
42  7 0.22442 , 0.23831 , 0.21130 , 0.19308 ,
43  8 0.17642 , 0.16282 , 0.15958 , 0.16280 ,
44  9 0.16117 , 0.15483 , 0.14725 , 0.14288 ,
45  a 0.14003 , 0.13451 , 0.13316 , 0.13050 ,
46  b 0.12789 , 0.12533 , 0.12657 , 0.12529 ,
47  c 0.12278 , 0.12154 , 0.12030 , 0.11907 ,
48  d 0.11904 , 0.11901 , 0.11779 , 0.11777 ,
49  e 0.11774 , 0.11537 , 0.11418 , 0.11530 ,
50  f 0.11879 , 0.12116 , 0.12235 , 0.12478 ,
51  g 0.12726 , 0.13108 , 0.13501 , 0.14186 ,
52  h 0.14468 , 0.15357 , 0.15977
53  * /
54 
55  save
56 ! s = (E+Mp)^2-E^2 = 2EMp+Mp^2
57  s = (2*eg+masp)*masp
58  rts = sqrt(s)
59 !//////
60 ! write(*,*) Eg, s, rts
61 !/////////
62  if( rts .lt. 1.08) then
63  xs = 0.
64  elseif(rts .lt. 15.) then
65  call
66  * kpolintplogxyfe(roots, 1, mb, 1, np, m, 3, rts, xs, error)
67  else
68  xs = z + b*log(s/s0)**2 + y1*(1./s)**eta1
69  endif
70  end
71 !c These are x-sections near threshold.
72 ! implicit none
73 ! real*8 e, eg, xs
74 !
75 !c to test cgppi0, cgppip, cgppi2, cgppi3
76 ! do e=2.2, 3.7, .02
77 ! eg = 10.**e/1000.
78 ! call cgppi0(e, xs)
79 ! write(*, *) eg, xs
80 ! enddo
81 ! write(*, *)
82 ! do e=2.2, 3.7, .02
83 ! eg = 10.**e/1000.
84 ! call cgppip(e, xs)
85 ! write(*, *) eg, xs
86 ! enddo
87 ! write(*, *)
88 ! do e=2.2, 3.7, .02
89 ! eg = 10.**e/1000.
90 ! call cgppi2(e, xs)
91 ! write(*, *) eg, xs
92 ! enddo
93 ! write(*, *)
94 ! do e=2.2, 3.7, .02
95 ! eg = 10.**e/1000.
96 ! call cgppi3(e, xs)
97 ! write(*, *) eg, xs
98 ! enddo
99 ! end
100  subroutine cgppi0(egl10, xs)
101 ! egl10: input. log10(Eg/MeV)
102 ! xs: output. xsection in micro-barn for gp-->p+pi0
103  implicit none
104  real*8 xs, egl10
105  integer i
106  real*8 xs1(107), xs2(100), xs3(109), xs4(92)
107 ! log10(Eg/MeV) range step 0.01
108  real*8 e11/2.2328224/, e12/3.2981243/, eps/1./
109  real*8 e21/2.3053560/, e22/3.2981243/
110  real*8 e31/2.6146288/, e32/3.7040262/
111  real*8 e41/2.8246450/
112 
113 !
114 ! gp-->ppi0
115  data ( xs1(i),i= 1, 72)/
116  1 0.0, 2.4, 5.8, 8.9, 11.6, 12.8, 13.6, 14.4,
117  2 17.2, 20.9, 25.3, 30.3, 35.9, 42.4, 48.5, 53.4,
118  3 60.9, 71.8, 85.8, 120.9, 150.4, 204.4, 224.5, 241.6,
119  4 251.3, 252.4, 248.9, 233.7, 210.9, 196.1, 186.7, 170.5,
120  5 155.6, 145.1, 140.3, 134.9, 124.5, 111.0, 100.6, 91.3,
121  6 86.8, 77.9, 66.8, 55.4, 46.5, 41.0, 40.0, 39.5,
122  7 40.0, 40.4, 40.8, 41.2, 41.6, 42.0, 42.8, 41.7,
123  8 40.3, 38.8, 37.3, 35.5, 34.2, 33.5, 32.7, 32.8,
124  9 32.4, 32.0, 31.6, 31.2, 30.6, 30.0, 29.7, 28.9/
125  data ( xs1(i),i= 73, 107)/
126  1 27.9, 26.7, 25.3, 23.4, 21.8, 20.3, 18.8, 16.8,
127  2 15.4, 14.2, 13.2, 12.3, 11.9, 11.2, 10.5, 9.8,
128  3 9.0, 8.0, 7.3, 6.8, 6.2, 5.7, 5.3, 4.8,
129  4 4.8, 4.7, 4.7, 4.7, 4.5, 4.1, 4.0, 2.5,
130  5 1.2, 0.7, 0.7/
131 !
132 
133 ! gp-->npi+
134  data ( xs2(i),i= 1, 72)/
135  1 0.0, 59.9, 82.4, 105.5, 127.1, 147.2, 160.8, 166.5,
136  2 175.5, 185.1, 191.6, 194.8, 197.7, 200.1, 201.8, 203.0,
137  3 203.2, 203.4, 202.3, 198.6, 195.0, 193.8, 190.1, 159.7,
138  4 152.0, 143.0, 130.8, 119.4, 109.8, 101.7, 92.2, 81.5,
139  5 73.8, 67.7, 64.9, 61.5, 58.4, 56.5, 56.5, 59.2,
140  6 62.0, 64.1, 68.6, 76.9, 84.7, 90.1, 93.4, 96.1,
141  7 97.6, 98.0, 97.3, 97.0, 96.0, 94.7, 93.0, 91.0,
142  8 88.8, 86.4, 83.6, 80.6, 78.0, 74.3, 69.7, 63.7,
143  9 58.1, 52.8, 47.4, 43.3, 41.2, 38.2, 35.0, 31.2/
144  data ( xs2(i),i= 73, 100)/
145  1 28.3, 25.7, 23.6, 22.1, 20.5, 19.1, 18.5, 17.3,
146  2 16.0, 14.6, 12.8, 11.6, 10.6, 9.8, 9.2, 8.7,
147  3 8.7, 8.7, 8.6, 8.6, 8.2, 7.5, 6.9, 6.2,
148  4 5.7, 4.6, 3.2, 1.3/
149 !
150 ! gp-->ppi+pi-
151  data ( xs3(i),i= 1, 72)/
152  1 0.0, 0.7, 3.0, 5.7, 8.9, 12.9, 16.6, 21.1,
153  2 23.0, 30.9, 44.3, 50.9, 57.5, 63.4, 67.4, 69.9,
154  3 70.7, 71.3, 72.6, 72.4, 72.4, 71.6, 70.3, 68.5,
155  4 67.4, 66.4, 65.3, 64.3, 63.3, 62.3, 61.2, 60.2,
156  5 59.1, 58.0, 56.9, 55.8, 54.8, 53.8, 52.9, 51.9,
157  6 51.0, 50.0, 49.4, 48.4, 47.4, 46.4, 45.4, 44.3,
158  7 43.2, 42.2, 40.7, 39.6, 38.5, 37.5, 36.4, 35.4,
159  8 34.4, 33.4, 32.4, 31.4, 30.4, 29.4, 28.5, 27.6,
160  9 26.7, 25.8, 24.9, 24.0, 22.3, 21.5, 20.7, 20.1/
161  data ( xs3(i),i= 73, 109)/
162  1 19.5, 19.1, 19.2, 19.3, 19.4, 19.9, 19.6, 19.7,
163  2 19.8, 20.0, 19.8, 19.7, 19.1, 18.8, 18.5, 18.3,
164  3 18.0, 17.8, 17.6, 17.1, 16.9, 16.8, 16.7, 16.9,
165  4 17.1, 17.4, 17.8, 18.2, 18.8, 19.4, 20.4, 21.1,
166  5 21.8, 22.4, 23.0, 23.5, 23.9/
167 !
168 
169 ! e42/3.7369471/
170 ! gp-->ppi+pi- x (x=pi+,pi-,,,)
171  data ( xs4(i),i= 1, 72)/
172  1 0.0, 2.6, 5.6, 8.7, 11.8, 14.9, 18.1, 21.2,
173  2 24.4, 28.2, 31.1, 34.0, 36.7, 39.2, 41.6, 43.9,
174  3 45.9, 48.0, 50.1, 52.0, 53.9, 55.6, 57.3, 58.4,
175  4 60.0, 61.6, 63.2, 64.7, 66.2, 67.6, 68.8, 70.2,
176  5 71.6, 73.0, 74.4, 75.8, 77.2, 77.9, 79.3, 80.7,
177  6 82.3, 84.0, 85.9, 87.8, 89.9, 93.2, 95.4, 97.4,
178  7 99.3, 101.2, 103.0, 104.6, 106.7, 108.0, 109.2, 109.9,
179  8 110.3, 111.7, 112.0, 112.3, 111.9, 112.3, 112.3, 112.0,
180  9 111.6, 110.9, 110.1, 109.2, 108.2, 107.0, 105.7, 104.0/
181  data ( xs4(i),i= 73, 92)/
182  1 102.5, 100.9, 99.3, 97.6, 95.7, 93.9, 92.1, 90.3,
183  2 88.5, 86.1, 84.4, 82.8, 81.4, 81.1, 80.3, 79.1,
184  3 77.7, 75.9, 73.9, 71.6/
185 !
186  goto 10
187 ! **********************
188  entry cgppip(egl10, xs)
189 ! **********************
190  goto 20
191 ! **********************
192  entry cgppi2(egl10, xs)
193 ! **********************
194  goto 30
195 ! **********************
196  entry cgppi3(egl10, xs)
197 ! **********************
198  goto 40
199 !
200 
201  10 continue
202  if(egl10 .lt. e11) then
203  xs=0.
204  elseif(egl10 .lt. e12) then
205  call kintp3(xs1, 1, 107, e11, 0.01d0, egl10, xs)
206  else
207  xs=0.
208  endif
209  return
210 !
211  20 continue
212  if(egl10 .lt. e21) then
213  xs=0.
214  elseif(egl10 .lt. e22) then
215  call kintp3(xs2, 1, 100, e21, 0.01d0, egl10, xs)
216  else
217  xs=0.
218  endif
219  return
220 !
221  30 continue
222  if(egl10 .lt. e31) then
223  xs=0.
224  elseif(egl10 .lt. e32) then
225  call kintp3(xs3, 1, 109, e31, 0.01d0, egl10, xs)
226  else
227  xs=0.
228  endif
229  return
230 !
231  40 continue
232  if(egl10 .lt. e41) then
233  xs=0.
234  else
235  call kintp3(xs4, 1, 92, e41, 0.01d0, egl10, xs)
236  endif
237  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
cgppi0
subroutine cgppi0(egl10, xs)
Definition: cgpxs1.f:106
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
d
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
a
nodes a
Definition: cstdatmos0.fNew2.h:93
h
dE dx *! Nuc Int sampling table h
Definition: cblkMuInt.h:130
g
dE dx *! Nuc Int sampling table g
Definition: cblkMuInt.h:130
kintp3
subroutine kintp3(f, intv, n, x1, h, x, ans)
Definition: kintp3.f:19
masp
masp
Definition: Zmass.h:5
cgpxs1
subroutine cgpxs1(Eg, xs)
Definition: cgpxs1.f:3
f
dE dx *! Nuc Int sampling table f
Definition: cblkMuInt.h:130
c
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130