VB代码有错误,还望大神指正啊!(for循环中数组下标竟然越界)
追赶法求三次样条插值,其中n为全局变量Private Function spline(num As Single) As Single
Dim k As Integer
Dim h() As Single, lamda() As Single, miu() As Single, d() As Single
Dim q() As Single, r() As Single, u() As Single, m() As Single
ReDim h(1 To n) As Single, lamda(0 To n - 1) As Single, miu(1 To n) As Single, d(0 To n) As Single '矩阵中的数组
ReDim q(0 To n) As Single, r(0 To n) As Single, u(0 To n) As Single, m(0 To n) As Single '追赶法求解过程中的数组
If num < x(0) And num > x(n) Then
MsgBox "错误:所输入数据超出插值区间", vbCritical + vbOKOnly
Text6.Text = ""
Text6.SetFocus
End If
For k = 1 To n '基本参数的确定
h(k) = x(k) - x(k - 1)
Next
For k = 1 To (n - 1)
lamda(k) = h(k + 1) / (h(k) + h(k + 1))
miu(k) = 1 - lamda(k)
d(k) = 6 * ((y(k + 1) - y(k)) / h(k + 1) - (y(k) - y(k - 1)) / h(k)) / (h(k) + h(k + 1)) '这个循环中也出现了k=3的情况,n是全局变量
Next
If Option1.Value = True Then '端点条件的判定(两端输入导数值)
d(0) = 6 / h(1) * ((y(1) - y(0)) / h(1) - Val(Text4.Text))
d(n) = 6 / h(n) * (Val(Text5.Text) - (y(n) - y(n - 1)) / h(n))
For k = 1 To (n - 1)
q(0) = 2
lamda(0) = 1
miu(n) = 1
r(0) = lamda(0) / q(0)
u(0) = d(0) / q(0)
q(k) = 2 - miu(k) * r(k - 1) 'L(3)=0
r(k) = lamda(k) / q(k)
u(k) = (d(k) - miu(k) * u(k - 1)) / q(k) '最后k应该是2,但是却是3
Next
q(n) = -miu(n) * r(n - 1) + 2
u(n) = (d(n) - miu(n) * u(n - 1)) / q(n)
m(n) = u(n)
For k = n - 1 To 0 '计算二阶导数数组
m(k) = -r(k) * m(k + 1) + u(k)
Next
Else: m(0) = Val(Text4.Text) ’两端输入二阶导数值
m(n) = Val(Text5.Text)
For k = 1 To n - 1
r(0) = 0
u(0) = 0
q(k) = -miu(k) * r(k - 1) + 2
r(k) = lamda(k) / q(k)
u(k) = (d(k) - miu(k) * u(k - 1)) / q(k)
Next
m(n - 1) = u(n - 1)
For k = n - 2 To 1 '计算M数组(这里的K最后是2而不是1)
m(k) = -r(k) * m(k + 1) + u(k)
Next
End If
For k = 1 To n '参数确定后的计算
If num <= x(k) And num >= x(k - 1) Then
spline = m(k - 1) * ((x(k) - num) ^ 3) / 6 / h(k) + m(k) * ((num - x(k - 1)) ^ 3) / 6 / h(k) + _
(y(k - 1) - m(k - 1) * (h(k) ^ 2) / 6) * (x(k) - num) / h(k) + _
(y(k) - m(k) * (h(k) ^ 2) / 6) * (num - x(k - 1)) / h(k)
Exit For
End If
Next
End Function