Jumat, 14 Juni 2013

Program metode tabulasi

Program pascal metode tabulasi
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('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