Сортировка методом вставки чётных и нечётных чисел

Program ctrCcrtV;
uses    crt;
const   n=20;
var     i,k,pa,ne,temp,j,l:integer;
        a:array[1..n] of integer;
        pr:array[1..n] of integer;
        np:array[1..n] of integer;
Begin
textbackground(lightgray);
textcolor(black);
clrscr;
for i:=1 to n do
 Begin
 write('Enter a[',i,']: ');
 readln(a[i]);
 End;
 
for i:=1 to n do
 if odd(a[i])=false then
 Begin
 inc(pa);
 for k:=pa to pa do
 pr[k]:=a[i];
 End
 else if odd(a[i])=true then
 Begin
 inc(ne);
 for k:=ne to ne do
 np[k]:=a[i];
 End;
writeln;
writeln;
textcolor(green);
writeln('Chetnye: ');
for k:=1 to pa do
write(pr[k],' ');
writeln;
writeln;
textcolor(magenta);
writeln('Nechetnye: ');
for k:=1 to ne do
write(np[k],' ');
 
for k:=2 to pa do
Begin
temp:=pr[k];
j:=k-1;
while (j>=1) and (pr[j]>temp) do
Begin
pr[j+1]:=pr[j];
j:=j-1;
End;
pr[j+1]:=temp;
End;
 
for k:=2 to ne do
Begin
temp:=np[k];
j:=k-1;
while (j>=1) and (np[j]<temp) do
Begin
np[j+1]:=np[j];
j:=j-1;
End;
np[j+1]:=temp;
End;
writeln;
writeln;
textcolor(red);
writeln('Sort chetnye ');
for k:=1 to pa do
write(pr[k],' ');
textcolor(lightblue);
writeln;
writeln;
writeln('Sort nechetnye: ');
for k:=1 to ne do
write(np[k],' ');
 readln;
 
for i:=1 to pa do
a[i]:=pr[i];
l:=0;
for i:=pa+1 to n do
Begin
inc(l);
a[i]:=np[l];
End;
textcolor(blue);
writeln;
writeln('Sorted array: ');
for i:=1 to n do
write(a[i],' ');
 
readln;
End.

{
[url]https://www.cyberforum.ru/turbo-pascal/thread1384197.html[/url]
Организовать массив, что состоит из 20 целых чисел.
 Упорядочить отдельно чётные элементы по возрастанию, а после - нечётные по убыванию.
}
program DualSort;
 
const
  Nmax = 10;
type
  TArray = array[0..Nmax - 1] of integer;
  TIndex = array[0..Nmax - 1] of integer;
 
  procedure GetIndexes(const a: TArray; var Indx: TIndex; var n: integer;
    ParityEven: boolean);
  var
    i: integer;
  begin
    n := 0;
    for i := low(a) to high(a) do
      if odd(a[i]) xor ParityEven then
      begin
        Indx[n] := i;
        Inc(n);
      end;
  end;
 
  procedure sort(var a: TArray; const Indx: TIndex; n: integer; DirectUp: boolean);
  var
    i, j: integer;
    x: integer;
  begin
    if n < 2 then
      Exit;
    for i := 0 to n - 1 do
      for j := i + 1 to n - 1 do
      begin
        if (a[Indx[i]] < a[Indx[j]]) xor DirectUp then
        begin
          x := a[Indx[i]];
          a[Indx[i]] := a[Indx[j]];
          a[Indx[j]] := x;
        end;
      end;
  end;
 
var
  a: TArray = (8, 1, 6, 3, 4, 5, 2, 7, 0, 9);
  i: integer;
  Indexes: TIndex;
  Len: integer;
begin
  GetIndexes(a, Indexes, Len, True);
  sort(a, Indexes, Len, true);
  GetIndexes(a, Indexes, Len, False);
  sort(a, Indexes, Len, False);
  for i := low(a) to high(a) do
    Write(a[i]: 4);
  writeln;
end.