d8r1.txt

VB常用数值算法集 内含有解线性代数方程组

Private Sub Command1_Click()
    'PROGRAM D8R1
    'Driver for routine JACOBI
    NP = 3
    Dim D(3), V(3, 3), R(3)
    Dim A(3, 3), E(3, 3)
    A(1, 1) = 1#: A(1, 2) = 2#: A(1, 3) = 3#
    A(2, 1) = 2#: A(2, 2) = 2#: A(2, 3) = 3#
    A(3, 1) = 3#: A(3, 2) = 3#: A(3, 3) = 3#
    For II = 1 To 3
        For JJ = 1 To 3
            E(II, JJ) = A(II, JJ)
        Next JJ
    Next II
    Call JACOBI(E(), NP, D(), V(), NROT)
    Print Tab(5); "Number of JACOBI rotations:  "; NROT
    Print Tab(5); " Eigenvalues:"
    For J = 1 To NP
        Print Tab(7); Format$(D(J), "#0.######")
    Next J
    Print
    Print Tab(5); " Eigenvectors:"
    For J = 1 To NP
        Print Tab(5); "Number  "; J
        For K = 1 To NP
            Print Tab(5 + (K - 1) * 15); Format$(V(K, J), "##.#####0");
        Next K
        Print
    Next J
    Print
    'Eigenvector test
    Print Tab(5); " Eigenvector Test"
    For J = 1 To NP
        For L = 1 To NP
            R(L) = 0#
            For K = 1 To NP
               If K > L Then
                    KK = L
                    LL = K
                Else
                    KK = K
                    LL = L
                End If
                R(L) = R(L) + A(LL, KK) * V(K, J)
            Next K
        Next L
        Print
        Print Tab(5); " Vector Number", J
        Print
        Print Tab(5); "    Vector     Mtrx*Vec.    Ratio"
        For L = 1 To NP
            RATIO = R(L) / V(L, J)
            Print Tab(5); Format$(V(L, J), "#.#####0"),
            Print Tab(20); Format$(R(L), "#.#####0"),
            Print Tab(35); Format$(RATIO, "#.#####0")
        Next L
    Next J
End Sub