Type
 Ar=Array[1..255] of Byte;

Var
 A:Ar;
 k,N,i:Byte;

Procedure Exch(q:byte; var C:Ar);
Var
 Mx1,Mx2:Integer;
 D,m,p:byte;
begin
 p:=1+q;
 Mx1:=-1;
 for m:=1+q to N do
  if (C[m]>Mx1) and ((C[m] mod 2)=1) then
   begin
    p:=m;
    Mx1:=C[p];
   end;
 if Mx1>-1 then
  begin
   D:=C[1+q];
   C[1+q]:=C[p];
   C[p]:=D;
  end;
 p:=1+q;
 Mx2:=-1;
 for m:=1+q to N-q do
  if (C[m]>Mx2) and ((C[m] mod 2)=0) then
   begin
    p:=m;
    Mx2:=C[p];
   end;
 if Mx2>-1 then
  begin
   D:=C[N-q];
   C[N-q]:=C[p];
   C[p]:=D;
  end;
end;

Begin
 Randomize;
 Write(' N = ');
 Readln(N);
 Writeln('Initial array:');
 for i:=1 to N do
  begin
   A[i]:=Random(100);
   write(A[i]:4);
  end;
 writeln;
 writeln;

 for k:=0 to N-1 do Exch(k,A);

 Writeln('Ordered array:');
 for i:=1 to N do write(A[i]:4);

 Readln
End.

uses  Crt;
const n=10;
var   a:array[1..n] of integer;
      i,t,ti,k,m,p:integer;
begin
  ClrScr;
   Randomize;
    for i:=1 to n do
      begin
        a[i]:=Random(99)+1;
        Write(a[i]:4);
      end; Writeln; Writeln;
   m:=1; k:=n; p:=0;
    repeat  
      Inc(p);
      t:=0; 
      for i:=m to k do
       if a[i]>t then
         begin
           t:=a[i]; ti:=i;
         end;
      if (p mod 2)<>0
       then
         begin
           for i:=ti downto m+1 do
            a[i]:=a[i-1];
           a[m]:=t;
           Inc(m);
         end
       else
         begin
           for i:=ti to k-1 do
            a[i]:=a[i+1];
           a[k]:=t;
           Dec(k);
         end;
    until (m=k);
     for i:=1 to n do
      Write(a[i]:4);
  Readkey;
end.

var
  arRnd: array of integer;
const
  maxValue = 60; // Max value of rnd
  maxLen = 31; // arRnd.Length

function Even_ahead(ar: array of integer): integer;
var k: integer = 0;
var x: integer;
begin
  for var i :=0 to ar.Length-1 do
    if not Odd(ar[i]) then
      begin
        x := ar[i];
        for var j := i downto k+1 do
          ar[j] := ar[j-1];
        ar[k] := x;
        Inc(k);
      end;
  Result := k;    
end;

procedure _Swap(ar: array of integer; i,j: integer);
var x: integer;
begin
  x := ar[i];
  ar[i]:=ar[j];
  ar[j]:=x;
end;

procedure Odd_Sort(ar: array of integer; k: integer);
var x: integer;
begin
  for var i := k to ar.Length-2 do
    for var j :=i to ar.Length-1 do
      if ar[i] > ar[j] then _Swap(ar,i,j);
end;

procedure Even_Sort(ar: array of integer; k: integer);
var x: integer;
begin
  for var i:=0 to k-2 do
    for var j :=i to k-1 do
      if ar[i] < ar[j] then _Swap(ar,i,j);
end;
  
begin
  SetLength(arRnd, maxLen);

  for var i := Low(arRnd) to High(arRnd) do
    arRnd[i] := random(MaxValue + 1);

  write('rnd=', arRnd.Length,' ', arRnd);
  writeln();
  
  var k: integer = 0;

// Тело основного цикла
  k := Even_Ahead(arRnd);
  Even_Sort(arRnd, k);
  Odd_Sort(arRnd, k);


  write('rnd=', arRnd.Length,' ', arRnd);
  writeln();

end.

var
  ar: array of integer;
const
  maxValue = 60; // Max value of rnd
  maxLen = 19; // ar.Length

procedure _Swap(ar: array of integer; i,j: integer);
var x: integer;
begin
  x := ar[i];
  ar[i]:=ar[j];
  ar[j]:=x;
end;
  
begin
// Init  
  SetLength(ar, maxLen);
  for var i := Low(ar) to High(ar) do
    ar[i] := random(MaxValue + 1);

  write('rnd= ', ar.Length,' ', ar);
  writeln();

// Body  
  var k: integer = 0;
  var x: integer;
  
// Even to head
  for var i :=0 to ar.High do
    if not Odd(ar[i]) then begin
        x := ar[i];
        for var j := i downto k+1 do
          ar[j] := ar[j-1];
        ar[k] := x;
        Inc(k);
    end;
// Sort even
  for var i:=0 to k-2 do
    for var j :=i to k-1 do
      if ar[i] < ar[j] then _Swap(ar,i,j);
// Sort odd
  for var i := k to ar.High-1 do
    for var j :=i to ar.High do
      if ar[i] > ar[j] then _Swap(ar,i,j);

  write('sort=', ar.Length,' ', ar);
  writeln();
 
end.

begin
  var ar := Seq(45,46,8,11,5,29,37,0,21,43,4,5,58,34,14,18,40,46,30);
  ar.Where(x -> x mod 2 = 0).SortedDescending.Print;
  Print('');
  ar.Where(x -> x mod 2 <> 0).Sorted.Print;
end.

58 46 46 40 34 30 18 14 8 4 0 5 5 11 21 29 37 43 45