!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_statistics
  use cubetools_parameters
  use cubetools_nan
  use cubemain_messaging
  !
  public :: cubemain_swap,cubemain_find,cubemain_median,cubemain_mad
  private
  !
contains
  !
  subroutine cubemain_swap(in1,in2)
    !---------------------------------------------------------------------
    ! Swap two real
    !---------------------------------------------------------------------
    real(kind=sign_k), intent(inout) :: in1
    real(kind=sign_k), intent(inout) :: in2
    !
    real(kind=chan_k) :: tmp
    !
    tmp = in1
    in1 = in2
    in2 = tmp
  end subroutine cubemain_swap
  !
  subroutine cubemain_find(ith,vec,error)
    !---------------------------------------------------------------------
    ! Sort the input vector to have the ith smallest value in location
    ! vec(ith), i.e., with all smaller elements moved to vec(1:ith-1) (in
    ! arbitrary order) and all larger elements in vec(ith+1:) (also in
    ! arbitrary order).
    ! ---------------------------------------------------------------------
    integer(kind=chan_k), intent(in)    :: ith
    real(kind=sign_k),    intent(inout) :: vec(:)
    logical,              intent(inout) :: error
    !
    integer(kind=chan_k) :: iup,jdown,iright,ileft,imed,nvec
    real(kind=sign_k) :: pivot
    character(len=*), parameter :: rname='FIND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    nvec = size(vec)
    if ((ith.lt.1).or.(ith.gt.nvec)) then
       call cubemain_message(seve%e,rname,'Asked element out of array range')
       error = .true.
       return
    endif
    !
    ileft = 1
    iright = nvec
    do
       if (iright-ileft.le.1) then
          if (iright-ileft.eq.1) then
             ! Two elements remaining => Last potential cubemain_swap!
             if (vec(ileft).gt.vec(iright)) call cubemain_swap(vec(ileft),vec(iright))
          else
             ! One element remaining => Nothing to be done anymore
          endif
          return ! Finished!
       else 
          ! 1. Cubemain_swap imedian and ileft+1
          ! 2. Ensure that vec(ileft) <= vec(ileft+1) <= vec(iright)
          ! 3. Use median value, i.e., vec(ileft+1), as pivot
          imed = (ileft+iright)/2
          call cubemain_swap(vec(imed),vec(ileft+1))
          if (vec(ileft).gt.vec(iright))   call cubemain_swap(vec(ileft),vec(iright))
          if (vec(ileft+1).gt.vec(iright)) call cubemain_swap(vec(ileft+1),vec(iright))
          if (vec(ileft).gt.vec(ileft+1))  call cubemain_swap(vec(ileft),vec(ileft+1))
          pivot = vec(ileft+1)
          ! Initialize partitioning loop
          iup = ileft+1
          jdown = iright
          do ! Partitioning loop
             do ! Scan up to find element greater than pivot
                iup = iup+1
                if (vec(iup).ge.pivot) exit
             enddo
             do ! Scan down to find element lower than pivot
                jdown = jdown-1
                if (vec(jdown).le.pivot) exit
             enddo
             if (jdown.lt.iup) exit ! Partitioning complete => Exit loop
             call cubemain_swap(vec(iup),vec(jdown))
          enddo
          ! Analyze result
          vec(ileft+1) = vec(jdown)
          vec(jdown) = pivot
          if (jdown.ge.ith) iright = jdown-1
          if (jdown.le.ith) ileft  = iup
       endif
    enddo
  end subroutine cubemain_find
  !
  function cubemain_median(vec) result(median)
    !----------------------------------------------------------------------
    ! Logically speaking this should be a method of the real_1d_t
    !
    ! Compute the median.
    !
    ! It assumes that all array elements are valid, ie, ne.NaN.
    !
    ! This is the correct definition for an odd number samples and a good
    ! enough compromise between performance and accuracy for an even number
    ! of samples.
    !----------------------------------------------------------------------
    real(kind=sign_k), intent(inout) :: vec(:)
    real(kind=sign_k)                :: median
    !
    logical :: error
    integer(kind=chan_k) :: nmed
    character(len=*), parameter :: rname='MEDIAN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    nmed = size(vec)/2+1
    error = .false.
    call cubemain_find(nmed,vec,error)
    if (error) then
       median = gr4nan
    else
       median = vec(nmed)
    endif
  end function cubemain_median
  !
  function cubemain_mad(vec,median) result(mad)
    !----------------------------------------------------------------------
    ! Logically speaking this should be a method of the real_1d_t
    !
    ! Compute a running Mean absolute Deviation.
    !
    ! For normally distributed data K is taken to be 1/phi^-1(3/4) =~ 1.4826,
    ! where phi^-1 is the inverse of the cumulative distribution function for
    ! the standard normal distribution, i.e., the quantile function.
    ! See http://en.wikipedia.org/wiki/Median_absolute_deviation
    !
    ! It assumes that all array elements are valid, ie, ne.NaN.
    !----------------------------------------------------------------------
    real(kind=sign_k), intent(inout) :: vec(:)
    real(kind=sign_k), intent(in)    :: median
    real(kind=sign_k)                :: mad
    !
    integer(kind=chan_k) :: ivec
    real(kind=sign_k), parameter :: kfactor=1.4826
    character(len=*), parameter :: rname='MAD'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (ieee_is_nan(median)) then
       mad = gr4nan
    else
       do ivec=1,size(vec)
          vec(ivec) = abs(vec(ivec)-median)
       enddo ! ivec
       mad = kfactor*cubemain_median(vec)
    endif
  end function cubemain_mad
end module cubemain_statistics
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
