stdlib_stats_moment_all.fypp Source File


This file depends on

sourcefile~~stdlib_stats_moment_all.fypp~~EfferentGraph sourcefile~stdlib_stats_moment_all.fypp stdlib_stats_moment_all.fypp sourcefile~stdlib_stats.fypp stdlib_stats.fypp sourcefile~stdlib_stats_moment_all.fypp->sourcefile~stdlib_stats.fypp sourcefile~stdlib_optval.fypp stdlib_optval.fypp sourcefile~stdlib_stats_moment_all.fypp->sourcefile~stdlib_optval.fypp sourcefile~stdlib_error.f90 stdlib_error.f90 sourcefile~stdlib_stats_moment_all.fypp->sourcefile~stdlib_error.f90 sourcefile~stdlib_kinds.f90 stdlib_kinds.f90 sourcefile~stdlib_stats.fypp->sourcefile~stdlib_kinds.f90 sourcefile~stdlib_optval.fypp->sourcefile~stdlib_kinds.f90 sourcefile~stdlib_error.f90->sourcefile~stdlib_optval.fypp

Contents


Source Code

#:include "common.fypp"
#:set RANKS = range(1, MAXRANK + 1)
#:set REDRANKS = range(2, MAXRANK + 1)
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
submodule (stdlib_stats) stdlib_stats_moment_all

  use, intrinsic:: ieee_arithmetic, only: ieee_value, ieee_quiet_nan
  use stdlib_error, only: error_stop
  use stdlib_optval, only: optval
  implicit none

contains

  #:for k1, t1 in RC_KINDS_TYPES
    #:for rank in RANKS
      #:set RName = rname("moment_all",rank, t1, k1)
      module function ${RName}$(x, order, center, mask) result(res)
        ${t1}$, intent(in) :: x${ranksuffix(rank)}$
        integer, intent(in) :: order
        ${t1}$, intent(in), optional :: center
        logical, intent(in), optional :: mask
        ${t1}$ :: res

        real(${k1}$) :: n

        if (.not.optval(mask, .true.)) then
          res = ieee_value(1._${k1}$, ieee_quiet_nan)
          return
        end if

        n = real(size(x, kind = int64), ${k1}$)

        if (present(center)) then
         res = sum((x - center)**order) / n
        else
         res = sum((x - mean(x))**order) / n
        end if

      end function ${RName}$
    #:endfor
  #:endfor


  #:for k1, t1 in INT_KINDS_TYPES
    #:for rank in RANKS
      #:set RName = rname("moment_all",rank, t1, k1, 'dp')
      module function ${RName}$(x, order, center, mask) result(res)
        ${t1}$, intent(in) :: x${ranksuffix(rank)}$
        integer, intent(in) :: order
        real(dp), intent(in), optional :: center
        logical, intent(in), optional :: mask
        real(dp) :: res

        real(dp) :: n

        if (.not.optval(mask, .true.)) then
          res = ieee_value(1._dp, ieee_quiet_nan)
          return
        end if

        n = real(size(x, kind = int64), dp)

        if (present(center)) then
         res = sum((real(x, dp) - center)**order) / n
        else
         res = sum((real(x, dp) - mean(x))**order) / n
        end if

      end function ${RName}$
    #:endfor
  #:endfor


  #:for k1, t1 in RC_KINDS_TYPES
    #:for rank in RANKS
      #:set RName = rname("moment_mask_all",rank, t1, k1)
      module function ${RName}$(x, order, center, mask) result(res)
        ${t1}$, intent(in) :: x${ranksuffix(rank)}$
        integer, intent(in) :: order
        ${t1}$, intent(in), optional :: center
        logical, intent(in) :: mask${ranksuffix(rank)}$
        ${t1}$ :: res

        real(${k1}$) :: n

        n = real(count(mask, kind = int64), ${k1}$)

        if (present(center)) then
         res = sum((x - center)**order, mask) / n
        else
         res = sum((x - mean(x, mask))**order, mask) / n
        end if

      end function ${RName}$
    #:endfor
  #:endfor


  #:for k1, t1 in INT_KINDS_TYPES
    #:for rank in RANKS
      #:set RName = rname("moment_mask_all",rank, t1, k1, 'dp')
      module function ${RName}$(x, order, center, mask) result(res)
        ${t1}$, intent(in) :: x${ranksuffix(rank)}$
        integer, intent(in) :: order
        real(dp),intent(in), optional :: center
        logical, intent(in) :: mask${ranksuffix(rank)}$
        real(dp) :: res

        real(dp) :: n

        n = real(count(mask, kind = int64), dp)

        if (present(center)) then
         res = sum((real(x, dp) - center)**order, mask) / n
        else
         res = sum((real(x, dp) - mean(x,mask))**order, mask) / n
        end if

      end function ${RName}$
    #:endfor
  #:endfor

end submodule