base_util_unique_DP Subroutine

public subroutine base_util_unique_DP(input_array, output_array, index_map)

Takes an input unsorted integer array and returns a new array of sorted, unique values (DP version)

Arguments

Type IntentOptional Attributes Name
real(kind=DP), intent(in), dimension(:) :: input_array

Unsorted input array

real(kind=DP), intent(out), dimension(:), allocatable :: output_array

Sorted array of unique values

integer(kind=I4B), intent(out), dimension(:), allocatable :: index_map

An array of the same size as input_array that such that any for any index i,
output_array(index_map(i)) = input_array(i)


Called by

proc~~base_util_unique_dp~~CalledByGraph proc~base_util_unique_dp base_util_unique_DP interface~util_unique util_unique interface~util_unique->proc~base_util_unique_dp

Source Code

      subroutine base_util_unique_DP(input_array, output_array, index_map)
         !! author: David A. Minton 
         !! 
         !! Takes an input unsorted integer array and returns a new array of sorted, unique values (DP version) 
         implicit none
         ! Arguments
         real(DP),     dimension(:),              intent(in)  :: input_array  
            !! Unsorted input array  
         real(DP),     dimension(:), allocatable, intent(out) :: output_array 
            !! Sorted array of unique values  
         integer(I4B), dimension(:), allocatable, intent(out) :: index_map    
            !! An array of the same size as input_array that such  that any for any index i,  
            !!    output_array(index_map(i)) = input_array(i) 
         ! Internals
         real(DP), dimension(:), allocatable :: unique_array
         integer(I4B) :: n
         real(DP) :: lo, hi
   
         allocate(unique_array, mold=input_array)
         allocate(index_map(size(input_array)))
         lo = minval(input_array) - 1
         hi = maxval(input_array)
   
         n = 0
         do 
            n = n + 1
            lo = minval(input_array(:), mask=input_array(:) > lo)
            unique_array(n) = lo
            where(abs(input_array(:) - lo) < epsilon(1.0_DP) * lo) index_map(:) = n
            if (lo >= hi) exit
         enddo
         allocate(output_array(n), source=unique_array(1:n)) 
   
         return
      end subroutine base_util_unique_DP