Skip to content

Commit 91a4e36

Browse files
committed
chol: function interface, implement and test
1 parent 74074a4 commit 91a4e36

File tree

3 files changed

+45
-4
lines changed

3 files changed

+45
-4
lines changed

src/stdlib_linalg.fypp

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ module stdlib_linalg
1616
implicit none
1717
private
1818

19+
public :: chol
1920
public :: cholesky
2021
public :: det
2122
public :: operator(.det.)
@@ -43,6 +44,23 @@ module stdlib_linalg
4344
! Export linalg error handling
4445
public :: linalg_state_type, linalg_error_handling
4546

47+
interface chol
48+
#:for rk,rt,ri in RC_KINDS_TYPES
49+
#:if rk!="xdp"
50+
pure module function stdlib_linalg_${ri}$_cholesky_fun(a,lower,other_zeroed) result(c)
51+
!> Input matrix a[m,n]
52+
${rt}$, intent(in) :: a(:,:)
53+
!> [optional] is the lower or upper triangular factor required? Default = lower
54+
logical(lk), optional, intent(in) :: lower
55+
!> [optional] should the unused half of the return matrix be zeroed out? Default: yes
56+
logical(lk), optional, intent(in) :: other_zeroed
57+
!> Output matrix with Cholesky factors c[n,n]
58+
${rt}$, allocatable :: c(:,:)
59+
end function stdlib_linalg_${ri}$_cholesky_fun
60+
#:endif
61+
#:endfor
62+
end interface chol
63+
4664
interface cholesky
4765
#:for rk,rt,ri in RC_KINDS_TYPES
4866
#:if rk!="xdp"

src/stdlib_linalg_cholesky.fypp

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -156,6 +156,24 @@ submodule (stdlib_linalg) stdlib_linalg_cholesky
156156

157157
end subroutine stdlib_linalg_${ri}$_cholesky
158158

159+
! Compute the Cholesky factorization of a symmetric / Hermitian matrix, A = L*L^T = U^T*U.
160+
! Function interface
161+
pure module function stdlib_linalg_${ri}$_cholesky_fun(a,lower,other_zeroed) result(c)
162+
!> Input matrix a[n,n]
163+
${rt}$, intent(in) :: a(:,:)
164+
!> Output matrix with Cholesky factors c[n,n]
165+
${rt}$, allocatable :: c(:,:)
166+
!> [optional] is the lower or upper triangular factor required? Default = lower
167+
logical(lk), optional, intent(in) :: lower
168+
!> [optional] should the unused half of the return matrix be zeroed out? Default: yes
169+
logical(lk), optional, intent(in) :: other_zeroed
170+
171+
allocate(c,source=a)
172+
173+
call stdlib_linalg_${ri}$_cholesky_inplace(c,lower,other_zeroed)
174+
175+
end function stdlib_linalg_${ri}$_cholesky_fun
176+
159177
#:endif
160178
#:endfor
161179

test/linalg/test_linalg_cholesky.fypp

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4,13 +4,13 @@
44
module test_linalg_cholesky
55
use testdrive, only: error_type, check, new_unittest, unittest_type
66
use stdlib_linalg_constants
7-
use stdlib_linalg, only: cholesky
7+
use stdlib_linalg, only: cholesky,chol
88
use stdlib_linalg_state, only: linalg_state_type
99

1010
implicit none (type,external)
1111
private
1212

13-
public :: test_cholesky_factorization
13+
public :: test_cholesky_factorization
1414

1515
contains
1616

@@ -53,12 +53,17 @@ module test_linalg_cholesky
5353
! 1) Cholesky factorization with full matrices
5454
call cholesky(a, l, other_zeroed=.true., err=state)
5555

56-
call check(error,state%ok(),state%print())
56+
call check(error,state%ok(),'cholesky (subr) :: '//state%print())
5757
if (allocated(error)) return
5858

59-
call check(error, all(abs(a-matmul(l,transpose(l)))<tol), 'data converged')
59+
call check(error, all(abs(a-matmul(l,transpose(l)))<tol), 'cholesky (subr) :: data converged')
6060
if (allocated(error)) return
6161

62+
! 2) Function interface
63+
l = chol(a, other_zeroed=.true.)
64+
65+
call check(error, all(abs(a-matmul(l,transpose(l)))<tol), 'cholesky (function) :: data converged')
66+
if (allocated(error)) return
6267

6368
end subroutine test_cholesky_${ri}$
6469

0 commit comments

Comments
 (0)