Матрица

[jorjinho10]

Если количество ненулевых элементов матрицы В , размерностью m x n (3 х 4 в данной задаче),меньше , чем (m x n)/3 , сформировать матрицу С размерами к х 3 в первом столбце которой содержатся ненулевые элементы матрицы В , а во втором и третьем столбцах - их координаты в исходной матрице.( (m x n)/3 - число, число к - число ненулевых элементов в матрице В.)

Всё требуется сделать с помощью function и procedure

Вот что я делал , но это не работает (((

program Kursovaya;
uses crt;
Const
Nmax=8;
NMAXIMUM=999999;
var i,j,m,n,y,o,l:integer;
    A,B,C,MA:array[1..Nmax,1..Nmax] of real;
begin
 writeln('Vvedite kol-vo strok v matrice B (do ',Nmax,')');readln(m);
 writeln('Vvedite kol-vo stolbcov v matrice B (do ',Nmax,')');readln(n);
 writeln;
 for i:=1 to m do
 for j:=1 to n do
 begin
 write('B[',i,',',j,']: ');readln(B[i,j]);
 end;
 writeln;
 writeln(' matrica B :');
 writeln;
 for i:=1 to m do
 begin
 for j:=1 to n do write(B[i,j]:9:1,' ');
   writeln;
 end;
for i:=1 to m do
for j:=1 to m do
if B[i,j]<>0 Then
 y:=y+1;
if y>((m*n)/3) then
begin
for i:=1 to m do
for j:=1 to m do
if B[i,j]<>0 then
begin
y:=y+1;
MA[y,1]:=B[i,j];
MA[y,2]:=i;
MA[y,3]:=j;
end;
    for i:=1 to y do
 begin
 for j:=1 to n do write(MA[i,j]:5,' ');
   writeln;
 end;
 end;
 end.

[Gongled]

Если я верно понял задание.

program lab;
uses CRT;
const
n = 3;
m = 4;
z = 3;
type
DMass = array[1..n,1..m] of integer;
NMass = array[1..n*m,1..z] of integer;
var
a : DMass;
c : NMass;
i, j, k, b : integer;

procedure new_arr(var a : DMass);
begin
     for i:=1 to n do
     begin
          for j:=1 to m do
          begin
               write('Введите [',i,',',j,']: ');
               read(a[i,j]);
               if a[i,j]<>0 then inc(k);
          end;
     end;
end;

function check_num(k,m,n : integer) : boolean;
begin
     if k < m*n/3 then check_num := true
     else check_num := false;
end;

procedure mod_arr(a : DMass; var c : NMass);
var
b : integer;
begin
b := 0;
     if check_num(k,m,n) then
     begin
          for i:=1 to n do
          begin
               for j:=1 to m do
               begin
                    if a[i,j]<>0 then
                    begin
                         inc(b);
                         c[b,1] := a[i,j];
                         c[b,2] := i;
                         c[b,3] := j;
                         writeln(c[b,1]:5,c[b,2]:5,c[b,3]:5);
                    end;
               end;
          end;
     end;

end;


begin
clrscr;
randomize;

k := 0;

new_arr(a);
mod_arr(a,c);
readln;

end.

[jorjinho10]

вылетает сразу после того как ввожу последний элемент матрицы