Skip to content

Commit 92b1ac5

Browse files
perazzperazz
committed
reorganize as submodule 
1 parent c0da712 commit 92b1ac5

File tree

2 files changed

+79
-60
lines changed

2 files changed

+79
-60
lines changed

‎src/stdlib_linalg.fypp

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,9 @@ module stdlib_linalg
2020
public :: operator(.det.)
2121
public :: diag
2222
public :: eye
23+
public :: inv
24+
public :: invert
25+
public :: operator(.inv.)
2326
public :: lstsq
2427
public :: lstsq_space
2528
public :: solve
@@ -552,6 +555,50 @@ module stdlib_linalg
552555
#:endfor
553556
end interface
554557

558+
! Function interface
559+
interface inv
560+
#:for rk,rt,ri in RC_KINDS_TYPES
561+
#:if rk!="xdp"
562+
module function stdlib_linalg_inverse_${ri}$(a,err) result(inva)
563+
!> Input matrix a[n,n]
564+
${rt}$, intent(in) :: a(:,:)
565+
!> Output matrix inverse
566+
${rt}$, allocatable :: inva(:,:)
567+
!> [optional] state return flag. On error if not requested, the code will stop
568+
type(linalg_state_type), optional, intent(out) :: err
569+
end function stdlib_linalg_inverse_${ri}$
570+
#:endif
571+
#:endfor
572+
end interface inv
573+
574+
! Subroutine interface: in-place factorization
575+
interface invert
576+
#:for rk,rt,ri in RC_KINDS_TYPES
577+
#:if rk!="xdp"
578+
module subroutine stdlib_linalg_invert_${ri}$(a,err)
579+
!> Input matrix a[n,n]
580+
${rt}$, intent(inout) :: a(:,:)
581+
!> [optional] state return flag. On error if not requested, the code will stop
582+
type(linalg_state_type), optional, intent(out) :: err
583+
end subroutine stdlib_linalg_invert_${ri}$
584+
#:endif
585+
#:endfor
586+
end interface invert
587+
588+
! Operator interface
589+
interface operator(.inv.)
590+
#:for rk,rt,ri in RC_KINDS_TYPES
591+
#:if rk!="xdp"
592+
module function stdlib_linalg_inverse_${ri}$_operator(a) result(inva)
593+
!> Input matrix a[n,n]
594+
${rt}$, intent(in) :: a(:,:)
595+
!> Result matrix
596+
${rt}$, allocatable :: inva(:,:)
597+
end function stdlib_linalg_inverse_${ri}$_operator
598+
#:endif
599+
#:endfor
600+
end interface operator(.inv.)
601+
555602
contains
556603

557604

‎src/stdlib_linalg_inverse.fypp

Lines changed: 32 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -1,60 +1,40 @@
11
#:include "common.fypp"
22
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
3-
module stdlib_linalg_inverse
3+
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
77
use stdlib_linalg_state, only: linalg_state_type, linalg_error_handling, LINALG_ERROR, &
88
LINALG_INTERNAL_ERROR, LINALG_VALUE_ERROR
99
implicit none(type,external)
10-
private
1110

1211
character(*), parameter :: this = 'inverse'
1312

14-
!> Function interface return the matrix inverse
15-
public :: inv
16-
!> Subroutine interface: invert matrix inplace
17-
public :: invert
18-
!> Operator interface: .inv.A returns the matrix inverse of A
19-
public :: operator(.inv.)
20-
21-
! Numpy: inv(a)
22-
! Scipy: inv(a, overwrite_a=False, check_finite=True)
23-
! IMSL: .i.a
24-
25-
! Function interface
26-
interface inv
27-
#:for rk,rt,ri in RC_KINDS_TYPES
28-
#:if rk!="xdp"
29-
module procedure stdlib_linalg_inverse_${ri}$
30-
#:endif
31-
#:endfor
32-
end interface inv
33-
34-
! Subroutine interface: in-place factorization
35-
interface invert
36-
#:for rk,rt,ri in RC_KINDS_TYPES
37-
#:if rk!="xdp"
38-
module procedure stdlib_linalg_invert_${ri}$
39-
#:endif
40-
#:endfor
41-
end interface invert
42-
43-
! Operator interface
44-
interface operator(.inv.)
45-
#:for rk,rt,ri in RC_KINDS_TYPES
46-
#:if rk!="xdp"
47-
module procedure stdlib_linalg_inverse_${ri}$_operator
48-
#:endif
49-
#:endfor
50-
end interface operator(.inv.)
51-
5213
contains
5314

15+
elemental subroutine handle_getri_info(info,lda,n,err)
16+
integer(ilp), intent(in) :: info,lda,n
17+
type(linalg_state_type), intent(out) :: err
18+
19+
! Process output
20+
select case (info)
21+
case (0)
22+
! Success
23+
case (:-1)
24+
err = linalg_state_type(this,LINALG_ERROR,'invalid matrix size a=',[lda,n])
25+
case (1:)
26+
! Matrix is singular
27+
err = linalg_state_type(this,LINALG_ERROR,'singular matrix')
28+
case default
29+
err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'catastrophic error')
30+
end select
31+
32+
end subroutine handle_getri_info
33+
5434
#:for rk,rt,ri in RC_KINDS_TYPES
5535
#:if rk!="xdp"
5636
! Compute the in-place square matrix inverse of a
57-
subroutine stdlib_linalg_invert_${ri}$(a,err)
37+
module subroutine stdlib_linalg_invert_${ri}$(a,err)
5838
!> Input matrix a[n,n]
5939
${rt}$, intent(inout) :: a(:,:)
6040
!> [optional] state return flag. On error if not requested, the code will stop
@@ -72,7 +52,8 @@ module stdlib_linalg_inverse
7252

7353
if (lda<1 .or. n<1 .or. lda/=n) then
7454
err0 = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size: a=[',lda,',',n,']')
75-
goto 1
55+
call linalg_error_handling(err0,err)
56+
return
7657
end if
7758

7859
! Pivot indices
@@ -84,9 +65,9 @@ module stdlib_linalg_inverse
8465
! Return codes from getrf and getri are identical
8566
if (info==0) then
8667

87-
! Get optimal worksize (returned in work(1)) (inflate by a 2% safety margin)
68+
! Get optimal worksize (returned in work(1)) (inflate by a 5% safety margin)
8869
nb = stdlib_ilaenv(1,'${ri}$getri',' ',n,-1,-1,-1)
89-
lwork = ceiling(1.02*n*nb,kind=ilp)
70+
lwork = ceiling(1.05*n*nb,kind=ilp)
9071

9172
allocate(work(lwork))
9273

@@ -95,25 +76,16 @@ module stdlib_linalg_inverse
9576

9677
endif
9778

98-
select case (info)
99-
case (0)
100-
! Success
101-
case (:-1)
102-
err0 = linalg_state_type(this,LINALG_ERROR,'invalid matrix size a=[',lda,',',n,']')
103-
case (1:)
104-
! Matrix is singular
105-
err0 = linalg_state_type(this,LINALG_ERROR,'singular matrix')
106-
case default
107-
err0 = linalg_state_type(this,LINALG_INTERNAL_ERROR,'catastrophic error')
108-
end select
79+
! Process output
80+
call handle_getri_info(info,lda,n,err0)
10981

11082
! Process output and return
111-
1 call linalg_error_handling(err0,err)
83+
call linalg_error_handling(err0,err)
11284

11385
end subroutine stdlib_linalg_invert_${ri}$
11486

11587
! Invert matrix in place
116-
function stdlib_linalg_inverse_${ri}$(a,err) result(inva)
88+
module function stdlib_linalg_inverse_${ri}$(a,err) result(inva)
11789
!> Input matrix a[n,n]
11890
${rt}$, intent(in) :: a(:,:)
11991
!> Output matrix inverse
@@ -130,7 +102,7 @@ module stdlib_linalg_inverse
130102
end function stdlib_linalg_inverse_${ri}$
131103

132104
! Inverse matrix operator
133-
function stdlib_linalg_inverse_${ri}$_operator(a) result(inva)
105+
module function stdlib_linalg_inverse_${ri}$_operator(a) result(inva)
134106
!> Input matrix a[n,n]
135107
${rt}$, intent(in) :: a(:,:)
136108
!> Result matrix
@@ -140,12 +112,12 @@ module stdlib_linalg_inverse
140112

141113
inva = stdlib_linalg_inverse_${ri}$(a,err0)
142114

143-
! On error, return an empty matrix
115+
! On error, return zeros
144116
if (err0%error()) inva = 0.0_${rk}$
145117

146118
end function stdlib_linalg_inverse_${ri}$_operator
147119

148120
#:endif
149121
#:endfor
150122

151-
end module stdlib_linalg_inverse
123+
end submodule stdlib_linalg_inverse

0 commit comments

Comments
 (0)