1 subroutine spline_cubic_int(x,y,xx,yy,n,iflag)
12 integer,
intent(in) :: n
13 integer,
intent(inout) :: iflag
14 real(rprec),
intent(in) :: x
15 real(rprec),
dimension(n),
intent(in) :: xx,yy
16 real(rprec),
intent(out) :: y
17 real(rprec),
dimension(n) :: y2, dxx
21 real(rprec) :: yp1, ypn
26 if(x < xx(1) .or. x > xx(n))
then
31 dxx(1:n-1)=xx(2:n)-xx(1:n-1)
32 if(minval(dxx(1:n-1)) <= 0.d+0)
then
39 c=((yy(3)-yy(1))/(xx(3)-xx(1))-(yy(2)-yy(1))/(xx(2)-xx(1)))
41 yp1=(yy(2)-yy(1))/(xx(2)-xx(1))-c*(xx(2)-xx(1))
43 c=((yy(n-2)-yy(n))/(xx(n-2)-xx(n))
44 > -(yy(n-1)-yy(n))/(xx(n-1)-xx(n)))
46 ypn=(yy(n-1)-yy(n))/(xx(n-1)-xx(n))-c*(xx(n-1)-xx(n))
48 call spline_int(xx,yy,n,yp1,ypn,y2)
49 call splint_int(xx,yy,y2,n,x,y)
55 subroutine spline_int(x,y,n,yp1,ypn,y2)
66 integer,
intent(in) :: n
67 integer,
parameter :: nmax=500
68 real(rprec),
intent(in) :: yp1, ypn
69 real(rprec),
dimension(n),
intent(in) :: x, y
70 real(rprec),
dimension(n),
intent(out) :: y2
72 real(rprec) :: p, qn, sig, un
73 real(rprec),
dimension(n) :: u
75 if(yp1 > .99d+30)
then
80 u(1)=(3.d+0/(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
84 sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
87 u(i)=(6.d+0*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1))
88 > /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p
90 if (ypn > .99d+30)
then
95 un=(3.d+0/(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
97 y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.d+0)
99 y2(k)=y2(k)*y2(k+1)+u(k)
102 end subroutine spline_int
104 subroutine splint_int(xa,ya,y2a,n,x,y)
110 integer,
intent(in) :: n
111 real(rprec),
intent(in) :: x
112 real(rprec),
intent(out) :: y
113 real(rprec),
dimension(n),
intent(in) :: xa, ya, y2a
115 real(rprec) :: h, c, dx
116 integer :: k, khi, klo
117 real(rprec),
dimension(n) :: dxa,dxa3, dya, dy2a, my2a, mya
122 if (khi-klo <= 1)
exit
131 dxa(1:n-1)=xa(2:n)-xa(1:n-1)
133 dya(1:n-1)=ya(2:n)-ya(1:n-1)
134 mya(1:n-1)=ya(2:n)+ya(1:n-1)
135 dy2a(1:n-1)=y2a(2:n)-y2a(1:n-1)
136 my2a(1:n-1)=y2a(2:n)+y2a(1:n-1)
138 c = .5d+0*dot_product(dxa(1:klo-1),mya(1:klo-1))
139 > -dot_product(dxa3(1:klo-1),my2a(1:klo-1))/24.0d+0
142 > stop
"spline_cubic: bad xa input! xa(i) have to be distinct!"
144 y = ya(klo)*dx +.5d+0*dya(klo)*dx**2/h +
145 > y2a(klo)*dx**2*(2*dx-3*h)/12.d+0 +
146 > dy2a(klo)*dx**2*(dx**2-2*h**2)/(h*24.d+0)
149 end subroutine splint_int
151 end subroutine spline_cubic_int