f_lin_mahalanobis Function

public impure function f_lin_mahalanobis(x, y, cov) result(dist)

Impure wrapper function for f_lin_mahalanobis_core.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: x(:)

input vector 1
real(kind=wp), intent(in) :: y(:)

input vector 2
real(kind=wp), intent(in), optional :: cov(:,:)

covariance matrix

Return Value real(kind=wp)

Mahalanobis distance


Calls

proc~~f_lin_mahalanobis~~CallsGraph proc~f_lin_mahalanobis f_lin_mahalanobis proc~f_lin_mahalanobis_core f_lin_mahalanobis_core proc~f_lin_mahalanobis->proc~f_lin_mahalanobis_core proc~s_err_print s_err_print proc~f_lin_mahalanobis->proc~s_err_print proc~f_sts_cov_core f_sts_cov_core proc~f_lin_mahalanobis_core->proc~f_sts_cov_core proc~s_utl_cholesky_solve s_utl_cholesky_solve proc~f_lin_mahalanobis_core->proc~s_utl_cholesky_solve proc~f_utl_r2c f_utl_r2c proc~s_err_print->proc~f_utl_r2c proc~f_sts_mean_core f_sts_mean_core proc~f_sts_cov_core->proc~f_sts_mean_core chol chol proc~s_utl_cholesky_solve->chol

Called by

proc~~f_lin_mahalanobis~~CalledByGraph proc~f_lin_mahalanobis f_lin_mahalanobis interface~fsml_mahalanobis fsml_mahalanobis interface~fsml_mahalanobis->proc~f_lin_mahalanobis

Source Code

impure function f_lin_mahalanobis(x, y, cov) result(dist)

! ==== Description
!! Impure wrapper function for `f_lin_mahalanobis_core`.

! ==== Declarations
  real(wp), intent(in)           :: x(:)     !! input vector 1
  real(wp), intent(in)           :: y(:)     !! input vector 2
  real(wp), intent(in), optional :: cov(:,:) !! covariance matrix
  real(wp)                       :: dist     !! Mahalanobis distance

! ==== Instructions

! ---- handle input

  ! check if size is valid
  if (size(x) .le. 1 .or. size(y) .le. 1) then
     ! write error message and assign sentinel value if invalid
     call s_err_print(fsml_error(4))
     dist = c_sentinel_r
     return
  endif

  if (present(cov)) then
     ! check if dims match
     if (size(cov, 1) .ne. size(x)) then
        ! write error message and assign sentinel value if invalid
        call s_err_print(fsml_error(3))
        dist = c_sentinel_r
        return
     endif

     ! check if dims match
     if (size(cov, 1) .ne. size(cov, 2)) then
        ! write error message and assign sentinel value if invalid
        call s_err_print(fsml_error(3))
        dist = c_sentinel_r
        return
     endif
  endif

! ---- compute Mahalanobis distance

  ! call pure function
  if (present(cov)) then
     dist = f_lin_mahalanobis_core(x, y, cov)
  else
     dist = f_lin_mahalanobis_core(x, y)
  endif

end function f_lin_mahalanobis