В каждой строке матрицы найти количество элементов, кратных трем.

Program Lab6;
type
 TMatrix = array[1..50,1..50] of integer;
var
 Matrix:TMatrix;
 a:array[1..50] of integer;
 rows,cols:integer;
 i,j:integer
 Done:boolean
 t:integer;
procedure Input(var mt:TMatrix; var n:integer; var m:integer);
var
 i,j:integer;
  begin
   write('Введите количество строк:');
   readln(n);
   write('Введите количество столбцов:');
   readln(m);
 
   for i:=1 to n do
    for j:=1 to m do
    begin
     write('Введите [',i,',',j,'] элемент:');
     readln(mt[i,j]);
    end;
  end;
procedure Output(mt:TMatrix;n,m,:integer);
var
 i,j:integer;
begin
 for i:=1 to n do
 begin
  for j:=1 to m do
   write(mt[i,j]:5);
  writeln;
 end;
end;
function Calc(mt:TMatrix;i,j:integer):integer;
var
 j:integer;
begin
 Calc:=1;
 for j:=1 to m do
 begin
  Calc:=Calc*mt[i,j];
 end;
end;
begin
 Input(Matrix,rows,cols);
 writeln('Исходная матрица');
 Output(Matrix,rows,cols);
 for i:=1 to rows do
 begin
  a[i]:=Calc(Matrix,i,cols);
 end;
Done:=false;
while not Done do
begin
 Done:=true;
 for i:=1 to rows-1 do
 begin
  if a[i]>a[i+1] then
  begin
   Done:=false;
   t:=a[i];
   a[i]:=a[i+1];
   a[i+1]:=t;
   for j:=1 to cols do
   begin
    t:=Matrix[i,j];
    Matrix[i,j]:=Matrix[i+1,j]:
    Matrix[i+1,j]:=t;
   end;
  end;
 end;
end;
writeln('Полученная матрица');
Output(Matrix,rows,cols);
readln;
end.

uses crt;
const
p=4;//количество позиций под числа в матрице
nmax=22;//максимальное количество строк матрицы
mmax=18;//то же столбцов
type
mas=array[1..mmax] of integer;//массив - строка матрицы
matr=array[1..nmax] of mas;//матрица - массив строк
 
function Krat_3(v:mas;y:byte):byte;//подсчет кратных в строке
var k,i:byte;
begin
k:=0;
for i:=1 to y do
if v[i] mod 3=0 then k:=k+1;
Krat_3:=k;
end;
 
procedure Vvod(var mt:matr;var x,y:byte);//ввод матрицы
var i,j:byte;
begin
repeat
write('Количество строк до ',nmax,' = ');
readln(x);
until x in [1..nmax];//проверка диапазона
repeat
write('Количество столбцов до ',mmax-1,' = ');
readln(y);
until y in [1..mmax];
for i:=1 to x do
for j:=1 to y do
mt[i,j]:=random(30)+1;
for i:=1 to x do
mt[i,y+1]:=Krat_3(mt[i],y);// считаем кратные в строках и записываем в дополнительный столбец
end;
 
procedure Vyvod(var mt:matr;x,y:byte);//вывод матрицы
var i,j:byte;
begin
writeln('Крат. 3':(y+1)*p+3);
for i:=1 to x do
 begin
  for j:=1 to y+1 do//на  столбец больше
  write(mt[i,j]:p);
  writeln;
 end;
end;
 
Procedure Sort(var mt:matr;x,y:byte);//сортировка строк
var i,j,k:byte;
    b:integer;
begin
for i:=1 to x-1 do
for j:=i+1 to x do
if mt[i,y+1]<mt[j,y+1] then//по убыванию элемента в дополнительном столбце
for k:=1 to y+1 do//переставляем строки
 begin
  b:=mt[i,k];
  mt[i,k]:=mt[j,k];
  mt[j,k]:=b;
 end;
end;
var a:matr;
    n,m:byte;
begin
clrscr;
randomize;
Vvod(a,n,m);
clrscr;
writeln('Исходная матрица:');
Vyvod(a,n,m);
readln;
clrscr;
Sort(a,n,m);
writeln;
writeln('Перестановка строк по убыванию кратных 3:');
Vyvod(a,n,m);
readln
end.