Получить массив В путем перебора элементов массива А с нечетным индексом

   Program Z1_2_11;
  uses crt;
  type
   Arr=array [1..30] of integer;
   PArr=^Arr;
  var
   a,b:PArr;
   i,d,max,kl:integer;
   t:text;
   ch:char;
 
  Procedure VvodI (var ni:integer);
   begin
    repeat
     Writeln ('Vvedite kolichestvo elementov massiva');
     readln (ni);
     if ni<=0 then
      writeln ('Error!');
    until (ni>0);
    writeln (t,' kolichestvo elementov=',ni);
   end;
 
  Procedure ZapolnMas (ii:integer; var ai:PArr);
   var j:integer;
   Begin
    for j:=1 to ii do
     begin
      writeln ('Vvedite element [',j,']:');
      readln (ai^[j]);
      writeln (t,'    a[',j,']=',ai^[j]);
     end;
   end;
    procedure MaxR(var ai: parr; var t:text; ni:integer;max:integer;kl:integer);
  var
   k:integer;
  begin
   kl:=1;
   max:=ai^[1];
   for k:=1 to ni do
     if a^[k]>max then
     begin
      max:=ai^[k];
      kl:=k;
     end;
     writeln(t,'index max element =',kl);
     writeln(t,'max element=',max);
   end;
 
  Procedure Obrabotka (ii:integer; ai:PArr; var di:integer; var kl:integer);
   var j:integer;
   begin
    di:=0;
    for j:=kl to ii do
     if (j mod 2=1) then
      inc(di);
   end;
 
  Procedure ZapolnB (di,ii,kl:integer; ai:PArr; var bi:PArr);
   var j:integer;
   begin
    if (kl mod 2=1) then bi^[1]:=a^[kl];
    di:=1;
    for j:=kl to ii do
     if (j mod 2=1) and (j>=kl) then
      begin
 
       bi^[di]:=ai^[j];
       inc(di);
      end;
   end;
  Procedure Sortirovka (var bi:PArr; di:integer);
   var i,j,k:integer;
   begin
     for i:=1 to di do
      for j:=1 to di do
      if bi^[j]>bi^[j+1] then
       begin
        k:= bi^[j];
        bi^[j]:=bi^[j+1];
        bi^[j+1]:=k;
       end;
     for j:=1 to di do
      writeln (t,'    ',bi^[j],' ');
      writeln ('      ',bi^[j],' ');
   end;
 
 
  begin
   clrscr;
   assign (t,'z1_02.pas');
   append (t);
  repeat
   {writeln(t,' Available ',memavail ,' byte.');}
 
   VvodI (i);
 
   GetMem (a,sizeof(integer)*i);
   ZapolnMas (i,a);
   maxr(a,t,i,max,kl);
   Obrabotka (i,a,d,kl);
   GetMem(b,sizeof(integer)*d);
   ZapolnB (d,i,kl,a,b);
   writeln (t,'  Otvet:');
   Sortirovka (b,d);
   {writeln(t,' Available ',memavail ,' byte.'); }
 
   writeln(t,'-----------------------------------------');
   FreeMem (a,sizeof(integer)*i);
   FreeMem (b,sizeof(integer)*d);
   writeln ('Press 1');
   readln (ch);
  until (ch='1');
   close (t);
  end.

Procedure ZapolnB (var di: Integer; ii,kl:integer; ai:PArr; var bi:PArr);

var
  a, b: array of Integer;
  t: Integer;
begin
  repeat Write('Размер A: '); ReadLn(t); until t>0;
  SetLength(a,t);
  Write('Элементы массива A: ');
  for t:=Low(a) to High(a) do Read(a[t]); ReadLn;
...

const W=4;
type
  PIntArr = ^TIntArr;
  TIntArr = array [1..$FFFE div SizeOf(Integer)] of Integer;
var
  pa, pb: PIntArr;
  na, nb, i, j, k, t: Integer;
begin
  Randomize;
  repeat Write('Размер A: '); ReadLn(na); until na>0;
  GetMem(pa,SizeOf(pa^[1])*na);
  for i:=1 to na do pa^[i]:=Random(100);
  Write('A ='); for i:=1 to na do Write(' ',pa^[i]:W); WriteLn;
  k:=1; for i:=2 to na do if pa^[i]>pa^[k] then k:=i;
  nb:=(na-k) div 2;
  if nb>0 then begin
    GetMem(pb,SizeOf(pb^[1])*nb);
    i:=(k+1) or 1; for j:=1 to nb do begin pb^[j]:=pa^[i]; Inc(i,2); end;
    i:=nb;
    repeat
      k:=1;
      for j:=1 to i-1 do
        if pb^[j+1]>pb^[j] then begin
          k:=j; t:=pb^[j]; pb^[j]:=pb^[j+1]; pb^[j+1]:=t;
        end;
      i:=k;
    until k=1;
    Write('B ='); for i:=1 to nb do Write(' ',pb^[i]:W); WriteLn;
    FreeMem(pb,SizeOf(pb^[1])*nb);
  end else WriteLn('Нет элементов с нечетными индексами после максимального');
  FreeMem(pa,SizeOf(pa^[1])*na);
end.