diff --git a/src/atlas/CMakeLists.txt b/src/atlas/CMakeLists.txt index 6e0d3d01b..3627dd60d 100644 --- a/src/atlas/CMakeLists.txt +++ b/src/atlas/CMakeLists.txt @@ -500,6 +500,8 @@ functionspace/detail/BlockStructuredColumns.h functionspace/detail/BlockStructuredColumns.cc functionspace/detail/BlockStructuredColumnsInterface.h functionspace/detail/BlockStructuredColumnsInterface.cc +functionspace/detail/CellColumnsInterface.h +functionspace/detail/CellColumnsInterface.cc functionspace/detail/FunctionSpaceImpl.h functionspace/detail/FunctionSpaceImpl.cc functionspace/detail/FunctionSpaceInterface.h diff --git a/src/atlas/functionspace/detail/CellColumnsInterface.cc b/src/atlas/functionspace/detail/CellColumnsInterface.cc new file mode 100644 index 000000000..b33e52028 --- /dev/null +++ b/src/atlas/functionspace/detail/CellColumnsInterface.cc @@ -0,0 +1,155 @@ +/* + * (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 "CellColumnsInterface.h" +#include "atlas/field/FieldSet.h" +#include "atlas/field/detail/FieldImpl.h" +#include "atlas/runtime/Exception.h" + +namespace atlas { +namespace functionspace { +namespace detail { + +using atlas::FieldSet; +using atlas::field::FieldImpl; +using atlas::field::FieldSetImpl; + +// ---------------------------------------------------------------------- + +extern "C" { +const CellColumns* atlas__CellsFunctionSpace__new(Mesh::Implementation* mesh, const eckit::Configuration* config) { + ATLAS_ASSERT(mesh); + Mesh m(mesh); + return new CellColumns(m, *config); +} + +void atlas__CellsFunctionSpace__delete(CellColumns* This) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + delete (This); +} + +int atlas__CellsFunctionSpace__nb_cells(const CellColumns* This) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + return This->nb_cells(); +} + +const Mesh::Implementation* atlas__CellsFunctionSpace__mesh(const CellColumns* This) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + return This->mesh().get(); +} + +const mesh::HybridElements* atlas__CellsFunctionSpace__cells(const CellColumns* This) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + return &This->cells(); +} + +void atlas__CellsFunctionSpace__halo_exchange_fieldset(const CellColumns* This, field::FieldSetImpl* fieldset) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + ATLAS_ASSERT(fieldset != nullptr, "Cannot access uninitialised atlas_FieldSet"); + FieldSet f(fieldset); + This->haloExchange(f); +} + +void atlas__CellsFunctionSpace__halo_exchange_field(const CellColumns* This, field::FieldImpl* field) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + ATLAS_ASSERT(field != nullptr, "Cannot access uninitialised atlas_Field"); + Field f(field); + This->haloExchange(f); +} + +const parallel::HaloExchange* atlas__CellsFunctionSpace__get_halo_exchange(const CellColumns* This) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + return &This->halo_exchange(); +} + +void atlas__CellsFunctionSpace__gather_fieldset(const CellColumns* This, const field::FieldSetImpl* local, + field::FieldSetImpl* global) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + ATLAS_ASSERT(local != nullptr, "Cannot access uninitialised local atlas_FieldSet"); + ATLAS_ASSERT(global != nullptr, "Cannot access uninitialised global atlas_FieldSet"); + const FieldSet l(local); + FieldSet g(global); + This->gather(l, g); +} + +void atlas__CellsFunctionSpace__gather_field(const CellColumns* This, const field::FieldImpl* local, + field::FieldImpl* global) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + ATLAS_ASSERT(local != nullptr, "Cannot access uninitialised local atlas_Field"); + ATLAS_ASSERT(global != nullptr, "Cannot access uninitialised global atlas_Field"); + const Field l(local); + Field g(global); + This->gather(l, g); +} + +const parallel::GatherScatter* atlas__CellsFunctionSpace__get_gather(const CellColumns* This) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + return &This->gather(); +} + +const parallel::GatherScatter* atlas__CellsFunctionSpace__get_scatter(const CellColumns* This) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + return &This->scatter(); +} + +void atlas__CellsFunctionSpace__scatter_fieldset(const CellColumns* This, const field::FieldSetImpl* global, + field::FieldSetImpl* local) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + ATLAS_ASSERT(local != nullptr, "Cannot access uninitialised local atlas_FieldSet"); + ATLAS_ASSERT(global != nullptr, "Cannot access uninitialised global atlas_FieldSet"); + const FieldSet g(global); + FieldSet l(local); + This->scatter(g, l); +} + +void atlas__CellsFunctionSpace__scatter_field(const CellColumns* This, const field::FieldImpl* global, + field::FieldImpl* local) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + ATLAS_ASSERT(local != nullptr, "Cannot access uninitialised local atlas_Field"); + ATLAS_ASSERT(global != nullptr, "Cannot access uninitialised global atlas_Field"); + const Field g(global); + Field l(local); + This->scatter(g, l); +} + +const parallel::Checksum* atlas__CellsFunctionSpace__get_checksum(const CellColumns* This) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + return &This->checksum(); +} + +void atlas__CellsFunctionSpace__checksum_fieldset(const CellColumns* This, const field::FieldSetImpl* fieldset, + char*& checksum, int& size, int& allocated) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + ATLAS_ASSERT(fieldset != nullptr, "Cannot access uninitialised atlas_FieldSet"); + std::string checksum_str(This->checksum(fieldset)); + size = static_cast(checksum_str.size()); + checksum = new char[size + 1]; + allocated = true; + std::strncpy(checksum, checksum_str.c_str(), size + 1); +} + +void atlas__CellsFunctionSpace__checksum_field(const CellColumns* This, const field::FieldImpl* field, char*& checksum, + int& size, int& allocated) { + ATLAS_ASSERT(This != nullptr, "Cannot access uninitialised atlas_functionspace_CellColumns"); + ATLAS_ASSERT(field != nullptr, "Cannot access uninitialised atlas_Field"); + std::string checksum_str(This->checksum(field)); + size = static_cast(checksum_str.size()); + checksum = new char[size + 1]; + allocated = true; + std::strncpy(checksum, checksum_str.c_str(), size + 1); +} + +} // extern C + +} // namespace detail +} // namespace functionspace +} // namespace atlas diff --git a/src/atlas/functionspace/detail/CellColumnsInterface.h b/src/atlas/functionspace/detail/CellColumnsInterface.h new file mode 100644 index 000000000..86ca7d0e9 --- /dev/null +++ b/src/atlas/functionspace/detail/CellColumnsInterface.h @@ -0,0 +1,59 @@ +/* + * (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 + +#include "atlas/functionspace/CellColumns.h" +#include "atlas/mesh/Mesh.h" + +namespace atlas { +namespace field { +class FieldSetImpl; +class FieldImpl; +} // namespace field +} // namespace atlas + +namespace atlas { +namespace functionspace { +namespace detail { + +extern "C" { +const CellColumns* atlas__CellsFunctionSpace__new(Mesh::Implementation* mesh, const eckit::Configuration* config); +void atlas__CellsFunctionSpace__delete(CellColumns* This); +int atlas__CellsFunctionSpace__nb_cells(const CellColumns* This); +const Mesh::Implementation* atlas__CellsFunctionSpace__mesh(const CellColumns* This); +const mesh::HybridElements* atlas__CellsFunctionSpace__cells(const CellColumns* This); + +void atlas__CellsFunctionSpace__halo_exchange_fieldset(const CellColumns* This, field::FieldSetImpl* fieldset); +void atlas__CellsFunctionSpace__halo_exchange_field(const CellColumns* This, field::FieldImpl* field); +const parallel::HaloExchange* atlas__CellsFunctionSpace__get_halo_exchange(const CellColumns* This); + +void atlas__CellsFunctionSpace__gather_fieldset(const CellColumns* This, const field::FieldSetImpl* local, + field::FieldSetImpl* global); +void atlas__CellsFunctionSpace__gather_field(const CellColumns* This, const field::FieldImpl* local, + field::FieldImpl* global); +const parallel::GatherScatter* atlas__CellsFunctionSpace__get_gather(const CellColumns* This); + +void atlas__CellsFunctionSpace__scatter_fieldset(const CellColumns* This, const field::FieldSetImpl* global, + field::FieldSetImpl* local); +void atlas__CellsFunctionSpace__scatter_field(const CellColumns* This, const field::FieldImpl* global, + field::FieldImpl* local); +const parallel::GatherScatter* atlas__CellsFunctionSpace__get_scatter(const CellColumns* This); + +void atlas__CellsFunctionSpace__checksum_fieldset(const CellColumns* This, const field::FieldSetImpl* fieldset, + char*& checksum, int& size, int& allocated); +void atlas__CellsFunctionSpace__checksum_field(const CellColumns* This, const field::FieldImpl* field, char*& checksum, + int& size, int& allocated); +const parallel::Checksum* atlas__CellsFunctionSpace__get_checksum(const CellColumns* This); +} + +} // namespace detail +} // namespace functionspace +} // namespace atlas diff --git a/src/atlas_f/CMakeLists.txt b/src/atlas_f/CMakeLists.txt index a59e7f9c2..f1b831e3c 100644 --- a/src/atlas_f/CMakeLists.txt +++ b/src/atlas_f/CMakeLists.txt @@ -121,6 +121,9 @@ generate_fortran_bindings(FORTRAN_BINDINGS ../atlas/functionspace/detail/Structu generate_fortran_bindings(FORTRAN_BINDINGS ../atlas/functionspace/detail/BlockStructuredColumnsInterface.h MODULE atlas_functionspace_BlockStructuredColumns_c_binding OUTPUT functionspace_BlockStructuredColumns_c_binding.f90 ) +generate_fortran_bindings(FORTRAN_BINDINGS ../atlas/functionspace/detail/CellColumnsInterface.h + MODULE atlas_functionspace_CellColumns_c_binding + OUTPUT functionspace_CellColumns_c_binding.f90) generate_fortran_bindings(FORTRAN_BINDINGS ../atlas/functionspace/detail/NodeColumnsInterface.h MODULE atlas_functionspace_NodeColumns_c_binding OUTPUT functionspace_NodeColumns_c_binding.f90) @@ -213,6 +216,7 @@ ecbuild_add_library( TARGET atlas_f domain/atlas_Domain_module.F90 functionspace/atlas_FunctionSpace_module.F90 functionspace/atlas_functionspace_EdgeColumns_module.F90 + functionspace/atlas_functionspace_CellColumns_module.F90 functionspace/atlas_functionspace_NodeColumns_module.fypp functionspace/atlas_functionspace_StructuredColumns_module.F90 functionspace/atlas_functionspace_BlockStructuredColumns_module.F90 diff --git a/src/atlas_f/atlas_module.F90 b/src/atlas_f/atlas_module.F90 index d82553e86..48ffe33ae 100644 --- a/src/atlas_f/atlas_module.F90 +++ b/src/atlas_f/atlas_module.F90 @@ -91,6 +91,8 @@ module atlas_module & atlas_Vertical use atlas_functionspace_EdgeColumns_module, only: & & atlas_functionspace_EdgeColumns +use atlas_functionspace_CellColumns_module, only: & + & atlas_functionspace_CellColumns use atlas_functionspace_NodeColumns_module, only: & & atlas_functionspace_NodeColumns use atlas_functionspace_PointCloud_module, only: & diff --git a/src/atlas_f/functionspace/atlas_functionspace_CellColumns_module.F90 b/src/atlas_f/functionspace/atlas_functionspace_CellColumns_module.F90 new file mode 100644 index 000000000..c67f5a148 --- /dev/null +++ b/src/atlas_f/functionspace/atlas_functionspace_CellColumns_module.F90 @@ -0,0 +1,283 @@ +! (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_functionspace_CellColumns_module + +use fckit_c_interop_module, only : c_str, c_ptr_to_string, c_ptr_free +use atlas_functionspace_module, only : atlas_FunctionSpace +use atlas_Field_module, only: atlas_Field +use atlas_FieldSet_module, only: atlas_FieldSet +use atlas_Mesh_module, only: atlas_Mesh +use atlas_mesh_Cells_module, only: atlas_mesh_Cells +use atlas_GatherScatter_module, only: atlas_GatherScatter +use atlas_HaloExchange_module, only: atlas_HaloExchange +use atlas_Checksum_module, only: atlas_Checksum +use atlas_Config_module, only: atlas_Config +use atlas_kinds_module, only: ATLAS_KIND_GIDX + +implicit none + +private :: c_str, c_ptr_to_string, c_ptr_free +private :: atlas_FunctionSpace +private :: atlas_Field +private :: atlas_FieldSet +private :: atlas_mesh_Cells +private :: atlas_GatherScatter +private :: atlas_HaloExchange +private :: atlas_Checksum +private :: atlas_Mesh +private :: atlas_Config +private :: ATLAS_KIND_GIDX + +public :: atlas_functionspace_CellColumns + +private + +!------------------------------------------------------------------------------ +TYPE, extends(atlas_FunctionSpace) :: atlas_functionspace_CellColumns + +! Purpose : +! ------- +! *atlas_functionspace_CellColumns* : Interpretes fields defined in cells + +! Methods : +! ------- + +! Author : +! ------ +! August-2015 Willem Deconinck *ECMWF* + +!------------------------------------------------------------------------------ +contains + + + procedure, public :: nb_cells + procedure, public :: mesh + procedure, public :: cells + + procedure, public :: get_halo_exchange + + procedure, private :: gather_fieldset + procedure, private :: gather_field + generic, public :: gather => gather_fieldset, gather_field + procedure, public :: get_gather + + procedure, private :: scatter_fieldset + procedure, private :: scatter_field + generic, public :: scatter => scatter_fieldset, scatter_field + procedure, public :: get_scatter + + procedure, private :: checksum_fieldset + procedure, private :: checksum_field + generic, public :: checksum => checksum_fieldset, checksum_field + procedure, public :: get_checksum + +#if FCKIT_FINAL_NOT_INHERITING + final :: atlas_functionspace_CellColumns__final_auto +#endif + +END TYPE atlas_functionspace_CellColumns + +interface atlas_functionspace_CellColumns + module procedure constructor__cptr + module procedure constructor +end interface + +!------------------------------------------------------------------------------ + +!======================================================== +contains +!======================================================== + +!------------------------------------------------------------------------------ + +function constructor__cptr(cptr) result(this) + use, intrinsic :: iso_c_binding, only : c_ptr + type(atlas_functionspace_CellColumns) :: this + type(c_ptr), intent(in) :: cptr + call this%reset_c_ptr( cptr ) + call this%return() +end function + +!------------------------------------------------------------------------------ + +function constructor(mesh,halo,levels) result(this) + use atlas_functionspace_CellColumns_c_binding + type(atlas_functionspace_CellColumns) :: this + type(atlas_Mesh), intent(inout) :: mesh + integer, intent(in), optional :: halo + integer, intent(in), optional :: levels + type(atlas_Config) :: config + config = atlas_Config() + if( present(halo) ) call config%set("halo",halo) + if( present(levels) ) call config%set("levels",levels) + call this%reset_c_ptr( atlas__CellsFunctionSpace__new(mesh%CPTR_PGIBUG_A,config%CPTR_PGIBUG_B) ) + call config%final() + call this%return() +end function + +!------------------------------------------------------------------------------ + +function nb_cells(this) + use atlas_functionspace_CellColumns_c_binding + integer :: nb_cells + class(atlas_functionspace_CellColumns), intent(in) :: this + nb_cells = atlas__CellsFunctionSpace__nb_cells(this%CPTR_PGIBUG_A) +end function + +!------------------------------------------------------------------------------ + +function mesh(this) + use atlas_functionspace_CellColumns_c_binding + type(atlas_Mesh) :: mesh + class(atlas_functionspace_CellColumns), intent(in) :: this + call mesh%reset_c_ptr( atlas__CellsFunctionSpace__mesh(this%CPTR_PGIBUG_A) ) + call mesh%return() +end function + +!------------------------------------------------------------------------------ + +function cells(this) + use atlas_functionspace_CellColumns_c_binding + type(atlas_mesh_Cells) :: cells + class(atlas_functionspace_CellColumns), intent(in) :: this + call cells%reset_c_ptr( atlas__CellsFunctionSpace__cells(this%CPTR_PGIBUG_A) ) + call cells%return() +end function + +!------------------------------------------------------------------------------ + +function get_gather(this) result(gather) + use atlas_functionspace_CellColumns_c_binding + type(atlas_GatherScatter) :: gather + class(atlas_functionspace_CellColumns), intent(in) :: this + call gather%reset_c_ptr( atlas__CellsFunctioNSpace__get_gather(this%CPTR_PGIBUG_A) ) +end function + +!------------------------------------------------------------------------------ + +function get_scatter(this) result(gather) + use atlas_functionspace_CellColumns_c_binding + type(atlas_GatherScatter) :: gather + class(atlas_functionspace_CellColumns), intent(in) :: this + call gather%reset_c_ptr( atlas__CellsFunctioNSpace__get_scatter(this%CPTR_PGIBUG_A) ) +end function + +!------------------------------------------------------------------------------ + +subroutine gather_fieldset(this,local,global) + use atlas_functionspace_CellColumns_c_binding + class(atlas_functionspace_CellColumns), intent(in) :: this + type(atlas_FieldSet), intent(in) :: local + type(atlas_FieldSet), intent(inout) :: global + call atlas__CellsFunctionSpace__gather_fieldset(this%CPTR_PGIBUG_A,local%CPTR_PGIBUG_A,global%CPTR_PGIBUG_A) +end subroutine + +!------------------------------------------------------------------------------ + +subroutine gather_field(this,local,global) + use atlas_functionspace_CellColumns_c_binding + class(atlas_functionspace_CellColumns), intent(in) :: this + type(atlas_Field), intent(in) :: local + type(atlas_Field), intent(inout) :: global + call atlas__CellsFunctionSpace__gather_field(this%CPTR_PGIBUG_A,local%CPTR_PGIBUG_A,global%CPTR_PGIBUG_A) +end subroutine + +!------------------------------------------------------------------------------ + +subroutine scatter_fieldset(this,global,local) + use atlas_functionspace_CellColumns_c_binding + class(atlas_functionspace_CellColumns), intent(in) :: this + type(atlas_FieldSet), intent(in) :: global + type(atlas_FieldSet), intent(inout) :: local + call atlas__CellsFunctionSpace__scatter_fieldset(this%CPTR_PGIBUG_A,global%CPTR_PGIBUG_A,local%CPTR_PGIBUG_A) +end subroutine + +!------------------------------------------------------------------------------ + +subroutine scatter_field(this,global,local) + use atlas_functionspace_CellColumns_c_binding + class(atlas_functionspace_CellColumns), intent(in) :: this + type(atlas_Field), intent(in) :: global + type(atlas_Field), intent(inout) :: local + call atlas__CellsFunctionSpace__scatter_field(this%CPTR_PGIBUG_A,global%CPTR_PGIBUG_A,local%CPTR_PGIBUG_A) +end subroutine + +!------------------------------------------------------------------------------ + +function get_halo_exchange(this) result(halo_exchange) + use atlas_functionspace_CellColumns_c_binding + type(atlas_HaloExchange) :: halo_exchange + class(atlas_functionspace_CellColumns), intent(in) :: this + call halo_exchange%reset_c_ptr( atlas__CellsFunctioNSpace__get_halo_exchange(this%CPTR_PGIBUG_A) ) +end function + +!------------------------------------------------------------------------------ + +function get_checksum(this) result(checksum) + use atlas_functionspace_CellColumns_c_binding + type(atlas_Checksum) :: checksum + class(atlas_functionspace_CellColumns), intent(in) :: this + call checksum%reset_c_ptr( atlas__CellsFunctioNSpace__get_checksum(this%CPTR_PGIBUG_A) ) +end function + +!------------------------------------------------------------------------------ + +function checksum_fieldset(this,fieldset) result(checksum) + use atlas_functionspace_CellColumns_c_binding + use, intrinsic :: iso_c_binding, only : c_ptr + character(len=:), allocatable :: checksum + class(atlas_functionspace_CellColumns), intent(in) :: this + type(atlas_FieldSet), intent(in) :: fieldset + type(c_ptr) :: checksum_cptr + integer :: checksum_size, checksum_allocated + call atlas__CellsFunctionSpace__checksum_fieldset( & + this%CPTR_PGIBUG_A,fieldset%CPTR_PGIBUG_A,checksum_cptr,checksum_size,checksum_allocated) + allocate(character(len=checksum_size) :: checksum ) + checksum = c_ptr_to_string(checksum_cptr) + if( checksum_allocated == 1 ) call c_ptr_free(checksum_cptr) +end function + +!------------------------------------------------------------------------------ + +function checksum_field(this,field) result(checksum) + use atlas_functionspace_CellColumns_c_binding + use, intrinsic :: iso_c_binding, only : c_ptr + character(len=:), allocatable :: checksum + class(atlas_functionspace_CellColumns), intent(in) :: this + type(atlas_Field), intent(in) :: field + type(c_ptr) :: checksum_cptr + integer :: checksum_size, checksum_allocated + call atlas__CellsFunctionSpace__checksum_field( & + this%CPTR_PGIBUG_A,field%CPTR_PGIBUG_A,checksum_cptr,checksum_size,checksum_allocated) + allocate(character(len=checksum_size) :: checksum ) + checksum = c_ptr_to_string(checksum_cptr) + if( checksum_allocated == 1 ) call c_ptr_free(checksum_cptr) +end function + +!------------------------------------------------------------------------------ + +#if FCKIT_FINAL_NOT_INHERITING +ATLAS_FINAL subroutine atlas_functionspace_CellColumns__final_auto(this) + type(atlas_functionspace_CellColumns), intent(inout) :: this +#if FCKIT_FINAL_DEBUGGING + write(0,*) "atlas_functionspace_CellColumns__final_auto" +#endif +#if FCKIT_FINAL_NOT_PROPAGATING + call this%final() +#endif + FCKIT_SUPPRESS_UNUSED( this ) +end subroutine +#endif + +!------------------------------------------------------------------------------ + +end module atlas_functionspace_CellColumns_module + diff --git a/src/tests/functionspace/fctest_functionspace.F90 b/src/tests/functionspace/fctest_functionspace.F90 index fd2011d11..ee63cc600 100644 --- a/src/tests/functionspace/fctest_functionspace.F90 +++ b/src/tests/functionspace/fctest_functionspace.F90 @@ -247,7 +247,7 @@ module fcta_FunctionSpace_fxt ! ----------------------------------------------------------------------------- -TEST( test_collectives ) +TEST( test_node_collectives ) #if 1 use fckit_mpi_module type(atlas_StructuredGrid) :: grid @@ -365,6 +365,300 @@ module fcta_FunctionSpace_fxt #endif END_TEST +! ----------------------------------------------------------------------------- + +TEST( test_cell_collectives ) +#if 1 +use fckit_mpi_module +type(atlas_StructuredGrid) :: grid +type(atlas_MeshGenerator) :: meshgenerator +type(atlas_Mesh) :: mesh +type(atlas_functionspace_CellColumns) :: fs2d +type(atlas_Field) :: field, global, scal +type(atlas_Metadata) :: metadata +type(fckit_mpi_comm) :: mpi +real(c_float), pointer :: scalvalues(:) +real(c_float), pointer :: values(:,:) +real(c_float), pointer :: values3d(:,:,:) +!real(c_float) :: minimum, maximum, sum, oisum, mean, stddev +!real(c_float), allocatable :: minimumv(:), maximumv(:), meanv(:), stddevv(:) +integer :: halo_size, levels +integer(ATLAS_KIND_GIDX) :: glb_idx +integer(ATLAS_KIND_GIDX), allocatable :: glb_idxv (:) +integer(c_int) :: test_broadcast +mpi = fckit_mpi_comm() +halo_size = 1 +levels = 10 + +grid = atlas_StructuredGrid("N24") +meshgenerator = atlas_MeshGenerator() +mesh = meshgenerator%generate(grid) +call meshgenerator%final() +fs2d = atlas_functionspace_CellColumns(mesh,halo_size) + +field = fs2d%create_field(kind=atlas_real(c_float),variables=2) +global = fs2d%create_field(field,global=.True.) +scal = fs2d%create_field(kind=atlas_real(c_float)) + +write(msg,*) "field: rank",field%rank(), " shape [",field%shape(), "] size ", field%size(); call atlas_log%info(msg) +write(msg,*) "global: rank",global%rank()," shape [",global%shape(),"] size ", global%size(); call atlas_log%info(msg) + +call fs2d%gather(field,global) +call fs2d%halo_exchange(field) + +metadata = global%metadata() +if( mpi%rank() == 0 ) then + call metadata%set("test_broadcast",123) +endif + +call fs2d%scatter(global,field) +metadata = field%metadata() +call metadata%get("test_broadcast",test_broadcast) +FCTEST_CHECK_EQUAL( test_broadcast, 123 ) +call field%data(values) +call scal%data(scalvalues) +values = 2. +scalvalues = 2. + +call atlas_log%info(fs2d%checksum(field)) + +values = mpi%rank() +scalvalues = mpi%rank() + +call scal%final() +call field%final() +call global%final() + +field = fs2d%create_field(kind=atlas_real(c_float),levels=levels,variables=2*3) +global = fs2d%create_field(field,global=.True.,owner=mpi%size()-1) + +write(msg,*) "field: rank",field%rank(), " shape [",field%shape(), "] size ", field%size(); call atlas_log%info(msg) +write(msg,*) "global: rank",global%rank()," shape [",global%shape(),"] size ", global%size(); call atlas_log%info(msg) + +call fs2d%gather(field,global) +call fs2d%halo_exchange(field) +call fs2d%scatter(global,field) + +call field%data(values3d) +values3d = 2. + +call atlas_log%info(fs2d%checksum(field)) +call field%final() +call global%final() +call fs2d%final() + +call mesh%final() +call grid%final() +#endif +END_TEST + +TEST( test_cells ) +#if 1 +type(atlas_StructuredGrid) :: grid +type(atlas_MeshGenerator) :: meshgenerator +type(atlas_Mesh) :: mesh +type(atlas_functionspace_CellColumns) :: fs +type(atlas_Field) :: field, template +type(atlas_mesh_Nodes) :: cells +integer :: halo_size, nb_cells +halo_size = 1 + +grid = atlas_StructuredGrid("N24") +meshgenerator = atlas_MeshGenerator() +mesh = meshgenerator%generate(grid) +call meshgenerator%final() +fs = atlas_functionspace_CellColumns(mesh,halo_size) +cells = fs%cells() +nb_cells = fs%nb_cells() +write(msg,*) "nb_cells = ",nb_cells; call atlas_log%info(msg) + +field = fs%create_field(atlas_real(c_float)) +FCTEST_CHECK_EQUAL( field%rank() , 1 ) +FCTEST_CHECK_EQUAL( field%name() , "" ) +FCTEST_CHECK_EQUAL( field%kind() , atlas_real(c_float) ) +call field%final() + +field = fs%create_field(name="field",kind=atlas_real(c_float)) +FCTEST_CHECK_EQUAL( field%rank() , 1 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +FCTEST_CHECK_EQUAL( field%kind() , atlas_real(c_float) ) +call field%final() + +field = fs%create_field(atlas_real(c_float),variables=2) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "" ) +call field%final() + +field = fs%create_field(name="field",kind=atlas_integer(c_int),variables=2*2) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +template = field + +field = fs%create_field(template) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , template%name() ) +call field%final() + +field = fs%create_field(template,name="field") +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +call field%final() +call template%final() + + +field = fs%create_field(atlas_real(c_float),global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 1 ) +FCTEST_CHECK_EQUAL( field%name() , "" ) +FCTEST_CHECK_EQUAL( field%kind() , atlas_real(c_float) ) +call field%final() + +field = fs%create_field(name="field",kind=atlas_real(c_float),global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 1 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +FCTEST_CHECK_EQUAL( field%kind() , atlas_real(c_float) ) +call field%final() + +field = fs%create_field(atlas_real(c_float),variables=2,global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "" ) +call field%final() + +field = fs%create_field(name="field",kind=atlas_integer(c_int),variables=2*2,global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +template = field + +field = fs%create_field(template,global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , template%name() ) +call field%final() + +field = fs%create_field(template,name="field",global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +call field%final() +call template%final() + +call fs%final() +call mesh%final() +call grid%final() +#else +#warning test test_cells disabled +#endif +END_TEST + +! ----------------------------------------------------------------------------- + + +TEST( test_cellscolumns ) +#if 1 +type(atlas_StructuredGrid) :: grid +type(atlas_MeshGenerator) :: meshgenerator +type(atlas_Mesh) :: mesh +type(atlas_functionspace_CellColumns) :: fs +type(atlas_Field) :: field, template +integer :: halo_size, levels +halo_size = 1 +levels = 10 + +grid = atlas_StructuredGrid("N24") +meshgenerator = atlas_MeshGenerator() +mesh = meshgenerator%generate(grid) +call meshgenerator%final() +fs = atlas_functionspace_CellColumns(mesh,halo_size) + +!levels = fs%nb_levels() +write(msg,*) "nb_levels = ",levels; call atlas_log%info(msg) + +field = fs%create_field(atlas_real(c_float),levels=levels) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "" ) +FCTEST_CHECK_EQUAL( field%kind() , atlas_real(c_float) ) +call field%final() + +field = fs%create_field(name="field",kind=atlas_real(c_float),levels=levels) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +FCTEST_CHECK_EQUAL( field%kind() , atlas_real(c_float) ) +call field%final() + +field = fs%create_field(atlas_real(c_float),levels=levels,variables=2) +FCTEST_CHECK_EQUAL( field%rank() , 3 ) +FCTEST_CHECK_EQUAL( field%name() , "" ) +call field%final() + +field = fs%create_field(name="field",kind=atlas_integer(c_int),levels=levels,variables=2*2) +FCTEST_CHECK_EQUAL( field%rank() , 3 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +template = field + +field = fs%create_field(template) +FCTEST_CHECK_EQUAL( field%rank() , 3 ) +FCTEST_CHECK_EQUAL( field%name() , template%name() ) +call field%final() + +field = fs%create_field(template,name="field") +FCTEST_CHECK_EQUAL( field%rank() , 3 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +call field%final() +call template%final() + + +field = fs%create_field(atlas_real(c_float),levels=levels,global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "" ) +FCTEST_CHECK_EQUAL( field%kind() , atlas_real(c_float) ) +call field%final() + +field = fs%create_field(name="field",kind=atlas_real(c_float),levels=levels,global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +FCTEST_CHECK_EQUAL( field%kind() , atlas_real(c_float) ) +call field%final() + +field = fs%create_field(atlas_real(c_float),levels=levels,variables=2,global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 3 ) +FCTEST_CHECK_EQUAL( field%name() , "" ) +call field%final() + +field = fs%create_field(name="field",kind=atlas_integer(c_int),levels=levels,variables=2*2,global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 3 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +template = field + +field = fs%create_field(template,global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 3 ) +FCTEST_CHECK_EQUAL( field%name() , template%name() ) +call field%final() + +field = fs%create_field(template,name="field",global=.True.) +FCTEST_CHECK_EQUAL( field%rank() , 3 ) +FCTEST_CHECK_EQUAL( field%name() , "field" ) +call field%final() +call template%final() + +fs = atlas_functionspace_CellColumns(mesh,levels=5) +field = fs%create_field(atlas_real(c_float)) +FCTEST_CHECK_EQUAL( field%rank() , 2 ) +FCTEST_CHECK_EQUAL( field%name() , "" ) +FCTEST_CHECK_EQUAL( field%kind() , atlas_real(c_float) ) +call field%final() + +FCTEST_CHECK_EQUAL( fs%owners(), 1 ) +call fs%final() + +FCTEST_CHECK_EQUAL( mesh%owners(), 1 ) +call mesh%final() + +FCTEST_CHECK_EQUAL( grid%owners(), 1 ) +call grid%final() +#else +#warning test test_cellscolumns disabled +#endif +END_TEST + +! ----------------------------------------------------------------------------- +