! Copyright (c) 1994 Unicomp, Inc.
!
! Developed at Unicomp, Inc.
!
! Permission to use, copy, modify, and distribute this
! software is freely granted, provided that this notice 
! is preserved.

implicit none
real x(16), element
logical err
read*,x
call quick_select(x,1,element,err)
print "(f20.0,l9)", element, err
call quick_select(x,8,element,err)
print "(f20.0,l9)", element, err
call quick_select(x,16,element,err)
print "(f20.0,l9)", element, err
call quick_select(x,0,element,err)
print "(f20.0,l9)", element, err
call quick_select(x,17,element,err)
print "(f20.0,l9)", element, err

contains

recursive subroutine quick_select  &
      (list, k, element, error)

   real, dimension (:), intent (in) :: list
   integer, intent (in) :: k
   real, intent (out) :: element
   logical, intent (out) :: error
   real, dimension (size (list)) :: smaller, larger
   integer :: i,  &
         number_smaller, number_equal, number_larger
   real :: chosen

   if (size (list) <= 1) then
      error = .not. (size (list) == 1 .and. k == 1)
      if (error) then
         element = 0.0  ! A value must be assigned
                 ! because element is intent (out)
      else
         element = list (1)
      end if

   else
      chosen = list (1)
      number_smaller = 0
      number_equal = 1
      number_larger = 0

      do i = 2, size (list)
         if (list (i) < chosen) then
            number_smaller = number_smaller + 1
            smaller (number_smaller) = list (i)
         else if (list (i) == chosen) then
            number_equal = number_equal + 1
         else
            number_larger = number_larger + 1
            larger (number_larger) = list (i)
         end if
      end do

      if (k <= number_smaller) then
         call quick_select  &
               (smaller (1 : number_smaller),  &
                k, element, error)
      else if (k <= number_smaller + number_equal) then
         element = chosen
         error = .false.
      else
         call quick_select  &
               (larger (1 : number_larger),  &
                k - number_smaller - number_equal,  &
                element, error)
      end if
   end if

end subroutine quick_select

end