MOM6
MOM_domains.F90
1 !> Describes the decomposed MOM domain and has routines for communications across PEs
2 module mom_domains
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
6 use mom_array_transform, only : rotate_array
7 use mom_coms, only : pe_here, root_pe, num_pes, mom_infra_init, mom_infra_end
8 use mom_coms, only : broadcast, sum_across_pes, min_across_pes, max_across_pes
9 use mom_cpu_clock, only : cpu_clock_begin, cpu_clock_end
10 use mom_error_handler, only : mom_error, mom_mesg, note, warning, fatal, is_root_pe
11 use mom_file_parser, only : get_param, log_param, log_version
12 use mom_file_parser, only : param_file_type
13 use mom_string_functions, only : slasher
14 
15 use mpp_domains_mod, only : mpp_define_layout, mpp_get_boundary
16 use mpp_domains_mod, only : mom_define_io_domain => mpp_define_io_domain
17 use mpp_domains_mod, only : mom_define_domain => mpp_define_domains
18 use mpp_domains_mod, only : domain2d, domain1d, mpp_get_data_domain
19 use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_global_domain
20 use mpp_domains_mod, only : global_field_sum => mpp_global_sum
21 use mpp_domains_mod, only : mpp_update_domains, cyclic_global_domain, fold_north_edge
22 use mpp_domains_mod, only : mpp_start_update_domains, mpp_complete_update_domains
23 use mpp_domains_mod, only : mpp_create_group_update, mpp_do_group_update
24 use mpp_domains_mod, only : group_pass_type => mpp_group_update_type
25 use mpp_domains_mod, only : mpp_reset_group_update_field
26 use mpp_domains_mod, only : mpp_group_update_initialized
27 use mpp_domains_mod, only : mpp_start_group_update, mpp_complete_group_update
28 use mpp_domains_mod, only : compute_block_extent => mpp_compute_block_extent
29 use mpp_domains_mod, only : agrid, bgrid_ne, cgrid_ne, scalar_pair, bitwise_exact_sum
30 use mpp_domains_mod, only : to_east => wupdate, to_west => eupdate, omit_corners => edgeupdate
31 use mpp_domains_mod, only : to_north => supdate, to_south => nupdate
32 use mpp_domains_mod, only : center, corner, north_face => north, east_face => east
33 use fms_io_mod, only : file_exist, parse_mask_table
34 use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set, fms_affinity_get
35 
36 implicit none ; private
37 
38 public :: mom_domains_init, mom_infra_init, mom_infra_end, get_domain_extent, get_domain_extent_dsamp2
39 public :: mom_define_domain, mom_define_io_domain, clone_mom_domain
40 public :: pass_var, pass_vector, pe_here, root_pe, num_pes
41 public :: pass_var_start, pass_var_complete, fill_symmetric_edges, broadcast
42 public :: pass_vector_start, pass_vector_complete
43 public :: global_field_sum, sum_across_pes, min_across_pes, max_across_pes
44 public :: agrid, bgrid_ne, cgrid_ne, scalar_pair, bitwise_exact_sum
45 public :: corner, center, north_face, east_face
46 public :: to_east, to_west, to_north, to_south, to_all, omit_corners
47 public :: create_group_pass, do_group_pass, group_pass_type
48 public :: start_group_pass, complete_group_pass
49 public :: compute_block_extent, get_global_shape
50 public :: get_simple_array_i_ind, get_simple_array_j_ind
51 public :: domain2d
52 
53 !> Do a halo update on an array
54 interface pass_var
55  module procedure pass_var_3d, pass_var_2d
56 end interface pass_var
57 
58 !> Do a halo update on a pair of arrays representing the two components of a vector
59 interface pass_vector
60  module procedure pass_vector_3d, pass_vector_2d
61 end interface pass_vector
62 
63 !> Initiate a non-blocking halo update on an array
64 interface pass_var_start
65  module procedure pass_var_start_3d, pass_var_start_2d
66 end interface pass_var_start
67 
68 !> Complete a non-blocking halo update on an array
69 interface pass_var_complete
70  module procedure pass_var_complete_3d, pass_var_complete_2d
71 end interface pass_var_complete
72 
73 !> Initiate a halo update on a pair of arrays representing the two components of a vector
74 interface pass_vector_start
75  module procedure pass_vector_start_3d, pass_vector_start_2d
76 end interface pass_vector_start
77 
78 !> Complete a halo update on a pair of arrays representing the two components of a vector
79 interface pass_vector_complete
80  module procedure pass_vector_complete_3d, pass_vector_complete_2d
81 end interface pass_vector_complete
82 
83 !> Set up a group of halo updates
84 interface create_group_pass
85  module procedure create_var_group_pass_2d
86  module procedure create_var_group_pass_3d
87  module procedure create_vector_group_pass_2d
88  module procedure create_vector_group_pass_3d
89 end interface create_group_pass
90 
91 !> Do a set of halo updates that fill in the values at the duplicated edges
92 !! of a staggered symmetric memory domain
93 interface fill_symmetric_edges
94  module procedure fill_vector_symmetric_edges_2d !, fill_vector_symmetric_edges_3d
95 ! module procedure fill_scalar_symmetric_edges_2d, fill_scalar_symmetric_edges_3d
96 end interface fill_symmetric_edges
97 
98 !> Copy one MOM_domain_type into another
99 interface clone_mom_domain
100  module procedure clone_md_to_md, clone_md_to_d2d
101 end interface clone_mom_domain
102 
103 !> The MOM_domain_type contains information about the domain decompositoin.
104 type, public :: mom_domain_type
105  type(domain2d), pointer :: mpp_domain => null() !< The FMS domain with halos
106  !! on this processor, centered at h points.
107  type(domain2d), pointer :: mpp_domain_d2 => null() !< A coarse FMS domain with halos
108  !! on this processor, centered at h points.
109  integer :: niglobal !< The total horizontal i-domain size.
110  integer :: njglobal !< The total horizontal j-domain size.
111  integer :: nihalo !< The i-halo size in memory.
112  integer :: njhalo !< The j-halo size in memory.
113  logical :: symmetric !< True if symmetric memory is used with
114  !! this domain.
115  logical :: nonblocking_updates !< If true, non-blocking halo updates are
116  !! allowed. The default is .false. (for now).
117  logical :: thin_halo_updates !< If true, optional arguments may be used to
118  !! specify the width of the halos that are
119  !! updated with each call.
120  integer :: layout(2) !< This domain's processor layout. This is
121  !! saved to enable the construction of related
122  !! new domains with different resolutions or
123  !! other properties.
124  integer :: io_layout(2) !< The IO-layout used with this domain.
125  integer :: x_flags !< Flag that specifies the properties of the
126  !! domain in the i-direction in a define_domain call.
127  integer :: y_flags !< Flag that specifies the properties of the
128  !! domain in the j-direction in a define_domain call.
129  logical, pointer :: maskmap(:,:) => null() !< A pointer to an array indicating
130  !! which logical processors are actually used for
131  !! the ocean code. The other logical processors
132  !! would be contain only land points and are not
133  !! assigned to actual processors. This need not be
134  !! assigned if all logical processors are used.
135 end type mom_domain_type
136 
137 integer, parameter :: to_all = to_east + to_west + to_north + to_south !< A flag for passing in all directions
138 
139 contains
140 
141 !> pass_var_3d does a halo update for a three-dimensional array.
142 subroutine pass_var_3d(array, MOM_dom, sideflag, complete, position, halo, &
143  clock)
144  real, dimension(:,:,:), intent(inout) :: array !< The array which is having its halos points
145  !! exchanged.
146  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
147  !! needed to determine where data should be
148  !! sent.
149  integer, optional, intent(in) :: sideflag !< An optional integer indicating which
150  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
151  !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east,
152  !! sothe halos on the western side are filled. TO_ALL is the default if sideflag is omitted.
153  logical, optional, intent(in) :: complete !< An optional argument indicating whether the
154  !! halo updates should be completed before
155  !! progress resumes. Omitting complete is the
156  !! same as setting complete to .true.
157  integer, optional, intent(in) :: position !< An optional argument indicating the position.
158  !! This is CENTER by default and is often CORNER,
159  !! but could also be EAST_FACE or NORTH_FACE.
160  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
161  !! halo by default.
162  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
163  !! started then stopped to time this routine.
164 
165  integer :: dirflag
166  logical :: block_til_complete
167 
168  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
169 
170  dirflag = to_all ! 60
171  if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif
172  block_til_complete = .true.
173  if (present(complete)) block_til_complete = complete
174 
175  if (present(halo) .and. mom_dom%thin_halo_updates) then
176  call mpp_update_domains(array, mom_dom%mpp_domain, flags=dirflag, &
177  complete=block_til_complete, position=position, &
178  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
179  else
180  call mpp_update_domains(array, mom_dom%mpp_domain, flags=dirflag, &
181  complete=block_til_complete, position=position)
182  endif
183 
184  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
185 
186 end subroutine pass_var_3d
187 
188 !> pass_var_2d does a halo update for a two-dimensional array.
189 subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo, inner_halo, clock)
190  real, dimension(:,:), intent(inout) :: array !< The array which is having its halos points
191  !! exchanged.
192  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
193  !! needed to determine where data should be sent.
194  integer, optional, intent(in) :: sideflag !< An optional integer indicating which
195  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
196  !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east,
197  !! so the halos on the western side are filled. TO_ALL is the default if sideflag is omitted.
198  logical, optional, intent(in) :: complete !< An optional argument indicating whether the
199  !! halo updates should be completed before
200  !! progress resumes. Omitting complete is the
201  !! same as setting complete to .true.
202  integer, optional, intent(in) :: position !< An optional argument indicating the position.
203  !! This is CENTER by default and is often CORNER,
204  !! but could also be EAST_FACE or NORTH_FACE.
205  integer, optional, intent(in) :: halo !< The size of the halo to update - the full halo
206  !! by default.
207  integer, optional, intent(in) :: inner_halo !< The size of an inner halo to avoid updating,
208  !! or 0 to avoid updating symmetric memory
209  !! computational domain points. Setting this >=0
210  !! also enforces that complete=.true.
211  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
212  !! started then stopped to time this routine.
213 
214  ! Local variables
215  real, allocatable, dimension(:,:) :: tmp
216  integer :: pos, i_halo, j_halo
217  integer :: isc, iec, jsc, jec, isd, ied, jsd, jed, IscB, IecB, JscB, JecB
218  integer :: inner, i, j, isfw, iefw, isfe, iefe, jsfs, jefs, jsfn, jefn
219  integer :: dirflag
220  logical :: block_til_complete
221 
222  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
223 
224  dirflag = to_all ! 60
225  if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif
226  block_til_complete = .true. ; if (present(complete)) block_til_complete = complete
227  pos = center ; if (present(position)) pos = position
228 
229  if (present(inner_halo)) then ; if (inner_halo >= 0) then
230  ! Store the original values.
231  allocate(tmp(size(array,1), size(array,2)))
232  tmp(:,:) = array(:,:)
233  block_til_complete = .true.
234  endif ; endif
235 
236  if (present(halo) .and. mom_dom%thin_halo_updates) then
237  call mpp_update_domains(array, mom_dom%mpp_domain, flags=dirflag, &
238  complete=block_til_complete, position=position, &
239  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
240  else
241  call mpp_update_domains(array, mom_dom%mpp_domain, flags=dirflag, &
242  complete=block_til_complete, position=position)
243  endif
244 
245  if (present(inner_halo)) then ; if (inner_halo >= 0) then
246  call mpp_get_compute_domain(mom_dom%mpp_domain, isc, iec, jsc, jec)
247  call mpp_get_data_domain(mom_dom%mpp_domain, isd, ied, jsd, jed)
248  ! Convert to local indices for arrays starting at 1.
249  isc = isc - (isd-1) ; iec = iec - (isd-1) ; ied = ied - (isd-1) ; isd = 1
250  jsc = jsc - (jsd-1) ; jec = jec - (jsd-1) ; jed = jed - (jsd-1) ; jsd = 1
251  i_halo = min(inner_halo, isc-1) ; j_halo = min(inner_halo, jsc-1)
252 
253  ! Figure out the array index extents of the eastern, western, northern and southern regions to copy.
254  if (pos == center) then
255  if (size(array,1) == ied) then
256  isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo
257  else ; call mom_error(fatal, "pass_var_2d: wrong i-size for CENTER array.") ; endif
258  if (size(array,2) == jed) then
259  isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo
260  else ; call mom_error(fatal, "pass_var_2d: wrong j-size for CENTER array.") ; endif
261  elseif (pos == corner) then
262  if (size(array,1) == ied) then
263  isfw = max(isc - (i_halo+1), 1) ; iefw = isc ; isfe = iec ; iefe = iec + i_halo
264  elseif (size(array,1) == ied+1) then
265  isfw = isc - i_halo ; iefw = isc+1 ; isfe = iec+1 ; iefe = min(iec + 1 + i_halo, ied+1)
266  else ; call mom_error(fatal, "pass_var_2d: wrong i-size for CORNER array.") ; endif
267  if (size(array,2) == jed) then
268  jsfs = max(jsc - (j_halo+1), 1) ; jefs = jsc ; jsfn = jec ; jefn = jec + j_halo
269  elseif (size(array,2) == jed+1) then
270  jsfs = jsc - j_halo ; jefs = jsc+1 ; jsfn = jec+1 ; jefn = min(jec + 1 + j_halo, jed+1)
271  else ; call mom_error(fatal, "pass_var_2d: wrong j-size for CORNER array.") ; endif
272  elseif (pos == north_face) then
273  if (size(array,1) == ied) then
274  isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo
275  else ; call mom_error(fatal, "pass_var_2d: wrong i-size for NORTH_FACE array.") ; endif
276  if (size(array,2) == jed) then
277  jsfs = max(jsc - (j_halo+1), 1) ; jefs = jsc ; jsfn = jec ; jefn = jec + j_halo
278  elseif (size(array,2) == jed+1) then
279  jsfs = jsc - j_halo ; jefs = jsc+1 ; jsfn = jec+1 ; jefn = min(jec + 1 + j_halo, jed+1)
280  else ; call mom_error(fatal, "pass_var_2d: wrong j-size for NORTH_FACE array.") ; endif
281  elseif (pos == east_face) then
282  if (size(array,1) == ied) then
283  isfw = max(isc - (i_halo+1), 1) ; iefw = isc ; isfe = iec ; iefe = iec + i_halo
284  elseif (size(array,1) == ied+1) then
285  isfw = isc - i_halo ; iefw = isc+1 ; isfe = iec+1 ; iefe = min(iec + 1 + i_halo, ied+1)
286  else ; call mom_error(fatal, "pass_var_2d: wrong i-size for EAST_FACE array.") ; endif
287  if (size(array,2) == jed) then
288  isfw = isc - i_halo ; iefw = isc ; isfe = iec ; iefe = iec + i_halo
289  else ; call mom_error(fatal, "pass_var_2d: wrong j-size for EAST_FACE array.") ; endif
290  else
291  call mom_error(fatal, "pass_var_2d: Unrecognized position")
292  endif
293 
294  ! Copy back the stored inner halo points
295  do j=jsfs,jefn ; do i=isfw,iefw ; array(i,j) = tmp(i,j) ; enddo ; enddo
296  do j=jsfs,jefn ; do i=isfe,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo
297  do j=jsfs,jefs ; do i=isfw,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo
298  do j=jsfn,jefn ; do i=isfw,iefe ; array(i,j) = tmp(i,j) ; enddo ; enddo
299 
300  deallocate(tmp)
301  endif ; endif
302 
303  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
304 
305 end subroutine pass_var_2d
306 
307 !> pass_var_start_2d starts a halo update for a two-dimensional array.
308 function pass_var_start_2d(array, MOM_dom, sideflag, position, complete, halo, &
309  clock)
310  real, dimension(:,:), intent(inout) :: array !< The array which is having its halos points
311  !! exchanged.
312  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
313  !! needed to determine where data should be
314  !! sent.
315  integer, optional, intent(in) :: sideflag !< An optional integer indicating which
316  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
317  !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east,
318  !! so the halos on the western side are filled. TO_ALL is the default if sideflag is omitted.
319  integer, optional, intent(in) :: position !< An optional argument indicating the position.
320  !! This is CENTER by default and is often CORNER,
321  !! but could also be EAST_FACE or NORTH_FACE.
322  logical, optional, intent(in) :: complete !< An optional argument indicating whether the
323  !! halo updates should be completed before
324  !! progress resumes. Omitting complete is the
325  !! same as setting complete to .true.
326  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
327  !! halo by default.
328  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
329  !! started then stopped to time this routine.
330  integer :: pass_var_start_2d !<The integer index for this update.
331 
332  integer :: dirflag
333 
334  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
335 
336  dirflag = to_all ! 60
337  if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif
338 
339  if (present(halo) .and. mom_dom%thin_halo_updates) then
340  pass_var_start_2d = mpp_start_update_domains(array, mom_dom%mpp_domain, &
341  flags=dirflag, position=position, &
342  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
343  else
344  pass_var_start_2d = mpp_start_update_domains(array, mom_dom%mpp_domain, &
345  flags=dirflag, position=position)
346  endif
347 
348  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
349 
350 end function pass_var_start_2d
351 
352 !> pass_var_start_3d starts a halo update for a three-dimensional array.
353 function pass_var_start_3d(array, MOM_dom, sideflag, position, complete, halo, &
354  clock)
355  real, dimension(:,:,:), intent(inout) :: array !< The array which is having its halos points
356  !! exchanged.
357  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
358  !! needed to determine where data should be
359  !! sent.
360  integer, optional, intent(in) :: sideflag !< An optional integer indicating which
361  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
362  !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east,
363  !! so the halos on the western side are filled. TO_ALL is the default if sideflag is omitted.
364  integer, optional, intent(in) :: position !< An optional argument indicating the position.
365  !! This is CENTER by default and is often CORNER,
366  !! but could also be EAST_FACE or NORTH_FACE.
367  logical, optional, intent(in) :: complete !< An optional argument indicating whether the
368  !! halo updates should be completed before
369  !! progress resumes. Omitting complete is the
370  !! same as setting complete to .true.
371  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
372  !! halo by default.
373  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
374  !! started then stopped to time this routine.
375  integer :: pass_var_start_3d !< The integer index for this update.
376 
377  integer :: dirflag
378 
379  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
380 
381  dirflag = to_all ! 60
382  if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif
383 
384  if (present(halo) .and. mom_dom%thin_halo_updates) then
385  pass_var_start_3d = mpp_start_update_domains(array, mom_dom%mpp_domain, &
386  flags=dirflag, position=position, &
387  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
388  else
389  pass_var_start_3d = mpp_start_update_domains(array, mom_dom%mpp_domain, &
390  flags=dirflag, position=position)
391  endif
392 
393  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
394 
395 end function pass_var_start_3d
396 
397 !> pass_var_complete_2d completes a halo update for a two-dimensional array.
398 subroutine pass_var_complete_2d(id_update, array, MOM_dom, sideflag, position, halo, &
399  clock)
400  integer, intent(in) :: id_update !< The integer id of this update which has
401  !! been returned from a previous call to
402  !! pass_var_start.
403  real, dimension(:,:), intent(inout) :: array !< The array which is having its halos points
404  !! exchanged.
405  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
406  !! needed to determine where data should be
407  !! sent.
408  integer, optional, intent(in) :: sideflag !< An optional integer indicating which
409  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
410  !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east,
411  !! so the halos on the western side are filled. TO_ALL is the default if sideflag is omitted.
412  integer, optional, intent(in) :: position !< An optional argument indicating the position.
413  !! This is CENTER by default and is often CORNER,
414  !! but could also be EAST_FACE or NORTH_FACE.
415  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
416  !! halo by default.
417  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
418  !! started then stopped to time this routine.
419 
420  integer :: dirflag
421 
422  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
423 
424  dirflag = to_all ! 60
425  if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif
426 
427  if (present(halo) .and. mom_dom%thin_halo_updates) then
428  call mpp_complete_update_domains(id_update, array, mom_dom%mpp_domain, &
429  flags=dirflag, position=position, &
430  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
431  else
432  call mpp_complete_update_domains(id_update, array, mom_dom%mpp_domain, &
433  flags=dirflag, position=position)
434  endif
435 
436  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
437 
438 end subroutine pass_var_complete_2d
439 
440 !> pass_var_complete_3d completes a halo update for a three-dimensional array.
441 subroutine pass_var_complete_3d(id_update, array, MOM_dom, sideflag, position, halo, &
442  clock)
443  integer, intent(in) :: id_update !< The integer id of this update which has
444  !! been returned from a previous call to
445  !! pass_var_start.
446  real, dimension(:,:,:), intent(inout) :: array !< The array which is having its halos points
447  !! exchanged.
448  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
449  !! needed to determine where data should be
450  !! sent.
451  integer, optional, intent(in) :: sideflag !< An optional integer indicating which
452  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
453  !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east,
454  !! so the halos on the western side are filled. TO_ALL is the default if sideflag is omitted.
455  integer, optional, intent(in) :: position !< An optional argument indicating the position.
456  !! This is CENTER by default and is often CORNER,
457  !! but could also be EAST_FACE or NORTH_FACE.
458  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
459  !! halo by default.
460  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
461  !! started then stopped to time this routine.
462 
463  integer :: dirflag
464 
465  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
466 
467  dirflag = to_all ! 60
468  if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif
469 
470  if (present(halo) .and. mom_dom%thin_halo_updates) then
471  call mpp_complete_update_domains(id_update, array, mom_dom%mpp_domain, &
472  flags=dirflag, position=position, &
473  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
474  else
475  call mpp_complete_update_domains(id_update, array, mom_dom%mpp_domain, &
476  flags=dirflag, position=position)
477  endif
478 
479  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
480 
481 end subroutine pass_var_complete_3d
482 
483 !> pass_vector_2d does a halo update for a pair of two-dimensional arrays
484 !! representing the compontents of a two-dimensional horizontal vector.
485 subroutine pass_vector_2d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete, halo, &
486  clock)
487  real, dimension(:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector
488  !! pair which is having its halos points
489  !! exchanged.
490  real, dimension(:,:), intent(inout) :: v_cmpt !< The nominal meridional (v) component of the
491  !! vector pair which is having its halos points
492  !! exchanged.
493  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
494  !! needed to determine where data should be
495  !! sent.
496  integer, optional, intent(in) :: direction !< An optional integer indicating which
497  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
498  !! TO_NORTH, and TO_SOUTH, possibly plus SCALAR_PAIR if these are paired non-directional
499  !! scalars discretized at the typical vector component locations. For example, TO_EAST sends
500  !! the data to the processor to the east, so the halos on the western side are filled. TO_ALL
501  !! is the default if omitted.
502  integer, optional, intent(in) :: stagger !< An optional flag, which may be one of A_GRID,
503  !! BGRID_NE, or CGRID_NE, indicating where the two components of the vector are
504  !! discretized. Omitting stagger is the same as setting it to CGRID_NE.
505  logical, optional, intent(in) :: complete !< An optional argument indicating whether the
506  !! halo updates should be completed before progress resumes.
507  !! Omitting complete is the same as setting complete to .true.
508  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
509  !! halo by default.
510  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
511  !! started then stopped to time this routine.
512 
513  ! Local variables
514  integer :: stagger_local
515  integer :: dirflag
516  logical :: block_til_complete
517 
518  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
519 
520  stagger_local = cgrid_ne ! Default value for type of grid
521  if (present(stagger)) stagger_local = stagger
522 
523  dirflag = to_all ! 60
524  if (present(direction)) then ; if (direction > 0) dirflag = direction ; endif
525  block_til_complete = .true.
526  if (present(complete)) block_til_complete = complete
527 
528  if (present(halo) .and. mom_dom%thin_halo_updates) then
529  call mpp_update_domains(u_cmpt, v_cmpt, mom_dom%mpp_domain, flags=dirflag, &
530  gridtype=stagger_local, complete = block_til_complete, &
531  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
532  else
533  call mpp_update_domains(u_cmpt, v_cmpt, mom_dom%mpp_domain, flags=dirflag, &
534  gridtype=stagger_local, complete = block_til_complete)
535  endif
536 
537  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
538 
539 end subroutine pass_vector_2d
540 
541 !> fill_vector_symmetric_edges_2d does an usual set of halo updates that only
542 !! fill in the values at the edge of a pair of symmetric memory two-dimensional
543 !! arrays representing the compontents of a two-dimensional horizontal vector.
544 !! If symmetric memory is not being used, this subroutine does nothing except to
545 !! possibly turn optional cpu clocks on or off.
546 subroutine fill_vector_symmetric_edges_2d(u_cmpt, v_cmpt, MOM_dom, stagger, scalar, &
547  clock)
548  real, dimension(:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector
549  !! pair which is having its halos points
550  !! exchanged.
551  real, dimension(:,:), intent(inout) :: v_cmpt !< The nominal meridional (v) component of the
552  !! vector pair which is having its halos points
553  !! exchanged.
554  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
555  !! needed to determine where data should be
556  !! sent.
557  integer, optional, intent(in) :: stagger !< An optional flag, which may be one of A_GRID,
558  !! BGRID_NE, or CGRID_NE, indicating where the two components of the vector are
559  !! discretized. Omitting stagger is the same as setting it to CGRID_NE.
560  logical, optional, intent(in) :: scalar !< An optional argument indicating whether.
561  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
562  !! started then stopped to time this routine.
563 
564  ! Local variables
565  integer :: stagger_local
566  integer :: dirflag
567  integer :: i, j, isc, iec, jsc, jec, isd, ied, jsd, jed, IscB, IecB, JscB, JecB
568  real, allocatable, dimension(:) :: sbuff_x, sbuff_y, wbuff_x, wbuff_y
569  logical :: block_til_complete
570 
571  if (.not. mom_dom%symmetric) then
572  return
573  endif
574 
575  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
576 
577  stagger_local = cgrid_ne ! Default value for type of grid
578  if (present(stagger)) stagger_local = stagger
579 
580  if (.not.(stagger_local == cgrid_ne .or. stagger_local == bgrid_ne)) return
581 
582  call mpp_get_compute_domain(mom_dom%mpp_domain, isc, iec, jsc, jec)
583  call mpp_get_data_domain(mom_dom%mpp_domain, isd, ied, jsd, jed)
584 
585  ! Adjust isc, etc., to account for the fact that the input arrays indices all
586  ! start at 1 (and are effectively on a SW grid!).
587  isc = isc - (isd-1) ; iec = iec - (isd-1)
588  jsc = jsc - (jsd-1) ; jec = jec - (jsd-1)
589  iscb = isc ; iecb = iec+1 ; jscb = jsc ; jecb = jec+1
590 
591  dirflag = to_all ! 60
592  if (present(scalar)) then ; if (scalar) dirflag = to_all+scalar_pair ; endif
593 
594  if (stagger_local == cgrid_ne) then
595  allocate(wbuff_x(jsc:jec)) ; allocate(sbuff_y(isc:iec))
596  wbuff_x(:) = 0.0 ; sbuff_y(:) = 0.0
597  call mpp_get_boundary(u_cmpt, v_cmpt, mom_dom%mpp_domain, flags=dirflag, &
598  wbufferx=wbuff_x, sbuffery=sbuff_y, &
599  gridtype=cgrid_ne)
600  do i=isc,iec
601  v_cmpt(i,jscb) = sbuff_y(i)
602  enddo
603  do j=jsc,jec
604  u_cmpt(iscb,j) = wbuff_x(j)
605  enddo
606  deallocate(wbuff_x) ; deallocate(sbuff_y)
607  elseif (stagger_local == bgrid_ne) then
608  allocate(wbuff_x(jscb:jecb)) ; allocate(sbuff_x(iscb:iecb))
609  allocate(wbuff_y(jscb:jecb)) ; allocate(sbuff_y(iscb:iecb))
610  wbuff_x(:) = 0.0 ; wbuff_y(:) = 0.0 ; sbuff_x(:) = 0.0 ; sbuff_y(:) = 0.0
611  call mpp_get_boundary(u_cmpt, v_cmpt, mom_dom%mpp_domain, flags=dirflag, &
612  wbufferx=wbuff_x, sbufferx=sbuff_x, &
613  wbuffery=wbuff_y, sbuffery=sbuff_y, &
614  gridtype=bgrid_ne)
615  do i=iscb,iecb
616  u_cmpt(i,jscb) = sbuff_x(i) ; v_cmpt(i,jscb) = sbuff_y(i)
617  enddo
618  do j=jscb,jecb
619  u_cmpt(iscb,j) = wbuff_x(j) ; v_cmpt(iscb,j) = wbuff_y(j)
620  enddo
621  deallocate(wbuff_x) ; deallocate(sbuff_x)
622  deallocate(wbuff_y) ; deallocate(sbuff_y)
623  endif
624 
625  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
626 
627 end subroutine fill_vector_symmetric_edges_2d
628 
629 !> pass_vector_3d does a halo update for a pair of three-dimensional arrays
630 !! representing the compontents of a three-dimensional horizontal vector.
631 subroutine pass_vector_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete, halo, &
632  clock)
633  real, dimension(:,:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector
634  !! pair which is having its halos points
635  !! exchanged.
636  real, dimension(:,:,:), intent(inout) :: v_cmpt !< The nominal meridional (v) component of the
637  !! vector pair which is having its halos points
638  !! exchanged.
639  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
640  !! needed to determine where data should be
641  !! sent.
642  integer, optional, intent(in) :: direction !< An optional integer indicating which
643  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
644  !! TO_NORTH, and TO_SOUTH, possibly plus SCALAR_PAIR if these are paired non-directional
645  !! scalars discretized at the typical vector component locations. For example, TO_EAST sends
646  !! the data to the processor to the east, so the halos on the western side are filled. TO_ALL
647  !! is the default if omitted.
648  integer, optional, intent(in) :: stagger !< An optional flag, which may be one of A_GRID,
649  !! BGRID_NE, or CGRID_NE, indicating where the two components of the vector are
650  !! discretized. Omitting stagger is the same as setting it to CGRID_NE.
651  logical, optional, intent(in) :: complete !< An optional argument indicating whether the
652  !! halo updates should be completed before progress resumes.
653  !! Omitting complete is the same as setting complete to .true.
654  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
655  !! halo by default.
656  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
657  !! started then stopped to time this routine.
658 
659  ! Local variables
660  integer :: stagger_local
661  integer :: dirflag
662  logical :: block_til_complete
663 
664  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
665 
666  stagger_local = cgrid_ne ! Default value for type of grid
667  if (present(stagger)) stagger_local = stagger
668 
669  dirflag = to_all ! 60
670  if (present(direction)) then ; if (direction > 0) dirflag = direction ; endif
671  block_til_complete = .true.
672  if (present(complete)) block_til_complete = complete
673 
674  if (present(halo) .and. mom_dom%thin_halo_updates) then
675  call mpp_update_domains(u_cmpt, v_cmpt, mom_dom%mpp_domain, flags=dirflag, &
676  gridtype=stagger_local, complete = block_til_complete, &
677  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
678  else
679  call mpp_update_domains(u_cmpt, v_cmpt, mom_dom%mpp_domain, flags=dirflag, &
680  gridtype=stagger_local, complete = block_til_complete)
681  endif
682 
683  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
684 
685 end subroutine pass_vector_3d
686 
687 !> pass_vector_start_2d starts a halo update for a pair of two-dimensional arrays
688 !! representing the compontents of a two-dimensional horizontal vector.
689 function pass_vector_start_2d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete, halo, &
690  clock)
691  real, dimension(:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector
692  !! pair which is having its halos points
693  !! exchanged.
694  real, dimension(:,:), intent(inout) :: v_cmpt !< The nominal meridional (v) component of the
695  !! vector pair which is having its halos points
696  !! exchanged.
697  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
698  !! needed to determine where data should be
699  !! sent.
700  integer, optional, intent(in) :: direction !< An optional integer indicating which
701  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
702  !! TO_NORTH, and TO_SOUTH, possibly plus SCALAR_PAIR if these are paired non-directional
703  !! scalars discretized at the typical vector component locations. For example, TO_EAST sends
704  !! the data to the processor to the east, so the halos on the western side are filled. TO_ALL
705  !! is the default if omitted.
706  integer, optional, intent(in) :: stagger !< An optional flag, which may be one of A_GRID,
707  !! BGRID_NE, or CGRID_NE, indicating where the two components of the vector are
708  !! discretized. Omitting stagger is the same as setting it to CGRID_NE.
709  logical, optional, intent(in) :: complete !< An optional argument indicating whether the
710  !! halo updates should be completed before progress resumes.
711  !! Omitting complete is the same as setting complete to .true.
712  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
713  !! halo by default.
714  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
715  !! started then stopped to time this routine.
716  integer :: pass_vector_start_2d !< The integer index for this
717  !! update.
718 
719  ! Local variables
720  integer :: stagger_local
721  integer :: dirflag
722 
723  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
724 
725  stagger_local = cgrid_ne ! Default value for type of grid
726  if (present(stagger)) stagger_local = stagger
727 
728  dirflag = to_all ! 60
729  if (present(direction)) then ; if (direction > 0) dirflag = direction ; endif
730 
731  if (present(halo) .and. mom_dom%thin_halo_updates) then
732  pass_vector_start_2d = mpp_start_update_domains(u_cmpt, v_cmpt, &
733  mom_dom%mpp_domain, flags=dirflag, gridtype=stagger_local, &
734  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
735  else
736  pass_vector_start_2d = mpp_start_update_domains(u_cmpt, v_cmpt, &
737  mom_dom%mpp_domain, flags=dirflag, gridtype=stagger_local)
738  endif
739 
740  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
741 
742 end function pass_vector_start_2d
743 
744 !> pass_vector_start_3d starts a halo update for a pair of three-dimensional arrays
745 !! representing the compontents of a three-dimensional horizontal vector.
746 function pass_vector_start_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete, halo, &
747  clock)
748  real, dimension(:,:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector
749  !! pair which is having its halos points
750  !! exchanged.
751  real, dimension(:,:,:), intent(inout) :: v_cmpt !< The nominal meridional (v) component of the
752  !! vector pair which is having its halos points
753  !! exchanged.
754  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
755  !! needed to determine where data should be
756  !! sent.
757  integer, optional, intent(in) :: direction !< An optional integer indicating which
758  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
759  !! TO_NORTH, and TO_SOUTH, possibly plus SCALAR_PAIR if these are paired non-directional
760  !! scalars discretized at the typical vector component locations. For example, TO_EAST sends
761  !! the data to the processor to the east, so the halos on the western side are filled. TO_ALL
762  !! is the default if omitted.
763  integer, optional, intent(in) :: stagger !< An optional flag, which may be one of A_GRID,
764  !! BGRID_NE, or CGRID_NE, indicating where the two components of the vector are
765  !! discretized. Omitting stagger is the same as setting it to CGRID_NE.
766  logical, optional, intent(in) :: complete !< An optional argument indicating whether the
767  !! halo updates should be completed before progress resumes.
768  !! Omitting complete is the same as setting complete to .true.
769  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
770  !! halo by default.
771  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
772  !! started then stopped to time this routine.
773  integer :: pass_vector_start_3d !< The integer index for this
774  !! update.
775  ! Local variables
776  integer :: stagger_local
777  integer :: dirflag
778 
779  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
780 
781  stagger_local = cgrid_ne ! Default value for type of grid
782  if (present(stagger)) stagger_local = stagger
783 
784  dirflag = to_all ! 60
785  if (present(direction)) then ; if (direction > 0) dirflag = direction ; endif
786 
787  if (present(halo) .and. mom_dom%thin_halo_updates) then
788  pass_vector_start_3d = mpp_start_update_domains(u_cmpt, v_cmpt, &
789  mom_dom%mpp_domain, flags=dirflag, gridtype=stagger_local, &
790  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
791  else
792  pass_vector_start_3d = mpp_start_update_domains(u_cmpt, v_cmpt, &
793  mom_dom%mpp_domain, flags=dirflag, gridtype=stagger_local)
794  endif
795 
796  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
797 
798 end function pass_vector_start_3d
799 
800 !> pass_vector_complete_2d completes a halo update for a pair of two-dimensional arrays
801 !! representing the compontents of a two-dimensional horizontal vector.
802 subroutine pass_vector_complete_2d(id_update, u_cmpt, v_cmpt, MOM_dom, direction, stagger, halo, &
803  clock)
804  integer, intent(in) :: id_update !< The integer id of this update which has been
805  !! returned from a previous call to
806  !! pass_var_start.
807  real, dimension(:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector
808  !! pair which is having its halos points
809  !! exchanged.
810  real, dimension(:,:), intent(inout) :: v_cmpt !< The nominal meridional (v) component of the
811  !! vector pair which is having its halos points
812  !! exchanged.
813  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
814  !! needed to determine where data should be
815  !! sent.
816  integer, optional, intent(in) :: direction !< An optional integer indicating which
817  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
818  !! TO_NORTH, and TO_SOUTH, possibly plus SCALAR_PAIR if these are paired non-directional
819  !! scalars discretized at the typical vector component locations. For example, TO_EAST sends
820  !! the data to the processor to the east, so the halos on the western side are filled. TO_ALL
821  !! is the default if omitted.
822  integer, optional, intent(in) :: stagger !< An optional flag, which may be one of A_GRID,
823  !! BGRID_NE, or CGRID_NE, indicating where the two components of the vector are
824  !! discretized. Omitting stagger is the same as setting it to CGRID_NE.
825  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
826  !! halo by default.
827  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
828  !! started then stopped to time this routine.
829  ! Local variables
830  integer :: stagger_local
831  integer :: dirflag
832 
833  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
834 
835  stagger_local = cgrid_ne ! Default value for type of grid
836  if (present(stagger)) stagger_local = stagger
837 
838  dirflag = to_all ! 60
839  if (present(direction)) then ; if (direction > 0) dirflag = direction ; endif
840 
841  if (present(halo) .and. mom_dom%thin_halo_updates) then
842  call mpp_complete_update_domains(id_update, u_cmpt, v_cmpt, &
843  mom_dom%mpp_domain, flags=dirflag, gridtype=stagger_local, &
844  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
845  else
846  call mpp_complete_update_domains(id_update, u_cmpt, v_cmpt, &
847  mom_dom%mpp_domain, flags=dirflag, gridtype=stagger_local)
848  endif
849 
850  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
851 
852 end subroutine pass_vector_complete_2d
853 
854 !> pass_vector_complete_3d completes a halo update for a pair of three-dimensional
855 !! arrays representing the compontents of a three-dimensional horizontal vector.
856 subroutine pass_vector_complete_3d(id_update, u_cmpt, v_cmpt, MOM_dom, direction, stagger, halo, &
857  clock)
858  integer, intent(in) :: id_update !< The integer id of this update which has been
859  !! returned from a previous call to
860  !! pass_var_start.
861  real, dimension(:,:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector
862  !! pair which is having its halos points
863  !! exchanged.
864  real, dimension(:,:,:), intent(inout) :: v_cmpt !< The nominal meridional (v) component of the
865  !! vector pair which is having its halos points
866  !! exchanged.
867  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
868  !! needed to determine where data should be
869  !! sent.
870  integer, optional, intent(in) :: direction !< An optional integer indicating which
871  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
872  !! TO_NORTH, and TO_SOUTH, possibly plus SCALAR_PAIR if these are paired non-directional
873  !! scalars discretized at the typical vector component locations. For example, TO_EAST sends
874  !! the data to the processor to the east, so the halos on the western side are filled. TO_ALL
875  !! is the default if omitted.
876  integer, optional, intent(in) :: stagger !< An optional flag, which may be one of A_GRID,
877  !! BGRID_NE, or CGRID_NE, indicating where the two components of the vector are
878  !! discretized. Omitting stagger is the same as setting it to CGRID_NE.
879  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
880  !! halo by default.
881  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
882  !! started then stopped to time this routine.
883  ! Local variables
884  integer :: stagger_local
885  integer :: dirflag
886 
887  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
888 
889  stagger_local = cgrid_ne ! Default value for type of grid
890  if (present(stagger)) stagger_local = stagger
891 
892  dirflag = to_all ! 60
893  if (present(direction)) then ; if (direction > 0) dirflag = direction ; endif
894 
895  if (present(halo) .and. mom_dom%thin_halo_updates) then
896  call mpp_complete_update_domains(id_update, u_cmpt, v_cmpt, &
897  mom_dom%mpp_domain, flags=dirflag, gridtype=stagger_local, &
898  whalo=halo, ehalo=halo, shalo=halo, nhalo=halo)
899  else
900  call mpp_complete_update_domains(id_update, u_cmpt, v_cmpt, &
901  mom_dom%mpp_domain, flags=dirflag, gridtype=stagger_local)
902  endif
903 
904  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
905 
906 end subroutine pass_vector_complete_3d
907 
908 !> create_var_group_pass_2d sets up a group of two-dimensional array halo updates.
909 subroutine create_var_group_pass_2d(group, array, MOM_dom, sideflag, position, &
910  halo, clock)
911  type(group_pass_type), intent(inout) :: group !< The data type that store information for
912  !! group update. This data will be used in
913  !! do_group_pass.
914  real, dimension(:,:), intent(inout) :: array !< The array which is having its halos points
915  !! exchanged.
916  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
917  !! needed to determine where data should be
918  !! sent.
919  integer, optional, intent(in) :: sideflag !< An optional integer indicating which
920  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
921  !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east,
922  !! so the halos on the western side are filled. TO_ALL is the default if sideflag is omitted.
923  integer, optional, intent(in) :: position !< An optional argument indicating the position.
924  !! This is CENTER by default and is often CORNER,
925  !! but could also be EAST_FACE or NORTH_FACE.
926  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
927  !! halo by default.
928  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
929  !! started then stopped to time this routine.
930  ! Local variables
931  integer :: dirflag
932 
933  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
934 
935  dirflag = to_all ! 60
936  if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif
937 
938  if (mpp_group_update_initialized(group)) then
939  call mpp_reset_group_update_field(group,array)
940  elseif (present(halo) .and. mom_dom%thin_halo_updates) then
941  call mpp_create_group_update(group, array, mom_dom%mpp_domain, flags=dirflag, &
942  position=position, whalo=halo, ehalo=halo, &
943  shalo=halo, nhalo=halo)
944  else
945  call mpp_create_group_update(group, array, mom_dom%mpp_domain, flags=dirflag, &
946  position=position)
947  endif
948 
949  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
950 
951 end subroutine create_var_group_pass_2d
952 
953 !> create_var_group_pass_3d sets up a group of three-dimensional array halo updates.
954 subroutine create_var_group_pass_3d(group, array, MOM_dom, sideflag, position, halo, &
955  clock)
956  type(group_pass_type), intent(inout) :: group !< The data type that store information for
957  !! group update. This data will be used in
958  !! do_group_pass.
959  real, dimension(:,:,:), intent(inout) :: array !< The array which is having its halos points
960  !! exchanged.
961  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
962  !! needed to determine where data should be
963  !! sent.
964  integer, optional, intent(in) :: sideflag !< An optional integer indicating which
965  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
966  !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east,
967  !! so the halos on the western side are filled. TO_ALL is the default if sideflag is omitted.
968  integer, optional, intent(in) :: position !< An optional argument indicating the position.
969  !! This is CENTER by default and is often CORNER,
970  !! but could also be EAST_FACE or NORTH_FACE.
971  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
972  !! halo by default.
973  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
974  !! started then stopped to time this routine.
975  ! Local variables
976  integer :: dirflag
977 
978  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
979 
980  dirflag = to_all ! 60
981  if (present(sideflag)) then ; if (sideflag > 0) dirflag = sideflag ; endif
982 
983  if (mpp_group_update_initialized(group)) then
984  call mpp_reset_group_update_field(group,array)
985  elseif (present(halo) .and. mom_dom%thin_halo_updates) then
986  call mpp_create_group_update(group, array, mom_dom%mpp_domain, flags=dirflag, &
987  position=position, whalo=halo, ehalo=halo, &
988  shalo=halo, nhalo=halo)
989  else
990  call mpp_create_group_update(group, array, mom_dom%mpp_domain, flags=dirflag, &
991  position=position)
992  endif
993 
994  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
995 
996 end subroutine create_var_group_pass_3d
997 
998 !> create_vector_group_pass_2d sets up a group of two-dimensional vector halo updates.
999 subroutine create_vector_group_pass_2d(group, u_cmpt, v_cmpt, MOM_dom, direction, stagger, halo, &
1000  clock)
1001  type(group_pass_type), intent(inout) :: group !< The data type that store information for
1002  !! group update. This data will be used in
1003  !! do_group_pass.
1004  real, dimension(:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector
1005  !! pair which is having its halos points
1006  !! exchanged.
1007  real, dimension(:,:), intent(inout) :: v_cmpt !< The nominal meridional (v) component of the
1008  !! vector pair which is having its halos points
1009  !! exchanged.
1010 
1011  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
1012  !! needed to determine where data should be
1013  !! sent
1014  integer, optional, intent(in) :: direction !< An optional integer indicating which
1015  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
1016  !! TO_NORTH, and TO_SOUTH, possibly plus SCALAR_PAIR if these are paired non-directional
1017  !! scalars discretized at the typical vector component locations. For example, TO_EAST sends
1018  !! the data to the processor to the east, so the halos on the western side are filled. TO_ALL
1019  !! is the default if omitted.
1020  integer, optional, intent(in) :: stagger !< An optional flag, which may be one of A_GRID,
1021  !! BGRID_NE, or CGRID_NE, indicating where the two components of the vector are
1022  !! discretized. Omitting stagger is the same as setting it to CGRID_NE.
1023  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
1024  !! halo by default.
1025  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
1026  !! started then stopped to time this routine.
1027  ! Local variables
1028  integer :: stagger_local
1029  integer :: dirflag
1030 
1031  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
1032 
1033  stagger_local = cgrid_ne ! Default value for type of grid
1034  if (present(stagger)) stagger_local = stagger
1035 
1036  dirflag = to_all ! 60
1037  if (present(direction)) then ; if (direction > 0) dirflag = direction ; endif
1038 
1039  if (mpp_group_update_initialized(group)) then
1040  call mpp_reset_group_update_field(group,u_cmpt, v_cmpt)
1041  elseif (present(halo) .and. mom_dom%thin_halo_updates) then
1042  call mpp_create_group_update(group, u_cmpt, v_cmpt, mom_dom%mpp_domain, &
1043  flags=dirflag, gridtype=stagger_local, whalo=halo, ehalo=halo, &
1044  shalo=halo, nhalo=halo)
1045  else
1046  call mpp_create_group_update(group, u_cmpt, v_cmpt, mom_dom%mpp_domain, &
1047  flags=dirflag, gridtype=stagger_local)
1048  endif
1049 
1050  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
1051 
1052 end subroutine create_vector_group_pass_2d
1053 
1054 !> create_vector_group_pass_3d sets up a group of three-dimensional vector halo updates.
1055 subroutine create_vector_group_pass_3d(group, u_cmpt, v_cmpt, MOM_dom, direction, stagger, halo, &
1056  clock)
1057  type(group_pass_type), intent(inout) :: group !< The data type that store information for
1058  !! group update. This data will be used in
1059  !! do_group_pass.
1060  real, dimension(:,:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector
1061  !! pair which is having its halos points
1062  !! exchanged.
1063  real, dimension(:,:,:), intent(inout) :: v_cmpt !< The nominal meridional (v) component of the
1064  !! vector pair which is having its halos points
1065  !! exchanged.
1066 
1067  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
1068  !! needed to determine where data should be
1069  !! sent.
1070  integer, optional, intent(in) :: direction !< An optional integer indicating which
1071  !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST,
1072  !! TO_NORTH, and TO_SOUTH, possibly plus SCALAR_PAIR if these are paired non-directional
1073  !! scalars discretized at the typical vector component locations. For example, TO_EAST sends
1074  !! the data to the processor to the east, so the halos on the western side are filled. TO_ALL
1075  !! is the default if omitted.
1076  integer, optional, intent(in) :: stagger !< An optional flag, which may be one of A_GRID,
1077  !! BGRID_NE, or CGRID_NE, indicating where the two components of the vector are
1078  !! discretized. Omitting stagger is the same as setting it to CGRID_NE.
1079  integer, optional, intent(in) :: halo !< The size of the halo to update - the full
1080  !! halo by default.
1081  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
1082  !! started then stopped to time this routine.
1083 
1084  ! Local variables
1085  integer :: stagger_local
1086  integer :: dirflag
1087 
1088  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
1089 
1090  stagger_local = cgrid_ne ! Default value for type of grid
1091  if (present(stagger)) stagger_local = stagger
1092 
1093  dirflag = to_all ! 60
1094  if (present(direction)) then ; if (direction > 0) dirflag = direction ; endif
1095 
1096  if (mpp_group_update_initialized(group)) then
1097  call mpp_reset_group_update_field(group,u_cmpt, v_cmpt)
1098  elseif (present(halo) .and. mom_dom%thin_halo_updates) then
1099  call mpp_create_group_update(group, u_cmpt, v_cmpt, mom_dom%mpp_domain, &
1100  flags=dirflag, gridtype=stagger_local, whalo=halo, ehalo=halo, &
1101  shalo=halo, nhalo=halo)
1102  else
1103  call mpp_create_group_update(group, u_cmpt, v_cmpt, mom_dom%mpp_domain, &
1104  flags=dirflag, gridtype=stagger_local)
1105  endif
1106 
1107  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
1108 
1109 end subroutine create_vector_group_pass_3d
1110 
1111 !> do_group_pass carries out a group halo update.
1112 subroutine do_group_pass(group, MOM_dom, clock)
1113  type(group_pass_type), intent(inout) :: group !< The data type that store information for
1114  !! group update. This data will be used in
1115  !! do_group_pass.
1116  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
1117  !! needed to determine where data should be
1118  !! sent.
1119  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
1120  !! started then stopped to time this routine.
1121  real :: d_type
1122 
1123  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
1124 
1125  call mpp_do_group_update(group, mom_dom%mpp_domain, d_type)
1126 
1127  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
1128 
1129 end subroutine do_group_pass
1130 
1131 !> start_group_pass starts out a group halo update.
1132 subroutine start_group_pass(group, MOM_dom, clock)
1133  type(group_pass_type), intent(inout) :: group !< The data type that store information for
1134  !! group update. This data will be used in
1135  !! do_group_pass.
1136  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
1137  !! needed to determine where data should be
1138  !! sent.
1139  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
1140  !! started then stopped to time this routine.
1141 
1142  real :: d_type
1143 
1144  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
1145 
1146  call mpp_start_group_update(group, mom_dom%mpp_domain, d_type)
1147 
1148  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
1149 
1150 end subroutine start_group_pass
1151 
1152 !> complete_group_pass completes a group halo update.
1153 subroutine complete_group_pass(group, MOM_dom, clock)
1154  type(group_pass_type), intent(inout) :: group !< The data type that store information for
1155  !! group update. This data will be used in
1156  !! do_group_pass.
1157  type(mom_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain
1158  !! needed to determine where data should be
1159  !! sent.
1160  integer, optional, intent(in) :: clock !< The handle for a cpu time clock that should be
1161  !! started then stopped to time this routine.
1162  real :: d_type
1163 
1164  if (present(clock)) then ; if (clock>0) call cpu_clock_begin(clock) ; endif
1165 
1166  call mpp_complete_group_update(group, mom_dom%mpp_domain, d_type)
1167 
1168  if (present(clock)) then ; if (clock>0) call cpu_clock_end(clock) ; endif
1169 
1170 end subroutine complete_group_pass
1171 
1172 !> MOM_domains_init initalizes a MOM_domain_type variable, based on the information
1173 !! read in from a param_file_type, and optionally returns data describing various'
1174 !! properties of the domain type.
1175 subroutine mom_domains_init(MOM_dom, param_file, symmetric, static_memory, &
1176  NIHALO, NJHALO, NIGLOBAL, NJGLOBAL, NIPROC, NJPROC, &
1177  min_halo, domain_name, include_name, param_suffix)
1178  type(mom_domain_type), pointer :: MOM_dom !< A pointer to the MOM_domain_type
1179  !! being defined here.
1180  type(param_file_type), intent(in) :: param_file !< A structure to parse for
1181  !! run-time parameters
1182  logical, optional, intent(in) :: symmetric !< If present, this specifies
1183  !! whether this domain is symmetric, regardless of
1184  !! whether the macro SYMMETRIC_MEMORY_ is defined.
1185  logical, optional, intent(in) :: static_memory !< If present and true, this
1186  !! domain type is set up for static memory and error checking of
1187  !! various input values is performed against those in the input file.
1188  integer, optional, intent(in) :: NIHALO !< Default halo sizes, required
1189  !! with static memory.
1190  integer, optional, intent(in) :: NJHALO !< Default halo sizes, required
1191  !! with static memory.
1192  integer, optional, intent(in) :: NIGLOBAL !< Total domain sizes, required
1193  !! with static memory.
1194  integer, optional, intent(in) :: NJGLOBAL !< Total domain sizes, required
1195  !! with static memory.
1196  integer, optional, intent(in) :: NIPROC !< Processor counts, required with
1197  !! static memory.
1198  integer, optional, intent(in) :: NJPROC !< Processor counts, required with
1199  !! static memory.
1200  integer, dimension(2), optional, intent(inout) :: min_halo !< If present, this sets the
1201  !! minimum halo size for this domain in the i- and j-
1202  !! directions, and returns the actual halo size used.
1203  character(len=*), optional, intent(in) :: domain_name !< A name for this domain, "MOM"
1204  !! if missing.
1205  character(len=*), optional, intent(in) :: include_name !< A name for model's include file,
1206  !! "MOM_memory.h" if missing.
1207  character(len=*), optional, intent(in) :: param_suffix !< A suffix to apply to
1208  !! layout-specific parameters.
1209 
1210  ! Local variables
1211  integer, dimension(2) :: layout = (/ 1, 1 /)
1212  integer, dimension(2) :: io_layout = (/ 0, 0 /)
1213  integer, dimension(4) :: global_indices
1214 !$ integer :: ocean_nthreads ! Number of Openmp threads
1215 !$ integer :: get_cpu_affinity, omp_get_thread_num, omp_get_num_threads
1216 !$ logical :: ocean_omp_hyper_thread
1217  integer :: nihalo_dflt, njhalo_dflt
1218  integer :: pe, proc_used
1219  integer :: X_FLAGS, Y_FLAGS
1220  logical :: reentrant_x, reentrant_y, tripolar_N, is_static
1221  logical :: mask_table_exists
1222  character(len=128) :: mask_table, inputdir
1223  character(len=64) :: dom_name, inc_nm
1224  character(len=200) :: mesg
1225 
1226  integer :: xsiz, ysiz, nip_parsed, njp_parsed
1227  integer :: isc,iec,jsc,jec ! The bounding indices of the computational domain.
1228  character(len=8) :: char_xsiz, char_ysiz, char_niglobal, char_njglobal
1229  character(len=40) :: nihalo_nm, njhalo_nm, layout_nm, io_layout_nm, masktable_nm
1230  character(len=40) :: niproc_nm, njproc_nm
1231  integer :: xhalo_d2,yhalo_d2
1232 ! This include declares and sets the variable "version".
1233 #include "version_variable.h"
1234  character(len=40) :: mdl ! This module's name.
1235 
1236  if (.not.associated(mom_dom)) then
1237  allocate(mom_dom)
1238  allocate(mom_dom%mpp_domain)
1239  allocate(mom_dom%mpp_domain_d2)
1240  endif
1241 
1242  pe = pe_here()
1243  proc_used = num_pes()
1244 
1245  mdl = "MOM_domains"
1246 
1247  mom_dom%symmetric = .true.
1248  if (present(symmetric)) then ; mom_dom%symmetric = symmetric ; endif
1249  if (present(min_halo)) mdl = trim(mdl)//" min_halo"
1250 
1251  dom_name = "MOM" ; inc_nm = "MOM_memory.h"
1252  if (present(domain_name)) dom_name = trim(domain_name)
1253  if (present(include_name)) inc_nm = trim(include_name)
1254 
1255  nihalo_nm = "NIHALO" ; njhalo_nm = "NJHALO"
1256  layout_nm = "LAYOUT" ; io_layout_nm = "IO_LAYOUT" ; masktable_nm = "MASKTABLE"
1257  niproc_nm = "NIPROC" ; njproc_nm = "NJPROC"
1258  if (present(param_suffix)) then ; if (len(trim(adjustl(param_suffix))) > 0) then
1259  nihalo_nm = "NIHALO"//(trim(adjustl(param_suffix)))
1260  njhalo_nm = "NJHALO"//(trim(adjustl(param_suffix)))
1261  layout_nm = "LAYOUT"//(trim(adjustl(param_suffix)))
1262  io_layout_nm = "IO_LAYOUT"//(trim(adjustl(param_suffix)))
1263  masktable_nm = "MASKTABLE"//(trim(adjustl(param_suffix)))
1264  niproc_nm = "NIPROC"//(trim(adjustl(param_suffix)))
1265  njproc_nm = "NJPROC"//(trim(adjustl(param_suffix)))
1266  endif ; endif
1267 
1268  is_static = .false. ; if (present(static_memory)) is_static = static_memory
1269  if (is_static) then
1270  if (.not.present(nihalo)) call mom_error(fatal, "NIHALO must be "// &
1271  "present in the call to MOM_domains_init with static memory.")
1272  if (.not.present(njhalo)) call mom_error(fatal, "NJHALO must be "// &
1273  "present in the call to MOM_domains_init with static memory.")
1274  if (.not.present(niglobal)) call mom_error(fatal, "NIGLOBAL must be "// &
1275  "present in the call to MOM_domains_init with static memory.")
1276  if (.not.present(njglobal)) call mom_error(fatal, "NJGLOBAL must be "// &
1277  "present in the call to MOM_domains_init with static memory.")
1278  if (.not.present(niproc)) call mom_error(fatal, "NIPROC must be "// &
1279  "present in the call to MOM_domains_init with static memory.")
1280  if (.not.present(njproc)) call mom_error(fatal, "NJPROC must be "// &
1281  "present in the call to MOM_domains_init with static memory.")
1282  endif
1283 
1284  ! Read all relevant parameters and write them to the model log.
1285  call log_version(param_file, mdl, version, "", log_to_all=.true., layout=.true.)
1286  call get_param(param_file, mdl, "REENTRANT_X", reentrant_x, &
1287  "If true, the domain is zonally reentrant.", default=.true.)
1288  call get_param(param_file, mdl, "REENTRANT_Y", reentrant_y, &
1289  "If true, the domain is meridionally reentrant.", &
1290  default=.false.)
1291  call get_param(param_file, mdl, "TRIPOLAR_N", tripolar_n, &
1292  "Use tripolar connectivity at the northern edge of the "//&
1293  "domain. With TRIPOLAR_N, NIGLOBAL must be even.", &
1294  default=.false.)
1295 
1296 #ifndef NOT_SET_AFFINITY
1297 !$ call fms_affinity_init
1298 !$OMP PARALLEL
1299 !$OMP master
1300 !$ ocean_nthreads = omp_get_num_threads()
1301 !$OMP END MASTER
1302 !$OMP END PARALLEL
1303 !$ if(ocean_nthreads < 2 ) then
1304 !$ call get_param(param_file, mdl, "OCEAN_OMP_THREADS", ocean_nthreads, &
1305 !$ "The number of OpenMP threads that MOM6 will use.", &
1306 !$ default = 1, layoutParam=.true.)
1307 !$ call get_param(param_file, mdl, "OCEAN_OMP_HYPER_THREAD", ocean_omp_hyper_thread, &
1308 !$ "If True, use hyper-threading.", default = .false., layoutParam=.true.)
1309 !$ call fms_affinity_set('OCEAN', ocean_omp_hyper_thread, ocean_nthreads)
1310 !$ call omp_set_num_threads(ocean_nthreads)
1311 !$ write(6,*) "MOM_domains_mod OMPthreading ", fms_affinity_get(), omp_get_thread_num(), omp_get_num_threads()
1312 !$ call flush(6)
1313 !$ endif
1314 #endif
1315  call log_param(param_file, mdl, "!SYMMETRIC_MEMORY_", mom_dom%symmetric, &
1316  "If defined, the velocity point data domain includes "//&
1317  "every face of the thickness points. In other words, "//&
1318  "some arrays are larger than others, depending on where "//&
1319  "they are on the staggered grid. Also, the starting "//&
1320  "index of the velocity-point arrays is usually 0, not 1. "//&
1321  "This can only be set at compile time.",&
1322  layoutparam=.true.)
1323  call get_param(param_file, mdl, "NONBLOCKING_UPDATES", mom_dom%nonblocking_updates, &
1324  "If true, non-blocking halo updates may be used.", &
1325  default=.false., layoutparam=.true.)
1326  call get_param(param_file, mdl, "THIN_HALO_UPDATES", mom_dom%thin_halo_updates, &
1327  "If true, optional arguments may be used to specify the "//&
1328  "the width of the halos that are updated with each call.", &
1329  default=.true., layoutparam=.true.)
1330 
1331  nihalo_dflt = 4 ; njhalo_dflt = 4
1332  if (present(nihalo)) nihalo_dflt = nihalo
1333  if (present(njhalo)) njhalo_dflt = njhalo
1334 
1335  call log_param(param_file, mdl, "!STATIC_MEMORY_", is_static, &
1336  "If STATIC_MEMORY_ is defined, the principle variables "//&
1337  "will have sizes that are statically determined at "//&
1338  "compile time. Otherwise the sizes are not determined "//&
1339  "until run time. The STATIC option is substantially "//&
1340  "faster, but does not allow the PE count to be changed "//&
1341  "at run time. This can only be set at compile time.",&
1342  layoutparam=.true.)
1343 
1344  if (is_static) then
1345  call get_param(param_file, mdl, "NIGLOBAL", mom_dom%niglobal, &
1346  "The total number of thickness grid points in the "//&
1347  "x-direction in the physical domain. With STATIC_MEMORY_ "//&
1348  "this is set in "//trim(inc_nm)//" at compile time.", &
1349  static_value=niglobal)
1350  call get_param(param_file, mdl, "NJGLOBAL", mom_dom%njglobal, &
1351  "The total number of thickness grid points in the "//&
1352  "y-direction in the physical domain. With STATIC_MEMORY_ "//&
1353  "this is set in "//trim(inc_nm)//" at compile time.", &
1354  static_value=njglobal)
1355  if (mom_dom%niglobal /= niglobal) call mom_error(fatal,"MOM_domains_init: " // &
1356  "static mismatch for NIGLOBAL_ domain size. Header file does not match input namelist")
1357  if (mom_dom%njglobal /= njglobal) call mom_error(fatal,"MOM_domains_init: " // &
1358  "static mismatch for NJGLOBAL_ domain size. Header file does not match input namelist")
1359 
1360  else
1361  call get_param(param_file, mdl, "NIGLOBAL", mom_dom%niglobal, &
1362  "The total number of thickness grid points in the "//&
1363  "x-direction in the physical domain. With STATIC_MEMORY_ "//&
1364  "this is set in "//trim(inc_nm)//" at compile time.", &
1365  fail_if_missing=.true.)
1366  call get_param(param_file, mdl, "NJGLOBAL", mom_dom%njglobal, &
1367  "The total number of thickness grid points in the "//&
1368  "y-direction in the physical domain. With STATIC_MEMORY_ "//&
1369  "this is set in "//trim(inc_nm)//" at compile time.", &
1370  fail_if_missing=.true.)
1371  endif
1372 
1373  call get_param(param_file, mdl, trim(nihalo_nm), mom_dom%nihalo, &
1374  "The number of halo points on each side in the x-direction. How this is set "//&
1375  "varies with the calling component and static or dynamic memory configuration.", &
1376  default=nihalo_dflt, static_value=nihalo_dflt)
1377  call get_param(param_file, mdl, trim(njhalo_nm), mom_dom%njhalo, &
1378  "The number of halo points on each side in the y-direction. How this is set "//&
1379  "varies with the calling component and static or dynamic memory configuration.", &
1380  default=njhalo_dflt, static_value=njhalo_dflt)
1381  if (present(min_halo)) then
1382  mom_dom%nihalo = max(mom_dom%nihalo, min_halo(1))
1383  min_halo(1) = mom_dom%nihalo
1384  mom_dom%njhalo = max(mom_dom%njhalo, min_halo(2))
1385  min_halo(2) = mom_dom%njhalo
1386  ! These are generally used only with static memory, so they are considerd layout params.
1387  call log_param(param_file, mdl, "!NIHALO min_halo", mom_dom%nihalo, layoutparam=.true.)
1388  call log_param(param_file, mdl, "!NJHALO min_halo", mom_dom%nihalo, layoutparam=.true.)
1389  endif
1390  if (is_static .and. .not.present(min_halo)) then
1391  if (mom_dom%nihalo /= nihalo) call mom_error(fatal,"MOM_domains_init: " // &
1392  "static mismatch for "//trim(nihalo_nm)//" domain size")
1393  if (mom_dom%njhalo /= njhalo) call mom_error(fatal,"MOM_domains_init: " // &
1394  "static mismatch for "//trim(njhalo_nm)//" domain size")
1395  endif
1396 
1397  global_indices(1) = 1 ; global_indices(2) = mom_dom%niglobal
1398  global_indices(3) = 1 ; global_indices(4) = mom_dom%njglobal
1399 
1400  call get_param(param_file, mdl, "INPUTDIR", inputdir, do_not_log=.true., default=".")
1401  inputdir = slasher(inputdir)
1402 
1403  call get_param(param_file, mdl, trim(masktable_nm), mask_table, &
1404  "A text file to specify n_mask, layout and mask_list. "//&
1405  "This feature masks out processors that contain only land points. "//&
1406  "The first line of mask_table is the number of regions to be masked out. "//&
1407  "The second line is the layout of the model and must be "//&
1408  "consistent with the actual model layout. "//&
1409  "The following (n_mask) lines give the logical positions "//&
1410  "of the processors that are masked out. The mask_table "//&
1411  "can be created by tools like check_mask. The "//&
1412  "following example of mask_table masks out 2 processors, "//&
1413  "(1,2) and (3,6), out of the 24 in a 4x6 layout: \n"//&
1414  " 2\n 4,6\n 1,2\n 3,6\n", default="MOM_mask_table", &
1415  layoutparam=.true.)
1416  mask_table = trim(inputdir)//trim(mask_table)
1417  mask_table_exists = file_exist(mask_table)
1418 
1419  if (is_static) then
1420  layout(1) = niproc ; layout(2) = njproc
1421  else
1422  call get_param(param_file, mdl, trim(layout_nm), layout, &
1423  "The processor layout to be used, or 0, 0 to automatically "//&
1424  "set the layout based on the number of processors.", default=0, &
1425  do_not_log=.true.)
1426  call get_param(param_file, mdl, trim(niproc_nm), nip_parsed, &
1427  "The number of processors in the x-direction.", default=-1, &
1428  do_not_log=.true.)
1429  call get_param(param_file, mdl, trim(njproc_nm), njp_parsed, &
1430  "The number of processors in the y-direction.", default=-1, &
1431  do_not_log=.true.)
1432  if (nip_parsed > -1) then
1433  if ((layout(1) > 0) .and. (layout(1) /= nip_parsed)) &
1434  call mom_error(fatal, trim(layout_nm)//" and "//trim(niproc_nm)//" set inconsistently. "//&
1435  "Only LAYOUT should be used.")
1436  layout(1) = nip_parsed
1437  call mom_mesg(trim(niproc_nm)//" used to set "//trim(layout_nm)//" in dynamic mode. "//&
1438  "Shift to using "//trim(layout_nm)//" instead.")
1439  endif
1440  if (njp_parsed > -1) then
1441  if ((layout(2) > 0) .and. (layout(2) /= njp_parsed)) &
1442  call mom_error(fatal, trim(layout_nm)//" and "//trim(njproc_nm)//" set inconsistently. "//&
1443  "Only "//trim(layout_nm)//" should be used.")
1444  layout(2) = njp_parsed
1445  call mom_mesg(trim(njproc_nm)//" used to set "//trim(layout_nm)//" in dynamic mode. "//&
1446  "Shift to using "//trim(layout_nm)//" instead.")
1447  endif
1448 
1449  if ( layout(1)==0 .and. layout(2)==0 ) &
1450  call mpp_define_layout(global_indices, proc_used, layout)
1451  if ( layout(1)/=0 .and. layout(2)==0 ) layout(2) = proc_used/layout(1)
1452  if ( layout(1)==0 .and. layout(2)/=0 ) layout(1) = proc_used/layout(2)
1453 
1454  if (layout(1)*layout(2) /= proc_used .and. (.not. mask_table_exists) ) then
1455  write(mesg,'("MOM_domains_init: The product of the two components of layout, ", &
1456  & 2i4,", is not the number of PEs used, ",i5,".")') &
1457  layout(1),layout(2),proc_used
1458  call mom_error(fatal, mesg)
1459  endif
1460  endif
1461  call log_param(param_file, mdl, trim(niproc_nm), layout(1), &
1462  "The number of processors in the x-direction. With "//&
1463  "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",&
1464  layoutparam=.true.)
1465  call log_param(param_file, mdl, trim(njproc_nm), layout(2), &
1466  "The number of processors in the y-direction. With "//&
1467  "STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.",&
1468  layoutparam=.true.)
1469  call log_param(param_file, mdl, trim(layout_nm), layout, &
1470  "The processor layout that was actually used.",&
1471  layoutparam=.true.)
1472 
1473  ! Idiot check that fewer PEs than columns have been requested
1474  if (layout(1)*layout(2)>mom_dom%niglobal*mom_dom%njglobal) then
1475  write(mesg,'(a,2(i5,x,a))') 'You requested to use',layout(1)*layout(2), &
1476  'PEs but there are only',mom_dom%niglobal*mom_dom%njglobal,'columns in the model'
1477  call mom_error(fatal, mesg)
1478  endif
1479 
1480  if (mask_table_exists) then
1481  call mom_error(note, 'MOM_domains_init: reading maskmap information from '//&
1482  trim(mask_table))
1483  allocate(mom_dom%maskmap(layout(1), layout(2)))
1484  call parse_mask_table(mask_table, mom_dom%maskmap, dom_name)
1485  endif
1486 
1487  ! Set up the I/O layout, and check that it uses an even multiple of the
1488  ! number of PEs in each direction.
1489  io_layout(:) = (/ 1, 1 /)
1490  call get_param(param_file, mdl, trim(io_layout_nm), io_layout, &
1491  "The processor layout to be used, or 0,0 to automatically "//&
1492  "set the io_layout to be the same as the layout.", default=1, &
1493  layoutparam=.true.)
1494 
1495  if (io_layout(1) < 0) then
1496  write(mesg,'("MOM_domains_init: IO_LAYOUT(1) = ",i4,". Negative values "//&
1497  &"are not allowed in ")') io_layout(1)
1498  call mom_error(fatal, mesg//trim(io_layout_nm))
1499  elseif (io_layout(1) > 0) then ; if (modulo(layout(1), io_layout(1)) /= 0) then
1500  write(mesg,'("MOM_domains_init: The i-direction I/O-layout, IO_LAYOUT(1)=",i4, &
1501  &", does not evenly divide the i-direction layout, NIPROC=,",i4,".")') &
1502  io_layout(1),layout(1)
1503  call mom_error(fatal, mesg)
1504  endif ; endif
1505 
1506  if (io_layout(2) < 0) then
1507  write(mesg,'("MOM_domains_init: IO_LAYOUT(2) = ",i4,". Negative values "//&
1508  &"are not allowed in ")') io_layout(2)
1509  call mom_error(fatal, mesg//trim(io_layout_nm))
1510  elseif (io_layout(2) /= 0) then ; if (modulo(layout(2), io_layout(2)) /= 0) then
1511  write(mesg,'("MOM_domains_init: The j-direction I/O-layout, IO_LAYOUT(2)=",i4, &
1512  &", does not evenly divide the j-direction layout, NJPROC=,",i4,".")') &
1513  io_layout(2),layout(2)
1514  call mom_error(fatal, mesg)
1515  endif ; endif
1516 
1517  if (io_layout(2) == 0) io_layout(2) = layout(2)
1518  if (io_layout(1) == 0) io_layout(1) = layout(1)
1519 
1520  x_flags = 0 ; y_flags = 0
1521  if (reentrant_x) x_flags = cyclic_global_domain
1522  if (reentrant_y) y_flags = cyclic_global_domain
1523  if (tripolar_n) then
1524  y_flags = fold_north_edge
1525  if (reentrant_y) call mom_error(fatal,"MOM_domains: "// &
1526  "TRIPOLAR_N and REENTRANT_Y may not be defined together.")
1527  endif
1528 
1529  global_indices(1) = 1 ; global_indices(2) = mom_dom%niglobal
1530  global_indices(3) = 1 ; global_indices(4) = mom_dom%njglobal
1531 
1532  if (mask_table_exists) then
1533  call mom_define_domain( global_indices, layout, mom_dom%mpp_domain, &
1534  xflags=x_flags, yflags=y_flags, &
1535  xhalo=mom_dom%nihalo, yhalo=mom_dom%njhalo, &
1536  symmetry = mom_dom%symmetric, name=dom_name, &
1537  maskmap=mom_dom%maskmap )
1538  else
1539  call mom_define_domain( global_indices, layout, mom_dom%mpp_domain, &
1540  xflags=x_flags, yflags=y_flags, &
1541  xhalo=mom_dom%nihalo, yhalo=mom_dom%njhalo, &
1542  symmetry = mom_dom%symmetric, name=dom_name)
1543  endif
1544 
1545  if ((io_layout(1) > 0) .and. (io_layout(2) > 0) .and. &
1546  (layout(1)*layout(2) > 1)) then
1547  call mom_define_io_domain(mom_dom%mpp_domain, io_layout)
1548  endif
1549 
1550 ! Save the extra data for creating other domains of different resolution that overlay this domain
1551  mom_dom%X_FLAGS = x_flags
1552  mom_dom%Y_FLAGS = y_flags
1553  mom_dom%layout = layout
1554  mom_dom%io_layout = io_layout
1555 
1556  if (is_static) then
1557  ! A requirement of equal sized compute domains is necessary when STATIC_MEMORY_
1558  ! is used.
1559  call mpp_get_compute_domain(mom_dom%mpp_domain,isc,iec,jsc,jec)
1560  xsiz = iec - isc + 1
1561  ysiz = jec - jsc + 1
1562  if (xsiz*niproc /= mom_dom%niglobal .OR. ysiz*njproc /= mom_dom%njglobal) then
1563  write( char_xsiz,'(i4)' ) niproc
1564  write( char_ysiz,'(i4)' ) njproc
1565  write( char_niglobal,'(i4)' ) mom_dom%niglobal
1566  write( char_njglobal,'(i4)' ) mom_dom%njglobal
1567  call mom_error(warning,'MOM_domains: Processor decomposition (NIPROC_,NJPROC_) = (' &
1568  //trim(char_xsiz)//','//trim(char_ysiz)// &
1569  ') does not evenly divide size set by preprocessor macro ('&
1570  //trim(char_niglobal)//','//trim(char_njglobal)// '). ')
1571  call mom_error(fatal,'MOM_domains: #undef STATIC_MEMORY_ in "//trim(inc_nm)//" to use &
1572  &dynamic allocation, or change processor decomposition to evenly divide the domain.')
1573  endif
1574  endif
1575 
1576  global_indices(1) = 1 ; global_indices(2) = int(mom_dom%niglobal/2)
1577  global_indices(3) = 1 ; global_indices(4) = int(mom_dom%njglobal/2)
1578  !For downsampled domain, recommend a halo of 1 (or 0?) since we're not doing wide-stencil computations.
1579  !But that does not work because the downsampled field would not have the correct size to pass the checks, e.g., we get
1580  !error: downsample_diag_indices_get: peculiar size 28 in i-direction\ndoes not match one of 24 25 26 27
1581  xhalo_d2 = int(mom_dom%nihalo/2)
1582  yhalo_d2 = int(mom_dom%njhalo/2)
1583  if (mask_table_exists) then
1584  call mom_define_domain( global_indices, layout, mom_dom%mpp_domain_d2, &
1585  xflags=x_flags, yflags=y_flags, &
1586  xhalo=xhalo_d2, yhalo=yhalo_d2, &
1587  symmetry = mom_dom%symmetric, name=trim("MOMc"), &
1588  maskmap=mom_dom%maskmap )
1589  else
1590  call mom_define_domain( global_indices, layout, mom_dom%mpp_domain_d2, &
1591  xflags=x_flags, yflags=y_flags, &
1592  xhalo=xhalo_d2, yhalo=yhalo_d2, &
1593  symmetry = mom_dom%symmetric, name=trim("MOMc"))
1594  endif
1595 
1596  if ((io_layout(1) > 0) .and. (io_layout(2) > 0) .and. &
1597  (layout(1)*layout(2) > 1)) then
1598  call mom_define_io_domain(mom_dom%mpp_domain_d2, io_layout)
1599  endif
1600 
1601 end subroutine mom_domains_init
1602 
1603 !> clone_MD_to_MD copies one MOM_domain_type into another, while allowing
1604 !! some properties of the new type to differ from the original one.
1605 subroutine clone_md_to_md(MD_in, MOM_dom, min_halo, halo_size, symmetric, &
1606  domain_name, turns)
1607  type(mom_domain_type), intent(in) :: MD_in !< An existing MOM_domain
1608  type(mom_domain_type), pointer :: MOM_dom !< A pointer to a MOM_domain that will be
1609  !! allocated if it is unassociated, and will have data
1610  !! copied from MD_in
1611  integer, dimension(2), &
1612  optional, intent(inout) :: min_halo !< If present, this sets the
1613  !! minimum halo size for this domain in the i- and j-
1614  !! directions, and returns the actual halo size used.
1615  integer, optional, intent(in) :: halo_size !< If present, this sets the halo
1616  !! size for the domain in the i- and j-directions.
1617  !! min_halo and halo_size can not both be present.
1618  logical, optional, intent(in) :: symmetric !< If present, this specifies
1619  !! whether the new domain is symmetric, regardless of
1620  !! whether the macro SYMMETRIC_MEMORY_ is defined.
1621  character(len=*), &
1622  optional, intent(in) :: domain_name !< A name for the new domain, "MOM"
1623  !! if missing.
1624  integer, optional, intent(in) :: turns !< Number of quarter turns
1625 
1626  integer :: global_indices(4)
1627  logical :: mask_table_exists
1628  character(len=64) :: dom_name
1629  integer :: qturns
1630 
1631  qturns = 0
1632  if (present(turns)) qturns = turns
1633 
1634  if (.not.associated(mom_dom)) then
1635  allocate(mom_dom)
1636  allocate(mom_dom%mpp_domain)
1637  allocate(mom_dom%mpp_domain_d2)
1638  endif
1639 
1640 ! Save the extra data for creating other domains of different resolution that overlay this domain
1641  mom_dom%symmetric = md_in%symmetric
1642  mom_dom%nonblocking_updates = md_in%nonblocking_updates
1643  mom_dom%thin_halo_updates = md_in%thin_halo_updates
1644 
1645  if (modulo(qturns, 2) /= 0) then
1646  mom_dom%niglobal = md_in%njglobal ; mom_dom%njglobal = md_in%niglobal
1647  mom_dom%nihalo = md_in%njhalo ; mom_dom%njhalo = md_in%nihalo
1648 
1649  mom_dom%X_FLAGS = md_in%Y_FLAGS ; mom_dom%Y_FLAGS = md_in%X_FLAGS
1650  mom_dom%layout(:) = md_in%layout(2:1:-1)
1651  mom_dom%io_layout(:) = md_in%io_layout(2:1:-1)
1652  else
1653  mom_dom%niglobal = md_in%niglobal ; mom_dom%njglobal = md_in%njglobal
1654  mom_dom%nihalo = md_in%nihalo ; mom_dom%njhalo = md_in%njhalo
1655 
1656  mom_dom%X_FLAGS = md_in%X_FLAGS ; mom_dom%Y_FLAGS = md_in%Y_FLAGS
1657  mom_dom%layout(:) = md_in%layout(:)
1658  mom_dom%io_layout(:) = md_in%io_layout(:)
1659  endif
1660 
1661  global_indices(1) = 1 ; global_indices(2) = mom_dom%niglobal
1662  global_indices(3) = 1 ; global_indices(4) = mom_dom%njglobal
1663 
1664  if (associated(md_in%maskmap)) then
1665  mask_table_exists = .true.
1666  allocate(mom_dom%maskmap(mom_dom%layout(1), mom_dom%layout(2)))
1667  if (qturns /= 0) then
1668  call rotate_array(md_in%maskmap(:,:), qturns, mom_dom%maskmap(:,:))
1669  else
1670  mom_dom%maskmap(:,:) = md_in%maskmap(:,:)
1671  endif
1672  else
1673  mask_table_exists = .false.
1674  endif
1675 
1676  if (present(halo_size) .and. present(min_halo)) call mom_error(fatal, &
1677  "clone_MOM_domain can not have both halo_size and min_halo present.")
1678 
1679  if (present(min_halo)) then
1680  mom_dom%nihalo = max(mom_dom%nihalo, min_halo(1))
1681  min_halo(1) = mom_dom%nihalo
1682  mom_dom%njhalo = max(mom_dom%njhalo, min_halo(2))
1683  min_halo(2) = mom_dom%njhalo
1684  endif
1685 
1686  if (present(halo_size)) then
1687  mom_dom%nihalo = halo_size ; mom_dom%njhalo = halo_size
1688  endif
1689 
1690  if (present(symmetric)) then ; mom_dom%symmetric = symmetric ; endif
1691 
1692  dom_name = "MOM"
1693  if (present(domain_name)) dom_name = trim(domain_name)
1694 
1695  if (mask_table_exists) then
1696  call mom_define_domain(global_indices, mom_dom%layout, mom_dom%mpp_domain, &
1697  xflags=mom_dom%X_FLAGS, yflags=mom_dom%Y_FLAGS, &
1698  xhalo=mom_dom%nihalo, yhalo=mom_dom%njhalo, &
1699  symmetry=mom_dom%symmetric, name=dom_name, &
1700  maskmap=mom_dom%maskmap)
1701 
1702  global_indices(2) = global_indices(2) / 2
1703  global_indices(4) = global_indices(4) / 2
1704  call mom_define_domain(global_indices, mom_dom%layout, &
1705  mom_dom%mpp_domain_d2, &
1706  xflags=mom_dom%X_FLAGS, yflags=mom_dom%Y_FLAGS, &
1707  xhalo=(mom_dom%nihalo/2), yhalo=(mom_dom%njhalo/2), &
1708  symmetry=mom_dom%symmetric, name=dom_name, &
1709  maskmap=mom_dom%maskmap)
1710  else
1711  call mom_define_domain(global_indices, mom_dom%layout, mom_dom%mpp_domain, &
1712  xflags=mom_dom%X_FLAGS, yflags=mom_dom%Y_FLAGS, &
1713  xhalo=mom_dom%nihalo, yhalo=mom_dom%njhalo, &
1714  symmetry=mom_dom%symmetric, name=dom_name)
1715 
1716  global_indices(2) = global_indices(2) / 2
1717  global_indices(4) = global_indices(4) / 2
1718  call mom_define_domain(global_indices, mom_dom%layout, &
1719  mom_dom%mpp_domain_d2, &
1720  xflags=mom_dom%X_FLAGS, yflags=mom_dom%Y_FLAGS, &
1721  xhalo=(mom_dom%nihalo/2), yhalo=(mom_dom%njhalo/2), &
1722  symmetry=mom_dom%symmetric, name=dom_name)
1723  endif
1724 
1725  if ((mom_dom%io_layout(1) + mom_dom%io_layout(2) > 0) .and. &
1726  (mom_dom%layout(1)*mom_dom%layout(2) > 1)) then
1727  call mom_define_io_domain(mom_dom%mpp_domain, mom_dom%io_layout)
1728  endif
1729 
1730 end subroutine clone_md_to_md
1731 
1732 !> clone_MD_to_d2D uses information from a MOM_domain_type to create a new
1733 !! domain2d type, while allowing some properties of the new type to differ from
1734 !! the original one.
1735 subroutine clone_md_to_d2d(MD_in, mpp_domain, min_halo, halo_size, symmetric, &
1736  domain_name, turns)
1737  type(mom_domain_type), intent(in) :: MD_in !< An existing MOM_domain to be cloned
1738  type(domain2d), intent(inout) :: mpp_domain !< The new mpp_domain to be set up
1739  integer, dimension(2), &
1740  optional, intent(inout) :: min_halo !< If present, this sets the
1741  !! minimum halo size for this domain in the i- and j-
1742  !! directions, and returns the actual halo size used.
1743  integer, optional, intent(in) :: halo_size !< If present, this sets the halo
1744  !! size for the domain in the i- and j-directions.
1745  !! min_halo and halo_size can not both be present.
1746  logical, optional, intent(in) :: symmetric !< If present, this specifies
1747  !! whether the new domain is symmetric, regardless of
1748  !! whether the macro SYMMETRIC_MEMORY_ is defined.
1749  character(len=*), &
1750  optional, intent(in) :: domain_name !< A name for the new domain, "MOM"
1751  !! if missing.
1752  integer, optional, intent(in) :: turns !< If true, swap X and Y axes
1753 
1754  integer :: global_indices(4), layout(2), io_layout(2)
1755  integer :: X_FLAGS, Y_FLAGS, niglobal, njglobal, nihalo, njhalo
1756  logical :: symmetric_dom
1757  character(len=64) :: dom_name
1758 
1759  if (present(turns)) &
1760  call mom_error(fatal, "Rotation not supported for MOM_domain to domain2d")
1761 
1762 ! Save the extra data for creating other domains of different resolution that overlay this domain
1763  niglobal = md_in%niglobal ; njglobal = md_in%njglobal
1764  nihalo = md_in%nihalo ; njhalo = md_in%njhalo
1765 
1766  symmetric_dom = md_in%symmetric
1767 
1768  x_flags = md_in%X_FLAGS ; y_flags = md_in%Y_FLAGS
1769  layout(:) = md_in%layout(:) ; io_layout(:) = md_in%io_layout(:)
1770 
1771  if (present(halo_size) .and. present(min_halo)) call mom_error(fatal, &
1772  "clone_MOM_domain can not have both halo_size and min_halo present.")
1773 
1774  if (present(min_halo)) then
1775  nihalo = max(nihalo, min_halo(1))
1776  njhalo = max(njhalo, min_halo(2))
1777  min_halo(1) = nihalo ; min_halo(2) = njhalo
1778  endif
1779 
1780  if (present(halo_size)) then
1781  nihalo = halo_size ; njhalo = halo_size
1782  endif
1783 
1784  if (present(symmetric)) then ; symmetric_dom = symmetric ; endif
1785 
1786  dom_name = "MOM"
1787  if (present(domain_name)) dom_name = trim(domain_name)
1788 
1789  global_indices(1) = 1 ; global_indices(2) = niglobal
1790  global_indices(3) = 1 ; global_indices(4) = njglobal
1791  if (associated(md_in%maskmap)) then
1792  call mom_define_domain( global_indices, layout, mpp_domain, &
1793  xflags=x_flags, yflags=y_flags, &
1794  xhalo=nihalo, yhalo=njhalo, &
1795  symmetry = symmetric, name=dom_name, &
1796  maskmap=md_in%maskmap )
1797  else
1798  call mom_define_domain( global_indices, layout, mpp_domain, &
1799  xflags=x_flags, yflags=y_flags, &
1800  xhalo=nihalo, yhalo=njhalo, &
1801  symmetry = symmetric, name=dom_name)
1802  endif
1803 
1804  if ((io_layout(1) + io_layout(2) > 0) .and. &
1805  (layout(1)*layout(2) > 1)) then
1806  call mom_define_io_domain(mpp_domain, io_layout)
1807  endif
1808 
1809 end subroutine clone_md_to_d2d
1810 
1811 !> Returns various data that has been stored in a MOM_domain_type
1812 subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, &
1813  isg, ieg, jsg, jeg, idg_offset, jdg_offset, &
1814  symmetric, local_indexing, index_offset)
1815  type(mom_domain_type), &
1816  intent(in) :: Domain !< The MOM domain from which to extract information
1817  integer, intent(out) :: isc !< The start i-index of the computational domain
1818  integer, intent(out) :: iec !< The end i-index of the computational domain
1819  integer, intent(out) :: jsc !< The start j-index of the computational domain
1820  integer, intent(out) :: jec !< The end j-index of the computational domain
1821  integer, intent(out) :: isd !< The start i-index of the data domain
1822  integer, intent(out) :: ied !< The end i-index of the data domain
1823  integer, intent(out) :: jsd !< The start j-index of the data domain
1824  integer, intent(out) :: jed !< The end j-index of the data domain
1825  integer, intent(out) :: isg !< The start i-index of the global domain
1826  integer, intent(out) :: ieg !< The end i-index of the global domain
1827  integer, intent(out) :: jsg !< The start j-index of the global domain
1828  integer, intent(out) :: jeg !< The end j-index of the global domain
1829  integer, intent(out) :: idg_offset !< The offset between the corresponding global and
1830  !! data i-index spaces.
1831  integer, intent(out) :: jdg_offset !< The offset between the corresponding global and
1832  !! data j-index spaces.
1833  logical, intent(out) :: symmetric !< True if symmetric memory is used.
1834  logical, optional, intent(in) :: local_indexing !< If true, local tracer array indices start at 1,
1835  !! as in most MOM6 code.
1836  integer, optional, intent(in) :: index_offset !< A fixed additional offset to all indices. This
1837  !! can be useful for some types of debugging with
1838  !! dynamic memory allocation.
1839  ! Local variables
1840  integer :: ind_off
1841  logical :: local
1842 
1843  local = .true. ; if (present(local_indexing)) local = local_indexing
1844  ind_off = 0 ; if (present(index_offset)) ind_off = index_offset
1845 
1846  call mpp_get_compute_domain(domain%mpp_domain, isc, iec, jsc, jec)
1847  call mpp_get_data_domain(domain%mpp_domain, isd, ied, jsd, jed)
1848  call mpp_get_global_domain(domain%mpp_domain, isg, ieg, jsg, jeg)
1849 
1850  ! This code institutes the MOM convention that local array indices start at 1.
1851  if (local) then
1852  idg_offset = isd-1 ; jdg_offset = jsd-1
1853  isc = isc-isd+1 ; iec = iec-isd+1 ; jsc = jsc-jsd+1 ; jec = jec-jsd+1
1854  ied = ied-isd+1 ; jed = jed-jsd+1
1855  isd = 1 ; jsd = 1
1856  else
1857  idg_offset = 0 ; jdg_offset = 0
1858  endif
1859  if (ind_off /= 0) then
1860  idg_offset = idg_offset + ind_off ; jdg_offset = jdg_offset + ind_off
1861  isc = isc + ind_off ; iec = iec + ind_off
1862  jsc = jsc + ind_off ; jec = jec + ind_off
1863  isd = isd + ind_off ; ied = ied + ind_off
1864  jsd = jsd + ind_off ; jed = jed + ind_off
1865  endif
1866  symmetric = domain%symmetric
1867 
1868 end subroutine get_domain_extent
1869 
1870 subroutine get_domain_extent_dsamp2(Domain, isc_d2, iec_d2, jsc_d2, jec_d2,&
1871  isd_d2, ied_d2, jsd_d2, jed_d2,&
1872  isg_d2, ieg_d2, jsg_d2, jeg_d2)
1873  type(mom_domain_type), &
1874  intent(in) :: Domain !< The MOM domain from which to extract information
1875  integer, intent(out) :: isc_d2 !< The start i-index of the computational domain
1876  integer, intent(out) :: iec_d2 !< The end i-index of the computational domain
1877  integer, intent(out) :: jsc_d2 !< The start j-index of the computational domain
1878  integer, intent(out) :: jec_d2 !< The end j-index of the computational domain
1879  integer, intent(out) :: isd_d2 !< The start i-index of the data domain
1880  integer, intent(out) :: ied_d2 !< The end i-index of the data domain
1881  integer, intent(out) :: jsd_d2 !< The start j-index of the data domain
1882  integer, intent(out) :: jed_d2 !< The end j-index of the data domain
1883  integer, intent(out) :: isg_d2 !< The start i-index of the global domain
1884  integer, intent(out) :: ieg_d2 !< The end i-index of the global domain
1885  integer, intent(out) :: jsg_d2 !< The start j-index of the global domain
1886  integer, intent(out) :: jeg_d2 !< The end j-index of the global domain
1887 
1888  call mpp_get_compute_domain(domain%mpp_domain_d2, isc_d2, iec_d2, jsc_d2, jec_d2)
1889  call mpp_get_data_domain(domain%mpp_domain_d2, isd_d2, ied_d2, jsd_d2, jed_d2)
1890  call mpp_get_global_domain (domain%mpp_domain_d2, isg_d2, ieg_d2, jsg_d2, jeg_d2)
1891  ! This code institutes the MOM convention that local array indices start at 1.
1892  isc_d2 = isc_d2-isd_d2+1 ; iec_d2 = iec_d2-isd_d2+1
1893  jsc_d2 = jsc_d2-jsd_d2+1 ; jec_d2 = jec_d2-jsd_d2+1
1894  ied_d2 = ied_d2-isd_d2+1 ; jed_d2 = jed_d2-jsd_d2+1
1895  isd_d2 = 1 ; jsd_d2 = 1
1896 end subroutine get_domain_extent_dsamp2
1897 
1898 !> Return the (potentially symmetric) computational domain i-bounds for an array
1899 !! passed without index specifications (i.e. indices start at 1) based on an array size.
1900 subroutine get_simple_array_i_ind(domain, size, is, ie, symmetric)
1901  type(mom_domain_type), intent(in) :: domain !< MOM domain from which to extract information
1902  integer, intent(in) :: size !< The i-array size
1903  integer, intent(out) :: is !< The computational domain starting i-index.
1904  integer, intent(out) :: ie !< The computational domain ending i-index.
1905  logical, optional, intent(in) :: symmetric !< If present, indicates whether symmetric sizes
1906  !! can be considered.
1907  ! Local variables
1908  logical :: sym
1909  character(len=120) :: mesg, mesg2
1910  integer :: isc, iec, jsc, jec, isd, ied, jsd, jed
1911 
1912  call mpp_get_compute_domain(domain%mpp_domain, isc, iec, jsc, jec)
1913  call mpp_get_data_domain(domain%mpp_domain, isd, ied, jsd, jed)
1914 
1915  isc = isc-isd+1 ; iec = iec-isd+1 ; ied = ied-isd+1 ; isd = 1
1916  sym = domain%symmetric ; if (present(symmetric)) sym = symmetric
1917 
1918  if (size == ied) then ; is = isc ; ie = iec
1919  elseif (size == 1+iec-isc) then ; is = 1 ; ie = size
1920  elseif (sym .and. (size == 1+ied)) then ; is = isc ; ie = iec+1
1921  elseif (sym .and. (size == 2+iec-isc)) then ; is = 1 ; ie = size+1
1922  else
1923  write(mesg,'("Unrecognized size ", i6, "in call to get_simple_array_i_ind. \")') size
1924  if (sym) then
1925  write(mesg2,'("Valid sizes are : ", 2i7)') ied, 1+iec-isc
1926  else
1927  write(mesg2,'("Valid sizes are : ", 4i7)') ied, 1+iec-isc, 1+ied, 2+iec-isc
1928  endif
1929  call mom_error(fatal, trim(mesg)//trim(mesg2))
1930  endif
1931 
1932 end subroutine get_simple_array_i_ind
1933 
1934 
1935 !> Return the (potentially symmetric) computational domain j-bounds for an array
1936 !! passed without index specifications (i.e. indices start at 1) based on an array size.
1937 subroutine get_simple_array_j_ind(domain, size, js, je, symmetric)
1938  type(mom_domain_type), intent(in) :: domain !< MOM domain from which to extract information
1939  integer, intent(in) :: size !< The j-array size
1940  integer, intent(out) :: js !< The computational domain starting j-index.
1941  integer, intent(out) :: je !< The computational domain ending j-index.
1942  logical, optional, intent(in) :: symmetric !< If present, indicates whether symmetric sizes
1943  !! can be considered.
1944  ! Local variables
1945  logical :: sym
1946  character(len=120) :: mesg, mesg2
1947  integer :: isc, iec, jsc, jec, isd, ied, jsd, jed
1948 
1949  call mpp_get_compute_domain(domain%mpp_domain, isc, iec, jsc, jec)
1950  call mpp_get_data_domain(domain%mpp_domain, isd, ied, jsd, jed)
1951 
1952  jsc = jsc-jsd+1 ; jec = jec-jsd+1 ; jed = jed-jsd+1 ; jsd = 1
1953  sym = domain%symmetric ; if (present(symmetric)) sym = symmetric
1954 
1955  if (size == jed) then ; js = jsc ; je = jec
1956  elseif (size == 1+jec-jsc) then ; js = 1 ; je = size
1957  elseif (sym .and. (size == 1+jed)) then ; js = jsc ; je = jec+1
1958  elseif (sym .and. (size == 2+jec-jsc)) then ; js = 1 ; je = size+1
1959  else
1960  write(mesg,'("Unrecognized size ", i6, "in call to get_simple_array_j_ind. \")') size
1961  if (sym) then
1962  write(mesg2,'("Valid sizes are : ", 2i7)') jed, 1+jec-jsc
1963  else
1964  write(mesg2,'("Valid sizes are : ", 4i7)') jed, 1+jec-jsc, 1+jed, 2+jec-jsc
1965  endif
1966  call mom_error(fatal, trim(mesg)//trim(mesg2))
1967  endif
1968 
1969 end subroutine get_simple_array_j_ind
1970 
1971 !> Returns the global shape of h-point arrays
1972 subroutine get_global_shape(domain, niglobal, njglobal)
1973  type(mom_domain_type), intent(in) :: domain !< MOM domain
1974  integer, intent(out) :: niglobal !< i-index global size of h-point arrays
1975  integer, intent(out) :: njglobal !< j-index global size of h-point arrays
1976 
1977  niglobal = domain%niglobal
1978  njglobal = domain%njglobal
1979 
1980 end subroutine get_global_shape
1981 
1982 end module mom_domains
mom_domains::pass_vector_complete
Complete a halo update on a pair of arrays representing the two components of a vector.
Definition: MOM_domains.F90:79
mom_file_parser::param_file_type
A structure that can be parsed to read and document run-time parameters.
Definition: MOM_file_parser.F90:54
mom_domains::pass_var_complete
Complete a non-blocking halo update on an array.
Definition: MOM_domains.F90:69
mom_cpu_clock
Wraps the MPP cpu clock functions.
Definition: MOM_cpu_clock.F90:2
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
mom_domains::fill_symmetric_edges
Do a set of halo updates that fill in the values at the duplicated edges of a staggered symmetric mem...
Definition: MOM_domains.F90:93
mom_domains::pass_var_start
Initiate a non-blocking halo update on an array.
Definition: MOM_domains.F90:64
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
mom_domains::pass_vector
Do a halo update on a pair of arrays representing the two components of a vector. ...
Definition: MOM_domains.F90:59
mom_coms
Interfaces to non-domain-oriented communication subroutines, including the MOM6 reproducing sums faci...
Definition: MOM_coms.F90:3
mom_domains::clone_mom_domain
Copy one MOM_domain_type into another.
Definition: MOM_domains.F90:99
mom_array_transform
Module for supporting the rotation of a field&#39;s index map. The implementation of each angle is descri...
Definition: MOM_array_transform.F90:14
mom_domains::pass_vector_start
Initiate a halo update on a pair of arrays representing the two components of a vector.
Definition: MOM_domains.F90:74
mom_domains
Describes the decomposed MOM domain and has routines for communications across PEs.
Definition: MOM_domains.F90:2
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
mom_array_transform::rotate_array
Rotate the elements of an array to the rotated set of indices. Rotation is applied across the first a...
Definition: MOM_array_transform.F90:27
mom_domains::mom_domain_type
The MOM_domain_type contains information about the domain decompositoin.
Definition: MOM_domains.F90:104
mom_domains::create_group_pass
Set up a group of halo updates.
Definition: MOM_domains.F90:84
mom_string_functions
Handy functions for manipulating strings.
Definition: MOM_string_functions.F90:2
mom_domains::pass_var
Do a halo update on an array.
Definition: MOM_domains.F90:54
mom_file_parser::get_param
An overloaded interface to read and log the values of various types of parameters.
Definition: MOM_file_parser.F90:102