@@ -22,7 +22,9 @@ module test_linalg_solve_iterative
22
22
allocate(tests(0))
23
23
24
24
tests = [ new_unittest("factorize_ldlt",test_factorize_ldlt), &
25
- new_unittest("solve_ldlt",test_solve_ldlt) ]
25
+ new_unittest("solve_ldlt",test_solve_ldlt), &
26
+ new_unittest("solve_cg",test_solve_cg), &
27
+ new_unittest("solve_pcg",test_solve_pcg) ]
26
28
27
29
end subroutine test_linear_systems
28
30
@@ -97,7 +99,58 @@ module test_linalg_solve_iterative
97
99
#:endfor
98
100
end subroutine test_solve_ldlt
99
101
100
- ! TODO: add tests for solve_cg, solve_pcg, etc.
102
+ subroutine test_solve_cg(error)
103
+ type(error_type), allocatable, intent(out) :: error
104
+
105
+ #:for k, t, s in R_KINDS_TYPES
106
+ block
107
+ ${t}$, parameter :: tol = 1000*epsilon(0.0_${k}$)
108
+ ${t}$ :: A(2,2) = reshape([${t}$ :: 4, 1, &
109
+ 1, 3], [2,2])
110
+ ${t}$ :: x(2), load(2), xref(2)
111
+
112
+ xref = [0.0909, 0.6364]
113
+ x = real( [2,1] , kind = ${k}$ ) ! initial guess
114
+ load = real( [1,2] , kind = ${k}$ ) ! load vector
115
+
116
+ call solve_cg(A, load, x)
117
+
118
+
119
+ call check(error, norm2(x-xref)<1.e-4_${k}$, 'error in conjugate gradient solver')
120
+ if (allocated(error)) return
121
+ end block
122
+
123
+ #:endfor
124
+ end subroutine test_solve_cg
125
+
126
+ subroutine test_solve_pcg(error)
127
+ type(error_type), allocatable, intent(out) :: error
128
+
129
+ #:for k, t, s in R_KINDS_TYPES
130
+ block
131
+ ${t}$, parameter :: tol = 1000*epsilon(0.0_${k}$)
132
+ ${t}$ :: A(5,5) = reshape([${t}$ :: 1, -1, 0, 0, 0,&
133
+ -1, 2, -1, 0, 0,&
134
+ 0, -1, 2, -1, 0,&
135
+ 0, 0, -1, 2, -1,&
136
+ 0, 0, 0, -1, 1] , [5,5])
137
+ ${t}$ :: x(5), load(5), xref(5)
138
+ logical(1) :: dirichlet(5)
139
+
140
+ xref = [0.0_${k}$,2.5_${k}$,5.0_${k}$,2.5_${k}$,0.0_${k}$]
141
+ x = 0.0_${k}$
142
+ load = real( [0,0,5,0,0] , kind = ${k}$ ) ! load vector
143
+ dirichlet = .false._1
144
+ dirichlet([1,5]) = .true._1
145
+
146
+ call solve_pcg(A, load, x, di=dirichlet, tol=1.e-6_${k}$)
147
+
148
+ call check(error, norm2(x-xref)<1.e-6_${k}$*norm2(xref), 'error in preconditionned conjugate gradient solver')
149
+ if (allocated(error)) return
150
+ end block
151
+
152
+ #:endfor
153
+ end subroutine test_solve_pcg
101
154
102
155
end module test_linalg_solve_iterative
103
156
0 commit comments