Skip to content

Commit fe331f9

Browse files
committed
add cg and pcg tests
1 parent 6627f4c commit fe331f9

File tree

1 file changed

+55
-2
lines changed

1 file changed

+55
-2
lines changed

test/linalg/test_linalg_solve_iterative.fypp

Lines changed: 55 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,9 @@ module test_linalg_solve_iterative
2222
allocate(tests(0))
2323

2424
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) ]
2628

2729
end subroutine test_linear_systems
2830

@@ -97,7 +99,58 @@ module test_linalg_solve_iterative
9799
#:endfor
98100
end subroutine test_solve_ldlt
99101

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
101154

102155
end module test_linalg_solve_iterative
103156

0 commit comments

Comments
 (0)