1! -----------------------------------------------------------------
2! Programmer(s): Cody J. Balos @ LLNL
3! -----------------------------------------------------------------
4! Acknowledgements: These testing routines are based on
5! test_nvector.c written by David Gardner and Slaven Peles @ LLNL.
6! -----------------------------------------------------------------
7! SUNDIALS Copyright Start
8! Copyright (c) 2002-2020, Lawrence Livermore National Security
9! and Southern Methodist University.
10! All rights reserved.
11!
12! See the top-level LICENSE and NOTICE files for details.
13!
14! SPDX-License-Identifier: BSD-3-Clause
15! SUNDIALS Copyright End
16! -----------------------------------------------------------------
17! These test functions are designed to check the fortran interface
18! to an NVECTOR module implementation. It does not test every
19! function. It tests the N_VMake constructor, one standard vector
20! operation (N_VConst), N_VGetArrayPointer, and one fused operation.
21! -----------------------------------------------------------------
22
23module test_fnvector
24  use, intrinsic :: iso_c_binding
25  use fsundials_nvector_mod
26  use fsundials_types_mod
27  use test_utilities
28  implicit none
29
30  integer(C_INT), external :: check_ans
31  logical, external        :: has_data
32
33contains
34
35
36integer(C_INT) function Test_FN_VMake(X, local_length, myid) &
37    result(failure)
38  implicit none
39
40  type(N_Vector)  :: X
41  integer(C_LONG) :: local_length
42  integer(C_INT)  :: myid
43
44  if (.not. has_data(X)) then
45    print *, '(I4)', '>>> FAILED test -- FN_VMake, Proc ', myid
46    print *, '    vector data is not associated'
47    failure = 1
48    return
49  end if
50
51  if (myid == 0) then
52    print *, 'PASSED test -- FN_VMake'
53  end if
54
55  failure = 0
56end function Test_FN_VMake
57
58
59!! ----------------------------------------------------------------------
60!! NOTE: This routine depends on FN_VConst to check vector data.
61!! ----------------------------------------------------------------------
62integer(C_INT) function Test_FN_VGetArrayPointer(W, local_length, myid) &
63    result(failure)
64  implicit none
65
66  type(N_Vector)  :: W
67  integer(C_LONG) :: local_length
68  integer(C_INT)  :: myid
69
70  ! check vector data
71  if (.not. has_data(W)) then
72    print *, '>>> FAILED test -- FN_VGetArrayPointer, Proc ', myid
73    print *, '    Vector data == NULL \n\n'
74    failure = 1
75    return;
76  end if
77
78  call FN_VConst(NEG_HALF, W)
79  failure = check_ans(NEG_HALF, W, local_length)
80
81  if (failure > 0) then
82    print *, '(I2)', '>>> FAILED test -- FN_VGetArrayPointer, Proc ', myid
83    print *, '    Failed FN_VConst check \n\n'
84    failure = 1
85    return
86  end if
87
88  if (myid == 0) then
89    print *, 'PASSED test -- FN_VConst'
90    print *, 'PASSED test -- FN_VGetArrayPointer'
91  end if
92
93  failure = 0
94end function Test_FN_VGetArrayPointer
95
96
97integer(C_INT) function Test_FN_VLinearCombination(X, local_length, myid) &
98    result(failure)
99
100  type(N_Vector)          :: X
101  integer(C_LONG)         :: local_length
102  integer(C_INT)          :: myid, ierr
103  type(N_Vector), pointer :: Y1, Y2, Y3
104  type(c_ptr), target     :: V(3)
105  type(c_ptr)             :: Vptr
106  real(C_DOUBLE)          :: c(3)
107
108  failure = 0
109
110  ! create vectors for testing
111  Y1 => FN_VClone(X)
112  Y2 => FN_VClone(X)
113  Y3 => FN_VClone(X)
114
115  ! set vectors in vector array
116  V = (/c_loc(Y1), c_loc(Y2), c_loc(Y3)/)
117  Vptr = c_loc(V)
118
119  ! initialize c values
120  c = ZERO
121
122  !
123  ! Case 1a: V[0] = a V[0], FN_VScale
124  !
125
126  ! fill vector data
127  call FN_VConst(TWO, Y1)
128
129  ! set scaling factors
130  c =  HALF
131
132  ierr = FN_VLinearCombination(1, c, Vptr, Y1)
133
134  ! Y1 should be vector of +1
135  if (ierr == 0) then
136    failure = check_ans(ONE, Y1, local_length)
137  else
138    failure = 1
139  end if
140
141  if (failure > 0) then
142    print *, '(I4)', '>>> FAILED test -- FN_VLinearCombination Case 1a, Proc ', myid
143  else if (myid == 0) then
144    print *, 'PASSED test -- FN_VLinearCombination Case 1a'
145  end if
146
147  !
148  ! Case 3a: V[0] = V[0] + b V[1] + c V[2]
149  !
150
151  call FN_VConst(TWO, Y1)
152  call FN_VConst(NEG_TWO, Y2)
153  call FN_VConst(NEG_ONE, Y3)
154
155  c(1) = ONE
156  c(2) = HALF
157  c(3) = NEG_TWO
158
159  ierr = FN_VLinearCombination(3, c, Vptr, Y1)
160
161  ! Y1 should be vector of +3
162  if (ierr == 0) then
163    failure = check_ans(TWO+ONE, Y1, local_length)
164  else
165    failure = 1
166  end if
167
168  if (failure > 0) then
169    print *, '(I4)', '>>> FAILED test -- FN_VLinearCombination Case 3a, Proc ', myid
170  else if (myid == 0) then
171    print *, 'PASSED test -- FN_VLinearCombination Case 3a'
172  end if
173
174  ! Free vectors
175  call FN_VDestroy(Y1);
176  call FN_VDestroy(Y2);
177  call FN_VDestroy(Y3);
178
179end function Test_FN_VLinearCombination
180
181end module
182