COSMOS v7.655  COSMOSv7655
(AirShowerMC)
ckmpTotXs.f
Go to the documentation of this file.
1 ! K- -p total xsection , elastic xs
2  subroutine ckmptotxs(p, xs)
3  use modpdgxs, only: csigmat
4  implicit none
5 #include "Zmass.h"
6  real*8 p ! input. momentum of n. in GeV
7  real*8 xs ! output. total np cross section in mb
8  integer np, i, m
9  real*8 error
10  parameter(np=45, m=3)
11  real*8 px(np), mb(np)
12  real(8),parameter:: Pnorm=10.
13 
14  data ( px(i), i= 1 , np )/
15  1 0.9980e-01, 0.1155 , 0.2860 , 0.3614 ,
16  2 0.4023 , 0.4349 , 0.4500 , 0.48 ,
17  * 0.5158 ,
18  3 0.5913 , 0.6455 , 0.6810 , 0.7291 ,
19  4 0.7618 , 0.7883 , 0.8358 , 0.9258 ,
20  5 0.9816 , 1.036 , 1.082 , 1.164 ,
21  6 1.228 , 1.321 , 1.429 , 1.522 ,
22  7 1.622 , 1.788 , 1.933 , 2.162 ,
23  8 2.454 , 3.026 , 3.769 , 4.927 ,
24  9 7.207 , 9.422 , 12.68 , 16.99 ,
25  a 21.37 , 29.33 , 43.11 , 68.50 ,
26  b 99.22 , 153.1 , 236.3 , 369.9
27  * /
28  data ( mb(i), i= 1 , np )/
29  1 107.3 , 98.89 , 92.45 , 74.10 ,
30  2 68.94 , 63.22 , 49.47 , 42.0,
31  * 40.81 ,
32  3 36.01 , 34.48 , 34.15 , 35.16 ,
33  4 39.84 , 41.20 , 39.84 , 44.71 ,
34  5 48.76 , 51.41 , 47.83 , 40.22 ,
35  6 33.67 , 30.28 , 31.78 , 33.02 ,
36  7 33.83 , 32.39 , 30.14 , 29.71 ,
37  8 28.31 , 26.60 , 26.21 , 24.86 ,
38  9 23.58 , 22.69 , 21.94 , 21.21 ,
39  a 20.91 , 20.61 , 20.22 , 20.22 ,
40  b 20.32 , 20.71 , 21.01 , 21.73
41  * /
42 
43  save
44  if(p .gt. pnorm) then
45  xs = csigmat('K-', 'p', p)
46  elseif( p .gt. 0.2) then
47 ! call kpolintplogxyFE(px, 1, mb, 1, np, m, 3, p, xs, error)
48  call kpolintpfe(px, 1, mb, 1, np, m, p, xs, error)
49  else
50  call ckmpelaxs(p, xs)
51  endif
52  end subroutine ckmptotxs
53 !
54  subroutine ckmpelaxs(p, xs)
55  use modpdgxs, mpdg => m
56 ! pi+ p elastic cross section in mb
57  implicit none
58 #include "Zmass.h"
59  real*8 p ! input. momentum of n in GeV
60  real*8 xs ! output np elastic xs. mb.
61 
62  integer np, m, i
63  parameter(np=40, m=5)
64  real*8 px(np), mb(np)
65  real*8 error
66 
67  real(8),parameter:: Pnorm=50.0
68  real(8)::spip, spp, Epp, PnormPP, PPP
69  real(8):: xspel, xspt, xspit, Norm
70  real(8),save::xsnorm
71 
72  logical,save:: first = .true.
73 
74 
75  data ( px(i), i= 1 , np )/
76  1 0.9980e-01, 0.1155 , 0.1460 , 0.1918 ,
77  2 0.2658 , 0.3278 , 0.3794 , 0.4286 ,
78  3 0.4478 , 0.4611 , 0.5010 , 0.5714 ,
79  4 0.6330 , 0.6744 , 0.7081 , 0.7544 ,
80  5 0.7844 , 0.8439 , 0.9395 , 1.041 ,
81  6 1.114 , 1.205 , 1.271 , 1.321 ,
82  7 1.478 , 1.736 , 1.886 , 2.183 ,
83  8 2.589 , 3.419 , 4.094 , 5.000 ,
84  9 6.380 , 8.974 , 13.85 , 23.79 ,
85  a 40.07 , 61.84 , 96.36 , 165.5
86  * /
87  data ( mb(i), i= 1 , np )/
88  1 107.3 , 98.89 , 80.41 , 60.54 ,
89  2 45.36 , 37.60 , 32.71 , 32.08 ,
90  3 28.72 , 24.39 , 21.01 , 18.19 ,
91  4 16.05 , 14.93 , 14.03 , 15.82 ,
92  5 18.54 , 20.32 , 21.32 , 21.21 ,
93  6 18.36 , 15.37 , 12.74 , 10.46 ,
94  7 8.671 , 8.629 , 8.028 , 6.983 ,
95  8 5.844 , 4.845 , 4.337 , 3.977 ,
96  9 3.683 , 3.394 , 3.009 , 2.605 ,
97  a 2.435 , 2.423 , 2.459 , 2.543
98  * /
99 
100  save
101 !
102  if( p .gt. pnorm) then
103  if( first ) then
104  ppp = pnorm
105  call cppelaxs(ppp, xspel)
106  call cpptotxs(ppp, xspt)
107  call ckmptotxs(ppp, xspit)
108  call kpolintpfe(px, 1, mb, 1, np, m,
109  * ppp, xsnorm, error)
110  xs = xspit*xspel/xspt
111  norm = xs - xsnorm
112 
113  first=.false.
114  endif
115  ppp = p
116  call cppelaxs(ppp, xspel)
117  call cpptotxs(ppp, xspt)
118  call ckmptotxs(ppp, xspit)
119  xs = xspit*xspel/xspt
120  xs = xs - norm
121  elseif(p .gt. px(1)) then
122 ! call kpolintplogxyFE(px, 1, mb, 1, np, m, 3, p, xs, error)
123  call kpolintpfe(px, 1, mb, 1, np, m, p, xs, error)
124  else
125 ! get value at 0.1
126  xs = mb(1)
127  endif
128  end subroutine ckmpelaxs
129  subroutine ckmpinelaxs(p, xs)
130  implicit none
131  real(8),intent(in)::p
132  real(8),intent(out)::xs
133 
134  real(8)::txs, exs
135  call ckmptotxs(p, txs)
136  call ckmpelaxs(p, exs)
137  xs =max( txs - exs, 0.d0)
138  end subroutine ckmpinelaxs
139 
parameter
integer npitbl real *nx parameter(n=101, npitbl=46, nx=n-1) real *8 uconst
modpdgxs::m
real(8), parameter, public m
Definition: cpdgXs.f:13
e
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
cpptotxs
subroutine cpptotxs(p, xs)
Definition: cppTotXs.f:3
modpdgxs::csigmat
real(8) function, public csigmat(a, b, p)
Definition: cpdgXs.f:31
true
block data cblkElemag data *AnihiE ! Eposi< 1 TeV, anihilation considered *X0/365.667/, ! radiation length of air in kg/m2 *Ecrit/81.e-3/, ! critical energy of air in GeV *MaxComptonE/1./, ! compton is considered below 1 GeV *MaxPhotoE/1.e-3/, ! above this, PhotoElectric effect neg. *MinPhotoProdE/153.e-3/, ! below 153 MeV, no gp --> hadrons ! scattering const not MeV *Knockon true
Definition: cblkElemag.h:7
ckmptotxs
subroutine ckmptotxs(p, xs)
Definition: ckmpTotXs.f:3
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
ckmpinelaxs
subroutine ckmpinelaxs(p, xs)
Definition: ckmpTotXs.f:130
ckmpelaxs
subroutine ckmpelaxs(p, xs)
Definition: ckmpTotXs.f:55
a
nodes a
Definition: cstdatmos0.fNew2.h:93
b
dE dx *! Nuc Int sampling table b
Definition: cblkMuInt.h:130
kpolintpfe
subroutine kpolintpfe(xa, xstep, ya, ystep, nt, m, x, y, error)
Definition: kpolintp.f:134
false
block data cblkElemag data *AnihiE ! Eposi< 1 TeV, anihilation considered *X0/365.667/, ! radiation length of air in kg/m2 *Ecrit/81.e-3/, ! critical energy of air in GeV *MaxComptonE/1./, ! compton is considered below 1 GeV *MaxPhotoE/1.e-3/, ! above this, PhotoElectric effect neg. *MinPhotoProdE/153.e-3/, ! below 153 MeV, no gp --> hadrons ! scattering const not MeV *Knockon ! knockon is considered Obsolete *PhotoProd false
Definition: cblkElemag.h:7
modpdgxs
Definition: cpdgXs.f:1