From 3c898676755613acfbadd3985072610c7acbc73c Mon Sep 17 00:00:00 2001 From: Slavko Brdar Date: Tue, 12 Sep 2023 12:13:03 +0200 Subject: [PATCH] add data access by array and index for MultiField plus a unit test for it --- src/atlas_f/CMakeLists.txt | 2 +- ...odule.F90 => atlas_MultiField_module.fypp} | 77 +++++++++++++++++++ src/tests/field/fctest_multifield_ifs.F90 | 19 +++-- 3 files changed, 92 insertions(+), 6 deletions(-) rename src/atlas_f/field/{atlas_MultiField_module.F90 => atlas_MultiField_module.fypp} (58%) diff --git a/src/atlas_f/CMakeLists.txt b/src/atlas_f/CMakeLists.txt index 181b26aeb..a065daad2 100644 --- a/src/atlas_f/CMakeLists.txt +++ b/src/atlas_f/CMakeLists.txt @@ -218,7 +218,7 @@ ecbuild_add_library( TARGET atlas_f field/atlas_FieldSet_module.fypp field/atlas_State_module.F90 field/atlas_Field_module.fypp - field/atlas_MultiField_module.F90 + field/atlas_MultiField_module.fypp grid/atlas_Grid_module.F90 grid/atlas_GridDistribution_module.F90 grid/atlas_Vertical_module.F90 diff --git a/src/atlas_f/field/atlas_MultiField_module.F90 b/src/atlas_f/field/atlas_MultiField_module.fypp similarity index 58% rename from src/atlas_f/field/atlas_MultiField_module.F90 rename to src/atlas_f/field/atlas_MultiField_module.fypp index 414b01b55..9c0e406b9 100644 --- a/src/atlas_f/field/atlas_MultiField_module.F90 +++ b/src/atlas_f/field/atlas_MultiField_module.fypp @@ -8,10 +8,14 @@ #include "atlas/atlas_f.h" +#:include "atlas/atlas_f.fypp" +#:include "internals/atlas_generics.fypp" + module atlas_multifield_module use fckit_owned_object_module, only : fckit_owned_object use atlas_Config_module, only: atlas_Config +use atlas_field_module, only: atlas_field, array_c_to_f use atlas_fieldset_module, only: atlas_fieldset implicit none @@ -50,11 +54,40 @@ module atlas_multifield_module final :: atlas_MultiField__final_auto #endif +#:for rank in ranks +#:for dtype in dtypes + procedure, private :: access_data_${dtype}$_r${rank}$_by_name + procedure, private :: access_data_${dtype}$_r${rank}$_by_idx +#:endfor +#:endfor + + generic, public :: data => & +#:for rank in ranks +#:for dtype in dtypes + & access_data_${dtype}$_r${rank}$_by_name, & + & access_data_${dtype}$_r${rank}$_by_idx, & +#:endfor +#:endfor + & dummy + + procedure, private :: dummy + END TYPE interface atlas_MultiField module procedure atlas_MultiField__cptr module procedure atlas_MultiField__create +!#:for dtype in integer_dtypes +! module procedure atlas_MultiField__create_name_kind_shape_${dtype}$ +! module procedure atlas_MultiField__create_kind_shape_${dtype}$ +!#:endfor + +!#:for rank in ranks +!#:for dtype in dtypes +! module procedure atlas_MultiField__wrap_${dtype}$_r${rank}$ +! module procedure atlas_MultiField__wrap_name_${dtype}$_r${rank}$ +!#:endfor +!#:endfor end interface private :: fckit_owned_object @@ -122,5 +155,49 @@ ATLAS_FINAL subroutine atlas_MultiField__final_auto(this) !------------------------------------------------------------------------------- +#:for rank in ranks +#:for dtype,ftype,ctype in types +subroutine access_data_${dtype}$_r${rank}$_by_name(this, name, field) + use fckit_c_interop_module, only: c_str + use atlas_fieldset_c_binding + use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_long, c_float, c_double + class(atlas_MultiField), intent(in) :: this + character(len=*), intent(in) :: name + ${ftype}$, pointer, intent(inout) :: field(${dim[rank]}$) + type(c_ptr) :: field_cptr + type(c_ptr) :: shape_cptr + type(c_ptr) :: strides_cptr + integer(c_int) :: rank + type(atlas_FieldSet) :: fset + fset = this%fieldset() + call atlas__FieldSet__data_${ctype}$_specf(fset%CPTR_PGIBUG_A, c_str(name), field_cptr, rank, shape_cptr, strides_cptr) + call array_c_to_f(field_cptr, rank, shape_cptr, strides_cptr, field) +end subroutine +subroutine access_data_${dtype}$_r${rank}$_by_idx(this, idx, field) + use fckit_c_interop_module, only: c_str + use atlas_fieldset_c_binding + use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_long, c_float, c_double + class(atlas_MultiField), intent(in) :: this + integer, intent(in) :: idx + ${ftype}$, pointer, intent(inout) :: field(${dim[rank]}$) + type(c_ptr) :: field_cptr + type(c_ptr) :: shape_cptr + type(c_ptr) :: strides_cptr + integer(c_int) :: rank + type(atlas_FieldSet) :: fset + fset = this%fieldset() + call atlas__FieldSet__data_${ctype}$_specf_by_idx(fset%CPTR_PGIBUG_A, idx-1, field_cptr, rank, shape_cptr, strides_cptr) + call array_c_to_f(field_cptr, rank, shape_cptr, strides_cptr, field) +end subroutine +!------------------------------------------------------------------------------- +#:endfor +#:endfor + +subroutine dummy(this) + use atlas_fieldset_c_binding + class(atlas_MultiField), intent(in) :: this + FCKIT_SUPPRESS_UNUSED(this) +end subroutine + end module atlas_multifield_module diff --git a/src/tests/field/fctest_multifield_ifs.F90 b/src/tests/field/fctest_multifield_ifs.F90 index a1aa4a691..8cbef1e26 100644 --- a/src/tests/field/fctest_multifield_ifs.F90 +++ b/src/tests/field/fctest_multifield_ifs.F90 @@ -46,7 +46,10 @@ module fcta_MultiField_fixture type(atlas_FieldSet) :: fieldset_1, fieldset_2 type(atlas_Field) :: field type(atlas_config) :: config - real(c_double), pointer :: view(:,:,:) + integer, pointer :: fdata_int_2d(:,:) + real(c_float), pointer :: fdata_real32_2d(:,:) + real(c_double), pointer :: fdata_real64_2d(:,:) + real(c_double), pointer :: fdata_real64(:,:,:) integer, parameter :: nvar = 5; integer, parameter :: nproma = 16; @@ -81,13 +84,19 @@ module fcta_MultiField_fixture fieldset_2 = atlas_FieldSet() call fieldset_2%add(multifield%fieldset()) field = fieldset_2%field("density") - call field%data(view) - view(1,1,1) = 2. + call field%data(fdata_real64) + fdata_real64(1,1,1) = 2. call field%rename("dens") + ! check data access directly though multifield + !call multifield%data("density", fdata_real64) + call multifield%data("dens", fdata_real64) + fdata_real64(1,1,1) = 3. + field = fieldset_1%field("dens") - call field%data(view) - FCTEST_CHECK_EQUAL(view(1,1,1), 2._c_double) + call field%data(fdata_real64) + FCTEST_CHECK_EQUAL(fdata_real64(1,1,1), 3._c_double) + END_TEST ! -----------------------------------------------------------------------------