@@ -31,6 +31,12 @@ module test_linalg_svd
31
31
#:endif
32
32
#:endfor
33
33
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
+
34
40
end subroutine test_svd
35
41
36
42
!> Real matrix svd
@@ -240,6 +246,37 @@ module test_linalg_svd
240
246
#:endif
241
247
#:endfor
242
248
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
+
243
280
end module test_linalg_svd
244
281
245
282
program test_lstsq
0 commit comments