com_sub.bas

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

Attribute VB_Name = "Com_Sub"
Sub INVERSE1(m As Integer)
Dim c As Double
For i = 1 To m
   For j = 1 To m
     If i = j Then
        Q(i, j) = 1
     Else
        Q(i, j) = 0
     End If
     a1(i, j) = a(i, j)
   Next j
Next i
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 m
         a(i, j) = a(i, j) - c * a(k, j)
         Q(i, j) = Q(i, j) - c * Q(k, j)
       Next j
     End If
   Next i
Next k
For i = 1 To m
   c = a(i, i)
   For j = 1 To m
     a(i, j) = a(i, j) / c
     Q(i, j) = Q(i, j) / c
   Next j
Next i
For i = 1 To m
   For j = 1 To m
      a(i, j) = 0
      For k = 1 To m
         a(i, j) = a(i, j) + a1(i, k) * Q(k, j)
      Next k
   Next j
Next i

End Sub

Sub INVERSE2(m As Integer)
For i = 1 To m
   For j = 1 To m
     a1(i, j) = a(i, j)
   Next j
Next i
For k = 1 To m
  For i = 1 To m
    If i <> k Then
      For j = 1 To m
        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
    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
For i = 1 To m
   For j = 1 To m
     Q(i, j) = a(i, j)
   Next j
Next i
For i = 1 To m
   For j = 1 To m
      a(i, j) = 0
      For k = 1 To m
         a(i, j) = a(i, j) + a1(i, k) * Q(k, j)
      Next k
   Next j
Next i

End Sub
Sub InvZuQu(m As Integer)
    Dim c As Double
    Dim TT As Double
       For i = 1 To m
            For j = 1 To m
                If (i = j) Then
                     Q(i, j) = 1#
                Else
                     Q(i, j) = 0#
                End If
                a1(i, j) = a(i, j)
            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 n = 1 To m
                        T = a(k, n)
                        a(k, n) = a(L, n)
                        TT = Q(k, n)
                        Q(k, n) = Q(L, n)
                        Q(L, n) = TT
                        a(L, n) = T
                    Next n
                End If
            Next L
            For i = 1 To m
                If i < k Or i > k Then
                    c = a(i, k) / a(k, k)
                    For j = 1 To m
                        a(i, j) = a(i, j) - c * a(k, j)
                        Q(i, j) = Q(i, j) - c * Q(k, j)
                    Next j
                End If
            Next i
        Next k
        For i = 1 To m
            For j = 1 To m
                Q(i, j) = Q(i, j) / a(i, i)
            Next j
        Next i
        For i = 1 To m
           For j = 1 To m
             a(i, j) = 0
             For k = 1 To m
                a(i, j) = a(i, j) + a1(i, k) * Q(k, j)
             Next k
           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()
  Call InvZuQu(g_EquNum)
    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, j))
     Next j
  Next i
End Sub