home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / RTFLSP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-29  |  1.1 KB  |  48 lines
  1. FUNCTION rtflsp(x1,x2,xacc: real): real;
  2. (* Programs using routine RTFLSP must externally define a function
  3. fx(x:real):real which is to be analyzed for roots. *)
  4. LABEL 99;
  5. CONST
  6.    maxit=30;
  7. VAR
  8.    xl,xh,swap,fl: real;
  9.    dx,del,f,fh,rtf: real;
  10.    j: integer;
  11. BEGIN
  12.    fl := fx(x1);
  13.    fh := fx(x2);
  14.    IF (fl*fh > 0.0) THEN BEGIN
  15.       writeln('pause in routine RTFLSP');
  16.       writeln('Root must be bracketed for false position'); readln
  17.    END;
  18.    IF (fl < 0.0) THEN BEGIN
  19.       xl := x1;
  20.       xh := x2
  21.    END ELSE BEGIN
  22.       xl := x2;
  23.       xh := x1;
  24.       swap := fl;
  25.       fl := fh;
  26.       fh := swap
  27.    END;
  28.    dx := xh-xl;
  29.    FOR j := 1 TO maxit DO BEGIN
  30.       rtf := xl+dx*fl/(fl-fh);
  31.       f := fx(rtf);
  32.       IF (f < 0.0)  THEN BEGIN
  33.          del := xl-rtf;
  34.          xl := rtf;
  35.          fl := f
  36.       END ELSE BEGIN
  37.          del := xh-rtf;
  38.          xh := rtf;
  39.          fh := f
  40.       END;
  41.       dx := xh-xl;
  42.       IF ((abs(del) < xacc) OR (f = 0.0)) THEN GOTO 99
  43.    END;
  44.    writeln('pause in routine RTFLSP');
  45.    writeln('maximum number of iterations exceeded'); readln;
  46. 99:   rtflsp := rtf
  47. END;
  48.