From a711bdc56f2038f3bf9691e790765f698b6cadad Mon Sep 17 00:00:00 2001 From: Stefan Rethmeier Date: Sat, 13 Mar 2021 18:36:59 +0000 Subject: [PATCH] Subroutine primary_grid_lengths_global_ext moved from ice_grid module to MPI and serial implementations of ice_boundary modules (https://github.com/CICE-Consortium/CICE/pull/568#discussion_r588472194). Please note duplication of subroutine. --- .../infrastructure/comm/mpi/ice_boundary.F90 | 133 +++++++++++++++++- .../comm/serial/ice_boundary.F90 | 133 +++++++++++++++++- cicecore/cicedynB/infrastructure/ice_grid.F90 | 118 +--------------- 3 files changed, 270 insertions(+), 114 deletions(-) diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 index 884ee6331..590dfa6cd 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 @@ -72,7 +72,8 @@ module ice_boundary ice_HaloUpdate, & ice_HaloUpdate_stress, & ice_HaloExtrapolate, & - ice_HaloDestroy + ice_HaloDestroy, & + primary_grid_lengths_global_ext interface ice_HaloUpdate ! generic interface module procedure ice_HaloUpdate2DR8, & @@ -6733,6 +6734,136 @@ subroutine ice_HaloDestroy(halo) endif end subroutine ice_HaloDestroy +!*********************************************************************** + + subroutine primary_grid_lengths_global_ext( & + ARRAY_O, ARRAY_I, ew_boundary_type, ns_boundary_type) + +! This subroutine adds ghost cells to global primary grid lengths array +! ARRAY_I and outputs result to array ARRAY_O + +! Note duplicate implementation of this subroutine in: +! cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 + + use ice_constants, only: c0 + use ice_domain_size, only: nx_global, ny_global + + real (kind=dbl_kind), dimension(:,:), intent(in) :: & + ARRAY_I + + character (*), intent(in) :: & + ew_boundary_type, ns_boundary_type + + real (kind=dbl_kind), dimension(:,:), intent(out) :: & + ARRAY_O + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (kind=int_kind) :: & + ii, io, ji, jo + + character(len=*), parameter :: & + subname = '(primary_grid_lengths_global_ext)' + +!----------------------------------------------------------------------- +! +! add ghost cells to global primary grid lengths array +! +!----------------------------------------------------------------------- + + if (trim(ns_boundary_type) == 'tripole' .or. & + trim(ns_boundary_type) == 'tripoleT') then + call abort_ice(subname//' ERROR: '//ns_boundary_type & + //' boundary type not implemented for configuration') + endif + + do jo = 1,ny_global+2*nghost + ji = -nghost + jo + + !*** Southern ghost cells + + if (ji < 1) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji + ny_global + case ('open') + ji = nghost - jo + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + !*** Northern ghost cells + + if (ji > ny_global) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji - ny_global + case ('open') + ji = 2 * ny_global - ji + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + do io = 1,nx_global+2*nghost + ii = -nghost + io + + !*** Western ghost cells + + if (ii < 1) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii + nx_global + case ('open') + ii = nghost - io + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + !*** Eastern ghost cells + + if (ii > nx_global) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii - nx_global + case ('open') + ii = 2 * nx_global - ii + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + if (ii == 0 .or. ji == 0) then + ARRAY_O(io, jo) = c0 + else + ARRAY_O(io, jo) = ARRAY_I(ii, ji) + endif + + enddo + enddo + +!----------------------------------------------------------------------- + + end subroutine primary_grid_lengths_global_ext + !*********************************************************************** end module ice_boundary diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 index 9c2cfd9fc..e4991f86b 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 @@ -57,7 +57,8 @@ module ice_boundary ice_HaloUpdate, & ice_HaloUpdate_stress, & ice_HaloExtrapolate, & - ice_HaloDestroy + ice_HaloDestroy, & + primary_grid_lengths_global_ext interface ice_HaloUpdate ! generic interface module procedure ice_HaloUpdate2DR8, & @@ -4505,6 +4506,136 @@ subroutine ice_HaloDestroy(halo) end subroutine ice_HaloDestroy +!*********************************************************************** + + subroutine primary_grid_lengths_global_ext( & + ARRAY_O, ARRAY_I, ew_boundary_type, ns_boundary_type) + +! This subroutine adds ghost cells to global primary grid lengths array +! ARRAY_I and outputs result to array ARRAY_O + +! Note duplicate implementation of this subroutine in: +! cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 + + use ice_constants, only: c0 + use ice_domain_size, only: nx_global, ny_global + + real (kind=dbl_kind), dimension(:,:), intent(in) :: & + ARRAY_I + + character (*), intent(in) :: & + ew_boundary_type, ns_boundary_type + + real (kind=dbl_kind), dimension(:,:), intent(out) :: & + ARRAY_O + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (kind=int_kind) :: & + ii, io, ji, jo + + character(len=*), parameter :: & + subname = '(primary_grid_lengths_global_ext)' + +!----------------------------------------------------------------------- +! +! add ghost cells to global primary grid lengths array +! +!----------------------------------------------------------------------- + + if (trim(ns_boundary_type) == 'tripole' .or. & + trim(ns_boundary_type) == 'tripoleT') then + call abort_ice(subname//' ERROR: '//ns_boundary_type & + //' boundary type not implemented for configuration') + endif + + do jo = 1,ny_global+2*nghost + ji = -nghost + jo + + !*** Southern ghost cells + + if (ji < 1) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji + ny_global + case ('open') + ji = nghost - jo + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + !*** Northern ghost cells + + if (ji > ny_global) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji - ny_global + case ('open') + ji = 2 * ny_global - ji + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + do io = 1,nx_global+2*nghost + ii = -nghost + io + + !*** Western ghost cells + + if (ii < 1) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii + nx_global + case ('open') + ii = nghost - io + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + !*** Eastern ghost cells + + if (ii > nx_global) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii - nx_global + case ('open') + ii = 2 * nx_global - ii + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + if (ii == 0 .or. ji == 0) then + ARRAY_O(io, jo) = c0 + else + ARRAY_O(io, jo) = ARRAY_I(ii, ji) + endif + + enddo + enddo + +!----------------------------------------------------------------------- + + end subroutine primary_grid_lengths_global_ext + !*********************************************************************** end module ice_boundary diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index 874902d1f..2a8515c57 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -19,7 +19,8 @@ module ice_grid use ice_kinds_mod use ice_broadcast, only: broadcast_scalar, broadcast_array - use ice_boundary, only: ice_HaloUpdate, ice_HaloExtrapolate + use ice_boundary, only: ice_HaloUpdate, ice_HaloExtrapolate, & + primary_grid_lengths_global_ext use ice_communicate, only: my_task, master_task use ice_blocks, only: block, get_block, nx_block, ny_block, nghost use ice_domain_size, only: nx_global, ny_global, max_blocks @@ -1514,7 +1515,8 @@ subroutine primary_grid_lengths_HTN(work_g) enddo endif if (pgl_global_ext) then - call primary_grid_lengths_global_ext(G_HTN, work_g) + call primary_grid_lengths_global_ext( & + G_HTN, work_g, ew_boundary_type, ns_boundary_type) endif call scatter_global(HTN, work_g, master_task, distrb_info, & field_loc_Nface, field_type_scalar) @@ -1591,7 +1593,8 @@ subroutine primary_grid_lengths_HTE(work_g) endif endif if (pgl_global_ext) then - call primary_grid_lengths_global_ext(G_HTE, work_g) + call primary_grid_lengths_global_ext( & + G_HTE, work_g, ew_boundary_type, ns_boundary_type) endif call scatter_global(HTE, work_g, master_task, distrb_info, & field_loc_Eface, field_type_scalar) @@ -2576,115 +2579,6 @@ subroutine read_seabedstress_bathy end subroutine read_seabedstress_bathy -!======================================================================= -! Initialize global primary grid lengths array with ghost cells from -! global primary grid lengths array - - subroutine primary_grid_lengths_global_ext(ARRAY_O, ARRAY_I) - - use ice_constants, only: c0 - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & - ARRAY_I - - real (kind=dbl_kind), dimension(:,:), intent(out) :: & - ARRAY_O - - ! Local variables - - integer (kind=int_kind) :: & - ii, io, ji, jo - - character(len=*), parameter :: & - subname = '(primary_grid_lengths_global_ext)' - - if ((ns_boundary_type == 'tripole' ) .or. & - (ns_boundary_type == 'tripoleT')) then - call abort_ice(subname // 'ERROR: ' // & - ns_boundary_type // ' bndy type not impl for cfg') - endif - - do jo = 1, (ny_global + 2 * nghost) - ji = -nghost + jo - - ! Southern ghost cells - - if (ji < 1) then - select case (ns_boundary_type) - case ('cyclic') - ji = ji + ny_global - case ('open') - ji = nghost - jo + 1 - case ('closed') - ji = 0 - case default - call abort_ice( & - subname // 'ERROR: unknown n-s bndy type') - end select - endif - - ! Northern ghost cells - - if (ji > ny_global) then - select case (ns_boundary_type) - case ('cyclic') - ji = ji - ny_global - case ('open') - ji = 2 * ny_global - ji + 1 - case ('closed') - ji = 0 - case default - call abort_ice( & - subname // 'ERROR: unknown n-s bndy type') - end select - endif - - do io = 1, (nx_global + 2 * nghost) - ii = -nghost + io - - ! Western ghost cells - - if (ii < 1) then - select case (ew_boundary_type) - case ('cyclic') - ii = ii + nx_global - case ('open') - ii = nghost - io + 1 - case ('closed') - ii = 0 - case default - call abort_ice( & - subname//'ERROR: unknown e-w bndy type') - end select - endif - - ! Eastern ghost cells - - if (ii > nx_global) then - select case (ew_boundary_type) - case ('cyclic') - ii = ii - nx_global - case ('open') - ii = 2 * nx_global - ii + 1 - case ('closed') - ii = 0 - case default - call abort_ice( & - subname//'ERROR: unknown e-w bndy type') - end select - endif - - if ((ii == 0) .or. (ji == 0)) then - ARRAY_O(io, jo) = c0 - else - ARRAY_O(io, jo) = ARRAY_I(ii, ji) - endif - - enddo - enddo - - end subroutine primary_grid_lengths_global_ext - !======================================================================= end module ice_grid