subroutine sort_array(array,order)
integer,dimension(:) :: array
integer,dimension(size(array)) :: order
integer,dimension(size(array)) :: backup
integer :: i
forall(i=1:size(array))order(i)=i
call qsort_sort(array, order,1, size(array))
do i=1,size(array)
backup(i)=array(order(i))
enddo
array=backup
contains
recursive subroutine qsort_sort( array, order, left, right )
integer, dimension(:) :: array
integer, dimension(:) :: order
integer :: left
integer :: right
integer :: i
integer :: last
if ( left .ge. right ) return
call qsort_swap( order, left, qsort_rand(left,right) )
last = left
do i = left+1, right
if ( compare(array(order(i)), array(order(left)) ) .lt. 0 ) then
last = last + 1
call qsort_swap( order, last, i )
endif
enddo
call qsort_swap( order, left, last )
call qsort_sort( array, order, left, last-1 )
call qsort_sort( array, order, last+1, right )
end subroutine qsort_sort
!---------------------------------------------!
subroutine qsort_swap( order, first, second )
integer, dimension(:) :: order
integer :: first, second
integer :: tmp
tmp = order(first)
order(first) = order(second)
order(second) = tmp
end subroutine qsort_swap
!---------------------------------------------!
integer function qsort_rand( lower, upper )
integer :: lower, upper
real(8) :: r
call random_number(r)
qsort_rand = lower + nint(r * (upper-lower))
end function qsort_rand
!---------------------------------------------!
function compare(f,g)
implicit none
integer :: f,g
integer :: compare
if(f<g) then
compare=-1
else
compare=1
endif
end function compare
end subroutine sort_array