COSMOS v7.655  COSMOSv7655
(AirShowerMC)
getST3.f File Reference

Go to the source code of this file.

Functions/Subroutines

program __getst3.f__
 
subroutine inteflux (comp, ans)
 
real *8 function primdn (eorp)
 
real *8 function funcazim (azm)
 
subroutine chooktrace
 
subroutine chookceren
 
subroutine chookcerens
 
subroutine chookcerene
 
subroutine chookbgrun
 

Function/Subroutine Documentation

◆ __getst3.f__()

program __getst3.f__ ( )

Definition at line 20 of file getST3.f.

References azmmax, azmmin, cbeginrun(), coszenith, cprintprim(), creadparam(), d, false, i, inteflux(), rigc, true, and zen1.

20  integer i
nodes i
Here is the call graph for this function:

◆ chookbgrun()

subroutine chookbgrun ( )

Definition at line 212 of file getST3.f.

◆ chookceren()

subroutine chookceren ( )

Definition at line 206 of file getST3.f.

◆ chookcerene()

subroutine chookcerene ( )

Definition at line 210 of file getST3.f.

◆ chookcerens()

subroutine chookcerens ( )

Definition at line 208 of file getST3.f.

◆ chooktrace()

subroutine chooktrace ( )

Definition at line 204 of file getST3.f.

◆ funcazim()

real*8 function funcazim ( real*8  azm)

Definition at line 180 of file getST3.f.

References cconv_prim_e(), cprimflux0(), crigcut(), degree, e, funcazim(), and zen.

180  implicit none
181 #include "Zglobalc.h"
182 #include "Zptcl.h"
183 #include "Zprimary.h"
184  include 'Zflux.h'
185 
186  type(ptcl):: aptcl
187  real*8 rig, azm, prob, flux, zeny
188 
189 ! E= E_or_P must be converted to rigidity
190  call cconv_prim_e(compx, e, aptcl)
191 
192  rig =sqrt( aptcl%fm%p(4)**2 - aptcl%mass**2)/aptcl%charge
193  if(degree) then
194  zeny = zen/torad
195  else
196  zeny = zen
197  endif
198  call crigcut(azm, zeny, rig, prob)
199  call cprimflux0(compx, e, flux) ! E = EorP
200  funcazim = flux * prob
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
real *8 function funcazim(azm)
Definition: getST.f:286
subroutine crigcut(azmin, zen, rig, prob)
Definition: crigCut.f:6
subroutine cconv_prim_e(comp, e_or_p, aPtcl)
Definition: csampPrimary.f:128
subroutine cprimflux0(comp, e_or_p, flux)
Definition: cprimFlux0.f:2
Definition: Zptcl.h:75
real zen
Definition: Zflux.h:1
real zen logical degree
Definition: Zflux.h:1
Here is the call graph for this function:

◆ inteflux()

subroutine inteflux ( type (component comp,
real*8  ans 
)

Definition at line 100 of file getST3.f.

References azmmax, azmmin, cconv_prim_e2(), cmkptc(), d, d0, inteprim2(), kdexpintfb(), kdwhereis(), primdn(), and rigc.

100  implicit none
101 #include "Zglobalc.h"
102 #include "Zptcl.h"
103 #include "Zprimary.h"
104  type(component):: comp
105  real*8 ans
106  include 'Zflux.h'
107 
108  real*8 eps, error, ans2, eth, e_or_p
109  integer icon
110 
111 
112  integer imax
113  external primdn
114  real*8 primdn
115  type(ptcl)::aptcl
116  integer j
117  data eps/1.d-4/
118 
119 
120 
121  compx = comp
122  imax = comp%no_of_seg
123  if(rigc .eq. 0.) then
124 ! no rigidy cut. integrate segmented power functions
125  call inteprim2(comp, 1, imax, ans)
126  if(abs(ans/comp%inte_value-1.d0) .gt. 1.d-3 ) then
127  write(*,*) ' ans=',ans, ' internal integral=',
128  * comp%inte_value
129  stop 9999
130  endif
131  else
132  call cmkptc(comp%code, comp%subcode, comp%charge, aptcl)
133  eth =sqrt( (rigc*comp%charge)**2 + aptcl%mass**2 )
134  call cconv_prim_e2(comp, eth, e_or_p)
135  call kdwhereis(e_or_p, comp%no_of_seg+1, comp%energy, 1, j)
136  if(j .le. imax) then
137 ! energy integral;
138  call kdexpintfb(primdn, comp%energy(1), comp%energy(j+1),
139  * eps, ans, error, icon)
140  ans = ans * torad
141  endif
142 ! add E> comp.energy(j+1)
143  if(j+1 .lt. imax ) then
144  call inteprim2(comp, j+1, imax, ans2)
145  ans2 = ans2 * abs(azmmax - azmmin)*torad
146  else
147  ans2 = 0.
148  endif
149  ans = ans + ans2
150  endif
real *8 function primdn(eorp)
Definition: getST.f:246
atmos%rho(atmos%nodes) **exp(-(z-atmos%z(atmos%nodes))/Hinf) elseif(z .lt. atmos%z(1)) then ans=atmos%rho(1) **exp((atmos%z(1) -z)/atmos%H(1)) else call kdwhereis(z, atmos%nodes, atmos%z, 1, i) a=atmos%a(i) if(a .ne. 0.d0) then ans=atmos%rho(i) **(1+a *(z-atmos%z(i))/atmos%H(i)) **(-1.0d0-1.d0/a) else ans=*atmos%rho(i) *exp(-(z-atmos%z(i))/atmos%H(i)) endif endif ! zsave=z ! endif cvh2den=ans end ! ---------------------------------- real *8 function cvh2temp(z) implicit none ! vettical height to temperatur(Kelvin) real *8 z ! input. vertical height in m ! output is temperature of the atmospher in Kelvin real *8 ans integer i if(z .gt. atmos%z(atmos%nodes)) then ans=atmos%T(atmos%nodes) elseif(z .lt. atmos%z(1)) then ans=atmos%T(1)+atmos%b(1) *(z - atmos%z(1)) else call kdwhereis(z, atmos%nodes, atmos%z, 1, i) ans=atmos%T(i)+atmos%b(i) *(z-atmos%z(i)) endif cvh2temp=ans end !--------------------------------------------- real *8 function cthick2h(t) implicit none real *8 t ! input. air thickness in kg/m^2 real *8 logt, ans integer i real *8 dod0, fd, a logt=log(t) if(t .ge. atmos%cumd(1)) then ans=atmos%z(1) - *(logt - atmos%logcumd(1)) *atmos%H(1) elseif(t .le. atmos%cumd(atmos%nodes)) then ans=atmos%z(atmos%nodes) - *Hinf *log(t/atmos%cumd(atmos%nodes)) else call kdwhereis(t, atmos%nodes, atmos%cumd, 1, i) ! i is such that X(i) > x >=x(i+1) ans
subroutine cconv_prim_e2(comp, E, e_or_p)
Definition: csampPrimary.f:230
subroutine kdwhereis(x, in, a, step, loc)
Definition: kdwhereis.f:27
real * azmmin
Definition: Zflux.h:1
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
real rigc
Definition: Zflux.h:1
block data cblkEvhnp ! currently usable models data RegMdls ad *special data *Cekaon d0
Definition: cblkEvhnp.h:5
subroutine kdexpintfb(func, a, b, eps, ans, error, icon)
Definition: kdexpIntFb.f:10
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
subroutine inteprim2(comp, i1, i2, ans)
Definition: intePrim2.f:2
subroutine cmkptc(code, subcode, charge, p)
Definition: cmkptc.f:15
real azmmax
Definition: Zflux.h:1
Definition: Zptcl.h:75
float eth[nth]
Definition: Zprivate.h:8
Here is the call graph for this function:

◆ primdn()

real*8 function primdn ( real*8  eorp)

Definition at line 155 of file getST3.f.

References azmmax, azmmin, d, e, kdexpintf(), primdn(), zen, and zen1.

155  implicit none
156 
157 #include "Zglobalc.h"
158 #include "Zptcl.h"
159 #include "Zprimary.h"
160 ! primary flux at E
161  real*8 eorp
162 
163  include 'Zflux.h'
164 
165 
166  integer icon
167 
168  real*8 eps, ans, error
169  real*8 funcazim
170  external funcazim
171  data eps/1.d-5/
172 
173  e = eorp
174  zen = zen1
175  call kdexpintf(funcazim, azmmin, azmmax, eps, ans, error, icon)
176  primdn = ans
real *8 function primdn(eorp)
Definition: getST.f:246
real zen1
Definition: Zflux.h:1
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
atmos%rho(atmos%nodes) **exp(-(z-atmos%z(atmos%nodes))/Hinf) elseif(z .lt. atmos%z(1)) then ans=atmos%rho(1) **exp((atmos%z(1) -z)/atmos%H(1)) else call kdwhereis(z, atmos%nodes, atmos%z, 1, i) a=atmos%a(i) if(a .ne. 0.d0) then ans=atmos%rho(i) **(1+a *(z-atmos%z(i))/atmos%H(i)) **(-1.0d0-1.d0/a) else ans=*atmos%rho(i) *exp(-(z-atmos%z(i))/atmos%H(i)) endif endif ! zsave=z ! endif cvh2den=ans end ! ---------------------------------- real *8 function cvh2temp(z) implicit none ! vettical height to temperatur(Kelvin) real *8 z ! input. vertical height in m ! output is temperature of the atmospher in Kelvin real *8 ans integer i if(z .gt. atmos%z(atmos%nodes)) then ans=atmos%T(atmos%nodes) elseif(z .lt. atmos%z(1)) then ans=atmos%T(1)+atmos%b(1) *(z - atmos%z(1)) else call kdwhereis(z, atmos%nodes, atmos%z, 1, i) ans=atmos%T(i)+atmos%b(i) *(z-atmos%z(i)) endif cvh2temp=ans end !--------------------------------------------- real *8 function cthick2h(t) implicit none real *8 t ! input. air thickness in kg/m^2 real *8 logt, ans integer i real *8 dod0, fd, a logt=log(t) if(t .ge. atmos%cumd(1)) then ans=atmos%z(1) - *(logt - atmos%logcumd(1)) *atmos%H(1) elseif(t .le. atmos%cumd(atmos%nodes)) then ans=atmos%z(atmos%nodes) - *Hinf *log(t/atmos%cumd(atmos%nodes)) else call kdwhereis(t, atmos%nodes, atmos%cumd, 1, i) ! i is such that X(i) > x >=x(i+1) ans
real *8 function funcazim(azm)
Definition: getST.f:286
real * azmmin
Definition: Zflux.h:1
subroutine kdexpintf(func, a, b, eps, ans, error, icon)
Definition: kdexpIntF.f:55
dE dx *! Nuc Int sampling table d
Definition: cblkMuInt.h:130
real azmmax
Definition: Zflux.h:1
real zen
Definition: Zflux.h:1
Here is the call graph for this function: