Untitled

program sort;
var
   f,f1,f2  : text;
   n1,n2    : integer;
   fragsize : integer;
   k	    : integer;
function filesize(var f: text) : integer;
var
   size	: integer;
begin
   reset(f); size := 0;
   while not eof(f) do begin readln(f); inc(size) end;
   filesize := size
end; { filesize }

procedure two(n	: integer);
begin
   reset(f); rewrite(f1); rewrite(f2);
   while not eof(f) do begin
      for k := 1 to n do if (not eof(f)) then begin
	 readln(f,n1); writeln(f1,n1)
      end;
      for k := 1 to n do if (not eof(f)) then begin
	 readln(f,n2); writeln(f2,n2)
      end
   end;
   close(f1); close(f2)
end; { two }

procedure one(n	: integer);
begin
   reset(f1); reset(f2); rewrite(f);
   readln(f1,n1); readln(f2,n2);
   while (not eof(f1)) and (not eof(f2)) do begin
      for k := 1 to n do begin
	 if (n1 > n2) then begin writeln(f,n2); writeln('##',n2); readln(f2,n2) end;
	 if (n1 < n2) then begin writeln(f,n1); writeln('##',n1); readln(f1,n1) end;
	 if (n1 = n2) then begin writeln(f,n1); writeln(f,n2); readln(f1,n1); readln(f2,n2) end;
      end
   end;
   if (not eof(f1)) then while not eof(f1) do begin readln(f1,n1); writeln(f,n1); writeln('##',n1) end;
   if (not eof(f2)) then while not eof(f2) do begin readln(f2,n2); writeln(f,n2); writeln('##',n2) end;
   close(f)
end; { one }

begin
   assign(f,'f.txt'); assign(f1,'f1.txt'); assign(f2,'f2.txt');
   fragsize := 1;
   while (fragsize <= filesize(f)) do begin
      writeln('Длина фрагмента ',fragsize);
      writeln('Делим');
      two(fragsize);
      writeln('Сливаем');
      one(fragsize);
      fragsize := fragsize*2
   end;
   writeln('Конец');
end.