From adb8ec46bebdfb8d43cddb186520d28c6fe17313 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 9 Jan 2021 05:23:51 -0500 Subject: [PATCH] +Add deallocate_MOM_domain and get_layout_extents Added the new routines deallocate_MOM_domain, deallocate_domain_contents and get_layout_extents to standardize the clean-up of memory associated with MOM_domains, provide an interface for obtaining information about the global grid decomposition and limit the dependencies on mpp functions to calls that go through the MOM framework directory. All answers are bitwise identical, although there are new public interfaces. --- src/core/MOM_grid.F90 | 7 +-- src/framework/MOM_domains.F90 | 58 ++++++++++++++++++++-- src/initialization/MOM_grid_initialize.F90 | 43 +++++++--------- 3 files changed, 77 insertions(+), 31 deletions(-) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 8844c65f40..9ca98adf71 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -5,7 +5,7 @@ module MOM_grid use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_domains, only : MOM_domain_type, get_domain_extent, compute_block_extent -use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2 +use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2, deallocate_MOM_domain use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_unit_scaling, only : unit_scale_type @@ -630,8 +630,9 @@ subroutine MOM_grid_end(G) deallocate(G%gridLonT) ; deallocate(G%gridLatT) deallocate(G%gridLonB) ; deallocate(G%gridLatB) - deallocate(G%Domain%mpp_domain) - deallocate(G%Domain) + ! The cursory flag avoids doing any deallocation of memory in the underlying + ! infrastructure to avoid problems due to shared pointers. + call deallocate_MOM_domain(G%Domain, cursory=.true.) end subroutine MOM_grid_end diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index c71ec6b848..dc1f8ff867 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -17,6 +17,7 @@ module MOM_domains use mpp_domains_mod, only : MOM_define_domain => mpp_define_domains use mpp_domains_mod, only : domain2D, domain1D, mpp_get_data_domain use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_global_domain +use mpp_domains_mod, only : mpp_get_domain_extents, mpp_deallocate_domain 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 @@ -37,6 +38,7 @@ module MOM_domains public :: MOM_domains_init, MOM_infra_init, MOM_infra_end, get_domain_extent, get_domain_extent_dsamp2 public :: create_MOM_domain, clone_MOM_domain +public :: deallocate_MOM_domain, deallocate_domain_contents public :: MOM_define_domain, MOM_define_layout, MOM_define_io_domain public :: pass_var, pass_vector, PE_here, root_PE, num_PEs public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast @@ -47,7 +49,7 @@ module MOM_domains public :: To_East, To_West, To_North, To_South, To_All, Omit_Corners public :: create_group_pass, do_group_pass, group_pass_type public :: start_group_pass, complete_group_pass -public :: compute_block_extent, get_global_shape +public :: compute_block_extent, get_global_shape, get_layout_extents public :: MOM_thread_affinity_set, set_MOM_thread_affinity public :: get_simple_array_i_ind, get_simple_array_j_ind public :: domain2D @@ -1639,6 +1641,42 @@ subroutine create_MOM_domain(MOM_dom, n_global, n_halo, reentrant, tripolar, lay end subroutine create_MOM_domain +!> dealloc_MOM_domain deallocates memory associated with a pointer to a MOM_domain_type +!! and all of its contents +subroutine deallocate_MOM_domain(MOM_domain, cursory) + type(MOM_domain_type), pointer :: MOM_domain !< A pointer to the MOM_domain_type being deallocated + logical, optional, intent(in) :: cursory !< If true do not deallocate fields associated + !! with the underlying infrastructure + + if (associated(MOM_domain)) then + call deallocate_domain_contents(MOM_domain, cursory) + deallocate(MOM_domain) + endif + +end subroutine deallocate_MOM_domain + +!> deallocate_domain_contents deallocates memory associated with pointers +!! inside of a MOM_domain_type. +subroutine deallocate_domain_contents(MOM_domain, cursory) + type(MOM_domain_type), intent(inout) :: MOM_domain !< A MOM_domain_type whose contents will be deallocated + logical, optional, intent(in) :: cursory !< If true do not deallocate fields associated + !! with the underlying infrastructure + + logical :: invasive ! If true, deallocate fields associated with the underlying infrastructure + + invasive = .true. ; if (present(cursory)) invasive = .not.cursory + + if (associated(MOM_domain%mpp_domain)) then + if (invasive) call mpp_deallocate_domain(MOM_domain%mpp_domain) + deallocate(MOM_domain%mpp_domain) + endif + if (associated(MOM_domain%mpp_domain_d2)) then + if (invasive) call mpp_deallocate_domain(MOM_domain%mpp_domain_d2) + deallocate(MOM_domain%mpp_domain_d2) + endif + if (associated(MOM_domain%maskmap)) deallocate(MOM_domain%maskmap) + +end subroutine deallocate_domain_contents !> MOM_thread_affinity_set returns true if the number of openMP threads have been set to a value greater than 1. function MOM_thread_affinity_set() @@ -2041,13 +2079,27 @@ end subroutine get_simple_array_j_ind !> Returns the global shape of h-point arrays subroutine get_global_shape(domain, niglobal, njglobal) - type(MOM_domain_type), intent(in) :: domain !< MOM domain + type(MOM_domain_type), intent(in) :: domain !< MOM domain from which to extract information integer, intent(out) :: niglobal !< i-index global size of h-point arrays integer, intent(out) :: njglobal !< j-index global size of h-point arrays niglobal = domain%niglobal njglobal = domain%njglobal - end subroutine get_global_shape +!> Returns arrays of the i- and j- sizes of the h-point computational domains for each +!! element of the grid layout. Any input values in the extent arrays are discarded, so +!! they are effectively intent out despite their declared intent of inout. +subroutine get_layout_extents(Domain, extent_i, extent_j) + type(MOM_domain_type), intent(in) :: domain !< MOM domain from which to extract information + integer, dimension(:), allocatable, intent(inout) :: extent_i + integer, dimension(:), allocatable, intent(inout) :: extent_j + + if (allocated(extent_i)) deallocate(extent_i) + if (allocated(extent_j)) deallocate(extent_j) + allocate(extent_i(domain%layout(1))) ; extent_i(:) = 0 + allocate(extent_j(domain%layout(2))) ; extent_j(:) = 0 + call mpp_get_domain_extents(domain%mpp_domain, extent_i, extent_j) +end subroutine get_layout_extents + end module MOM_domains diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 4526d9e9c7..eee168eefb 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -3,22 +3,19 @@ module MOM_grid_initialize ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_checksums, only : hchksum, Bchksum -use MOM_checksums, only : uvchksum, hchksum_pair, Bchksum_pair -use MOM_domains, only : pass_var, pass_vector, pe_here, root_PE, broadcast -use MOM_domains, only : AGRID, BGRID_NE, CGRID_NE, To_All, Scalar_Pair -use MOM_domains, only : To_North, To_South, To_East, To_West -use MOM_domains, only : MOM_define_domain, MOM_define_IO_domain -use MOM_domains, only : MOM_domain_type -use MOM_dyn_horgrid, only : dyn_horgrid_type, set_derived_dyn_horgrid +use MOM_checksums, only : hchksum, Bchksum, uvchksum, hchksum_pair, Bchksum_pair +use MOM_domains, only : pass_var, pass_vector, pe_here, root_PE, broadcast +use MOM_domains, only : AGRID, BGRID_NE, CGRID_NE, To_All, Scalar_Pair +use MOM_domains, only : To_North, To_South, To_East, To_West +use MOM_domains, only : MOM_define_domain, MOM_define_IO_domain, get_layout_extents +use MOM_domains, only : MOM_domain_type, deallocate_domain_contents +use MOM_dyn_horgrid, only : dyn_horgrid_type, set_derived_dyn_horgrid use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_io, only : MOM_read_data, read_data, slasher, file_exists, stdout -use MOM_io, only : CORNER, NORTH_FACE, EAST_FACE -use MOM_unit_scaling, only : unit_scale_type - -use mpp_domains_mod, only : mpp_get_domain_extents, mpp_deallocate_domain +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_io, only : MOM_read_data, read_data, slasher, file_exists, stdout +use MOM_io, only : CORNER, NORTH_FACE, EAST_FACE +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -192,8 +189,8 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) type(MOM_domain_type) :: SGdom ! Supergrid domain logical :: lon_bug ! If true use an older buggy answer in the tripolar longitude. integer :: i, j, i2, j2 - integer :: npei,npej - integer, dimension(:), allocatable :: exni,exnj + integer, dimension(:), allocatable :: exni ! The extents of the grid for each i-row of the layout + integer, dimension(:), allocatable :: exnj ! The extents of the grid for each j-row of the layout integer :: start(4), nread(4) call callTree_enter("set_grid_metrics_from_mosaic(), MOM_grid_initialize.F90") @@ -224,9 +221,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) nj = 2*(G%jec-G%jsc+1) ! j size of supergrid ! Define a domain for the supergrid (SGdom) - npei = G%domain%layout(1) ; npej = G%domain%layout(2) - allocate(exni(npei)) ; allocate(exnj(npej)) - call mpp_get_domain_extents(G%domain%mpp_domain, exni, exnj) + call get_layout_extents(G%domain, exni, exnj) allocate(SGdom%mpp_domain) SGdom%nihalo = 2*G%domain%nihalo+1 SGdom%njhalo = 2*G%domain%njhalo+1 @@ -243,19 +238,18 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & xflags=G%domain%X_FLAGS, yflags=G%domain%Y_FLAGS, & xhalo=SGdom%nihalo, yhalo=SGdom%njhalo, & - xextent=exni,yextent=exnj, & + xextent=exni, yextent=exnj, & symmetry=.true., name="MOM_MOSAIC", maskmap=G%domain%maskmap) else call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & xflags=G%domain%X_FLAGS, yflags=G%domain%Y_FLAGS, & xhalo=SGdom%nihalo, yhalo=SGdom%njhalo, & - xextent=exni,yextent=exnj, & + xextent=exni, yextent=exnj, & symmetry=.true., name="MOM_MOSAIC") endif call MOM_define_IO_domain(SGdom%mpp_domain, SGdom%io_layout) - deallocate(exni) - deallocate(exnj) + deallocate(exni, exnj) ! Read X from the supergrid tmpZ(:,:) = 999. @@ -346,8 +340,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) ni=SGdom%niglobal nj=SGdom%njglobal - call mpp_deallocate_domain(SGdom%mpp_domain) - deallocate(SGdom%mpp_domain) + call deallocate_domain_contents(SGdom) call pass_vector(dyCu, dxCv, G%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dxCu, dyCv, G%Domain, To_All+Scalar_Pair, CGRID_NE)