From 3e9ce93658010680d27037968f483bce9c8d75b3 Mon Sep 17 00:00:00 2001 From: Alistair Pirrie <187289694+mo-alistairp@users.noreply.github.com> Date: Fri, 10 Apr 2026 16:27:58 +0100 Subject: [PATCH 01/10] Replace invoke_X_innerproduct_ --- .../solver/sci_r_solver_field_vector_mod.x90 | 25 +-- .../source/psy/sci_psykal_light_mod.f90 | 149 ------------------ 2 files changed, 14 insertions(+), 160 deletions(-) diff --git a/components/science/source/algorithm/solver/sci_r_solver_field_vector_mod.x90 b/components/science/source/algorithm/solver/sci_r_solver_field_vector_mod.x90 index 88c1905bf..6c1e0c5a7 100644 --- a/components/science/source/algorithm/solver/sci_r_solver_field_vector_mod.x90 +++ b/components/science/source/algorithm/solver/sci_r_solver_field_vector_mod.x90 @@ -118,18 +118,18 @@ contains ! compute the norm of a field vector function norm_field_vector(self) result(normal) - use sci_psykal_light_mod, only: invoke_rdouble_X_innerproduct_X - implicit none class(r_solver_field_vector_type), intent(in) :: self real(kind=r_def) :: normal integer(kind=i_def) :: fctr, nfctr real(kind=r_def) :: field_norm normal = 0.0_r_def + type(field_type) :: tmp nfctr = size(self%vector) do fctr = 1, nfctr - call invoke_rdouble_X_innerproduct_X(field_norm, self%vector(fctr)) + call invoke(real_to_real_x(tmp, self%vector(fctr)), & + X_innerproduct_X(field_norm, tmp)) normal=normal + field_norm end do normal = sqrt(normal) @@ -138,37 +138,40 @@ contains ! compute the norm of a field in the vector function field_norm_field_vector(self, n) result(normal) - use sci_psykal_light_mod, only: invoke_rdouble_X_innerproduct_X - implicit none class(r_solver_field_vector_type), intent(in) :: self integer(kind=i_def), intent(in) :: n real(kind=r_def) :: normal + type(field_type) :: tmp - call invoke_rdouble_X_innerproduct_X(normal, self%vector(n)) + call invoke(real_to_real_x(tmp, self%vector(n)), & + X_innerproduct_X(normal, tmp)) normal = sqrt(normal) end function field_norm_field_vector ! compute the dot of inner product of a field vector function dot_field_vector(self, x) result(dot_prod) - use sci_psykal_light_mod, only: invoke_rdouble_X_innerproduct_Y - implicit none class(r_solver_field_vector_type), intent(in) :: self class(abstract_vector_type), intent(in) :: x real(kind=r_def) :: dot_prod real(kind=r_def) :: inner_prod_field + real(kind=r_def) :: tmp3_scalar integer(kind=i_def) :: fctr, nfctr + type(field_type) :: tmp1, tmp2 select type(x) type is(r_solver_field_vector_type) dot_prod = 0.0_r_def nfctr = size(self%vector) do fctr = 1, nfctr - inner_prod_field = 0.0_r_def - call invoke_rdouble_X_innerproduct_Y( inner_prod_field, self%vector(fctr), x%vector(fctr) ) - dot_prod = dot_prod + inner_prod_field + tmp3_scalar = 0.0_r_def + call invoke(real_to_real_x(tmp1, self%vector(fctr)), & + real_to_real_x(tmp2, x%vector(fctr)), & + X_innerproduct_Y(tmp3_scalar, tmp1, tmp2)) + + dot_prod = dot_prod + tmp3_scalar end do class default write(log_scratch_space,'(A)') & diff --git a/components/science/source/psy/sci_psykal_light_mod.f90 b/components/science/source/psy/sci_psykal_light_mod.f90 index de13f593f..89004a7d2 100644 --- a/components/science/source/psy/sci_psykal_light_mod.f90 +++ b/components/science/source/psy/sci_psykal_light_mod.f90 @@ -65,155 +65,6 @@ subroutine invoke_rtran_halo_exchange(field, depth) end subroutine invoke_rtran_halo_exchange - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Psyclone does not currently have native support for builtins with mixed - ! precision, this will be addressed in https://github.com/stfc/PSyclone/issues/1786 - ! Perform innerproduct of a r_solver precision field in r_double precision - subroutine invoke_rdouble_X_innerproduct_X(field_norm, field) - - use scalar_mod, only: scalar_type - use omp_lib, only: omp_get_thread_num - use omp_lib, only: omp_get_max_threads - use mesh_mod, only: mesh_type - - implicit none - - real(kind=r_def), intent(out) :: field_norm - type(r_solver_field_type), intent(in) :: field - - type(scalar_type) :: global_sum - integer(kind=i_def) :: df - real(kind=r_double), allocatable, dimension(:) :: l_field_norm - integer(kind=i_def) :: th_idx - integer(kind=i_def) :: loop0_start, loop0_stop - integer(kind=i_def) :: nthreads - type(r_solver_field_proxy_type) :: field_proxy - integer(kind=i_def) :: max_halo_depth_mesh - type(mesh_type), pointer :: mesh => null() - ! - ! Determine the number of OpenMP threads - ! - nthreads = omp_get_max_threads() - ! - ! Initialise field and/or operator proxies - ! - field_proxy = field%get_proxy() - ! - ! Create a mesh object - ! - mesh => field_proxy%vspace%get_mesh() - max_halo_depth_mesh = mesh%get_halo_depth() - ! - ! Set-up all of the loop bounds - ! - loop0_start = 1 - loop0_stop = field_proxy%vspace%get_last_dof_owned() - ! - ! Call kernels and communication routines - ! - ! - ! Zero summation variables - ! - field_norm = 0.0_r_def - ALLOCATE (l_field_norm(nthreads)) - l_field_norm = 0.0_r_double - ! - !$omp parallel default(shared), private(df,th_idx) - th_idx = omp_get_thread_num()+1 - !$omp do schedule(static) - DO df=loop0_start,loop0_stop - l_field_norm(th_idx) = l_field_norm(th_idx) + real(field_proxy%data(df),r_double)**2 - END DO - !$omp end do - !$omp end parallel - ! - ! sum the partial results sequentially - ! - DO th_idx=1,nthreads - field_norm = field_norm+real(l_field_norm(th_idx),r_def) - END DO - DEALLOCATE (l_field_norm) - global_sum%value = field_norm - field_norm = global_sum%get_sum() - ! - end subroutine invoke_rdouble_X_innerproduct_X - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Psyclone does not currently have native support for builtins with mixed - ! precision, this will be addressed in https://github.com/stfc/PSyclone/issues/1786 - ! Perform innerproduct of a r_solver precision field in r_def precision - subroutine invoke_rdouble_X_innerproduct_Y(field_norm, field1, field2) - - use scalar_mod, only: scalar_type - use omp_lib, only: omp_get_thread_num - use omp_lib, only: omp_get_max_threads - use mesh_mod, only: mesh_type - - implicit none - - real(kind=r_def), intent(out) :: field_norm - type(r_solver_field_type), intent(in) :: field1, field2 - - type(scalar_type) :: global_sum - integer(kind=i_def) :: df - real(kind=r_double), allocatable, dimension(:) :: l_field_norm - integer(kind=i_def) :: th_idx - integer(kind=i_def) :: loop0_start, loop0_stop - integer(kind=i_def) :: nthreads - type(r_solver_field_proxy_type) :: field1_proxy, field2_proxy - integer(kind=i_def) :: max_halo_depth_mesh - type(mesh_type), pointer :: mesh => null() - ! - ! Determine the number of OpenMP threads - ! - nthreads = omp_get_max_threads() - ! - ! Initialise field and/or operator proxies - ! - field1_proxy = field1%get_proxy() - field2_proxy = field2%get_proxy() - ! - ! Create a mesh object - ! - mesh => field1_proxy%vspace%get_mesh() - max_halo_depth_mesh = mesh%get_halo_depth() - ! - ! Set-up all of the loop bounds - ! - loop0_start = 1 - loop0_stop = field1_proxy%vspace%get_last_dof_owned() - ! - ! Call kernels and communication routines - ! - ! - ! Zero summation variables - ! - field_norm = 0.0_r_def - ALLOCATE (l_field_norm(nthreads)) - l_field_norm = 0.0_r_double - ! - !$omp parallel default(shared), private(df,th_idx) - th_idx = omp_get_thread_num()+1 - !$omp do schedule(static) - DO df=loop0_start,loop0_stop - l_field_norm(th_idx) = l_field_norm(th_idx) + real(field1_proxy%data(df),r_double)*real(field2_proxy%data(df),r_double) - END DO - !$omp end do - !$omp end parallel - ! - ! sum the partial results sequentially - ! - DO th_idx=1,nthreads - field_norm = field_norm+real(l_field_norm(th_idx),r_def) - END DO - DEALLOCATE (l_field_norm) - global_sum%value = field_norm - field_norm = global_sum%get_sum() - ! - end subroutine invoke_rdouble_X_innerproduct_Y - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine invoke_inc_rdefX_plus_rsolverY(X, Y) From 6a58660252aeaba42f198792d21c689605fd06c2 Mon Sep 17 00:00:00 2001 From: Alistair Pirrie <187289694+mo-alistairp@users.noreply.github.com> Date: Fri, 17 Apr 2026 15:53:02 +0100 Subject: [PATCH 02/10] Revert "Replace invoke_X_innerproduct_" (#2) This reverts commit 012c75ec689b9b2d13e3e50233a77cfa37ec716e. --- .../solver/sci_r_solver_field_vector_mod.x90 | 25 ++- .../source/psy/sci_psykal_light_mod.f90 | 149 ++++++++++++++++++ 2 files changed, 160 insertions(+), 14 deletions(-) diff --git a/components/science/source/algorithm/solver/sci_r_solver_field_vector_mod.x90 b/components/science/source/algorithm/solver/sci_r_solver_field_vector_mod.x90 index 6c1e0c5a7..88c1905bf 100644 --- a/components/science/source/algorithm/solver/sci_r_solver_field_vector_mod.x90 +++ b/components/science/source/algorithm/solver/sci_r_solver_field_vector_mod.x90 @@ -118,18 +118,18 @@ contains ! compute the norm of a field vector function norm_field_vector(self) result(normal) + use sci_psykal_light_mod, only: invoke_rdouble_X_innerproduct_X + implicit none class(r_solver_field_vector_type), intent(in) :: self real(kind=r_def) :: normal integer(kind=i_def) :: fctr, nfctr real(kind=r_def) :: field_norm normal = 0.0_r_def - type(field_type) :: tmp nfctr = size(self%vector) do fctr = 1, nfctr - call invoke(real_to_real_x(tmp, self%vector(fctr)), & - X_innerproduct_X(field_norm, tmp)) + call invoke_rdouble_X_innerproduct_X(field_norm, self%vector(fctr)) normal=normal + field_norm end do normal = sqrt(normal) @@ -138,40 +138,37 @@ contains ! compute the norm of a field in the vector function field_norm_field_vector(self, n) result(normal) + use sci_psykal_light_mod, only: invoke_rdouble_X_innerproduct_X + implicit none class(r_solver_field_vector_type), intent(in) :: self integer(kind=i_def), intent(in) :: n real(kind=r_def) :: normal - type(field_type) :: tmp - call invoke(real_to_real_x(tmp, self%vector(n)), & - X_innerproduct_X(normal, tmp)) + call invoke_rdouble_X_innerproduct_X(normal, self%vector(n)) normal = sqrt(normal) end function field_norm_field_vector ! compute the dot of inner product of a field vector function dot_field_vector(self, x) result(dot_prod) + use sci_psykal_light_mod, only: invoke_rdouble_X_innerproduct_Y + implicit none class(r_solver_field_vector_type), intent(in) :: self class(abstract_vector_type), intent(in) :: x real(kind=r_def) :: dot_prod real(kind=r_def) :: inner_prod_field - real(kind=r_def) :: tmp3_scalar integer(kind=i_def) :: fctr, nfctr - type(field_type) :: tmp1, tmp2 select type(x) type is(r_solver_field_vector_type) dot_prod = 0.0_r_def nfctr = size(self%vector) do fctr = 1, nfctr - tmp3_scalar = 0.0_r_def - call invoke(real_to_real_x(tmp1, self%vector(fctr)), & - real_to_real_x(tmp2, x%vector(fctr)), & - X_innerproduct_Y(tmp3_scalar, tmp1, tmp2)) - - dot_prod = dot_prod + tmp3_scalar + inner_prod_field = 0.0_r_def + call invoke_rdouble_X_innerproduct_Y( inner_prod_field, self%vector(fctr), x%vector(fctr) ) + dot_prod = dot_prod + inner_prod_field end do class default write(log_scratch_space,'(A)') & diff --git a/components/science/source/psy/sci_psykal_light_mod.f90 b/components/science/source/psy/sci_psykal_light_mod.f90 index 89004a7d2..de13f593f 100644 --- a/components/science/source/psy/sci_psykal_light_mod.f90 +++ b/components/science/source/psy/sci_psykal_light_mod.f90 @@ -65,6 +65,155 @@ subroutine invoke_rtran_halo_exchange(field, depth) end subroutine invoke_rtran_halo_exchange + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Psyclone does not currently have native support for builtins with mixed + ! precision, this will be addressed in https://github.com/stfc/PSyclone/issues/1786 + ! Perform innerproduct of a r_solver precision field in r_double precision + subroutine invoke_rdouble_X_innerproduct_X(field_norm, field) + + use scalar_mod, only: scalar_type + use omp_lib, only: omp_get_thread_num + use omp_lib, only: omp_get_max_threads + use mesh_mod, only: mesh_type + + implicit none + + real(kind=r_def), intent(out) :: field_norm + type(r_solver_field_type), intent(in) :: field + + type(scalar_type) :: global_sum + integer(kind=i_def) :: df + real(kind=r_double), allocatable, dimension(:) :: l_field_norm + integer(kind=i_def) :: th_idx + integer(kind=i_def) :: loop0_start, loop0_stop + integer(kind=i_def) :: nthreads + type(r_solver_field_proxy_type) :: field_proxy + integer(kind=i_def) :: max_halo_depth_mesh + type(mesh_type), pointer :: mesh => null() + ! + ! Determine the number of OpenMP threads + ! + nthreads = omp_get_max_threads() + ! + ! Initialise field and/or operator proxies + ! + field_proxy = field%get_proxy() + ! + ! Create a mesh object + ! + mesh => field_proxy%vspace%get_mesh() + max_halo_depth_mesh = mesh%get_halo_depth() + ! + ! Set-up all of the loop bounds + ! + loop0_start = 1 + loop0_stop = field_proxy%vspace%get_last_dof_owned() + ! + ! Call kernels and communication routines + ! + ! + ! Zero summation variables + ! + field_norm = 0.0_r_def + ALLOCATE (l_field_norm(nthreads)) + l_field_norm = 0.0_r_double + ! + !$omp parallel default(shared), private(df,th_idx) + th_idx = omp_get_thread_num()+1 + !$omp do schedule(static) + DO df=loop0_start,loop0_stop + l_field_norm(th_idx) = l_field_norm(th_idx) + real(field_proxy%data(df),r_double)**2 + END DO + !$omp end do + !$omp end parallel + ! + ! sum the partial results sequentially + ! + DO th_idx=1,nthreads + field_norm = field_norm+real(l_field_norm(th_idx),r_def) + END DO + DEALLOCATE (l_field_norm) + global_sum%value = field_norm + field_norm = global_sum%get_sum() + ! + end subroutine invoke_rdouble_X_innerproduct_X + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Psyclone does not currently have native support for builtins with mixed + ! precision, this will be addressed in https://github.com/stfc/PSyclone/issues/1786 + ! Perform innerproduct of a r_solver precision field in r_def precision + subroutine invoke_rdouble_X_innerproduct_Y(field_norm, field1, field2) + + use scalar_mod, only: scalar_type + use omp_lib, only: omp_get_thread_num + use omp_lib, only: omp_get_max_threads + use mesh_mod, only: mesh_type + + implicit none + + real(kind=r_def), intent(out) :: field_norm + type(r_solver_field_type), intent(in) :: field1, field2 + + type(scalar_type) :: global_sum + integer(kind=i_def) :: df + real(kind=r_double), allocatable, dimension(:) :: l_field_norm + integer(kind=i_def) :: th_idx + integer(kind=i_def) :: loop0_start, loop0_stop + integer(kind=i_def) :: nthreads + type(r_solver_field_proxy_type) :: field1_proxy, field2_proxy + integer(kind=i_def) :: max_halo_depth_mesh + type(mesh_type), pointer :: mesh => null() + ! + ! Determine the number of OpenMP threads + ! + nthreads = omp_get_max_threads() + ! + ! Initialise field and/or operator proxies + ! + field1_proxy = field1%get_proxy() + field2_proxy = field2%get_proxy() + ! + ! Create a mesh object + ! + mesh => field1_proxy%vspace%get_mesh() + max_halo_depth_mesh = mesh%get_halo_depth() + ! + ! Set-up all of the loop bounds + ! + loop0_start = 1 + loop0_stop = field1_proxy%vspace%get_last_dof_owned() + ! + ! Call kernels and communication routines + ! + ! + ! Zero summation variables + ! + field_norm = 0.0_r_def + ALLOCATE (l_field_norm(nthreads)) + l_field_norm = 0.0_r_double + ! + !$omp parallel default(shared), private(df,th_idx) + th_idx = omp_get_thread_num()+1 + !$omp do schedule(static) + DO df=loop0_start,loop0_stop + l_field_norm(th_idx) = l_field_norm(th_idx) + real(field1_proxy%data(df),r_double)*real(field2_proxy%data(df),r_double) + END DO + !$omp end do + !$omp end parallel + ! + ! sum the partial results sequentially + ! + DO th_idx=1,nthreads + field_norm = field_norm+real(l_field_norm(th_idx),r_def) + END DO + DEALLOCATE (l_field_norm) + global_sum%value = field_norm + field_norm = global_sum%get_sum() + ! + end subroutine invoke_rdouble_X_innerproduct_Y + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine invoke_inc_rdefX_plus_rsolverY(X, Y) From 66b80d14d824e4eb483d8f60e1a81049567bf7e3 Mon Sep 17 00:00:00 2001 From: Alistair Pirrie <187289694+mo-alistairp@users.noreply.github.com> Date: Tue, 21 Apr 2026 15:02:57 +0100 Subject: [PATCH 03/10] Add new PSyKAl to copy into clean halos --- .../psy/sci_psykal_builtin_light_mod.f90 | 75 ++++++++++++++++++- 1 file changed, 74 insertions(+), 1 deletion(-) 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..61bb067f7 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,77 @@ 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_in, field_out) + + use omp_lib, only: omp_get_thread_num + use omp_lib, only: omp_get_max_threads + use mesh_mod, only: mesh_type + use field_type_mod, only: field_type, & + field_proxy_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) :: depth, 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() + ! + ! Find the depth of the last clean halo + ! + do depth=0, field_in_proxy%vspace%get_field_proxy_halo_depth()-1 + ! check if the next halo depth is dirty, if so return the clean depth + if (field_in_proxy%is_dirty(depth=depth+1)) exit + end do + clean_halo_depth = depth + ! + ! Set-up all of the loop bounds + ! + 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/clean for fields modified in the above loop + ! + call field_out_proxy%set_dirty() + if (.not. field_in_proxy%is_dirty(depth=1)) then + call field_out_proxy%set_clean(1) + end if + ! + end subroutine invoke_copy_field_halo + +end module sci_psykal_builtin_light_mod \ No newline at end of file From 8b26bbbe65b48704c60a98e076934556c98870a7 Mon Sep 17 00:00:00 2001 From: Alistair Pirrie <187289694+mo-alistairp@users.noreply.github.com> Date: Tue, 28 Apr 2026 10:56:05 +0100 Subject: [PATCH 04/10] temporarily add my own clean halo depth check --- .../source/psy/sci_psykal_builtin_light_mod.f90 | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) 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 61bb067f7..0dfa25f9a 100644 --- a/components/science/source/psy/sci_psykal_builtin_light_mod.f90 +++ b/components/science/source/psy/sci_psykal_builtin_light_mod.f90 @@ -746,8 +746,6 @@ subroutine invoke_copy_field_halo(field_in, field_out) use omp_lib, only: omp_get_thread_num use omp_lib, only: omp_get_max_threads use mesh_mod, only: mesh_type - use field_type_mod, only: field_type, & - field_proxy_type implicit none @@ -756,7 +754,7 @@ subroutine invoke_copy_field_halo(field_in, field_out) integer(kind=i_def) :: df integer(kind=i_def) :: loop0_start, loop0_stop - integer(kind=i_def) :: depth, clean_halo_depth + 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 @@ -771,7 +769,7 @@ subroutine invoke_copy_field_halo(field_in, field_out) ! mesh => field_out_proxy%vspace%get_mesh() max_halo_depth_mesh = mesh%get_halo_depth() - ! + ! TEMPORARY UNTIL get_clean_depth() is added ! Find the depth of the last clean halo ! do depth=0, field_in_proxy%vspace%get_field_proxy_halo_depth()-1 @@ -779,9 +777,11 @@ subroutine invoke_copy_field_halo(field_in, field_out) if (field_in_proxy%is_dirty(depth=depth+1)) exit end do clean_halo_depth = depth + ! ! Set-up all of the loop bounds ! + ! clean_halo_depth = field_in_proxy%vspace%get_clean_depth() loop0_start = 1 if (clean_halo_depth > 0) then ! only copy the clean halos @@ -801,13 +801,9 @@ subroutine invoke_copy_field_halo(field_in, field_out) !$omp end do !$omp end parallel ! - ! Set halos dirty/clean for fields modified in the above loop + ! Set halos dirty for fields modified in the above loop ! call field_out_proxy%set_dirty() - if (.not. field_in_proxy%is_dirty(depth=1)) then - call field_out_proxy%set_clean(1) - end if - ! end subroutine invoke_copy_field_halo end module sci_psykal_builtin_light_mod \ No newline at end of file From ab6b9b1ff0a3987bab1799394408337c13b4487e Mon Sep 17 00:00:00 2001 From: Alistair Pirrie <187289694+mo-alistairp@users.noreply.github.com> Date: Tue, 28 Apr 2026 11:56:04 +0100 Subject: [PATCH 05/10] Add depth to parameter descriptions --- .../science/source/psy/sci_psykal_builtin_light_mod.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 0dfa25f9a..702ae88b5 100644 --- a/components/science/source/psy/sci_psykal_builtin_light_mod.f90 +++ b/components/science/source/psy/sci_psykal_builtin_light_mod.f90 @@ -754,7 +754,7 @@ subroutine invoke_copy_field_halo(field_in, field_out) integer(kind=i_def) :: df integer(kind=i_def) :: loop0_start, loop0_stop - integer(kind=i_def) :: clean_halo_depth + integer(kind=i_def) :: depth, 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 @@ -772,7 +772,7 @@ subroutine invoke_copy_field_halo(field_in, field_out) ! TEMPORARY UNTIL get_clean_depth() is added ! Find the depth of the last clean halo ! - do depth=0, field_in_proxy%vspace%get_field_proxy_halo_depth()-1 + do depth=0, field_in_proxy%vspace%get_field_halo_depth()-1 ! check if the next halo depth is dirty, if so return the clean depth if (field_in_proxy%is_dirty(depth=depth+1)) exit end do From d18f22b565cf903b2abe6a58461f0c85b65031a2 Mon Sep 17 00:00:00 2001 From: Alistair Pirrie <187289694+mo-alistairp@users.noreply.github.com> Date: Tue, 28 Apr 2026 11:58:01 +0100 Subject: [PATCH 06/10] Change over to use get_clean_depth --- .../source/psy/sci_psykal_builtin_light_mod.f90 | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) 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 702ae88b5..05f6ec129 100644 --- a/components/science/source/psy/sci_psykal_builtin_light_mod.f90 +++ b/components/science/source/psy/sci_psykal_builtin_light_mod.f90 @@ -754,7 +754,7 @@ subroutine invoke_copy_field_halo(field_in, field_out) integer(kind=i_def) :: df integer(kind=i_def) :: loop0_start, loop0_stop - integer(kind=i_def) :: depth, clean_halo_depth + 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 @@ -769,19 +769,10 @@ subroutine invoke_copy_field_halo(field_in, field_out) ! mesh => field_out_proxy%vspace%get_mesh() max_halo_depth_mesh = mesh%get_halo_depth() - ! TEMPORARY UNTIL get_clean_depth() is added - ! Find the depth of the last clean halo - ! - do depth=0, field_in_proxy%vspace%get_field_halo_depth()-1 - ! check if the next halo depth is dirty, if so return the clean depth - if (field_in_proxy%is_dirty(depth=depth+1)) exit - end do - clean_halo_depth = depth - ! ! Set-up all of the loop bounds ! - ! clean_halo_depth = field_in_proxy%vspace%get_clean_depth() + clean_halo_depth = field_in_proxy%vspace%get_clean_depth() loop0_start = 1 if (clean_halo_depth > 0) then ! only copy the clean halos From 4f3497b7b68f9a967a1847341605169d6d265225 Mon Sep 17 00:00:00 2001 From: Alistair Pirrie <187289694+mo-alistairp@users.noreply.github.com> Date: Wed, 29 Apr 2026 16:22:25 +0100 Subject: [PATCH 07/10] Correct the get_clean_depth() call --- components/science/source/psy/sci_psykal_builtin_light_mod.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 05f6ec129..0b9edf600 100644 --- a/components/science/source/psy/sci_psykal_builtin_light_mod.f90 +++ b/components/science/source/psy/sci_psykal_builtin_light_mod.f90 @@ -772,7 +772,7 @@ subroutine invoke_copy_field_halo(field_in, field_out) ! ! Set-up all of the loop bounds ! - clean_halo_depth = field_in_proxy%vspace%get_clean_depth() + clean_halo_depth = field_in_proxy%get_clean_depth() loop0_start = 1 if (clean_halo_depth > 0) then ! only copy the clean halos From 0b03870ba1ac33aa3db23a0d53f9ce6229115705 Mon Sep 17 00:00:00 2001 From: Alistair Pirrie <187289694+mo-alistairp@users.noreply.github.com> Date: Thu, 30 Apr 2026 13:53:08 +0100 Subject: [PATCH 08/10] Delete copy_field_halo_kernel_mod and its test --- .../algebra/copy_field_halo_kernel_mod.F90 | 72 ------------------- .../copy_field_halo_kernel_mod_test.pf | 36 ---------- 2 files changed, 108 deletions(-) delete mode 100644 components/science/source/kernel/algebra/copy_field_halo_kernel_mod.F90 delete mode 100644 components/science/unit-test/kernel/algebra/copy_field_halo_kernel_mod_test.pf 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/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 From c3eb183af5bc679ced22272bcd4a343d8830d99d Mon Sep 17 00:00:00 2001 From: Alistair Pirrie <187289694+mo-alistairp@users.noreply.github.com> Date: Thu, 30 Apr 2026 14:24:31 +0100 Subject: [PATCH 09/10] Add a set_clean --- components/science/source/psy/sci_psykal_builtin_light_mod.f90 | 3 +++ 1 file changed, 3 insertions(+) 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 0b9edf600..8c4a6466a 100644 --- a/components/science/source/psy/sci_psykal_builtin_light_mod.f90 +++ b/components/science/source/psy/sci_psykal_builtin_light_mod.f90 @@ -795,6 +795,9 @@ subroutine invoke_copy_field_halo(field_in, field_out) ! 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 From dde8d0f5c7f9d0c8a56e1f10c8925ad3a73a75f9 Mon Sep 17 00:00:00 2001 From: Alistair Pirrie <187289694+mo-alistairp@users.noreply.github.com> Date: Thu, 30 Apr 2026 15:09:12 +0100 Subject: [PATCH 10/10] Flip the order of the input/output --- components/science/source/psy/sci_psykal_builtin_light_mod.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 8c4a6466a..0438e4b12 100644 --- a/components/science/source/psy/sci_psykal_builtin_light_mod.f90 +++ b/components/science/source/psy/sci_psykal_builtin_light_mod.f90 @@ -741,7 +741,7 @@ end subroutine invoke_copy_field_64_64 ! 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_in, field_out) + 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