procedure string_heap_sort(var str:string_array;n:integer);
var i,j,r,l:integer;
    temp:wrkstring;
    not_ready:boolean;
begin
  if n>0 then
  begin
    l:=n div 2+1;
    r:=n;
    repeat
      if l>1 then l:=l-1
      else if r>1 then begin
                         temp:=str[l];
                         str[l]:=str[r];
                         str[r]:=temp;
                         r:=r-1;
                       end;
      i:=l;
      j:=2*i;
      temp:=str[i];
      not_ready:=(j<=r);
      while not_ready do
        begin
          if j<r then if str[j]<str[j+1] then j:=j+1;
          not_ready:=false;
          if j<=r then not_ready:=(temp<str[j]);
          if not_ready then begin
                              str[i]:=str[j];
                              i:=j;
                              j:=2*i;
                            end;
        end;
      str[i]:=temp;
    until r=1;
  end
  else writeln('<string_heap_sort>: n < 1');
end;

                           