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

Go to the source code of this file.

Functions/Subroutines

subroutine kintp3 (f, intv, n, x1, h, x, ans)
 

Function/Subroutine Documentation

◆ kintp3()

subroutine kintp3 ( real*8, dimension(intv, n f,
integer  intv,
integer  n,
real*8  x1,
real*8  h,
real*8  x,
real*8  ans 
)

Definition at line 19 of file kintp3.f.

Referenced by cbrlsampp(), cbrssampp(), cgppi0(), cmubrdedx(), cmubrsmpp(), cmundedx(), cmunsmpp(), cmupolatlabk(), cmuprdedx(), cmuprsmpp(), and cprlsampp().

19  implicit none
20 !
21  integer intv, n
22  real*8 f(intv, n), x1, h, x, ans
23 !
24  integer i
25  real*8 p, ta, tb
26 !
27  if(n .lt. 3) then
28  ans=0.
29  else
30  i=(x-x1)/h
31  if(i .lt. 0) then
32  i=0
33  elseif(i .gt. 0) then
34  if(i+3 .gt. n) then
35  i=n-3
36  endif
37  endif
38  p=(x-x1-h*float(i+1))/h
39  ta=p-1.
40  tb=p+1.
41  ans=0.5*p*(ta*f(1, i+1)+tb*f(1, i+3)) - ta*tb*f(1, i+2)
42  endif
block data include Zlatfit h c fitting region data x1(1)/0.03/
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
nodes i
real(4), dimension(:), allocatable, save h
Definition: cNRLAtmos.f:28
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
integer n
Definition: Zcinippxc.h:1
! structure defining a particle at production ! Basic idea of what is to be contained in ! the particle structue is that dynamical ones should be included those derivable from the particle code ! is not included ******************************************************type fmom momentum sequence union map real e endmap map real * x
Definition: Zptcl.h:21
dE dx *! Nuc Int sampling table f
Definition: cblkMuInt.h:130
Here is the caller graph for this function: