d8r4.txt

来自「VB常用数值算法集 内含有解线性代数方程组」· 文本 代码 · 共 43 行

Private Sub Command1_Click()
    'PROGRAM D8R4
    'Driver for routine TQLI
    NP = 3
    TINY = 0.000001
    Dim A(3, 3), C(3, 3), D(3), E(3), F(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 I = 1 To NP
        For J = 1 To NP
            C(I, J) = A(I, J)
        Next J
    Next I
    Call TRED2(C(), NP, D(), E())
    Call TQLI(D(), E(), NP, C())
    Print
    Print Tab(5); " Eigenvectors for a real symmetric matrix"
    For I = 1 To NP
        For J = 1 To NP
            F(J) = 0#
            For K = 1 To NP
                F(J) = F(J) + A(J, K) * C(K, I)
            Next K
        Next J
        Print
        Print Tab(5); " Eigenvalue "; I; "= ";
        Print Format$(D(I), "0.000000")
        Print
        Print Tab(5); " Vector     Mtrx*vect.    Ratio"
        For J = 1 To NP
            If Abs(C(J, I)) < TINY Then
              Print Tab(5); Format$(C(J, I), "#.000000"),
              Print Format$(F(J), "#.000000"),
              Print "div. by 0"
            Else
              Print Tab(5); Format$(C(J, I), "#.000000"),
              Print Format$(F(J), "#.000000"),
              Print Format$(F(J) / C(J, I), "0.000000")
            End If
        Next J
    Next I
End Sub