diff --git a/.github/workflows/code_coverage.yml b/.github/workflows/code_coverage.yml index 8e9e664852..10d01c1988 100644 --- a/.github/workflows/code_coverage.yml +++ b/.github/workflows/code_coverage.yml @@ -95,9 +95,10 @@ jobs: && echo CONFIG_OPTIONS="$CONFIG_OPTIONS" >> $GITHUB_ENV # cmake - name: echo cmake line - run: echo cmake ../ $CONFIG_OPTIONS + run: echo cmake ../ $CONFIG_OPTIONS -DCMAKE_Fortran_FLAGS="-fprofile-arcs -ftest-coverage" + # Note: Adding DCMAKE_Fortran_FLAGS here is a workaround because the blank space between the compiler flags causes trouble otherwise. - name: cmake - run: mkdir build && cd build && cmake ../ $CONFIG_OPTIONS + run: mkdir build && cd build && cmake ../ $CONFIG_OPTIONS -DCMAKE_Fortran_FLAGS="-fprofile-arcs -ftest-coverage" - name: OnFailUploadLog if: failure() uses: actions/upload-artifact@v6 diff --git a/api/t8_fortran_interface/CMakeLists.txt b/api/t8_fortran_interface/CMakeLists.txt index d3056d7d37..e9ecaedc28 100644 --- a/api/t8_fortran_interface/CMakeLists.txt +++ b/api/t8_fortran_interface/CMakeLists.txt @@ -1,6 +1,6 @@ # Link in C-Fortran interface file into libt8. target_sources( T8 PRIVATE t8_fortran_interface.c ) -target_sources( T8 PRIVATE t8_fortran_interface_mod.f90 ) +target_sources( T8 PRIVATE t8_fortran_interface_mod.f90 t8_fortran_example_adapt_mod.f90 ) # Add this directory to header search path. diff --git a/api/t8_fortran_interface/t8_fortran_example_adapt_mod.f90 b/api/t8_fortran_interface/t8_fortran_example_adapt_mod.f90 new file mode 100644 index 0000000000..448f175475 --- /dev/null +++ b/api/t8_fortran_interface/t8_fortran_example_adapt_mod.f90 @@ -0,0 +1,48 @@ +! This file is part of t8code. +! t8code is a C library to manage a collection (a forest) of multiple +! connected adaptive space-trees of general element classes in parallel. +! +! Copyright (C) 2026 the developers +! +! t8code is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! t8code is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with t8code; if not, write to the Free Software Foundation, Inc., +! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +! This file contains a module with an example callback of the Fortran interface +! that refines and coarsenes some elements based on their centroids' coordinates. +module t8_fortran_example_adapt_mod + use t8_fortran_interface_mod + +contains + + ! Example callback for adapting based on the centroid coordinates x, y, z. + function example_fortran_adapt_by_coordinates_callback(x, y, z, is_family) & + & result(ret) bind(c, name="example_fortran_adapt_by_coordinates_callback") + use, intrinsic :: ISO_C_BINDING, only: c_int, c_double + real(c_double), value :: x + real(c_double), value :: y + real(c_double), value :: z + integer(c_int), value :: is_family + integer(c_int) :: ret + ret = 0 + if(x < 0.5d0 .and. y < 0.5d0 .and. z < 0.5d0) then + ret = 1 + elseif(x > 0.5d0 .and. y > 0.5d0) then + if(is_family.ne.0) then + ret = -1 + endif + endif + + end function example_fortran_adapt_by_coordinates_callback + +end module t8_fortran_example_adapt_mod \ No newline at end of file diff --git a/api/t8_fortran_interface/t8_fortran_interface.c b/api/t8_fortran_interface/t8_fortran_interface.c index 9cb3f408ac..98a44b9bc4 100644 --- a/api/t8_fortran_interface/t8_fortran_interface.c +++ b/api/t8_fortran_interface/t8_fortran_interface.c @@ -21,10 +21,11 @@ */ #include -#include -#include #include #include +#include +#include +#include #include #include @@ -51,12 +52,6 @@ t8_fortran_cmesh_commit (t8_cmesh_t cmesh, sc_MPI_Comm *comm) t8_cmesh_commit (cmesh, *comm); } -void -t8_fortran_cmesh_set_join_by_stash_noConn (t8_cmesh_t cmesh, const int do_both_directions) -{ - t8_cmesh_set_join_by_stash (cmesh, NULL, do_both_directions); -} - void t8_fortran_init_all (sc_MPI_Comm *comm) { @@ -127,16 +122,14 @@ int t8_fortran_adapt_by_coordinates_callback (t8_forest_t forest, t8_forest_t forest_from, t8_locidx_t which_tree, const t8_eclass_t tree_class, __attribute__ ((unused)) t8_locidx_t lelement_id, const t8_scheme_c *scheme, - const int is_family, const int num_elements, t8_element_t *elements[]) + const int is_family, __attribute__ ((unused)) const int num_elements, + t8_element_t *elements[]) { t8_fortran_adapt_coordinate_callback callback = (t8_fortran_adapt_coordinate_callback) t8_forest_get_user_function (forest); double midpoint[3]; - t8_forest_element_centroid (forest_from, which_tree, elements[0], midpoint); - t8_debugf ("Coord: %.2f\n", midpoint[0]); - int ret = callback (midpoint[0], midpoint[1], midpoint[2], num_elements > 0); - /* Coarsen if a family was given and return value is negative. */ + /* If a family was given, form parent first to feed its centroid into the callback. */ if (is_family) { /* The elements form a family */ T8_ASSERT (t8_elements_are_family (scheme, tree_class, elements)); @@ -146,14 +139,16 @@ t8_fortran_adapt_by_coordinates_callback (t8_forest_t forest, t8_forest_t forest t8_element_get_parent (scheme, tree_class, elements[0], parent); /* Get the coordinates of the parent. */ t8_forest_element_centroid (forest_from, which_tree, parent, midpoint); - - ret = callback (midpoint[0], midpoint[1], midpoint[2], 1); + /* Deallocate parent element to avoid memory leakage. */ + t8_element_destroy (scheme, tree_class, 1, &parent); } else { /* The elements do not form a family. */ - /* Get the coordinates of the first element and call callback */ + /* Get the coordinates of the first element.*/ t8_forest_element_centroid (forest_from, which_tree, elements[0], midpoint); - ret = callback (midpoint[0], midpoint[1], midpoint[2], 0); + } + int ret = callback (midpoint[0], midpoint[1], midpoint[2], is_family); + if (!is_family) { T8_ASSERT (ret >= 0); } return ret; diff --git a/api/t8_fortran_interface/t8_fortran_interface.h b/api/t8_fortran_interface/t8_fortran_interface.h index b9a6a8c670..8953b36afd 100644 --- a/api/t8_fortran_interface/t8_fortran_interface.h +++ b/api/t8_fortran_interface/t8_fortran_interface.h @@ -21,11 +21,11 @@ */ /** \file t8_fortran_interface.h - * In this file we provide a basic Fortran interface + * In this file we provide a basic Fortran interface * for some functions of t8code. * Mostly, the C functions here are wrappers around more complex * t8code function. - * We only export a minimum of the actual t8code functionality + * We only export a minimum of the actual t8code functionality * to Fortran. */ @@ -73,19 +73,6 @@ t8_fortran_finalize (); void t8_fortran_cmesh_commit (t8_cmesh_t cmesh, sc_MPI_Comm *comm); -/** This function calls t8_cmesh_set_join_by_stash with connectivity = NULL. - * \param[in,out] cmesh Pointer to a t8code cmesh object. If set to NULL this argument is ignored. - * \param[in] do_both_directions Compute the connectivity from both neighboring sides. - * Takes much longer to compute. - * - * \warning This routine might be too expensive for very large meshes. In this case, - * consider to use a fully featured mesh generator. - * - * \note This routine does not detect periodic boundaries. -*/ -void -t8_fortran_cmesh_set_join_by_stash_noConn (t8_cmesh_t cmesh, const int do_both_directions); - /** Translate a fortran MPI communicator into a C MPI communicator * and return a pointer to it. * \param [in] Fcomm Fortran MPI Communicator @@ -125,7 +112,7 @@ t8_cmesh_new_periodic_tri_wrap (sc_MPI_Comm *Ccomm); t8_forest_t t8_forest_new_uniform_default (t8_cmesh_t cmesh, int level, int do_face_ghost, sc_MPI_Comm *comm); -/** +/** * \param [in, out] forest The forest * \param [in] recursive A flag specifying whether adaptation is to be done recursively * or not. If the value is zero, adaptation is not recursive diff --git a/api/t8_fortran_interface/t8_fortran_interface_mod.f90 b/api/t8_fortran_interface/t8_fortran_interface_mod.f90 index 3facffbb9a..d999c8a360 100644 --- a/api/t8_fortran_interface/t8_fortran_interface_mod.f90 +++ b/api/t8_fortran_interface/t8_fortran_interface_mod.f90 @@ -18,140 +18,128 @@ !! along with t8code; if not, write to the Free Software Foundation, Inc., !! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +!! This file contains the module with t8code's Fortran interface. module t8_fortran_interface_mod + use, intrinsic :: iso_c_binding - use, intrinsic :: ISO_C_BINDING - - - !!! Interface for t8_fortran_MPI_Comm_new + !!! interface for t8_fortran_MPI_Comm_new !!! Given a fortran MPI Communicator, converts it into C and !!! returns a pointer to the C MPI communicator. !!! This function allocates memory that needs to be freed with !!! t8_fortran_mpi_comm_delete_f !!! !!! Code modified from: https://stackoverflow.com/questions/42530620/how-to-pass-mpi-communicator-handle-from-fortran-to-c-using-iso-c-binding - INTERFACE - type (C_PTR) FUNCTION t8_fortran_mpi_comm_new_f (FCOMM) & - BIND(C, NAME='t8_fortran_MPI_Comm_new') - use, intrinsic :: ISO_C_BINDING, only: c_int, c_ptr - IMPLICIT NONE - INTEGER (C_INT), VALUE :: Fcomm - END FUNCTION t8_fortran_mpi_comm_new_f - END INTERFACE + interface + type (C_PTR) function t8_fortran_mpi_comm_new_f (FCOMM) & + bind(C, NAME='t8_fortran_MPI_Comm_new') + use, intrinsic :: iso_c_binding, only: c_int, c_ptr + implicit none + integer (c_int), value :: Fcomm + end function t8_fortran_mpi_comm_new_f + end interface !!! Free memory of a C MPI communicator pointer that was !!! allocated using t8_fortran_mpi_comm_new_f - INTERFACE + interface subroutine t8_fortran_mpi_comm_delete_f (Ccomm) & - BIND(C, NAME='t8_fortran_MPI_Comm_delete') - use, intrinsic :: ISO_C_BINDING, only: c_ptr - IMPLICIT NONE + bind(C, NAME='t8_fortran_MPI_Comm_delete') + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none type (c_ptr), value :: Ccomm - END subroutine t8_fortran_mpi_comm_delete_f - END INTERFACE - + end subroutine t8_fortran_mpi_comm_delete_f + end interface + !!! Initialize sc and t8code with a given C MPI Communicator - Interface + interface subroutine t8_fortran_init_all_f (Ccomm) & - BIND(C, NAME='t8_fortran_init_all') - use, intrinsic :: ISO_C_BINDING, only: c_ptr - IMPLICIT NONE + bind(C, NAME='t8_fortran_init_all') + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none type (c_ptr), value :: Ccomm - END subroutine t8_fortran_init_all_f - end Interface + end subroutine t8_fortran_init_all_f + end interface - !!! Initialize sc and t8code with a given C MPI Communicator - Interface + !!! Initialize sc and t8code with a given C MPI Communicator + interface subroutine t8_fortran_init_all_noMPI_f () & - BIND(C, NAME='t8_fortran_init_all_noMPI') - END subroutine t8_fortran_init_all_noMPI_f - end Interface + bind(C, NAME='t8_fortran_init_all_noMPI') + end subroutine t8_fortran_init_all_noMPI_f + end interface - Interface + interface type (c_ptr) function t8_cmesh_new_periodic_tri_f (Ccomm) & bind (c, name = 't8_cmesh_new_periodic_tri_wrap') - use, intrinsic :: ISO_C_BINDING, only: c_ptr - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none type (c_ptr), value :: Ccomm end function t8_cmesh_new_periodic_tri_f - end Interface - - Interface - integer (c_int) function t8_cmesh_vtk_write_file_f (cmesh, fileprefix, scale) & - bind (c, name = 't8_cmesh_vtk_write_file') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int, c_char, c_double - IMPLICIT NONE - type (c_ptr), value :: cmesh - character (c_char) :: fileprefix - real (c_double), value :: scale - end function t8_cmesh_vtk_write_file_f - end Interface + end interface - Interface + interface subroutine t8_cmesh_destroy_f (cmesh) & bind (c, name = 't8_cmesh_destroy') - use, intrinsic :: ISO_C_BINDING, only: c_ptr - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none type (c_ptr) :: cmesh end subroutine t8_cmesh_destroy_f - end Interface + end interface - Interface + interface subroutine t8_fortran_cmesh_init_f (cmesh) & bind (c, name = 't8_cmesh_init') - use, intrinsic :: ISO_C_BINDING, only: c_ptr - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none type (c_ptr) :: cmesh end subroutine t8_fortran_cmesh_init_f - end Interface + end interface - Interface + interface type (c_ptr) function t8_fortran_geometry_linear_new_f (dimension) & bind (c, name = 't8_geometry_linear_new') - use, intrinsic :: ISO_C_BINDING, only: c_int, c_ptr - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_int, c_ptr + implicit none integer (c_int), value :: dimension end function t8_fortran_geometry_linear_new_f - end Interface + end interface - Interface + interface subroutine t8_fortran_cmesh_register_geometry_f (cmesh, geometry) & bind (c, name = 't8_cmesh_register_geometry') - use, intrinsic :: ISO_C_BINDING, only: c_ptr - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none type (c_ptr), value :: cmesh type (c_ptr), value :: geometry end subroutine t8_fortran_cmesh_register_geometry_f - end Interface + end interface - Interface + interface subroutine t8_fortran_cmesh_set_tree_class_f (cmesh, gtree_id, tree_class) & bind (c, name = 't8_cmesh_set_tree_class') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int64_t, c_int - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr, c_int64_t, c_int + implicit none type (c_ptr), value :: cmesh integer (c_int64_t), value :: gtree_id integer (c_int), value :: tree_class end subroutine t8_fortran_cmesh_set_tree_class_f - end Interface + end interface - Interface + interface subroutine t8_fortran_cmesh_set_tree_vertices_f (cmesh, ltree_id, vertices, num_vertices) & bind (c, name = 't8_cmesh_set_tree_vertices') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int, c_int64_t - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_int64_t + implicit none type (c_ptr), value :: cmesh integer (c_int64_t), value :: ltree_id type(c_ptr),value :: vertices integer (c_int), value :: num_vertices end subroutine t8_fortran_cmesh_set_tree_vertices_f - end Interface + end interface - Interface + interface subroutine t8_fortran_cmesh_set_join_f (cmesh, gtree1, gtree2, face1, face2, orientation) & bind (c, name = 't8_cmesh_set_join') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int, c_int64_t - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_int64_t + implicit none type (c_ptr), value :: cmesh integer (c_int64_t), value :: gtree1 integer (c_int64_t), value :: gtree2 @@ -159,169 +147,226 @@ subroutine t8_fortran_cmesh_set_join_f (cmesh, gtree1, gtree2, face1, face2, ori integer (c_int), value :: face2 integer (c_int), value :: orientation end subroutine t8_fortran_cmesh_set_join_f - end Interface - - Interface - subroutine t8_fortran_cmesh_set_join_by_vertices_noConn_f (cmesh, ntrees, eclasses, vertices, do_both_directions) & - bind (c, name = 't8_fortran_cmesh_set_join_by_vertices_noConn') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int - IMPLICIT NONE + end interface + + interface + subroutine t8_fortran_cmesh_set_join_by_vertices_noConn_f (cmesh, ntrees, eclasses, vertices, & + connectivity, do_both_directions) bind (c, name = 't8_cmesh_set_join_by_vertices') + use, intrinsic :: iso_c_binding, only: c_ptr, c_int + implicit none type (c_ptr), value :: cmesh integer (c_int), value :: ntrees type (c_ptr), value :: eclasses type (c_ptr), value :: vertices + type (c_ptr), value :: connectivity integer (c_int), value :: do_both_directions end subroutine t8_fortran_cmesh_set_join_by_vertices_noConn_f - end Interface + end interface - Interface + interface subroutine t8_fortran_cmesh_commit_f (cmesh, Ccom) & bind (c, name = 't8_fortran_cmesh_commit') - use, intrinsic :: ISO_C_BINDING, only: c_ptr - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none type (c_ptr), value :: cmesh type (c_ptr), value :: Ccom end subroutine t8_fortran_cmesh_commit_f - end Interface + end interface - Interface + interface type (c_ptr) function t8_forest_new_uniform_default_f (cmesh, level, do_face_ghost, Ccomm) & bind (c, name = 't8_forest_new_uniform_default') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr, c_int + implicit none type (c_ptr), value :: cmesh integer (c_int), value :: level integer (c_int), value :: do_face_ghost type (c_ptr), value :: Ccomm end function t8_forest_new_uniform_default_f - end Interface - + end interface - Interface + interface subroutine t8_forest_unref_f (forest) & bind (c, name = 't8_forest_unref') - use, intrinsic :: ISO_C_BINDING, only: c_ptr - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr + implicit none type (c_ptr) :: forest end subroutine t8_forest_unref_f - end Interface - + end interface - Interface - integer (c_int) function t8_forest_write_vtk_f (forest, fileprefix) & - bind (c, name = 't8_forest_write_vtk') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int, c_char, c_double - IMPLICIT NONE - type (c_ptr), value :: forest - character (c_char) :: fileprefix - end function t8_forest_write_vtk_f - end Interface - - Interface - subroutine t8_forest_iterate_replace_f (forest_new, forest_old, replace_fn) & - bind (c, name = 't8_forest_iterate_replace') - use, intrinsic :: ISO_C_BINDING, only: c_ptr - IMPLICIT NONE - type (c_ptr), value :: forest_new - type (c_ptr), value :: forest_old - type (c_ptr), value :: replace_fn - end subroutine t8_forest_iterate_replace_f - end Interface - - Interface + interface integer (c_int) function t8_forest_get_local_num_leaf_elements (forest) & bind (c, name = 't8_forest_get_local_num_leaf_elements') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr, c_int + implicit none type (c_ptr), value :: forest end function t8_forest_get_local_num_leaf_elements - end Interface + end interface - Interface + interface integer (c_int) function t8_forest_get_global_num_elements (forest) & - bind (c, name = 't8_forest_get_global_num_elements') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int - IMPLICIT NONE + bind (c, name = 't8_forest_get_global_num_leaf_elements') + use, intrinsic :: iso_c_binding, only: c_ptr, c_int + implicit none type (c_ptr), value :: forest end function t8_forest_get_global_num_elements - end Interface + end interface - Interface + interface integer (c_int) function t8_forest_get_num_local_trees (forest) & bind (c, name = 't8_forest_get_num_local_trees') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr, c_int + implicit none type (c_ptr), value :: forest end function t8_forest_get_num_local_trees - end Interface + end interface - Interface + interface integer (c_int) function t8_forest_get_tree_num_elements (forest, ltreeid) & - bind (c, name = 't8_forest_get_tree_num_elements') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int - IMPLICIT NONE + bind (c, name = 't8_forest_get_tree_num_leaf_elements') + use, intrinsic :: iso_c_binding, only: c_ptr, c_int + implicit none type (c_ptr), value :: forest integer (c_int), value :: ltreeid end function t8_forest_get_tree_num_elements - end Interface + end interface - Interface + interface type (c_ptr) function t8_forest_get_element_in_tree (forest, ltreeid, leid_in_tree) & - bind (c, name = 't8_forest_get_element_in_tree') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int - IMPLICIT NONE + bind (c, name = 't8_forest_get_leaf_element_in_tree') + use, intrinsic :: iso_c_binding, only: c_ptr, c_int + implicit none type (c_ptr), value :: forest integer (c_int), value :: ltreeid, leid_in_tree end function t8_forest_get_element_in_tree - end Interface + end interface - Interface + interface subroutine t8_forest_element_from_ref_coords (forest, ltreeid, element, ref_coords, num_coords, coords_out) & bind (c, name = 't8_forest_element_from_ref_coords') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int, c_double - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_double + implicit none type (c_ptr), value :: forest, element integer (c_int), value :: ltreeid, num_coords real (c_double), dimension(3) :: ref_coords, coords_out end subroutine t8_forest_element_from_ref_coords - end Interface + end interface - Interface + interface subroutine t8_global_productionf_noargs_f (string) & bind (c, name = 't8_global_productionf_noargs') - use, intrinsic :: ISO_C_BINDING, only: c_char - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_char + implicit none character (c_char) :: string end subroutine t8_global_productionf_noargs_f - end Interface + end interface - Interface + interface subroutine t8_fortran_finalize_f () & bind (c, name = 't8_fortran_finalize') - IMPLICIT NONE + implicit none end subroutine t8_fortran_finalize_f - end Interface - - Interface - type (c_ptr) function t8_fortran_adapt_by_coordinates_f (forest, recursive, callback) & - bind (c, name = 't8_fortran_adapt_by_coordinates') - use, intrinsic :: ISO_C_BINDING, only : c_ptr, c_int - IMPLICIT NONE - type (c_ptr), value :: forest - integer (c_int), value :: recursive - type (c_ptr), value :: callback - end function t8_fortran_adapt_by_coordinates_f - end Interface - - Interface - subroutine t8_fortran_element_volume_f (forest, ltreeid, element) & + end interface + + interface + function t8_fortran_adapt(forest, fortran_callback, recursive) result(new_forest) & + bind (c, name = 't8_fortran_adapt_c') + import :: c_funptr, c_ptr, c_int + type(c_ptr), value :: forest + type(c_funptr), value :: fortran_callback + integer (c_int), value :: recursive + type (c_ptr) :: new_forest + end function t8_fortran_adapt + end interface + + interface + function t8_fortran_adapt_by_coordinates_f (forest, recursive, callback) result(new_forest) & + bind (c, name = 't8_forest_adapt_by_coordinates') + use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_funptr + implicit none + type (c_ptr), value :: forest + integer (c_int), value :: recursive + type(c_funptr), value :: callback + type (c_ptr) :: new_forest + end function t8_fortran_adapt_by_coordinates_f + end interface + + interface + subroutine t8_fortran_element_volume_f (forest, ltreeid, element) & bind (c, name = 't8_forest_element_volume') - use, intrinsic :: ISO_C_BINDING, only: c_ptr, c_int - IMPLICIT NONE + use, intrinsic :: iso_c_binding, only: c_ptr, c_int + implicit none type (c_ptr), value :: forest integer (c_int), value :: ltreeid type (c_ptr), value :: element end subroutine t8_fortran_element_volume_f - end Interface - -End module t8_fortran_interface_mod + end interface + +contains + + ! This function wraps t8_forest_write_vtk, passing back an error flag instead of true/false, so non-zero means + ! fail, zero success. + function t8_forest_write_vtk_f(forest, fileprefix) result(ierror) + implicit none + type (c_ptr), value :: forest + character (c_char) :: fileprefix + integer (c_int) :: ierror + integer (c_int) :: retValue + + ! Local binding to C function t8_forest_write_vtk. + interface + integer (c_int) function t8_forest_write_vtk_c (forest, fileprefix) & + bind (c, name = 't8_forest_write_vtk') + use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_char, c_double + implicit none + type (c_ptr), value :: forest + character (c_char) :: fileprefix + end function t8_forest_write_vtk_c + end interface + + ! Call c function. + retValue = t8_forest_write_vtk_c(forest, fileprefix) + + ! Convert return value of C function to the error flag returned by the Fortran function. + if( retValue.eq.0) then + ierror = 1 + else + ierror = 0 + end if + + end function t8_forest_write_vtk_f + + ! This function wraps t8_cmesh_vtk_write_file, passing back an error flag instead of true/false, so non-zero means + ! fail, zero success. + function t8_cmesh_vtk_write_file_f(cmesh, fileprefix) result(ierror) + use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_char, c_double + implicit none + type (c_ptr), value :: cmesh + character (c_char) :: fileprefix + integer (c_int) :: ierror + integer (c_int) :: retValue + + ! Local binding to C function t8_cmesh_vtk_write_file. + interface + integer (c_int) function t8_cmesh_vtk_write_file_c (cmesh, fileprefix) & + bind (c, name = 't8_cmesh_vtk_write_file') + use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_char, c_double + implicit none + type (c_ptr), value :: cmesh + character (c_char) :: fileprefix + end function t8_cmesh_vtk_write_file_c + end interface + + ! Call c function. + retValue = t8_cmesh_vtk_write_file_c(cmesh, fileprefix) + + ! Convert return value of C function to the error flag returned by the Fortran function. + if( retValue.eq.0) then + ierror = 1 + else + ierror = 0 + end if + + end function t8_cmesh_vtk_write_file_f + +end module t8_fortran_interface_mod diff --git a/cmake/CodeCoverage.cmake b/cmake/CodeCoverage.cmake index a08a300b16..a78dbabdea 100644 --- a/cmake/CodeCoverage.cmake +++ b/cmake/CodeCoverage.cmake @@ -103,6 +103,6 @@ endfunction() # setup_target_for_coverage append_coverage_compiler_flags() setup_target_for_coverage( NAME coverage - EXCLUDE "${CMAKE_SOURCE_DIR}/sc*" "${CMAKE_SOURCE_DIR}/p4est*" "${CMAKE_SOURCE_DIR}/test*" "${CMAKE_SOURCE_DIR}/thirdparty*" "${CMAKE_SOURCE_DIR}/tutorials*" "${CMAKE_SOURCE_DIR}/example*" "${CMAKE_SOURCE_DIR}/benchmarks*" + EXCLUDE "${CMAKE_SOURCE_DIR}/sc*" "${CMAKE_SOURCE_DIR}/p4est*" "${CMAKE_SOURCE_DIR}/test*" "${CMAKE_SOURCE_DIR}/thirdparty*" "${CMAKE_SOURCE_DIR}/tutorials*" "${CMAKE_SOURCE_DIR}/example*" "${CMAKE_SOURCE_DIR}/benchmarks*" "${CMAKE_SOURCE_DIR}/CMakeFortranCompilerId.F" "${CMAKE_BINARY_DIR}/*" LCOV_ARGS --no-external --ignore-errors gcov ) \ No newline at end of file diff --git a/src/t8_vtk/t8_vtk_writer.h b/src/t8_vtk/t8_vtk_writer.h index 0b1ccf1567..0383c2fa6a 100644 --- a/src/t8_vtk/t8_vtk_writer.h +++ b/src/t8_vtk/t8_vtk_writer.h @@ -140,7 +140,7 @@ t8_cmesh_vtk_write_file_via_API (t8_cmesh_t cmesh, const char *fileprefix, sc_MP * * \param[in] cmesh The cmesh * \param[in] fileprefix The prefix of the output files - * \return 0 if successful, non-zero otherwise + * \return True (nonzero) if successful, false (zero) otherwise */ int t8_cmesh_vtk_write_file (t8_cmesh_t cmesh, const char *fileprefix); diff --git a/src/t8_vtk/t8_vtk_writer.hxx b/src/t8_vtk/t8_vtk_writer.hxx index 2e8c1b8aa0..aae073b48a 100644 --- a/src/t8_vtk/t8_vtk_writer.hxx +++ b/src/t8_vtk/t8_vtk_writer.hxx @@ -131,8 +131,7 @@ struct vtk_writer * A vtk-writer function that uses the vtk API * * \param[in] grid The forest or cmesh that is translated - * \return true - * \return false + * \return True if successful, false if not */ bool write_ASCII (const grid_t grid); diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 70ec3c3a37..e9a631f74a 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -202,7 +202,10 @@ add_t8_cpp_test( NAME t8_gtest_face_corner_serial SOURCES t8_schemes/t add_t8_cpp_test( NAME t8_gtest_set_linear_id_serial SOURCES t8_schemes/t8_gtest_set_linear_id.cxx ) add_t8_cpp_test( NAME t8_gtest_elements_are_family_serial SOURCES t8_schemes/t8_gtest_elements_are_family.cxx ) if( T8CODE_BUILD_FORTRAN_INTERFACE AND T8CODE_ENABLE_MPI ) + add_t8_test( NAME t8_test_fortran_mpi_interface_init_serial SOURCES api/t8_fortran_interface/t8_test_init_no_mpi.f90 ) add_t8_test( NAME t8_test_fortran_mpi_interface_init_parallel SOURCES api/t8_fortran_interface/t8_test_mpi_init.f90 ) + add_t8_test( NAME t8_test_fortran_mpi_interface_cmesh_parallel SOURCES api/t8_fortran_interface/t8_test_cmesh.f90 ) + add_t8_test( NAME t8_test_fortran_mpi_interface_forest_parallel SOURCES api/t8_fortran_interface/t8_test_forest.f90 ) endif() add_t8_cpp_test( NAME t8_gtest_vector_split_serial SOURCES t8_helper_functions/t8_gtest_vector_split.cxx ) diff --git a/test/api/t8_fortran_interface/t8_test_cmesh.f90 b/test/api/t8_fortran_interface/t8_test_cmesh.f90 new file mode 100644 index 0000000000..a32de54c63 --- /dev/null +++ b/test/api/t8_fortran_interface/t8_test_cmesh.f90 @@ -0,0 +1,117 @@ +!! This file is part of t8code. +!! t8code is a C library to manage a collection (a forest) of multiple +!! connected adaptive space-trees of general element classes in parallel. +!! +!! Copyright (C) 2026 the developers +!! +!! t8code is free software; you can redistribute it and/or modify +!! it under the terms of the GNU General Public License as published by +!! the Free Software Foundation; either version 2 of the License, or +!! (at your option) any later version. +!! +!! t8code is distributed in the hope that it will be useful, +!! but WITHOUT ANY WARRANTY; without even the implied warranty of +!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!! GNU General Public License for more details. +!! +!! You should have received a copy of the GNU General Public License +!! along with t8code; if not, write to the Free Software Foundation, Inc., +!! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +!! Description: +!! +!! This program tests if the cmesh part of the Fortran +!! interface can be called. +!! Works only when MPI is enabled. + +program t8_test_cmesh + use mpi + use iso_c_binding, only: c_ptr, c_int, c_char, c_double + use t8_fortran_interface_mod + + implicit none + + integer :: ierror, fcomm + type(c_ptr) :: ccomm, cmesh, geometry + real(c_double), target :: vertices_tri_0(9), vertices_tri_1(9), vertices_total(18) + integer(c_int), target :: eclasses(2) + character(len=256, kind=c_char) :: vtk_prefix + + call MPI_Init (ierror) + + if (ierror /= 0) then + print *, 'MPI initialization failed.' + stop 1 + endif + + fcomm = MPI_COMM_WORLD + ccomm = t8_fortran_mpi_comm_new_f (fcomm) + call t8_fortran_init_all_f (ccomm) + + cmesh = t8_cmesh_new_periodic_tri_f (ccomm) + + ! Test vtk output + write(*,*) 'Start cmesh vtk output' + vtk_prefix = "fortran_cmesh_to_vtk" // c_null_char + ierror = t8_cmesh_vtk_write_file_f(cmesh, vtk_prefix) + if (ierror /= 0) then + print *, 'cmesh VTK output failed.' + stop 1 + endif + write(*,*) 'Finished cmesh vtk output' + call t8_cmesh_destroy_f(cmesh) + + write(*,*) 'Destroyed mesh' + vertices_tri_0 = [0.0_c_double, 0.0_c_double, 0.0_c_double, & + 1.0_c_double, 0.0_c_double, 0.0_c_double, & + 1.0_c_double, 1.0_c_double, 0.0_c_double] + + vertices_tri_1 = [0.0_c_double, 0.0_c_double, 0.0_c_double, & + 1.0_c_double, 1.0_c_double, 0.0_c_double, & + 0.0_c_double, 1.0_c_double, 0.0_c_double] + vertices_total = [vertices_tri_0, vertices_tri_1] + + !! Create a test quad mesh with 2 triangles in a square + call t8_fortran_cmesh_init_f(cmesh) + write(*,*) 'initialized new mesh' + !! Create and register a geometry for linear triangles + geometry = t8_fortran_geometry_linear_new_f (2) + call t8_fortran_cmesh_register_geometry_f(cmesh, geometry) + !! Set tree class + call t8_fortran_cmesh_set_tree_class_f(cmesh, int(0, kind=8), 3) + call t8_fortran_cmesh_set_tree_class_f(cmesh, int(1, kind=8), 3) + !! Set tree vertices for the two triangles + call t8_fortran_cmesh_set_tree_vertices_f(cmesh, int(0, kind=8), c_loc(vertices_tri_0), 3) + call t8_fortran_cmesh_set_tree_vertices_f(cmesh, int(1, kind=8), c_loc(vertices_tri_1), 3) + !! Set connections between the two triangles + call t8_fortran_cmesh_set_join_f(cmesh, int(0, kind=8), int(1, kind=8), 1, 2, 0) + call t8_fortran_cmesh_commit_f(cmesh, ccomm) + call t8_cmesh_destroy_f(cmesh) + write(*,*) 'destroyed mesh again' + + !! Create the same mesh again, but let t8code find the connectivity + eclasses = [3, 3] + call t8_fortran_cmesh_init_f(cmesh) + geometry = t8_fortran_geometry_linear_new_f (2) + call t8_fortran_cmesh_register_geometry_f(cmesh, geometry) + call t8_fortran_cmesh_set_tree_class_f(cmesh, int(0, kind=8), 3) + call t8_fortran_cmesh_set_tree_class_f(cmesh, int(1, kind=8), 3) + call t8_fortran_cmesh_set_tree_vertices_f(cmesh, int(0, kind=8), c_loc(vertices_tri_0), 3) + call t8_fortran_cmesh_set_tree_vertices_f(cmesh, int(1, kind=8), c_loc(vertices_tri_1), 3) + call t8_fortran_cmesh_set_join_by_vertices_noConn_f(cmesh, 2, c_loc(eclasses), c_loc(vertices_total), C_NULL_PTR, 0) + call t8_fortran_cmesh_commit_f(cmesh, ccomm) + call t8_cmesh_destroy_f(cmesh) + write(*,*) 'destroyed mesh a third time' + + call t8_fortran_finalize_f () + call t8_fortran_mpi_comm_delete_f(ccomm) + call MPI_Finalize(ierror) + + if (ierror /= 0) then + print *, 'MPI Finalize failed.' + stop 1 + endif + print *, 'All good!' + stop 0 + +end program diff --git a/test/api/t8_fortran_interface/t8_test_forest.f90 b/test/api/t8_fortran_interface/t8_test_forest.f90 new file mode 100644 index 0000000000..d729ad2389 --- /dev/null +++ b/test/api/t8_fortran_interface/t8_test_forest.f90 @@ -0,0 +1,98 @@ +!! This file is part of t8code. +!! t8code is a C library to manage a collection (a forest) of multiple +!! connected adaptive space-trees of general element classes in parallel. +!! +!! Copyright (C) 2026 the developers +!! +!! t8code is free software; you can redistribute it and/or modify +!! it under the terms of the GNU General Public License as published by +!! the Free Software Foundation; either version 2 of the License, or +!! (at your option) any later version. +!! +!! t8code is distributed in the hope that it will be useful, +!! but WITHOUT ANY WARRANTY; without even the implied warranty of +!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!! GNU General Public License for more details. +!! +!! You should have received a copy of the GNU General Public License +!! along with t8code; if not, write to the Free Software Foundation, Inc., +!! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +!! Description: +!! +!! This program tests if the forest part of the Fortran +!! interface can be called. +!! Works only when MPI is enabled. + +program t8_test_forest + use mpi + use iso_c_binding, only: c_ptr, c_int, c_char + use t8_fortran_interface_mod + use t8_fortran_example_adapt_mod + + implicit none + + integer :: ierror, fcomm + integer :: num_local_elements, num_global_elements, num_local_trees + type(c_ptr) :: ccomm, cmesh, forest, element, adapted_forest + integer :: num_elems_in_tree, ltree_id + real(c_double) :: ref_coords(3), out_coords(3) + character(len=256, kind=c_char) :: vtk_prefix + type(c_funptr) :: c_adapt_callback_ptr + + call MPI_Init (ierror) + + if (ierror /= 0) then + write(*,*) 'MPI initialization failed.' + stop 1 + endif + + fcomm = MPI_COMM_WORLD + ccomm = t8_fortran_mpi_comm_new_f (fcomm) + call t8_fortran_init_all_f (ccomm) + + cmesh = t8_cmesh_new_periodic_tri_f (ccomm) + forest = t8_forest_new_uniform_default_f (cmesh, 2, 0, ccomm) + num_local_elements = t8_forest_get_local_num_leaf_elements (forest) + num_global_elements = t8_forest_get_global_num_elements (forest) + num_local_trees = t8_forest_get_num_local_trees (forest) + num_elems_in_tree = t8_forest_get_tree_num_elements (forest, 0) + element = t8_forest_get_element_in_tree (forest, 0, 0) + ref_coords = [0.5_c_double, 0.5_c_double, 0.0_c_double] + call t8_forest_element_from_ref_coords (forest, 0, element, ref_coords, 1, out_coords) + ltree_id = 0 + call t8_fortran_element_volume_f(forest, ltree_id, element) + + ! Cast adapt callback into C-compatible function pointer. + c_adapt_callback_ptr = c_funloc(example_fortran_adapt_by_coordinates_callback) + + ! Adapt the forest using the Fortran-defined callback. + write(*,*) '*** Start forest adaptation!' + adapted_forest = t8_fortran_adapt_by_coordinates_f(forest, 0, c_adapt_callback_ptr) + write(*,*) '*** Finished forest adaptation!' + + ! Write out forest + write(*,*) '*** Start forest vtk output!' + vtk_prefix = "fortran_forest_to_vtk" // c_null_char + ierror = t8_forest_write_vtk_f(adapted_forest, vtk_prefix) + if (ierror /= 0) then + write(*,*) 'forest VTK output failed.' + stop 1 + endif + write(*,*) '*** Finished forest vtk output!' + + write(*,*) 'Finalize forest tests.' + call t8_forest_unref_f (adapted_forest) + call t8_fortran_finalize_f () + call t8_fortran_mpi_comm_delete_f(ccomm) + + call MPI_Finalize(ierror) + if (ierror /= 0) then + write(*,*) 'MPI Finalize failed.' + stop 1 + endif + + write(*,*) '' + write(*,*) 'All good!' + stop 0 +end program diff --git a/test/api/t8_fortran_interface/t8_test_init_no_mpi.f90 b/test/api/t8_fortran_interface/t8_test_init_no_mpi.f90 new file mode 100644 index 0000000000..22fbe9347c --- /dev/null +++ b/test/api/t8_fortran_interface/t8_test_init_no_mpi.f90 @@ -0,0 +1,45 @@ +!! This file is part of t8code. +!! t8code is a C library to manage a collection (a forest) of multiple +!! connected adaptive space-trees of general element classes in parallel. +!! +!! Copyright (C) 2024 the developers +!! +!! t8code is free software; you can redistribute it and/or modify +!! it under the terms of the GNU General Public License as published by +!! the Free Software Foundation; either version 2 of the License, or +!! (at your option) any later version. +!! +!! t8code is distributed in the hope that it will be useful, +!! but WITHOUT ANY WARRANTY; without even the implied warranty of +!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!! GNU General Public License for more details. +!! +!! You should have received a copy of the GNU General Public License +!! along with t8code; if not, write to the Free Software Foundation, Inc., +!! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + +!! Description: +!! +!! This program tests if t8code can be initialized from Fortran +!! without MPI communicator. + +program t8_test_init_no_mpi + use mpi + use iso_c_binding, only: c_ptr, c_int + use t8_fortran_interface_mod + + implicit none + + ! Init Fortran interface without MPI, i.e., sc_MPI_COMM_NULL communicator. + call t8_fortran_init_all_noMPI_f() + + ! Test t8_global_productionf_noargs_f + call t8_global_productionf_noargs_f("This string was written by t8_global_productionf_noargs_f()") + + ! Finalize + call t8_fortran_finalize_f () + + print *, 'All good!' + stop 0 + +end program