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