home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 03 / solve.inc < prev    next >
Encoding:
Text File  |  1987-02-03  |  2.8 KB  |  79 lines
  1. (*****************************************************************************)
  2. (*                                                                           *)
  3. (*                          ---  SOLVE.INC  ---                              *)
  4. (*                                                                           *)
  5. (*          Unterprogramm-Modul zum Loesen einer Gleichung  g(x)=0           *)
  6. (*                                                                           *)
  7. (*****************************************************************************)
  8.  
  9.  
  10. Function Solve (    a,b,                           (* Suchintervall          *)
  11.                     d       :Real;                 (* Suchschrittweite       *)
  12.                     k       :Integer;              (* k-te Ableitung         *)
  13.                 Var Success :Boolean):Real;        (* Loesung gefunden?      *)
  14.  
  15.  
  16.    Var  x,y,s,dy,Lastx,Lasty,Lastdy :Real;
  17.  
  18.  
  19.    Function Regula_Falsi (    Lastx,Lasty,
  20.                               x,y :Real;
  21.                               k            :Integer;
  22.                           Var Success      :Boolean) :Real;
  23.  
  24.       Var xmin,xmax,z :Real;
  25.  
  26.       Begin
  27.       xmin := Lastx;
  28.       xmax := x;
  29.       If y<>0 then
  30.          Repeat                             (* Anwendung der Regula falsi... *)
  31.             z := x;
  32.             x := x - y*(x-Lastx)/(y-Lasty);
  33.             Lastx := z;
  34.             Lasty := y;
  35.             y := fn (x,k)
  36.          until abs(x-Lastx) < eps;           (* ... bis Genauigkeit erreicht *)
  37.       Success := (x >= xmin) and (x <= xmax);
  38.       Regula_Falsi := x
  39.       End;
  40.  
  41.  
  42.    Begin
  43.    Success := false;
  44.    x       := a;
  45.    Lasty   := fn (x,k);
  46.    Lastdy  := fn (x,k+1);
  47.    Lastx   := x;
  48.    x       := x + d;
  49.    If Lasty<>0 then
  50.       Repeat
  51.          y  := fn (x,k);
  52.          dy := fn (x,k+1);
  53.          If y*Lasty <= 0 then                      (* Nullstelle lokalisiert *)
  54.             s := Regula_Falsi (Lastx,Lasty,
  55.                                x,y,k,Success)
  56.          else if dy*Lastdy <= 0 then               (* Extremwert lokalisiert *)
  57.             Begin
  58.             s := Regula_Falsi (Lastx,Lastdy,x,
  59.                                dy,k+1,Success);
  60.             Success := Success and
  61.                        (abs(fn(s,k)) < eps)      (* Extremwert = Nullstelle? *)
  62.             End;
  63.          If not Success then
  64.             Begin
  65.             Lasty  := y;
  66.             Lastx  := x;
  67.             Lastdy := dy;
  68.             x      := x + d
  69.             End
  70.          else
  71.             Solve := s
  72.       until (x>b) or Success             (* suche bis Nullstelle gefunden... *)
  73.    else                                  (* ... oder Intervallende erreicht  *)
  74.       Begin
  75.       Success := true;
  76.       Solve := x - d
  77.       End
  78.    End;
  79.