const
 n=10;
var
 mas : array[1..2*n] of real;
 i : integer;
{--------------------------------------------------------------------------}
procedure mergesort;
var
 i,j,k,l,t,h,m,lser,q,r : integer;
 up : BooLean;
begin
 up:=true;
 lser:=1;
 repeat
  h:=1;
  m:=n;
  if up then begin i:=1; j:=n; k:=n+1; l:=2*n; end
  else begin k:=1; l:=n; i:=n+1; j:=2*n; end;
  repeat
   if lser<=n then q:=lser
   else q:=m; m:=m-q;
   if lser<=m then r:=lser
   else r:=m; m:=m-r;
   while (q<>0) and (r<>0) do
    begin
     if mas[i]<mas[j] then begin mas[k]:=mas[i]; k:=k+h; i:=i+1; q:=q-1; end
     else begin mas[k]:=mas[j]; k:=k+h; j:=j-1; r:=r-1; end
    end;
   while r<>0 do
    begin mas[k]:=mas[j]; k:=k+h; j:=j-1; r:=r-1; end;
   while q<>0 do
    begin mas[k]:=mas[i]; k:=k+h; i:=i+1; q:=q-1; end;
   h:=(-h); t:=k; k:=l; l:=t;
  until m=0;
  up:=not(up);
  lser:=2*lser;
 until lser>=n;
 if not(up) then
  for i:=1 to n do
   mas[i]:=mas[i+n];
end;
{-------------------------------------------------------------------------}
begin
 randomize;
 WriteLn('Было :');
 for i:=1 to n do
  begin
   mas[i]:=random(100);
   Write('   ',mas[i]:0:2);
  end;
 mergesort;
 WriteLn;
 Writeln('Стало :');
 for i:=1 to n do
  Write('   ',mas[i]:0:2);
 for i:=2 to n do
  if mas[i]<mas[i-1] then begin WriteLn('ERROR!!!'); break;end;

 ReadLn;
end.


