order_by_i32_key Subroutine

  subroutine order_by_i32_key(keys, order)
    integer(i32), intent(in) :: keys(:)
    integer(i32), intent(out) :: order(:)
    integer(i32) :: item
    integer :: start, last, i

    if (size(order) /= size(keys)) error stop 'order_by_i32_key size mismatch.'
    order = [(int(i, i32), i=1, size(keys))]
    last = size(order)
    do start = last/2, 1, -1
      call sift_down(start, last)
    end do
    do last = size(order), 2, -1
      item = order(last)
      order(last) = order(1)
      order(1) = item
      call sift_down(1, last - 1)
    end do
  contains
    subroutine sift_down(first, limit)
      integer, intent(in) :: first, limit
      integer :: root, child
      integer(i32) :: item

      root = first
      item = order(root)
      do while (root <= limit/2)
        child = 2*root
        if (child < limit) then
          if (keys(order(child)) < keys(order(child + 1))) child = child + 1
        end if
        if (keys(item) >= keys(order(child))) exit
        order(root) = order(child)
        root = child
      end do
      order(root) = item
    end subroutine sift_down
  end subroutine order_by_i32_key