Pascal Code

    procedure FalsePos(A,B:real; var C,DX:real;
                                    Delta,Epsilon:real; var K:integer;
                                    var A0,A1,A2,B0,B1,B2,C0,C1,C2:real;
                                    var Satisfied:boolean);
        label  999;
        var  M,YA,YB,YC:real;
    begin
        YA := F(A);  YB := F(B);
        K := 0;
        Satisfied := False;
        if YA*YB > 0 then  goto 999;
        while (K<MAX) and (Satisfied=False) do
            begin
                M := (B - A)/(YB - YA);
                if ABS(YA) < ABS(YB) then
                    begin  DX := YA*M; C := A - DX;  end
                else
                    begin  DX := YB*M; C := B - DX;  end;
                YC := F(C);
                if K = 0 then
                    begin  A0 := A; B0 := B; C0 := C;  end;
                if K = 1 then
                    begin  A1 := A; B1 := B; C1 := C;  end;
                if K = 2 then
                    begin  A2 := A; B2 := B; C2 := C;  end;
                if (C - A) < DX then
                    DX := C - A;
                if YC = 0 then
                    Satisfied := TRUE
                else
                    begin
                        if YB*YC > 0 then
                            begin  B := C; YB := YC;  end
                        else
                            begin  A := C; YA := YC;  end;
                        end;
                if (ABS(DX) < Delta) and (ABS(YC) < Epsilon) then
                    Satisfied := True;
                K := K+1;
            end;
        M := (B - A)/(YB - YA);
        if ABS(YA) < ABS(YB) then
            begin  DX := YA*M;  end
        else
            begin  DX := YB*M;  end;

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

  

(c) John H. Mathews 2004