frprmn.txt

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

Procedure FRPRMN(var P:array of real; N:integer;
                           FTOL:real;var ITER:integer; var FRET:real);
const
    ITMAX = 200;  EPS = 0.1e-9;
var
    G:array[0..550] of real; H,XI:array[0..50] of real;
    J,ITS,ITC:integer;    FP,GG,DGG,GAM:real;
begin
    FP:=FUNC2(P, N);
    DFUNC(P, XI);
    For J:=1 To N do
    begin
        G[J]:=-XI[J];
        H[J]:=G[J];
        XI[J]:=H[J];
    end;
    For ITS:=1 To ITMAX do
    begin
        ITER:=ITS;
        LINMIN(P, XI, N, FRET);
        If 2 * Abs(FRET - FP) <= FTOL * (Abs(FRET) + Abs(FP) + EPS) Then
            exit;
        FP:=FUNC2(P, N);
        DFUNC(P, XI);
        GG:=0;
        DGG:=0; 
        For J:=1 To N do
        begin
            GG:=GG + Sqr(G[J]);
            //DGG:=DGG + Sqr(XI[J]);  //Polak-Ribiere 法
            DGG:=DGG + (XI[J] + G[J]) * XI[J];  //Fletcher-Reeves 法
        end; 
        If GG = 0  Then exit;
        GAM:=DGG / GG;
        For J:=1 To N do
        begin
            G[J]:=-XI[J];
            H[J]:=G[J] + GAM * H[J];
            XI[J]:=H[J];
        end;
    end;
    If ITC > ITMAX Then ShowMessage('FRPR maximum iterations exceeded');
end;