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