!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_statistics
  use cubetools_parameters
  use cubemain_messaging
  !
  public :: cubemain_find
  private
  !
contains
  !
  subroutine cubemain_rms(array,nelem,rms)
    use cubetools_nan
    !---------------------------------------------------------------------
    ! *** JP: Not used anywhere right now. Why?
    ! Protected against NaNs and Blanking Values. If Blanking enabled, will
    ! return blanking value if no valid result. If Blanking is not enabled,
    ! will return NaN if no valid result.
    ! ---------------------------------------------------------------------
    real(kind=sign_k),    intent(in)  :: array(*) ! Data values to compute
    integer(kind=chan_k), intent(in)  :: nelem    ! Number of data values
    real(kind=sign_k),    intent(out) :: rms      ! Output scalar value
    !
    integer(kind=chan_k) :: ielem,count
    real(kind=sign_k) :: mean,quaddevi
    !
    ! Sanity check
    if (nelem.lt.1) then
       ! VVV should this be an error instead?
       rms = gr4nan
       return
    endif
    ! Initialization
    rms = 0.0
    !
    mean = 0.
    quaddevi = 0.
    count = 0
    do ielem = 1,nelem
       if (.not.ieee_is_nan(array(ielem))) then
          mean = mean+array(ielem)
          count = count+1
       endif
    enddo
    if (count.gt.0) then
       mean = mean/dble(count)
    else
       ! VVV Should this be a warning?
       rms = gr4nan
       return
    endif
    !
    count = 0
    do ielem = 1,nelem
       if (.not.ieee_is_nan(array(ielem))) then
          quaddevi = quaddevi + (array(ielem)-mean)**2
          count = count+1
       endif
    enddo
    !
    quaddevi = quaddevi/dble(count)
    rms = sqrt (quaddevi)
  end subroutine cubemain_rms
  !
  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
  !
  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
end module cubemain_statistics
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
