uses
 crt;
var
 n,m,k,i,j,t:integer;
 a:array[1..10,1..10,1..10] of integer;
procedure swap(var x,y,z:integer);
   var t,q:integer;
 begin
    t := x;
    x := y;
    y := z;
    z := t;
 end;
begin
 clrscr;
 writeln ('vvod poryadok matrica n');
 readln (n);
 m:=n; k:=n; 
 randomize;
   for i := 1 to n do
   for j := 1 to m do
   for t := 1 to k do
   a[i, j, t] := Random(10);
      for i := 1 to n do
      begin
      for j := 1 to m do
      begin
      for t := 1 to k do
      write(a[i,j,t]);
      writeln;
      end;
      end;
   for k:=1 to n-1 do
   for j:=1 to n-k do
   for i:=1 to n-j do
   begin
   if (a[i,j,k] > a[i+1,j,k]) and (a[i,j,k] > a[i+2,j,k])  then
   swap(a[i,j,k],a[i+1,j,k],a[i+2,j,k]);
   end;
     for i := 1 to n do
     begin
     for j := 1 to m do
     begin
     for t := 1 to k do
     write(a[i,j,t]);
     writeln;
     end;
     end;
end. 

Цитата(klik1602 @ 13.01.2011 18:54)

type
  tElement= integer;

const
  n= 3;
  m= 6;
  k= 8;
  l= n*m*k;

var
  a: array [1..n,1..m,1..k] of integer;
  b: array [1..l] of integer absolute a;


procedure Show;
var
  i,j,t: integer;
begin
  for i:= 1 to n do begin
    WriteLn(i,':');
    for j:= 1 to m do begin
      for t:= 1 to k do Write(a[i,j,t]:4);
      WriteLn
    end;
    WriteLn
  end
end;


var
  i,j,t: integer;
  buf: tElement;

begin
  for i := 1 to n do
    for j := 1 to m do
      for t := 1 to k do
        a[i, j, t] := Random(100)-49;

  Show;

  { Сквозная сортировка }
  for i:=2 to l do
    for j:=l downto i do if b[j-1]>b[j] then begin
      buf:= b[j-1];
      b[j-1]:= b[j];
      b[j]:= buf
    end;

  WriteLn('Отсортированный массив:');
  Show;

  ReadLn
end.

type
  vector = array[1 .. L] of telement;

// и дальше где-то привести:
vector(a)[i] := ...

type
   TElement= integer;
const
   n= 3;
   m= 6;
   k= 8;
   L = n*m*k;

var
   a : array [1 .. n, 1 .. m, 1 .. k] of TElement;

procedure Show;
var i, j, t : integer;
begin
   for i:= 1 to n do
   begin
      WriteLn(i,':');
      for j:= 1 to m do
      begin
         for t:= 1 to k do Write(a[i,j,t]:4);
         WriteLn
      end;
      WriteLn
   end
end;

type
   indexes = 
   record
      m, n, k : integer;
   end;
   
function decr(ix : indexes) : indexes;
begin
   result := ix;
   dec(result.k);
   if result.k = 0 then
   begin
      result.k := k;
      dec(result.m);
      if result.m = 0 then
      begin
         result.m := m;
         dec(result.n);
      end;
   end;
end;

const
   last : indexes = (m: m; n: n; k: k);
var
   curr, prev: indexes;
   
   i, j, t: integer;
   buf : TElement;
   
begin
   for i := 1 to n do
      for j := 1 to m do
         for t := 1 to k do
            a[i, j, t] := Random(100)-49;

   Show;
   
   for i := 2 to L do
   begin
      curr := last; prev := decr(last);
      
      for j:= L downto i do
      begin
         if a[prev.n, prev.m, prev.k] > a[curr.n, curr.m, curr.k] then 
         begin
            buf := a[prev.n, prev.m, prev.k];
            a[prev.n, prev.m, prev.k] := a[curr.n, curr.m, curr.k];
            a[curr.n, curr.m, curr.k] := buf
         end;
         curr := prev; prev := decr(prev);
      end;

   end;
   WriteLn('Отсортированный массив:');
   Show;
   ReadLn
end.