Нашел следующий алгоритм:
Procedure MergeSort(name: string; var f: text);
Var s1,s2,a1,a2,where,tmp: integer;
f1,f2: text;
Begin
s1:=5; s2:=5; {Можно задать любые числа, которые запустят цикл while}
Assign(f,name);
Assign(f1,'{имя 1-го вспомогательного файла}');
Assign(f2,'{имя 2-го вспомогательного файла}');
While (s1>1) and (s2>=1) do
begin
where:=1;
s1:=0; s2:=0;
Reset(f); Rewrite(f1); Rewrite(f2);
Read(f,a1);
Write(f1,a1,' ');
While not EOF(f) do
begin
read(f,a2);
If (a2<a1) then
begin
Case where of
1: begin
where:=2;
inc(s1);
End;
2: begin
where:=1;
inc(s2);
End;
End;
End;
Case where of
1: write(f1,a2,' ');
2: write(f2,a2,' ');
End;
a1:=a2;
End;
If where=2 then
inc(s2)
else
inc(s1);
Close(f); Close(f1); Close(f2);
Rewrite(f); Reset(f1); Reset(f2);
Read(f1,a1);
Read(f2,a2);
While (not EOF(f1)) and (not EOF(f2)) do
begin
If (a1<=a2) then
begin
Write(f,a1,' ');
Read(f1,a1);
End
else
begin
Write(f,a2,' ');
Read(f2,a2);
End;
End;
While not EOF(f1) do
begin
tmp:=a1;
Read(f1,a1);
If not EOF(f1) then
Write(f,tmp,' ')
else
Write(f,tmp);
End;
While not EOF(f2) do
begin
tmp:=a2;
Read(f2,a2);
If not EOF(f2) then
Write(f,tmp,' ')
else
Write(f,tmp);
End;
Close(f); Close(f1); Close(f2);
End;
Erase(f1);
Erase(f2);
End;
Но, как я понимаю, это двухфазный алгоритм, а мне надо реализовать однофазный. Заранее благодарю всех ответивших.