1! Copyright (c) 2017-2021, Lawrence Livermore National Security, LLC and
2! other Axom Project Developers. See the top-level LICENSE file for details.
3!
4! SPDX-License-Identifier: (BSD-3-Clause)
5
6!
7! Test allocatable arrays as meta-buffers
8!
9
10module sidre_allocatable_test
11  use iso_c_binding
12  use fruit
13  use axom_sidre
14  implicit none
15
16contains
17
18! Allocate array via Fortran
19! Register with datastore then
20! Query metadata using datastore API.
21!----------------------------------------------------------------------
22
23  subroutine external_allocatable_int
24    integer, allocatable :: iarray(:)
25    integer, pointer :: ipointer(:)
26
27    type(SidreDataStore) ds
28    type(SidreGroup) root
29    type(SidreView)  view
30    integer type
31    integer num_elements
32    integer i
33    integer rank
34    integer(SIDRE_IndexType) extents(7)
35
36    call set_case_name("external_allocatable_int")
37
38    ds = SidreDataStore()
39    root = ds%get_root()
40
41    allocate(iarray(10))
42
43    do i=1,10
44       iarray(i) = i
45    enddo
46
47    view = root%create_array_view("iarray", iarray)
48
49    call assert_true(view%is_external())
50
51    type = view%get_type_id()
52    call assert_equals(type, SIDRE_INT_ID)
53
54    num_elements = view%get_num_elements()
55    call assert_equals(num_elements, size(iarray))
56
57    rank = view%get_num_dimensions()
58    call assert_equals(rank, 1)
59
60    rank = view%get_shape(7, extents)
61    call assert_equals(rank, 1)
62    call assert_true(extents(1) == size(iarray, 1))
63
64    ! get array via a pointer
65    call view%get_data(ipointer)
66    call assert_true(all(iarray.eq.ipointer))
67
68    call ds%delete()
69
70    deallocate(iarray)
71
72  end subroutine external_allocatable_int
73
74!----------------------------------------------------------------------
75
76  subroutine external_allocatable_int_3d
77    integer, allocatable :: iarray(:,:,:)
78    integer, pointer :: ipointer(:,:,:)
79
80    type(SidreDataStore) ds
81    type(SidreGroup) root
82    type(SidreView)  view
83    integer type
84    integer num_elements
85    integer i, j, k
86    integer rank
87    integer(SIDRE_IndexType) extents(7)
88
89    call set_case_name("external_allocatable_int_3d")
90
91    ds = SidreDataStore()
92    root = ds%get_root()
93
94    allocate(iarray(2,3,4))
95
96    do i=1,2
97       do j=1,3
98          do k=1,4
99             iarray(i,j,k) = i*100 + j*1-0 + k
100          enddo
101       enddo
102    enddo
103
104    view = root%create_array_view("iarray", iarray)
105
106    call assert_true(view%is_external())
107
108    type = view%get_type_id()
109    call assert_equals(type, SIDRE_INT_ID)
110
111    num_elements = view%get_num_elements()
112    call assert_equals(num_elements, size(iarray))
113
114    rank = view%get_num_dimensions()
115    call assert_equals(rank, 3)
116
117    rank = view%get_shape(7, extents)
118    call assert_equals(rank, 3)
119    call assert_true(extents(1) == size(iarray, 1))
120    call assert_true(extents(2) == size(iarray, 2))
121    call assert_true(extents(3) == size(iarray, 3))
122
123    ! get array via a pointer
124    call view%get_data(ipointer)
125    call assert_true(all(iarray.eq.ipointer))
126
127    call ds%delete()
128
129    deallocate(iarray)
130
131  end subroutine external_allocatable_int_3d
132
133!----------------------------------------------------------------------
134!
135! register a static (non-allocatable) array with the datastore as external view
136
137  subroutine external_static_int
138    integer :: iarray(10)
139    integer, pointer :: ipointer(:)
140
141    type(SidreDataStore) ds
142    type(SidreGroup) root
143    type(SidreView)  view
144    integer type
145    integer num_elements
146    integer i
147
148    call set_case_name("external_static_int")
149
150    ds = SidreDataStore()
151    root = ds%get_root()
152
153    do i=1,10
154       iarray(i) = i
155    enddo
156
157    view = root%create_array_view("iarray", iarray)
158
159    type = view%get_type_id()
160    call assert_equals(type, SIDRE_INT_ID)
161
162    num_elements = view%get_num_elements()
163    call assert_equals(num_elements, 10)
164
165    ! get array via a pointer
166    call view%get_data(ipointer)
167    call assert_true(all(iarray.eq.ipointer))
168
169    call ds%delete()
170
171  end subroutine external_static_int
172
173!----------------------------------------------------------------------
174!--- check other types
175
176  subroutine external_allocatable_double
177    real(C_DOUBLE), allocatable :: darray(:)
178    real(C_DOUBLE), pointer :: dpointer(:)
179
180    type(SidreDataStore) ds
181    type(SidreGroup) root
182    type(SidreView)  view
183    integer num_elements
184    integer type
185    integer i
186
187    call set_case_name("external_allocatable_double")
188
189    ds = SidreDataStore()
190    root = ds%get_root()
191
192    allocate(darray(10))
193
194    do i=1,10
195       darray(i) = i + 0.5d0
196    enddo
197
198    view = root%create_array_view("darray", darray)
199
200    type = view%get_type_id()
201    call assert_equals(type, SIDRE_DOUBLE_ID)
202
203    num_elements = view%get_num_elements()
204    call assert_equals(num_elements, 10)
205
206    ! get array via a pointer
207    call view%get_data(dpointer)
208    call assert_true(all(abs(darray-dpointer).lt..0005))
209
210    call ds%delete()
211
212    deallocate(darray)
213
214  end subroutine external_allocatable_double
215
216!----------------------------------------------------------------------
217!----------------------------------------------------------------------
218! Datastore owns a multi-dimension array.
219
220  subroutine datastore_int_3d
221    integer, pointer :: ipointer(:,:,:)
222
223    type(SidreDataStore) ds
224    type(SidreGroup) root
225    type(SidreView)  view
226    integer type
227    integer num_elements
228    integer i, j, k
229    integer rank
230    integer(SIDRE_IndexType) extents_in(3), extents(7)
231
232    call set_case_name("datastore_int_3d")
233
234    extents_in(1) = 2
235    extents_in(2) = 3
236    extents_in(3) = 4
237
238    ds = SidreDataStore()
239    root = ds%get_root()
240
241    view = root%create_view_and_allocate("iarray", SIDRE_INT_ID, 3, extents_in)
242
243    call view%get_data(ipointer)
244
245    type = view%get_type_id()
246    call assert_equals(type, SIDRE_INT_ID)
247
248    num_elements = view%get_num_elements()
249    call assert_equals(num_elements, size(ipointer))
250
251    rank = view%get_num_dimensions()
252    call assert_equals(rank, 3)
253
254    rank = view%get_shape(7, extents)
255    call assert_equals(rank, 3)
256    call assert_true(extents(1) == size(ipointer, 1))
257    call assert_true(extents(2) == size(ipointer, 2))
258    call assert_true(extents(3) == size(ipointer, 3))
259
260    ! reshape as 1-d using shape
261    extents_in(1) = size(ipointer)
262    call view%apply(SIDRE_INT_ID, 1, extents_in(1:1))
263    num_elements = view%get_num_elements()
264    call assert_equals(num_elements, size(ipointer))
265
266    ! reshape as 1-d using length
267    call view%apply(SIDRE_INT_ID, extents_in(1))
268    num_elements = view%get_num_elements()
269    call assert_equals(num_elements, size(ipointer))
270
271    call ds%delete()
272
273  end subroutine datastore_int_3d
274
275!----------------------------------------------------------------------
276!----------------------------------------------------------------------
277
278end module sidre_allocatable_test
279
280
281program fortran_test
282  use fruit
283  use sidre_allocatable_test
284  implicit none
285  logical ok
286
287  call init_fruit
288
289  call external_allocatable_int
290  call external_allocatable_int_3d
291  call external_static_int
292  call external_allocatable_double
293  call datastore_int_3d
294
295  call fruit_summary
296  call fruit_finalize
297
298  call is_all_successful(ok)
299  if (.not. ok) then
300     call exit(1)
301  endif
302end program fortran_test
303