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

Go to the source code of this file.

Functions/Subroutines

subroutine k4ptdi (f, im, jm, iadj, x0, y0, hx, hy, x, y, ans)
 

Function/Subroutine Documentation

◆ k4ptdi()

subroutine k4ptdi ( real*8, dimension(iadj,jm)  f,
integer  im,
integer  jm,
integer  iadj,
real*8  x0,
real*8  y0,
real*8  hx,
real*8  hy,
real*8  x,
real*8  y,
real*8  ans 
)

Definition at line 21 of file k4ptdi.f.

Referenced by cavenoofsucc(), cbrlsampe(), cbrssampe(), cgetrigcut(), cnebyapproxb(), cprlsampe(), and crigcut().

21  implicit none
22  integer im, jm, iadj
23  real*8 f(iadj,jm), x0, y0, hx, hy, x, y, ans
24 !
25  integer i, j
26  real*8 a, b, p, q, p1, q1
27 
28  a=(x-x0)/hx
29  b=(y-y0)/hy
30  i=a
31  j=b
32  i=min(max(i,0)+1,im-1)
33  j=min(max(j,0)+1,jm-1)
34  p=a+1.-i
35  q=b+1.-j
36  p1=1.-p
37  q1=1.-q
38  ans=( f(i,j)*p1 + f(i+1,j)*p ) * q1 +
39  * ( f(i,j+1)*p1 + f(i+1,j+1)*p ) * q
ans
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
Definition: cstdatmos0.fNew2.h:82
i
nodes i
Definition: cstdatmos0.fNew2.h:93
p
********************block data cblkHeavy ********************integer j data *HeavyG2symbol p
Definition: cblkHeavy.h:7
j
********************block data cblkHeavy ********************integer j data *HeavyG2symbol *data *HeavyG2code kiron data j
Definition: cblkHeavy.h:36
y
latitude latitude this system is used *****************************************************************! type coord sequence union map real y
Definition: Zcoord.h:25
nrl_atmos::a
real(4), save a
Definition: cNRLAtmos.f:20
nrl_atmos::b
real(4), save b
Definition: cNRLAtmos.f:21
x
! 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
f
dE dx *! Nuc Int sampling table f
Definition: cblkMuInt.h:130
Here is the caller graph for this function: