Skip to content

Commit bde2f3c

Browse files
committed
add test
1 parent e832a10 commit bde2f3c

File tree

1 file changed

+37
-0
lines changed

1 file changed

+37
-0
lines changed

test/linalg/test_linalg_svd.fypp

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,12 @@ module test_linalg_svd
3131
#:endif
3232
#:endfor
3333

34+
#:for rk,rt,ri in RC_KINDS_TYPES
35+
#:if rk!="xdp"
36+
tests = [tests,new_unittest("test_svd_row_${ri}$",test_svd_row_${ri}$)]
37+
#:endif
38+
#:endfor
39+
3440
end subroutine test_svd
3541

3642
!> Real matrix svd
@@ -240,6 +246,37 @@ module test_linalg_svd
240246
#:endif
241247
#:endfor
242248

249+
250+
#:for rk,rt,ri in RC_KINDS_TYPES
251+
#:if rk!="xdp"
252+
! Issue #835: bounds checking triggers an error with 1-sized A matrix
253+
subroutine test_svd_row_${ri}$(error)
254+
type(error_type), allocatable, intent(out) :: error
255+
256+
!> Reference solution
257+
type(linalg_state_type) :: state
258+
integer(ilp), parameter :: m = 1, n = 1
259+
real(${rk}$), parameter :: tol = sqrt(epsilon(0.0_${rk}$))
260+
real(${rk}$) :: Arand(m, n), S(n)
261+
${rt}$ :: A(m, n), U(m, m), Vt(n, n)
262+
263+
! Random matrix.
264+
call random_number(Arand)
265+
A = Arand
266+
267+
call svd(A, S, U, Vt, err=state)
268+
269+
call check(error,state%ok(),'1-row SVD: '//state%print())
270+
if (allocated(error)) return
271+
call check(error, abs(S(1)-A(1,1))<tol, '1-row SVD: result')
272+
if (allocated(error)) return
273+
274+
end subroutine test_svd_row_${ri}$
275+
276+
#:endif
277+
#:endfor
278+
279+
243280
end module test_linalg_svd
244281

245282
program test_lstsq

0 commit comments

Comments
 (0)