Pages

Jumat, 06 April 2012

Procedure program kali matriks

Program kali_matriks;
uses wincrt;
type
matriksint = array [1..20,1..20] of integer;
var
M,a,b : matriksint; p , q: integer;

procedure bacamatriks (var M:matriksint;Nbar,Nkol:integer);
var i,j: integer;
begin
 for i:=1 to Nbar do
   begin
    for j:= 1 to Nkol do
     begin
       write ('M[',i,',',j,'] = ');readln (M[i,j]);
     end;
   end;
end;

procedure tulismatriks (var M:matriksint;Nbar,Nkol:integer);
var i,j : integer;
begin
 for i:= 1 to Nbar do
 begin
   for j:= 1 to Nkol do
     begin
       write (M[i,j]:6);
     end;
   writeln;
 end;
end;

procedure kalimatriks (a,b:matriksint; Nbar,Nkol : integer);
var
hasil:matriksint;
i,j,z : integer;
begin
  for i := 1 to Nbar do
  begin
   for j := 1 to Nkol do
   begin
   hasil[i,j] := 0;
    for z := 1 to Nbar do
    hasil[i,j] := hasil[i,j]+a[i,z]*b[z,j];
    begin
    write(hasil[i,j]:6) ;
    end;
   end;
   writeln;
  end;
end;

var
   lagi : char;
begin
repeat
clrscr;
  writeln ('MATRIK A ');
  write ('masukkan jumlah baris : '); readln (p);
  write ('masukkan jumlah kolom : '); readln (q);
  bacamatriks (a,p,q);
  writeln;
  writeln ('MATRIKS B ');
  write ('masukkan jumlah baris : '); readln (p);
  write ('masukkan jumlah kolom : '); readln (q);
  bacamatriks (b,p,q);
  writeln;
  writeln ('hasil perkalian matriks adalah : ');
  write ('ELEMEN MATRIKS A');
  writeln;
  tulismatriks(a,p,q);
  writeln;
  write ('ELEMEN MATRIKS B');
  writeln;
  tulismatriks(b,p,q);
  writeln;
  writeln ('HASIL PERKALIAN MATRIKS A x B');
  kalimatriks (a,b,p,q);
  writeln;
  write('Apakah ingin mengalikan matriks lagi ? [y/t] '); readln(lagi);
  writeln;
  until (lagi='T') or (lagi='t');
  donewincrt;
end.

0 komentar

Posting Komentar