old/PAS/Sortir/FONNEU.PAS

const
 inp = 'input.txt';
 out = 'output.txt';
 N = 20;
type
  TArr =  array [1..n] of integer;
Var
  F       : text;
  A,R,tmp : ^TArr;
  Lser    : 1..N;
  i,j     : 1..N;

Procedure InArr(FileName : string);
var i : 1..n;
Begin
  Assign(F,FileName);
  Reset(F);
  i := 1;
  repeat
    read(F,A^[i]);
    inc(i)
  until EOF(F);
  Close(F);
end;

Procedure Merge(beg,ends:word);
var k,i,j,pos : 1..n;
begin
 i := beg;j := beg+lser;pos:=beg;
 if J<=N then begin
 repeat
   if a^[i] < a^[j] then
     begin R^[pos] := A^[i];inc(i);end
   else
     begin R^[pos] := A^[j];inc(j);end;
   inc(pos);
 until (i>beg+lser-1) or (j>ends);

 for k := i to beg+lser-1 do begin R^[pos] := a^[k];inc(pos);end;
 for k := j to ends do begin R^[pos] := a^[k];inc(pos);end;
 end
 else
  for k := beg to N do begin R^[pos] := A^[k];inc(pos);end;
end;

Procedure OutArr(OutName:string);
var i :1..n;
Begin
  Assign(F,OutName);
  ReWrite(F);
  for i := 1 to n do if (i mod 8) = 0 then WriteLn(F,A^[i]:8) else
      Write(F,A^[i]:8);
  Close(F);
End;

BEGIN
  New(A);
  New(R);

  For i := 1 to n do begin A^[i] :=0;R^[i] := 0;end;

  InArr(inp);
  lser := 1;

  repeat
    i := 1;
    repeat
      if I+lser*2-1 < n then Merge(i,I+lser*2-1)
        else Merge(i,N);
      inc(i,lser*2);
    until i>n;
    tmp:=A;
    A := R;
    R:=tmp;
    lser := lser shl 1;
  until lser > N;
  OutArr(Out);
  Dispose(A);
END.