MOM_domains.F90

1! This file is part of MOM6, the Modular Ocean Model version 6.
2! See the LICENSE file for licensing information.
3! SPDX-License-Identifier: Apache-2.0
4
5!> Describes the decomposed MOM domain and has routines for communications across PEs
6module mom_domains
7
8use mom_coms_infra, only : mom_infra_init, mom_infra_end
9use mom_coms_infra, only : pe_here, root_pe, num_pes, broadcast
10use mom_coms_infra, only : sum_across_pes, min_across_pes, max_across_pes
11use mom_domain_infra, only : mom_domain_type, domain2d, domain1d, group_pass_type
12use mom_domain_infra, only : create_mom_domain, clone_mom_domain, deallocate_mom_domain
13use mom_domain_infra, only : get_domain_extent, get_domain_components, same_domain
14use mom_domain_infra, only : compute_block_extent, get_global_shape
15use mom_domain_infra, only : pass_var, pass_vector, fill_symmetric_edges
16use mom_domain_infra, only : pass_var_start, pass_var_complete
17use mom_domain_infra, only : pass_vector_start, pass_vector_complete
18use mom_domain_infra, only : create_group_pass, do_group_pass
19use mom_domain_infra, only : start_group_pass, complete_group_pass
20use mom_domain_infra, only : rescale_comp_data, global_field, redistribute_array, broadcast_domain
21use mom_domain_infra, only : mom_thread_affinity_set, set_mom_thread_affinity
22use mom_domain_infra, only : agrid, bgrid_ne, cgrid_ne, scalar_pair
23use mom_domain_infra, only : corner, center, north_face, east_face
24use mom_domain_infra, only : to_east, to_west, to_north, to_south, to_all, omit_corners
25use mom_domain_infra, only : compute_extent
26use mom_error_handler, only : mom_error, mom_mesg, note, warning, fatal, is_root_pe
27use mom_file_parser, only : get_param, log_param, log_version, param_file_type
28use mom_io_infra, only : file_exists, read_field, open_ascii_file, close_file, writeonly_file
30use mom_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, clock_routine
32
33implicit none ; private
34
35public :: mom_infra_init, mom_infra_end
36! Domain types and creation and destruction routines
37public :: mom_domain_type, domain2d, domain1d
38public :: mom_domains_init, create_mom_domain, clone_mom_domain, deallocate_mom_domain
39public :: mom_thread_affinity_set, set_mom_thread_affinity
40public :: mom_define_layout
41! Domain query routines
42public :: get_domain_extent, get_domain_components, get_global_shape, same_domain
43public :: pe_here, root_pe, num_pes
44! Blocks are not actively used in MOM6, so this routine could be deprecated.
45public :: compute_block_extent
46! Single call communication routines
47public :: pass_var, pass_vector, fill_symmetric_edges, broadcast
48! Non-blocking communication routines
49public :: pass_var_start, pass_var_complete, pass_vector_start, pass_vector_complete
50! Multi-variable group communication routines and type
51public :: create_group_pass, do_group_pass, group_pass_type, start_group_pass, complete_group_pass
52! Global reduction routines
53public :: sum_across_pes, min_across_pes, max_across_pes
54public :: global_field, redistribute_array, broadcast_domain
55! Simple index-convention-invariant array manipulation routine
56public :: rescale_comp_data
57!> These encoding constants are used to indicate the staggering of scalars and vectors
58public :: agrid, bgrid_ne, cgrid_ne, scalar_pair
59!> These encoding constants are used to indicate the discretization position of a variable
60public :: corner, center, north_face, east_face
61!> These encoding constants indicate communication patterns. In practice they can be added.
62public :: to_east, to_west, to_north, to_south, to_all, omit_corners
63
64contains
65
66!> MOM_domains_init initializes a MOM_domain_type variable, based on the information
67!! read in from a param_file_type, and optionally returns data describing various
68!! properties of the domain type.
69subroutine mom_domains_init(MOM_dom, param_file, symmetric, static_memory, &
70 NIHALO, NJHALO, NIGLOBAL, NJGLOBAL, NIPROC, NJPROC, &
71 min_halo, domain_name, include_name, param_suffix, US, MOM_dom_unmasked)
72 type(mom_domain_type), pointer :: mom_dom !< A pointer to the MOM_domain_type
73 !! being defined here.
74 type(param_file_type), intent(in) :: param_file !< A structure to parse for
75 !! run-time parameters
76 logical, optional, intent(in) :: symmetric !< If present, this specifies
77 !! whether this domain is symmetric, regardless of
78 !! whether the macro SYMMETRIC_MEMORY_ is defined.
79 logical, optional, intent(in) :: static_memory !< If present and true, this
80 !! domain type is set up for static memory and
81 !! error checking of various input values is
82 !! performed against those in the input file.
83 integer, optional, intent(in) :: nihalo !< Default halo sizes, required
84 !! with static memory.
85 integer, optional, intent(in) :: njhalo !< Default halo sizes, required
86 !! with static memory.
87 integer, optional, intent(in) :: niglobal !< Total domain sizes, required
88 !! with static memory.
89 integer, optional, intent(in) :: njglobal !< Total domain sizes, required
90 !! with static memory.
91 integer, optional, intent(in) :: niproc !< Processor counts, required with
92 !! static memory.
93 integer, optional, intent(in) :: njproc !< Processor counts, required with
94 !! static memory.
95 integer, dimension(2), optional, intent(inout) :: min_halo !< If present, this sets the
96 !! minimum halo size for this domain in the i- and j-
97 !! directions, and returns the actual halo size used.
98 character(len=*), optional, intent(in) :: domain_name !< A name for this domain, "MOM"
99 !! if missing.
100 character(len=*), optional, intent(in) :: include_name !< A name for model's include file,
101 !! "MOM_memory.h" if missing.
102 character(len=*), optional, intent(in) :: param_suffix !< A suffix to apply to
103 !! layout-specific parameters.
104 type(unit_scale_type), optional, pointer :: us !< A dimensional unit scaling type
105 type(mom_domain_type), optional, pointer :: mom_dom_unmasked !< Unmasked MOM domain instance.
106 !! Set to null if masking is not enabled.
107
108 ! Local variables
109 integer, dimension(2) :: layout ! The number of logical processors in the i- and j- directions
110 integer, dimension(2) :: auto_layout ! The layout determined by the auto masking routine
111 integer, dimension(2) :: layout_unmasked ! A temporary layout for unmasked domain
112 integer, dimension(2) :: io_layout ! The layout of logical processors for input and output
113 !$ integer :: ocean_nthreads ! Number of openMP threads
114 !$ logical :: ocean_omp_hyper_thread ! If true use openMP hyper-threads
115 integer, dimension(2) :: n_global ! The number of i- and j- points in the global computational domain
116 integer, dimension(2) :: n_halo ! The number of i- and j- points in the halos
117 integer :: nihalo_dflt, njhalo_dflt ! The default halo sizes
118 integer :: pes_used ! The number of processors used
119 logical, dimension(2) :: reentrant ! True if the x- and y- directions are periodic.
120 logical :: tripolar_n ! A flag indicating whether there is northern tripolar connectivity
121 logical :: is_static ! If true, static memory is being used for this domain.
122 logical :: is_symmetric ! True if the domain being set up will use symmetric memory.
123 logical :: nonblocking ! If true, nonblocking halo updates will be used.
124 logical :: thin_halos ! If true, If true, optional arguments may be used to specify the
125 ! width of the halos that are updated with each call.
126 logical :: auto_mask_table ! Runtime flag that turns on automatic mask table generator
127 integer :: auto_io_layout_fac ! Used to compute IO layout when auto_mask_table is True.
128 logical :: mask_table_exists ! True if there is a mask table file
129 logical :: is_mom_domain ! True if this domain is being set for MOM, and not another component like SIS2.
130 character(len=128) :: inputdir ! The directory in which to find the diag table
131 character(len=200) :: mask_table ! The file name and later the full path to the diag table
132 character(len=64) :: inc_nm ! The name of the memory include file
133 character(len=200) :: mesg ! A string to use for error messages
134
135 integer :: nip_parsed, njp_parsed
136 character(len=8) :: char_xsiz, char_ysiz, char_niglobal, char_njglobal
137 character(len=40) :: nihalo_nm, njhalo_nm, layout_nm, io_layout_nm, masktable_nm
138 character(len=40) :: niproc_nm, njproc_nm
139 character(len=200) :: topo_config
140 integer :: id_clock_auto_mask
141 character(len=:), allocatable :: masktable_desc
142 character(len=:), allocatable :: auto_mask_table_fname ! Auto-generated mask table file name
143 ! This include declares and sets the variable "version".
144# include "version_variable.h"
145 character(len=40) :: mdl ! This module's name.
146
147 pes_used = num_pes()
148
149 mdl = "MOM_domains"
150
151 is_symmetric = .true. ; if (present(symmetric)) is_symmetric = symmetric
152 if (present(min_halo)) mdl = trim(mdl)//" min_halo"
153
154 inc_nm = "MOM_memory.h" ; if (present(include_name)) inc_nm = trim(include_name)
155
156 nihalo_nm = "NIHALO" ; njhalo_nm = "NJHALO"
157 layout_nm = "LAYOUT" ; io_layout_nm = "IO_LAYOUT" ; masktable_nm = "MASKTABLE"
158 niproc_nm = "NIPROC" ; njproc_nm = "NJPROC"
159 if (present(param_suffix)) then ; if (len(trim(adjustl(param_suffix))) > 0) then
160 nihalo_nm = "NIHALO"//(trim(adjustl(param_suffix)))
161 njhalo_nm = "NJHALO"//(trim(adjustl(param_suffix)))
162 layout_nm = "LAYOUT"//(trim(adjustl(param_suffix)))
163 io_layout_nm = "IO_LAYOUT"//(trim(adjustl(param_suffix)))
164 masktable_nm = "MASKTABLE"//(trim(adjustl(param_suffix)))
165 niproc_nm = "NIPROC"//(trim(adjustl(param_suffix)))
166 njproc_nm = "NJPROC"//(trim(adjustl(param_suffix)))
167 endif ; endif
168
169 is_static = .false. ; if (present(static_memory)) is_static = static_memory
170 if (is_static) then
171 if (.not.present(nihalo)) call mom_error(fatal, "NIHALO must be "// &
172 "present in the call to MOM_domains_init with static memory.")
173 if (.not.present(njhalo)) call mom_error(fatal, "NJHALO must be "// &
174 "present in the call to MOM_domains_init with static memory.")
175 if (.not.present(niglobal)) call mom_error(fatal, "NIGLOBAL must be "// &
176 "present in the call to MOM_domains_init with static memory.")
177 if (.not.present(njglobal)) call mom_error(fatal, "NJGLOBAL must be "// &
178 "present in the call to MOM_domains_init with static memory.")
179 if (.not.present(niproc)) call mom_error(fatal, "NIPROC must be "// &
180 "present in the call to MOM_domains_init with static memory.")
181 if (.not.present(njproc)) call mom_error(fatal, "NJPROC must be "// &
182 "present in the call to MOM_domains_init with static memory.")
183 endif
184
185 ! Read all relevant parameters and write them to the model log.
186 call log_version(param_file, mdl, version, "", log_to_all=.true., layout=.true.)
187 call get_param(param_file, mdl, "REENTRANT_X", reentrant(1), &
188 "If true, the domain is zonally reentrant.", default=.true.)
189 call get_param(param_file, mdl, "REENTRANT_Y", reentrant(2), &
190 "If true, the domain is meridionally reentrant.", &
191 default=.false.)
192 call get_param(param_file, mdl, "TRIPOLAR_N", tripolar_n, &
193 "Use tripolar connectivity at the northern edge of the "//&
194 "domain. With TRIPOLAR_N, NIGLOBAL must be even.", &
195 default=.false.)
196
197# ifndef NOT_SET_AFFINITY
198 !$ if (.not.MOM_thread_affinity_set()) then
199 !$ call get_param(param_file, mdl, "OCEAN_OMP_THREADS", ocean_nthreads, &
200 !$ "The number of OpenMP threads that MOM6 will use.", &
201 !$ default=1, layoutParam=.true.)
202 !$ call get_param(param_file, mdl, "OCEAN_OMP_HYPER_THREAD", ocean_omp_hyper_thread, &
203 !$ "If True, use hyper-threading.", default=.false., layoutParam=.true.)
204 !$ call set_MOM_thread_affinity(ocean_nthreads, ocean_omp_hyper_thread)
205 !$ endif
206# endif
207
208 call log_param(param_file, mdl, "!SYMMETRIC_MEMORY_", is_symmetric, &
209 "If defined, the velocity point data domain includes every face of the "//&
210 "thickness points. In other words, some arrays are larger than others, "//&
211 "depending on where they are on the staggered grid. Also, the starting "//&
212 "index of the velocity-point arrays is usually 0, not 1. "//&
213 "This can only be set at compile time.",&
214 layoutparam=.true.)
215 call get_param(param_file, mdl, "NONBLOCKING_UPDATES", nonblocking, &
216 "If true, non-blocking halo updates may be used.", &
217 default=.false., layoutparam=.true.)
218 call get_param(param_file, mdl, "THIN_HALO_UPDATES", thin_halos, &
219 "If true, optional arguments may be used to specify the width of the "//&
220 "halos that are updated with each call.", &
221 default=.true., layoutparam=.true.)
222
223 nihalo_dflt = 4 ; njhalo_dflt = 4
224 if (present(nihalo)) nihalo_dflt = nihalo
225 if (present(njhalo)) njhalo_dflt = njhalo
226
227 call log_param(param_file, mdl, "!STATIC_MEMORY_", is_static, &
228 "If STATIC_MEMORY_ is defined, the principle variables will have sizes that "//&
229 "are statically determined at compile time. Otherwise the sizes are not "//&
230 "determined until run time. The STATIC option is substantially faster, but "//&
231 "does not allow the PE count to be changed at run time. This can only be "//&
232 "set at compile time.", layoutparam=.true.)
233
234 if (is_static) then
235 call get_param(param_file, mdl, "NIGLOBAL", n_global(1), &
236 "The total number of thickness grid points in the x-direction in the physical "//&
237 "domain. With STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.", &
238 default=niglobal)
239 call get_param(param_file, mdl, "NJGLOBAL", n_global(2), &
240 "The total number of thickness grid points in the y-direction in the physical "//&
241 "domain. With STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.", &
242 default=njglobal)
243 if (n_global(1) /= niglobal) call mom_error(fatal,"MOM_domains_init: " // &
244 "static mismatch for NIGLOBAL_ domain size. Header file does not match input namelist")
245 if (n_global(2) /= njglobal) call mom_error(fatal,"MOM_domains_init: " // &
246 "static mismatch for NJGLOBAL_ domain size. Header file does not match input namelist")
247
248 ! Check the requirement of equal sized compute domains when STATIC_MEMORY_ is used.
249 if ((mod(niglobal, niproc) /= 0) .OR. (mod(njglobal, njproc) /= 0)) then
250 write( char_xsiz, '(I0)' ) niproc
251 write( char_ysiz, '(I0)' ) njproc
252 write( char_niglobal, '(I0)' ) niglobal
253 write( char_njglobal, '(I0)' ) njglobal
254 call mom_error(warning, 'MOM_domains: Processor decomposition (NIPROC_,NJPROC_) = ('//&
255 trim(char_xsiz)//','//trim(char_ysiz)//') does not evenly divide size '//&
256 'set by preprocessor macro ('//trim(char_niglobal)//','//trim(char_njglobal)//').')
257 call mom_error(fatal,'MOM_domains: #undef STATIC_MEMORY_ in '//trim(inc_nm)//' to use '//&
258 'dynamic allocation, or change processor decomposition to evenly divide the domain.')
259 endif
260 else
261 call get_param(param_file, mdl, "NIGLOBAL", n_global(1), &
262 "The total number of thickness grid points in the x-direction in the physical "//&
263 "domain. With STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.", &
264 fail_if_missing=.true.)
265 call get_param(param_file, mdl, "NJGLOBAL", n_global(2), &
266 "The total number of thickness grid points in the y-direction in the physical "//&
267 "domain. With STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.", &
268 fail_if_missing=.true.)
269 endif
270
271 call get_param(param_file, mdl, trim(nihalo_nm), n_halo(1), &
272 "The number of halo points on each side in the x-direction. How this is set "//&
273 "varies with the calling component and static or dynamic memory configuration.", &
274 default=nihalo_dflt)
275 call get_param(param_file, mdl, trim(njhalo_nm), n_halo(2), &
276 "The number of halo points on each side in the y-direction. How this is set "//&
277 "varies with the calling component and static or dynamic memory configuration.", &
278 default=njhalo_dflt)
279 if (present(min_halo)) then
280 n_halo(1) = max(n_halo(1), min_halo(1))
281 min_halo(1) = n_halo(1)
282 n_halo(2) = max(n_halo(2), min_halo(2))
283 min_halo(2) = n_halo(2)
284 ! These are generally used only with static memory, so they are considered layout params.
285 call log_param(param_file, mdl, "!NIHALO min_halo", n_halo(1), layoutparam=.true.)
286 call log_param(param_file, mdl, "!NJHALO min_halo", n_halo(2), layoutparam=.true.)
287 endif
288 if (is_static .and. .not.present(min_halo)) then
289 if (n_halo(1) /= nihalo) call mom_error(fatal,"MOM_domains_init: " // &
290 "static mismatch for "//trim(nihalo_nm)//" domain size")
291 if (n_halo(2) /= njhalo) call mom_error(fatal,"MOM_domains_init: " // &
292 "static mismatch for "//trim(njhalo_nm)//" domain size")
293 endif
294
295 call get_param(param_file, mdl, "INPUTDIR", inputdir, do_not_log=.true., default=".")
296 inputdir = slasher(inputdir)
297
298 is_mom_domain = .true.
299 if (present(domain_name)) then
300 is_mom_domain = (index(domain_name, "MOM") > 1)
301 endif
302
303 if (is_mom_domain) then
304 call get_param(param_file, mdl, "TOPO_CONFIG", topo_config, do_not_log=.true., fail_if_missing=.true.)
305 else ! SIS2 has a default value for TOPO_CONFIG.
306 call get_param(param_file, mdl, "TOPO_CONFIG", topo_config, default="file", do_not_log=.true.)
307 endif
308
309 auto_mask_table = .false.
310 if (.not. present(param_suffix) .and. .not. is_static .and. trim(topo_config) == 'file') then
311 call get_param(param_file, mdl, 'AUTO_MASKTABLE', auto_mask_table, &
312 "Turn on automatic mask table generation to eliminate land blocks.", &
313 default=.false., layoutparam=.true.)
314 endif
315
316 masktable_desc = "A text file to specify n_mask, layout and mask_list. This feature masks out "//&
317 "processors that contain only land points. The first line of mask_table is the "//&
318 "number of regions to be masked out. The second line is the layout of the "//&
319 "model and must be consistent with the actual model layout. The following "//&
320 "(n_mask) lines give the logical positions of the processors that are masked "//&
321 "out. The mask_table can be created by tools like check_mask. The following "//&
322 "example of mask_table masks out 2 processors, (1,2) and (3,6), out of the 24 "//&
323 "in a 4x6 layout: \n 2\n 4,6\n 1,2\n 3,6\n"
324
325 if (auto_mask_table) then
326 id_clock_auto_mask = cpu_clock_id('(Ocean gen_auto_mask_table)', grain=clock_routine)
327 auto_mask_table_fname = "MOM_auto_mask_table"
328
329 ! Auto-generate a mask file and determine the layout
330 call cpu_clock_begin(id_clock_auto_mask)
331 if (is_root_pe()) then
332 call gen_auto_mask_table(n_global, reentrant, tripolar_n, pes_used, param_file, inputdir, &
333 auto_mask_table_fname, auto_layout, us)
334 endif
335 call broadcast(auto_layout, length=2)
336 call cpu_clock_end(id_clock_auto_mask)
337
338 mask_table = auto_mask_table_fname
339 call log_param(param_file, mdl, trim(masktable_nm), mask_table, masktable_desc, &
340 default="MOM_mask_table", layoutparam=.true.)
341 else
342 call get_param(param_file, mdl, trim(masktable_nm), mask_table, masktable_desc, &
343 default="MOM_mask_table", layoutparam=.true.)
344 endif
345
346 ! First, check the run directory for the mask_table input file.
347 mask_table_exists = file_exists(trim(mask_table))
348 ! If not found, check the input directory
349 if (.not. mask_table_exists) then
350 mask_table = trim(inputdir)//trim(mask_table)
351 mask_table_exists = file_exists(mask_table)
352 endif
353
354 if (is_static) then
355 layout(1) = niproc ; layout(2) = njproc
356 else
357 call get_param(param_file, mdl, trim(layout_nm), layout, &
358 "The processor layout to be used, or 0, 0 to automatically set the layout "//&
359 "based on the number of processors.", defaults=(/0, 0/), do_not_log=.true.)
360 call get_param(param_file, mdl, trim(niproc_nm), nip_parsed, &
361 "The number of processors in the x-direction.", default=-1, do_not_log=.true.)
362 call get_param(param_file, mdl, trim(njproc_nm), njp_parsed, &
363 "The number of processors in the y-direction.", default=-1, do_not_log=.true.)
364 if (nip_parsed > -1) then
365 if ((layout(1) > 0) .and. (layout(1) /= nip_parsed)) &
366 call mom_error(fatal, trim(layout_nm)//" and "//trim(niproc_nm)//" set inconsistently. "//&
367 "Only LAYOUT should be used.")
368 layout(1) = nip_parsed
369 call mom_mesg(trim(niproc_nm)//" used to set "//trim(layout_nm)//" in dynamic mode. "//&
370 "Shift to using "//trim(layout_nm)//" instead.")
371 endif
372 if (njp_parsed > -1) then
373 if ((layout(2) > 0) .and. (layout(2) /= njp_parsed)) &
374 call mom_error(fatal, trim(layout_nm)//" and "//trim(njproc_nm)//" set inconsistently. "//&
375 "Only "//trim(layout_nm)//" should be used.")
376 layout(2) = njp_parsed
377 call mom_mesg(trim(njproc_nm)//" used to set "//trim(layout_nm)//" in dynamic mode. "//&
378 "Shift to using "//trim(layout_nm)//" instead.")
379 endif
380
381 if (auto_mask_table) then
382 if (layout(1) /= 0 .and. layout(1) /= auto_layout(1)) then
383 call mom_error(fatal, "Cannot set LAYOUT or NIPROC when AUTO_MASKTABLE is enabled.")
384 endif
385 if (layout(2) /= 0 .and. layout(2) /= auto_layout(2)) then
386 call mom_error(fatal, "Cannot set LAYOUT or NJPROC when AUTO_MASKTABLE is enabled.")
387 endif
388 layout(:) = auto_layout(:)
389 endif
390
391 if ( (layout(1) == 0) .and. (layout(2) == 0) ) &
392 call mom_define_layout(n_global, pes_used, layout)
393 if ( (layout(1) /= 0) .and. (layout(2) == 0) ) layout(2) = pes_used / layout(1)
394 if ( (layout(1) == 0) .and. (layout(2) /= 0) ) layout(1) = pes_used / layout(2)
395
396 if (layout(1)*layout(2) /= pes_used .and. (.not. mask_table_exists) ) then
397 write(mesg,'("MOM_domains_init: The product of the two components of layout, ", &
398 & I0,", ",I0,", is not the number of PEs used, ",I0,".")') &
399 layout(1), layout(2), pes_used
400 call mom_error(fatal, mesg)
401 endif
402 endif
403 call log_param(param_file, mdl, trim(niproc_nm), layout(1), &
404 "The number of processors in the x-direction. With STATIC_MEMORY_ this "//&
405 "is set in "//trim(inc_nm)//" at compile time.", layoutparam=.true.)
406 call log_param(param_file, mdl, trim(njproc_nm), layout(2), &
407 "The number of processors in the y-direction. With STATIC_MEMORY_ this "//&
408 "is set in "//trim(inc_nm)//" at compile time.", layoutparam=.true.)
409 call log_param(param_file, mdl, trim(layout_nm), layout, &
410 "The processor layout that was actually used.", layoutparam=.true.)
411
412 ! Idiot check that fewer PEs than columns have been requested
413 if (layout(1)*layout(2) > n_global(1)*n_global(2)) then
414 write(mesg,'(a,I0,a,I0,a)') 'You requested to use ', layout(1)*layout(2), &
415 ' PEs but there are only ', n_global(1)*n_global(2), ' columns in the model'
416 call mom_error(fatal, mesg)
417 endif
418
419 if (mask_table_exists) &
420 call mom_error(note, 'MOM_domains_init: reading maskmap information from '//trim(mask_table))
421
422 ! Set up the I/O layout, it will be checked later that it uses an even multiple of the number of
423 ! PEs in each direction.
424 io_layout(:) = (/ 1, 1 /)
425
426 ! Compute a valid IO layout if auto_mask_table is on. Otherwise, read in IO_LAYOUT parameter,
427 if (auto_mask_table) then
428 call get_param(param_file, mdl, "AUTO_IO_LAYOUT_FAC", auto_io_layout_fac, &
429 "When AUTO_MASKTABLE is enabled, io layout is calculated by performing integer "//&
430 "division of the runtime-determined domain layout with this factor. If the factor "//&
431 "is set to 0 (default), the io layout is set to 1,1.", &
432 default=0, layoutparam=.true.)
433 if (auto_io_layout_fac>0) then
434 io_layout(1) = max(layout(1)/auto_io_layout_fac, 1)
435 io_layout(2) = max(layout(2)/auto_io_layout_fac, 1)
436 elseif (auto_io_layout_fac<0) then
437 call mom_error(fatal, 'AUTO_IO_LAYOUT_FAC must be a nonnegative integer.')
438 endif
439 call log_param(param_file, mdl, trim(io_layout_nm), io_layout, &
440 "The processor layout to be used, or 0,0 to automatically set the io_layout "//&
441 "to be the same as the layout.", layoutparam=.true.)
442 else
443 call get_param(param_file, mdl, trim(io_layout_nm), io_layout, &
444 "The processor layout to be used, or 0,0 to automatically set the io_layout "//&
445 "to be the same as the layout.", defaults=(/1, 1/), layoutparam=.true.)
446 endif
447
448 ! Create an unmasked domain if requested. This is used for writing out unmasked ocean geometry.
449 if (present(mom_dom_unmasked) .and. mask_table_exists) then
450 call mom_define_layout(n_global, pes_used, layout_unmasked)
451 call create_mom_domain(mom_dom_unmasked, n_global, n_halo, reentrant, tripolar_n, layout_unmasked, &
452 domain_name=domain_name, symmetric=symmetric, thin_halos=thin_halos, &
453 nonblocking=nonblocking)
454 endif
455
456 call create_mom_domain(mom_dom, n_global, n_halo, reentrant, tripolar_n, layout, &
457 io_layout=io_layout, domain_name=domain_name, mask_table=mask_table, &
458 symmetric=symmetric, thin_halos=thin_halos, nonblocking=nonblocking)
459
460end subroutine mom_domains_init
461
462!> Given a global array size and a number of (logical) processors, provide a layout of the
463!! processors in the two directions where the total number of processors is the product of
464!! the two layouts and number of points in the partitioned arrays are as close as possible
465!! to an aspect ratio of 1.
466subroutine mom_define_layout(n_global, ndivs, layout)
467 integer, dimension(2), intent(in) :: n_global !< The total number of gridpoints in 2 directions
468 integer, intent(in) :: ndivs !< The total number of (logical) PEs
469 integer, dimension(2), intent(out) :: layout !< The generated layout of PEs
470
471 ! Local variables
472 integer :: isz, jsz, idiv, jdiv
473
474 ! At present, this algorithm is a copy of mpp_define_layout, but it could perhaps be improved?
475
476 isz = n_global(1) ; jsz = n_global(2)
477 ! First try to divide ndivs to match the domain aspect ratio. If this is not an even
478 ! divisor of ndivs, reduce idiv until a factor is found.
479 idiv = max(nint( sqrt(float(ndivs*isz)/jsz) ), 1)
480 do while( mod(ndivs,idiv) /= 0 )
481 idiv = idiv - 1
482 enddo ! This will terminate at idiv=1 if not before
483 jdiv = ndivs / idiv
484
485 layout = (/ idiv, jdiv /)
486end subroutine mom_define_layout
487
488!> Given a desired number of active npes, generate a layout and mask_table
489subroutine gen_auto_mask_table(n_global, reentrant, tripolar_N, npes, param_file, inputdir, filename, layout, US)
490 integer, dimension(2), intent(in) :: n_global !< The total number of gridpoints in 2 directions
491 logical, dimension(2), intent(in) :: reentrant !< True if the x- and y- directions are periodic.
492 logical, intent(in) :: tripolar_N !< A flag indicating whether there is n. tripolar connectivity
493 integer, intent(in) :: npes !< The desired number of active PEs.
494 type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
495 character(len=128), intent(in) :: inputdir !< INPUTDIR parameter
496 character(len=:), allocatable, intent(in) :: filename !< Mask table file path (to be auto-generated.)
497 integer, dimension(2), intent(out) :: layout !< The generated layout of PEs (incl. masked blocks)
498 type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type
499
500 ! Local variables
501 real, dimension(n_global(1), n_global(2)) :: D ! Bathymetric depth (to be read in from TOPO_FILE) [Z ~> m]
502 integer, dimension(:,:), allocatable :: mask ! Cell masks (based on D and MINIMUM_DEPTH)
503 character(len=200) :: topo_filepath, topo_file ! Strings for file/path
504 character(len=200) :: topo_varname ! Variable name in file
505 character(len=200) :: topo_config
506 character(len=40) :: mdl = "gen_auto_mask_table" ! This subroutine's name.
507 integer :: i, j, p
508 real :: Dmask ! The depth for masking in the same units as D [Z ~> m]
509 real :: min_depth ! The minimum ocean depth in the same units as D [Z ~> m]
510 real :: mask_depth ! The depth shallower than which to mask a point as land. [Z ~> m]
511 real :: glob_ocn_frac ! ratio of ocean points to total number of points [nondim]
512 real :: r_p ! aspect ratio for division count p. [nondim]
513 real :: m_to_Z ! A conversion factor from m to height units [Z m-1 ~> 1]
514 integer :: nx, ny ! global domain sizes
515 integer, parameter :: ibuf=2, jbuf=2
516 real, parameter :: r_extreme = 4.0 ! aspect ratio limit (>1) for a layout to be considered [nondim]
517 integer :: num_masked_blocks
518 integer, allocatable :: mask_table(:,:)
519
520 m_to_z = 1.0 ; if (present(us)) m_to_z = us%m_to_Z
521
522 ! Read in params necessary for auto-masking
523 call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, &
524 units="m", default=0.0, scale=m_to_z, do_not_log=.true.)
525 call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, &
526 units="m", default=-9999.0, scale=m_to_z, do_not_log=.true.)
527 call get_param(param_file, mdl, "TOPO_CONFIG", topo_config, default="file", do_not_log=.true.)
528 call get_param(param_file, mdl, "TOPO_FILE", topo_file, do_not_log=.true., default="topog.nc")
529 call get_param(param_file, mdl, "TOPO_VARNAME", topo_varname, do_not_log=.true., default="depth")
530 topo_filepath = trim(inputdir)//trim(topo_file)
531
532 ! Sanity checks
533 if (.not. is_root_pe()) then
534 call mom_error(fatal, 'gen_auto_mask_table should only be called by the root PE.')
535 endif
536 if (trim(topo_config) /= "file") then
537 call mom_error(fatal, 'Auto mask table only works with TOPO_CONFIG="file"')
538 endif
539 if (.not.file_exists(topo_filepath)) then
540 call mom_error(fatal, " gen_auto_mask_table: Unable to open "//trim(topo_filepath))
541 endif
542
543 nx = n_global(1)
544 ny = n_global(2)
545
546 ! Read in bathymetric depth.
547 d(:,:) = -9.0e30 * m_to_z ! Initializing to a very large negative depth (tall mountains) everywhere.
548 call read_field(topo_filepath, trim(topo_varname), d, start=(/1, 1/), nread=n_global, no_domain=.true., &
549 scale=m_to_z)
550
551 allocate(mask(nx+2*ibuf, ny+2*jbuf), source=0)
552
553 ! Determine cell masks
554 dmask = mask_depth
555 if (mask_depth == -9999.0*m_to_z) dmask = min_depth
556 do i=1,nx ; do j=1,ny
557 if (d(i,j) <= dmask) then
558 mask(i+ibuf,j+jbuf) = 0
559 else
560 mask(i+ibuf,j+jbuf) = 1
561 endif
562 enddo ; enddo
563
564 ! fill in buffer cells
565
566 if (reentrant(1)) then ! REENTRANT_X
567 mask(1:ibuf, :) = mask(nx+1:nx+ibuf, :)
568 mask(ibuf+nx+1:nx+2*ibuf, :) = mask(ibuf+1:2*ibuf, :)
569 endif
570
571 if (reentrant(2)) then ! REENTRANT_Y
572 mask(:, 1:jbuf) = mask(:, ny+1:ny+jbuf)
573 mask(:, jbuf+ny+1:ny+2*jbuf) = mask(:, jbuf+1:2*jbuf)
574 endif
575
576 if (tripolar_n) then ! TRIPOLAR_N
577 do i=1,nx+2*ibuf
578 do j=1,jbuf
579 mask(i, jbuf+ny+j) = mask(nx+2*ibuf+1-i, jbuf+ny+1-j)
580 enddo
581 enddo
582 endif
583
584 ! Tripolar Stitch Fix: In cases where masking is asymmetrical across the tripolar stitch, there's a possibility
585 ! that certain unmasked blocks won't be able to obtain grid metrics from the halo points. This occurs when the
586 ! neighboring block on the opposite side of the tripolar stitch is masked. As a consequence, certain metrics like
587 ! dxT and dyT may be calculated through extrapolation (refer to extrapolate_metric), potentially leading to the
588 ! generation of non-positive values. This can result in divide-by-zero errors elsewhere, e.g., in MOM_hor_visc.F90.
589 ! Currently, the safest and most general solution is to prohibit masking along the tripolar stitch:
590 if (tripolar_n) then
591 mask(:, jbuf+ny) = 1
592 endif
593
594 glob_ocn_frac = real(sum(mask(1+ibuf:nx+ibuf, 1+jbuf:ny+jbuf))) / (nx * ny)
595
596 ! Iteratively check for all possible division counts starting from the upper bound of npes/glob_ocn_frac,
597 ! which is over-optimistic for realistic domains, but may be satisfied with idealized domains.
598 do p = ceiling(npes/glob_ocn_frac), npes, -1
599
600 ! compute the layout for the current division count, p
601 call mom_define_layout(n_global, p, layout)
602
603 ! don't bother checking this p if the aspect ratio is extreme
604 r_p = (real(nx)/layout(1)) / (real(ny)/layout(2))
605 if ( r_p * r_extreme < 1 .or. r_extreme < r_p ) cycle
606
607 ! Get the number of masked_blocks for this particular division count
608 call determine_land_blocks(mask, nx, ny, layout(1), layout(2), ibuf, jbuf, num_masked_blocks)
609
610 ! If we can eliminate enough blocks to reach the target npes, adopt
611 ! this p (and the associated layout) and terminate the iteration.
612 if (p-num_masked_blocks <= npes) then
613 call mom_error(note, "Found the optimum layout for auto-masking. Terminating iteration...")
614 exit
615 endif
616 enddo
617
618 if (num_masked_blocks == 0) then
619 call mom_error(fatal, "Couldn't auto-eliminate any land blocks. Try to increase the number "//&
620 "of MOM6 PEs or set AUTO_MASKTABLE to False.")
621 endif
622
623 ! Call determine_land_blocks once again, this time to retrieve and write out the mask_table.
624 allocate(mask_table(num_masked_blocks,2))
625 call determine_land_blocks(mask, nx, ny, layout(1), layout(2), ibuf, jbuf, num_masked_blocks, mask_table)
626 call write_auto_mask_file(mask_table, layout, npes, filename)
627 deallocate(mask_table)
628 deallocate(mask)
629
630end subroutine gen_auto_mask_table
631
632!> Given a number of domain divisions, compute the max number of land blocks that can be eliminated,
633!! and return the resulting mask table if requested.
634subroutine determine_land_blocks(mask, nx, ny, idiv, jdiv, ibuf, jbuf, num_masked_blocks, mask_table)
635 integer, dimension(:,:), intent(in) :: mask !< cell masks based on depth and MINIMUM_DEPTH
636 integer, intent(in) :: nx !< Total number of gridpoints in x-dir (global)
637 integer, intent(in) :: ny !< Total number of gridpoints in y-dir (global)
638 integer, intent(in) :: idiv !< number of divisions along x-dir
639 integer, intent(in) :: jdiv !< number of divisions along y-dir
640 integer, intent(in) :: ibuf !< number of buffer cells in x-dir.
641 !! (not necessarily the same as NIHALO)
642 integer, intent(in) :: jbuf !< number of buffer cells in y-dir.
643 !! (not necessarily the same as NJHALO)
644 integer, intent(out) :: num_masked_blocks !< the final number of masked blocks
645 integer, intent(out), optional :: mask_table(:,:) !< the resulting array of mask_table
646 ! integer
647 integer, dimension(idiv) :: ibegin !< The starting index of each division along x axis
648 integer, dimension(idiv) :: iend !< The ending index of each division along x axis
649 integer, dimension(jdiv) :: jbegin !< The starting index of each division along y axis
650 integer, dimension(jdiv) :: jend !< The ending index of each division along y axis
651 integer :: i, j, ib, ie, jb,je
652
653 call compute_extent(1, nx, idiv, ibegin, iend)
654 call compute_extent(1, ny, jdiv, jbegin, jend)
655
656 num_masked_blocks = 0
657
658 do i=1,idiv
659 ib = ibegin(i)
660 ie = iend(i) + 2 * ibuf
661 do j=1,jdiv
662 jb = jbegin(j)
663 je = jend(j) + 2 * jbuf
664
665 if (any(mask(ib:ie,jb:je)==1)) cycle
666
667 num_masked_blocks = num_masked_blocks + 1
668
669 if (present(mask_table)) then
670 if ( num_masked_blocks > size(mask_table, dim=1)) then
671 call mom_error(fatal, "The mask_table argument passed to determine_land_blocks() has insufficient size.")
672 endif
673
674 mask_table(num_masked_blocks,1) = i
675 mask_table(num_masked_blocks,2) = j
676 endif
677 enddo
678 enddo
679
680end subroutine determine_land_blocks
681
682!> Write out the auto-generated mask information to a file in the run directory.
683subroutine write_auto_mask_file(mask_table, layout, npes, filename)
684 integer, intent(in) :: mask_table(:,:) !> mask table array to be written out.
685 integer, dimension(2), intent(in) :: layout !> PE layout
686 integer, intent(in) :: npes !> Number of divisions (incl. eliminated ones)
687 character(len=:), allocatable, intent(in) :: filename !> file name for the mask_table to be written
688 ! local
689 integer :: file_ascii= -1 !< The unit number of the auto-generated mask_file file.
690 integer :: true_num_masked_blocks
691 integer :: p
692
693 ! Eliminate only enough blocks to ensure that the number of active blocks precisely matches the target npes.
694 true_num_masked_blocks = layout(1) * layout(2) - npes
695
696 call open_ascii_file(file_ascii, trim(filename), action=writeonly_file)
697 write(file_ascii, '(I0)') true_num_masked_blocks
698 write(file_ascii, '(I0,",",I0)') layout(1), layout(2)
699 do p = 1, true_num_masked_blocks
700 write(file_ascii, '(I0,",",I0)') mask_table(p,1), mask_table(p,2)
701 enddo
702 call close_file(file_ascii)
703end subroutine write_auto_mask_file
704
705end module mom_domains