! test_heapsort.f90    includes a test program that is deleted in a module
!
! always  Order n lg n  sort, reliably fast
! reference: P 147 of Introduction to Algorithms by Cormen et. al.
!
! 11/5/95 JSS converted from Ada with minimum editing

subroutine HeapSort ( A )
  implicit none
  integer, dimension(:), intent(inout) :: A
  integer :: T
  integer :: Heap_Size
  integer :: I

  if (size(A) <= 1) then
    return
  end if
  call Build_Heap(A)
  do I=ubound(A,1), lbound(A,1), -1
    T = A(lbound(A,1));
    A(lbound(A,1)) = A(I)
    A(I) = T
    Heap_Size = Heap_Size-1
    call Heapify(A,lbound(A,1))
  end do

contains
  recursive subroutine Heapify(A, I)
    integer, dimension(:), intent(inout) :: A
    integer, intent(in) :: I
    integer :: T
    integer :: Largest
    integer :: L
    integer :: R

    L = lbound(A,1) + 2*(I-lbound(A,1))
    R = L+1
    if (L <= Heap_Size .and. A(L) > A(I)) then
      Largest = L
    else
      Largest = I
    end if
    if (R <= Heap_Size .and. A(R) > A(Largest)) then
      Largest = R
    end if
    if (Largest /= I) then
      T = A(I)
      A(I) = A(Largest)
      A(Largest) = T
      call Heapify(A, Largest)
    end if
  end subroutine Heapify

  subroutine Build_Heap ( A )
    integer, dimension(:), intent(inout) :: A
    integer :: I

    Heap_Size = size(A,1)
    do I=lbound(A,1)+size(A,1)/2 ,lbound(A,1) ,-1
      call Heapify(A, I);
    end do
  end subroutine Build_Heap;
end subroutine HeapSort;

program Test_HeapSort
  implicit none
  integer, dimension(-5:6) :: A12 = (/12, 1,  2, 11,  8,  9,  &
                                      10, 3,  4,  5,  7,  6/)
  integer, dimension(3:9) :: A9 = (/5, 3, 9, 6, 8, 7, 4/)
  integer, dimension(0:0) :: A1 = 7
  integer, dimension(1:2) :: A2 = (/2, 1/)

  interface
    subroutine HeapSort(A)
      integer, dimension(:), intent(inout) :: A
    end subroutine HeapSort
  end interface

  print *, "Test_HeapSort."
  print *, "A(-5:6)"
  call HeapSort(A12)
  print *, A12

  print *, "A(3:9)"
  call HeapSort(A9)
  print *, A9

  print *, "A(3:9) pre sorted"
  call HeapSort(A9)
  print *, A9

  print *, "A(0:0)"
  call HeapSort(A1)
  print *, A1

  print *, "A(1:2)"
  call HeapSort(A2)
  print *, A2
end program Test_HeapSort