qroot.txt

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

Sub QROOT(P(), N, B, C, EPS)
    ITMAX = 20
    TINY = 0.000001
    Dim Q(20), D(3), REM1(20), QQ(20)
    D(3) = 1#
    For ITER = 1 To ITMAX
        D(2) = B
        D(1) = C
        Call POLDIV(P(), N, D, 3, Q(), REM1())
        S = REM1(1)
        R = REM1(2)
        Call POLDIV(Q(), N - 1, D, 3, QQ(), REM1())
        SC = -REM1(1)
        RC = -REM1(2)
        For I = N - 1 To 1 Step -1
            Q(I + 1) = Q(I)
        Next I
        Q(1) = 0#
        Call POLDIV(Q(), N, D, 3, QQ(), REM1())
        SB = -REM1(1)
        RB = -REM1(2)
        DIV = 1# / (SB * RC - SC * RB)
        DELB = (R * SC - S * RC) * DIV
        DELC = (-R * SB + S * RB) * DIV
        B = B + DELB
        C = C + DELC
        DB = Abs(DELB) - EPS * Abs(B)
        DC = Abs(DELC) - EPS * Abs(C)
        If (DB <= 0# Or Abs(B) < TINY) And (DC <= 0 Or Abs(C) < TINY) Then
            Erase QQ, REM1, D, Q
            Exit Sub
        End If
    Next ITER
    Print "too many iterations in QROOT"
End Sub