Jumat, 03 Mei 2013

Program Metode Tabulasi pada pascal


uses crt;
label ulang;
var x,x1,x2,xa,xb,xc,y,y1,y2,ya,yb:real;
    i,j,k:integer;
    ab:char;
begin
ulang:
clrscr;
writeln('Selamat Datang di Program menentukan akar dengan Metode Tabulasi');
writeln('<<<<<<UNIVERSITAS GUNADARMA>>>>>>');
writeln('<<<<<<Created by YAN AJIE PRASETIA>>>>>>');
writeln;
     writeln('Tentukan akar penyelesaian dengan metode tabulasi dari f(x)=x^3-7x+1..!');
     writeln;
     write('Masukkan nilai x1 = ');
     readln(x1);
     y1 := x1 * x1 * x1 - 7 * x1 + 1;
     writeln('  f(',x1:0:2,') = ',y1:0:4);
     repeat
     begin
          write('Masukkan nilai x2 = ');
          readln(x2);
          y2 := x2 * x2 * x2 - 7 * x2 + 1;
          writeln('  f(',x2:0:2,') = ',y2:0:4);
          writeln;
          writeln('Syarat (x1 * x2) < 0');
          write('x1 * x2 = ',y1 * y2:0:5);
          if (y1 * y2) < 0 then write('Nilai OK')
          else write('Nilai tidak sesuai');
          readln;
     end;
     until (y1 * y2) < 0;
     clrscr;
     k := 0;
     repeat
     begin
          k := k + 1;
          if x1 > x2 then
          begin
               xa := x1;
               xb := x2;
          end
          else
          begin
               xa := x2;
               xb := x1;
          end;
          xc := (xa - xb) / 10;
          i := 0;
          repeat
          begin
               i := i + 1;
               x := xb + xc * i;
               ya := x * x * x - 7 * x + 1;
               yb := (x - xc) * (x - xc) * (x - xc) - 7 * (x - xc) + 1;
          end;
          until (ya * yb) < 0;
          x1 := x;
          x2 := x - xc;
          writeln('Tabulasi ke-',k);
writeln('----------------------------------------------');
writeln(' n ||         x        ||        f(x)      ||       error      ||');
writeln('----------------------------------------------');
          for j := 1 to 9 do
          begin
               x := xb + xc * (j - 1);
               y := x * x * x - 7 * x + 1;
               writeln('',j , '  ::',x,' ::',y,' ::',abs(y),' ::');
          end;
          for j := 10 to 11 do
          begin
               x := xb + xc * (j - 1);
               y := x * x * x - 7 * x + 1;
               writeln('',j , '  ::',x,' ::',y,' ::',abs(y),' ::');
          end;
writeln('---------------------------------------------');
     end;
     readln;
     until abs(y) < 10e - 8;
     writeln('Akar pendekatannya adalah x = ',x);
     writeln('Error = ',abs(y));
     writeln;
     write('Apakah anda ingin mengulangi? (Y/T) : ');
     readln(ab);
     if (ab = 'y') or (ab = 'Y') then
     begin
          goto ulang;
     end
end.

Tidak ada komentar:

Posting Komentar