tqli.txt

用VB实现矩阵特征值的求解算法集。包括：对称矩阵的雅可比变换

Sub TQLI(D(), E(), N, Z())
    If N > 1 Then
        For I = 2 To N
            E(I - 1) = E(I)
        Next I
        E(N) = 0#
        For L = 1 To N
            ITER = 0
1           For M = L To N - 1
                DD = Abs(D(M)) + Abs(D(M + 1))
                If Abs(E(M)) + DD = DD Then GoTo 2
            Next M
            M = N
2           If M <> L Then
                If ITER = 30 Then Print " too many iterations "
                ITER = ITER + 1
                G = (D(L + 1) - D(L)) / (2# * E(L))
                R = Sqr(G ^ 2 + 1#)
                G = D(M) - D(L) + E(L) / (G + Abs(R) * Sgn(G))
                S = 1#
                C = 1#
                P = 0#
                For I = M - 1 To L Step -1
                    F = S * E(I)
                    B = C * E(I)
                    If Abs(F) >= Abs(G) Then
                        C = G / F
                        R = Sqr(C ^ 2 + 1#)
                        E(I + 1) = F * R
                        S = 1# / R
                        C = C * S
                    Else
                        S = F / G
                        R = Sqr(S ^ 2 + 1#)
                        E(I + 1) = G * R
                        C = 1# / R
                        S = S * C
                    End If
                    G = D(I + 1) - P
                    R = (D(I) - G) * S + 2# * C * B
                    P = S * R
                    D(I + 1) = G + P
                    G = C * R - B
                    'Omit lines from here ...
                    For K = 1 To N
                        F = Z(K, I + 1)
                        Z(K, I + 1) = S * Z(K, I) + C * F
                        Z(K, I) = C * Z(K, I) - S * F
                    Next K
                   'to here when finding only eigenvalues.
                Next I
                D(L) = D(L) - P
                E(L) = G
                E(M) = 0#
                GoTo 1
            End If
       Next L
    End If
End Sub