diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index ce48b973f9..33ddf5260a 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -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 @@ -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 @@ -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) @@ -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 @@ -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) diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index ba0608cda0..d75b88d204 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -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 @@ -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 @@ -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. @@ -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