Задача на массив

[Юрии Александрович]

Дан двумерный массив действительных чисел размером NxN.
Поменять местами строки с номерами 1 и 3, 4 и 6, 7 и 9 и т. д.
Вот программа

uses crt;
const n=9;
type mas=array [1..n,1..n] of integer;
procedure vvod(var m:mas);
 var j,i:integer;
  begin
  for i:=1 to n do
    for j:=1 to n do
     m[i,j]:=random(15);
  end;
procedure vivod(var m:mas);
 var i,j:integer;
 begin
 for i:=1 to n do
   begin
   for j:=1 to n do
   write(m[i,j]:3);
   writeln;
   end;
 writeln;
end;
procedure ssort (var m:mas);
 var j,i,k,p,d:byte;
 begin
   k:=3; i:=1;
 while  k <= n do
 begin
  for j:=1 to n do
   begin
    p:=m[i,j];
    m[i,j]:=m[k,j];
    m[k,j]:=p;
    end;
 i:=i+k;
 k:=k+k;
end;
end;
var m:mas;
begin
randomize;
ClrScr;
vvod(m);
vivod(m);
ssort(m);
vivod(m);
readln;
end.

[Abbatik]

что не работает?

[Юрии Александрович]

Не меняет последние строки местами!

[Abbatik]

procedure ssort (var m:mas);   
 var j,i,k,p,d:byte;   
 begin  
   k:=3; i:=1;   
 while  i <= n do  
 begin  
 [b] for j:=1 to n do  
   begin  
    p:=m[i,j];   
    m[i,j]:=m[i+2,j];   
    m[i+2,j]:=p;   
    end;   
 i:=i+3;
 end;   
end;

так вроде работает!

[Юрии Александрович]

k задает номера строк 3 6 9
i задает номера строк 1. 4. 7

[Abbatik]

procedure ssort (var m:mas);   
 var j,i,k,p,d:byte;   
 begin  
   k:=3; i:=1;   
 while  i <= n do  
 begin  
for j:=1 to n do  
   begin  
    p:=m[i,j];   
    m[i,j]:=m[i+2,j];   
    m[i+2,j]:=p;   
    end;   
 i:=i+3;
 end;   
end;

так должно работать!