mnbrak.txt

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

Procedure MNBRAK(var AX, BX, CX, FA, FB, FC:real);
const
    GOLD = 1.618034;  GLIMIT = 100;  TINY = 1E-20;
var 
    DUM,R,Q,U,ULIM,FU:real;   DONE:boolean;
begin
    FA:=FUNC(AX);
    FB:=FUNC(BX);
    If FB > FA Then
    begin
        DUM:=AX;
        AX:=BX;
        BX:=DUM;
        DUM:=FB;
        FB:=FA;
        FA:=DUM;
    end;
    CX:=BX + GOLD * (BX - AX);
    FC:=FUNC(CX);
    repeat
        If FB < FC Then break;
        DONE:=true;
        R:=(BX - AX) * (FB - FC);
        Q:=(BX - CX) * (FB - FA);
        DUM:=Q - R;
        If Abs(DUM) < TINY Then DUM:=TINY;
        U:=BX - ((BX - CX) * Q - (BX - AX) * R) / (2 * DUM);
        ULIM:=BX + GLIMIT * (CX - BX);
        If (BX - U) * (U - CX) > 0  Then
        begin
            FU:=FUNC(U);
            If FU < FC Then
            begin
                AX:=BX;
                FA:=FB;
                BX:=U;
                FB:=FU;
                Exit;
            end
            Else If FU > FB Then
            begin
                CX:=U;
                FC:=FU;
                Exit;
            end;
            U:=CX + GOLD * (CX - BX);
            FU:=FUNC(U);
        end
        Else If (CX - U) * (U - ULIM) > 0  Then
        begin
            FU:=FUNC(U);
            If FU < FC Then
            begin
                BX:=CX;
                CX:=U;
                U:=CX + GOLD * (CX - BX);
                FB:=FC;
                FC:=FU;
                FU:=FUNC(U);
            end;
        end
        Else If (U - ULIM) * (ULIM - CX) >= 0  Then
        begin
            U:=ULIM;
            FU:=FUNC(U);
        end
        Else
        begin
            U:=CX + GOLD * (CX - BX);
            FU:=FUNC(U);
        end;
        If DONE Then
        begin
            AX:=BX;
            BX:=CX;
            CX:=U;
            FA:=FB;
            FB:=FC;
            FC:=FU;
        end
        Else
            DONE:=false;
    until not DONE
end;