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

Go to the source code of this file.

Functions/Subroutines

subroutine kscsplinteg (x, y, n, coef, nc, a, b, s)
 

Function/Subroutine Documentation

◆ kscsplinteg()

subroutine kscsplinteg ( real(4), dimension(n)  x,
real(4), dimension(n)  y,
integer  n,
real(4), dimension(nc, 3)  coef,
integer  nc,
real(4)  a,
real(4)  b,
real(4)  s 
)

Definition at line 2 of file kScsplInteg.f.

Referenced by cnrldatamanip().

2  implicit none
3  integer n ! input. size of x,y
4  real(4):: x(n), y(n) ! input.
5  integer nc ! input. size of coef
6  real(4):: coef(nc, 3) ! input. which is the output from
7  ! kcsplCoeff.
8  real(4):: a ! input. lower limt of the integral
9  real(4):: b ! input. upper //
10  real(4):: s ! output. obtained integral value.
11 
12 
13  real(4) xx, x2, x1, xa, xb, sa, sb, sab, h
14  integer ind, ia, ib, ifla, iflb, ip, ier, i
15 
16  ind = 1
17  ia = 1
18  ifla = 0
19  iflb = 0
20  xx = a
21  if (a .gt. b) xx = b
22  do while( ind .le. 2 ) ! until ind=3
23  x1 = xx - x(ia)
24  do i=ia,n-1
25  ip = i
26  x2 = xx - x(i+1)
27 
28  if (x2 .lt. 0.0) go to 30
29  if (i .lt. n-1) x1 = x2
30  enddo
31  ip = n - 1
32  if (x2 .gt. 0.0) ier = 1
33  30 continue
34  if (x1 .lt. 0.0) then
35  ier = 1
36  x1 = - x1
37  if (ind .eq. 1) ifla = 1
38  if (ind .eq. 2) iflb = 1
39  endif
40  if(ind .ne. 2) then
41  ia = ip
42  xa = x1
43  xx = b
44  if (a .gt. b) xx = a
45  endif
46  ind = ind + 1
47  enddo
48 
49  ib = ip
50  xb = x1
51 ! integral from a to b.
52  sa = y(ia)+
53  * xa*(coef(ia,1)/2.0 +
54  * xa*(coef(ia,2)/3.0+xa*coef(ia,3)/4.0))
55 
56  sa = sa * xa
57  if (ifla .eq. 1) sa = - sa
58  sab = 0.0
59 
60  if (ib-1 .ge. ia) then
61  do i=ia,ib-1
62  h = x(i+1) - x(i)
63  sab =
64  * sab+h*(y(i+1)+y(i)-
65  * (coef(i+1,2)+coef(i,2))*h*h/6.0)/2.0
66  enddo
67  endif
68 
69  sb = y(ib)+
70  * xb*(coef(ib,1)/2.0 +
71  * xb*(coef(ib,2)/3.0+xb*coef(ib,3)/4.0))
72  sb = sb * xb
73  if (iflb .eq. 1) sb = - sb
74  s = sb + sab - sa
75  if (a .gt. b) s = - s
76 
x1
block data include Zlatfit h c fitting region data x1(1)/0.03/
i
nodes i
Definition: cstdatmos0.fNew2.h:93
nrl_atmos::h
real(4), dimension(:), allocatable, save h
Definition: cNRLAtmos.f:28
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
nc
real cut integer nc
Definition: Zprivate.h:1
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
Here is the caller graph for this function: