1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:

-------------------------------------------------------------------------------
-- MAIN: Newton Verfahren
--
-- PROJECT: Newton Verfahren
-- VERSION: 1.00
-- CREATED: 2007-11-17
-- AUTHOR:  Ani
--
-- ENVIRONMENT:
--   gcc 2.8.1 Gnat 3.15p
--   Microsoft Windows XP Professional Service Pack 2 (Build 2600)
--   IDE: myAda 2006
--
-- DESCRIPTION:
--   A Program which was originally ment to calculate Zero-Values for
--   predefined functions.
-------------------------------------------------------------------------------

with Ada.Text_IO;
with Ada.Integer_Text_IO;
with Ada.Float_Text_IO;
with Ada.Numerics.Elementary_Functions;

use Ada.Text_IO;
use Ada.Integer_Text_IO;
use Ada.Float_Text_IO;
use Ada.Numerics.Elementary_Functions;

Procedure Newton is

   Auswahl: Natural;
   xnp1 : Float :=2.0;
   xn : Float   :=2.0;

   fkt1 : Float := 1.0;   --fkt stellt immer das Funtkionsergebnis dar also f(x)
   fkt2 : Float := 1.0;
   fkt3 : Float := 1.0;
   ablfkt1: float := 1.0; --ablfkt stellt immer das die Ableitung dar also f'(x)
   ablfkt2: float := 1.0;
   ablfkt3: float := 1.0;

begin

   -- Userabfrage für Funktionsstellenberechnung

   Put("Fuer welche der folgenden Funktionen moechten Sie"
   & " die Nullstellen berechnen lassen?");
   new_line;
   Put("1: ");
   Put_line("f1(x) = -(xn**4.0 - xn**2.0)*exp(-xn**3.0)");
   New_line;
   Put("2: ");
   Put_line("xn**3.0)-(4.0*xn**2.0)-(2.0*xn+4.0)+(1.0/xn)");
   New_line;
   Put("3: ");
   Put_line("f3(x) = 1.0/(xn**2.0)-5.0+sqrt(abs(5.0*xn))");

   New_line;

   Get(Auswahl);
   -- Schätzwertangabe durch User
   New_line;
   Put("Bitte geben Sie einen Schaetzwert fuer die Nullstelle ein (es wird jeweils nur die zum eingegebenen Wert naechste Nullstelle ausgegeben): ");
   Get(xn);
   New_line;
   -- Fallunterscheidung für die Gleichungen
   if auswahl = 1 then
      -- wiederholung des Newtonverfahrens bis zu einem verschwindend geringen Wert f(x)
      while fkt1 >= 0.000000000011 loop
         fkt1 := -(xn**4.0 - xn**2.0)*exp(-xn**3.0);  -- Gleichung 1
         ablfkt1 := xn*((3.0*xn**5.0) - (3.0*xn**3.0) -- Abl. 1
         -(4.0*xn**2.0+2.0))*exp(-xn**3.0);

         xnp1 := (xn) -(fkt1)/(ablfkt1);              -- newtonverfahren
         xn   := xnp1;                                -- ersetzen von xn durch xn+1
         If fkt1 <= (0.000000000001) then          -- Abfrage und Ausgabe
            put("Die Funktion f1(x) hat eine Nullstelle bei : " & xn'img);
            New_line;
            exit;

         end if;

      end loop;
   end if;

   if auswahl =2 then

      while fkt2 >= 0.000000000000011 loop
         fkt2 := (xn**3.0)-(4.0*xn**2.0)-(2.0*xn+4.0)+(1.0/xn); -- gleichung2
         ablfkt2 := (3.0*xn**2.0)-(8.0*xn)-(1.0/(xn**2.0))-(2.0);-- Abl2
         xnp1 := (xn) -(fkt2)/(ablfkt2);
         xn   := xnp1;
         If fkt2 <= (0.000000000001) then
            put("Die Funktion f2(x) hat eine Nullstelle bei x:" & Xn'img);
            New_line;
            exit;

         end if;
      end loop;
   end if;

   if auswahl = 3 then
      while fkt3 >= 0.00000000000011 loop
         fkt3 := 1.0/(xn**2.0)-5.0+sqrt(abs(5.0*xn)); -- gleichung3
         -- abl. 3 ((sqrt(5.0)*(xn)) sollte ((sqrt(5.0)*sign(xn)) heißen,
         -- sign scheint in Ada nicht zu existieren!
         ablfkt3 := ((sqrt(5.0)*(xn))/(2.0*sqrt(abs(xn))))-2.0/xn**3.0;
         xnp1 := (xn) -((fkt3)/ablfkt3);
         xn   := xnp1;
         If fkt3 <= (0.00000000001) then
            put("Die Funktion f3(x) hat eine Nullstelle bei x: "

            & xn'img);
            New_line;
            exit;

         end if;

      end loop;
   end if;

end;