{ Programm zur iterativen Berechnung von Nullstellen } {$N+} uses crt ; var epsilon :real; x1, x2, x3 :double; it_zahl :word; function Funktion(var x:double):double; begin Funktion:=x*x*x-2*x*x+12*x-12; end; procedure start_eingabe; begin ClrScr; writeln(' Startwert = ');readln(x3); writeln(' Abbruchgenauigkeit = ');readln(epsilon); writeln(' Iterationszahl = ');readln(it_zahl); if x3=0 then x3:=1; if epsilon=0 then epsilon:=1E-33; if it_zahl=0 then it_zahl:=200; x1:=x3-0.5; x2:=x3+0.5; clrscr; writeln;writeln; writeln(' Startwert = ',x3); writeln(' Epsilon = ',epsilon); writeln(' Iterationszahl = ',it_zahl); readln; end; procedure mittelteil; var x, l, l1, e1, e2, e3, a, b, c, d :double; k :word; begin k:=1; e1:=Funktion(x1); e2:=Funktion(x2); repeat if (x2=x1) then x2:=x2+1E-20; l1:=(x3-x2)/(x2-x1); d:=(x3-x1)/(x2-x1); e3:=Funktion(x3); a:=l1*l1*e1 - d*d*e2 + (l1+d)*e3; c:=l1*(l1*e1 - d*e2 + e3); b:= a*a - 4*d*c*e3; if (b<0) then b:=0; if (a > 0 ) then a:=a + sqrt(b); if (a < 0 ) then a:=a - sqrt(b); if ( abs(a) + abs(b) =0 ) then a:=4*d*e3; if (abs(a) < 1e-10) then a:=1E-10; l:=-2*d*(e3/a); x:=x3+l*(x3-x2); writeln(' ',x); if ( abs(x-x3) < epsilon*abs(x3) ) then begin writeln(#10,' Funktionswert = ',Funktion(x3)); writeln(' gesuchter Wert X = ',x3); exit; end; k:=k+1; x1:=x2; x2:=x3; x3:=x; e1:=e2; e2:=e3; until (k >= it_zahl); writeln(#10,' keine Konvergenz nach ', it_zahl,' Iterationen '); writeln(#10,' letzter Funktionswert = ',Funktion(x3)); writeln(' gesuchter Wert X = ',x3); end; Begin Start_eingabe; mittelteil; readln; end.