diff --git a/src/atlas/CMakeLists.txt b/src/atlas/CMakeLists.txt index 3655519be..6e0d3d01b 100644 --- a/src/atlas/CMakeLists.txt +++ b/src/atlas/CMakeLists.txt @@ -693,6 +693,8 @@ linalg/dense/MatrixMultiply_EckitLinalg.cc list (APPEND atlas_redistribution_srcs redistribution/Redistribution.h redistribution/Redistribution.cc +redistribution/detail/RedistributionInterface.h +redistribution/detail/RedistributionInterface.cc redistribution/detail/RedistributionImpl.h redistribution/detail/RedistributionImpl.cc redistribution/detail/RedistributionImplFactory.h diff --git a/src/atlas/redistribution/detail/RedistributionInterface.cc b/src/atlas/redistribution/detail/RedistributionInterface.cc new file mode 100644 index 000000000..6f461967f --- /dev/null +++ b/src/atlas/redistribution/detail/RedistributionInterface.cc @@ -0,0 +1,66 @@ +/* + * (C) Copyright 2013 ECMWF. + * + * This software is licensed under the terms of the Apache Licence Version 2.0 + * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. + * In applying this licence, ECMWF does not waive the privileges and immunities + * granted to it by virtue of its status as an intergovernmental organisation + * nor does it submit to any jurisdiction. + */ + +#include + +#include "RedistributionInterface.h" + +#include "RedistributeGeneric.h" +#include "RedistributionImpl.h" + +#include "atlas/functionspace/FunctionSpace.h" +#include "atlas/redistribution/detail/RedistributionImplFactory.h" + +namespace atlas { +namespace redistribution { + +// ---------------------------------------------------------------------------- +// Fortran interfaces +// ---------------------------------------------------------------------------- + +extern "C" { + +detail::RedistributionImpl* atlas__Redistribution__new__config( + const functionspace::FunctionSpaceImpl* fspace1, const functionspace::FunctionSpaceImpl* fspace2, + const eckit::Configuration* config) { + ATLAS_ASSERT(config != nullptr); + std::string type = detail::RedistributeGeneric::static_type(); + config->get("type", type); + auto redist = redistribution::detail::RedistributionImplFactory::build(type); + FunctionSpace fs1(fspace1); + FunctionSpace fs2(fspace2); + redist->setup(fs1, fs2); + return redist; +} + +void atlas__Redistribution__execute( + const detail::RedistributionImpl* This, const field::FieldImpl* field_1, field::FieldImpl* field_2) { + Field f1(field_1); + Field f2(field_2); + This->execute(f1, f2); +} + +const functionspace::FunctionSpaceImpl* atlas__Redistribution__source( + const detail::RedistributionImpl* This) { + return This->source().get(); +} + +const functionspace::FunctionSpaceImpl* atlas__Redistribution__target( + const detail::RedistributionImpl* This) { + return This->target().get(); +} + +} + + +// ---------------------------------------------------------------------------- + +} // namespace redistribution +} // namespace atlas diff --git a/src/atlas/redistribution/detail/RedistributionInterface.h b/src/atlas/redistribution/detail/RedistributionInterface.h new file mode 100644 index 000000000..2d6cb3bd8 --- /dev/null +++ b/src/atlas/redistribution/detail/RedistributionInterface.h @@ -0,0 +1,52 @@ +/* + * (C) Copyright 2013 ECMWF. + * + * This software is licensed under the terms of the Apache Licence Version 2.0 + * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. + * In applying this licence, ECMWF does not waive the privileges and immunities + * granted to it by virtue of its status as an intergovernmental organisation + * nor does it submit to any jurisdiction. + */ +#pragma once + +namespace eckit { +class Configuration; +} + +namespace atlas { +namespace functionspace { +class FunctionSpaceImpl; +} +namespace field { +class FieldImpl; +} +} // namespace atlas + +namespace atlas { +namespace redistribution { +namespace detail { +class RedistributionImpl; + +// ------------------------------------------------------------------- +// C wrapper interfaces to C++ routines +extern "C" { + +RedistributionImpl* atlas__Redistribution__new__config( + const functionspace::FunctionSpaceImpl* fspace1, const functionspace::FunctionSpaceImpl* fspace2, + const eckit::Configuration* config); + +void atlas__Redistribution__execute( + const RedistributionImpl* This, const field::FieldImpl* field_1, field::FieldImpl* field_2); + +const functionspace::FunctionSpaceImpl* atlas__Redistribution__source( + const RedistributionImpl* This); + +const functionspace::FunctionSpaceImpl* atlas__Redistribution__target( + const RedistributionImpl* This); + +} + + +} // namespace detail +} // namespace redistribution +} // namespace atlas diff --git a/src/atlas_f/CMakeLists.txt b/src/atlas_f/CMakeLists.txt index 7075be1bb..a59e7f9c2 100644 --- a/src/atlas_f/CMakeLists.txt +++ b/src/atlas_f/CMakeLists.txt @@ -130,6 +130,9 @@ generate_fortran_bindings(FORTRAN_BINDINGS ../atlas/functionspace/EdgeColumns.h generate_fortran_bindings(FORTRAN_BINDINGS ../atlas/functionspace/detail/PointCloudInterface.h MODULE atlas_functionspace_PointCloud_c_binding OUTPUT functionspace_PointCloud_c_binding.f90) +generate_fortran_bindings(FORTRAN_BINDINGS ../atlas/redistribution/detail/RedistributionInterface.h + MODULE atlas_redistribution_c_binding + OUTPUT redistribution_c_binding.f90) if( atlas_HAVE_ATLAS_NUMERICS ) generate_fortran_bindings(FORTRAN_BINDINGS ../atlas/numerics/Nabla.h) @@ -237,6 +240,7 @@ ecbuild_add_library( TARGET atlas_f parallel/atlas_Checksum_module.fypp parallel/atlas_HaloExchange_module.fypp projection/atlas_Projection_module.F90 + redistribution/atlas_Redistribution_module.F90 internals/atlas_read_file.h internals/atlas_read_file.cc internals/Library.h diff --git a/src/atlas_f/redistribution/atlas_Redistribution_module.F90 b/src/atlas_f/redistribution/atlas_Redistribution_module.F90 new file mode 100644 index 000000000..1461e4c76 --- /dev/null +++ b/src/atlas_f/redistribution/atlas_Redistribution_module.F90 @@ -0,0 +1,136 @@ +! (C) Copyright 2013 ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation nor +! does it submit to any jurisdiction. + +#include "atlas/atlas_f.h" + +module atlas_Redistribution_module + +use, intrinsic :: iso_c_binding, only : c_ptr +use atlas_config_module, only : atlas_Config +use atlas_functionspace_module, only : atlas_FunctionSpace +use fckit_owned_object_module, only: fckit_owned_object + +implicit none + +public :: atlas_Redistribution + +private + +!------------------------------------------------------------------------------ +TYPE, extends(fckit_owned_object) :: atlas_Redistribution + +! Purpose : +! ------- +! *atlas_Redistribution* : Object passed from atlas to inspect redistribution + +! Methods : +! ------- + +! Author : +! ------ +! October-2023 Slavko Brdar *ECMWF* +! August-2015 Willem Deconinck *ECMWF* + +!------------------------------------------------------------------------------ +contains + + procedure, public :: execute => atlas_Redistribution__execute + procedure, public :: source => atlas_Redistribution__source + procedure, public :: target => atlas_Redistribution__target + +#if FCKIT_FINAL_NOT_INHERITING + final :: atlas_Redistribution__final_auto +#endif +END TYPE atlas_Redistribution + +!------------------------------------------------------------------------------ + +interface atlas_Redistribution + module procedure ctor_cptr + module procedure ctor_create +end interface + +private :: c_ptr +private :: fckit_owned_object + +!======================================================== +contains +!======================================================== +! ----------------------------------------------------------------------------- +! Redistribution routines + +function empty_config() result(config) + type(atlas_Config) :: config + config = atlas_Config() + call config%return() +end function + +function ctor_cptr( cptr ) result(this) + use atlas_redistribution_c_binding + type(atlas_Redistribution) :: this + type(c_ptr), intent(in) :: cptr + call this%reset_c_ptr( cptr ) + call this%return() +end function + +function ctor_create(fspace1, fspace2, redist_name) result(this) + use atlas_redistribution_c_binding + class(atlas_FunctionSpace), intent(in) :: fspace1, fspace2 + character(len=*), intent(in), optional :: redist_name + type(atlas_Redistribution) :: this + type(atlas_Config) :: config + config = empty_config() + if (present(redist_name)) call config%set("type", redist_name) + call this%reset_c_ptr( atlas__Redistribution__new__config(fspace1%CPTR_PGIBUG_A, fspace2%CPTR_PGIBUG_A, config%CPTR_PGIBUG_B) ) + call config%final() + call this%return() +end function + +subroutine atlas_Redistribution__execute(this, field_1, field_2) + use atlas_redistribution_c_binding + use atlas_Field_module + class(atlas_Redistribution), intent(in) :: this + class(atlas_Field), intent(in) :: field_1 + class(atlas_Field), intent(inout) :: field_2 + call atlas__Redistribution__execute(this%CPTR_PGIBUG_A, field_1%CPTR_PGIBUG_A, field_2%CPTR_PGIBUG_A) +end subroutine + +function atlas_Redistribution__source(this) result(fspace) + use atlas_redistribution_c_binding + class(atlas_Redistribution), intent(in) :: this + type(atlas_FunctionSpace) :: fspace + call fspace%reset_c_ptr(atlas__Redistribution__source(this%CPTR_PGIBUG_A)) + call fspace%return() +end function + +function atlas_Redistribution__target(this) result(fspace) + use atlas_redistribution_c_binding + class(atlas_Redistribution), intent(in) :: this + type(atlas_FunctionSpace) :: fspace + call fspace%reset_c_ptr(atlas__Redistribution__target(this%CPTR_PGIBUG_A)) + call fspace%return() +end function + +! ---------------------------------------------------------------------------------------- + +#if FCKIT_FINAL_NOT_INHERITING +ATLAS_FINAL subroutine atlas_Redistribution__final_auto(this) + type(atlas_Redistribution), intent(inout) :: this +#if FCKIT_FINAL_DEBUGGING + write(0,*) "atlas_Redistribution__final_auto" +#endif +#if FCKIT_FINAL_NOT_PROPAGATING + call this%final() +#endif + FCKIT_SUPPRESS_UNUSED( this ) +end subroutine +#endif + +! ---------------------------------------------------------------------------------------- + +end module atlas_Redistribution_module diff --git a/src/tests/redistribution/CMakeLists.txt b/src/tests/redistribution/CMakeLists.txt index 0a3a5a836..904fcadcd 100644 --- a/src/tests/redistribution/CMakeLists.txt +++ b/src/tests/redistribution/CMakeLists.txt @@ -7,6 +7,17 @@ if( atlas_HAVE_ATLAS_FUNCTIONSPACE ) +if( HAVE_FORTRAN ) + add_fctest( TARGET atlas_fctest_redistribution + MPI 4 + CONDITION eckit_HAVE_MPI + LINKER_LANGUAGE Fortran + SOURCES fctest_redistribution.F90 + LIBS atlas_f + ENVIRONMENT ${ATLAS_TEST_ENVIRONMENT} + ) +endif() + ecbuild_add_test( TARGET atlas_test_redistribution_structured SOURCES test_redistribution_structured.cc MPI 8 diff --git a/src/tests/redistribution/fctest_redistribution.F90 b/src/tests/redistribution/fctest_redistribution.F90 new file mode 100644 index 000000000..a023f3e8e --- /dev/null +++ b/src/tests/redistribution/fctest_redistribution.F90 @@ -0,0 +1,132 @@ +! (C) Copyright 2013 ECMWF. +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation nor +! does it submit to any jurisdiction. + +! This File contains Unit Tests for testing the +! C++ / Fortran Interfaces to the State Datastructure +! +! @author Willem Deconinck +! @author Slavko Brdar + +#include "fckit/fctest.h" + +! ----------------------------------------------------------------------------- + +module fcta_Redistribution_fxt +use atlas_module +use, intrinsic :: iso_c_binding +implicit none +character(len=1024) :: msg + +contains + +function do_redistribute(fspace_1, fspace_2) result(field_2) +use atlas_module +use atlas_redistribution_module + +implicit none + +type(atlas_FunctionSpace), intent(in) :: fspace_1, fspace_2 +type(atlas_Field) :: field_2 + +type(atlas_FunctionSpace) :: fspace_hlp +type(atlas_Redistribution) :: redist, redist_hlp +type(atlas_Field) :: field_1 !, field_2 +real(c_float), pointer :: field_1v(:), field_2v(:) + +redist = atlas_Redistribution(fspace_1, fspace_2) + +field_1 = fspace_1%create_field(atlas_real(c_float)) +field_2 = fspace_2%create_field(atlas_real(c_float)) +call field_1%data(field_1v) +field_1v = 1._c_float +call field_2%data(field_2v) +field_2v = 2._c_float + +call redist%execute(field_1, field_2) + +call field_2%data(field_2v) +call field_2%halo_exchange() + +! check access to source and target function spaces +redist_hlp = atlas_Redistribution(redist%c_ptr()) +fspace_hlp = redist%source() +fspace_hlp = redist%target() + +call field_1%final() +call redist_hlp%final() +call redist%final() +end function do_redistribute + +end module + +! ----------------------------------------------------------------------------- + +TESTSUITE(fcta_Redistribution) +!TESTSUITE_WITH_FIXTURE(fcta_Redistribution,fcta_Redistribution_fxt) + +! ----------------------------------------------------------------------------- + +TESTSUITE_INIT + use atlas_module + call atlas_library%initialise() +END_TESTSUITE_INIT + +! ----------------------------------------------------------------------------- + +TESTSUITE_FINALIZE + use atlas_module + call atlas_library%finalise() +END_TESTSUITE_FINALIZE + +! ----------------------------------------------------------------------------- + +TEST( test_redistribution ) +use atlas_module +use fcta_Redistribution_fxt +use atlas_redistribution_module + +implicit none + +type(atlas_Grid) :: grid +type(atlas_Mesh) :: mesh +type(atlas_MeshGenerator) :: meshgenerator +type(atlas_FunctionSpace) :: fspace_1, fspace_2 +type(atlas_Field) :: field +real(c_float) , pointer :: field_v(:) + +grid = atlas_Grid("O8") + +fspace_1 = atlas_functionspace_StructuredColumns(grid, atlas_Partitioner("equal_regions")) +fspace_2 = atlas_functionspace_StructuredColumns(grid, atlas_Partitioner("regular_bands")) +field = do_redistribute(fspace_1, fspace_2) +call field%data(field_v) +FCTEST_CHECK(maxval(field_v) == 1.) + +meshgenerator = atlas_MeshGenerator() +mesh = meshgenerator%generate(grid, atlas_Partitioner("equal_regions")) +fspace_1 = atlas_functionspace_NodeColumns(mesh) +mesh = meshgenerator%generate(grid, atlas_Partitioner("regular_bands")) +fspace_2 = atlas_functionspace_NodeColumns(mesh) +field = do_redistribute(fspace_1, fspace_2) +call field%data(field_v) +FCTEST_CHECK(maxval(field_v) == 1.) + +fspace_2 = atlas_functionspace_EdgeColumns(mesh) +mesh = meshgenerator%generate(grid, atlas_Partitioner("equal_regions")) +fspace_1 = atlas_functionspace_EdgeColumns(mesh) +field = do_redistribute(fspace_1, fspace_2) +call field%data(field_v) +FCTEST_CHECK(maxval(field_v) == 1.) + +call fspace_2%final() +call fspace_1%final() +call grid%final() +END_TEST + +! ----------------------------------------------------------------------------- + +END_TESTSUITE