Sub Ex_Bsplvd()
Const Ndata = 4
Dim X(Ndata - 1) As Double, Y(Ndata - 1) As Double, Xe As Double
Dim Ibcl As Long, Ibcr As Long, Fbcl As Double, Fbcr As Double, Kntopt As Long
Dim T(Ndata + 5) As Double, Bcoef(Ndata + 1) As Double, N As Long, K As Long
Dim Vnikx() As Double, F As Double, Df As Double
Dim Nderiv As Long, Ilo As Long, Ileft As Long, Info As Long, I As Long
'-- Data
X(0) = 0.1: Y(0) = -2.3026
X(1) = 0.11: Y(1) = -2.2073
X(2) = 0.12: Y(2) = -2.1203
X(3) = 0.13: Y(3) = -2.0402
'-- B-representation of cubic spline interpolation
Ibcl = 2: Fbcl = 0: Ibcr = 2: Fbcr = 0 '-- Natural spline
Kntopt = 1
Call Bint4(X(), Y(), Ndata, Ibcl, Ibcr, Fbcl, Fbcr, Kntopt, T(), Bcoef(), N, K, Info)
If Info <> 0 Then
Debug.Print "Error in Bint4: Info =", Info
Exit Sub
End If
'-- Compute basis function values by Bsplvd
Xe = 0.115
Ilo = 1
Call Interv(T(), N + K, Xe, Ilo, Ileft, Info)
If Ileft > N Then Ileft = N
Nderiv = 2
ReDim Vnikx(K - 1, Nderiv - 1)
Call Bsplvd(T(), K, Nderiv, Xe, Ileft, Vnikx(), Info)
If Info <> 0 Then
Debug.Print "Error in Bsplvd: Info =", Info
Exit Sub
End If
'-- Compute interpolated value
F = 0: Df = 0
For I = 0 To K - 1
F = F + Bcoef(Ileft - K + I) * Vnikx(I, 0)
Df = Df + Bcoef(Ileft - K + I) * Vnikx(I, 1)
Next
Debug.Print "ln(" + CStr(Xe) + ") =", F, "ln'(" + CStr(Xe) + ") =", Df
Debug.Print "Info =", Info
End Sub