s_utl_sort Subroutine

public pure subroutine s_utl_sort(a_in, n, mode, idx_in, a_out, idx_out)

Sort real array in ascending (mode=1) or descending (mode=2) order. Preserves the input array. Outputs sorted array and index mapping.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: a_in(n)

input array (unchanged)
integer(kind=i4), intent(in) :: n

number of elements
integer(kind=i4), intent(in) :: mode

1=ascending, 2=descending
integer(kind=i4), intent(in) :: idx_in(n)

initial index mapping
real(kind=wp), intent(out) :: a_out(n)

sorted output array
integer(kind=i4), intent(out) :: idx_out(n)

updated index mapping

Called by

proc~~s_utl_sort~~CalledByGraph proc~s_utl_sort s_utl_sort proc~s_nlp_hclust_core s_nlp_hclust_core proc~s_nlp_hclust_core->proc~s_utl_sort proc~s_nlp_kmeans_core s_nlp_kmeans_core proc~s_nlp_kmeans_core->proc~s_utl_sort proc~s_nlp_hclust s_nlp_hclust proc~s_nlp_hclust->proc~s_nlp_hclust_core proc~s_nlp_hkmeans_core s_nlp_hkmeans_core proc~s_nlp_hkmeans_core->proc~s_nlp_hclust_core proc~s_nlp_hkmeans_core->proc~s_nlp_kmeans_core proc~s_nlp_kmeans s_nlp_kmeans proc~s_nlp_kmeans->proc~s_nlp_kmeans_core interface~fsml_hclust fsml_hclust interface~fsml_hclust->proc~s_nlp_hclust interface~fsml_kmeans fsml_kmeans interface~fsml_kmeans->proc~s_nlp_kmeans proc~s_nlp_hkmeans s_nlp_hkmeans proc~s_nlp_hkmeans->proc~s_nlp_hkmeans_core interface~fsml_hkmeans fsml_hkmeans interface~fsml_hkmeans->proc~s_nlp_hkmeans

Source Code

pure subroutine s_utl_sort(a_in, n, mode, idx_in, a_out, idx_out)

! ==== Description
!! Sort real array in ascending (mode=1) or descending (mode=2) order.
!! Preserves the input array. Outputs sorted array and index mapping.

! ==== Declarations
  integer(i4), intent(in)    :: n          !! number of elements
  integer(i4), intent(in)    :: mode       !! 1=ascending, 2=descending
  real(wp)   , intent(in)    :: a_in(n)    !! input array (unchanged)
  integer(i4), intent(in)    :: idx_in(n)  !! initial index mapping
  real(wp)   , intent(out)   :: a_out(n)   !! sorted output array
  integer(i4), intent(out)   :: idx_out(n) !! updated index mapping
  real(wp)                   :: tmp_a      !! swap buffer for a
  integer(i4)                :: tmp_idx    !! swap buffer for idx
  integer(i4)                :: i, j

! ==== Instructions

  ! make working copies
  a_out   = a_in
  idx_out = idx_in

  select case (mode)
  ! ascending
  case (1)
     do i = 1, n - 1
        do j = i + 1, n
           if (a_out(j) .lt. a_out(i)) then
              tmp_a      = a_out(i)
              a_out(i)   = a_out(j)
              a_out(j)   = tmp_a
              tmp_idx    = idx_out(i)
              idx_out(i) = idx_out(j)
              idx_out(j) = tmp_idx
           endif
        enddo
     enddo
  ! descending
  case (2)
     do i = 1, n - 1
        do j = i + 1, n
           if (a_out(j) .gt. a_out(i)) then
              tmp_a      = a_out(i)
              a_out(i)   = a_out(j)
              a_out(j)   = tmp_a
              tmp_idx    = idx_out(i)
              idx_out(i) = idx_out(j)
              idx_out(j) = tmp_idx
           endif
        enddo
     enddo
  ! invalid option returns sentinel
  case default
     a_out = c_sentinel_r
  end select

end subroutine s_utl_sort