Wrapper function to handle GEES error codes
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | this | |||
integer(kind=ilp), | intent(in) | :: | info | |||
integer(kind=ilp), | intent(in) | :: | m | |||
integer(kind=ilp), | intent(in) | :: | n | |||
integer(kind=ilp), | intent(in) | :: | ldvs | |||
type(linalg_state_type), | intent(out) | :: | err |
elemental subroutine handle_gees_info(this, info, m, n, ldvs, err) character(len=*), intent(in) :: this integer(ilp), intent(in) :: info, m, n, ldvs type(linalg_state_type), intent(out) :: err ! Process GEES output select case (info) case (0_ilp) ! Success case (-1_ilp) ! Vector not wanted, but task is wrong err = linalg_state_type(this, LINALG_INTERNAL_ERROR,'Invalid Schur vector task request') case (-2_ilp) ! Vector not wanted, but task is wrong err = linalg_state_type(this, LINALG_INTERNAL_ERROR,'Invalid sorting task request') case (-4_ilp,-6_ilp) ! Vector not wanted, but task is wrong err = linalg_state_type(this, LINALG_VALUE_ERROR,'Invalid/non-square input matrix size:',[m,n]) case (-11_ilp) err = linalg_state_type(this, LINALG_VALUE_ERROR,'Schur vector matrix has insufficient size',[ldvs,n]) case (-13_ilp) err = linalg_state_type(this, LINALG_INTERNAL_ERROR,'Insufficient working storage size') case (1_ilp:) if (info==n+2) then err = linalg_state_type(this, LINALG_ERROR, 'Ill-conditioned problem: could not sort eigenvalues') elseif (info==n+1) then err = linalg_state_type(this, LINALG_ERROR, 'Some selected eigenvalues lost property due to sorting') elseif (info==n) then err = linalg_state_type(this, LINALG_ERROR, 'Convergence failure: no converged eigenvalues') else err = linalg_state_type(this, LINALG_ERROR, 'Convergence failure; converged range is',[info,n]) end if case default err = linalg_state_type(this, LINALG_INTERNAL_ERROR, 'GEES catastrophic error: info=', info) end select end subroutine handle_gees_info