sort_array Subroutine

public subroutine sort_array(array, order)

Arguments

Type IntentOptional Attributes Name
integer, dimension(:) :: array
integer, dimension(size(array)) :: order

Called by

proc~~sort_array~~CalledByGraph proc~sort_array sort_array proc~binary_search binary_search proc~binary_search->proc~sort_array proc~binary_search->proc~binary_search none~insert sparse_dmatrix_csr%insert none~insert->proc~binary_search none~insert~2 sparse_zmatrix_csr%insert none~insert~2->proc~binary_search none~insert~3 sparse_dmatrix_csc%insert none~insert~3->proc~binary_search none~insert~4 sparse_zmatrix_csc%insert none~insert~4->proc~binary_search proc~dmatmul_csc_csc dmatmul_csc_csc proc~dmatmul_csc_csc->none~insert~3 proc~dmatmul_csc_csr_2csc dmatmul_csc_csr_2csc proc~dmatmul_csc_csr_2csc->none~insert~3 proc~dmatmul_csc_csr_2csr dmatmul_csc_csr_2csr proc~dmatmul_csc_csr_2csr->none~insert proc~dmatmul_csr_csr dmatmul_csr_csr proc~dmatmul_csr_csr->none~insert proc~zmatmul_csc_csc zmatmul_csc_csc proc~zmatmul_csc_csc->none~insert~4 proc~zmatmul_csc_csr_2csc zmatmul_csc_csr_2csc proc~zmatmul_csc_csr_2csc->none~insert~4 proc~zmatmul_csc_csr_2csr zmatmul_csc_csr_2csr proc~zmatmul_csc_csr_2csr->none~insert~2 proc~zmatmul_csr_csr zmatmul_csr_csr proc~zmatmul_csr_csr->none~insert~2 interface~matmul~2 matmul interface~matmul~2->proc~dmatmul_csc_csc interface~matmul~2->proc~dmatmul_csc_csr_2csc interface~matmul~2->proc~dmatmul_csc_csr_2csr interface~matmul~2->proc~dmatmul_csr_csr interface~matmul~2->proc~zmatmul_csc_csc interface~matmul~2->proc~zmatmul_csc_csr_2csc interface~matmul~2->proc~zmatmul_csc_csr_2csr interface~matmul~2->proc~zmatmul_csr_csr

Source Code

  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