home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 15 / numint / guldin.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-17  |  1.8 KB  |  60 lines
  1. (* ------------------------------------------------------------------------- *)
  2. (*                                GULDIN.PAS                                 *)
  3. (*          Berechnung von Volumen und Mantelfläche bei Drehkörpern          *)
  4. (* ------------------------------------------------------------------------- *)
  5.  
  6. PROGRAM Guldin;
  7.  
  8. USES
  9.   NumInt;
  10.  
  11. CONST
  12.   Max = 100;                      (* Maximalzahl von Intervallhalbierungenen *)
  13.   m   =  15;                             (* Formatparameter für FLOAT-Zahlen *)
  14.   n   =  11;
  15.  
  16. VAR
  17.   a, b, Result, Error, eps : FLOAT;
  18.   Decimals                 : BYTE;
  19.  
  20. FUNCTION y(x : FLOAT) : FLOAT;
  21.   (* die den Drehkörper erzeugende Funktion; hier: Rotationsparaboloid *)
  22. BEGIN
  23.   y := Sqrt(x);
  24. END;
  25.  
  26. {$F+}
  27. FUNCTION Surface(x : FLOAT) : FLOAT;
  28.   (* Guldin'sche Regel zur Oberflächenberechnung *)
  29. BEGIN
  30.   Surface := 2.0 * Pi * y(x) * Sqrt(1.0+Sqr(0.5/Sqrt(y(x))));
  31. END;
  32. {$F-}
  33.  
  34. {$F+}
  35. FUNCTION Volume(x : FLOAT) : FLOAT;
  36.   (* Guldin'sche Regel zur Volumenberechnung *)
  37. BEGIN
  38.   Volume := Pi * Sqr(y(x));
  39. END;
  40. {$F-}
  41.  
  42. BEGIN
  43.   Write(^M^J'Oberflächen- und Volumenberechnung eines Drehkörpers:'^M^J);
  44.   Write(^M^J'Untere Grenze:  a = '); Read(a);
  45.   Write(    'Obere  Grenze:  b = '); Read(b);
  46.   Write(^M^J'Genauigkeit in Dezimalstellen: '); ReadLn(Decimals); WriteLn;
  47.   eps := Exp(-ABS(Decimals)*Ln(10));
  48.   IF Adaptive(@Gauss, @Volume, a, b, eps, 1, Max, Result, Error) THEN BEGIN
  49.     WriteLn('Volumen  V =  ', Result:m:n);
  50.     WriteLn('             ±', Error:m:n, ^j)
  51.   END ELSE
  52.     WriteLn('Geforderte Genauigkeit nicht erreicht !');
  53.   IF Adaptive(@Gauss, @Surface, a, b, eps, 1, Max, Result, Error) THEN BEGIN
  54.     WriteLn('Mantel   M =  ', Result:m:n);
  55.     WriteLn('             ±', Error:m:n, ^j)
  56.   END ELSE
  57.     WriteLn('Geforderte Genauigkeit nicht erreicht !');
  58.   WriteLn;
  59. END.
  60.