Mine

program sort;
var
   f,f1,f2	: text;
   n1,n2	: integer;
   size,maxsize	: integer;
procedure two(n	: integer);
var
   k : integer;
begin
   while not eof(f) do begin
      for k := 1 to n do begin readln(f,n1); writeln(f1,n1); end;
      for k := 1 to n do begin readln(f,n2); writeln(f2,n2); end;
   end;
end; { part }

procedure one(n	: integer);
var
   k1,k2 : integer;
   ts,ns : integer;
begin
   while (not eof(f1)) and (not eof(f2)) do begin
      for k1 := 1 to n do begin
	 readln(f1,n1); ts := n1;
	 for k2 := 1 to n do begin
	    readln(f2,n2); ns := n2;
	    if ts >= ns then begin writeln(f,ns); end else begin writeln(f,ts); ts := ns; end;
	 end;
      end;
   end;
end; { one }

begin   
   assign(f,'f.txt'); assign(f1,'f1.txt'); assign(f2,'f2.txt');
   size := 1; maxsize := 0;
   reset(f);
   while not eof(f) do begin readln(f); inc(maxsize); end;
   while size <= maxsize do begin
      reset(f); rewrite(f1); rewrite(f2);
      two(size);
      size := size * 2;
      close(f); close(f1); close(f2);
      rewrite(f); reset(f1); reset(f2);
      one(size);
      close(f); close(f1); close(f2);
   end;
end.