#:include "common.fypp" #:set RANKS = range(1, MAXRANK + 1) #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES submodule (stdlib_stats) stdlib_stats_mean 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("mean_all",rank, t1, k1) module function ${RName}$ (x, mask) result(res) ${t1}$, intent(in) :: x${ranksuffix(rank)}$ logical, intent(in), optional :: mask ${t1}$ :: res if (.not.optval(mask, .true.)) then res = ieee_value(1._${k1}$, ieee_quiet_nan) return end if res = sum(x) / real(size(x, kind = int64), ${k1}$) end function ${RName}$ #:endfor #:endfor #:for k1, t1 in INT_KINDS_TYPES #:for rank in RANKS #:set RName = rname('mean_all', rank, t1, k1,'dp') module function ${RName}$(x, mask) result(res) ${t1}$, intent(in) :: x${ranksuffix(rank)}$ logical, intent(in), optional :: mask real(dp) :: res if (.not.optval(mask, .true.)) then res = ieee_value(1._dp, ieee_quiet_nan) return end if res = sum(real(x, dp)) / real(size(x, kind = int64), dp) end function ${RName}$ #:endfor #:endfor #:for k1, t1 in RC_KINDS_TYPES #:for rank in RANKS #:set RName = rname("mean",rank, t1, k1) module function ${RName}$(x, dim, mask) result(res) ${t1}$, intent(in) :: x${ranksuffix(rank)}$ integer, intent(in) :: dim logical, intent(in), optional :: mask ${t1}$ :: res${reduced_shape('x', rank, 'dim')}$ if (.not.optval(mask, .true.)) then res = ieee_value(1._${k1}$, ieee_quiet_nan) return end if if (dim >= 1 .and. dim <= ${rank}$) then res = sum(x, dim) / real(size(x, dim), ${k1}$) else call error_stop("ERROR (mean): wrong dimension") end if end function ${RName}$ #:endfor #:endfor #:for k1, t1 in INT_KINDS_TYPES #:for rank in RANKS #:set RName = rname("mean",rank, t1, k1,'dp') module function ${RName}$(x, dim, mask) result(res) ${t1}$, intent(in) :: x${ranksuffix(rank)}$ integer, intent(in) :: dim logical, intent(in), optional :: mask real(dp) :: res${reduced_shape('x', rank, 'dim')}$ if (.not.optval(mask, .true.)) then res = ieee_value(1._dp, ieee_quiet_nan) return end if if (dim >= 1 .and. dim <= ${rank}$) then res = sum(real(x, dp), dim) / real(size(x, dim), dp) else call error_stop("ERROR (mean): wrong dimension") end if end function ${RName}$ #:endfor #:endfor #:for k1, t1 in RC_KINDS_TYPES #:for rank in RANKS #:set RName = rname('mean_mask_all',rank, t1, k1) module function ${RName}$(x, mask) result(res) ${t1}$, intent(in) :: x${ranksuffix(rank)}$ logical, intent(in) :: mask${ranksuffix(rank)}$ ${t1}$ :: res res = sum(x, mask) / real(count(mask, kind = int64), ${k1}$) end function ${RName}$ #:endfor #:endfor #:for k1, t1 in INT_KINDS_TYPES #:for rank in RANKS #:set RName = rname('mean_mask_all',rank, t1, k1, 'dp') module function ${RName}$(x, mask) result(res) ${t1}$, intent(in) :: x${ranksuffix(rank)}$ logical, intent(in) :: mask${ranksuffix(rank)}$ real(dp) :: res res = sum(real(x, dp), mask) / real(count(mask, kind = int64), dp) end function ${RName}$ #:endfor #:endfor #:for k1, t1 in RC_KINDS_TYPES #:for rank in RANKS #:set RName = rname('mean_mask',rank, t1, k1) module function ${RName}$(x, dim, mask) result(res) ${t1}$, intent(in) :: x${ranksuffix(rank)}$ integer, intent(in) :: dim logical, intent(in) :: mask${ranksuffix(rank)}$ ${t1}$ :: res${reduced_shape('x', rank, 'dim')}$ if (dim >= 1 .and. dim <= ${rank}$) then res = sum(x, dim, mask) / real(count(mask, dim), ${k1}$) else call error_stop("ERROR (mean): wrong dimension") end if end function ${RName}$ #:endfor #:endfor #:for k1, t1 in INT_KINDS_TYPES #:for rank in RANKS #:set RName = rname('mean_mask',rank, t1, k1, 'dp') module function ${RName}$(x, dim, mask) result(res) ${t1}$, intent(in) :: x${ranksuffix(rank)}$ integer, intent(in) :: dim logical, intent(in) :: mask${ranksuffix(rank)}$ real(dp) :: res${reduced_shape('x', rank, 'dim')}$ if (dim >= 1 .and. dim <= ${rank}$) then res = sum(real(x, dp), dim, mask) / real(count(mask, dim), dp) else call error_stop("ERROR (mean): wrong dimension") end if end function ${RName}$ #:endfor #:endfor end submodule