哈哈哈,看来还是我无聊啊!哈哈哈哈
'本程序除了系数和初值部分,其余都很容扩展到不同方程组。
'本程序没有排除同构方程(既不定解)的情况。
Const Emp = 0.001, Faint = 0.3, n = 3 '允许误差、松弛系数、方程数(元数)
Dim a(n - 1, n) As Single, Order(n - 1) As Integer
Private Sub Command1_Click()
Dim x(n) As Single, Delta(n) As Single, MaxEmp As Single '初始值、迭代结果、本论最大误差
Dim m As Long
x(0) = 1 '初值
x(1) = 1
x(2) = 1
x(3) = 1 '为常数设置的。
Do
root x(), Delta() '调用松弛求根过程
MaxEmp = 0
For i = 0 To n - 1
x(i) = x(i) - Delta(i) '用松弛结果来修正当前值
If MaxEmp < Abs(Delta(i)) Then MaxEmp = Abs(Delta(i)) '寻出最大修正值
Next i
If m > 100 Then '循环次数过多,即不收敛
MsgBox "给出的初值不合适,请更换一组较为合适的初值,然后重新计算。", vbInformation
Exit Sub
End If
Loop Until MaxEmp < Emp '误差控制成功
For i = 0 To n - 1 '输出结果
Print "X"; Trim(Str(i)); "="; x(i)
Next i
End Sub
Private Sub Form_Load() '这是系数和常数,注意常数要改变符号
a(0, 0) = 2
a(0, 1) = -3
a(0, 2) = 1
a(0, 3) = -8
a(1, 0) = 1
a(1, 1) = 1
a(1, 2) = 6
a(1, 3) = -69
a(2, 0) = 12
a(2, 1) = 1
a(2, 2) = 2
a(2, 3) = -12
'把较大的系数交换到主对角线上,否则会不收敛
For i = 0 To n - 2
For j = i + 1 To n - 1
If Abs(a(i, i)) < Abs(a(j, i)) Then
For k = 0 To n
temp = a(i, k)
a(i, k) = a(j, k)
a(j, k) = temp
Next k
End If
Next j
Next i
End Sub
Private Sub root(x0() As Single, Delta() As Single)
Dim EquVal As Single
For i = 0 To n - 1
EquVal = 0
For j = 0 To n
EquVal = EquVal + a(i, j) * x0(j)
Next j
Delta(i) = EquVal / a(i, i) * Faint
Next i
End Sub