COSMOS v7.655  COSMOSv7655
(AirShowerMC)
Functions/Subroutines
cpippTotXs.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine cpipptotxs (p, xs)
 
subroutine cpippelaxs (p, xs)
 
subroutine cpippinelaxs (p, xs)
 

Function/Subroutine Documentation

◆ cpippelaxs()

subroutine cpippelaxs ( real*8  p,
real*8  xs 
)

Definition at line 61 of file cpippTotXs.f.

References a, b, c, cpipptotxs(), cppelaxs(), cpptotxs(), modpdgxs::csofstu(), d, e, false, kpolintpfe(), kpolintplogxyfe(), modpdgxs::m, masp, maspic, and parameter().

Referenced by cpimnelaxs(), cpippinelaxs(), and cpipptotxs().

61  use modpdgxs, mpdg=>m
62 ! pi+ p elastic cross section in mb
63  implicit none
64 #include "Zmass.h"
65  real*8 p ! input. momentum of n in GeV
66  real*8 xs ! output np elastic xs. mb.
67 
68  integer np, m, i
69 ! parameter (np=54, m=5)
70  parameter(np=52, m=5)
71  real*8 px(np), mb(np)
72  real*8 error
73  real*8 xssave/-1./
74  real(8),parameter:: pnorm=80.0
75  real(8),parameter:: sm=(maspic + masp + mpdg)**2
76  real(8),parameter:: smpp=(masp + masp + mpdg)**2
77  real(8),save:: xsn, norm, pshift
78  real(8)::spip, spp, epp, pnormpp, ppp
79  real(8):: xspel, xspt, xspit
80  real(8),save::xsnorm
81  logical,save:: first = .true.
82 
83  data ( px(i), i= 1 , np )/
84  1 0.1190 , 0.1275 , 0.1465 , 0.1649 ,
85  2 0.1811 , 0.2050 , 0.2197 , 0.2389 ,
86  3 0.2573 , 0.2703 , 0.2854 , 0.3058 ,
87  4 0.3180 , 0.3356 , 0.3595 , 0.3850 ,
88  5 0.4185 , 0.4594 , 0.5068 , 0.5645 ,
89  6 0.5900 , 0.6137 , 0.6338 , 0.6831 ,
90  7 0.7213 , 0.7892 , 0.8257 , 0.8800 ,
91  8 0.9521 , 1.03919 , 1.09262 , 1.19267 ,
92  9 1.36419 , 1.45478 , 1.55635 , 1.6661 ,
93  a 1.87834 , 2.13318 ,
94 !
95 ! , 0.6414 , 0.6638 ,
96 ! 7 0.6903 , 0.7395 , 0.7805 , 0.8039 ,
97 ! 8 0.8444 , 0.8914 , 0.9273 , 0.9888 ,
98 ! 9 1.075 , 1.146 , 1.241 , 1.349 ,
99 ! a 1.438 , 1.556 , 1.659 , 1.931 ,
100 
101  b 2.283 , 2.821 , 3.716 , 5.167 ,
102  c 7.511 , 11.03 , 16.03 , 19.8157 ,
103  d 29.373 , 42.482 , 59.9484 , 84.1809,
104  e 134.34 , 240.072
105  * /
106 
107  data ( mb(i), i= 1 , np )/
108  1 9.845 , 13.81 , 19.99 , 30.48 ,
109  2 44.11 , 75.42 , 100.4 , 137.3 ,
110  3 174.4 , 193.5 , 200.7 , 190.5 ,
111  4 174.4 , 143.8 , 113.1 , 88.09 ,
112  5 62.45 , 45.45 , 33.24 , 24.57 ,
113  6 21.01 , 18.74 , 17.877 , 14.09 ,
114  7 11.695 , 9.744 , 8.394 , 9.412 ,
115  8 11.169 , 12.89 , 15.036 , 14.11 ,
116  9 17.35 , 18.864 , 15.93 , 13.70 ,
117  a 12.078 , 9.8926 ,
118 
119 ! 16.11 , 14.29 ,
120 ! 7 12.74 , 10.67 , 9.417 , 8.846 ,
121 ! 8 8.396 , 8.752 , 9.612 , 11.30 ,
122 ! 9 12.73 , 14.35 , 16.01 , 17.31 ,
123 ! a 17.40 , 16.34 , 13.83 , 10.99 ,
124 
125  b 8.740 , 7.710 , 6.627 , 5.695 ,
126  c 5.075 , 4.740 , 4.359 , 3.94511 ,
127  d 3.46975 , 3.24744 , 3.20098 , 3.27183 ,
128  e 3.294 , 3.30042
129 
130  * /
131 
132  save
133 !
134  if( p .gt. pnorm) then
135 ! we assume scaling in s as s(pip)/sm=s(pp)/smpp
136 ! so s(pip) = sm/smpp s(pp)
137 ! get s(pip) from Pnorm->s(pip) and get s(pp), and then
138 ! get Pnormpp
139 ! s= (masp+E)**2 - P**2 = 2masp*E + masp**2 + maspi**2
140 ! Since s(pp) = s(pip)*smpp/sm
141  if( first ) then
142  spip = csofstu(pnorm, maspic, masp)
143  spp = spip*smpp/sm
144  epp= spp/2/masp - masp
145  pnormpp = sqrt(epp**2 - masp**2)
146  pshift = pnormpp/pnorm ! pshift = 1.55
147 
148  ppp = pnorm*pshift
149  call cppelaxs(ppp, xspel)
150  call cpptotxs(ppp, xspt)
151  call cpipptotxs(ppp, xspit) ! not recursive call
152  call kpolintpfe(px, 1, mb, 1, np, m,
153  * pnorm, xsnorm, error)
154  xs = xspit*xspel/xspt
155  norm = xs - xsnorm
156  first=.false.
157  endif
158 ! spip = csOfstu(p, maspic, masp)
159 ! spp = spip*smpp/sm
160 ! Epp= spp/2/masp - masp
161 ! PPP = sqrt (Epp**2 - masp**2)
162 ! PPP = p*1.55 ! good approx of the above
163 ! PPP = p*pshift ! pshift ~ 1.55
164 
165  ppp = p*pshift
166  call cppelaxs(ppp, xspel)
167  call cpptotxs(ppp, xspt)
168  call cpipptotxs(p, xspit) ! not recursive
169  xs = xspit*xspel/xspt
170  xs = xs - norm
171  elseif(p .gt. 0.12) then
172  call kpolintpfe(px, 1, mb, 1, np, m, p, xs, error)
173  elseif(p > 0.09 ) then
174  call kpolintplogxyfe(px, 1, mb, 1, np, m, 3, p, xs, error)
175  else
176  xs = 0.
177  endif
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
norm
common ZdedxAir norm
Definition: ZdedxAir.h:2
e
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
cpptotxs
subroutine cpptotxs(p, xs)
Definition: cppTotXs.f:3
nrl_atmos::first
logical, save first
Definition: cNRLAtmos.f:8
i
nodes i
Definition: cstdatmos0.fNew2.h:93
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
mb
! constants used for pair brem in Air real *mbtoPX0 ! mbtoPgrm x X0g If multiplied to sigma in mb
Definition: ZbpCnst.h:3
xs
! constants thru Cosmos real ! if multiplied to deg radian Torad ! light velocity m sec ! infinty ! kg m2 *Togpcm2 g cm2 ! g cm2 *Tokgpm2 kg m2 ! cm *Tom m ! m *Tocm cm ! g cm3 *Tokgpm3 kg m3 ! kg m3 *Togpcm3 g cm3 ! sec *Tonsec nsec ! Tesla m ! Avogadro *A2deninv ! mfp *n * xs
Definition: Zglobalc.h:18
p
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
cppelaxs
subroutine cppelaxs(p, xs)
Definition: cppTotXs.f:68
d
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
cpipptotxs
subroutine cpipptotxs(p, xs)
Definition: cpippTotXs.f:3
modpdgxs::csofstu
real(8) function, public csofstu(p, Mp, Mt)
Definition: cpdgXs.f:21
kpolintpfe
subroutine kpolintpfe(xa, xstep, ya, ystep, nt, m, x, y, error)
Definition: kpolintp.f:134
nrl_atmos::a
real(4), save a
Definition: cNRLAtmos.f:20
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
masp
masp
Definition: Zmass.h:5
nrl_atmos::b
real(4), save b
Definition: cNRLAtmos.f:21
maspic
maspic
Definition: Zmass.h:5
modpdgxs
Definition: cpdgXs.f:1
c
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130
Here is the call graph for this function:
Here is the caller graph for this function:

◆ cpippinelaxs()

subroutine cpippinelaxs ( real(8), intent(in)  p,
real(8), intent(out)  xs 
)

Definition at line 180 of file cpippTotXs.f.

References cpippelaxs(), cpipptotxs(), and d0.

Referenced by cinelx0(), cpimninelaxs(), and cpipluspxsec().

180  implicit none
181  real(8),intent(in)::p
182  real(8),intent(out)::xs
183 
184  real(8)::txs, exs
185  call cpipptotxs(p, txs)
186  call cpippelaxs(p, exs)
187  xs =max( txs - exs, 0.d0)
xs
! constants thru Cosmos real ! if multiplied to deg radian Torad ! light velocity m sec ! infinty ! kg m2 *Togpcm2 g cm2 ! g cm2 *Tokgpm2 kg m2 ! cm *Tom m ! m *Tocm cm ! g cm3 *Tokgpm3 kg m3 ! kg m3 *Togpcm3 g cm3 ! sec *Tonsec nsec ! Tesla m ! Avogadro *A2deninv ! mfp *n * xs
Definition: Zglobalc.h:18
p
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
d0
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
cpipptotxs
subroutine cpipptotxs(p, xs)
Definition: cpippTotXs.f:3
cpippelaxs
subroutine cpippelaxs(p, xs)
Definition: cpippTotXs.f:61
Here is the call graph for this function:
Here is the caller graph for this function:

◆ cpipptotxs()

subroutine cpipptotxs ( real*8  p,
real*8  xs 
)

Definition at line 3 of file cpippTotXs.f.

References a, b, c, cpippelaxs(), modpdgxs::csigmat(), d, e, kpolintpfe(), and parameter().

Referenced by cpimntotxs(), cpippelaxs(), cpippinelaxs(), and ctotx0().

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=53, m=5)
11  real*8 px(np), mb(np)
12  real(8),parameter:: pnorm=80.0
13 
14 
15  data ( px(i), i= 1 , np )/
16  1 0.1190 , 0.1275 , 0.1465 , 0.1649 ,
17  2 0.1811 , 0.2050 , 0.2197 , 0.2389 ,
18  3 0.2573 , 0.2703 , 0.2854 , 0.3058 ,
19  4 0.3180 , 0.3356 , 0.3595 , 0.3850 ,
20  5 0.4185 , 0.4594 , 0.5068 , 0.5645 ,
21  6 0.6198 , 0.6509 , 0.6737 , 0.7146 ,
22  7 0.7848 , 0.8327 , 0.8922 , 0.9944 ,
23  8 1.092 , 1.193 , 1.285 , 1.364 ,
24  9 1.439 , 1.542 , 1.636 , 1.718 ,
25  a 1.805 , 2.011 , 2.241 , 2.401 ,
26  b 2.573 , 2.825 , 3.242 , 4.066 ,
27  c 5.201 , 7.377 , 9.961 , 13.85 ,
28  d 19.08 , 27.20 , 39.73 , 59.20 ,
29  e 76.10
30  * /
31  data ( mb(i), i= 1 , np )/
32  1 9.845 , 13.81 , 19.99 , 30.48 ,
33  2 44.11 , 75.42 , 100.4 , 137.3 ,
34  3 174.4 , 193.5 , 200.7 , 190.5 ,
35  4 174.4 , 143.8 , 113.1 , 88.09 ,
36  5 62.45 , 45.45 , 33.24 , 24.57 ,
37  6 19.84 , 17.15 , 15.77 , 14.36 ,
38  7 15.21 , 17.41 , 20.14 , 23.30 ,
39  8 26.13 , 30.54 , 34.97 , 38.40 ,
40  9 40.67 , 38.20 , 35.14 , 32.84 ,
41  a 30.84 , 29.27 , 29.89 , 30.83 ,
42  b 30.99 , 30.19 , 29.10 , 27.61 ,
43  c 26.89 , 25.38 , 24.59 , 24.32 ,
44  d 23.81 , 23.43 , 23.17 , 23.40 ,
45  e 23.39
46  * /
47 
48 
49  save
50  if(p .gt. pnorm) then
51  xs = csigmat('pi+','p', p)
52  elseif( p .gt. 0.6) then
53 ! call kpolintplogxyFE(px, 1, mb, 1, np, m, 3, p, xs, error)
54  call kpolintpfe(px, 1, mb, 1, np, m, p, xs, error)
55  else
56  call cpippelaxs(p, xs)
57  endif
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
i
nodes i
Definition: cstdatmos0.fNew2.h:93
modpdgxs::csigmat
real(8) function, public csigmat(a, b, p)
Definition: cpdgXs.f:31
mb
! constants used for pair brem in Air real *mbtoPX0 ! mbtoPgrm x X0g If multiplied to sigma in mb
Definition: ZbpCnst.h:3
xs
! constants thru Cosmos real ! if multiplied to deg radian Torad ! light velocity m sec ! infinty ! kg m2 *Togpcm2 g cm2 ! g cm2 *Tokgpm2 kg m2 ! cm *Tom m ! m *Tocm cm ! g cm3 *Tokgpm3 kg m3 ! kg m3 *Togpcm3 g cm3 ! sec *Tonsec nsec ! Tesla m ! Avogadro *A2deninv ! mfp *n * xs
Definition: Zglobalc.h:18
p
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
d
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
cpippelaxs
subroutine cpippelaxs(p, xs)
Definition: cpippTotXs.f:61
m
block data include Zlatfit h c fitting region data data data data data d0 data data d0 data data m
Definition: ZlatfitBD.h:35
kpolintpfe
subroutine kpolintpfe(xa, xstep, ya, ystep, nt, m, x, y, error)
Definition: kpolintp.f:134
nrl_atmos::a
real(4), save a
Definition: cNRLAtmos.f:20
nrl_atmos::b
real(4), save b
Definition: cNRLAtmos.f:21
modpdgxs
Definition: cpdgXs.f:1
c
dE dx *! Nuc Int sampling table c
Definition: cblkMuInt.h:130
Here is the call graph for this function:
Here is the caller graph for this function: