home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / integral.inc < prev    next >
Encoding:
Text File  |  1988-02-02  |  1.7 KB  |  51 lines
  1. (*****************************************************************************)
  2. (*                              INTEGRAL.INC                                 *)
  3. (*                                                                           *)
  4. (*                 Berechnung eines bestimmten Integrals von f               *)
  5. (*****************************************************************************)
  6.  
  7. Procedure Integrate;
  8.  
  9.    Var a,b,g,err,I,LastI :Real;
  10.        k                 :Integer;
  11.  
  12.  
  13.    Function Simpson (a,b :Real; k :Integer) :Real;
  14.  
  15.       Var h,S :Real;
  16.           i   :Integer;
  17.  
  18.       Begin
  19.       h := (b-a)/(k+k);
  20.       S := fn(a,0) + fn(b,0);
  21.       For i:=0 to k-1 do
  22.          S := S + 4*fn(a+(i+i+1)*h,0);
  23.       For i:=1 to k-1 do
  24.          S := S + 2*fn(a+2*i*h,0);
  25.       Simpson := S * h/3;
  26.       End;
  27.  
  28.  
  29.    Begin
  30.    ClrScr;
  31.    WriteLn ('Berechnung des Integrals von f(x)'); WriteLn;
  32.    Write ('von a='); Read (a);
  33.    Write (' bis b='); Read (b);
  34.    Write (' mit relativer Genauigkeit g='); ReadLn (g); WriteLn; WriteLn;
  35.    k := 4;
  36.    LastI := Simpson (a, b, 2);
  37.    Repeat
  38.       I := Simpson (a, b, k);                            (* Simpson-Näherung *)
  39.       err := abs ((I-LastI)/I);                          (* relativer Fehler *)
  40.       LastI := I;
  41.       k := k * 2                                  (* Stützstellen verdoppeln *)
  42.    until (err <= g) or (k > MaxIter);
  43.    If k <= MaxIter then
  44.       Begin
  45.       WriteLn ('Integral:               I = ', I:m:n); WriteLn;
  46.       WriteLn ('absoluter Fehler:      dI = ', err:m:n); WriteLn;
  47.       End
  48.    else
  49.       WriteLn ('Maximale Anzahl von Iterationen überschritten!')
  50.    End;
  51.