Program HS;

Var i,x,l,n,r:integer;

    a:array[0..50] of integer;

Procedure Sift(l,r: integer);

   Var  i,j,x: integer;

Begin

   i:=l;

   j:=2*l;

   x:=a[l];

   if (j<r) and (a[j]<a[j+1]) then inc(j);

   while (j<=r) and (x<a[j]) do

         begin

             a[i]:=a[j];

             a[j]:=x;

             i:=j;

             j:=2*j;

             if (j<r) and (a[j]<a[j+1]) then inc(j);

          end

End;

Begin

     Writeln ('Введи длину  массива');

     Read (n);

     Writeln ('Введи  массив');

     For i:=1 to n do read(a[i]);

     l:=(n div 2)+1;

     r:=n;

     while l>1 do

         begin

            dec(l);

            Sift(l,n)

         end;

     while r>1 do

         begin

            x:=a[1];

            a[1]:=a[r];

            a[r]:=x;

            dec(r);

            Sift(1,r)

         end;

      Writeln(‘Результат:');

      For i:=1 to n do write(a[i],' ')

End.