Внутреннее естественное слияние

(*******************************************************
Процедура для сортировки массива.
Принимает:
    *массив значений a с индексами элементов от 0 до N-1
    *число элементов N
*******************************************************)
procedure NeumanSort(var Arr : array of Real; N : Integer);
type
    PTArr = ^TArr;
    TArr = array[0 .. pred(maxint div sizeof(real))] of real;
var
    C           :   Boolean;
    I,I1,I2,
    N1,N2,J,K   :   Integer;
    Tmp         :   Real;
    BArr        :   PTArr;
    MergeLen    :   Integer;
begin
    GetMem(BArr, (N - 1) * sizeof(real));
 
    MergeLen:=1;
    c:=True;
    while MergeLen<n do
    begin
        if C then
        begin
            i:=0;
            while i+MergeLen<=n do
            begin
                i1:=i+1;
                i2:=i+MergeLen+1;
                n1:=i+MergeLen;
                n2:=i+2*MergeLen;
                if n2>n then n2:=n;
                while (i1<=n1)or (i2<=n2) do
                begin
                    if i1>n1 then
                    begin
                        while i2<=n2 do
                        begin
                            inc(i);
                            BArr^[i-1]:=Arr[i2-1];
                            i2:=i2+1
                        end;
                    end
                    else
                    begin
                        if i2>n2 then
                        begin
                            while i1<=n1 do
                            begin
                                inc(i);
                                BArr^[i-1]:=Arr[i1-1];
                                i1:=i1+1
                            end;
                        end
                        else
                        begin
                            if Arr[i1-1]>Arr[i2-1] then
                            begin
                                inc(i);
                                BArr^[i-1]:=Arr[i2-1];
                                i2:=i2+1
                            end
                            else
                            begin
                                inc(i);
                                BArr^[i-1]:=Arr[i1-1];
                                i1:=i1+1
                            end;
                        end;
                    end;
                end;
            end;
            i:=i+1;
            while i<=n do
            begin
                BArr^[i-1]:=Arr[i-1];
                inc(i);
            end;
        end
        else
        begin
            i:=0;
            while i+MergeLen<=n do
            begin
                i1:=i+1;
                i2:=i+MergeLen+1;
                n1:=i+MergeLen;
                n2:=i+2*MergeLen;
                if n2>n then n2:=n;
                while (i1<=n1)or (i2<=n2) do
                begin
                    if i1>n1 then
                    begin
                        while i2<=n2 do
                        begin
                            inc(i);
                            Arr[i-1]:=BArr^[i2-1];
                            i2:=i2+1
                        end;
                    end
                    else
                    begin
                        if i2>n2 then
                            while i1<=n1 do
                            begin
                                inc(i);
                                Arr[i-1]:=BArr^[i1-1];
                                i1:=i1+1
                            end
                        else
                        begin
                            if BArr^[i1-1]>BArr^[i2-1] then
                            begin
                                inc(i);
                                Arr[i-1]:=BArr^[i2-1];
                                i2:=i2+1
                            end
                            else
                            begin
                                inc(i);
                                Arr[i-1]:=BArr^[i1-1];
                                i1:=i1+1
                            end;
                        end;
                    end;
                end;
            end;
            inc(i);
            while i<=n do
            begin
                Arr[i-1]:=BArr^[i-1];
                inc(i);
            end;
        end;
        MergeLen:=2*MergeLen;
        c:=not(C);
    end;
    if not(C) then
    begin
        i:=1;
        repeat
            Arr[i-1]:=BArr^[i-1];
            inc(i);
        until not(i<=n);
    end;
 
    FreeMem(BArr, (N - 1) * sizeof(real));
end;