#:include "common.fypp" #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES submodule (stdlib_stats) stdlib_stats_corr use, intrinsic:: ieee_arithmetic, only: ieee_value, ieee_quiet_nan use stdlib_error, only: error_stop use stdlib_linalg, only: diag use stdlib_optval, only: optval implicit none contains #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("corr",1, t1, k1) module function ${RName}$(x, dim, mask) result(res) ${t1}$, intent(in) :: x(:) integer, intent(in) :: dim logical, intent(in), optional :: mask real(${k1}$) :: res if (.not.optval(mask, .true.) .or. size(x) < 2) then res = ieee_value(1._${k1}$, ieee_quiet_nan) return end if res = 1 end function ${RName}$ #:endfor #:for k1, t1 in INT_KINDS_TYPES #:set RName = rname("corr",1, t1, k1, 'dp') module function ${RName}$(x, dim, mask) result(res) ${t1}$, intent(in) :: x(:) integer, intent(in) :: dim logical, intent(in), optional :: mask real(dp) :: res if (.not.optval(mask, .true.) .or. size(x) < 2) then res = ieee_value(1._dp, ieee_quiet_nan) return end if res = 1 end function ${RName}$ #:endfor #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("corr_mask",1, t1, k1) module function ${RName}$(x, dim, mask) result(res) ${t1}$, intent(in) :: x(:) integer, intent(in) :: dim logical, intent(in) :: mask(:) real(${k1}$) :: res if (count(mask) < 2) then res = ieee_value(1._${k1}$, ieee_quiet_nan) return end if res = 1 end function ${RName}$ #:endfor #:for k1, t1 in INT_KINDS_TYPES #:set RName = rname("corr_mask",1, t1, k1, 'dp') module function ${RName}$(x, dim, mask) result(res) ${t1}$, intent(in) :: x(:) integer, intent(in) :: dim logical, intent(in) :: mask(:) real(dp) :: res if (count(mask) < 2) then res = ieee_value(1._dp, ieee_quiet_nan) return end if res = 1 end function ${RName}$ #:endfor #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("corr",2, t1, k1) module function ${RName}$(x, dim, mask) result(res) ${t1}$, intent(in) :: x(:, :) integer, intent(in) :: dim logical, intent(in), optional :: mask ${t1}$ :: res(merge(size(x, 1), size(x, 2), mask = 1