f_sts_median_core Function

public pure function f_sts_median_core(x) result(median)

Computes median using s_utl_rank for tie-aware ranking

Arguments

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

x vector (assumed size array)

Return Value real(kind=wp)

median


Calls

proc~~f_sts_median_core~~CallsGraph proc~f_sts_median_core f_sts_median_core proc~s_utl_rank s_utl_rank proc~f_sts_median_core->proc~s_utl_rank

Called by

proc~~f_sts_median_core~~CalledByGraph proc~f_sts_median_core f_sts_median_core proc~f_sts_median f_sts_median proc~f_sts_median->proc~f_sts_median_core interface~fsml_median fsml_median interface~fsml_median->proc~f_sts_median

Source Code

pure function f_sts_median_core(x) result(median)

! ==== Description
!! Computes median using s_utl_rank for tie-aware ranking

! ==== Declarations
  real(wp), intent(in)  :: x(:)   !! x vector (assumed size array)
  real(wp)              :: median !! median
  real(wp), allocatable :: rx(:)  !! ranks of x
  integer(i4)           :: n      !! dimension of x
  integer(i4)           :: i1, i2

! ==== Instructions

  ! get array dimension
  n = size(x)

  ! get ranks for x; rank arrays allocated in ranking
  call s_utl_rank(x, rx)

  if (mod(n, 2) .eq. 1) then
     ! If n is odd, the middle rank is (n+1)/2
     i1 = maxloc(rx, mask = (rx .eq. real((n+1)/2, wp)), dim=1)
     median = x(i1)
  else
     ! If n is even, average elements with ranks n/2 and n/2+1
     i1 = maxloc(rx, mask = (rx .eq. real(n, wp)/2.0_wp)         , dim=1)
     i2 = maxloc(rx, mask = (rx .eq. 1.0_wp + real(n, wp)/2.0_wp), dim=1)
     median = 0.5_wp * (x(i1) + x(i2))
  endif

  deallocate(rx)

end function f_sts_median_core