rtsafe.txt

《Delphi常用数值算法集》的配书源码

Function RTSAFE(X1, X2, XACC:real):real;
Label 99;
var
    J,MAXIT:integer;
    FL,FH,F,XL,XH,SWAP,DX,DF,DXOLD,RTS,DUM,TEMP:real;
begin
    MAXIT:=100;
    FUND(X1, FL, DF);
    FUND(X2, FH, DF);
    If FL * FH >= 0 Then ShowMessage('root must be bracketed');
    If FL < 0 Then
    begin
        XL:=X1;
        XH:=X2;
    end
    Else
    begin
        XH:=X1;
        XL:=X2;
        SWAP:=FL;
        FL:=FH;
        FH:=SWAP;
    end;
    RTS:=0.5 * (X1 + X2);
    DXOLD:=Abs(X2 - X1);
    DX:=DXOLD;
    FUND(RTS, F, DF);
    For J:=1 To MAXIT do
    begin
        DUM:=(RTS - XH) * DF - F * ((RTS - XL) * DF - F);
        If (DUM >= 0) Or (Abs(2 * F) > Abs(DXOLD * DF)) Then
        begin
            DXOLD:=DX;
            DX:=0.5 * (XH - XL);
            RTS:=XL + DX;
            If XL = RTS Then goto 99;
        end
        Else
        begin
            DXOLD:=DX;
            DX:=F / DF;
            TEMP:=RTS;
            RTS:=RTS - DX;
            If TEMP = RTS Then goto 99;
        end;
        If Abs(DX) < XACC Then goto 99;
        FUND(RTS, F, DF);
        If F < 0 Then
        begin
            XL:=RTS;
            FL:=F;
        end
        Else
        begin
            XH:=RTS;
            FH:=F;
        end;
    end; 
    ShowMessage('RTSAFE exceeding maximum iterations.');
99: RTSAFE:=RTS;
end;