COSMOS v7.655  COSMOSv7655
(AirShowerMC)
cnpTotXs.f
Go to the documentation of this file.
1 ! np total xsection
2  subroutine cnptotxs(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=54, 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.1001 , 0.1126 , 0.1224 , 0.1337 ,
17  2 0.1489 , 0.1716 , 0.1912 , 0.2119 ,
18  3 0.2395 , 0.2590 , 0.2856 , 0.3135 ,
19  4 0.3407 , 0.3739 , 0.4207 , 0.4595 ,
20  5 0.4996 , 0.5512 , 0.6082 , 0.6646 ,
21  6 0.7227 , 0.7781 , 0.8378 , 0.9246 ,
22  7 1.051 , 1.225 , 1.400 , 1.584 ,
23  8 1.827 , 2.161 , 2.506 , 2.949 ,
24  9 3.470 , 4.063 , 4.950 , 5.767 ,
25  a 6.854 , 8.432 , 10.07 , 12.09 ,
26  b 15.02 , 18.75 , 23.07 , 28.66 ,
27  c 36.68 , 47.41 , 61.27 , 78.80 ,
28  d 99.85 , 130.3 , 174.4 , 236.8 ,
29  e 318.3 , 395.5
30  * /
31  data ( mb(i), i= 1 , np )/
32  1 1465. , 1264. , 1097. , 946.4 ,
33  2 782.0 , 619.0 , 489.9 , 395.0 ,
34  3 301.3 , 242.9 , 197.0 , 152.1 ,
35  4 122.7 , 100.7 , 78.76 , 65.88 ,
36  5 56.14 , 48.73 , 44.17 , 42.57 ,
37  6 41.28 , 38.34 , 35.40 , 34.12 ,
38  7 34.12 , 36.07 , 38.13 , 40.30 ,
39  8 41.06 , 42.61 , 43.41 , 43.42 ,
40  9 43.42 , 42.64 , 42.12 , 42.13 ,
41  a 41.11 , 40.86 , 40.62 , 39.64 ,
42  b 39.16 , 39.90 , 39.66 , 39.67 ,
43  c 39.43 , 39.44 , 38.73 , 39.46 ,
44  d 39.23 , 39.48 , 40.47 , 39.99 ,
45  e 40.00 , 41.00
46  * /
47 
48  if(p .gt. 390.) then
49 ! s =(m+E)^2 - p^2 = m^2 + p^2+m^2+2mE-p^2
50 ! = 2m(m+E)
51  s = (masp + sqrt(p**2+masp**2))*masp*2.
52  rts = sqrt(s)
53  xs =z + b*log(s/s0)**2 + y1*(1./s)**eta1 -y2*(1./s)**eta2
54  elseif( p .gt. 0.4) then
55  call kpolintpfe(px, 1, mb, 1, np, m, p, xs, error)
56  else
57  call cnpelaxs(p, xs)
58  endif
59  end
60 !
61  subroutine cnpelaxs(p, xs)
62 ! np elastic cross section in mb
63  implicit none
64  real*8 p ! input. momentum of n in GeV
65  real*8 xs ! output np elastic xs. mb.
66 
67  integer np, m, i
68  parameter(np=37, m=5)
69  real*8 px(np), mb(np)
70  real*8 error
71  real*8 xssave/-1./
72  data ( px(i), i= 1 , np )/
73  1 0.9860e-02, 0.1271e-01, 0.1942e-01, 0.3230e-01,
74  2 0.4935e-01, 0.7025e-01, 0.1000 , 0.1187 ,
75  3 0.1294 , 0.1472 , 0.1692 , 0.1988 ,
76  4 0.2386 , 0.2833 , 0.3257 , 0.3785 ,
77  5 0.4803 , 0.5145 , 0.5818 , 0.6548 ,
78  6 0.7628 , 0.8543 , 0.9906 , 1.132 ,
79  7 1.243 , 1.413 , 1.575 , 1.712 ,
80  8 2.180 , 2.960 , 3.788 , 5.068 ,
81  9 8.427 , 16.91 , 37.07 , 66.05 ,
82  * 100.0
83  * /
84  data ( mb(i), i= 1 , np )/
85  1 8452. , 7556. , 6039. , 4437. ,
86  2 3306. , 2362. , 1549. , 1169. ,
87  3 1022. , 813.3 , 621.7 , 438.5 ,
88  4 301.1 , 198.5 , 136.3 , 100.1 ,
89  5 60.07 , 50.88 , 42.83 , 40.02 ,
90  6 34.96 , 32.67 , 31.88 , 30.92 ,
91  7 31.31 , 29.80 , 26.85 , 24.78 ,
92  8 21.65 , 18.23 , 15.92 , 12.92 ,
93  9 11.43 , 10.17 , 9.629 , 9.575 ,
94  * 9.578
95  * /
96  save
97  if( p .gt. 100.) then
98 ! assume prop. to Total
99  if(xssave .lt. 0.) then
100  call cnptotxs(px(np), xssave)
101  endif
102  call cnptotxs(p, xs)
103  xs = xs * mb(np)/xssave
104  elseif(p .gt. 0.01) then
105  call kpolintplogxyfe(px, 1, mb, 1, np, m, 3, p, xs, error)
106  else
107 ! get value at 0.01
108  xs = mb(1)
109  endif
110  end
111  subroutine cnpinelaxs(p, xs)
112  implicit none
113  real(8),intent(in)::p
114  real(8),intent(out)::xs
115 
116  real(8)::txs, exs
117  call cnptotxs(p, txs)
118  call cnpelaxs(p, exs)
119  xs =max( txs - exs, 0.d0)
120  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
cnptotxs
subroutine cnptotxs(p, xs)
Definition: cnpTotXs.f:3
cnpinelaxs
subroutine cnpinelaxs(p, xs)
Definition: cnpTotXs.f:142
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
cnpelaxs
subroutine cnpelaxs(p, xs)
Definition: cnpTotXs.f:70
d
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
a
nodes a
Definition: cstdatmos0.fNew2.h:93
kpolintpfe
subroutine kpolintpfe(xa, xstep, ya, ystep, nt, m, x, y, error)
Definition: kpolintp.f:134
masp
masp
Definition: Zmass.h:5
c
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130