home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 15 / numint / sphere.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-17  |  1.6 KB  |  48 lines
  1. (* ------------------------------------------------------------------------- *)
  2. (*                                SPHERE.PAS                                 *)
  3. (*          Berechnung des Kugel-Volumens durch Mehrfach-Integration         *)
  4. (* ------------------------------------------------------------------------- *)
  5.  
  6. PROGRAM Sphere;
  7.  
  8. USES
  9.   NumInt;
  10.  
  11. CONST
  12.   MaxSteps = 10;              (* Maximale Zahl von Stützstellenverdopplungen *)
  13.   v        = 15;                         (* Formatparameter für FLOAT-Zahlen *)
  14.   w        = 11;
  15.  
  16. VAR
  17.   Result,Error,eps,R : FLOAT;
  18.   a,b                : VECTOR;
  19.   N                  : POINTS;
  20.   Decimals           : BYTE;
  21.  
  22. {$F+}
  23. FUNCTION dV(r : VECTOR) : FLOAT;
  24.   (* das Volumenelement in Polarkoordinaten:  dV = r²sinΦ·dr·dΦ·dΘ *)
  25. BEGIN
  26.   dV := Sqr(r[1])*Sin(r[2]);
  27. END;
  28. {$F-}
  29.  
  30. BEGIN
  31.   Write('Berechnung des Kugelvolumens:'^M^J);
  32.   Write('Radius der Kugel:  R = '); Read(R);
  33.   Write('Genauigkeit in Dezimalstellen: '); Read(Decimals); WriteLn;
  34.  
  35.   eps := Exp(-ABS(Decimals)*Ln(10));                 (* relative Genauigkeit *)
  36.   N[1] := 1;  N[2] := 1;  N[3] := 1;                (* Anfangsunterteilungen *)
  37.   a[1] := 0;  b[1] := R;                              (* Integrationsgrenzen *)
  38.   a[2] := 0;  b[2] := Pi;
  39.   a[3] := 0;  b[3] := 2*Pi;
  40.   IF Romberg(@dV, 3, a, b, eps, N, MaxSteps, Result, Error) THEN BEGIN
  41.     WriteLn('Volumen:    V =  ', Result:v:w);
  42.     WriteLn('                ±', Error:v:w, ^M^J);
  43.     WriteLn('exakt:      V =  ', 4/3*Pi*R*R*R:v:w)
  44.   END ELSE
  45.     WriteLn('Geforderte Genauigkeit nicht erreicht !');
  46.   WriteLn;
  47. END.
  48.