gaussjordan.txt

用ＶＢ编写的Ｇａｕｓｓ－Ｊｏｒｄａｎ全主元消去法

Sub GAUSSJ(A(), N, B())
    Dim IPIV(50), INDXR(50), INDXC(50)
    For J = 1 To N
        IPIV(J) = 0
    Next J
    For I = 1 To N
        BIG = 0#
        For J = 1 To N
            If IPIV(J) <> 1 Then
                For K = 1 To N
                If IPIV(K) = 0 Then
                    If Abs(A(J, K)) >= BIG Then
                        BIG = Abs(A(J, K))
                        IROW = J
                        ICOL = K
                    End If
                ElseIf IPIV(K) > 1 Then
                    Print "Singular matrix"
                End If
                Next K
            End If
        Next J
        IPIV(ICOL) = IPIV(ICOL) + 1
        If IROW <> ICOL Then
            For L = 1 To N
                DUM = A(IROW, L)
                A(IROW, L) = A(ICOL, L)
                A(ICOL, L) = DUM
            Next L
            DUM = B(IROW)
            B(IROW) = B(ICOL)
            B(ICOL) = DUM
        End If
        INDXR(I) = IROW
        INDXC(I) = ICOL
        If A(ICOL, ICOL) = 0# Then Print "Singular matrix."
        PIVINV = 1# / A(ICOL, ICOL)
        A(ICOL, ICOL) = 1#
        For L = 1 To N
            A(ICOL, L) = A(ICOL, L) * PIVINV
        Next L
        B(ICOL) = B(ICOL) * PIVINV
        For LL = 1 To N
            If LL <> ICOL Then
                DUM = A(LL, ICOL)
                A(LL, ICOL) = 0#
                For L = 1 To N
                    A(LL, L) = A(LL, L) - A(ICOL, L) * DUM
                Next L
                B(LL) = B(LL) - B(ICOL) * DUM
            End If
        Next LL
    Next I
    For L = N To 1 Step -1
        If INDXR(L) <> INDXC(L) Then
            For K = 1 To N
                DUM = A(K, INDXR(L))
                A(K, INDXR(L)) = A(K, INDXC(L))
                A(K, INDXC(L)) = DUM
            Next K
        End If
    Next L
End Sub