com_sub.bas

解方程组的程序VB

Attribute VB_Name = "Com_Sub"
Sub INVERSE1(M As Integer)
Dim c As Double
For K = 1 To M
   For I = 1 To M
     If I <> K Then
       c = A(I, K) / A(K, K)
       For J = 1 To 2 * M + 1
         A(I, J) = A(I, J) - c * A(K, J)
       Next J
     End If
   Next I
Next K
For K = 1 To M
   c = A(K, K)
   For J = 1 To 2 * M + 1
     A(K, J) = A(K, J) / c
   Next J
Next K
End Sub

Sub INVERSE2(M As Integer)
For K = 1 To M
  For I = 1 To M
    If I <> K Then
      For J = 1 To M + 1
        c = A(I, K) / A(K, K)
        If J <> K Then
          A(I, J) = A(I, J) - c * A(K, J)
        End If
      Next J
    End If
  Next I
  For I = 1 To M
    If (I <> K) Then
       A(I, K) = -A(I, K) / A(K, K)
    End If
  Next I
  For J = 1 To M + 1
    If (J <> K) Then
       A(K, J) = A(K, J) / A(K, K)
    End If
  Next J
  A(K, K) = 1 / A(K, K)
Next K
End Sub
Sub InvZuQu(M As Integer)
    Dim L1(5, 5) As Double
    Dim L2(5, 5) As Double
    Dim TT As Double
       For I = 1 To M
            For J = 1 To M
                If (I = J) Then
                     L1(I, J) = 1#
                Else
                     L1(I, J) = 0#
                End If
            Next J
        Next I
        For K = 1 To M
            For L = K To M
                If (Abs(A(K, K)) < Abs(A(L, K))) Then
                    For M = 1 To M
                        T = A(K, M)
                        A(K, M) = A(L, M)
                        TT = L1(K, M)
                        L1(K, M) = L1(L, M)
                        L1(L, M) = TT
                        A(L, M) = T
                    Next M
                End If
            Next L
            For I = 1 To M
                If I < K Or I > K Then
                    L2(I, K) = A(I, K) / A(K, K)
                    For J = 1 To M
                        A(I, J) = A(I, J) - L2(I, K) * A(K, J)
                        L1(I, J) = L1(I, J) - L2(I, K) * L1(K, J)
                    Next J
                End If
            Next I
        Next K
        For I = 1 To M
            For J = 1 To M
                L1(I, J) = L1(I, J) / A(I, I)
            Next J
        Next I
        For I = 1 To M
            For J = 1 To M
                A(I, J) = L1(I, J)
            Next J
        Next I
End Sub

Sub InvSqr1()
        Dim Ss As Double
        For I = 1 To M
             DI = (I - 1) * (M - I / 2#)
             For J = I To M
                     Ss = c(DI + J)
                     For K = 1 To I - 1
                             Dk = (K - 1) * (M - K / 2#)
                             Ss = Ss - c(Dk + I) * c(Dk + J) / c(Dk + K)
                     Next K
                     If J = I Then
                          c(DI + J) = 1 / Ss
                     Else
                          c(DI + J) = Ss * c(DI + I)
                     End If
             Next J
        Next I
        For I = 1 To M - 1
             DI = (I - 1) * (M - I / 2#)
             For J = I + 1 To M
                 Ss = -c(DI + J)
                 For K = I + 1 To J - 1
                        Dk = (K - 1) * (M - K / 2#)
                        Ss = Ss - c(DI + K) * c(Dk + J)
                 Next K
                 c(DI + J) = Ss
             Next J
        Next I
        For I = 1 To M - 1
             DI = (I - 1) * (M - I / 2#)
             For J = I To M
                     DJ = (J - 1) * (M - J / 2#)
                     If (I = J) Then
                          Ss = c(DI + J)
                     Else
                          Ss = c(DI + J) * c(DJ + J)
                     End If
                     For K = J + 1 To M
                            Dk = (K - 1) * (M - K / 2#)
                            Ss = Ss + c(DI + K) * c(DJ + K) * c(Dk + K)
                     Next K
                     c(DI + J) = Ss
             Next J
        Next I
End Sub


Sub Main1()
  For I = 1 To g_EquNum
     A(I, g_EquNum + 1) = B(I)
     For J = 1 To g_EquNum
       If I = J Then
          A(I, g_EquNum + 1 + J) = 1#
       Else
          A(I, g_EquNum + 1 + J) = 0#
       End If
     Next J
  Next I
  Call INVERSE1(g_EquNum)
  For I = 1 To g_EquNum
       FrmVerDataInput2.Grid3.Col = 1
       FrmVerDataInput2.Grid3.Row = I
       FrmVerDataInput2.Grid3.Text = Str(A(I, g_EquNum + 1))
  Next I
  For I = 1 To g_EquNum
     FrmVerDataInput2.Grid1.Row = I
     For J = 1 To g_EquNum
       FrmVerDataInput2.Grid1.Col = J
       FrmVerDataInput2.Grid1.Text = Str(A(I, g_EquNum + 1 + J))
     Next J
  Next I
End Sub