subsolution.bas

方程组解算,根据系数矩阵,解出方程组中x的坐标

Attribute VB_Name = "SubSolution"
Dim c As Double
'高斯消元法－消元
Sub GS1(m As Integer)
For k = 1 To m - 1
    For i = k + 1 To m
       c = a(i, k) / a(k, k)
       For j = k + 1 To m
            a(i, j) = a(i, j) - c * a(k, j)
        Next j
        b(i) = b(i) - b(k) * c
    Next i
Next k
 End Sub
'高斯消元法—回代
Sub cy1(m As Integer)
For i = m To 1 Step -1
    c = 0
    For k = i + 1 To m
        c = c + a(i, k) * b(k)
    Next k
    b(i) = (b(i) - c) / a(i, i)
   Next i
End Sub

'对称方程组，高斯消元法－消元
Sub Gs2(m As Integer)
For i = 1 To m
    For j = i To m
        For k = 1 To i - 1
             a(i, j) = a(i, j) - a(k, i) / a(k, k) * a(k, j)
        Next k
     Next j
Next i
For i = 1 To m
         For k = 1 To i - 1
             b(i) = b(i) - b(k) / a(k, k) * a(k, i)
        Next k
Next i
End Sub
'列主元消元法
Sub GS4(m As Integer)
Dim T As Double
Dim I0 As Integer
Dim c As Double
For k = 1 To m - 1
    c = 0#
'    I0 = K
    For i = k To m
       If Abs(a(i, k)) > Abs(c) Then
          c = a(i, k)
          I0 = i
       End If
    Next i
    If I0 = k Then GoTo 30
    For j = k To m
       T = a(k, j)
       a(k, j) = a(I0, j)
       a(I0, j) = T
    Next j
    T = b(k)
    b(k) = b(I0)
    b(I0) = T
30:
    For i = k + 1 To m
       c = a(i, k) / a(k, k)
       For j = k + 1 To m
            a(i, j) = a(i, j) - c * a(k, j)
       Next j
       b(i) = b(i) - b(k) * c
    Next i
Next k
End Sub

Sub Main()
   Call GS1(g_EquNum)
   Call cy1(g_EquNum)
   For i = 1 To g_EquNum
       FrmVerDataInput2.Grid3.Col = 1
       FrmVerDataInput2.Grid3.Row = i
       FrmVerDataInput2.Grid3.Text = Str(Int(b(i) * 100000 + 0.5) / 100000#)
   Next i
End Sub