Skip to content

Commit d0181ca

Browse files
committed
Move handle_getri_info
1 parent 0efcf5c commit d0181ca

File tree

2 files changed

+21
-20
lines changed

2 files changed

+21
-20
lines changed

src/lapack/stdlib_linalg_lapack_aux.fypp

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ module stdlib_linalg_lapack_aux
4141
public :: stdlib_selctg_${ri}$
4242
#:endfor
4343
public :: handle_potrf_info
44+
public :: handle_getri_info
4445

4546
! SELCTG is a LOGICAL FUNCTION of three DOUBLE PRECISION arguments
4647
! used to select eigenvalues to sort to the top left of the Schur form.
@@ -1311,5 +1312,23 @@ module stdlib_linalg_lapack_aux
13111312

13121313
end subroutine handle_potrf_info
13131314

1315+
elemental subroutine handle_getri_info(this,info,lda,n,err)
1316+
character(len=*), intent(in) :: this
1317+
integer(ilp), intent(in) :: info,lda,n
1318+
type(linalg_state_type), intent(out) :: err
1319+
1320+
! Process output
1321+
select case (info)
1322+
case (0)
1323+
! Success
1324+
case (:-1)
1325+
err = linalg_state_type(this,LINALG_ERROR,'invalid matrix size a=',[lda,n])
1326+
case (1:)
1327+
! Matrix is singular
1328+
err = linalg_state_type(this,LINALG_ERROR,'singular matrix')
1329+
case default
1330+
err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'catastrophic error')
1331+
end select
1332+
end subroutine handle_getri_info
13141333

13151334
end module stdlib_linalg_lapack_aux

src/stdlib_linalg_inverse.fypp

Lines changed: 2 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ submodule (stdlib_linalg) stdlib_linalg_inverse
44
!! Compute inverse of a square matrix
55
use stdlib_linalg_constants
66
use stdlib_linalg_lapack, only: getri,getrf,stdlib_ilaenv
7+
use stdlib_linalg_lapack_aux, only: handle_getri_info
78
use stdlib_linalg_state, only: linalg_state_type, linalg_error_handling, LINALG_ERROR, &
89
LINALG_INTERNAL_ERROR, LINALG_VALUE_ERROR
910
use ieee_arithmetic, only: ieee_value, ieee_quiet_nan
@@ -13,25 +14,6 @@ submodule (stdlib_linalg) stdlib_linalg_inverse
1314

1415
contains
1516

16-
elemental subroutine handle_getri_info(info,lda,n,err)
17-
integer(ilp), intent(in) :: info,lda,n
18-
type(linalg_state_type), intent(out) :: err
19-
20-
! Process output
21-
select case (info)
22-
case (0)
23-
! Success
24-
case (:-1)
25-
err = linalg_state_type(this,LINALG_ERROR,'invalid matrix size a=',[lda,n])
26-
case (1:)
27-
! Matrix is singular
28-
err = linalg_state_type(this,LINALG_ERROR,'singular matrix')
29-
case default
30-
err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'catastrophic error')
31-
end select
32-
33-
end subroutine handle_getri_info
34-
3517
#:for rk,rt,ri in RC_KINDS_TYPES
3618
! Compute the in-place square matrix inverse of a
3719
module subroutine stdlib_linalg_invert_inplace_${ri}$(a,pivot,err)
@@ -86,7 +68,7 @@ submodule (stdlib_linalg) stdlib_linalg_inverse
8668
endif
8769

8870
! Process output
89-
call handle_getri_info(info,lda,n,err0)
71+
call handle_getri_info(this,info,lda,n,err0)
9072

9173
! Process output and return
9274
if (.not.present(pivot)) deallocate(ipiv)

0 commit comments

Comments
 (0)