home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / library / fst / modula3 / calc.mod < prev    next >
Text File  |  1993-07-28  |  4KB  |  109 lines
  1. MODULE calc;
  2. (*******************************************************************
  3.    Programm zum Testen der Rechengenauigkeit Ihres Rechners.
  4.    Es wird der folgende Funktion berechnet:
  5.                     (x+y)^2-2*x*y-y^2
  6.                     -----------------
  7.                            x^2
  8.    Das Ergebnis müßte eigentlich 1 ergeben, aber durch Rechen-
  9.    ungenauigkeit akkumulieren sich die Fehler zu Ergebnissen, die
  10.    mathematisch unmöglich sind. Vor allem durch die Eingabe von
  11.    Grenzwerten verzerrt sich das Ergebnis erheblich.
  12.  *******************************************************************)
  13. FROM IO IMPORT WrLn,
  14.                WrStr;
  15. FROM RealInOut IMPORT WriteReal,
  16.                       ReadReal;
  17. FROM Str IMPORT Caps;
  18. FROM InOut IMPORT Read;
  19.  
  20. CONST
  21.   MaxZahl = 50000.0;   (* groessmoegliche Zahl *)
  22.   MinZahl = -50000.0;  (* kleinstmoegliche Zahl *)
  23.  
  24. VAR
  25.   x, y : REAL;
  26.   jn:CHAR;
  27.  
  28. (*******************************************************************)
  29. (* Procedure BERECHNUNG                                            *)
  30. (*******************************************************************)
  31. (* Berechnet den besagten Ausdruck:                                *)
  32. (*                      (x+y)^2-2*x*y-y^2                          *)
  33. (*                      -----------------                          *)
  34. (*                            x^2                                  *)
  35. (*******************************************************************)
  36. PROCEDURE berechnung(x, y : REAL) : REAL;
  37. BEGIN
  38.   RETURN ((x+y)*(x+y)-2.0*x*y-y*y)/(x*x);
  39. END berechnung;
  40.  
  41.  
  42. (*******************************************************************)
  43. (* Procedure LESEZAHL                                              *)
  44. (*******************************************************************)
  45. (* Liest eine REAL-Zahl ein mit der Eigenschaft  min<=zahl<=max    *)
  46. (*******************************************************************)
  47. PROCEDURE lesezahl(min, max : REAL; message : ARRAY OF CHAR) : REAL;
  48. VAR
  49.   z : REAL;
  50.  
  51. BEGIN
  52.   REPEAT
  53.     WrStr(message);
  54.     ReadReal(z);
  55.     WrLn;
  56.   UNTIL (z>=min) AND (z<=max);
  57.   RETURN z;
  58. END lesezahl;
  59.  
  60.  
  61. (*******************************************************************)
  62. (* Procedure BERECHNEN                                             *)
  63. (*******************************************************************)
  64. (* gibt eine Nachricht aus, liest x,y ein, berechnet den Ausdruck  *)
  65. (* und gibt das Ergebnis aus.                                      *)
  66. (*******************************************************************)
  67. PROCEDURE berechnen;
  68. BEGIN
  69.   (* Nachricht ausgeben *)
  70.   WrLn;
  71.   WrStr('Dieses Programm berechnet nach Eingabe von x, y');
  72.   WrLn;
  73.   WrStr('den Ausdruck:'); WrLn;
  74.   WrLn;
  75.   WrStr('    (x+y)^2 - 2*x*y - y^2'); WrLn;
  76.   WrStr('    ---------------------'); WrLn;
  77.   WrStr('             x^2'); WrLn;
  78.   WrLn;
  79.   x:=lesezahl(MinZahl, MaxZahl, 'Bitte x-Wert eingeben: ');
  80.   y:=lesezahl(MinZahl, MaxZahl, 'Bitte y-Wert eingeben: ');
  81.   WrLn;
  82.   WrStr('Das Ergebnis lautet: ');
  83.   WriteReal(berechnung(x,y), 15);
  84.   WrLn;
  85.   WrLn;
  86. END berechnen;
  87.  
  88.  
  89. (*******************************************************************)
  90. (* Hauptprogramm                                                   *)
  91. (*******************************************************************)
  92. BEGIN
  93.   LOOP
  94.     berechnen;WrLn;
  95.     WrStr('Soll die Fehlerakkumulation noch mit weiteren Zahlen getestet');
  96.     WrLn;
  97.     WrStr('werden ?');
  98.     Read(jn);
  99.     Caps(jn);
  100.     IF jn="J" THEN WrLn;WrLn
  101.     ELSIF jn="N" THEN EXIT
  102.     ELSE Read(jn);
  103.          Caps(jn)
  104.     END;  (* IF *)
  105.   END  (* LOOP *)
  106. END calc.
  107.  
  108.  
  109.