pseudoinvert Interface

public interface pseudoinvert

Computation of the Moore-Penrose pseudo-inverse (Specification)

Summary

This interface provides methods for computing the Moore-Penrose pseudo-inverse of a rectangular or square real or complex matrix. The pseudo-inverse generalizes the matrix inverse and satisfies the properties: - - - -

Description

This subroutine interface provides a way to compute the Moore-Penrose pseudo-inverse of a matrix.
Supported data types include real and complex. Users must provide two matrices: the input matrix a [m,n] and the output pseudo-inverse pinva [n,m]. The input matrix a is used to compute the pseudo-inverse and is not modified. The computed pseudo-inverse is stored in pinva. The computation is based on the singular value decomposition (SVD).

An optional relative tolerance rtol is used to control the inclusion of singular values in the computation. Singular values below are treated as zero, where is the largest singular value. If rtol is not provided, a default threshold is applied.

Exceptions are raised in case of computational errors or invalid input, and trigger an error stop if the state flag err is not provided.

Note

The provided subroutines are intended for both rectangular and square matrices.


Subroutines

private module subroutine stdlib_linalg_pseudoinvert_c(a, pinva, rtol, err)

Arguments

Type IntentOptional Attributes Name
complex(kind=sp), intent(inout) :: a(:,:)

Input matrix a[m,n]

complex(kind=sp), intent(out) :: pinva(:,:)

Output pseudo-inverse matrix [n,m]

real(kind=sp), intent(in), optional :: rtol

[optional] Relative tolerance for singular value cutoff

type(linalg_state_type), intent(out), optional :: err

[optional] State return flag. On error if not requested, the code will stop

private module subroutine stdlib_linalg_pseudoinvert_d(a, pinva, rtol, err)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(inout) :: a(:,:)

Input matrix a[m,n]

real(kind=dp), intent(out) :: pinva(:,:)

Output pseudo-inverse matrix [n,m]

real(kind=dp), intent(in), optional :: rtol

[optional] Relative tolerance for singular value cutoff

type(linalg_state_type), intent(out), optional :: err

[optional] State return flag. On error if not requested, the code will stop

private module subroutine stdlib_linalg_pseudoinvert_s(a, pinva, rtol, err)

Arguments

Type IntentOptional Attributes Name
real(kind=sp), intent(inout) :: a(:,:)

Input matrix a[m,n]

real(kind=sp), intent(out) :: pinva(:,:)

Output pseudo-inverse matrix [n,m]

real(kind=sp), intent(in), optional :: rtol

[optional] Relative tolerance for singular value cutoff

type(linalg_state_type), intent(out), optional :: err

[optional] State return flag. On error if not requested, the code will stop

private module subroutine stdlib_linalg_pseudoinvert_z(a, pinva, rtol, err)

Arguments

Type IntentOptional Attributes Name
complex(kind=dp), intent(inout) :: a(:,:)

Input matrix a[m,n]

complex(kind=dp), intent(out) :: pinva(:,:)

Output pseudo-inverse matrix [n,m]

real(kind=dp), intent(in), optional :: rtol

[optional] Relative tolerance for singular value cutoff

type(linalg_state_type), intent(out), optional :: err

[optional] State return flag. On error if not requested, the code will stop