Metode Tali Busur pada Metode Numerik

Algoritma Program Pascal untuk Tali Busur pada Metode Numerik
program Tali_Busur;

uses wincrt;

var

   x                    : array[0..1000] of real;

   i, max               : integer;

   er, tolmax, tolmin   : real;

label 1, 2;

function f(a:real):real;

         begin

              f:= 3*a*a - 12;

         end;

begin

1:

     writeln('Masukkan tebakan awal anda.');

     write('X0 = ');readln(x[0]);

     write('X1 = ');readln(x[1]);

     clrscr;

     writeln('Titik-titik tebakan awal: (',x[0]:0:2,',',f(x[0]):0:2,') dan (',x[1]:0:2,',',f(x[1]):0:2,')');

     write('Toleransi maksimum = ');readln(tolmax);

     write('Toleransi minimum  = ');readln(tolmin);

     write('Iterasi maksimum   = ');readln(max);

     writeln;

     writeln('     i = 0   X0 = ',x[0]:0:6,'   Y0 = ',f(x[0]):0:6);

     writeln('             X1 = ',x[1]:0:6,'   Y1 = ',f(x[1]):0:6);

     i:= 1;

     repeat

           if f(x[i]) - f(x[i-1]) = 0 then

              begin

                   writeln('');

                   writeln('Akar gagal ditemukan karena nilai terdapat pembagi 0.');

                   goto 2;

              end;

           x[i+1]:= x[i] - ( (x[i]-x[i-1]) / (f(x[i])-f(x[i-1])) )*f(x[i]);

           er:= abs(x[i+1]-x[i]);

           writeln('     i = ',i,'   X',i+1,' = ',x[i+1]:0:6,'   Y',i+1,' = ',f(x[i+1]):0:6);

           i:= i + 1;

           if er > tolmax then

              begin

                   writeln('');

                   writeln('Fungsi divergen.');

                   goto 2;

              end;

           if i > max then

              begin

                   writeln('');

                   writeln('Fungsi belum konvergen.');

                   goto 2;

              end;

     until er < tolmin;

     writeln;

     writeln('Akar ditemukan!');

     writeln('Pada iterasi ke-',i-1,' dengan akarnya adalah ',x[i]:0:6);

2:

  writeln;

  writeln('Ingin mencoba lagi?  1. Ya  2. Tidak');readln(i);

  if i = 1 then

     begin

          clrscr;goto 1;

     end

  else

      begin

           writeln('');

           writeln('Terima kasih sudah menggunakan program ini.');

      end;

end.


Preview Program: