Skip to content

Commit

Permalink
add test
Browse files Browse the repository at this point in the history
  • Loading branch information
perazz committed Jun 15, 2024
1 parent e832a10 commit bde2f3c
Showing 1 changed file with 37 additions and 0 deletions.
37 changes: 37 additions & 0 deletions test/linalg/test_linalg_svd.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,12 @@ module test_linalg_svd
#:endif
#:endfor

#:for rk,rt,ri in RC_KINDS_TYPES
#:if rk!="xdp"
tests = [tests,new_unittest("test_svd_row_${ri}$",test_svd_row_${ri}$)]
#:endif
#:endfor

end subroutine test_svd

!> Real matrix svd
Expand Down Expand Up @@ -240,6 +246,37 @@ module test_linalg_svd
#:endif
#:endfor


#:for rk,rt,ri in RC_KINDS_TYPES
#:if rk!="xdp"
! Issue #835: bounds checking triggers an error with 1-sized A matrix
subroutine test_svd_row_${ri}$(error)
type(error_type), allocatable, intent(out) :: error

!> Reference solution
type(linalg_state_type) :: state
integer(ilp), parameter :: m = 1, n = 1
real(${rk}$), parameter :: tol = sqrt(epsilon(0.0_${rk}$))
real(${rk}$) :: Arand(m, n), S(n)
${rt}$ :: A(m, n), U(m, m), Vt(n, n)

! Random matrix.
call random_number(Arand)
A = Arand

call svd(A, S, U, Vt, err=state)

call check(error,state%ok(),'1-row SVD: '//state%print())
if (allocated(error)) return
call check(error, abs(S(1)-A(1,1))<tol, '1-row SVD: result')
if (allocated(error)) return

end subroutine test_svd_row_${ri}$

#:endif
#:endfor


end module test_linalg_svd

program test_lstsq
Expand Down

0 comments on commit bde2f3c

Please sign in to comment.