Skip to content

Commit 9d86d45

Browse files
committed
fix templated interface
1 parent 09bf7bc commit 9d86d45

File tree

2 files changed

+55
-31
lines changed

2 files changed

+55
-31
lines changed

src/stdlib_linalg.fypp

Lines changed: 35 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,9 @@
55
#:set RHS_SYMBOL = [ranksuffix(r) for r in [1,2]]
66
#:set RHS_EMPTY = [emptyranksuffix(r) for r in [1,2]]
77
#:set ALL_RHS = list(zip(RHS_SYMBOL,RHS_SUFFIX,RHS_EMPTY))
8+
#:set EIG_PROBLEM = ["standard", "generalized"]
9+
#:set EIG_FUNCTION = ["geev","ggev"]
10+
#:set EIG_PROBLEM_LIST = list(zip(EIG_PROBLEM, EIG_FUNCTION))
811
module stdlib_linalg
912
!!Provides a support for various linear algebra procedures
1013
!! ([Specification](../page/specs/stdlib_linalg.html))
@@ -832,12 +835,16 @@ module stdlib_linalg
832835
!!@note BLAS/LAPACK backends do not currently support extended precision (``xdp``).
833836
!!
834837
#:for rk,rt,ri in RC_KINDS_TYPES
835-
#:if rk!="xdp"
836-
module subroutine stdlib_linalg_eig_${ri}$(a,lambda,right,left,overwrite_a,err)
838+
#:for ep,ei in EIG_PROBLEM_LIST
839+
module subroutine stdlib_linalg_eig_${ep}$_${ri}$(a#{if ei=='ggev'}#,b#{endif}#,lambda,right,left,overwrite_a,err)
837840
!! Eigendecomposition of matrix A returning an array `lambda` of eigenvalues,
838841
!! and optionally right or left eigenvectors.
839842
!> Input matrix A[m,n]
840843
${rt}$, intent(inout), target :: a(:,:)
844+
#:if ei=='ggev'
845+
!> Generalized problem matrix B[n,n]
846+
${rt}$, intent(inout), target :: b(:,:)
847+
#:endif
841848
!> Array of eigenvalues
842849
complex(${rk}$), intent(out) :: lambda(:)
843850
!> The columns of RIGHT contain the right eigenvectors of A
@@ -848,17 +855,18 @@ module stdlib_linalg
848855
logical(lk), optional, intent(in) :: overwrite_a
849856
!> [optional] state return flag. On error if not requested, the code will stop
850857
type(linalg_state_type), optional, intent(out) :: err
851-
end subroutine stdlib_linalg_eig_${ri}$
852-
#:endif
853-
#:endfor
854-
#:for rk,rt,ri in REAL_KINDS_TYPES
855-
#:if rk!="xdp"
856-
module subroutine stdlib_linalg_real_eig_${ri}$(a,lambda,right,left,overwrite_a,err)
858+
end subroutine stdlib_linalg_eig_${ep}$_${ri}$
859+
860+
module subroutine stdlib_linalg_real_eig_${ep}$_${ri}$(a#{if ei=='ggev'}#,b#{endif}#,lambda,right,left,overwrite_a,err)
857861
!! Eigendecomposition of matrix A returning an array `lambda` of real eigenvalues,
858862
!! and optionally right or left eigenvectors. Returns an error if the eigenvalues had
859863
!! non-trivial imaginary parts.
860864
!> Input matrix A[m,n]
861-
${rt}$, intent(inout), target :: a(:,:)
865+
${rt}$, intent(in), target :: a(:,:)
866+
#:if ei=='ggev'
867+
!> Generalized problem matrix B[n,n]
868+
${rt}$, intent(inout), target :: b(:,:)
869+
#:endif
862870
!> Array of real eigenvalues
863871
real(${rk}$), intent(out) :: lambda(:)
864872
!> The columns of RIGHT contain the right eigenvectors of A
@@ -869,9 +877,9 @@ module stdlib_linalg
869877
logical(lk), optional, intent(in) :: overwrite_a
870878
!> [optional] state return flag. On error if not requested, the code will stop
871879
type(linalg_state_type), optional, intent(out) :: err
872-
end subroutine stdlib_linalg_real_eig_${ri}$
873-
#:endif
880+
end subroutine stdlib_linalg_real_eig_${ep}$_${ri}$
874881
#:endfor
882+
#:endfor
875883
end interface eig
876884

877885
! Eigenvalues of a square matrix
@@ -895,25 +903,33 @@ module stdlib_linalg
895903
!!@note BLAS/LAPACK backends do not currently support extended precision (``xdp``).
896904
!!
897905
#:for rk,rt,ri in RC_KINDS_TYPES
898-
#:if rk!="xdp"
899-
module function stdlib_linalg_eigvals_${ri}$(a,err) result(lambda)
906+
#:for ep,ei in EIG_PROBLEM_LIST
907+
module function stdlib_linalg_eigvals_${ep}$_${ri}$(a#{if ei=='ggev'}#,b#{endif}#,err) result(lambda)
900908
!! Return an array of eigenvalues of matrix A.
901909
!> Input matrix A[m,n]
902-
${rt}$, intent(in), target :: a(:,:)
910+
${rt}$, intent(in), dimension(:,:), target :: a
911+
#:if ei=='ggev'
912+
!> Generalized problem matrix B[n,n]
913+
${rt}$, intent(inout), dimension(:,:), target :: b
914+
#:endif
903915
!> [optional] state return flag. On error if not requested, the code will stop
904916
type(linalg_state_type), intent(out) :: err
905917
!> Array of singular values
906918
complex(${rk}$), allocatable :: lambda(:)
907-
end function stdlib_linalg_eigvals_${ri}$
919+
end function stdlib_linalg_eigvals_${ep}$_${ri}$
908920

909-
module function stdlib_linalg_eigvals_noerr_${ri}$(a) result(lambda)
921+
module function stdlib_linalg_eigvals_noerr_${ep}$_${ri}$(a#{if ei=='ggev'}#,b#{endif}#) result(lambda)
910922
!! Return an array of eigenvalues of matrix A.
911923
!> Input matrix A[m,n]
912-
${rt}$, intent(in), target :: a(:,:)
924+
${rt}$, intent(in), dimension(:,:), target :: a
925+
#:if ei=='ggev'
926+
!> Generalized problem matrix B[n,n]
927+
${rt}$, intent(inout), dimension(:,:), target :: b
928+
#:endif
913929
!> Array of singular values
914930
complex(${rk}$), allocatable :: lambda(:)
915-
end function stdlib_linalg_eigvals_noerr_${ri}$
916-
#:endif
931+
end function stdlib_linalg_eigvals_noerr_${ep}$_${ri}$
932+
#:endfor
917933
#:endfor
918934
end interface eigvals
919935

@@ -942,7 +958,6 @@ module stdlib_linalg
942958
!!@note BLAS/LAPACK backends do not currently support extended precision (``xdp``).
943959
!!
944960
#:for rk,rt,ri in RC_KINDS_TYPES
945-
#:if rk!="xdp"
946961
module subroutine stdlib_linalg_eigh_${ri}$(a,lambda,vectors,upper_a,overwrite_a,err)
947962
!! Eigendecomposition of a real symmetric or complex Hermitian matrix A returning an array `lambda`
948963
!! of eigenvalues, and optionally right or left eigenvectors.
@@ -959,7 +974,6 @@ module stdlib_linalg
959974
!> [optional] state return flag. On error if not requested, the code will stop
960975
type(linalg_state_type), optional, intent(out) :: err
961976
end subroutine stdlib_linalg_eigh_${ri}$
962-
#:endif
963977
#:endfor
964978
end interface eigh
965979

@@ -987,7 +1001,6 @@ module stdlib_linalg
9871001
!!@note BLAS/LAPACK backends do not currently support extended precision (``xdp``).
9881002
!!
9891003
#:for rk,rt,ri in RC_KINDS_TYPES
990-
#:if rk!="xdp"
9911004
module function stdlib_linalg_eigvalsh_${ri}$(a,upper_a,err) result(lambda)
9921005
!! Return an array of eigenvalues of real symmetric / complex hermitian A
9931006
!> Input matrix A[m,n]
@@ -1009,7 +1022,6 @@ module stdlib_linalg
10091022
!> Array of singular values
10101023
real(${rk}$), allocatable :: lambda(:)
10111024
end function stdlib_linalg_eigvalsh_noerr_${ri}$
1012-
#:endif
10131025
#:endfor
10141026
end interface eigvalsh
10151027

src/stdlib_linalg_eigenvalues.fypp

Lines changed: 20 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -131,7 +131,11 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
131131
module function stdlib_linalg_eigvals_${ep}$_${ri}$(a#{if ei=='ggev'}#,b#{endif}#,err) result(lambda)
132132
!! Return an array of eigenvalues of matrix A.
133133
!> Input matrix A[m,n]
134-
${rt}$, intent(in), dimension(:,:), target :: a #{if ei=='ggev'}#, b #{endif}#
134+
${rt}$, intent(in), dimension(:,:), target :: a
135+
#:if ei=='ggev'
136+
!> Generalized problem matrix B[n,n]
137+
${rt}$, intent(inout), dimension(:,:), target :: b
138+
#:endif
135139
!> [optional] state return flag. On error if not requested, the code will stop
136140
type(linalg_state_type), intent(out) :: err
137141
!> Array of eigenvalues
@@ -153,14 +157,18 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
153157
allocate(lambda(k))
154158

155159
!> Compute eigenvalues only
156-
call stdlib_linalg_eig_${ep}$_${ri}$(amat,#{if ei=='ggev'}#,bmat#{endif}#lambda,overwrite_a=.false.,err=err)
160+
call stdlib_linalg_eig_${ep}$_${ri}$(amat#{if ei=='ggev'}#,bmat#{endif}#,lambda,overwrite_a=.false.,err=err)
157161

158162
end function stdlib_linalg_eigvals_${ep}$_${ri}$
159163

160164
module function stdlib_linalg_eigvals_noerr_${ep}$_${ri}$(a#{if ei=='ggev'}#,b#{endif}#) result(lambda)
161165
!! Return an array of eigenvalues of matrix A.
162166
!> Input matrix A[m,n]
163-
${rt}$, intent(in), dimension(:,:), target :: a #{if ei=='ggev'}#, b #{endif}#
167+
${rt}$, intent(in), dimension(:,:), target :: a
168+
#:if ei=='ggev'
169+
!> Generalized problem matrix B[n,n]
170+
${rt}$, intent(inout), dimension(:,:), target :: b
171+
#:endif
164172
!> Array of eigenvalues
165173
complex(${rk}$), allocatable :: lambda(:)
166174

@@ -180,15 +188,19 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
180188
allocate(lambda(k))
181189

182190
!> Compute eigenvalues only
183-
call stdlib_linalg_eig_${ep}$_${ri}$(amat,#{if ei=='ggev'}#,bmat#{endif}#lambda,overwrite_a=.false.)
191+
call stdlib_linalg_eig_${ep}$_${ri}$(amat#{if ei=='ggev'}#,bmat#{endif}#,lambda,overwrite_a=.false.)
184192

185193
end function stdlib_linalg_eigvals_noerr_${ep}$_${ri}$
186194

187-
module subroutine stdlib_linalg_eig_${ep}$_${ri}$(a,#{if ei=='ggev'}#,b#{endif}#lambda,right,left,overwrite_a,err)
195+
module subroutine stdlib_linalg_eig_${ep}$_${ri}$(a#{if ei=='ggev'}#,b#{endif}#,lambda,right,left,overwrite_a,err)
188196
!! Eigendecomposition of matrix A returning an array `lambda` of eigenvalues,
189197
!! and optionally right or left eigenvectors.
190198
!> Input matrix A[m,n]
191-
${rt}$, intent(inout), target :: a(:,:)
199+
${rt}$, intent(inout), dimension(:,:), target :: a
200+
#:if ei=='ggev'
201+
!> Generalized problem matrix B[n,n]
202+
${rt}$, intent(inout), dimension(:,:), target :: b
203+
#:endif
192204
!> Array of eigenvalues
193205
complex(${rk}$), intent(out) :: lambda(:)
194206
!> [optional] RIGHT eigenvectors of A (as columns)
@@ -207,7 +219,7 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
207219
character :: task_u,task_v
208220
${rt}$, target :: work_dummy(1),u_dummy(1,1),v_dummy(1,1)
209221
${rt}$, allocatable :: work(:)
210-
${rt}$, pointer :: amat(:,:),umat(:,:),vmat(:,:)
222+
${rt}$, dimension(:,:), pointer :: amat,umat,vmat#{if ei=='ggev'}#,bmat#{endif}#
211223
#:if rt.startswith('complex')
212224
real(${rk}$), allocatable :: rwork(:)
213225
#:else
@@ -596,7 +608,7 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
596608
n = size(lambda,dim=1,kind=ilp)
597609
allocate(clambda(n))
598610

599-
call stdlib_linalg_eig_${ri}$(a,clambda,right,left,overwrite_a,err0)
611+
call stdlib_linalg_eig_standard_${ri}$(a,clambda,right,left,overwrite_a,err0)
600612

601613
! Check that no eigenvalues have meaningful imaginary part
602614
if (err0%ok() .and. any(aimag(clambda)>atol+rtol*abs(abs(clambda)))) then

0 commit comments

Comments
 (0)