Program Algorithm;

{ Heap sort.
  Algorithm H on page 146 of "The Art of Computer Programming"
  volume 3 / "Sorting and Searching" by Donald E. Knuth.
  I gave up on structured programming here. }

const
  N = 25;
var
  m : word;
  rij : array[1..N] of word;

procedure HeapSort;

var
  l, r, i, j : word;
  s : word;

label 1, 2, 3, 4, 5, 6, 7, 8;

begin

1: l := (N div 2) + 1;
   r := N;

2: if l > 1 then
   begin
     l := l - 1;
     s := rij[l];
   end else
   begin
     s := rij[r];
     rij[r] := rij[1];
     r := r - 1;
     if r = 1 then
     begin
       rij[1] := s;
       Exit;
     end;
   end;

3: j := l;

4: i := j;
   j := 2 * j;
   if j < r then goto 5;
   if j = r then goto 6;
   if j > r then goto 8;

5: if rij[j] < rij[j+1] then j := j + 1;

6: if s >= rij[j] then goto 8;

7: rij[i] := rij[j];
   goto 4;

8: rij[i] := s;
   goto 2;

end;

begin
  rij[1] := Random(3*N)+1;
  for m := 1 to N do
    rij[m] := Random(3*N)+1;
  for m := 1 to N do
    Write(rij[m],' ');
  Writeln;

  HeapSort;

  for m := 1 to N do
    Write(rij[m],' ');
  Writeln;
end.