Внешняя сортировка с использованием однофазного естественного слияния Опции

[ARMAGEDON]

Срочно нужна программа внешней сортировки с использованием однофазного естественного слияния на языке Pascal, желательно с комментариями, пояснениями, а то курсач на носу!!! People,помогите кто чем может)))

[ARMAGEDON]

НАРОД, это однофазная сортировка????

Сортировка естественным слиянием

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;

Добавлено через 6 мин.
или может быть вот эта сортировка однофазная????

Сортировка простым слиянием

Procedure MergeSort(name: string; var f: text);
          Var a1,a2,s,i,j,kol,tmp: integer;
              f1,f2: text;
              b: boolean;
          Begin
             kol:=0;
 
             Assign(f,name);
             Reset(f);
             While not EOF(f) do
               begin
                 read(f,a1);
                 inc(kol);
               End;
             Close(f);
 
             Assign(f1,'{имя 1-го вспомогательного файла}');
             Assign(f2,'{имя 2-го вспомогательного файла}');
 
             s:=1;
             While (s<kol) do
               begin
 
                 Reset(f); Rewrite(f1); Rewrite(f2);
                 For i:=1 to kol div 2 do
                   begin
                     Read(f,a1);
                     Write(f1,a1,' ');
                   End;
                 If (kol div 2) mod s<>0 then
                   begin
                     tmp:=kol div 2;
                     While tmp mod s<>0 do
                       begin
                         Read(f,a1);
                         Write(f1,a1,' ');
                         inc(tmp);
                       End;
                   End;
                 While not EOF(f) do
                   begin
                     Read(f,a2);
                     Write(f2,a2,' ');
                   End;
                 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
                     i:=0; j:=0;
                     b:=true;
                     While (b) and (not EOF(f1)) and (not EOF(f2)) do
                       begin
                         If (a1<a2) then
                           begin
                             Write(f,a1,' ');
                             Read(f1,a1);
                             inc(i);
                           End
                         else
                           begin
                             Write(f,a2,' ');
                             Read(f2,a2);
                             inc(j);
                           End;
                         If (i=s) or (j=s) then b:=false;
                       End;
                     If not b then
                       begin
                         While (i<s) and (not EOF(f1)) do
                           begin
                             Write(f,a1,' ');
                             Read(f1,a1);
                             inc(i);
                           End;
                         While (j<s) and (not EOF(f2)) do
                           begin
                             Write(f,a2,' ');
                             Read(f2,a2);
                             inc(j);
                           End;
                       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);
 
                 s:=s*2;
               End;
             Erase(f1);
             Erase(f2);
          End;