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)