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

Go to the source code of this file.

Functions/Subroutines

subroutine kbinchop (f, x1, x2, x, eps, ans, icon)
 

Function/Subroutine Documentation

◆ kbinchop()

subroutine kbinchop ( real*8  f,
real*8  x1,
real*8  x2,
real*8  x,
real*8  eps,
real*8  ans,
integer  icon 
)

Definition at line 20 of file kbinChop.f.

Referenced by cinipipx(), cinippx(), cinippxn(), and ksamppeang().

20  implicit none
21 !
22  real*8 f ! input. function name. to be used as f(x)
23  ! f(x) = 0 is solved.
24  real*8 x1 ! input. lower bound of solution
25  real*8 x2 ! input. upper bound of solution
26  real*8 x ! input. initial guess of solution.
27  real*8 eps ! input. relative error of solution.
28  real*8 ans ! output. obtained solution
29  integer icon ! output. condition code. 0--> ok.
30 ! 1--> unconvergence after 45 iterations
31 ! 2--> x not in the range
32  real*8 xa, xb, fa, fb, xt, ft
33  integer n
34 !
35  if(x .lt. x1 .or. x .gt. x2) then
36  icon = 2
37  else
38  xa = x1
39  xb = x2
40  fa = f(xa)
41  fb = f(xb)
42  icon = 1
43  do n = 0, 45
44  if(fa * fb .gt. 0.) then
45  icon = 1
46  goto 100
47  else
48  xt = (xa + xb)/ 2
49  ft = f(xt)
50  if( ft * fa .gt. 0.) then
51  xa = xt
52  fa = ft
53  else
54  xb = xt
55  fb = ft
56  endif
57  if(abs(xt) .gt. 1.) then
58  if(abs( (xa-xb) / xt ) .lt. eps) then
59  icon = 0
60  goto 100
61  endif
62  else
63  if(abs(xa-xb) .lt. eps) then
64  icon = 0
65  goto 100
66  endif
67  endif
68  endif
69  enddo
70  100 continue
71  ans = xt
72  endif
x1
block data include Zlatfit h c fitting region data x1(1)/0.03/
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
x2
block data include Zlatfit h c fitting region data x2(1)/0.5/data x1(2)/0.3/
n
integer n
Definition: Zcinippxc.h:1
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: