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