solve Interface

public interface solve

Solves the linear system for the unknown vector from a square matrix . (Specification)

Summary

Interface for solving a linear system arising from a general matrix.

Description

This interface provides methods for computing the solution of a linear matrix system. Supported data types include real and complex. No assumption is made on the matrix structure. The function can solve simultaneously either one (from a 1-d right-hand-side vector b(:)) or several (from a 2-d right-hand-side vector b(:,:)) systems.

Note

The solution is based on LAPACK's generic LU decomposition based solvers *GESV.


Functions

private pure module function stdlib_linalg_c_pure_solve_many(a, b) result(x)

Arguments

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

Input matrix a[n,n]

complex(kind=sp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

Return Value complex(kind=sp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private pure module function stdlib_linalg_c_pure_solve_one(a, b) result(x)

Arguments

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

Input matrix a[n,n]

complex(kind=sp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

Return Value complex(kind=sp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_c_solve_many(a, b, overwrite_a, err) result(x)

Arguments

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

Input matrix a[n,n]

complex(kind=sp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A data be overwritten and destroyed?

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

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

Return Value complex(kind=sp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_c_solve_one(a, b, overwrite_a, err) result(x)

Arguments

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

Input matrix a[n,n]

complex(kind=sp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A data be overwritten and destroyed?

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

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

Return Value complex(kind=sp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]

private pure module function stdlib_linalg_d_pure_solve_many(a, b) result(x)

Arguments

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

Input matrix a[n,n]

real(kind=dp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

Return Value real(kind=dp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private pure module function stdlib_linalg_d_pure_solve_one(a, b) result(x)

Arguments

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

Input matrix a[n,n]

real(kind=dp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

Return Value real(kind=dp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_d_solve_many(a, b, overwrite_a, err) result(x)

Arguments

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

Input matrix a[n,n]

real(kind=dp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A data be overwritten and destroyed?

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

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

Return Value real(kind=dp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_d_solve_one(a, b, overwrite_a, err) result(x)

Arguments

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

Input matrix a[n,n]

real(kind=dp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A data be overwritten and destroyed?

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

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

Return Value real(kind=dp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]

private pure module function stdlib_linalg_s_pure_solve_many(a, b) result(x)

Arguments

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

Input matrix a[n,n]

real(kind=sp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

Return Value real(kind=sp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private pure module function stdlib_linalg_s_pure_solve_one(a, b) result(x)

Arguments

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

Input matrix a[n,n]

real(kind=sp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

Return Value real(kind=sp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_s_solve_many(a, b, overwrite_a, err) result(x)

Arguments

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

Input matrix a[n,n]

real(kind=sp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A data be overwritten and destroyed?

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

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

Return Value real(kind=sp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_s_solve_one(a, b, overwrite_a, err) result(x)

Arguments

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

Input matrix a[n,n]

real(kind=sp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A data be overwritten and destroyed?

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

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

Return Value real(kind=sp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]

private pure module function stdlib_linalg_z_pure_solve_many(a, b) result(x)

Arguments

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

Input matrix a[n,n]

complex(kind=dp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

Return Value complex(kind=dp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private pure module function stdlib_linalg_z_pure_solve_one(a, b) result(x)

Arguments

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

Input matrix a[n,n]

complex(kind=dp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

Return Value complex(kind=dp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_z_solve_many(a, b, overwrite_a, err) result(x)

Arguments

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

Input matrix a[n,n]

complex(kind=dp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A data be overwritten and destroyed?

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

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

Return Value complex(kind=dp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_z_solve_one(a, b, overwrite_a, err) result(x)

Arguments

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

Input matrix a[n,n]

complex(kind=dp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A data be overwritten and destroyed?

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

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

Return Value complex(kind=dp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]