归并排序

const
  maxn=100000;
type
  arr=array[1..maxn] of longint;
var
  a:arr;
  n:longint;


procedure init;
var i:longint;
begin
  readln(n);
  for i:=1 to n do read(a[i]);
end;


procedure print;
var
  i:longint;
begin
  for i:=1 to n do
  write(a[i],' ');
end;


procedure merge(l,m,r:longint);
var
  i,j,k,p:longint;
  b:arr;
begin
  i:=l;j:=m+1;p:=0;
  while (i<=m) and (j<=r) do
  begin
    inc(p);
    if a[i]<=a[j] then
    begin
      b[p]:=a[i];
      inc(i)
    end
    else
    begin
      b[p]:=a[j];
      inc(j);
    end;
  end;
  for k:=i to m do
  begin
    inc(p);
    b[p]:=a[k];
  end;
  for k:=j to r do
  begin
    inc(p);
    b[p]:=a[k];
  end;
  for k:=l to r do
  a[k]:=b[k-l+1];
end;


procedure main;
var i,j,t,s:longint;
begin
  t:=1;
  while t<=n do
  begin
    s:=t;t:=2*s;i:=0;
    while i+t<=n do
    begin
      merge(i+1,i+s,i+t);
      i:=i+t;
    end;
    if i+s<n then merge(i+1,i+s,n);
  end;
end;


begin
  init;
  main;
  print;
end.