program Heap ( input, infile, output ) ;

const
    NameLength = 30;
    ListLength = 100 ;

type
    FileName = String;
    ListIndex = 1 .. 500000;
    ListItem = longint;
    list = array [ListIndex] of ListItem;

var
    FName : FileName;
    infile,g : text;
    l: list;
    i,n : longint;
    size : longint ;

(*----------------------------------------------------------*)
procedure Swap ( var x,y : ListItem ) ;

    var
     Temp : ListItem ;  (* temp storage *)

    begin (* procedure *)
         Temp := x;
         x:= y;
         y:= Temp;
    end  (* Swap *) ;

(*------------------------------------------------------------------*)

procedure FixHeap ( var a : List ; i : ListIndex ; Size : ListIndex );

    var
         j : ListIndex;

    begin (* procedure *)
         if i <= Size div 2 then begin
             j := 2*i;
             if j+1 <= Size then begin
                  if a[j] < a[j+ 1] then begin
                      j := j+1;
                  end;
             end ;
             if a[i] < a[j] then begin
                  Swap (a[j],a[i] ) ;
                  fixheap (a, j, Size) ;
             end ;
         end ;
    end  (* FixHeap *) ;

(*----------------------------------------------------------*)


procedure MakeHeap
    ( var A : List ; Size : ListIndex ) ;

    var
     i :longint ;  (* lcv *)

    begin (* procedure *)
         for i := Size div 2 downto 1 do begin
           FixHeap(A,i,Size);
         end  (* loop *) ;
    end  (* MakeHeap *) ;

(*==================================================================*)

begin (* main program *)
    WriteLn ('what file?');

    assign (infile,'algsort.in' );
    Reset(infile);
    assign(g,'algsort.out');rewrite(g);
    i := 1;
      readln(infile,n);for i:=1 to n do read(infile,l[i]);
    Size :=n  ;

    WriteLn ( 'Unsorted Data:');
    for i := 1 to Size do begin
         Write (L[i]:7);
         if i mod 10 = 0 then begin
             WriteLn ;
         end ;
    end;
    WriteLn ;

    MakeHeap(L, Size);
    for i := Size downto 2 do begin
      Swap (L[i],L[1]) ;
      Fixheap(L, 1,i-1);
    end  (* loop *) ;

    WriteLn ('Sorted Data:');
    for i := 1 to Size do begin
      Write(g,L[i],' ');
      if i mod 10 = 0 then begin
         writeln;
      end  (* if *) ;
    end  (* loop *) ;

    Close (g) ;
end (* Heap *).