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 | !> Thin interfaces to non-domain-oriented mpp communication subroutines | |
| 6 | module MOM_coms_infra | |
| 7 | ||
| 8 | use iso_fortran_env, only : int32, int64 | |
| 9 | ||
| 10 | use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_npes, mpp_set_root_pe | |
| 11 | use mpp_mod, only : mpp_set_current_pelist, mpp_get_current_pelist | |
| 12 | use mpp_mod, only : mpp_broadcast, mpp_sync, mpp_sync_self, mpp_chksum | |
| 13 | use mpp_mod, only : mpp_sum, mpp_max, mpp_min | |
| 14 | use memutils_mod, only : print_memuse_stats | |
| 15 | use fms_mod, only : fms_end, fms_init | |
| 16 | ||
| 17 | implicit none ; private | |
| 18 | ||
| 19 | public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist, sync_PEs | |
| 20 | public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs | |
| 21 | public :: any_across_PEs, all_across_PEs | |
| 22 | public :: field_chksum, MOM_infra_init, MOM_infra_end | |
| 23 | ||
| 24 | ! This module provides interfaces to the non-domain-oriented communication | |
| 25 | ! subroutines. | |
| 26 | ||
| 27 | !> Communicate an array, string or scalar from one PE to others | |
| 28 | interface broadcast | |
| 29 | module procedure broadcast_char, broadcast_int32_0D, broadcast_int64_0D, broadcast_int1D | |
| 30 | module procedure broadcast_real0D, broadcast_real1D, broadcast_real2D, broadcast_real3D | |
| 31 | end interface broadcast | |
| 32 | ||
| 33 | !> Compute a checksum for a field distributed over a PE list. If no PE list is | |
| 34 | !! provided, then the current active PE list is used. | |
| 35 | interface field_chksum | |
| 36 | module procedure field_chksum_real_0d | |
| 37 | module procedure field_chksum_real_1d | |
| 38 | module procedure field_chksum_real_2d | |
| 39 | module procedure field_chksum_real_3d | |
| 40 | module procedure field_chksum_real_4d | |
| 41 | end interface field_chksum | |
| 42 | ||
| 43 | !> Find the sum of field across PEs, and update PEs with the sums. | |
| 44 | interface sum_across_PEs | |
| 45 | module procedure sum_across_PEs_int4_0d | |
| 46 | module procedure sum_across_PEs_int4_1d | |
| 47 | module procedure sum_across_PEs_int4_2d | |
| 48 | module procedure sum_across_PEs_int8_0d | |
| 49 | module procedure sum_across_PEs_int8_1d | |
| 50 | module procedure sum_across_PEs_int8_2d | |
| 51 | module procedure sum_across_PEs_real_0d | |
| 52 | module procedure sum_across_PEs_real_1d | |
| 53 | module procedure sum_across_PEs_real_2d | |
| 54 | end interface sum_across_PEs | |
| 55 | ||
| 56 | !> Find the maximum value of field across PEs, and update PEs with the values. | |
| 57 | interface max_across_PEs | |
| 58 | module procedure max_across_PEs_int_0d | |
| 59 | module procedure max_across_PEs_real_0d | |
| 60 | module procedure max_across_PEs_real_1d | |
| 61 | end interface max_across_PEs | |
| 62 | ||
| 63 | !> Find the minimum value of field across PEs, and update PEs with the values. | |
| 64 | interface min_across_PEs | |
| 65 | module procedure min_across_PEs_int_0d | |
| 66 | module procedure min_across_PEs_real_0d | |
| 67 | module procedure min_across_PEs_real_1d | |
| 68 | end interface min_across_PEs | |
| 69 | ||
| 70 | contains | |
| 71 | ||
| 72 | !> Return the ID of the PE for the current process. | |
| 73 | 5 | function PE_here() result(pe) |
| 74 | integer :: pe !< PE ID of the current process | |
| 75 | 5 | pe = mpp_pe() |
| 76 | 5 | end function PE_here |
| 77 | ||
| 78 | !> Return the ID of the root PE for the PE list of the current procss. | |
| 79 | 6 | function root_PE() result(pe) |
| 80 | integer :: pe !< root PE ID | |
| 81 | 6 | pe = mpp_root_pe() |
| 82 | 6 | end function root_PE |
| 83 | ||
| 84 | !> Return the number of PEs for the current PE list. | |
| 85 | 174 | function num_PEs() result(npes) |
| 86 | integer :: npes !< Number of PEs | |
| 87 | 174 | npes = mpp_npes() |
| 88 | 174 | end function num_PEs |
| 89 | ||
| 90 | !> Designate a PE as the root PE | |
| 91 | 0 | subroutine set_rootPE(pe) |
| 92 | integer, intent(in) :: pe !< ID of the PE to be assigned as root | |
| 93 | 0 | call mpp_set_root_pe(pe) |
| 94 | 0 | end subroutine |
| 95 | ||
| 96 | !> Set the current PE list. If no list is provided, then the current PE list | |
| 97 | !! is set to the list of all available PEs on the communicator. Setting the | |
| 98 | !! list will trigger a rank synchronization unless the `no_sync` flag is set. | |
| 99 | 0 | subroutine Set_PEList(pelist, no_sync) |
| 100 | integer, optional, intent(in) :: pelist(:) !< List of PEs to set for communication | |
| 101 | logical, optional, intent(in) :: no_sync !< Do not sync after list update. | |
| 102 | 0 | call mpp_set_current_pelist(pelist, no_sync) |
| 103 | 0 | end subroutine Set_PEList |
| 104 | ||
| 105 | !> Retrieve the current PE list and any metadata if requested. | |
| 106 | 0 | subroutine Get_PEList(pelist, name, commID) |
| 107 | integer, intent(out) :: pelist(:) !< List of PE IDs of the current PE list | |
| 108 | character(len=*), optional, intent(out) :: name !< Name of PE list | |
| 109 | integer, optional, intent(out) :: commID !< Communicator ID of PE list | |
| 110 | ||
| 111 | 0 | call mpp_get_current_pelist(pelist, name, commiD) |
| 112 | 0 | end subroutine Get_PEList |
| 113 | ||
| 114 | !> Sync the PEs at a defined point in the model | |
| 115 | 0 | subroutine sync_PEs(pelist) |
| 116 | integer, optional, intent(in) :: pelist(:) !< The list of PEs to be synced | |
| 117 | ||
| 118 | 0 | call mpp_sync(pelist) |
| 119 | 0 | end subroutine sync_PEs |
| 120 | ||
| 121 | !> Communicate a 1-D array of character strings from one PE to others | |
| 122 | 2 | subroutine broadcast_char(dat, length, from_PE, PElist, blocking) |
| 123 | character(len=*), intent(inout) :: dat(:) !< The data to communicate and destination | |
| 124 | integer, intent(in) :: length !< The length of each string | |
| 125 | integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE | |
| 126 | integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the | |
| 127 | !! active PE set as previously set via Set_PElist. | |
| 128 | logical, optional, intent(in) :: blocking !< If true, barriers are added around the call | |
| 129 | ||
| 130 | integer :: src_PE ! The processor that is sending the data | |
| 131 | logical :: do_block ! If true add synchronizing barriers | |
| 132 | ||
| 133 | 2 | do_block = .false. ; if (present(blocking)) do_block = blocking |
| 134 | 2 | if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif |
| 135 | ||
| 136 | 2 | if (do_block) call mpp_sync(PElist) |
| 137 | 2 | call mpp_broadcast(dat, length, src_PE, PElist) |
| 138 | 2 | if (do_block) call mpp_sync_self(PElist) |
| 139 | ||
| 140 | 2 | end subroutine broadcast_char |
| 141 | ||
| 142 | !> Communicate an integer from one PE to others | |
| 143 | 0 | subroutine broadcast_int64_0D(dat, from_PE, PElist, blocking) |
| 144 | integer(kind=int64), intent(inout) :: dat !< The data to communicate and destination | |
| 145 | integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE | |
| 146 | integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the | |
| 147 | !! active PE set as previously set via Set_PElist. | |
| 148 | logical, optional, intent(in) :: blocking !< If true, barriers are added around the call | |
| 149 | ||
| 150 | integer :: src_PE ! The processor that is sending the data | |
| 151 | logical :: do_block ! If true add synchronizing barriers | |
| 152 | ||
| 153 | 0 | do_block = .false. ; if (present(blocking)) do_block = blocking |
| 154 | 0 | if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif |
| 155 | ||
| 156 | 0 | if (do_block) call mpp_sync(PElist) |
| 157 | 0 | call mpp_broadcast(dat, src_PE, PElist) |
| 158 | 0 | if (do_block) call mpp_sync_self(PElist) |
| 159 | ||
| 160 | 0 | end subroutine broadcast_int64_0D |
| 161 | ||
| 162 | ||
| 163 | !> Communicate an integer from one PE to others | |
| 164 | 0 | subroutine broadcast_int32_0D(dat, from_PE, PElist, blocking) |
| 165 | integer(kind=int32), intent(inout) :: dat !< The data to communicate and destination | |
| 166 | integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE | |
| 167 | integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the | |
| 168 | !! active PE set as previously set via Set_PElist. | |
| 169 | logical, optional, intent(in) :: blocking !< If true, barriers are added around the call | |
| 170 | ||
| 171 | integer :: src_PE ! The processor that is sending the data | |
| 172 | logical :: do_block ! If true add synchronizing barriers | |
| 173 | ||
| 174 | 0 | do_block = .false. ; if (present(blocking)) do_block = blocking |
| 175 | 0 | if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif |
| 176 | ||
| 177 | 0 | if (do_block) call mpp_sync(PElist) |
| 178 | 0 | call mpp_broadcast(dat, src_PE, PElist) |
| 179 | 0 | if (do_block) call mpp_sync_self(PElist) |
| 180 | ||
| 181 | 0 | end subroutine broadcast_int32_0D |
| 182 | ||
| 183 | !> Communicate a 1-D array of integers from one PE to others | |
| 184 | 4 | subroutine broadcast_int1D(dat, length, from_PE, PElist, blocking) |
| 185 | integer, dimension(:), intent(inout) :: dat !< The data to communicate and destination | |
| 186 | integer, intent(in) :: length !< The number of data elements | |
| 187 | integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE | |
| 188 | integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the | |
| 189 | !! active PE set as previously set via Set_PElist. | |
| 190 | logical, optional, intent(in) :: blocking !< If true, barriers are added around the call | |
| 191 | ||
| 192 | integer :: src_PE ! The processor that is sending the data | |
| 193 | logical :: do_block ! If true add synchronizing barriers | |
| 194 | ||
| 195 | 4 | do_block = .false. ; if (present(blocking)) do_block = blocking |
| 196 | 4 | if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif |
| 197 | ||
| 198 | 4 | if (do_block) call mpp_sync(PElist) |
| 199 | 4 | call mpp_broadcast(dat, length, src_PE, PElist) |
| 200 | 4 | if (do_block) call mpp_sync_self(PElist) |
| 201 | ||
| 202 | 4 | end subroutine broadcast_int1D |
| 203 | ||
| 204 | !> Communicate a real number from one PE to others | |
| 205 | 0 | subroutine broadcast_real0D(dat, from_PE, PElist, blocking) |
| 206 | real, intent(inout) :: dat !< The data to communicate and destination | |
| 207 | integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE | |
| 208 | integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the | |
| 209 | !! active PE set as previously set via Set_PElist. | |
| 210 | logical, optional, intent(in) :: blocking !< If true, barriers are added around the call | |
| 211 | ||
| 212 | integer :: src_PE ! The processor that is sending the data | |
| 213 | logical :: do_block ! If true add synchronizing barriers | |
| 214 | ||
| 215 | 0 | do_block = .false. ; if (present(blocking)) do_block = blocking |
| 216 | 0 | if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif |
| 217 | ||
| 218 | 0 | if (do_block) call mpp_sync(PElist) |
| 219 | 0 | call mpp_broadcast(dat, src_PE, PElist) |
| 220 | 0 | if (do_block) call mpp_sync_self(PElist) |
| 221 | ||
| 222 | 0 | end subroutine broadcast_real0D |
| 223 | ||
| 224 | !> Communicate a 1-D array of reals from one PE to others | |
| 225 | 0 | subroutine broadcast_real1D(dat, length, from_PE, PElist, blocking) |
| 226 | real, dimension(:), intent(inout) :: dat !< The data to communicate and destination | |
| 227 | integer, intent(in) :: length !< The number of data elements | |
| 228 | integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE | |
| 229 | integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the | |
| 230 | !! active PE set as previously set via Set_PElist. | |
| 231 | logical, optional, intent(in) :: blocking !< If true, barriers are added around the call | |
| 232 | ||
| 233 | integer :: src_PE ! The processor that is sending the data | |
| 234 | logical :: do_block ! If true add synchronizing barriers | |
| 235 | ||
| 236 | 0 | do_block = .false. ; if (present(blocking)) do_block = blocking |
| 237 | 0 | if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif |
| 238 | ||
| 239 | 0 | if (do_block) call mpp_sync(PElist) |
| 240 | 0 | call mpp_broadcast(dat, length, src_PE, PElist) |
| 241 | 0 | if (do_block) call mpp_sync_self(PElist) |
| 242 | ||
| 243 | 0 | end subroutine broadcast_real1D |
| 244 | ||
| 245 | !> Communicate a 2-D array of reals from one PE to others | |
| 246 | 0 | subroutine broadcast_real2D(dat, length, from_PE, PElist, blocking) |
| 247 | real, dimension(:,:), intent(inout) :: dat !< The data to communicate and destination | |
| 248 | integer, intent(in) :: length !< The total number of data elements | |
| 249 | integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE | |
| 250 | integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the | |
| 251 | !! active PE set as previously set via Set_PElist. | |
| 252 | logical, optional, intent(in) :: blocking !< If true, barriers are added around the call | |
| 253 | ||
| 254 | integer :: src_PE ! The processor that is sending the data | |
| 255 | logical :: do_block ! If true add synchronizing barriers | |
| 256 | ||
| 257 | 0 | do_block = .false. ; if (present(blocking)) do_block = blocking |
| 258 | 0 | if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif |
| 259 | ||
| 260 | 0 | if (do_block) call mpp_sync(PElist) |
| 261 | 0 | call mpp_broadcast(dat, length, src_PE, PElist) |
| 262 | 0 | if (do_block) call mpp_sync_self(PElist) |
| 263 | ||
| 264 | 0 | end subroutine broadcast_real2D |
| 265 | ||
| 266 | !> Communicate a 3-D array of reals from one PE to others | |
| 267 | 0 | subroutine broadcast_real3D(dat, length, from_PE, PElist, blocking) |
| 268 | real, dimension(:,:,:), intent(inout) :: dat !< The data to communicate and destination | |
| 269 | integer, intent(in) :: length !< The total number of data elements | |
| 270 | integer, optional, intent(in) :: from_PE !< The source PE, by default the root PE | |
| 271 | integer, optional, intent(in) :: PElist(:) !< The list of participating PEs, by default the | |
| 272 | !! active PE set as previously set via Set_PElist. | |
| 273 | logical, optional, intent(in) :: blocking !< If true, barriers are added around the call | |
| 274 | ||
| 275 | integer :: src_PE ! The processor that is sending the data | |
| 276 | logical :: do_block ! If true add synchronizing barriers | |
| 277 | ||
| 278 | 0 | do_block = .false. ; if (present(blocking)) do_block = blocking |
| 279 | 0 | if (present(from_PE)) then ; src_PE = from_PE ; else ; src_PE = root_PE() ; endif |
| 280 | ||
| 281 | 0 | if (do_block) call mpp_sync(PElist) |
| 282 | 0 | call mpp_broadcast(dat, length, src_PE, PElist) |
| 283 | 0 | if (do_block) call mpp_sync_self(PElist) |
| 284 | ||
| 285 | 0 | end subroutine broadcast_real3D |
| 286 | ||
| 287 | ! field_chksum wrappers | |
| 288 | ||
| 289 | !> Compute a checksum for a field distributed over a PE list. If no PE list is | |
| 290 | !! provided, then the current active PE list is used. | |
| 291 | 4 | function field_chksum_real_0d(field, pelist, mask_val) result(chksum) |
| 292 | real, intent(in) :: field !< Input scalar | |
| 293 | integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum | |
| 294 | real, optional, intent(in) :: mask_val !< FMS mask value | |
| 295 | integer(kind=int64) :: chksum !< checksum of array | |
| 296 | ||
| 297 | 4 | chksum = mpp_chksum(field, pelist, mask_val) |
| 298 | 4 | end function field_chksum_real_0d |
| 299 | ||
| 300 | !> Compute a checksum for a field distributed over a PE list. If no PE list is | |
| 301 | !! provided, then the current active PE list is used. | |
| 302 | 0 | function field_chksum_real_1d(field, pelist, mask_val) result(chksum) |
| 303 | real, dimension(:), intent(in) :: field !< Input array | |
| 304 | integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum | |
| 305 | real, optional, intent(in) :: mask_val !< FMS mask value | |
| 306 | integer(kind=int64) :: chksum !< checksum of array | |
| 307 | ||
| 308 | 0 | chksum = mpp_chksum(field, pelist, mask_val) |
| 309 | 0 | end function field_chksum_real_1d |
| 310 | ||
| 311 | !> Compute a checksum for a field distributed over a PE list. If no PE list is | |
| 312 | !! provided, then the current active PE list is used. | |
| 313 | 28 | function field_chksum_real_2d(field, pelist, mask_val) result(chksum) |
| 314 | real, dimension(:,:), intent(in) :: field !< Unrotated input field | |
| 315 | integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum | |
| 316 | real, optional, intent(in) :: mask_val !< FMS mask value | |
| 317 | integer(kind=int64) :: chksum !< checksum of array | |
| 318 | ||
| 319 | 28 | chksum = mpp_chksum(field, pelist, mask_val) |
| 320 | 28 | end function field_chksum_real_2d |
| 321 | ||
| 322 | !> Compute a checksum for a field distributed over a PE list. If no PE list is | |
| 323 | !! provided, then the current active PE list is used. | |
| 324 | 31 | function field_chksum_real_3d(field, pelist, mask_val) result(chksum) |
| 325 | real, dimension(:,:,:), intent(in) :: field !< Unrotated input field | |
| 326 | integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum | |
| 327 | real, optional, intent(in) :: mask_val !< FMS mask value | |
| 328 | integer(kind=int64) :: chksum !< checksum of array | |
| 329 | ||
| 330 | 31 | chksum = mpp_chksum(field, pelist, mask_val) |
| 331 | 31 | end function field_chksum_real_3d |
| 332 | ||
| 333 | !> Compute a checksum for a field distributed over a PE list. If no PE list is | |
| 334 | !! provided, then the current active PE list is used. | |
| 335 | 0 | function field_chksum_real_4d(field, pelist, mask_val) result(chksum) |
| 336 | real, dimension(:,:,:,:), intent(in) :: field !< Unrotated input field | |
| 337 | integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum | |
| 338 | real, optional, intent(in) :: mask_val !< FMS mask value | |
| 339 | integer(kind=int64) :: chksum !< checksum of array | |
| 340 | ||
| 341 | 0 | chksum = mpp_chksum(field, pelist, mask_val) |
| 342 | 0 | end function field_chksum_real_4d |
| 343 | ||
| 344 | ! sum_across_PEs wrappers | |
| 345 | ||
| 346 | !> Find the sum of field across PEs, and return this sum in field. | |
| 347 | 3 | subroutine sum_across_PEs_int4_0d(field, pelist) |
| 348 | integer(kind=int32), intent(inout) :: field !< Value on this PE, and the sum across PEs upon return | |
| 349 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 350 | ||
| 351 | 3 | call mpp_sum(field, pelist) |
| 352 | 3 | end subroutine sum_across_PEs_int4_0d |
| 353 | ||
| 354 | !> Find the sum of the values in corresponding positions of field across PEs, and return these sums in field. | |
| 355 | 19 | subroutine sum_across_PEs_int4_1d(field, length, pelist) |
| 356 | integer(kind=int32), dimension(:), intent(inout) :: field !< The values to add, the sums upon return | |
| 357 | integer, intent(in) :: length !< Number of elements in field to add | |
| 358 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 359 | ||
| 360 | 19 | call mpp_sum(field, length, pelist) |
| 361 | 19 | end subroutine sum_across_PEs_int4_1d |
| 362 | ||
| 363 | !> Find the sum of the values in corresponding positions of field across PEs, and return these sums in field. | |
| 364 | 0 | subroutine sum_across_PEs_int4_2d(field, length, pelist) |
| 365 | integer(kind=int32), dimension(:,:), intent(inout) :: field !< The values to add, the sums upon return | |
| 366 | integer, intent(in) :: length !< Number of elements in field to add | |
| 367 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 368 | ||
| 369 | 0 | call mpp_sum(field, length, pelist) |
| 370 | 0 | end subroutine sum_across_PEs_int4_2d |
| 371 | ||
| 372 | !> Find the sum of field across PEs, and return this sum in field. | |
| 373 | 0 | subroutine sum_across_PEs_int8_0d(field, pelist) |
| 374 | integer(kind=int64), intent(inout) :: field !< Value on this PE, and the sum across PEs upon return | |
| 375 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 376 | ||
| 377 | 0 | call mpp_sum(field, pelist) |
| 378 | 0 | end subroutine sum_across_PEs_int8_0d |
| 379 | ||
| 380 | !> Find the sum of the values in corresponding positions of field across PEs, and return these sums in field. | |
| 381 | 13 | subroutine sum_across_PEs_int8_1d(field, length, pelist) |
| 382 | integer(kind=int64), dimension(:), intent(inout) :: field !< The values to add, the sums upon return | |
| 383 | integer, intent(in) :: length !< Number of elements in field to add | |
| 384 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 385 | ||
| 386 | 13 | call mpp_sum(field, length, pelist) |
| 387 | 13 | end subroutine sum_across_PEs_int8_1d |
| 388 | ||
| 389 | !> Find the sum of the values in corresponding positions of field across PEs, and return these sums in field. | |
| 390 | 15 | subroutine sum_across_PEs_int8_2d(field, length, pelist) |
| 391 | integer(kind=int64), & | |
| 392 | dimension(:,:), intent(inout) :: field !< The values to add, the sums upon return | |
| 393 | integer, intent(in) :: length !< The total number of positions to sum, usually | |
| 394 | !! the product of the array sizes. | |
| 395 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 396 | ||
| 397 | 15 | call mpp_sum(field, length, pelist) |
| 398 | 15 | end subroutine sum_across_PEs_int8_2d |
| 399 | ||
| 400 | !> Find the sum of field across PEs, and return this sum in field. | |
| 401 | 2 | subroutine sum_across_PEs_real_0d(field, pelist) |
| 402 | real, intent(inout) :: field !< Value on this PE, and the sum across PEs upon return | |
| 403 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 404 | ||
| 405 | 2 | call mpp_sum(field, pelist) |
| 406 | 2 | end subroutine sum_across_PEs_real_0d |
| 407 | ||
| 408 | !> Find the sum of the values in corresponding positions of field across PEs, and return these sums in field. | |
| 409 | 2 | subroutine sum_across_PEs_real_1d(field, length, pelist) |
| 410 | real, dimension(:), intent(inout) :: field !< The values to add, the sums upon return | |
| 411 | integer, intent(in) :: length !< Number of elements in field to add | |
| 412 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 413 | ||
| 414 | 2 | call mpp_sum(field, length, pelist) |
| 415 | 2 | end subroutine sum_across_PEs_real_1d |
| 416 | ||
| 417 | !> Find the sum of the values in corresponding positions of field across PEs, and return these sums in field. | |
| 418 | 0 | subroutine sum_across_PEs_real_2d(field, length, pelist) |
| 419 | real, dimension(:,:), intent(inout) :: field !< The values to add, the sums upon return | |
| 420 | integer, intent(in) :: length !< The total number of positions to sum, usually | |
| 421 | !! the product of the array sizes. | |
| 422 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 423 | ||
| 424 | 0 | call mpp_sum(field, length, pelist) |
| 425 | 0 | end subroutine sum_across_PEs_real_2d |
| 426 | ||
| 427 | ! max_across_PEs wrappers | |
| 428 | ||
| 429 | !> Find the maximum value of field across PEs, and store this maximum in field. | |
| 430 | 13 | subroutine max_across_PEs_int_0d(field, pelist) |
| 431 | integer, intent(inout) :: field !< The values to compare, the maximum upon return | |
| 432 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 433 | ||
| 434 | 13 | call mpp_max(field, pelist) |
| 435 | 13 | end subroutine max_across_PEs_int_0d |
| 436 | ||
| 437 | !> Find the maximum value of field across PEs, and store this maximum in field. | |
| 438 | 18 | subroutine max_across_PEs_real_0d(field, pelist) |
| 439 | real, intent(inout) :: field !< The values to compare, the maximum upon return | |
| 440 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 441 | ||
| 442 | 18 | call mpp_max(field, pelist) |
| 443 | 18 | end subroutine max_across_PEs_real_0d |
| 444 | ||
| 445 | !> Find the maximum values in each position of field across PEs, and store these minima in field. | |
| 446 | 9 | subroutine max_across_PEs_real_1d(field, length, pelist) |
| 447 | real, dimension(:), intent(inout) :: field !< The list of values being compared, with the | |
| 448 | !! maxima in each position upon return | |
| 449 | integer, intent(in) :: length !< Number of elements in field to compare | |
| 450 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 451 | ||
| 452 | 9 | call mpp_max(field, length, pelist) |
| 453 | 9 | end subroutine max_across_PEs_real_1d |
| 454 | ||
| 455 | ! min_across_PEs wrappers | |
| 456 | ||
| 457 | !> Find the minimum value of field across PEs, and store this minimum in field. | |
| 458 | 0 | subroutine min_across_PEs_int_0d(field, pelist) |
| 459 | integer, intent(inout) :: field !< The values to compare, the minimum upon return | |
| 460 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 461 | ||
| 462 | 0 | call mpp_min(field, pelist) |
| 463 | 0 | end subroutine min_across_PEs_int_0d |
| 464 | ||
| 465 | !> Find the minimum value of field across PEs, and store this minimum in field. | |
| 466 | 22 | subroutine min_across_PEs_real_0d(field, pelist) |
| 467 | real, intent(inout) :: field !< The values to compare, the minimum upon return | |
| 468 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 469 | 22 | call mpp_min(field, pelist) |
| 470 | 22 | end subroutine min_across_PEs_real_0d |
| 471 | ||
| 472 | !> Find the minimum values in each position of field across PEs, and store these minima in field. | |
| 473 | 0 | subroutine min_across_PEs_real_1d(field, length, pelist) |
| 474 | real, dimension(:), intent(inout) :: field !< The list of values being compared, with the | |
| 475 | !! minima in each position upon return | |
| 476 | integer, intent(in) :: length !< Number of elements in field to compare | |
| 477 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 478 | ||
| 479 | 0 | call mpp_min(field, length, pelist) |
| 480 | 0 | end subroutine min_across_PEs_real_1d |
| 481 | ||
| 482 | !> Implementation of any() intrinsic across PEs | |
| 483 | 1 | function any_across_PEs(field, pelist) |
| 484 | logical, intent(in) :: field !< Local PE value | |
| 485 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 486 | logical :: any_across_PEs | |
| 487 | ||
| 488 | integer :: field_flag | |
| 489 | ||
| 490 | ! FMS1 does not support logical collectives, so integer flags are used. | |
| 491 | 1 | field_flag = 0 |
| 492 | 1 | if (field) field_flag = 1 |
| 493 | 1 | call max_across_PEs(field_flag, pelist) |
| 494 | 1 | any_across_PEs = (field_flag > 0) |
| 495 | 1 | end function any_across_PEs |
| 496 | ||
| 497 | !> Implementation of all() intrinsic across PEs | |
| 498 | 0 | function all_across_PEs(field, pelist) |
| 499 | logical, intent(in) :: field !< Local PE value | |
| 500 | integer, optional, intent(in) :: pelist(:) !< List of PEs to work with | |
| 501 | logical :: all_across_PEs | |
| 502 | ||
| 503 | integer :: field_flag | |
| 504 | ||
| 505 | ! FMS1 does not support logical collectives, so integer flags are used. | |
| 506 | 0 | field_flag = 0 |
| 507 | 0 | if (field) field_flag = 1 |
| 508 | 0 | call min_across_PEs(field_flag, pelist) |
| 509 | 0 | all_across_PEs = (field_flag > 0) |
| 510 | 0 | end function all_across_PEs |
| 511 | ||
| 512 | !> Initialize the model framework, including PE communication over a designated communicator. | |
| 513 | !! If no communicator ID is provided, the framework's default communicator is used. | |
| 514 | 1 | subroutine MOM_infra_init(localcomm) |
| 515 | integer, optional, intent(in) :: localcomm !< Communicator ID to initialize | |
| 516 | 1 | call fms_init(localcomm) |
| 517 | 1 | end subroutine |
| 518 | ||
| 519 | !> This subroutine carries out all of the calls required to close out the infrastructure cleanly. | |
| 520 | !! This should only be called in ocean-only runs, as the coupler takes care of this in coupled runs. | |
| 521 | 1 | subroutine MOM_infra_end |
| 522 | 1 | call print_memuse_stats( 'Memory HiWaterMark', always=.TRUE. ) |
| 523 | 1 | call fms_end() |
| 524 | 1 | end subroutine MOM_infra_end |
| 525 | ||
| 526 | end module MOM_coms_infra |