module wei_qksort
  !! quicksort on real vectors

  implicit none

  integer, private :: nsort
contains
  !----------------------------------------------------------------
  subroutine weiqksort_init(n)
    integer, intent(in) :: n

    nsort=n
  end subroutine weiqksort_init
  !----------------------------------------------------------------
  recursive subroutine weiqksort(a,low,high)
    real, dimension(:), pointer :: a
    integer :: low,high
    integer :: pivot

    !! Termination condition
    if(high > low) then
       pivot = partition( a, low, high )
       call weiqksort( a, low,  pivot-1 )
       call weiqksort( a, pivot+1, high )
    end if

  end subroutine weiqksort
  !----------------------------------------------------------------
  integer function partition(a,low,high)
    real, dimension(:), pointer :: a
    integer :: low,high
    integer :: left,right,pivot
    real    :: pivot_item

    pivot_item = a(low)

    pivot = low
    left  = low
    right = high

    do while( left < right )
       ! Move left while item < pivot
       do while( a(left) <= pivot_item .and. left<nsort) 
          left = left + 1
       end do

       ! Move right while item > pivot
       do while( a(right) > pivot_item .and. right>1) 
          right = right - 1
       end do

       if(left < right) then
          call swap(a,left,right)
       end if
    end do

    ! right is final position for the pivot
    a(low)   = a(right)
    a(right) = pivot_item

    ! return pivot
    partition = right
  end function partition
  !----------------------------------------------------------------
  subroutine swap(a,left,right)
    real, dimension(:), pointer :: a
    integer :: left, right
    real    :: tmp

    tmp      = a( left)
    a( left) = a(right)
    a(right) = tmp
  end subroutine swap
  !----------------------------------------------------------------
end module wei_qksort

