zroots.txt

用于开发税务票据管理的软件

Procedure ZROOTS(A:matrx2; M:integer;var ROOTS:matrx2; POLISH:boolean);
const
    EPS = 0.1e-5;
var
    AD:matrx2;
    X, B, C, DUM:array[0..2] of real;
    I,J,JJ:integer;   DUM1:real;
begin
    SetLength(AD,3,102);
    For J:=1 To M + 1 do
    begin
        AD[1, J]:=A[1, J];
        AD[2, J]:=A[2, J];
    end; 
    For J:=M DownTo 1 do
    begin
        X[1]:=0;
        X[2]:=0;
        LAGUER(AD, J, X, EPS, false);
        If Abs(X[2]) <= 2 * Sqr(EPS) * 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 DownTo 1 do
        begin
            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];
        end; 
    end;
    If POLISH Then
    begin
        For J:=1 To M do
        begin
            DUM[1]:=ROOTS[1, J];
            DUM[2]:=ROOTS[2, J];
            LAGUER(A, M, DUM, EPS, true);
        end;
    end;
    For J:=2 To M do
    begin
        X[1]:=ROOTS[1, J];
        X[2]:=ROOTS[2, J];
        For I:=J - 1 DownTo 1 do
        begin
            If ROOTS[1, I] <= X[1] Then BREAK;
            ROOTS[1, I + 1]:=ROOTS[1, I];
            ROOTS[2, I + 1]:=ROOTS[2, I];
        end; 
        If ROOTS[1, I] > X[1] Then I:=0;
        ROOTS[1, I + 1]:=X[1];
        ROOTS[2, I + 1]:=X[2];
    end; 
end;