Skip to content

Commit 063b421

Browse files
committed
create submodule
1 parent 4a90c09 commit 063b421

File tree

3 files changed

+61
-34
lines changed

3 files changed

+61
-34
lines changed

src/stdlib_linalg.fypp

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,8 @@ module stdlib_linalg
2424
public :: lstsq_space
2525
public :: solve_lstsq
2626
public :: trace
27+
public :: svd
28+
public :: svdvals
2729
public :: outer_product
2830
public :: kronecker_product
2931
public :: cross_product
@@ -456,6 +458,58 @@ module stdlib_linalg
456458
#:endfor
457459
end interface
458460

461+
! Singular value decomposition
462+
interface svd
463+
!! version: experimental
464+
!!
465+
!!### Description
466+
!!
467+
!!
468+
469+
#:for rk,rt,ri in RC_KINDS_TYPES
470+
#:if rk!="xdp"
471+
module subroutine stdlib_linalg_svd_${ri}$(a,s,u,vt,overwrite_a,full_matrices,err)
472+
!> Input matrix A[m,n]
473+
${rt}$, intent(inout), target :: a(:,:)
474+
!> Array of singular values
475+
real(${rk}$), intent(out) :: s(:)
476+
!> The columns of U contain the eigenvectors of A A^T
477+
${rt}$, optional, intent(out), target :: u(:,:)
478+
!> The rows of V^T contain the eigenvectors of A^T A
479+
${rt}$, optional, intent(out), target :: vt(:,:)
480+
!> [optional] Can A data be overwritten and destroyed?
481+
logical(lk), optional, intent(in) :: overwrite_a
482+
!> [optional] full matrices have shape(u)==[m,m], shape(vh)==[n,n] (default); otherwise
483+
!> they are shape(u)==[m,k] and shape(vh)==[k,n] with k=min(m,n)
484+
logical(lk), optional, intent(in) :: full_matrices
485+
!> [optional] state return flag. On error if not requested, the code will stop
486+
type(linalg_state_type), optional, intent(out) :: err
487+
end subroutine stdlib_linalg_svd_${ri}$
488+
#:endif
489+
#:endfor
490+
end interface svd
491+
492+
! Singular values
493+
interface svdvals
494+
!! version: experimental
495+
!!
496+
!!### Description
497+
!!
498+
!!
499+
#:for rk,rt,ri in RC_KINDS_TYPES
500+
#:if rk!="xdp"
501+
module function stdlib_linalg_svdvals_${ri}$(a,err) result(s)
502+
!> Input matrix A[m,n]
503+
${rt}$, intent(in), target :: a(:,:)
504+
!> [optional] state return flag. On error if not requested, the code will stop
505+
type(linalg_state_type), optional, intent(out) :: err
506+
!> Array of singular values
507+
real(${rk}$), allocatable :: s(:)
508+
end function stdlib_linalg_svdvals_${ri}$
509+
#:endif
510+
#:endfor
511+
end interface svdvals
512+
459513
contains
460514

461515

src/stdlib_linalg_svd.fypp

Lines changed: 6 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#:include "common.fypp"
22
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
3-
module stdlib_linalg_svd
3+
submodule(stdlib_linalg) stdlib_linalg_svd
44
!! Singular-Value Decomposition
55
use stdlib_linalg_constants
66
use stdlib_linalg_lapack, only: gesdd
@@ -9,30 +9,8 @@ module stdlib_linalg_svd
99
implicit none(type,external)
1010

1111
character(*), parameter :: this = 'svd'
12-
13-
!> Singular value decomposition
14-
public :: svd
15-
!> Singular values
16-
public :: svdvals
17-
18-
! Numpy: svd(a, full_matrices=True, compute_uv=True, hermitian=False)
19-
! Scipy: svd(a, full_matrices=True, compute_uv=True, overwrite_a=False, check_finite=True, lapack_driver='gesdd')
20-
21-
interface svd
22-
#:for rk,rt,ri in RC_KINDS_TYPES
23-
#:if rk!="xdp"
24-
module procedure stdlib_linalg_svd_${ri}$
25-
#:endif
26-
#:endfor
27-
end interface svd
28-
29-
interface svdvals
30-
#:for rk,rt,ri in RC_KINDS_TYPES
31-
#:if rk!="xdp"
32-
module procedure stdlib_linalg_svdvals_${ri}$
33-
#:endif
34-
#:endfor
35-
end interface svdvals
12+
13+
!> List of internal GESDD tasks:
3614

3715
!> Return full matrices U, V^T to separate storage
3816
character, parameter :: GESDD_FULL_MATRICES = 'A'
@@ -46,9 +24,6 @@ module stdlib_linalg_svd
4624
!> Do not return either U or VT (singular values array only)
4725
character, parameter :: GESDD_SINGVAL_ONLY = 'N'
4826

49-
50-
51-
5227
contains
5328

5429
!> Process GESDD output flag
@@ -87,7 +62,7 @@ module stdlib_linalg_svd
8762
#:if rk!="xdp"
8863

8964
!> Singular values of matrix A
90-
function stdlib_linalg_svdvals_${ri}$(a,err) result(s)
65+
module function stdlib_linalg_svdvals_${ri}$(a,err) result(s)
9166
!> Input matrix A[m,n]
9267
${rt}$, intent(in), target :: a(:,:)
9368
!> [optional] state return flag. On error if not requested, the code will stop
@@ -115,7 +90,7 @@ module stdlib_linalg_svd
11590
end function stdlib_linalg_svdvals_${ri}$
11691

11792
!> SVD of matrix A = U S V^T, returning S and optionally U and V^T
118-
subroutine stdlib_linalg_svd_${ri}$(a,s,u,vt,overwrite_a,full_matrices,err)
93+
module subroutine stdlib_linalg_svd_${ri}$(a,s,u,vt,overwrite_a,full_matrices,err)
11994
!> Input matrix A[m,n]
12095
${rt}$, intent(inout), target :: a(:,:)
12196
!> Array of singular values
@@ -285,4 +260,4 @@ module stdlib_linalg_svd
285260
#:endif
286261
#:endfor
287262

288-
end module stdlib_linalg_svd
263+
end submodule stdlib_linalg_svd

test/linalg/test_linalg_svd.fypp

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,8 @@
44
module test_linalg_svd
55
use testdrive, only: error_type, check, new_unittest, unittest_type
66
use stdlib_linalg_constants
7-
use stdlib_linalg, only: diag
8-
use stdlib_linalg_svd, only: svd,svdvals
7+
use stdlib_linalg, only: diag,svd,svdvals
98
use stdlib_linalg_state, only: linalg_state_type
10-
119
implicit none (type,external)
1210

1311
public :: test_svd

0 commit comments

Comments
 (0)