@@ -13,7 +13,6 @@ module test_linalg_least_squares
13
13
public :: test_least_squares
14
14
15
15
contains
16
-
17
16
18
17
!> Solve sample least squares problems
19
18
subroutine test_least_squares(tests)
@@ -24,15 +23,16 @@ module test_linalg_least_squares
24
23
25
24
#:for rk,rt,ri in REAL_KINDS_TYPES
26
25
#:if rk!="xdp"
27
- tests = [tests,new_unittest("lease_squares_${ri}$",test_lstsq_one_${ri}$)]
26
+ tests = [tests,new_unittest("least_squares_${ri}$",test_lstsq_one_${ri}$), &
27
+ new_unittest("least_squares_randm_${ri}$",test_lstsq_random_${ri}$)]
28
28
#:endif
29
29
#:endfor
30
30
31
31
end subroutine test_least_squares
32
-
33
- !> Simple polynomial fit
32
+
34
33
#:for rk,rt,ri in REAL_KINDS_TYPES
35
34
#:if rk!="xdp"
35
+ !> Simple polynomial fit
36
36
subroutine test_lstsq_one_${ri}$(error)
37
37
type(error_type), allocatable, intent(out) :: error
38
38
@@ -64,6 +64,32 @@ module test_linalg_least_squares
64
64
65
65
end subroutine test_lstsq_one_${ri}$
66
66
67
+ !> Fit from random array
68
+ subroutine test_lstsq_random_${ri}$(error)
69
+ type(error_type), allocatable, intent(out) :: error
70
+
71
+ type(linalg_state_type) :: state
72
+ integer(ilp), parameter :: n = 12, m = 3
73
+ ${rt}$ :: xsol(m),x(m),y(n),A(n,m)
74
+
75
+ ! Random coefficient matrix and solution
76
+ call random_number(A)
77
+ call random_number(xsol)
78
+
79
+ ! Compute rhs
80
+ y = matmul(A,xsol)
81
+
82
+ ! Find polynomial
83
+ x = lstsq(A,y,err=state)
84
+
85
+ call check(error,state%ok(),state%print())
86
+ if (allocated(error)) return
87
+
88
+ call check(error, all(abs(x-xsol)<1.0e-6_${rk}$), 'data converged')
89
+ if (allocated(error)) return
90
+
91
+ end subroutine test_lstsq_random_${ri}$
92
+
67
93
#:endif
68
94
#:endfor
69
95
0 commit comments