程序

ReDim a(p, p + 1), F(p, n), Q(100), c(n)
ER1 = 0.001
ER2 = 0.00001
m = 80: d = 10: H = 0.0001: t = 0: Max = 100
Do While Max > ER1
s3 = 0
For i = 1 To n
hanshu X, k, ff, i
c(i) = ff
For j = 1 To p
k(j) = k(j) + H
hanshu X, k, ff, i
F(j, i) = (ff - c(i)) / H
k(j) = k(j) - H
Next j
s3 = s3 + (c(i) - Y(i)) ^ 2
Next i
Q(t) = Sqr(s3)
If t > 0 Then
If Abs(Q(t) - Q(t - 1)) < ER2 Or t > m Then Exit Do
If Q(t) < Q(t - 1) Then d = d / 2 Else d = d * 3
End If
For i = 1 To p
For j = 1 To p
a(i, j) = 0
For kk = 1 To n
a(i, j) = a(i, j) + F(i, kk) * F(j, kk)
Next kk
Next j
a(i, p + 1) = 0
For kk = 1 To n
a(i, p + 1) = a(i, p + 1) + F(i, kk) * (Y(kk) - c(kk))
Next kk
a(i, i) = a(i, i) + d
Next i
高斯解方程组主程序 a, p
Max = 0
For i = 1 To p
If Abs(a(i, p + 1) * k(i)) > Max Then Max = Abs(a(i, p + 1) * k(i))
Next i
For i = 1 To p
k(i) = k(i) + a(i, p + 1)
Next i
t = t + 1
Loop
End Sub
Public Sub hanshu(X, k, ff, i)
ff = 100 * k(1) * X(i) ^ k(2) / (1 + k(1) * X(i) ^ k(2))
End Sub
Public Sub 高斯解方程组主程序(a, p)
For j = 1 To p
If a(j, j) <> 0 Then GoTo L2
For i = j To p
If a(i, j) <> 0 Then GoTo L1
Next i
MsgBox "方程组无解,求解失败!", , "解的情况"
End
L1: For kk = j To p + 1
b = a(j, kk)
a(j, kk) = a(i, kk)
a(i, kk) = b
Next kk
L2: cc = 1 / a(j, j)
For i = j To p + 1
a(j, i) = cc * a(j, i)
Next i
For i = 1 To p
If i <> j Then
cc = a(i, j)
For S = j To p + 1
a(i, S) = a(i, S) - cc * a(j, S)
Next S
End If
Next i
Next j
End Su