Skip to content

Commit

Permalink
Subroutine primary_grid_lengths_global_ext moved from ice_grid module…
Browse files Browse the repository at this point in the history 
… to MPI and serial implementations of ice_boundary modules (CICE-Consortium#568 (comment)). Please note duplication of subroutine.
  • Loading branch information
@srethmeier
srethmeier committed Mar 13, 2021
1 parent 4b702b8 commit a711bdc
Show file tree
Hide file tree
Showing 3 changed files with 270 additions and 114 deletions.
133 changes: 132 additions & 1 deletion cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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, &
Expand Down Expand Up @@ -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
Expand Down
133 changes: 132 additions & 1 deletion cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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, &
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit a711bdc

Please sign in to comment.