Внешняя сортировка слиянием

[Antihrist174]

Здравствуйте, помогите, пожалуйста, с такой задачкой:

Отсортируйте массив размера 50 000 методом слияния отрезков. Используйте 5 файлов для хранения отрезков. 20 - максимальное количество элементов в оперативной памяти. Используйте метод внутренней сортировки - Пузырек.

ЗЫ: нашел код, но не могу с ним до конца разобраться + он не работает с указанными выше значениями(где именно возникает проблема нашел, а исправить не могу). если не трудно помогите исправить и написать комментарии к процедурам

const
     FileName='file.txt';
     FileNew='File2.txt';
     AdditionalFilesNumber=12;  //файлов для хранения
     ElementsInMemory=24;       //элементов в памяти
     zero=ord('0');
 
type
    mas=array [0..49999] of integer;
    TFileArray=array [0..AdditionalFilesNumber-1] of text;
    bool=array [0..Additionalfilesnumber-1] of boolean;
 
 
var fa:TfileArray; f,f2:Text; fb:bool;
 
procedure CreateAdditionalFiles;
var i: integer;
begin
  for i:=low(TFileArray) to high(TFileArray) do
  begin
    if i>9 then
      assign(fa[i],'tmp1'+chr(i+38)+'.txt')
    else
      assign(FA[i],'tmp'+chr(i mod AdditionalFilesNumber+zero)+'.txt');
      rewrite(FA[i]);
  end;
end;
 
procedure ResetAdditionalFiles;
var i: integer;
begin
  for i:=low(TFileArray) to high(TFileArray) do
  begin
    if i>9 then
       assign(fa[i],'tmp1'+chr(i+38)+'.txt')
    else
       assign(FA[i],'tmp'+chr(i mod AdditionalFilesNumber+zero)+'.txt');
       reset(FA[i]);
  end;
end;
 
procedure CloseAdditionalFiles;
var i: integer;
begin
  for i:=low(TFileArray) to high(TFileArray) do
   close(FA[i]);
end;
 
procedure DeleteAdditionalFiles;
var i: integer;
begin
  for i:=low(TFileArray) to high(TFileArray) do
  begin
    if i>9 then
      assign(fa[i],'tmp1'+chr(i+38)+'.txt')
    else
      assign(FA[i],'tmp'+chr(i mod AdditionalFilesNumber+zero)+'.txt');
      erase(FA[i]);
  end;
  erase(f2);
end;
 
procedure AddaArrayFile2(a:mas;n:longint);
var i:integer;
begin
  Append(f2);
  for i:=0 to n do
    Write(f2,' ',a[i]);
end;
 
procedure AddaArrayFilename(a:mas;n:longint);
var i:integer;
begin
  Append(f);
  for i:=0 to n do
    Write(f,' ',a[i]);
end;
 
procedure AddArrayToOpenFile(fileID:integer; a:integer);
begin
  write(FA[fileID],' ',a);
end;
 
procedure sort(var a:mas;n:longint);
var i,j: longint; tmp:longint;
begin
 for i:=0 to n-1 do
   for j:=0 to n-1 do
     if a[j]>a[j+1]  then begin
       tmp:=a[j+1];
       a[j+1]:=a[j];
       a[j]:=tmp;
     end;
end;
 
procedure Input;
var i:longint; a:mas;
begin
  Assign(f,'File.txt');
  rewrite(f);
  randomize;
  for i:=0 to 5000 do
  begin
    a[i]:=random(9);
    write(f,' ',a[i]);
  end;
  close(f);
end;
 
procedure SortFile;
var i:integer; a:mas;
begin
  Assign(f,Filename);
  Reset(f);
  Assign(f2,Filenew);
  Rewrite(f2);
  while not eof(f) do
  begin
    for i:=0 to   ElementsInMemory-1 do
      if eof(f) then
        break
      else
        read(f,a[i]);
    sort(a,i-1);
    AddaArrayFile2(a,i-1);
  end;
  close(f);
  close(f2);
end;
 
procedure Partition(k:longint);
var i,z:longint; a:integer;
begin
  assign(f2,FileNew);
  Reset(f2);
  CreateAdditionalFiles;
  z:=0;
  while not eof(f2) do
  begin
    for i:=0 to k do
      if eof(f2) then
        break
      else begin
        read(f2,a);
        AddArrayToOpenFile(z,a);
      end;
    inc(z);
    if z=12 then z:=0;
  end;
  close(f2);
  CloseAdditionalFiles;
end;
 
function GetSeriesNumber: longint;
var f: text; previous,next,res:integer;
begin
  res:=1;
  assign(f,Filename);
  reset(f);
  read(f,next);
  while not eof(f) do
  begin
    previous:=next;
    read(f,next);
    if (next<previous) then inc(res);
  end;
  close(f);
  writeln(res);
  result:=res;
end;
 
function flag:boolean;
var i:integer;
begin
  Result:=false;
  for i:=low(fb) to high(fb) do
    if not fb[i] then begin
      Result:=true;
      break;
    end;
end;
 
procedure Merge(k:longint);
var i,j,z:longint; a:mas;
begin
  assign(f,filename);
  rewrite(f);
  ResetAdditionalFiles;
  while flag do begin
    z:=0;
    for i:=low(fa) to high(fa) do
      for j:=1 to k do
       if eof(fa[i]) then begin
         fb[i]:=true;
         break;
       end
       else begin
         read(fa[i],a[z]);
         inc(z);
       end;
    sort(a,z-1);
    AddaArrayFilename(a,z-1);
  end;
  CloseAdditionalFiles;
  Close(f);
end;
 
procedure flag2;
var i:integer;
begin
  for i:=low(fb) to high(fb) do
    fb[i]:=false;
end;
 
var k:longint;
 
begin
  input;
  k:=1;
  while getseriesnumber>1 do begin
    Sortfile;
    partition(k);
    Merge(k);
    flag2;
    K:=k*2;
  end;
  DeleteAdditionalFiles;
end.