subsolution.bas

解方程组的程序VB

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 GS4(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