Использование процедур

Program Z_2;
const n=3;
      m=3;
type matr=array[1..n,1..m] of real;
var i,j:integer;
    A,B:matr;
Procedure OEKS(n,m:integer; var A:matr);
var i,j,z,k:integer;
    d:integer;
Begin
d:=-1;
for i:=1 to n do
if A[i,j]<0 then k:=k+1;
if k>0 then begin
for i:=1 to n do
for j:=1 to m do
if A[i,j]<0 then begin d:=d+1;
A[n-d,j]:=A[i,j]
end
else writeln('Отрицательные элементы не найдены'); end;
for j:=1 to m do begin i:=1;
until (i=>n) or (A[i,j]<0) do z:=i;
if z>i then z:=i; end;
for i:=1 to z do
for j:=1 to m do
writeln(A[i,j])
BEGIN
for i:=1 to n do
for j:=1 to m do
readln(A[i,j]);
OEKS(n,m,B);
END.

const nmax=20;
var a:array[1..nmax,1..nmax] of integer;
    n,m,i,j,k,p,t:byte;
    x:integer;
begin
clrscr;
randomize;
repeat
write('Количество строк=');
readln(m);
until m in [1..nmax];
repeat
write('Количество столбцов=');
readln(n);
until n in [1..nmax];
writeln('Исходная матрица:');
for i:=1 to m do
 begin
   for j:=1 to n do
    begin
     a[i,j]:=random(20)-5;
     write(a[i,j]:4);
    end;
   writeln;
 end;
writeln;
 
for j:=1 to n do
 begin
  k:=0;
  for i:=1 to m do
  if a[i,j]>=0 then
    begin
      k:=k+1;
      x:=a[i,j];
      for p:=i downto k+1 do 
      a[p,j]:=a[p-1,j];
      a[k,j]:=x;
    end;
 end;
writeln('Результат перестановок:');
for i:=1 to m do
 begin
  for j:=1 to n do
  write(a[i,j]:4);
  writeln;
 end;
writeln;
writeln('Строки, не имеющие отрицательных элементов:');
 
t:=0;
for i:=1 to m do
 begin
  for j:=1 to n do
  if a[i,j]<0 then
   begin
    k:=i-1;
    t:=1;
    break;
   end;
  if t=1 then break;
 end;
for i:=1 to k do
 begin
  for j:=1 to n do
  write(a[i,j]:4);
  writeln;
 end;
readln
end.