1! ------------------------------------------------------------------ 2! Programmer(s): Daniel R. Reynolds @ SMU 3! ------------------------------------------------------------------ 4! SUNDIALS Copyright Start 5! Copyright (c) 2002-2021, Lawrence Livermore National Security 6! and Southern Methodist University. 7! All rights reserved. 8! 9! See the top-level LICENSE and NOTICE files for details. 10! 11! SPDX-License-Identifier: BSD-3-Clause 12! SUNDIALS Copyright End 13! ------------------------------------------------------------------ 14! Program to test custom fnvector_complex_mod implementation 15! ------------------------------------------------------------------ 16 17! ------------------------------------------------------------------ 18! Utility module for error-checking 19! ------------------------------------------------------------------ 20module fnvector_test_mod 21 use, intrinsic :: iso_c_binding 22 use fnvector_complex_mod 23 implicit none 24 25contains 26 integer(c_int) function check_ans(val, tol, N, sunvec_x) result(failure) 27 28 implicit none 29 complex(c_double_complex), value :: val 30 real(c_double), value :: tol 31 integer(c_long), value :: N 32 Type(N_Vector) :: sunvec_x 33 Type(FVec), pointer :: x 34 integer(c_long) :: i 35 36 x => FN_VGetFVec(sunvec_x) 37 failure = 0 38 do i = 1,N 39 if (abs(x%data(i) - val) > tol) failure = 1 40 end do 41 42 end function check_ans 43end module fnvector_test_mod 44 45! ------------------------------------------------------------------ 46program main 47 48 !======= Inclusions =========== 49 use, intrinsic :: iso_c_binding 50 use fnvector_complex_mod 51 use fnvector_test_mod 52 53 !======= Declarations ========= 54 implicit none 55 56 ! local variables 57 integer(c_int) :: fails, i, loc 58 integer(c_long), parameter :: N = 1000 59 type(N_Vector), pointer :: sU, sV, sW, sX, sY, sZ 60 type(FVec), pointer :: U, V, W, X, Y, Z 61 complex(c_double_complex) :: Udata(N) 62 real(c_double) :: fac 63 logical :: failure 64 65 66 !======= Internals ============ 67 68 ! initialize failure total 69 fails = 0 70 71 ! create new vectors, using New, Make and Clone routines 72 sU => FN_VMake_Complex(N, Udata) 73 if (.not. associated(sU)) then 74 print *, 'ERROR: sunvec = NULL' 75 stop 1 76 end if 77 U => FN_VGetFVec(sU) 78 79 sV => FN_VNew_Complex(N) 80 if (.not. associated(sV)) then 81 print *, 'ERROR: sunvec = NULL' 82 stop 1 83 end if 84 V => FN_VGetFVec(sV) 85 86 sW => FN_VNew_Complex(N) 87 if (.not. associated(sW)) then 88 print *, 'ERROR: sunvec = NULL' 89 stop 1 90 end if 91 W => FN_VGetFVec(sW) 92 93 sX => FN_VNew_Complex(N) 94 if (.not. associated(sX)) then 95 print *, 'ERROR: sunvec = NULL' 96 stop 1 97 end if 98 X => FN_VGetFVec(sX) 99 100 sY => FN_VNew_Complex(N) 101 if (.not. associated(sY)) then 102 print *, 'ERROR: sunvec = NULL' 103 stop 1 104 end if 105 Y => FN_VGetFVec(sY) 106 107 call c_f_pointer(FN_VClone_Complex(sU), sZ) 108 if (.not. associated(sZ)) then 109 print *, 'ERROR: sunvec = NULL' 110 stop 1 111 end if 112 Z => FN_VGetFVec(sZ) 113 114 115 ! check vector ID 116 if (FN_VGetVectorID(sU) /= SUNDIALS_NVEC_CUSTOM) then 117 fails = fails + 1 118 print *, '>>> FAILED test -- FN_VGetVectorID' 119 print *, ' Unrecognized vector type', FN_VGetVectorID(sU) 120 else 121 print *, 'PASSED test -- FN_VGetVectorID' 122 end if 123 124 125 ! check vector length 126 if (FN_VGetLength(sV) /= N) then 127 fails = fails + 1 128 print *, '>>> FAILED test -- FN_VGetLength' 129 print *, ' ', FN_VGetLength(sV), ' /= ', N 130 else 131 print *, 'PASSED test -- FN_VGetLength' 132 end if 133 134 ! test FN_VConst 135 Udata = 0.d0 136 call FN_VConst(1.d0, sU) 137 if (check_ans(dcmplx(1.d0, 0.d0), 1.d-14, N, sU) /= 0) then 138 fails = fails + 1 139 print *, '>>> FAILED test -- FN_VConst' 140 else 141 print *, 'PASSED test -- FN_VConst' 142 end if 143 144 ! test FN_VLinearSum 145 X%data = dcmplx(1.d0, -1.d0) 146 Y%data = dcmplx(-2.d0, 2.d0) 147 call FN_VLinearSum(1.d0, sX, 1.d0, sY, sY) 148 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sY) /= 0) then 149 fails = fails + 1 150 print *, '>>> FAILED test -- FN_VLinearSum Case 1a' 151 else 152 print *, 'PASSED test -- FN_VLinearSum Case 1a' 153 end if 154 155 X%data = dcmplx(1.d0, -1.d0) 156 Y%data = dcmplx(2.d0, -2.d0) 157 call FN_VLinearSum(-1.d0, sX, 1.d0, sY, sY) 158 if (check_ans(dcmplx(1.d0, -1.d0), 1.d-14, N, sY) /= 0) then 159 fails = fails + 1 160 print *, '>>> FAILED test -- FN_VLinearSum Case 1b' 161 else 162 print *, 'PASSED test -- FN_VLinearSum Case 1b' 163 end if 164 165 X%data = dcmplx(2.d0, -2.d0) 166 Y%data = dcmplx(-2.d0, 2.d0) 167 call FN_VLinearSum(0.5d0, sX, 1.d0, sY, sY) 168 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sY) /= 0) then 169 fails = fails + 1 170 print *, '>>> FAILED test -- FN_VLinearSum Case 1c' 171 else 172 print *, 'PASSED test -- FN_VLinearSum Case 1c' 173 end if 174 175 X%data = dcmplx(2.d0, -2.d0) 176 Y%data = dcmplx(-1.d0, 1.d0) 177 call FN_VLinearSum(1.d0, sX, 1.d0, sY, sX) 178 if (check_ans(dcmplx(1.d0, -1.d0), 1.d-14, N, sX) /= 0) then 179 fails = fails + 1 180 print *, '>>> FAILED test -- FN_VLinearSum Case 2a' 181 else 182 print *, 'PASSED test -- FN_VLinearSum Case 2a' 183 end if 184 185 X%data = dcmplx(1.d0, -1.d0) 186 Y%data = dcmplx(2.d0, -2.d0) 187 call FN_VLinearSum(1.d0, sX, -1.d0, sY, sX) 188 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sX) /= 0) then 189 fails = fails + 1 190 print *, '>>> FAILED test -- FN_VLinearSum Case 2b' 191 else 192 print *, 'PASSED test -- FN_VLinearSum Case 2b' 193 end if 194 195 X%data = dcmplx(2.d0, -2.d0) 196 Y%data = dcmplx(-0.5d0, 0.5d0) 197 call FN_VLinearSum(1.d0, sX, 2.d0, sY, sX) 198 if (check_ans(dcmplx(1.d0, -1.d0), 1.d-14, N, sX) /= 0) then 199 fails = fails + 1 200 print *, '>>> FAILED test -- FN_VLinearSum Case 2c' 201 else 202 print *, 'PASSED test -- FN_VLinearSum Case 2c' 203 end if 204 205 X%data = dcmplx(-2.d0, 2.d0) 206 Y%data = dcmplx(1.d0, -1.d0) 207 Z%data = dcmplx(0.d0, 0.d0) 208 call FN_VLinearSum(1.d0, sX, 1.d0, sY, sZ) 209 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sZ) /= 0) then 210 fails = fails + 1 211 print *, '>>> FAILED test -- FN_VLinearSum Case 3' 212 else 213 print *, 'PASSED test -- FN_VLinearSum Case 3' 214 end if 215 216 X%data = dcmplx(2.d0, -2.d0) 217 Y%data = dcmplx(1.d0, -1.d0) 218 Z%data = dcmplx(0.d0, 0.d0) 219 call FN_VLinearSum(1.d0, sX, -1.d0, sY, sZ) 220 if (check_ans(dcmplx(1.d0, -1.d0), 1.d-14, N, sZ) /= 0) then 221 fails = fails + 1 222 print *, '>>> FAILED test -- FN_VLinearSum Case 4a' 223 else 224 print *, 'PASSED test -- FN_VLinearSum Case 4a' 225 end if 226 227 X%data = dcmplx(2.d0, -2.d0) 228 Y%data = dcmplx(1.d0, -1.d0) 229 Z%data = dcmplx(0.d0, 0.d0) 230 call FN_VLinearSum(-1.d0, sX, 1.d0, sY, sZ) 231 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sZ) /= 0) then 232 fails = fails + 1 233 print *, '>>> FAILED test -- FN_VLinearSum Case 4b' 234 else 235 print *, 'PASSED test -- FN_VLinearSum Case 4b' 236 end if 237 238 X%data = dcmplx(2.d0, -2.d0) 239 Y%data = dcmplx(-0.5d0, 0.5d0) 240 Z%data = dcmplx(0.d0, 0.d0) 241 call FN_VLinearSum(1.d0, sX, 2.d0, sY, sZ) 242 if (check_ans(dcmplx(1.d0, -1.d0), 1.d-14, N, sZ) /= 0) then 243 fails = fails + 1 244 print *, '>>> FAILED test -- FN_VLinearSum Case 5a' 245 else 246 print *, 'PASSED test -- FN_VLinearSum Case 5a' 247 end if 248 249 X%data = dcmplx(0.5d0, -0.5d0) 250 Y%data = dcmplx(-2.d0, 2.d0) 251 Z%data = dcmplx(0.d0, 0.d0) 252 call FN_VLinearSum(2.d0, sX, 1.d0, sY, sZ) 253 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sZ) /= 0) then 254 fails = fails + 1 255 print *, '>>> FAILED test -- FN_VLinearSum Case 5b' 256 else 257 print *, 'PASSED test -- FN_VLinearSum Case 5b' 258 end if 259 260 X%data = dcmplx(-2.d0, 2.d0) 261 Y%data = dcmplx(-0.5d0, 0.5d0) 262 Z%data = dcmplx(0.d0, 0.d0) 263 call FN_VLinearSum(-1.d0, sX, 2.d0, sY, sZ) 264 if (check_ans(dcmplx(1.d0, -1.d0), 1.d-14, N, sZ) /= 0) then 265 fails = fails + 1 266 print *, '>>> FAILED test -- FN_VLinearSum Case 6a' 267 else 268 print *, 'PASSED test -- FN_VLinearSum Case 6a' 269 end if 270 271 X%data = dcmplx(0.5d0, -0.5d0) 272 Y%data = dcmplx(2.d0, -2.d0) 273 Z%data = dcmplx(0.d0, 0.d0) 274 call FN_VLinearSum(2.d0, sX, -1.d0, sY, sZ) 275 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sZ) /= 0) then 276 fails = fails + 1 277 print *, '>>> FAILED test -- FN_VLinearSum Case 6b' 278 else 279 print *, 'PASSED test -- FN_VLinearSum Case 6b' 280 end if 281 282 X%data = dcmplx(1.d0, -1.d0) 283 Y%data = dcmplx(-0.5d0, 0.5d0) 284 Z%data = dcmplx(0.d0, 0.d0) 285 call FN_VLinearSum(2.d0, sX, 2.d0, sY, sZ) 286 if (check_ans(dcmplx(1.d0, -1.d0), 1.d-14, N, sZ) /= 0) then 287 fails = fails + 1 288 print *, '>>> FAILED test -- FN_VLinearSum Case 7' 289 else 290 print *, 'PASSED test -- FN_VLinearSum Case 7' 291 end if 292 293 X%data = dcmplx(0.5d0, -0.5d0) 294 Y%data = dcmplx(1.d0, -1.d0) 295 Z%data = dcmplx(0.d0, 0.d0) 296 call FN_VLinearSum(2.d0, sX, -2.d0, sY, sZ) 297 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sZ) /= 0) then 298 fails = fails + 1 299 print *, '>>> FAILED test -- FN_VLinearSum Case 8' 300 else 301 print *, 'PASSED test -- FN_VLinearSum Case 8' 302 end if 303 304 X%data = dcmplx(1.d0, -1.d0) 305 Y%data = dcmplx(-2.d0, 2.d0) 306 Z%data = dcmplx(0.d0, 0.d0) 307 call FN_VLinearSum(2.d0, sX, 0.5d0, sY, sZ) 308 if (check_ans(dcmplx(1.d0, -1.d0), 1.d-14, N, sZ) /= 0) then 309 fails = fails + 1 310 print *, '>>> FAILED test -- FN_VLinearSum Case 9' 311 else 312 print *, 'PASSED test -- FN_VLinearSum Case 9' 313 end if 314 315 ! test FN_VProd 316 X%data = dcmplx(2.d0, 0.d0) 317 Y%data = dcmplx(-0.5d0, 0.0d0) 318 Z%data = dcmplx(0.d0, 0.d0) 319 call FN_VProd(sX, sY, sZ) 320 if (check_ans(dcmplx(-1.d0, 0.d0), 1.d-14, N, sZ) /= 0) then 321 fails = fails + 1 322 print *, '>>> FAILED test -- FN_VProd Case 1' 323 else 324 print *, 'PASSED test -- FN_VProd Case 1' 325 end if 326 327 X%data = dcmplx(0.d0, 0.5d0) 328 Y%data = dcmplx(-2.0d0, 0.0d0) 329 Z%data = dcmplx(0.d0, 0.d0) 330 call FN_VProd(sX, sY, sZ) 331 if (check_ans(dcmplx(0.d0, -1.d0), 1.d-14, N, sZ) /= 0) then 332 fails = fails + 1 333 print *, '>>> FAILED test -- FN_VProd Case 2' 334 else 335 print *, 'PASSED test -- FN_VProd Case 2' 336 end if 337 338 X%data = dcmplx(1.d0, 2.d0) 339 Y%data = dcmplx(1.0d0, -2.0d0) 340 Z%data = dcmplx(0.d0, 0.d0) 341 call FN_VProd(sX, sY, sZ) 342 if (check_ans(dcmplx(5.d0, 0.d0), 1.d-14, N, sZ) /= 0) then 343 fails = fails + 1 344 print *, '>>> FAILED test -- FN_VProd Case 3' 345 else 346 print *, 'PASSED test -- FN_VProd Case 3' 347 end if 348 349 ! test FN_VDiv 350 X%data = dcmplx(1.d0, 0.d0) 351 Y%data = dcmplx(2.d0, 0.d0) 352 Z%data = dcmplx(0.d0, 0.d0) 353 call FN_VDiv(sX, sY, sZ) 354 if (check_ans(dcmplx(0.5d0, 0.d0), 1.d-14, N, sZ) /= 0) then 355 fails = fails + 1 356 print *, '>>> FAILED test -- FN_VDiv Case 1' 357 else 358 print *, 'PASSED test -- FN_VDiv Case 1' 359 end if 360 361 X%data = dcmplx(0.d0, 1.d0) 362 Y%data = dcmplx(2.d0, 0.d0) 363 Z%data = dcmplx(0.d0, 0.d0) 364 call FN_VDiv(sX, sY, sZ) 365 if (check_ans(dcmplx(0.d0, 0.5d0), 1.d-14, N, sZ) /= 0) then 366 fails = fails + 1 367 print *, '>>> FAILED test -- FN_VDiv Case 2' 368 else 369 print *, 'PASSED test -- FN_VDiv Case 2' 370 end if 371 372 X%data = dcmplx(4.d0, 2.d0) 373 Y%data = dcmplx(1.d0, -1.d0) 374 Z%data = dcmplx(0.d0, 0.d0) 375 call FN_VDiv(sX, sY, sZ) 376 if (check_ans(dcmplx(1.d0, 3.d0), 1.d-14, N, sZ) /= 0) then 377 fails = fails + 1 378 print *, '>>> FAILED test -- FN_VDiv Case 3' 379 else 380 print *, 'PASSED test -- FN_VDiv Case 3' 381 end if 382 383 ! test FN_VScale 384 X%data = dcmplx(0.5d0, -0.5d0) 385 call FN_VScale(2.d0, sX, sX) 386 if (check_ans(dcmplx(1.d0, -1.d0), 1.d-14, N, sX) /= 0) then 387 fails = fails + 1 388 print *, '>>> FAILED test -- FN_VScale Case 1' 389 else 390 print *, 'PASSED test -- FN_VScale Case 1' 391 end if 392 393 X%data = dcmplx(-1.d0, 1.d0) 394 Z%data = dcmplx(0.d0, 0.d0) 395 call FN_VScale(1.d0, sX, sZ) 396 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sZ) /= 0) then 397 fails = fails + 1 398 print *, '>>> FAILED test -- FN_VScale Case 2' 399 else 400 print *, 'PASSED test -- FN_VScale Case 2' 401 end if 402 403 X%data = dcmplx(-1.d0, 1.d0) 404 Z%data = dcmplx(0.d0, 0.d0) 405 call FN_VScale(-1.d0, sX, sZ) 406 if (check_ans(dcmplx(1.d0, -1.d0), 1.d-14, N, sZ) /= 0) then 407 fails = fails + 1 408 print *, '>>> FAILED test -- FN_VScale Case 3' 409 else 410 print *, 'PASSED test -- FN_VScale Case 3' 411 end if 412 413 X%data = dcmplx(-0.5d0, 0.5d0) 414 Z%data = dcmplx(0.d0, 0.d0) 415 call FN_VScale(2.d0, sX, sZ) 416 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sZ) /= 0) then 417 fails = fails + 1 418 print *, '>>> FAILED test -- FN_VScale Case 4' 419 else 420 print *, 'PASSED test -- FN_VScale Case 4' 421 end if 422 423 ! test FN_VAbs 424 X%data = dcmplx(-1.d0, 0.d0) 425 Z%data = dcmplx(0.d0, 0.d0) 426 call FN_VAbs(sX, sZ) 427 if (check_ans(dcmplx(1.d0, 0.d0), 1.d-14, N, sZ) /= 0) then 428 fails = fails + 1 429 print *, '>>> FAILED test -- FN_VAbs Case 1' 430 else 431 print *, 'PASSED test -- FN_VAbs Case 1' 432 end if 433 434 X%data = dcmplx(1.d0, -0.d0) 435 Z%data = dcmplx(0.d0, 0.d0) 436 call FN_VAbs(sX, sZ) 437 if (check_ans(dcmplx(1.d0, 0.d0), 1.d-14, N, sZ) /= 0) then 438 fails = fails + 1 439 print *, '>>> FAILED test -- FN_VAbs Case 2' 440 else 441 print *, 'PASSED test -- FN_VAbs Case 2' 442 end if 443 444 X%data = dcmplx(3.d0, -4.d0) 445 Z%data = dcmplx(0.d0, 0.d0) 446 call FN_VAbs(sX, sZ) 447 if (check_ans(dcmplx(5.d0, 0.d0), 1.d-14, N, sZ) /= 0) then 448 fails = fails + 1 449 print *, '>>> FAILED test -- FN_VAbs Case 3' 450 else 451 print *, 'PASSED test -- FN_VAbs Case 3' 452 end if 453 454 ! test FN_VInv 455 X%data = dcmplx(2.d0, 0.d0) 456 Z%data = dcmplx(0.d0, 0.d0) 457 call FN_VInv(sX, sZ) 458 if (check_ans(dcmplx(0.5d0, 0.d0), 1.d-14, N, sZ) /= 0) then 459 fails = fails + 1 460 print *, '>>> FAILED test -- FN_VInv Case 1' 461 else 462 print *, 'PASSED test -- FN_VInv Case 1' 463 end if 464 465 X%data = dcmplx(0.d0, 1.d0) 466 Z%data = dcmplx(0.d0, 0.d0) 467 call FN_VInv(sX, sZ) 468 if (check_ans(dcmplx(0.d0, -1.d0), 1.d-14, N, sZ) /= 0) then 469 fails = fails + 1 470 print *, '>>> FAILED test -- FN_VInv Case 2' 471 else 472 print *, 'PASSED test -- FN_VInv Case 2' 473 end if 474 475 ! test FN_VAddConst 476 X%data = dcmplx(1.d0, 1.d0) 477 Z%data = dcmplx(0.d0, 0.d0) 478 call FN_VAddConst(sX, -2.d0, sZ) 479 if (check_ans(dcmplx(-1.d0, 1.d0), 1.d-14, N, sZ) /= 0) then 480 fails = fails + 1 481 print *, '>>> FAILED test -- FN_VAddConst' 482 else 483 print *, 'PASSED test -- FN_VAddConst' 484 end if 485 486 ! test FN_VMaxNorm 487 X%data = dcmplx(-0.5d0, 0.d0) 488 X%data(N) = dcmplx(0.d0, -2.d0) 489 if (dabs(FN_VMaxNorm(sX) - 2.d0) > 1.d-14) then 490 fails = fails + 1 491 print *, '>>> FAILED test -- FN_VMaxNorm (',FN_VMaxNorm(sX),' /= 2.d0)' 492 else 493 print *, 'PASSED test -- FN_VMaxNorm' 494 end if 495 496 ! test FN_VWrmsNorm 497 X%data = dcmplx(-0.5d0, 0.d0) 498 Y%data = dcmplx(0.5d0, 0.d0) 499 if (dabs(FN_VWrmsNorm(sX,sY) - 0.25d0) > 1.d-14) then 500 fails = fails + 1 501 print *, '>>> FAILED test -- FN_VWrmsNorm (',FN_VWrmsNorm(sX,sY),' /= 0.25d0)' 502 else 503 print *, 'PASSED test -- FN_VWrmsNorm' 504 end if 505 506 ! test FN_VWrmsNormMask 507 X%data = dcmplx(-0.5d0, 0.d0) 508 Y%data = dcmplx(0.5d0, 0.d0) 509 Z%data = dcmplx(1.d0, 0.d0) 510 Z%data(N) = dcmplx(0.d0, 0.d0) 511 fac = dsqrt(1.d0*(N - 1)/N)*0.25d0 512 if (dabs(FN_VWrmsNormMask(sX,sY,sZ) - fac) > 1.d-14) then 513 fails = fails + 1 514 print *, '>>> FAILED test -- FN_VWrmsNormMask (',FN_VWrmsNormMask(sX,sY,sZ),' /= ',fac,')' 515 else 516 print *, 'PASSED test -- FN_VWrmsNormMask' 517 end if 518 519 ! test FN_VMin 520 X%data = dcmplx(2.d0, 0.d0) 521 X%data(N) = dcmplx(-2.d0, -3.d0) 522 if (dabs(FN_VMin(sX) + 2.d0) > 1.d-14) then 523 fails = fails + 1 524 print *, '>>> FAILED test -- FN_VMin (',FN_VMin(sX),' /= -2.d0)' 525 else 526 print *, 'PASSED test -- FN_VMin' 527 end if 528 529 ! test FN_VWL2Norm 530 X%data = dcmplx(-0.5d0, 0.d0) 531 Y%data = dcmplx(0.5d0, 0.d0) 532 fac = dsqrt(1.d0*N)*0.25d0 533 if (dabs(FN_VWL2Norm(sX,sY) - fac) > 1.d-14) then 534 fails = fails + 1 535 print *, '>>> FAILED test -- FN_VWL2Norm (',FN_VWL2Norm(sX,sY),' /= ',fac,')' 536 else 537 print *, 'PASSED test -- FN_VWL2Norm' 538 end if 539 540 ! test FN_VL1Norm 541 X%data = dcmplx(0.d0, -1.d0) 542 fac = 1.d0*N 543 if (dabs(FN_VL1Norm(sX) - fac) > 1.d-14) then 544 fails = fails + 1 545 print *, '>>> FAILED test -- FN_VL1Norm (',FN_VL1Norm(sX),' /= ',fac,')' 546 else 547 print *, 'PASSED test -- FN_VL1Norm' 548 end if 549 550 ! test FN_VInvTest 551 X%data = dcmplx(0.5d0, 0.d0) 552 Z%data = dcmplx(0.d0, 0.d0) 553 failure = (FN_VInvTest(sX, sZ) == 0) 554 if ((check_ans(dcmplx(2.d0, 0.d0), 1.d-14, N, sZ) /= 0) .or. failure) then 555 fails = fails + 1 556 print *, '>>> FAILED test -- FN_VInvTest Case 1' 557 else 558 print *, 'PASSED test -- FN_VInvTest Case 1' 559 end if 560 561 failure = .false. 562 Z%data = dcmplx(0.d0, 0.d0) 563 do i = 1,N 564 loc = mod(i-1, 2) 565 if (loc == 0) X%data(i) = dcmplx(0.d0, 0.d0) 566 if (loc == 1) X%data(i) = dcmplx(0.5d0, 0.d0) 567 end do 568 if (FN_VInvTest(sX, sZ) == 1) failure = .true. 569 do i = 1,N 570 loc = mod(i-1, 2) 571 if ((loc == 0) .and. (Z%data(i) /= dcmplx(0.d0, 0.d0))) failure = .true. 572 if ((loc == 1) .and. (Z%data(i) /= dcmplx(2.d0, 0.d0))) failure = .true. 573 end do 574 if (failure) then 575 fails = fails + 1 576 print *, '>>> FAILED test -- FN_VInvTest Case 2' 577 else 578 print *, 'PASSED test -- FN_VInvTest Case 2' 579 end if 580 581 ! test FN_VWSqrSumLocal 582 X%data = dcmplx(-1.d0, 0.d0) 583 Y%data = dcmplx(0.5d0, 0.d0) 584 fac = 0.25d0*N 585 if (dabs(FN_VWSqrSumLocal(sX,sY) - fac) > 1.d-14) then 586 fails = fails + 1 587 print *, '>>> FAILED test -- FN_VWSqrSumLocal (',FN_VWSqrSumLocal(sX,sY),' /= ',fac,')' 588 else 589 print *, 'PASSED test -- FN_VWSqrSumLocal' 590 end if 591 592 593 ! test FN_VWSqrSumMaskLocal 594 X%data = dcmplx(-1.d0, 0.d0) 595 Y%data = dcmplx(0.5d0, 0.d0) 596 Z%data = dcmplx(1.d0, 0.d0) 597 Z%data(N) = dcmplx(0.d0, 0.d0) 598 fac = 0.25d0*(N-1) 599 if (dabs(FN_VWSqrSumMaskLocal(sX,sY,sZ) - fac) > 1.d-14) then 600 fails = fails + 1 601 print *, '>>> FAILED test -- FN_VWSqrSumMaskLocal (',FN_VWSqrSumMaskLocal(sX,sY,sZ),' /= ',fac,')' 602 else 603 print *, 'PASSED test -- FN_VWSqrSumMaskLocal' 604 end if 605 606 ! free vectors 607 call FN_VDestroy(sU) 608 call FN_VDestroy(sV) 609 call FN_VDestroy(sW) 610 call FN_VDestroy(sX) 611 call FN_VDestroy(sY) 612 call FN_VDestroy(sZ) 613 614 ! print results 615 if (fails > 0) then 616 print '(a,i3,a)', 'FAIL: FNVector module failed ',fails,' tests' 617 stop 1 618 else 619 print *, 'SUCCESS: FNVector module passed all tests' 620 end if 621 print *, ' ' 622 623end program main 624