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