old/PAS/Sortir/files.PAS

const
 inp  = 'input.dat';
 nF1  = 'F1.dat';
 nF2  = 'F2.dat';
 n    = 20;
type
  TArr =  array [1..n] of integer;
Var
  F,F1,F2 : file of integer;
  Lser    : longint;
  i,j     : longint;
  TMP     : integer;

Procedure Merge;
var i,j     : integer;
    k1,k2,k : longint;
    FL      : boolean;
begin
 if not EOF(F2) then begin
 Read(F1,i);
 Read(F2,j);
 k1 := 1;
 k2 := 1;
 FL := false;
 repeat
   if (I<J) then
    begin
     Write(F,I);
     inc(k1);
     if (k1 <= Lser) then
     Read(F1,i);
    end
   else
    begin
     if EOF(F2) then FL := true;
     Write(F,J);
     inc(k2);
     if (k2 <= Lser) and (not EOF(F2)) then
     Read(F2,j);
    end;
 until FL or (K1>Lser) or (k2>lser);

 if (K1>Lser) then
    Write(F,j)
 else
    Write(F,i);

 for k := k1 to lSer-1 do
  begin
    Read(F1,i);
    Write(F,i);
  end;

 if NOT EOF(F2) then
 for k := k2 to lSer-1 do
  begin
    Read(F2,j);
    Write(F,j);
  end;

  end

  else If NOt EOF(F1) then
   repeat
     Read(F1,i);
     Write(F,i);
   until EOF(F1)

end;

BEGIN
  Assign(F,inp);
  Assign(F1,nF1);
  Assign(F2,nF2);
  lser := 1;

    repeat
     Rewrite(F1);
     Rewrite(F2);
     Reset(F);
     for i := 1 to n div Lser + 1 do
     begin
       for j := 1 to Lser do
         begin
           if NOT EOF(F) then begin Read(F,tmp);
           if Odd(i) then Write(F1,tmp) else Write(F2,tmp);end;
         end;
     end;

     Reset(F1);
     Reset(F2);
     i := 1;
     ReWrite(F);
     for i := 1 to (N div (2*Lser)+1) do Merge;
     lser := lser shl 1;
    until lser > N;
    Close(F1);
    Close(F2);
    Close(F);
END.