Praktikum: Pertemuan Ke-3 Program Metode Bisection
Source Code:
uses crt;
label ulang;
var
x1, x2, x3, y1, y2, y3 :real;
i:integer;
ab:char;
begin
ulang:
clrscr;
writeln ('tentukan nilai akar dari persamaan f(x)=x^3+x^2-3x=0 dengan metode biseksi');
write ('masukan nilai x1= ');
readln (x1);
y1 :=x1*x1*x1+x1*x1-3*x1-3;
writeln ('nilai f(x1)=' ,y1:0:4);
repeat
begin
write ('masukan nilai x2= ');
readln (x2);
y2 :=x2*x2*x2+x2*x2-3*x2-3;
write ('nilai f(x2)=', y2:0:4);
end;
if (y1*y2) < 0 then
writeln ('syarat nilai ok')
else
writeln ('nilai x2 belum sesaui');
until (y1*y2) <0;
i :=2;
writeln;
writeln('penyelesaian persamaan dengan motede biseksi nilai x1=' ,x1:0:2, ' &x2= ',x2:0:2);
writeln ('-----------------------------------');
writeln ('n x f(x) error ');
writeln ('-----------------------------------');
repeat
begin
i :=1+1; x3:= (x1+x2) /2;
y3 :=x3*x3*3+x3*x3-3*x3-3;
if (i mod 10)=0 then readln;
if i<10 then
writeln (' ',i,' :: ',x3,'::',y3,' :: ',abs(y3),' ::')
else
writeln (i,' :: ',x3,'::',y3,' :: ',abs(y3),' ::');
if (y1*y3)<0 then
begin
x2 :=x3;
end else
begin
x1 :=x3;
end;
end;
until abs (y3)<1E-07;
writeln ('--------------------------');
writeln ('akar persamaanya =',x3);
writeln ('errornya =',abs(y3));
writeln ('--------------------------');
writeln ('apakan anda ingin mengulanginya (y/t): ');
readln (ab);
if (ab='y') or (ab='Y') then
begin
goto ulang;
end
else
end.
Download Source Code
uses crt;
label ulang;
var
x1, x2, x3, y1, y2, y3 :real;
i:integer;
ab:char;
begin
ulang:
clrscr;
writeln ('tentukan nilai akar dari persamaan f(x)=x^3+x^2-3x=0 dengan metode biseksi');
write ('masukan nilai x1= ');
readln (x1);
y1 :=x1*x1*x1+x1*x1-3*x1-3;
writeln ('nilai f(x1)=' ,y1:0:4);
repeat
begin
write ('masukan nilai x2= ');
readln (x2);
y2 :=x2*x2*x2+x2*x2-3*x2-3;
write ('nilai f(x2)=', y2:0:4);
end;
if (y1*y2) < 0 then
writeln ('syarat nilai ok')
else
writeln ('nilai x2 belum sesaui');
until (y1*y2) <0;
i :=2;
writeln;
writeln('penyelesaian persamaan dengan motede biseksi nilai x1=' ,x1:0:2, ' &x2= ',x2:0:2);
writeln ('-----------------------------------');
writeln ('n x f(x) error ');
writeln ('-----------------------------------');
repeat
begin
i :=1+1; x3:= (x1+x2) /2;
y3 :=x3*x3*3+x3*x3-3*x3-3;
if (i mod 10)=0 then readln;
if i<10 then
writeln (' ',i,' :: ',x3,'::',y3,' :: ',abs(y3),' ::')
else
writeln (i,' :: ',x3,'::',y3,' :: ',abs(y3),' ::');
if (y1*y3)<0 then
begin
x2 :=x3;
end else
begin
x1 :=x3;
end;
end;
until abs (y3)<1E-07;
writeln ('--------------------------');
writeln ('akar persamaanya =',x3);
writeln ('errornya =',abs(y3));
writeln ('--------------------------');
writeln ('apakan anda ingin mengulanginya (y/t): ');
readln (ab);
if (ab='y') or (ab='Y') then
begin
goto ulang;
end
else
end.
Download Source Code
Komentar
Posting Komentar