scale_sort.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_sort
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: sort_exec
 
  interface sort_exec
     module procedure sort_exec_without_idx
     module procedure sort_exec_with_idxs
     module procedure sort_exec_with_idx
  end interface sort_exec
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
!OCL SERIAL
  subroutine sort_exec_with_idxs( &
      npoints,      &
      val,          &
      idx_i, idx_j, &
      reverse       )
    implicit none
    integer,  intent(in)    :: npoints                ! number of interpolation points
    real(RP), intent(inout) :: val  (npoints)         ! value to sort
    integer,  intent(inout) :: idx_i(npoints)         ! i-index
    integer,  intent(inout) :: idx_j(npoints)         ! j-index
 
    logical,  intent(in), optional :: reverse
 
    real(RP) :: sig
    integer  :: itmp
    integer  :: jtmp
    real(RP) :: vtmp
 
    integer  :: n1, n2
    !---------------------------------------------------------------------------
 
    sig = 1.0_rp
    if ( present(reverse) ) then
       if ( reverse ) sig = -1.0_rp
    end if
 
    do n1 = 1, npoints-1
    do n2 = n1+1, npoints
       if ( val(n1) * sig > val(n2) * sig ) then
          itmp      = idx_i(n1)
          jtmp      = idx_j(n1)
          vtmp      = val(n1)
 
          idx_i(n1) = idx_i(n2)
          idx_j(n1) = idx_j(n2)
          val(n1) = val(n2)
 
          idx_i(n2) = itmp
          idx_j(n2) = jtmp
          val(n2) = vtmp
       endif
    enddo
    enddo
 
    return
  end subroutine sort_exec_with_idxs
 
!OCL SERIAL
  subroutine sort_exec_with_idx( &
      npoints,    &
      val, index, &
      reverse     )
    implicit none
    integer,  intent(in)    :: npoints                ! number of interpolation points
    real(RP), intent(inout) :: val  (npoints)         ! value to sort
    integer,  intent(inout) :: index(npoints)         ! index
 
    logical,  intent(in), optional :: reverse
 
    real(RP) :: sig
    integer  :: itmp
    real(RP) :: vtmp
 
    integer  :: n1, n2
    !---------------------------------------------------------------------------
 
    sig = 1.0_rp
    if ( present(reverse) ) then
       if ( reverse ) sig = -1.0_rp
    end if
 
    do n1 = 1, npoints-1
    do n2 = n1+1, npoints
       if ( val(n1) * sig > val(n2) * sig ) then
          itmp    = index(n1)
          vtmp    = val(n1)
 
          index(n1) = index(n2)
          val(n1) = val(n2)
 
          index(n2) = itmp
          val(n2) = vtmp
       endif
    enddo
    enddo
 
    return
  end subroutine sort_exec_with_idx
 
!OCL SERIAL
  subroutine sort_exec_without_idx( &
      npoints, &
      val,     &
      reverse  )
    implicit none
    integer,  intent(in)    :: npoints                ! number of interpolation points
    real(RP), intent(inout) :: val  (npoints)         ! value to sort
 
    logical,  intent(in), optional :: reverse
 
    real(RP) :: sig
    real(RP) :: vtmp
 
    integer  :: n1, n2
    !---------------------------------------------------------------------------
 
    sig = 1.0_rp
    if ( present(reverse) ) then
       if ( reverse ) sig = -1.0_rp
    end if
 
    do n1 = 1, npoints-1
    do n2 = n1+1, npoints
       if ( val(n1) * sig > val(n2) * sig ) then
          vtmp      = val(n1)
 
          val(n1) = val(n2)
 
          val(n2) = vtmp
       endif
    enddo
    enddo
 
    return
  end subroutine sort_exec_without_idx
 
end module scale_sort