procedure HEAPSORT(var A:TYPPOLE;  {Razene pole     }
                   N:integer       {Pocet prvku pole});

var K,R : INDEX;
    X : integer;

  procedure ZARAD;  {Provede zarazeni jednoho prvku}

  label 1;

  var I,J : INDEX;

  begin
    I := K;
    J := 2*I;
    X := A[I];
    while J<=R do
    begin
      if J<R then if A[J]<A[J+1] then J := J+1;
      if X>=A[J] then goto 1;
      A[I] := A[J];
      I := J;
      J := 2*I
    end;
    1:A[I] := X
  end;  {pomocna procedura ZARAD}

begin
  K := (N div 2)+1;
  R := N;
  while K>1 do
  begin
    K := K-1;
    ZARAD
  end;
  while R>1 do
  begin
    X := A[1];
    A[1] := A[R];
    A[R] := X;
    R := R-1;
    ZARAD
  end
end;  {Procedura HEAPSORT}