Skip to content

Group update for the barotropic solver #1

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
adcroft merged 2 commits into from
Feb 18, 2014
Merged

Group update for the barotropic solver #1

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
6e65feb
Group halo update
Zhi-Liang Jun 4, 2013
b408789
group halo update
Zhi-Liang Jun 4, 2013
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 16 additions & 8 deletions src/core/MOM_barotropic.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -101,6 +101,7 @@ module MOM_barotropic
use MOM_domains, only : To_All, Scalar_Pair, AGRID, CORNER, MOM_domain_type
use MOM_domains, only : pass_var_start, pass_var_complete
use MOM_domains, only : pass_vector_start, pass_vector_complete
use MOM_domains, only : create_group_update, do_group_update, group_update_type
use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe
use MOM_file_parser, only : get_param, read_param, log_param, log_version, param_file_type
use MOM_forcing_type, only : forcing
Expand Down Expand Up @@ -627,6 +628,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
logical :: apply_OBCs, apply_u_OBCs, apply_v_OBCs, apply_OBC_flather
type(BT_OBC_type) :: BT_OBC ! A structure with all of this module's fields
! for applying open boundary conditions.
type(group_update_type) :: group ! mix scalar and vector halo update.
type(memory_size_type) :: MS
character(len=200) :: mesg
integer :: pid_ubt, pid_eta, pid_e_anom, pid_etaav, pid_uhbtav, pid_ubtav
Expand Down Expand Up @@ -1235,15 +1237,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
call pass_vector(Datu, Datv, CS%BT_Domain, To_All+Scalar_Pair)
if (((G%isd > CS%isdw) .or. (G%jsd > CS%jsdw)) .or. (Isq <= is-1) .or. (Jsq <= js-1)) &
call pass_vector(BT_force_u, BT_force_v, CS%BT_Domain, complete=.false.)
if (G%nonblocking_updates) then ! Passing needs to be completed now.
! if (G%nonblocking_updates) then ! Passing needs to be completed now.
call pass_var(eta_src, CS%BT_Domain, complete=.true.)
if (add_uh0) call pass_vector(uhbt0, vhbt0, CS%BT_Domain, complete=.false.)
call pass_vector(Cor_ref_u, Cor_ref_v, CS%BT_Domain, complete=.true.)
else
call pass_var(eta_src, CS%BT_Domain, complete=.false.)
if (add_uh0) call pass_vector(uhbt0, vhbt0, CS%BT_Domain, complete=.false.)
call pass_vector(Cor_ref_u, Cor_ref_v, CS%BT_Domain, complete=.false.)
endif
! else
! call pass_var(eta_src, CS%BT_Domain, complete=.false.)
! if (add_uh0) call pass_vector(uhbt0, vhbt0, CS%BT_Domain, complete=.false.)
! call pass_vector(Cor_ref_u, Cor_ref_v, CS%BT_Domain, complete=.false.)
! endif
endif
if (id_clock_pass_pre > 0) call cpu_clock_end(id_clock_pass_pre)
if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre)
Expand Down Expand Up @@ -1373,6 +1375,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &

sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_accel = 0.0 ; sum_wt_trans = 0.0

if( .NOT. G%nonblocking_updates) then
call create_group_update(group, eta, CS%BT_Domain)
call create_group_update(group, ubt, vbt, CS%BT_Domain)
endif

! The following loop contains all of the time steps.
isv=is ; iev=ie ; jsv=js ; jev=je
do n=1,nstep+nfilter
Expand Down Expand Up @@ -1406,8 +1413,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, &
call pass_vector_complete(pid_ubt, ubt, vbt, CS%BT_Domain)
call pass_var_complete(pid_eta, eta, CS%BT_Domain)
else
call pass_var(eta, CS%BT_Domain)
call pass_vector(ubt, vbt, CS%BT_Domain)
call do_group_update(group, CS%BT_Domain, eta(isv-1,jsv-1))
! call pass_var(eta, CS%BT_Domain)
! call pass_vector(ubt, vbt, CS%BT_Domain)
endif
isv = isvf ; iev = ievf ; jsv = jsvf ; jev = jevf
if (id_clock_pass_step > 0) call cpu_clock_end(id_clock_pass_step)
Expand Down
90 changes: 90 additions & 0 deletions src/framework/MOM_domains.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,8 @@ module MOM_domains
use mpp_domains_mod, only : global_field_sum => mpp_global_sum
use mpp_domains_mod, only : mpp_update_domains, CYCLIC_GLOBAL_DOMAIN, FOLD_NORTH_EDGE
use mpp_domains_mod, only : mpp_start_update_domains, mpp_complete_update_domains
use mpp_domains_mod, only : mpp_create_group_update, mpp_do_group_update
use mpp_domains_mod, only : group_update_type => mpp_group_update_type
use mpp_parameter_mod, only : AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER
use mpp_parameter_mod, only : To_East => WUPDATE, To_West => EUPDATE
use mpp_parameter_mod, only : To_North => SUPDATE, To_South => NUPDATE
Expand All @@ -52,6 +54,7 @@ module MOM_domains
public :: global_field_sum, sum_across_PEs, min_across_PEs, max_across_PEs
public :: AGRID, BGRID_NE, CGRID_NE, SCALAR_PAIR, BITWISE_EXACT_SUM, CORNER
public :: To_East, To_West, To_North, To_South, To_All
public :: create_group_update, do_group_update, group_update_type

interface pass_var
module procedure pass_var_3d, pass_var_2d
Expand All @@ -77,6 +80,11 @@ module MOM_domains
module procedure pass_vector_complete_3d, pass_vector_complete_2d
end interface pass_vector_complete

interface create_group_update
module procedure create_var_group_update_2d
module procedure create_vector_group_update_2d
end interface create_group_update

type, public :: MOM_domain_type
type(domain2D), pointer :: mpp_domain => NULL() ! The domain with halos on
! this processor, centered at h points.
Expand Down Expand Up @@ -546,6 +554,88 @@ subroutine pass_vector_complete_3d(id_update, u_cmpt, v_cmpt, MOM_dom, direction

end subroutine pass_vector_complete_3d

subroutine create_var_group_update_2d(group, array, MOM_dom, sideflag, position)
type(group_update_type),intent(inout) :: group
real, dimension(:,:), intent(inout) :: array
type(MOM_domain_type), intent(inout) :: MOM_dom
integer, optional, intent(in) :: sideflag
integer, optional, intent(in) :: position
! Arguments:
! (inout) group - The data type that store information for group update.
! This data will be used in do_group_update.
! (inout) array - The array which is having its halos points exchanged.
! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
! determine where data should be sent.
! (in) sideflag - An optional integer indicating which directions the
! data should be sent. It is TO_ALL or the sum of any of
! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH. For example,
! TO_EAST sends the data to the processor to the east, so
! the halos on the western side are filled. TO_ALL is
! the default if sideflag is omitted.
! (in) position - An optional argument indicating the position. This is
! may be CORNER, but is CENTER by default.

call mpp_create_group_update(group, array, MOM_dom%mpp_domain, flags=sideflag, position=position)

end subroutine create_var_group_update_2d

subroutine create_vector_group_update_2d(group, u_cmpt, v_cmpt, MOM_dom, direction, stagger)
type(group_update_type),intent(inout) :: group
real, dimension(:,:), intent(inout) :: u_cmpt, v_cmpt
type(MOM_domain_type), intent(inout) :: MOM_dom
integer, optional, intent(in) :: direction
integer, optional, intent(in) :: stagger
! Arguments:
! (inout) group - The data type that store information for group update.
! This data will be used in do_group_update.
! (inout) u_cmpt - The nominal zonal (u) component of the vector pair which
! is having its halos points exchanged.
! (inout) v_cmpt - The nominal meridional (v) component of the vector pair
! which is having its halos points exchanged.
! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
! determine where data should be sent.
! (in) direction - An optional integer indicating which directions the
! data should be sent. It is TO_ALL or the sum of any of
! TO_EAST, TO_WEST, TO_NORTH, and TO_SOUTH, possibly
! plus SCALAR_PAIR if these are paired non-directional
! scalars discretized at the typical vector component
! locations. For example, TO_EAST sends the data to the
! processor to the east, so the halos on the western
! side are filled. TO_ALL is the default if omitted.
! (in) stagger - An optional flag, which may be one of A_GRID, BGRID_NE,
! or CGRID_NE, indicating where the two components of the
! vector are discretized. Omitting stagger is the same as
! setting it to CGRID_NE.
integer :: stagger_local
integer :: dirflag

stagger_local = CGRID_NE ! Default value for type of grid
if (present(stagger)) stagger_local = stagger

dirflag = To_All ! 60
if (PRESENT(direction)) then ; if (direction > 0) dirflag = direction ; endif


call mpp_create_group_update(group, u_cmpt, v_cmpt, MOM_dom%mpp_domain, &
flags=dirflag, gridtype=stagger_local)

end subroutine create_vector_group_update_2d

subroutine do_group_update(group, MOM_dom, d_type)
type(group_update_type),intent(inout) :: group
type(MOM_domain_type), intent(inout) :: MOM_dom
real, intent(in ) :: d_type

! Arguments:
! (inout) group - The data type that store information for group update.
! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to
! determine where data should be sent.
! (in) d_type - A scalar variable to indicate the data type.

call mpp_do_group_update(group, MOM_dom%mpp_domain, d_type)

end subroutine do_group_update

subroutine MOM_domains_init(MOM_dom, param_file, min_halo, symmetric)
type(MOM_domain_type), pointer :: MOM_dom
type(param_file_type), intent(in) :: param_file
Expand Down