program Gauss_Sederhana;
uses wincrt;
var
i, j, k, n, y, z, cek : integer;
r, s, jumlah : real;
x : array[0..20,0..20] of real;
akar : array[0..20] of real;
label 1, 2, 3, 4, 5;
begin
1:
{Input awal: orde dan elemen-elemen dari matriks}
writeln('Masukkan orde matriks anda. (Xnn dengan maksimal 20x20)');
write('n = ');readln(n);
writeln('Masukkan elemen-elemen matriks anda.');
for i := 1 to n do
begin
for j := 1 to n+1 do
begin
write('a',i,'',j,' = ');readln(x[i,j]);
end;
end;
clrscr;
2:
{Cetak matriks}
for i := 1 to n do
begin
write('|');
for j := 1 to n+1 do
begin
write(' ',x[i,j]:0:4);
end;
writeln(' |');
end;
if y = 0 then
begin
writeln;
writeln('Benarkah ini matriks yang anda inginkan? 1. Ya 2. Tidak');readln(y);
if y = 1 then
begin
clrscr;z:= 1;goto 2;
end;
if y = 2 then
begin
clrscr;goto 1;
end;
end;
writeln;
{Proses pencarian akar-akar dari SPL yang diberikan}
for i:= 1 to n-1 do
begin
{Pengecekan matriks singular dan diagonal utama 0}
if x[i,i] = 0 then
begin
for z:= i+1 to n do
begin
if x[z,i] <> 0 then
begin
for k:= i to n+1 do
begin
s:= x[z,k];
x[z,k]:= x[i,k];
x[i,k]:= s;
end;
end
else
begin
cek:= cek + 1;
end;
end;
if cek = n - 1 then
begin
writeln('Mariks singular.');
end;
end
else
{Proses OBE}
begin
for j:= i+1 to n do
begin
r:= x[j,i]/x[i,i];
for k:= i to n+1 do
begin
x[j,k]:= x[j,k] - r*x[i,k];
end;
end;
end;
end;
{Penyulihan mundur}
akar[n]:= x[n,n+1]/x[n,n];
for i:= n-1 downto 1 do
begin
jumlah:= 0;
for j:= i to n do
begin
jumlah:= jumlah + x[i,j]*akar[j];
end;
akar[i]:= (x[i,n+1] - jumlah)/x[i,i];
end;
{Pencetakan akar}
writeln('Jadi, akar-akar dari SPL yang diberikan adalah');
for i:= 1 to n do
begin
writeln('X',i,' = ',akar[i]:0:4);
end;
3:
{Optional}
writeln;
writeln('Ingin mencoba lagi? 1. Ya 2. Tidak');readln(y);
if y = 1 then
begin
clrscr;y:= 0;cek:= 0;goto 1;
end
else
begin
writeln;
writeln('Terima kasih sudah menggunakan program ini.');
end;
end.
Preview Program:
Preview Program:
Tidak ada komentar:
Posting Komentar