4 SUBROUTINE fvn_akima(n,x,y,br,co)
7 INTEGER,
INTENT(in) :: n
8 REAL(rprec),
INTENT(in) :: x(n)
9 REAL(rprec),
INTENT(in) :: y(n)
10 REAL(rprec),
INTENT(out) :: br(n)
11 REAL(rprec),
INTENT(out) :: co(4,n)
13 REAL(rprec),
ALLOCATABLE :: var(:),z(:)
14 REAL(rprec) :: wi_1,wi
25 var(i+2)=(y(i+1)-y(i))/(x(i+1)-x(i))
27 var(n+2)=2.d0*var(n+1)-var(n)
28 var(n+3)=2.d0*var(n+2)-var(n+1)
29 var(2)=2.d0*var(3)-var(4)
30 var(1)=2.d0*var(2)-var(3)
33 wi_1=abs(var(i+3)-var(i+2))
34 wi=abs(var(i+1)-var(i))
35 IF ((wi_1+wi) .EQ. 0.d0)
THEN
36 z(i)=(var(i+2)+var(i+1))/2.d0
38 z(i)=(wi_1*var(i+1)+wi*var(i+2))/(wi_1+wi)
48 co(3,i)=(3.d0*var(i+2)-2.d0*z(i)-z(i+1))/dx
49 co(4,i)=(z(i)+z(i+1)-2.d0*var(i+2))/dx**2
61 FUNCTION fvn_spline_eval(x,n,br,co)
65 REAL(rprec) fvn_spline_eval
66 REAL(rprec),
INTENT(in) :: x
68 INTEGER,
INTENT(in) :: n
69 REAL(rprec),
INTENT(in) :: br(n+1)
70 REAL(rprec),
INTENT(in) :: co(4,n+1)
71 REAL(rprec) :: fvn_d_spline_eval
79 ELSE IF (x>=br(n+1))
THEN
90 fvn_spline_eval=co(1,i)+co(2,i)*dx+co(3,i)*dx**2+co(4,i)*dx**3
92 END FUNCTION fvn_spline_eval
95 FUNCTION fvn_spline_devaldx(x,n,br,co)
99 REAL(rprec) fvn_spline_devaldx
100 REAL(rprec),
INTENT(in) :: x
102 INTEGER,
INTENT(in) :: n
103 REAL(rprec),
INTENT(in) :: br(n+1)
104 REAL(rprec),
INTENT(in) :: co(4,n+1)
105 REAL(rprec) :: fvn_d_spline_eval
113 ELSE IF (x>=br(n+1))
THEN
124 fvn_spline_devaldx=co(2,i)+2*co(3,i)*dx+3*co(4,i)*dx**2
126 END FUNCTION fvn_spline_devaldx
128 FUNCTION fvn_spline_d2evaldx2(x,n,br,co)
132 REAL(rprec) fvn_spline_d2evaldx2
133 REAL(rprec),
INTENT(in) :: x
135 INTEGER,
INTENT(in) :: n
136 REAL(rprec),
INTENT(in) :: br(n+1)
137 REAL(rprec),
INTENT(in) :: co(4,n+1)
145 ELSE IF (x>=br(n+1))
THEN
156 fvn_spline_d2evaldx2=2*co(3,i)+6*co(4,i)*dx
158 END FUNCTION fvn_spline_d2evaldx2