Помогите пожалуйста решить задачу в Паскале!

uses crt;
const n=10;
var a:array[1..n,1..n] of Integer;
i,j:Integer;
function sred(s:Integer):real;var p,m:Integer;begin m:=0;for p:=1 to n do inc(m,a[p,s]);sred:=m/n;end;
procedure change; var x,t:Integer; begin for x:=1 to n do begin t:=a[x,i];a[x,i]:=a[x,j];a[x,j]:=t;end;end;
begin
randomize;clrscr;
for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=Random(1000);write(a[i,j]:4,' ');end;writeln;end;
for i:=1 to n do for j:=1 to n do if sred(i)< sred(j) then change;
writeln('Result array:');
for i:=1 to n do begin for j:=1 to n do write(a[i,j]:4,' ');writeln;end;
end.

У меня получилось длинно, и массив большой делать лень:
program p;
var i,j:integer;
a:array [1..3,1..3] of integer = ((4,5,6),(7,8,9),(1,2,3));

procedure exchange(k:integer);
var i,t:integer;
begin
for i:=1 to 3 do
begin
t:=a[ k, i]; a[ k, i]:=a[ k+1, i]; a[ k+1, i]:=t;
end;
end;

procedure sort(k:integer);
var i,j,s1,s2:integer;
begin
for j:=k to 2 do
begin
s1:=0;s2:=0;
for i:=1 to 3 do
begin
s1:=a[ i, j]+s1; s2:=a[ i+1, j]+s2;
end;
if s2 < s1 then exchange(j); // среднее искать не надо -делитель один, достаточно суммы
end;
end;

begin
for i:=1 to 2 do
sort(i);
for i:=1 to 3 do
begin
for j:=1 to 3 do write(a[j,i],' ');
writeln();
end;
end.

среднему арифметическому каждого столбца смогла найти?
for i:= 1 to n do
begin
for i:= 1 to m do
sum:= sum + mas[ j,i];
masSredArifm[ i ] := sum/m;
end;
а далее сортируй полученный массив среднеарифметических и соответствующий столбец исходного массива