COSMOS v7.655  COSMOSv7655
(AirShowerMC)
ckppTotXs.f
Go to the documentation of this file.
1 ! K+ p total xsection , elastic xs
2  subroutine ckpptotxs(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=40, m=5)
11  real*8 px(np), mb(np)
12  real(8),parameter:: Pnorm=10.
13 
14  data ( px(i), i= 1 , np )/
15  1 0.1005 , 0.1706 , 0.2619 , 0.3586 ,
16  2 0.4511 , 0.5370 , 0.6587 , 0.7537 ,
17  3 0.8003 , 0.8846 , 0.9779 , 1.034 ,
18  4 1.065 , 1.131 , 1.166 , 1.263 ,
19  5 1.388 , 1.466 , 1.549 , 1.728 ,
20  6 1.938 , 2.173 , 2.377 , 2.653 ,
21  7 3.319 , 3.913 , 4.824 , 6.409 ,
22  8 8.305 , 10.19 , 12.50 , 15.33 ,
23  9 20.07 , 27.34 , 41.97 , 59.50 ,
24  a 85.63 , 126.3 , 203.9 , 302.5
25  * /
26 
27  data ( mb(i), i= 1 , np )/
28  1 10.98 , 11.55 , 11.91 , 12.33 ,
29  2 12.54 , 12.56 , 12.46 , 12.59 ,
30  3 13.13 , 14.05 , 15.20 , 16.17 ,
31  4 16.95 , 17.81 , 18.31 , 18.54 ,
32  5 18.33 , 18.02 , 17.81 , 17.89 ,
33  6 17.73 , 17.55 , 17.49 , 17.36 ,
34  7 17.28 , 17.20 , 17.25 , 17.25 ,
35  8 17.33 , 17.38 , 17.43 , 17.45 ,
36  9 17.50 , 17.71 , 17.97 , 18.30 ,
37  a 18.67 , 19.19 , 19.92 , 20.62
38  * /
39  save
40  if(p .gt. pnorm ) then
41  xs = csigmat('K+', 'p', p)
42  elseif( p .gt. 0.6) then
43 ! take log x only
44  call kpolintplogxyfe(px, 1, mb, 1, np, m, 1, p, xs, error)
45  else
46  call ckppelaxs(p, xs)
47  endif
48  end subroutine ckpptotxs
49 !
50  subroutine ckppelaxs(p, xs)
51  use modpdgxs, mpdg => m
52  implicit none
53 ! K+ p elastic cross section in mb
54 #include "Zmass.h"
55  real*8 p ! input. momentum of n in GeV
56  real*8 xs ! output np elastic xs. mb.
57 
58  integer np, m, i
59  parameter(np=27, m=5)
60  real*8 px(np), mb(np)
61  real*8 error
62  real(8),parameter:: Pnorm=100.0
63  real(8),save:: Norm
64  real(8)::spip, spp, Epp, PnormPP, PPP
65  real(8):: xspel, xspt, xspit
66  real(8),save::xsnorm
67  logical,save:: first = .true.
68  data ( px(i), i= 1 , np )/
69  1 0.1005 , 0.1706 , 0.2619 , 0.3586 ,
70  2 0.4511 , 0.5370 , 0.6330 , 0.7725 ,
71  3 0.9106 , 1.011 , 1.203 , 1.410 ,
72  4 1.669 , 1.996 , 2.497 , 3.107 ,
73  5 4.066 , 5.427 , 7.428 , 9.819 ,
74  6 14.92 , 22.57 , 34.81 , 52.64 ,
75  7 83.26 , 133.7 , 250.5
76  * /
77  data ( mb(i), i= 1 , np )/
78  1 10.98 , 11.55 , 11.91 , 12.33 ,
79  2 12.54 , 12.56 , 12.46 , 12.17 ,
80  3 12.06 , 11.56 , 10.62 , 9.627 ,
81  4 8.319 , 6.958 , 5.701 , 4.811 ,
82  5 4.129 , 3.525 , 3.366 , 3.312 ,
83  6 3.387 , 2.992 , 2.492 , 2.358 ,
84  7 2.433 , 2.429 , 2.686
85  * /
86 
87  save
88 !
89  if( p .gt. pnorm) then
90  if( first ) then
91  ppp = pnorm
92  call cppelaxs(ppp, xspel)
93  call cpptotxs(ppp, xspt)
94  call ckpptotxs(ppp, xspit)
95  call kpolintpfe(px, 1, mb, 1, np, m,
96  * ppp, xsnorm, error)
97  xs = xspit*xspel/xspt
98  norm = xs - xsnorm
99  first=.false.
100  endif
101  ppp = p
102  call cppelaxs(ppp, xspel)
103  call cpptotxs(ppp, xspt)
104  call ckpptotxs(ppp, xspit)
105  xs = xspit*xspel/xspt
106  xs = xs - norm
107  elseif(p .gt. px(1)) then
108 ! take log x only
109  call kpolintplogxyfe(px, 1, mb, 1, np, m, 1, p, xs, error)
110  else
111 ! get value at 0.1
112  xs = mb(1)
113  endif
114  end subroutine ckppelaxs
115  subroutine ckppinelaxs(p, xs)
116  implicit none
117  real(8),intent(in)::p
118  real(8),intent(out)::xs
119 
120  real(8)::txs, exs
121  call ckpptotxs(p, txs)
122  call ckppelaxs(p, exs)
123  xs =max( txs - exs, 0.d0)
124  end subroutine ckppinelaxs
125 
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
cpptotxs
subroutine cpptotxs(p, xs)
Definition: cppTotXs.f:3
ckppelaxs
subroutine ckppelaxs(p, xs)
Definition: ckppTotXs.f:51
modpdgxs::csigmat
real(8) function, public csigmat(a, b, p)
Definition: cpdgXs.f:31
ckpptotxs
subroutine ckpptotxs(p, xs)
Definition: ckppTotXs.f:3
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
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
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
ckppinelaxs
subroutine ckppinelaxs(p, xs)
Definition: ckppTotXs.f:116
modpdgxs
Definition: cpdgXs.f:1