заданной прямоугольной матрице поставить на первое место столбец с наименьшим количеством нулевых элементов (Паскаль, Фортран)

[HuBuDuMkA]

закончить решение
нужно проверить и добавить перестановку нулей в конец столбца
решение сначала на паскале потом на фортране
ответ можно написать либо в том либо в том,переведу сам

1) В заданной прямоугольной матрице поставить на первое место столбец с наименьшим количеством нулевых элементов, переставив все нули в конец этого столбца. (Изменённая матрица должна содержать все элементы исходной матрицы).

unit modul1;

 interface

 const M = 5; N = 4;

 type matr = array[1..N, 1..M] of real;

 procedure vvod(var a: matr);
 procedure vivod(a: matr);
 function kolnul(a: matr; col: integer):integer;
 procedure minnul(var a: matr);

 implementation

 procedure vvod(var a: matr);
 var i,j:integer;
 begin
 writeln('Input matr: ');
 for i:=1 to N do
 for j:=1 to M do
 read(a[i,j]);
 end;

 procedure vivod(a:matr);
 var i,j:integer;
 begin
 for i:=1 to n do
 begin
 for j:=1 to m do
 write(a[i,j]:5:2);
 writeln;
 end;
 end;

 function kolnul(a:matr; col: integer): integer;
 var
 i:integer;
 k: integer;
 begin
 k := 0;
 for i:=1 to m do
 if a[i, col]=0 then
 k := k + 1;
 kolnul := k;
 end;

 procedure minnul(var a:matr);
 var i,j,minN,kolN:integer;
 buf:real;
 begin
 minN:=1;
 kolN:=kolnul(a,minN);
 for i:=2 to m do
 if kolnul(a,i)<kolN then
 begin
 kolN:=kolnul(a,i);
 minN:=i;
 end;
 for i:=1 to n do
 begin
 buf:=a[i,minN];
 a[i,minN]:=a[i,1];
 a[i,1]:=buf;
 end;

 for i:=1 to N do
 begin
 writeln(i);
 if a[i, 1] = 0 then 
 begin 
 j := i;
 while (a[j,1] <> 0) or (j = n) do begin
 writeln(j);
 inc(j); 
 end;
 a[i, 1] := a[j, 1]
 end;
 for i:=n downto n - kolN + 1 do
 a[i, n] := 0;
 end;
 end;


 end.

program p2

dimension a(5,7)
real A
integer i,j,n,m
write(*,*)'BBedute N'
read(*,*)n
write(*,*)'BBedute M'
read(*,*)m
write(*,*)'BBedute A'
read(*,*)((A(i,j),j=1,5),i=1,5)

call kolnul(a,m,col)

write(*,*)'izm matrica'
write(*,36)((A(i,j),j=1,5),i=1,5)
36 Format((1x,5(F5,1,1x)))


 integer function kolnul(a,m,col)
 k=0
 do i=1,m
 if (a(i,col)==0) then
 k=k+1
 kolnul=k
 end do
 end

subroutine minnul(a,minN,kolN);
 integer i,j,minN,kolN
 real buf
 minN=1
 kolN=kolnul(a,minN)
 for i:=2 to m do
 if (kolnul(a,i)<kolN) then
 kolN=kolnul(a,i)
 minN=i
 do i=1,n
 buf=a(i,minN)
 a(i,minN)=a(i,1)
 a(i,1)=buf
 end do
end if
end