1! -----------------------------------------------------------------
2! Programmer(s): Cody J. Balos @ LLNL
3! -----------------------------------------------------------------
4! Acknowledgements: These testing routines are based on
5! test_sunlinsol.c written by David Gardner @ LLNL and Daniel
6! R. Reynolds @ SMU.
7! -----------------------------------------------------------------
8! SUNDIALS Copyright Start
9! Copyright (c) 2002-2021, Lawrence Livermore National Security
10! and Southern Methodist University.
11! All rights reserved.
12!
13! See the top-level LICENSE and NOTICE files for details.
14!
15! SPDX-License-Identifier: BSD-3-Clause
16! SUNDIALS Copyright End
17! -----------------------------------------------------------------
18! These test functions are designed to check the SWIG generated
19! Fortran interface to a SUNLinearSolver module implementation.
20! -----------------------------------------------------------------
21
22module test_sunlinsol
23  use, intrinsic :: iso_c_binding
24  use fsundials_nvector_mod
25  use fsundials_matrix_mod
26  use fsundials_types_mod
27  use test_utilities
28
29  implicit none
30
31  ! check_vector routine is provided by implementation specific tests
32  integer(C_INT), external :: check_vector
33
34contains
35
36  integer(C_INT) function Test_FSUNLinSolGetType(S, mysunid, myid) result(failure)
37    use, intrinsic :: iso_c_binding
38    use fsundials_linearsolver_mod
39
40    implicit none
41
42    type(SUNLinearSolver), pointer :: S
43    integer(SUNLinearSolver_Type)  :: mysunid, sunid
44    integer(C_INT)                 :: myid
45
46    sunid = FSUNLinSolGetType(S)
47    if (sunid /= mysunid) then
48      failure = 1
49      write(*,*) ">>> FAILED test -- FSUNLinSolGetType, Proc", myid
50    else if (myid == 0) then
51      failure = 0
52      write(*,*) "    PASSED test -- FSUNLinSolGetType"
53    end if
54  end function Test_FSUNLinSolGetType
55
56
57  integer(C_INT) function Test_FSUNLinSolLastFlag(S, myid) result(failure)
58    use, intrinsic :: iso_c_binding
59    use fsundials_linearsolver_mod
60
61    implicit none
62
63    type(SUNLinearSolver), pointer :: S
64    integer(C_INT)                 :: myid
65    integer(C_LONG)                :: lastflag
66
67    failure = 0
68
69    ! the only way to fail this test is if the function is NULL,
70    ! which will cause a seg-fault
71    lastflag = FSUNLinSolLastFlag(S)
72    if (myid == 0) then
73      write(*,'(A,I0,A)') "     PASSED test -- FSUNLinSolLastFlag (", lastflag, ")"
74    end if
75  end function Test_FSUNLinSolLastFlag
76
77
78  integer(C_INT) function Test_FSUNLinSolSpace(S, myid) result(failure)
79    use, intrinsic :: iso_c_binding
80    use fsundials_linearsolver_mod
81
82    implicit none
83
84    type(SUNLinearSolver), pointer :: S
85    integer(C_INT)                 :: myid
86    integer(C_LONG)                :: lenrw(1), leniw(1)
87
88    failure = 0
89
90    ! call FSUNLinSolSpace (failure based on output flag)
91    failure = FSUNLinSolSpace(S, lenrw, leniw)
92    if (failure /= 0) then
93      write(*,*) ">>> FAILED test -- FSUNLinSolSpace, Proc ", myid
94    else if (myid == 0) then
95      write(*,'(A,I0,A,I0)') "     PASSED test -- FSUNLinSolSpace, lenrw = ", &
96        lenrw, " leniw = ",  leniw
97    end if
98
99  end function Test_FSUNLinSolSpace
100
101
102  integer(C_INT) function Test_FSUNLinSolNumIters(S, myid) result(failure)
103    use, intrinsic :: iso_c_binding
104    use fsundials_linearsolver_mod
105
106    implicit none
107
108    type(SUNLinearSolver), pointer :: S
109    integer(C_INT)                 :: myid
110    integer(C_INT)                 :: numiters
111
112    failure = 0
113
114    ! the only way to fail this test is if the function is NULL (segfault will happen)
115    numiters = FSUNLinSolNumIters(S)
116
117    if (myid == 0) then
118      write(*,'(A,I0,A)') "     PASSED test -- FSUNLinSolNumIters (", numiters, ")"
119    end if
120
121  end function Test_FSUNLinSolNumIters
122
123
124  integer(C_INT) function Test_FSUNLinSolResNorm(S, myid) result(failure)
125    use, intrinsic :: iso_c_binding
126    use fsundials_linearsolver_mod
127
128    implicit none
129
130    type(SUNLinearSolver), pointer :: S
131    integer(C_INT)                 :: myid
132    real(C_DOUBLE)                 :: resnorm
133
134    failure = 0
135
136    resnorm = FSUNLinSolResNorm(S)
137
138    if (resnorm < ZERO) then
139      write(*,'(A,E14.7,A,I0)') &
140        ">>> FAILED test -- FSUNLinSolSolve returned ", resnorm, ", Proc ", myid
141    else if (myid == 0) then
142      write(*,*) "    PASSED test -- FSUNLinSolResNorm "
143    end if
144
145  end function Test_FSUNLinSolResNorm
146
147
148  integer(C_INT) function Test_FSUNLinSolResid(S, myid) result(failure)
149    use, intrinsic :: iso_c_binding
150    use fsundials_nvector_mod
151    use fsundials_linearsolver_mod
152
153    implicit none
154
155    type(SUNLinearSolver), pointer :: S
156    integer(C_INT)                 :: myid
157    type(N_Vector),        pointer :: resid
158
159    failure = 0
160
161    resid => FSUNLinSolResid(S)
162
163    if (.not. associated(resid)) then
164      write(*,*) ">>> FAILED test -- FSUNLinSolResid returned NULL N_Vector, Proc ", myid
165    else if (myid == 0) then
166      write(*,*) "    PASSED test -- FSUNLinSolResid "
167    end if
168
169  end function Test_FSUNLinSolResid
170
171
172  integer(C_INT) function Test_FSUNLinSolSetATimes(S, ATdata, ATimes, myid) &
173    result(failure)
174    use, intrinsic :: iso_c_binding
175    use fsundials_linearsolver_mod
176
177    implicit none
178
179    type(SUNLinearSolver), pointer :: S
180    type(C_PTR)                    :: ATdata
181    type(C_FUNPTR)                 :: ATimes
182    integer(C_INT)                 :: myid
183
184    failure = 0
185
186    ! try calling SetATimes routine: should pass/fail based on expected input
187    failure = FSUNLinSolSetATimes(S, ATdata, ATimes);
188
189    if (failure /= 0) then
190      write(*,'(A,I0,A,I0)') &
191        ">>> FAILED test -- FSUNLinSolSetATimes returned ", failure, ", Proc ", myid
192      failure = 1
193    else if (myid == 0) then
194      write(*,*) "    PASSED test -- FSUNLinSolSetATimes "
195    end if
196
197  end function Test_FSUNLinSolSetATimes
198
199
200  integer(C_INT) function Test_FSUNLinSolSetPreconditioner(S, Pdata, PSetup, PSolve, myid) &
201    result(failure)
202    use, intrinsic :: iso_c_binding
203    use fsundials_linearsolver_mod
204
205    implicit none
206
207    type(SUNLinearSolver), pointer :: S
208    type(C_PTR)                    :: Pdata
209    type(C_FUNPTR)                 :: PSetup, PSolve
210    integer(C_INT)                 :: myid
211
212    ! try calling SetPreconditioner routine: should pass/fail based on expected input
213    failure = FSUNLinSolSetPreconditioner(S, Pdata, PSetup, PSolve);
214
215    if (failure /= 0) then
216      write(*,'(A,I0,A,I0)') &
217        ">>> FAILED test -- FSUNLinSolSetPreconditioner returned ", failure, ", Proc ", myid
218      failure = 1
219    else if (myid == 0) then
220      write(*,*) "    PASSED test -- FSUNLinSolSetPreconditioner "
221    end if
222
223  end function Test_FSUNLinSolSetPreconditioner
224
225
226  integer(C_INT) function Test_FSUNLinSolSetScalingVectors(S, s1, s2, myid) &
227    result(failure)
228    use, intrinsic :: iso_c_binding
229    use fsundials_linearsolver_mod
230    use fsundials_nvector_mod
231
232    implicit none
233
234    type(SUNLinearSolver) :: S
235    type(N_Vector)        :: s1, s2
236    integer(C_INT)        :: myid
237
238    failure = 0
239
240    ! try calling SetScalingVectors routine: should pass/fail based on expected input
241    failure = FSUNLinSolSetScalingVectors(S, s1, s2)
242
243    if (failure /= 0) then
244      write(*,'(A,I0,A,I0)') &
245        ">>> FAILED test -- FSUNLinSolSetScalingVectors returned ", failure, ", Proc ", myid
246      failure = 1
247    else if (myid == 0) then
248      write(*,*) "    PASSED test -- FSUNLinSolSetScalingVectors "
249    end if
250
251  end function Test_FSUNLinSolSetScalingVectors
252
253
254  integer(C_INT) function Test_FSUNLinSolInitialize(S, myid) result(failure)
255    use, intrinsic :: iso_c_binding
256    use fsundials_linearsolver_mod
257
258    implicit none
259
260    type(SUNLinearSolver) :: S
261    integer(C_INT)        :: myid
262
263    failure = 0
264
265    failure = FSUNLinSolInitialize(S)
266
267    if (failure /= 0) then
268      write(*,'(A,I0,A,I0)') &
269        ">>> FAILED test -- FSUNLinSolInitialize returned ", failure, ", Proc ", myid
270      failure = 1
271    else if (myid == 0) then
272      write(*,*) "    PASSED test -- FSUNLinSolInitialize "
273    end if
274
275  end function Test_FSUNLinSolInitialize
276
277  integer(C_INT) function Test_FSUNLinSolSetup(S, A, myid) result(failure)
278    use, intrinsic :: iso_c_binding
279    use fsundials_matrix_mod
280    use fsundials_linearsolver_mod
281
282    implicit none
283
284    type(SUNLinearSolver) :: S
285    type(SUNMatrix)       :: A
286    integer(C_INT)        :: myid
287
288    failure = 0
289
290    failure = FSUNLinSolSetup(S, A)
291
292    if (failure /= 0) then
293      write(*,'(A,I0,A,I0)') &
294        ">>> FAILED test -- FSUNLinSolSetup returned ", failure, ", Proc ", myid
295      failure = 1
296    else if (myid == 0) then
297      write(*,*) "    PASSED test -- FSUNLinSolSetup "
298    end if
299
300  end function Test_FSUNLinSolSetup
301
302  ! ----------------------------------------------------------------------
303  ! FSUNLinSolSolve Test
304  !
305  ! This test must follow Test_FSUNLinSolSetup.  Also, x must be the
306  ! solution to the linear system A*x = b (for the original A matrix);
307  ! while the 'A' that is supplied to this function should have been
308  ! 'setup' by the Test_FSUNLinSolSetup() function prior to this call.
309  ! ----------------------------------------------------------------------
310  integer(C_INT) function Test_FSUNLinSolSolve(S, A, x, b, tol, myid) result(failure)
311    use, intrinsic :: iso_c_binding
312    use fsundials_nvector_mod
313    use fsundials_matrix_mod
314    use fsundials_linearsolver_mod
315
316    implicit none
317
318    type(SUNLinearSolver)   :: S
319    type(SUNMatrix)         :: A
320    type(N_Vector)          :: x, b
321    type(N_Vector), pointer :: y
322    real(C_DOUBLE)          :: tol
323    integer(C_INT)          :: myid
324
325    failure = 0
326
327    ! clone to create solution vector
328    y => FN_VClone(x)
329    call FN_VConst(ZERO, y)
330
331    ! perform solve
332    failure = FSUNLinSolSolve(S, A, y, b, tol)
333    if (failure /= 0) then
334      write(*,'(A,I0,A,I0)') &
335        ">>> FAILED test -- FSUNLinSolSolve returned ", failure, ", Proc ", myid
336      return
337    end if
338
339    ! Check solution, and copy y into x for return
340    failure = check_vector(x, y, 10.0d0*tol)
341    call FN_VScale(ONE, y, x)
342
343    if (failure /= 0) then
344      write(*,*) ">>> FAILED test -- FSUNLinSolSolve check, Proc ", myid
345    else if (myid == 0) then
346      write(*,*) "    PASSED test -- FSUNLinSolSolve"
347    end if
348
349    call FN_VDestroy(y)
350
351  end function Test_FSUNLinSolSolve
352
353end module
354