home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 04 / quellen / integral.inc < prev    next >
Encoding:
Text File  |  1979-12-31  |  3.0 KB  |  100 lines
  1. (*****************************************************************************)
  2. (*                              INTEGRAL.INC                                 *)
  3. (*                                                                           *)
  4. (*                 Berechnung eines bestimmten Integrals von f               *)
  5. (*****************************************************************************)
  6.  
  7. PROCEDURE integrate;
  8.  
  9. TYPE integrtyp = (flaeche,rotationsvolumen,mantelflaeche,bogenlaenge);
  10.  
  11. VAR a,b,g,err,i,lasti : REAL;
  12.     k                 : INTEGER;
  13.     typ               : integrtyp;
  14.     key               : CHAR;
  15.  
  16.   FUNCTION simpson (a,b :REAL; k :INTEGER; typ : integrtyp) : REAL;
  17.  
  18.   VAR h,s : REAL;
  19.       i   : INTEGER;
  20.  
  21.     FUNCTION integrand(x : REAL ; typ : integrtyp) : REAL;
  22.  
  23.     BEGIN
  24.       CASE typ OF 
  25.         flaeche           : integrand := fn(x,0);
  26.         rotationsvolumen  : integrand := pi*Sqr(fn(x,0));
  27.         mantelflaeche     : integrand := 2.0*pi*fn(x,0)*Sqrt(1.0+Sqr(fn(x,1
  28.                                            )));
  29.         bogenlaenge       : integrand := Sqrt(1.0+Sqr(fn(x,1)))
  30.       END
  31.     END;
  32.  
  33.   BEGIN
  34.     h := (b-a)/(k+k);
  35.     s := integrand(a,typ) + integrand(b,typ);
  36.     FOR i:=0 TO k-1 DO
  37.       s := s + 4*integrand(a+(i+i+1)*h,typ);
  38.     FOR i:=1 TO k-1 DO
  39.       s := s + 2*integrand(a+2*i*h,typ);
  40.     simpson := s * h/3;
  41.   END;
  42.  
  43. BEGIN
  44.   Clrscr;
  45.   Writeln ('Berechnung des Integrals von f(x)');
  46.   REPEAT
  47.     Writeln;
  48.     formulaln (a,'von a = ');
  49.     formulaln (b,'bis b = ');
  50.   UNTIL a < b;
  51.   REPEAT
  52.     formulaln (g,'mit relativer Genauigkeit g = ');
  53.   UNTIL g > 0.0;
  54.   Writeln;
  55.   Writeln;
  56.   Writeln('Welche Integration soll ausgefuehrt werden ?');
  57.   Writeln;
  58.   Writeln(' Flaechenintegral :  <F>');
  59.   Writeln(' Rotationsvolumen :  <R>');
  60.   Writeln(' Mantelflaeche    :  <M>');
  61.   Writeln(' Bogenlaenge      :  <B>');
  62.   Writeln;
  63.   Write(' Bitte waehlen    :   ');
  64.   REPEAT
  65.     Read(kbd,key);
  66.     key := Upcase(key)
  67.   UNTIL key IN ['F','R','B','M'];
  68.   Writeln(key);
  69.   Writeln;
  70.   Writeln;
  71.   CASE key OF
  72.     'F' : typ := flaeche;
  73.     'R' : typ := rotationsvolumen;
  74.     'M' : typ := mantelflaeche;
  75.     'B' : typ := bogenlaenge
  76.   END;
  77.   k := 4;
  78.   lasti := simpson (a, b, 2, typ);
  79.   REPEAT
  80.     i := simpson (a, b, k, typ);                    (* Simpson-Naeherung *)
  81.     err := Abs ((i-lasti)/i);                        (* relativer Fehler *)
  82.     lasti := i;
  83.     k := k * 2                               (* Stuetzstellen verdoppeln *)
  84.   UNTIL (err <= g) OR (k > maxiter);
  85.   IF k <= maxiter
  86.     THEN
  87.       BEGIN
  88.         Writeln ('Integral:               I = ', i:m:n);
  89.         Writeln;
  90.         Writeln ('relativer Fehler:      dI = ', err:m:n);
  91.         Writeln;
  92.       END
  93.     ELSE
  94.       BEGIN
  95.         Writeln ('Maximale Anzahl von Iterationen ueberschritten!');
  96.         Writeln ('Integral ungefaehr:     I = ', i:m:n);
  97.       END
  98. END;
  99.  
  100.