zroots.txt

常用的数值算法的VB程序

Sub ZROOTS(A(), M, ROOTS(), POLISH%)
    EPS = 0.000001
    Dim AD(2, 101), X(2), B(2), C(2), DUM(2)
    For J = 1 To M + 1
        AD(1, J) = A(1, J)
        AD(2, J) = A(2, J)
    Next J
    For J = M To 1 Step -1
        X(1) = 0
        X(2) = 0
        Call LAGUER(AD(), J, X(), EPS, 0)
        If Abs(X(2)) <= 2# * EPS ^ 2 * Abs(X(1)) Then X(2) = 0
        ROOTS(1, J) = X(1)
        ROOTS(2, J) = X(2)
        B(1) = AD(1, J + 1)
        B(2) = AD(2, J + 1)
        For JJ = J To 1 Step -1
            C(1) = AD(1, JJ)
            C(2) = AD(2, JJ)
            AD(1, JJ) = B(1)
            AD(2, JJ) = B(2)
            DUM1 = B(1)
            B(1) = X(1) * DUM1 - X(2) * B(2) + C(1)
            B(2) = X(2) * DUM1 + X(1) * B(2) + C(2)
        Next JJ
    Next J
    If POLISH% Then
        For J = 1 To M
            DUM(1) = ROOTS(1, J)
            DUM(2) = ROOTS(2, J)
            Call LAGUER(A(), M, DUM(), EPS, -1)
        Next J
    End If
    For J = 2 To M
        X(1) = ROOTS(1, J)
        X(2) = ROOTS(2, J)
        For I = J - 1 To 1 Step -1
            If ROOTS(1, I) <= X(1) Then Exit For
            ROOTS(1, I + 1) = ROOTS(1, I)
            ROOTS(2, I + 1) = ROOTS(2, I)
        Next I
        If ROOTS(1, I) > X(1) Then I = 0
        ROOTS(1, I + 1) = X(1)
        ROOTS(2, I + 1) = X(2)
    Next J
    Erase DUM, C, B, X, AD
End Sub