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 deleted file mode 100644 index 9c62670db..000000000 --- a/components/science/source/kernel/algebra/copy_field_halo_kernel_mod.F90 +++ /dev/null @@ -1,72 +0,0 @@ -!------------------------------------------------------------------------------- -! (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/source/psy/sci_psykal_builtin_light_mod.f90 b/components/science/source/psy/sci_psykal_builtin_light_mod.f90 index 6ec844a43..0438e4b12 100644 --- a/components/science/source/psy/sci_psykal_builtin_light_mod.f90 +++ b/components/science/source/psy/sci_psykal_builtin_light_mod.f90 @@ -737,4 +737,67 @@ subroutine invoke_copy_field_64_64(fsrce_64, fdest_64) ! end subroutine invoke_copy_field_64_64 -end module sci_psykal_builtin_light_mod + !--------------------------------------------------------------------- + ! This is a PSyKAl-lite implementation of a built-in that will be + ! implemented under PSyclone issue #3398. See that issue for further + ! details. + subroutine invoke_copy_field_halo(field_out, field_in) + + use omp_lib, only: omp_get_thread_num + use omp_lib, only: omp_get_max_threads + use mesh_mod, only: mesh_type + + implicit none + + type(field_type), intent(in) :: field_in + type(field_type), intent(inout) :: field_out + + integer(kind=i_def) :: df + integer(kind=i_def) :: loop0_start, loop0_stop + integer(kind=i_def) :: clean_halo_depth + type(field_proxy_type) :: field_in_proxy + type(field_proxy_type) :: field_out_proxy + integer(kind=i_def) :: max_halo_depth_mesh + type(mesh_type), pointer :: mesh => null() + ! + ! Initialise field and/or operator proxies + ! + field_in_proxy = field_in%get_proxy() + field_out_proxy = field_out%get_proxy() + ! + ! Create a mesh object + ! + mesh => field_out_proxy%vspace%get_mesh() + max_halo_depth_mesh = mesh%get_halo_depth() + ! + ! Set-up all of the loop bounds + ! + clean_halo_depth = field_in_proxy%get_clean_depth() + loop0_start = 1 + if (clean_halo_depth > 0) then + ! only copy the clean halos + loop0_stop = field_out_proxy%vspace%get_last_dof_halo(clean_halo_depth) + else + ! if there are no clean halos copy only owned DoFs + loop0_stop = field_out_proxy%vspace%get_last_dof_owned() + end if + ! + ! Call kernels and communication routines + ! + !$omp parallel default(shared), private(df) + !$omp do schedule(static) + do df=loop0_start,loop0_stop + field_out_proxy%data(df) = field_in_proxy%data(df) + end do + !$omp end do + !$omp end parallel + ! + ! Set halos dirty for fields modified in the above loop + ! + call field_out_proxy%set_dirty() + if (clean_halo_depth > 0) then + call field_out_proxy%set_clean(clean_halo_depth) + end if + end subroutine invoke_copy_field_halo + +end module sci_psykal_builtin_light_mod \ No newline at end of file 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 deleted file mode 100644 index ed66bab62..000000000 --- a/components/science/unit-test/kernel/algebra/copy_field_halo_kernel_mod_test.pf +++ /dev/null @@ -1,36 +0,0 @@ -!----------------------------------------------------------------------------- -! (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