Pascal Code

    procedure FixedPoint({function G(X:real):real;}
                            var Pterm:real; Max:integer; Tol:real;
                            var Pnew:real; var Cond,Kcount:integer);
    label 999;
    const Big = 1E10; Small = 1E-20;
    var Dx,Dg,Pold,RelErr,Slope:real;
    begin
        RelErr := 1;
        Pnew := G(Pterm);
        Kcount := 0;
        while ((RelErr>=Tol) and (KCount<=Max)) do
            begin
                if Kcount <= 2 then P[Kcount] := Pterm;
                Pold := Pterm;
                Pterm := Pnew;
                Pnew := G(Pterm);
                Dg := Pnew - Pterm;
                RelErr := ABS(Dg)/(ABS(Pnew)+Small);
                Kcount := Kcount+1;
                if (Pnew < -Big) or (Big < Pnew) then goto 999;
            end;
        999:
        if Kcount <= 2 then P[Kcount] := Pterm;
        if Dg = 0 then
            Slope := 0
        else
            begin
                Dx := Pterm - Pold;
                if Dx <> 0 then
                    Slope := Dg/Dx
                else
                    Slope := 6.023E23;
            end;
        if ABS(Slope) < 1 then
            begin
                Cond := 1;
                if Slope < 0 then Cond := 2;
            end
        else
            begin
                Cond := 3;
                if Slope < 0 then Cond := 4;
            end;
        if RelErr < Tol then
         if (Cond = 3) or (Cond = 4) then Cond := 5;
        Kcount := Kcount+1;
    end;

(c) John H. Mathews 2004