Упорядочить столбцы матрицы по возрастанию максимальных элементов столбцов методом линейной вставки

Program z1;
  Uses crt;
  Type mas=array[1..100,1..100] of real;
  Var i,j,k,n,imin,jmin:byte;
      min:real;
      a:mas;
  Begin clrscr;
    write('n='); readln(n);
    for i:=1 to n do
     for j:=1 to n do
       begin
     write('a(',i,',',j,')=');
     readln(a[i,j]);
       end;
    min:=a[1,1];
    for i:=1 to n do
      begin
    for j:=1 to n do
     if min>a[i,j] then
       begin
         min:=a[i,j];
         imin:=i;
         jmin:=j;
       end;
      end;
    k:=0;
    for i:=1 to n do
      begin
    for j:=1 to n do
     if a[i,j]=min then k:=k+1;
      end;
    for i:=1 to n do
      begin
    for j:=1 to n do
     if (k>3) and (imin=jmin) then
 
     {Вот тут должна идти сортировка...извини дальше не знаю, могу
          отсортировать методом "пузырька" если хочешь}

program marazm;
uses crt;
const
   maxelements=100;
 
var
   slovo:array[0..maxelements] of string;
   stroka,strokaTEMP:string;
   i,k,y,x,m:byte;
 
 
 
function FirstIsMax(a:array of string;y:integer):boolean;
      var i:integer;
      begin
           FirstIsMax:=true;
              For i:=1 to y do
                   begin
                     If a[i]>a[0] then FirstIsMax:=false;break;
                   end;
             end;
 
 
begin
writeln('Enter words(not more than ',maxelements, '):  ');
 readln(stroka);strokaTEMP:=stroka;
 
 For i:=0 to length(stroka) do
   begin
     if (stroka[i]=' ') and (stroka[i]<>stroka[i+1]) then inc(m);
   end;
 
 For k:=0 to m do
   begin
     For i:=1 to length(stroka) do
       If (stroka[i]<>' ')   then
         begin
           insert(stroka[i], slovo[k], i);inc(y);
         end
 
       else  if (stroka[i]=' ') and (stroka[i-1]<>' ') and (stroka[i-1]<>stroka[length(stroka)+1])  then
         begin
           delete(stroka, 1, i);
           break;
         end
 
       else if (stroka[i]=' ') and (stroka[i+1]=' ') then delete(stroka, 1, 1);
   end;
 
 
If FirstIsMax(slovo,y)=true then
   begin
     For i:=1 to m do
       begin
          x:=length(slovo[0]);
          If slovo[i][length(slovo[i])]=slovo[0][x] then
            begin
              slovo[m+i]:=slovo[i];
              slovo[i]:='0';
            end;
       end;
 
  writeln;
  Writeln('Ishodniy text: ');writeln(StrokaTemp, '.');
  writeln;
  writeln('Pervoe slovo: ',slovo[0]);
  writeln;
  writeln('Otredaktirovanniy text');
  For  i:=0 to 2*m do if slovo[i]<>'0' then write(slovo[i], ' ');
 end
 
else writeln('Pervoe slovo ne maximalnoe');
 
writeln('Press enter to exit');
readln;
end.