diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 8fbcb1c91..e1a1465b4 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -22,4 +22,5 @@ | MetBenjaminWent | Benjamin Went | Met Office | 2026-01-30 | | jcsmeto | James Cunningham-Smith | Met Office | 2026-02-06 | | thomasmelvin | Thomas Melvin | Met Office | 2026-01-15 | -| ericaneininger | Erica Neininger | Met Office | 2026-03-02 | \ No newline at end of file +| ericaneininger | Erica Neininger | Met Office | 2026-03-02 | +| iboutle | Ian Boutle | Met Office | 2026-03-06 | \ No newline at end of file diff --git a/components/science/source/algorithm/sci_geometric_constants_mod.x90 b/components/science/source/algorithm/sci_geometric_constants_mod.x90 index 524ee5622..65234a124 100644 --- a/components/science/source/algorithm/sci_geometric_constants_mod.x90 +++ b/components/science/source/algorithm/sci_geometric_constants_mod.x90 @@ -785,6 +785,7 @@ contains type(field_type), pointer :: dA_at_w2 type(function_space_type), pointer :: w2_fs integer(tik) :: id + integer(kind=i_def) :: depth ! Initialise inventory if it hasn't been done so already if (.not. dx_at_w2_inventory%is_initialised()) then @@ -802,7 +803,8 @@ contains if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) - call dx_at_w2_inventory%add_field(dx_at_w2, w2_fs, mesh) + depth = mesh%get_halo_depth() + call dx_at_w2_inventory%add_field(dx_at_w2, w2_fs, mesh, halo_depth=depth) call invoke( X_divideby_Y(dx_at_w2, detj_at_w2, dA_at_w2) ) if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) @@ -1272,6 +1274,7 @@ contains type(field_type), pointer :: height character(len=str_def) :: inventory_name integer(tik) :: id + integer(kind=i_def) :: depth ! Determine inventory based on space select case (space_id) @@ -1312,8 +1315,9 @@ contains if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) + depth = mesh%get_halo_depth() space => function_space_collection%get_fs(mesh, 0, 0, space_id) - call inventory%add_field(height, space, mesh) + call inventory%add_field(height, space, mesh, halo_depth=depth) call invoke( get_height_kernel_type(height, chi, scaled_radius) ) diff --git a/components/science/source/kernel/algebra/copy_field_halo_kernel_mod.F90 b/components/science/source/kernel/algebra/copy_field_halo_kernel_mod.F90 new file mode 100644 index 000000000..9c62670db --- /dev/null +++ b/components/science/source/kernel/algebra/copy_field_halo_kernel_mod.F90 @@ -0,0 +1,72 @@ +!------------------------------------------------------------------------------- +! (c) Crown copyright 2026 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!------------------------------------------------------------------------------- +!> @brief Copy a field to specified halo depth + +module copy_field_halo_kernel_mod + + use argument_mod, only: arg_type, & + GH_FIELD, GH_REAL, & + GH_READ, GH_WRITE, & + OWNED_AND_HALO_CELL_COLUMN,& + ANY_DISCONTINUOUS_SPACE_1 + use constants_mod, only: r_def, i_def + use kernel_mod, only: kernel_type + + implicit none + + private + + !> Kernel metadata for Psyclone + type, public, extends(kernel_type) :: copy_field_halo_kernel_type + private + type(arg_type) :: meta_args(2) = (/ & + arg_type(GH_FIELD, GH_REAL, GH_WRITE, ANY_DISCONTINUOUS_SPACE_1), & + arg_type(GH_FIELD, GH_REAL, GH_READ, ANY_DISCONTINUOUS_SPACE_1) & + /) + integer :: operates_on = OWNED_AND_HALO_CELL_COLUMN + contains + procedure, nopass :: copy_field_halo_code + end type copy_field_halo_kernel_type + + public :: copy_field_halo_code + +contains + + !> @brief Copy field to specified halo depth + !> @param[in] nlayers The number of layers + !> @param[in,out] field_out Output field + !> @param[in] field_in Input field + !> @param[in] ndf Number of degrees of freedom per cell + !> @param[in] undf Number of total degrees of freedom + !> @param[in] map Dofmap for the cell at the base of the column + subroutine copy_field_halo_code(nlayers, & + field_out, & + field_in, & + ndf, undf, map) + + implicit none + + ! Arguments added automatically in call to kernel + integer(kind=i_def), intent(in) :: nlayers + integer(kind=i_def), intent(in) :: ndf, undf + integer(kind=i_def), intent(in), dimension(ndf) :: map + + ! Arguments passed explicitly from algorithm + real(kind=r_def), intent(in), dimension(undf) :: field_in + real(kind=r_def), intent(inout), dimension(undf) :: field_out + + ! Local arguments + integer(kind=i_def) :: k, dof + + do dof = 1, ndf + do k = 0, nlayers-1 + field_out(map(dof)+k) = field_in(map(dof)+k) + end do + end do + + end subroutine copy_field_halo_code + +end module copy_field_halo_kernel_mod diff --git a/components/science/unit-test/kernel/algebra/copy_field_halo_kernel_mod_test.pf b/components/science/unit-test/kernel/algebra/copy_field_halo_kernel_mod_test.pf new file mode 100644 index 000000000..ed66bab62 --- /dev/null +++ b/components/science/unit-test/kernel/algebra/copy_field_halo_kernel_mod_test.pf @@ -0,0 +1,36 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2026 Met Office. All rights reserved. +! For further details please refer to the file LICENCE which you should have +! received as part of this distribution. +!----------------------------------------------------------------------------- +! +!------------------------------------------------------------------------------- +module copy_field_halo_kernel_mod_test + + use constants_mod, only : r_def, i_def + use funit + + implicit none + +contains + + @test + subroutine test_of_copy_field_halo() + + use copy_field_halo_kernel_mod, only : copy_field_halo_code + + implicit none + + real(kind=r_def) :: field_out(3), field_in(3) + real(kind=r_def), parameter :: tol = 1.0e-14_r_def + integer(kind=i_def) :: map(1) + + field_in(:) = [ -10.0_r_def, 0.0_r_def, 10.0_r_def ] + map(:) = [1] + + call copy_field_halo_code(3, field_out, field_in, 1, 3, map) + @assertEqual( field_out, field_in, tol ) + + end subroutine test_of_copy_field_halo + +end module copy_field_halo_kernel_mod_test