home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / library / fst / mod2brd1 / mnf.mod < prev    next >
Text File  |  1990-04-08  |  4KB  |  144 lines
  1. MODULE Mnf;
  2. (*********************************************************************
  3.   Programm zum Errechnen der Mitternachtsformel.
  4.   Mit der Mitternachtsformel ist folgende Formel gemeint:
  5.  
  6.                (-1)*b +/- SQRT(b*b + 4*a*c)
  7.       x1/x2  = ----------------------------
  8.                           2*a
  9.  
  10.   mit deren Hilfe die Nullstellen einer quadratischen Funktion
  11.   zweiten Grades (a*x^2+b*x+c) errechnet werden können.
  12.   ********************************************************************)
  13. FROM RealInOut IMPORT ReadReal,
  14.                       WriteReal;
  15. FROM InOut     IMPORT WriteString,
  16.                       WriteLn;
  17. FROM MathLib0  IMPORT sqrt;
  18.  
  19.  
  20. VAR
  21.   a, b, c : REAL; (* enthalten die Koeffizienten a, b, c *)
  22.   x1, x2 : REAL; (* enthalten die Nullstellen x1, x2, falls vorhanden *)
  23.   wertunterwurzel : REAL; (* enthaelt den Wert, der mit sqrt ausgerechnet
  24.                              werden soll *)
  25.  
  26.  
  27. PROCEDURE Init();
  28. (* Installiert das Programm, gibt eine Meldung aus und
  29.    setzt die Variablen auf 0 *)
  30. BEGIN
  31.   WriteString('Programm zur Berechnung der Nullstellen einer');
  32.   WriteLn;
  33.   WriteString('quadratischen Funktion zweiten Grades (a*x^2+b*x+c)');
  34.   WriteLn;
  35.   WriteString('mittels der Mitternachtsformel: '); WriteLn; WriteLn;
  36.   WriteString('         (-1)*b +/- SQRT(b*b + 4*a*c)'); WriteLn;
  37.   WriteString('x1/x2  = ----------------------------'); WriteLn;
  38.   WriteString('                     2*a'); WriteLn;
  39.   a:=0.0;
  40.   b:=0.0;
  41.   c:=0.0;
  42.   x1:=0.0;
  43.   x2:=0.0;
  44.   wertunterwurzel:=0.0;
  45. END Init;
  46.  
  47.  
  48. PROCEDURE LeseReal(meldung : ARRAY OF CHAR) : REAL;
  49. (* gibt die Meldung aus und liest eine REAL-Zahl ein *)
  50. VAR
  51.   realzahl : REAL;
  52.  
  53. BEGIN
  54.   WriteString(meldung);
  55.   ReadReal(realzahl);
  56.   WriteLn;
  57.   RETURN realzahl;
  58. END LeseReal;
  59.  
  60.  
  61. PROCEDURE LeseKoeffizienten();
  62. (* Liest die Koeffizienten a, b, c ein *)
  63. BEGIN
  64.   WriteLn;
  65.   WriteString('Geben Sie bitte die Koffezienten ein.');
  66.   WriteLn;
  67.   a:=LeseReal('Bitte die Realzahl a eingeben: ');
  68.   b:=LeseReal('Bitte die Realzahl b eingeben: ');
  69.   c:=LeseReal('Bitte die Realzahl c eingeben: ');
  70.   WriteLn;
  71.   WriteString('f(x) = ');  (* Funktion ausgeben *)
  72.   WriteReal(a, 8);
  73.   WriteString('* x^2 + ');
  74.   WriteReal(b, 8);
  75.   WriteString('* x + ');
  76.   WriteReal(c, 8);
  77.   WriteLn;
  78.   WriteLn;
  79. END LeseKoeffizienten;
  80.  
  81.  
  82. PROCEDURE QWurzel(zahl : REAL) : REAL;
  83. (* Berechnet den Wert := sqrt(zahl). Falls zahl<0 ist, liefert
  84.    QWurzel den Wert -1 zurueck *)
  85. VAR
  86.   wurzel : REAL;
  87.  
  88. BEGIN
  89.   IF (zahl<0.0) THEN wurzel:=-1.0;
  90.     ELSIF (zahl=0.0) THEN wurzel:=0.0;
  91.     ELSE wurzel:=sqrt(zahl);
  92.   END;
  93.   RETURN wurzel;
  94. END QWurzel;
  95.  
  96.  
  97.  
  98. (* Hauptprogramm *)
  99. BEGIN
  100.   Init;    (* Initialisieren *)
  101.   LeseKoeffizienten;  (* Koeffizienten einlesen *)
  102.   wertunterwurzel:=(b*b - 4.0*a*c);  (* Wert unter der Wurzel berechnen *)
  103.  
  104.   (* a=0.0 => Division durch 0, Fehler ausgeben *)
  105.   IF (a=0.0) THEN
  106.     WriteLn;
  107.     WriteString('Konnte keine Nullstellen berechnen, da a=0');
  108.     WriteLn;
  109.   (* wertunterwurzel<0.0 => man berechnet die Wurzel einer negativen
  110.      Zahl, Fehler ausgeben *)
  111.   ELSIF (wertunterwurzel<0.0) THEN
  112.     WriteLn;
  113.     WriteString('Funktion besitzt keine Nullstellen, da (b*b - 4*a*c)<0');
  114.     WriteLn;
  115.   (* andernfalls Nullstelle(n) berechnen *)
  116.   ELSE
  117.     x1:=((-1.0)*b + QWurzel(wertunterwurzel)) / (2.0*a);
  118.     x2:=((-1.0)*b - QWurzel(wertunterwurzel)) / (2.0*a);
  119.     (* nur eine Nullstelle vorhanden => x ausgeben *)
  120.     IF (x1=x2) THEN
  121.       WriteLn;
  122.       WriteString('Eine Nullstelle gefunden: x = ');
  123.       WriteReal(x1, 8);
  124.       WriteLn;
  125.     (* oder zwei Nullstellen => x1, x2 ausgeben *)
  126.     ELSE
  127.       WriteLn;
  128.       WriteString('Zwei Nullstellen gefunden:');
  129.       WriteLn;
  130.       WriteString('x1 = '); WriteReal(x1, 8);
  131.       WriteLn;
  132.       WriteString('x2 = '); WriteReal(x2, 8);
  133.       WriteLn;
  134.     END;
  135.   END;
  136.   (* Programm mit einer Meldung beenden *)
  137.   WriteLn;
  138.   WriteLn;
  139.   WriteString('Ende der Berechnung.');
  140.   WriteLn;
  141.   WriteLn;
  142.   (* Und Tschuess *)
  143. END Mnf.
  144.