From 571013dad0a7f4971f629cbda16b1c396620d812 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 12 Jan 2021 15:32:40 -0500 Subject: [PATCH] +Added MOM_coms_wrapper.F90 Added the new module MOM_coms_wrapper, along with explicit interfaces for the broadcast routine for the cases that might actually be used by MOM6. With these new interfaces, the source PE has been made into an optional argument, and there is a new optional argument to indicate whether the broadcast is blocking. Also the MOM_horizontal_regridding module has been updated to reflect these changes. All answers are bitwise identical, but an existing required argument to broadcast has been made optional and there is a new optional argument. --- src/framework/MOM_coms.F90 | 19 +-- src/framework/MOM_coms_wrapper.F90 | 160 ++++++++++++++++++++ src/framework/MOM_horizontal_regridding.F90 | 52 +++---- 3 files changed, 183 insertions(+), 48 deletions(-) create mode 100644 src/framework/MOM_coms_wrapper.F90 diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index 04ed46ad22..13fc4df75d 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -5,22 +5,19 @@ module MOM_coms ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING -use fms_mod, only : fms_end, MOM_infra_init => fms_init -use memutils_mod, only : print_memuse_stats -use mpp_mod, only : PE_here => mpp_pe, root_PE => mpp_root_pe, num_PEs => mpp_npes -use mpp_mod, only : Set_PElist => mpp_set_current_pelist, Get_PElist => mpp_get_current_pelist -use mpp_mod, only : broadcast => mpp_broadcast, field_chksum => mpp_chksum -use mpp_mod, only : sum_across_PEs => mpp_sum, max_across_PEs => mpp_max, min_across_PEs => mpp_min +use MOM_coms_wrapper, only : PE_here, root_PE, num_PEs, Set_PElist, Get_PElist +use MOM_coms_wrapper, only : broadcast, field_chksum, MOM_infra_init, MOM_infra_end +use MOM_coms_wrapper, only : sum_across_PEs, max_across_PEs, min_across_PEs implicit none ; private public :: PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs, field_chksum +public :: Set_PElist, Get_PElist public :: reproducing_sum, reproducing_sum_EFP, EFP_sum_across_PEs, EFP_list_sum_across_PEs public :: EFP_plus, EFP_minus, EFP_to_real, real_to_EFP, EFP_real_diff public :: operator(+), operator(-), assignment(=) public :: query_EFP_overflow_error, reset_EFP_overflow_error -public :: Set_PElist, Get_PElist ! This module provides interfaces to the non-domain-oriented communication subroutines. @@ -880,12 +877,4 @@ subroutine EFP_val_sum_across_PEs(EFP, error) end subroutine EFP_val_sum_across_PEs - -!> This subroutine carries out all of the calls required to close out the infrastructure cleanly. -!! This should only be called in ocean-only runs, as the coupler takes care of this in coupled runs. -subroutine MOM_infra_end - call print_memuse_stats( 'Memory HiWaterMark', always=.TRUE. ) - call fms_end -end subroutine MOM_infra_end - end module MOM_coms diff --git a/src/framework/MOM_coms_wrapper.F90 b/src/framework/MOM_coms_wrapper.F90 new file mode 100644 index 0000000000..954f6da93c --- /dev/null +++ b/src/framework/MOM_coms_wrapper.F90 @@ -0,0 +1,160 @@ +!> Thin interfaces to non-domain-oriented mpp communication subroutines +module MOM_coms_wrapper + +! This file is part of MOM6. See LICENSE.md for the license. + +use fms_mod, only : fms_end, MOM_infra_init => fms_init +use memutils_mod, only : print_memuse_stats +use mpp_mod, only : PE_here => mpp_pe, root_PE => mpp_root_pe, num_PEs => mpp_npes +use mpp_mod, only : Set_PElist => mpp_set_current_pelist, Get_PElist => mpp_get_current_pelist +use mpp_mod, only : mpp_broadcast, mpp_sync, mpp_sync_self, field_chksum => mpp_chksum +use mpp_mod, only : sum_across_PEs => mpp_sum, max_across_PEs => mpp_max, min_across_PEs => mpp_min + +implicit none ; private + +public :: PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end, Set_PElist, Get_PElist +public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs, field_chksum + +! This module provides interfaces to the non-domain-oriented communication subroutines. + +!> Communicate an array, string or scalar from one PE to others +interface broadcast + module procedure broadcast_char, broadcast_int0D, broadcast_int1D + module procedure broadcast_real0D, broadcast_real1D, broadcast_real2D +end interface broadcast + +contains + +!> Communicate a 1-D array of character strings from one PE to others +subroutine broadcast_char(dat, length, from_PE, PElist, blocking) + character(len=*), intent(inout) :: dat(:) !< The data to communicate and destination + integer, intent(in) :: length !< The length of each string + integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE + integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the + !! active PE set as previously set via Set_PElist. + logical, optional, intent(in) :: blocking !< If true, barriers are added around the call + + integer :: src_PE ! The processor that is sending the data + logical :: do_block ! If true add synchronizing barriers + + do_block = .false. ; if (present(blocking)) do_block = blocking + if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif + + if (do_block) call mpp_sync(PElist) + call mpp_broadcast(dat, length, src_PE, PElist) + if (do_block) call mpp_sync_self(PElist) + +end subroutine broadcast_char + +!> Communicate an integer from one PE to others +subroutine broadcast_int0D(dat, from_PE, PElist, blocking) + integer, intent(inout) :: dat !< The data to communicate and destination + integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE + integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the + !! active PE set as previously set via Set_PElist. + logical, optional, intent(in) :: blocking !< If true, barriers are added around the call + + integer :: src_PE ! The processor that is sending the data + logical :: do_block ! If true add synchronizing barriers + + do_block = .false. ; if (present(blocking)) do_block = blocking + if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif + + if (do_block) call mpp_sync(PElist) + call mpp_broadcast(dat, src_PE, PElist) + if (do_block) call mpp_sync_self(PElist) + +end subroutine broadcast_int0D + +!> Communicate a 1-D array of integers from one PE to others +subroutine broadcast_int1D(dat, length, from_PE, PElist, blocking) + integer, dimension(:), intent(inout) :: dat !< The data to communicate and destination + integer, intent(in) :: length !< The number of data elements + integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE + integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the + !! active PE set as previously set via Set_PElist. + logical, optional, intent(in) :: blocking !< If true, barriers are added around the call + + integer :: src_PE ! The processor that is sending the data + logical :: do_block ! If true add synchronizing barriers + + do_block = .false. ; if (present(blocking)) do_block = blocking + if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif + + if (do_block) call mpp_sync(PElist) + call mpp_broadcast(dat, length, src_PE, PElist) + if (do_block) call mpp_sync_self(PElist) + +end subroutine broadcast_int1D + +!> Communicate a real number from one PE to others +subroutine broadcast_real0D(dat, from_PE, PElist, blocking) + real, intent(inout) :: dat !< The data to communicate and destination + integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE + integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the + !! active PE set as previously set via Set_PElist. + logical, optional, intent(in) :: blocking !< If true, barriers are added around the call + + integer :: src_PE ! The processor that is sending the data + logical :: do_block ! If true add synchronizing barriers + + do_block = .false. ; if (present(blocking)) do_block = blocking + if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif + + if (do_block) call mpp_sync(PElist) + call mpp_broadcast(dat, src_PE, PElist) + if (do_block) call mpp_sync_self(PElist) + +end subroutine broadcast_real0D + +!> Communicate a 1-D array of reals from one PE to others +subroutine broadcast_real1D(dat, length, from_PE, PElist, blocking) + real, dimension(:), intent(inout) :: dat !< The data to communicate and destination + integer, intent(in) :: length !< The number of data elements + integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE + integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the + !! active PE set as previously set via Set_PElist. + logical, optional, intent(in) :: blocking !< If true, barriers are added around the call + + integer :: src_PE ! The processor that is sending the data + logical :: do_block ! If true add synchronizing barriers + + do_block = .false. ; if (present(blocking)) do_block = blocking + if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif + + if (do_block) call mpp_sync(PElist) + call mpp_broadcast(dat, length, src_PE, PElist) + if (do_block) call mpp_sync_self(PElist) + +end subroutine broadcast_real1D + +!> Communicate a 2-D array of reals from one PE to others +subroutine broadcast_real2D(dat, length, from_PE, PElist, blocking) + real, dimension(:,:), intent(inout) :: dat !< The data to communicate and destination + integer, intent(in) :: length !< The total number of data elements + integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE + integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the + !! active PE set as previously set via Set_PElist. + logical, optional, intent(in) :: blocking !< If true, barriers are added around the call + + integer :: src_PE ! The processor that is sending the data + logical :: do_block ! If true add synchronizing barriers + + do_block = .false. ; if (present(blocking)) do_block = blocking + if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif + + if (do_block) call mpp_sync(PElist) + call mpp_broadcast(dat, length, src_PE, PElist) + if (do_block) call mpp_sync_self(PElist) + +end subroutine broadcast_real2D + + +!> This subroutine carries out all of the calls required to close out the infrastructure cleanly. +!! This should only be called in ocean-only runs, as the coupler takes care of this in coupled runs. +subroutine MOM_infra_end + call print_memuse_stats( 'Memory HiWaterMark', always=.TRUE. ) + call fms_end() +end subroutine MOM_infra_end + +end module MOM_coms_wrapper diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 4f98038f12..9b340f3aa7 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -3,32 +3,22 @@ module MOM_horizontal_regridding ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_debugging, only : hchksum -use MOM_coms, only : max_across_PEs, min_across_PEs -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end -use MOM_cpu_clock, only : CLOCK_ROUTINE, CLOCK_LOOP -use MOM_domains, only : pass_var, pass_vector, sum_across_PEs, broadcast -use MOM_domains, only : root_PE, To_All, SCALAR_PAIR, CGRID_NE, AGRID +use MOM_debugging, only : hchksum +use MOM_coms, only : max_across_PEs, min_across_PEs, sum_across_PEs, broadcast +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_LOOP +use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint -use MOM_file_parser, only : get_param, read_param, log_param, param_file_type -use MOM_file_parser, only : log_version -use MOM_get_input, only : directories -use MOM_grid, only : ocean_grid_type, isPointInCell -use MOM_io, only : close_file, fieldtype, file_exists -use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE, MULTIPLE -use MOM_io, only : slasher, vardesc, write_field -use MOM_string_functions, only : uppercase -use MOM_time_manager, only : time_type, get_external_field_size -use MOM_time_manager, only : init_external_field -use MOM_time_manager, only : get_external_field_axes, get_external_field_missing +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_grid, only : ocean_grid_type +use MOM_io_wrapper, only : axistype, get_axis_data +use MOM_time_manager, only : time_type +use MOM_time_manager, only : init_external_field, get_external_field_size +use MOM_time_manager, only : get_external_field_axes, get_external_field_missing use MOM_transform_FMS, only : time_interp_external => rotated_time_interp_external -use MOM_variables, only : thermo_var_ptrs -use mpp_io_mod, only : axistype, mpp_get_axis_data -use mpp_mod, only : mpp_broadcast, mpp_sync, mpp_sync_self, mpp_max -use horiz_interp_mod, only : horiz_interp_new, horiz_interp, horiz_interp_type -use horiz_interp_mod, only : horiz_interp_init, horiz_interp_del +use horiz_interp_mod, only : horiz_interp_new, horiz_interp, horiz_interp_type +use horiz_interp_mod, only : horiz_interp_init, horiz_interp_del use netcdf @@ -463,7 +453,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, endif max_depth = maxval(G%bathyT) - call mpp_max(max_depth) + call max_across_PEs(max_depth) if (z_edges_in(kd+1)