From 3126f0592c702b3003397e0a33e4ce8516ce9bd1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 24 Jan 2021 08:08:45 -0500 Subject: [PATCH 1/6] +Made get_domain_extent work with domain2D types Overloaded get_domain_extent to extract index ranges with domain2D types as well as MOM_domain_types. Also made the global extent arguments optional to get_domain_extent_MD. All answers are bitwise identical. --- src/framework/MOM_domain_infra.F90 | 91 +++++++++++++++++++++--------- 1 file changed, 64 insertions(+), 27 deletions(-) diff --git a/src/framework/MOM_domain_infra.F90 b/src/framework/MOM_domain_infra.F90 index 482e01871f..5ced2e33c0 100644 --- a/src/framework/MOM_domain_infra.F90 +++ b/src/framework/MOM_domain_infra.F90 @@ -111,6 +111,12 @@ module MOM_domain_infra module procedure get_domain_components_MD, get_domain_components_d2D end interface get_domain_components +!> Returns the index ranges that have been stored in a MOM_domain_type +interface get_domain_extent + module procedure get_domain_extent_MD, get_domain_extent_d2D +end interface get_domain_extent + + !> The MOM_domain_type contains information about the domain decomposition. type, public :: MOM_domain_type character(len=64) :: name !< The name of this domain @@ -1626,38 +1632,39 @@ subroutine clone_MD_to_d2D(MD_in, mpp_domain, min_halo, halo_size, symmetric, & end subroutine clone_MD_to_d2D -!> Returns various data that has been stored in a MOM_domain_type -subroutine 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, coarsen) +!> Returns the index ranges that have been stored in a MOM_domain_type +subroutine get_domain_extent_MD(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & + isg, ieg, jsg, jeg, idg_offset, jdg_offset, & + symmetric, local_indexing, index_offset, coarsen) type(MOM_domain_type), & - intent(in) :: Domain !< The MOM domain from which to extract information - integer, intent(out) :: isc !< The start i-index of the computational domain - integer, intent(out) :: iec !< The end i-index of the computational domain - integer, intent(out) :: jsc !< The start j-index of the computational domain - integer, intent(out) :: jec !< The end j-index of the computational domain - integer, intent(out) :: isd !< The start i-index of the data domain - integer, intent(out) :: ied !< The end i-index of the data domain - integer, intent(out) :: jsd !< The start j-index of the data domain - integer, intent(out) :: jed !< The end j-index of the data domain - integer, intent(out) :: isg !< The start i-index of the global domain - integer, intent(out) :: ieg !< The end i-index of the global domain - integer, intent(out) :: jsg !< The start j-index of the global domain - integer, intent(out) :: jeg !< The end j-index of the global domain + intent(in) :: Domain !< The MOM domain from which to extract information + integer, intent(out) :: isc !< The start i-index of the computational domain + integer, intent(out) :: iec !< The end i-index of the computational domain + integer, intent(out) :: jsc !< The start j-index of the computational domain + integer, intent(out) :: jec !< The end j-index of the computational domain + integer, intent(out) :: isd !< The start i-index of the data domain + integer, intent(out) :: ied !< The end i-index of the data domain + integer, intent(out) :: jsd !< The start j-index of the data domain + integer, intent(out) :: jed !< The end j-index of the data domain + integer, optional, intent(out) :: isg !< The start i-index of the global domain + integer, optional, intent(out) :: ieg !< The end i-index of the global domain + integer, optional, intent(out) :: jsg !< The start j-index of the global domain + integer, optional, intent(out) :: jeg !< The end j-index of the global domain integer, optional, intent(out) :: idg_offset !< The offset between the corresponding global and - !! data i-index spaces. + !! data i-index spaces. integer, optional, intent(out) :: jdg_offset !< The offset between the corresponding global and - !! data j-index spaces. + !! data j-index spaces. logical, optional, intent(out) :: symmetric !< True if symmetric memory is used. logical, optional, intent(in) :: local_indexing !< If true, local tracer array indices start at 1, - !! as in most MOM6 code. + !! as in most MOM6 code. The default is true. integer, optional, intent(in) :: index_offset !< A fixed additional offset to all indices. This !! can be useful for some types of debugging with - !! dynamic memory allocation. + !! dynamic memory allocation. The default is 0. integer, optional, intent(in) :: coarsen !< A factor by which the grid is coarsened. !! The default is 1, for no coarsening. ! Local variables + integer :: isg_, ieg_, jsg_, jeg_ integer :: ind_off, idg_off, jdg_off, coarsen_lev logical :: local @@ -1669,22 +1676,22 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & if (coarsen_lev == 1) then call mpp_get_compute_domain(Domain%mpp_domain, isc, iec, jsc, jec) call mpp_get_data_domain(Domain%mpp_domain, isd, ied, jsd, jed) - call mpp_get_global_domain(Domain%mpp_domain, isg, ieg, jsg, jeg) + call mpp_get_global_domain(Domain%mpp_domain, isg_, ieg_, jsg_, jeg_) elseif (coarsen_lev == 2) then if (.not.associated(Domain%mpp_domain_d2)) call MOM_error(FATAL, & "get_domain_extent called with coarsen=2, but Domain%mpp_domain_d2 is not associated.") call mpp_get_compute_domain(Domain%mpp_domain_d2, isc, iec, jsc, jec) call mpp_get_data_domain(Domain%mpp_domain_d2, isd, ied, jsd, jed) - call mpp_get_global_domain(Domain%mpp_domain_d2, isg, ieg, jsg, jeg) + call mpp_get_global_domain(Domain%mpp_domain_d2, isg_, ieg_, jsg_, jeg_) else call MOM_error(FATAL, "get_domain_extent called with an unsupported level of coarsening.") endif if (local) then ! This code institutes the MOM convention that local array indices start at 1. - idg_off = isd-1 ; jdg_off = jsd-1 - isc = isc-isd+1 ; iec = iec-isd+1 ; jsc = jsc-jsd+1 ; jec = jec-jsd+1 - ied = ied-isd+1 ; jed = jed-jsd+1 + idg_off = isd - 1 ; jdg_off = jsd - 1 + isc = isc - isd + 1 ; iec = iec - isd + 1 ; jsc = jsc - jsd + 1 ; jec = jec - jsd + 1 + ied = ied - isd + 1 ; jed = jed - jsd + 1 isd = 1 ; jsd = 1 else idg_off = 0 ; jdg_off = 0 @@ -1696,11 +1703,41 @@ subroutine get_domain_extent(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed, & isd = isd + ind_off ; ied = ied + ind_off jsd = jsd + ind_off ; jed = jed + ind_off endif + if (present(isg)) isg = isg_ + if (present(ieg)) ieg = ieg_ + if (present(jsg)) jsg = jsg_ + if (present(jeg)) jeg = jeg_ if (present(idg_offset)) idg_offset = idg_off if (present(jdg_offset)) jdg_offset = jdg_off if (present(symmetric)) symmetric = Domain%symmetric -end subroutine get_domain_extent +end subroutine get_domain_extent_MD + +!> Returns the index ranges that have been stored in a domain2D type +subroutine get_domain_extent_d2D(Domain, isc, iec, jsc, jec, isd, ied, jsd, jed) + type(domain2d), intent(in) :: Domain !< The MOM domain from which to extract information + integer, intent(out) :: isc !< The start i-index of the computational domain + integer, intent(out) :: iec !< The end i-index of the computational domain + integer, intent(out) :: jsc !< The start j-index of the computational domain + integer, intent(out) :: jec !< The end j-index of the computational domain + integer, optional, intent(out) :: isd !< The start i-index of the data domain + integer, optional, intent(out) :: ied !< The end i-index of the data domain + integer, optional, intent(out) :: jsd !< The start j-index of the data domain + integer, optional, intent(out) :: jed !< The end j-index of the data domain + + ! Local variables + integer :: isd_, ied_, jsd_, jed_, jsg_, jeg_, isg_, ieg_ + + call mpp_get_compute_domain(Domain, isc, iec, jsc, jec) + call mpp_get_data_domain(Domain, isd_, ied_, jsd_, jed_) + + if (present(isd)) isd = isd_ + if (present(ied)) ied = ied_ + if (present(jsd)) jsd = jsd_ + if (present(jed)) jed = jed_ + +end subroutine get_domain_extent_d2D + !> Return the (potentially symmetric) computational domain i-bounds for an array !! passed without index specifications (i.e. indices start at 1) based on an array size. From 74f229018dbb9cd8e0aba924a7874723e0206b2e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 24 Jan 2021 08:09:30 -0500 Subject: [PATCH 2/6] +Added MOM_coupler_types.F90 Added MOM_coupler_types.F90 and MOM_couplertype_infra.F90 to provide explicit interfaces for the routines from coupler_type_mod that MOM6 uses, with some new interfaces, extract_coupler_type_data and set_coupler_type_data, that are tailored to their use in MOM6. All answers are bitwise identical, but there are some new public interfaces. --- src/framework/MOM_coupler_types.F90 | 235 ++++++++++++++++++++++ src/framework/MOM_couplertype_infra.F90 | 247 ++++++++++++++++++++++++ 2 files changed, 482 insertions(+) create mode 100644 src/framework/MOM_coupler_types.F90 create mode 100644 src/framework/MOM_couplertype_infra.F90 diff --git a/src/framework/MOM_coupler_types.F90 b/src/framework/MOM_coupler_types.F90 new file mode 100644 index 0000000000..94014d9a56 --- /dev/null +++ b/src/framework/MOM_coupler_types.F90 @@ -0,0 +1,235 @@ +!> This module provides coupler type interfaces for use by MOM6 +module MOM_coupler_types + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_couplertype_infra, only : CT_spawn, CT_initialized, CT_destructor, atmos_ocn_coupler_flux +use MOM_couplertype_infra, only : CT_set_diags, CT_send_data, CT_write_chksums +use MOM_couplertype_infra, only : CT_copy_data, CT_increment_data, CT_set_data, CT_extract_data +use MOM_couplertype_infra, only : coupler_1d_bc_type, coupler_2d_bc_type +use MOM_couplertype_infra, only : ind_flux, ind_alpha, ind_csurf + +use MOM_time_manager, only : time_type + +implicit none ; private + +public :: coupler_type_spawn, coupler_type_destructor, coupler_type_initialized +public :: coupler_type_set_diags, coupler_type_send_data, coupler_type_write_chksums +public :: set_coupler_type_data, extract_coupler_type_data +public :: coupler_type_copy_data, coupler_type_increment_data +public :: atmos_ocn_coupler_flux +public :: ind_flux, ind_alpha, ind_csurf +public :: coupler_1d_bc_type, coupler_2d_bc_type + +!> This is the interface to spawn one coupler_bc_type into another. +interface coupler_type_spawn + module procedure CT_spawn_1d_2d, CT_spawn_2d_2d +end interface coupler_type_spawn + +!> This function interface indicates whether a coupler_bc_type has been initialized. +interface coupler_type_initialized + module procedure CT_initialized_1d, CT_initialized_2d +end interface coupler_type_initialized + +!> This is the interface to deallocate any data associated with a coupler_bc_type. +interface coupler_type_destructor + module procedure CT_destructor_1d, CT_destructor_2d +end interface coupler_type_destructor + +contains + +!> Generate a 2-D coupler type using a 1-D coupler type as a template. +subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed) + type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information + integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of + !! the first dimension in a non-decreasing list + integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of + !! the second dimension in a non-decreasing list + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique + logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) + !! is not set and the parent type (var_in) is set. + + call CT_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_1d_2d + +!> Generate one 2-D coupler type using another 2-D coupler type as a template. +subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed) + type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information + integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of + !! the first dimension in a non-decreasing list + integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of + !! the second dimension in a non-decreasing list + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique + logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) + !! is not set and the parent type (var_in) is set. + + call CT_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_2d_2d + +!> Copy all elements of the data in of one coupler_2d_bc_type into another. Both must have the same array sizes. +subroutine coupler_type_copy_data(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice) + type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(coupler_2d_bc_type), intent(inout) :: var !< The recipient BC_type structure + integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default + integer, optional, intent(in) :: bc_index !< The index of the boundary condition + !! that is being copied + integer, optional, intent(in) :: field_index !< The index of the field in the + !! boundary condition that is being copied + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes + !! to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes + !! to include from this copy. + logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose + !! value of pass_through ice matches this + + call CT_copy_data(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice) +end subroutine coupler_type_copy_data + +!> Increment data in all elements of one coupler_2d_bc_type with the data from another. Both +!! must have the same array sizes. +subroutine coupler_type_increment_data(var_in, var, halo_size, scale_factor, scale_prev) + type(coupler_2d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type + type(coupler_2d_bc_type), intent(inout) :: var !< The coupler_type structure whose fields are being incremented + integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default + real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added + real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here + + call CT_increment_data(var_in, var, halo_size=halo_size, scale_factor=scale_factor, & + scale_prev=scale_prev) + +end subroutine coupler_type_increment_data + +!> Extract a 2d field from a coupler_2d_bc_type into a two-dimensional array, using a +!! MOM-specific interface. +subroutine extract_coupler_type_data(var_in, bc_index, array_out, scale_factor, & + halo_size, idim, jdim, field_index) + type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract + integer, intent(in) :: bc_index !< The index of the boundary condition + !! that is being copied + real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size + !! must match the size of the data being copied + !! unless idim and jdim are supplied. + real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added + integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default + integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of + !! the first dimension of the output array + !! in a non-decreasing list + integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of + !! the second dimension of the output array + !! in a non-decreasing list + integer, optional, intent(in) :: field_index !< The index of the field in the boundary + !! condition that is being copied, or the + !! surface flux by default. + + if (present(field_index)) then + call CT_extract_data(var_in, bc_index, field_index, array_out, & + scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) + else + call CT_extract_data(var_in, bc_index, ind_flux, array_out, & + scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) + endif + +end subroutine extract_coupler_type_data + +!> Set single 2d field in coupler_2d_bc_type from a two-dimensional array, using a +!! MOM-specific interface. +subroutine set_coupler_type_data(array_in, bc_index, var, solubility, scale_factor, & + halo_size, idim, jdim, field_index) + real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size + !! must match the size of the data being copied + !! unless idim and jdim are supplied. + integer, intent(in) :: bc_index !< The index of the boundary condition + !! that is being copied + type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure with the data to set + logical, optional, intent(in) :: solubility !< If true and field index is missing, set + !! the solubility field. Otherwise set the + !! surface concentration (the default). + real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added + integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default + integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of + !! the first dimension of the output array + !! in a non-decreasing list + integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of + !! the second dimension of the output array + !! in a non-decreasing list + integer, optional, intent(in) :: field_index !< The index of the field in the + !! boundary condition that is being set. The + !! surface concentration is set by default. + + integer :: subfield ! An integer indicating which field to set. + + subfield = ind_csurf + if (present(solubility)) then ; if (solubility) subfield = ind_alpha ; endif + if (present(field_index)) subfield = field_index + + call CT_set_data(array_in, bc_index, subfield, var, & + scale_factor=scale_factor, halo_size=halo_size, idim=idim, jdim=jdim) + +end subroutine set_coupler_type_data + +!> Register the diagnostics of a coupler_2d_bc_type +subroutine coupler_type_set_diags(var, diag_name, axes, time) + type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics + character(len=*), intent(in) :: diag_name !< name for diagnostic file, or blank not to register the fields + integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration + type(time_type), intent(in) :: time !< model time variable for registering diagnostic field + + call CT_set_diags(var, diag_name, axes, time) + +end subroutine coupler_type_set_diags + +!> Write out all diagnostics of elements of a coupler_2d_bc_type +subroutine coupler_type_send_data(var, Time) + type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write + type(time_type), intent(in) :: time !< The current model time + + call CT_send_data(var, Time) +end subroutine coupler_type_send_data + +!> Write out checksums for the elements of a coupler_2d_bc_type +subroutine coupler_type_write_chksums(var, outunit, name_lead) + type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics + integer, intent(in) :: outunit !< The index of a open output file + character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names + + call CT_write_chksums(var, outunit, name_lead) + +end subroutine coupler_type_write_chksums + +!> Indicate whether a coupler_1d_bc_type has been initialized. +logical function CT_initialized_1d(var) + type(coupler_1d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed + + CT_initialized_1d = CT_initialized(var) +end function CT_initialized_1d + +!> Indicate whether a coupler_2d_bc_type has been initialized. +logical function CT_initialized_2d(var) + type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed + + CT_initialized_2d = CT_initialized(var) +end function CT_initialized_2d + +!> Deallocate all data associated with a coupler_1d_bc_type +subroutine CT_destructor_1d(var) + type(coupler_1d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed + + call CT_destructor(var) + +end subroutine CT_destructor_1d + +!> Deallocate all data associated with a coupler_2d_bc_type +subroutine CT_destructor_2d(var) + type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed + + call CT_destructor(var) + +end subroutine CT_destructor_2d + +end module MOM_coupler_types diff --git a/src/framework/MOM_couplertype_infra.F90 b/src/framework/MOM_couplertype_infra.F90 new file mode 100644 index 0000000000..fd947691ca --- /dev/null +++ b/src/framework/MOM_couplertype_infra.F90 @@ -0,0 +1,247 @@ +!> This module wraps the FMS coupler types module +module MOM_couplertype_infra + +! This file is part of MOM6. See LICENSE.md for the license. + +use coupler_types_mod, only : coupler_type_spawn, coupler_type_initialized, coupler_type_destructor +use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data +use coupler_types_mod, only : coupler_type_write_chksums +use coupler_types_mod, only : coupler_type_copy_data, coupler_type_increment_data +use coupler_types_mod, only : coupler_type_extract_data, coupler_type_set_data +use coupler_types_mod, only : ind_flux, ind_alpha, ind_csurf +use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type +use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux +use MOM_time_manager, only : time_type + +implicit none ; private + +public :: CT_spawn, CT_initialized, CT_destructor +public :: CT_set_diags, CT_send_data, CT_write_chksums +public :: CT_set_data, CT_increment_data +public :: CT_copy_data, CT_extract_data +public :: atmos_ocn_coupler_flux +public :: ind_flux, ind_alpha, ind_csurf +public :: coupler_1d_bc_type, coupler_2d_bc_type + +!> This is the interface to spawn one coupler_bc_type into another. +interface CT_spawn + module procedure CT_spawn_1d_2d, CT_spawn_2d_2d +end interface CT_spawn + +!> This function interface indicates whether a coupler_bc_type has been initialized. +interface CT_initialized + module procedure CT_initialized_1d, CT_initialized_2d +end interface CT_initialized + +!> This is the interface to deallocate any data associated with a coupler_bc_type. +interface CT_destructor + module procedure CT_destructor_1d, CT_destructor_2d +end interface CT_destructor + +contains + +!> This subroutine sets many of the parameters for calculating an atmosphere-ocean tracer flux +!! and retuns an integer index for that flux. +function atmos_ocn_coupler_flux(name, flux_type, implementation, param, mol_wt, & + ice_restart_file, ocean_restart_file, units, caller, verbosity) & + result (coupler_index) + + character(len=*), intent(in) :: name !< A name to use for the flux + character(len=*), intent(in) :: flux_type !< A string describing the type of this flux, + !! perhaps 'air_sea_gas_flux'. + character(len=*), intent(in) :: implementation !< A name describing the specific + !! implementation of this flux, such as 'ocmip2'. + real, dimension(:), optional, intent(in) :: param !< An array of parameters used for the fluxes + real, optional, intent(in) :: mol_wt !< The molecular weight of this tracer + character(len=*), optional, intent(in) :: ice_restart_file !< A sea-ice restart file to use with this flux. + character(len=*), optional, intent(in) :: ocean_restart_file !< An ocean restart file to use with this flux. + character(len=*), optional, intent(in) :: units !< The units of the flux + character(len=*), optional, intent(in) :: caller !< The name of the calling routine + integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity. + integer :: coupler_index !< The resulting integer handle to use for this flux in subsequent calls. + + coupler_index = aof_set_coupler_flux(name, flux_type, implementation, & + param=param, mol_wt=mol_wt, ice_restart_file=ice_restart_file, & + ocean_restart_file=ocean_restart_file, & + units=units, caller=caller, verbosity=verbosity) + +end function atmos_ocn_coupler_flux + +!> Generate a 2-D coupler type using a 1-D coupler type as a template. +subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed) + type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information + integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of + !! the first dimension in a non-decreasing list + integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of + !! the second dimension in a non-decreasing list + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique + logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) + !! is not set and the parent type (var_in) is set. + + call coupler_type_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_1d_2d + +!> Generate one 2-D coupler type using another 2-D coupler type as a template. +subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed) + type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information + integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of + !! the first dimension in a non-decreasing list + integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of + !! the second dimension in a non-decreasing list + character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique + logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var) + !! is not set and the parent type (var_in) is set. + + call coupler_type_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_2d_2d + +!> Copy all elements of the data in of one coupler_2d_bc_type into another. Both must have the same array sizes. +subroutine CT_copy_data(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice) + type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(coupler_2d_bc_type), intent(inout) :: var !< The recipient BC_type structure + integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default + integer, optional, intent(in) :: bc_index !< The index of the boundary condition + !! that is being copied + integer, optional, intent(in) :: field_index !< The index of the field in the + !! boundary condition that is being copied + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes + !! to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes + !! to include from this copy. + logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose + !! value of pass_through ice matches this + + call coupler_type_copy_data(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice) +end subroutine CT_copy_data + +!> Increment data in all elements of one coupler_2d_bc_type with the data from another. Both +!! must have the same array sizes. +subroutine CT_increment_data(var_in, var, halo_size, scale_factor, scale_prev) + type(coupler_2d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type + type(coupler_2d_bc_type), intent(inout) :: var !< The coupler_type structure whose fields are being incremented + integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default + real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added + real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here + + call coupler_type_increment_data(var_in, var, halo_size=halo_size, scale_factor=scale_factor, & + scale_prev=scale_prev) + +end subroutine CT_increment_data + +!> Extract a 2d field from a coupler_2d_bc_type into a two-dimensional array. +subroutine CT_extract_data(var_in, bc_index, field_index, array_out, & + scale_factor, halo_size, idim, jdim) + type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract + integer, intent(in) :: bc_index !< The index of the boundary condition + !! that is being copied + integer, intent(in) :: field_index !< The index of the field in the boundary + !! condition that is being copied, or the + !! surface flux by default. + real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size + !! must match the size of the data being copied + !! unless idim and jdim are supplied. + real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added + integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default + integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of + !! the first dimension of the output array + !! in a non-decreasing list + integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of + !! the second dimension of the output array + !! in a non-decreasing list + call coupler_type_extract_data(var_in, bc_index, field_index, array_out, scale_factor, halo_size, idim, jdim) + +end subroutine CT_extract_data + +!> Set single 2d field in coupler_2d_bc_type from a two-dimensional array. +subroutine CT_set_data(array_in, bc_index, field_index, var, & + scale_factor, halo_size, idim, jdim) + real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size + !! must match the size of the data being copied + !! unless idim and jdim are supplied. + integer, intent(in) :: bc_index !< The index of the boundary condition + !! that is being copied + integer, intent(in) :: field_index !< The index of the field in the + !! boundary condition that is being set. The + !! surface concentration is set by default. + type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure with the data to set + real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added + integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default + integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of + !! the first dimension of the output array + !! in a non-decreasing list + integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of + !! the second dimension of the output array + !! in a non-decreasing list + + integer :: subfield ! An integer indicating which field to set. + + call coupler_type_set_data(array_in, bc_index, field_index, var, scale_factor, halo_size, idim, jdim) + +end subroutine CT_set_data + +!> Register the diagnostics of a coupler_2d_bc_type +subroutine CT_set_diags(var, diag_name, axes, time) + type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics + character(len=*), intent(in) :: diag_name !< name for diagnostic file, or blank not to register the fields + integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration + type(time_type), intent(in) :: time !< model time variable for registering diagnostic field + + call coupler_type_set_diags(var, diag_name, axes, time) + +end subroutine CT_set_diags + +!> Write out all diagnostics of elements of a coupler_2d_bc_type +subroutine CT_send_data(var, Time) + type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write + type(time_type), intent(in) :: time !< The current model time + + call coupler_type_send_data(var, Time) +end subroutine CT_send_data + +!> Write out checksums for the elements of a coupler_2d_bc_type +subroutine CT_write_chksums(var, outunit, name_lead) + type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics + integer, intent(in) :: outunit !< The index of a open output file + character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names + + call coupler_type_write_chksums(var, outunit, name_lead) + +end subroutine CT_write_chksums + +!> Indicate whether a coupler_1d_bc_type has been initialized. +logical function CT_initialized_1d(var) + type(coupler_1d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed + + CT_initialized_1d = coupler_type_initialized(var) +end function CT_initialized_1d + +!> Indicate whether a coupler_2d_bc_type has been initialized. +logical function CT_initialized_2d(var) + type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed + + CT_initialized_2d = coupler_type_initialized(var) +end function CT_initialized_2d + +!> Deallocate all data associated with a coupler_1d_bc_type +subroutine CT_destructor_1d(var) + type(coupler_1d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed + + call coupler_type_destructor(var) + +end subroutine CT_destructor_1d + +!> Deallocate all data associated with a coupler_2d_bc_type +subroutine CT_destructor_2d(var) + type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed + + call coupler_type_destructor(var) + +end subroutine CT_destructor_2d + +end module MOM_couplertype_infra From 9ad5dcbac30c0b04b0f02537250db2dcc34cca09 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 24 Jan 2021 08:14:41 -0500 Subject: [PATCH 3/6] Use new MOM_coupler_types interfaces with tracers Modified the various MOM6 tracer packages to use the MOM_coupler_types module along with new and simpler MOM_coupler_types interfaces. Also modified the module use statements in some of the core and diagnostics modules to access the coupler_types routines via MOM_coupler_types module. All answers are bitwise identical. --- src/core/MOM.F90 | 1 - src/core/MOM_forcing_type.F90 | 10 +++--- src/core/MOM_variables.F90 | 19 +++++----- src/diagnostics/MOM_diagnostics.F90 | 2 +- src/tracer/DOME_tracer.F90 | 13 +++---- src/tracer/ISOMIP_tracer.F90 | 13 +++---- src/tracer/MOM_OCMIP2_CFC.F90 | 48 ++++++++++++-------------- src/tracer/advection_test_tracer.F90 | 13 +++---- src/tracer/boundary_impulse_tracer.F90 | 13 +++---- src/tracer/dye_example.F90 | 13 +++---- src/tracer/dyed_obc_tracer.F90 | 8 ++--- src/tracer/ideal_age_example.F90 | 13 +++---- src/tracer/oil_tracer.F90 | 13 +++---- src/tracer/pseudo_salt_tracer.F90 | 3 -- src/tracer/tracer_example.F90 | 13 +++---- 15 files changed, 79 insertions(+), 116 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 23aa866b90..9127924cfb 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -47,7 +47,6 @@ module MOM use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) use MOM_time_manager, only : operator(>=), operator(==), increment_date use MOM_unit_tests, only : unit_tests -use coupler_types_mod, only : coupler_type_send_data, coupler_1d_bc_type, coupler_type_spawn ! MOM core modules use MOM_ALE, only : ALE_init, ALE_end, ALE_main, ALE_CS, adjustGridForIntegrity diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index dd6b92da2d..682ad03397 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -4,13 +4,15 @@ module MOM_forcing_type ! This file is part of MOM6. See LICENSE.md for the license. use MOM_array_transform, only : rotate_array, rotate_vector, rotate_array_pair -use MOM_debugging, only : hchksum, uvchksum +use MOM_coupler_types, only : coupler_2d_bc_type, coupler_type_destructor +use MOM_coupler_types, only : coupler_type_increment_data, coupler_type_initialized use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE +use MOM_debugging, only : hchksum, uvchksum use MOM_diag_mediator, only : post_data, register_diag_field, register_scalar_field use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_alloc, query_averaging_enabled use MOM_diag_mediator, only : enable_averages, enable_averaging, disable_averaging -use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_EOS, only : calculate_density_derivs, EOS_domain +use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_opacity, only : sumSWoverBands, optics_type, extract_optics_slice, optics_nbands @@ -19,10 +21,6 @@ module MOM_forcing_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_2d_bc_type, coupler_type_spawn -use coupler_types_mod, only : coupler_type_increment_data, coupler_type_initialized -use coupler_types_mod, only : coupler_type_copy_data, coupler_type_destructor - implicit none ; private #include diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 2cfce980dc..d81cf28e17 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -4,16 +4,14 @@ module MOM_variables ! This file is part of MOM6. See LICENSE.md for the license. use MOM_array_transform, only : rotate_array, rotate_vector -use MOM_domains, only : MOM_domain_type, get_domain_extent, group_pass_type -use MOM_debugging, only : hchksum +use MOM_coupler_types, only : coupler_1d_bc_type, coupler_2d_bc_type +use MOM_coupler_types, only : coupler_type_spawn, coupler_type_destructor, coupler_type_initialized +use MOM_debugging, only : hchksum +use MOM_domains, only : MOM_domain_type, get_domain_extent, group_pass_type +use MOM_EOS, only : EOS_type use MOM_error_handler, only : MOM_error, FATAL -use MOM_grid, only : ocean_grid_type -use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : EOS_type - -use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type -use coupler_types_mod, only : coupler_type_spawn, coupler_type_destructor -use coupler_types_mod, only : coupler_type_initialized +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -471,8 +469,7 @@ subroutine rotate_surface_state(sfc_state_in, G_in, sfc_state, G, turns) ! TODO: tracer field rotation if (coupler_type_initialized(sfc_state_in%tr_fields)) & - call MOM_error(FATAL, "Rotation of surface state tracers is not yet " & - // "implemented.") + call MOM_error(FATAL, "Rotation of surface state tracers is not yet implemented.") end subroutine rotate_surface_state !> Allocates the arrays contained within a BT_cont_type and initializes them to 0. diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 6a53ffb1fc..47d322dfa0 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -6,6 +6,7 @@ module MOM_diagnostics ! This file is part of MOM6. See LICENSE.md for the license. use MOM_coms, only : reproducing_sum +use MOM_coupler_types, only : coupler_type_send_data use MOM_density_integrals, only : int_density_dz use MOM_diag_mediator, only : post_data, get_diag_time_end use MOM_diag_mediator, only : register_diag_field, register_scalar_field @@ -30,7 +31,6 @@ module MOM_diagnostics use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, surface use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speed, wave_speed_CS, wave_speed_init -use coupler_types_mod, only : coupler_type_send_data implicit none ; private diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index b9e9196ffa..c20eda7745 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -3,6 +3,7 @@ module DOME_tracer ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -21,9 +22,6 @@ module DOME_tracer use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include @@ -48,7 +46,7 @@ module DOME_tracer real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. - integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + integer, dimension(NTR) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -130,7 +128,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! values to the coupler (if any). This is meta-code and its arguments will ! currently (deliberately) give fatal errors if it is used. if (CS%coupled_tracers) & - CS%ind_tr(m) = aof_set_coupler_flux(trim(name)//'_flux', & + CS%ind_tr(m) = atmos_ocn_coupler_flux(trim(name)//'_flux', & flux_type=' ', implementation=' ', caller="register_DOME_tracer") enddo @@ -359,9 +357,8 @@ subroutine DOME_tracer_surface_state(sfc_state, h, G, GV, CS) do m=1,NTR ! This call loads the surface values into the appropriate array in the ! coupler-type structure. - call coupler_type_set_data(CS%tr(:,:,1,m), CS%ind_tr(m), ind_csurf, & - sfc_state%tr_fields, idim=(/isd, is, ie, ied/), & - jdim=(/jsd, js, je, jed/) ) + call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) enddo endif diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index ce997d6af1..0e31282e9c 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -11,6 +11,7 @@ module ISOMIP_tracer ! Adapted to the ISOMIP test case by Gustavo Marques, May 2016 use MOM_coms, only : max_across_PEs +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -28,9 +29,6 @@ module ISOMIP_tracer use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include @@ -51,7 +49,7 @@ module ISOMIP_tracer real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. - integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux + integer, dimension(NTR) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux !< if it is used and the surface tracer concentrations are to be !< provided to the coupler. @@ -135,7 +133,7 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! values to the coupler (if any). This is meta-code and its arguments will ! currently (deliberately) give fatal errors if it is used. if (CS%coupled_tracers) & - CS%ind_tr(m) = aof_set_coupler_flux(trim(name)//'_flux', & + CS%ind_tr(m) = atmos_ocn_coupler_flux(trim(name)//'_flux', & flux_type=' ', implementation=' ', caller="register_ISOMIP_tracer") enddo @@ -345,9 +343,8 @@ subroutine ISOMIP_tracer_surface_state(sfc_state, h, G, GV, CS) do m=1,ntr ! This call loads the surface values into the appropriate array in the ! coupler-type structure. - call coupler_type_set_data(CS%tr(:,:,1,m), CS%ind_tr(m), ind_csurf, & - sfc_state%tr_fields, idim=(/isd, is, ie, ied/), & - jdim=(/jsd, js, je, jed/) ) + call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) enddo endif diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 3e007cbe7a..4e5813e42a 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -3,6 +3,8 @@ module MOM_OCMIP2_CFC ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coupler_types, only : extract_coupler_type_data, set_coupler_type_data +use MOM_coupler_types, only : atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -21,10 +23,6 @@ module MOM_OCMIP2_CFC use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : ind_flux, ind_alpha, ind_csurf -use coupler_types_mod, only : coupler_type_extract_data, coupler_type_set_data -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include @@ -71,9 +69,9 @@ module MOM_OCMIP2_CFC character(len=16) :: CFC11_name !< CFC11 variable name character(len=16) :: CFC12_name !< CFC12 variable name - integer :: ind_cfc_11_flux !< Index returned by aof_set_coupler_flux that is used to + integer :: ind_cfc_11_flux !< Index returned by atmos_ocn_coupler_flux that is used to !! pack and unpack surface boundary condition arrays. - integer :: ind_cfc_12_flux !< Index returned by aof_set_coupler_flux that is used to + integer :: ind_cfc_12_flux !< Index returned by atmos_ocn_coupler_flux that is used to !! pack and unpack surface boundary condition arrays. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate @@ -127,7 +125,7 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) ! indicies for the CFC11 and CFC12 flux coupling. call flux_init_OCMIP2_CFC(CS, verbosity=3) if ((CS%ind_cfc_11_flux < 0) .or. (CS%ind_cfc_12_flux < 0)) then - ! This is most likely to happen with the dummy version of aof_set_coupler_flux + ! This is most likely to happen with the dummy version of atmos_ocn_coupler_flux ! used in ocean-only runs. call MOM_ERROR(WARNING, "CFCs are currently only set up to be run in " // & " coupled model configurations, and will be disabled.") @@ -291,18 +289,18 @@ subroutine flux_init_OCMIP2_CFC(CS, verbosity) ! These calls obtain the indices for the CFC11 and CFC12 flux coupling. They ! can safely be called multiple times. - ind_flux(1) = aof_set_coupler_flux('cfc_11_flux', & - flux_type = 'air_sea_gas_flux', implementation = 'ocmip2', & - param = (/ 9.36e-07, 9.7561e-06 /), & + ind_flux(1) = atmos_ocn_coupler_flux('cfc_11_flux', & + flux_type = 'air_sea_gas_flux', implementation='ocmip2', & + param=(/ 9.36e-07, 9.7561e-06 /), & ice_restart_file = default_ice_restart_file, & ocean_restart_file = default_ocean_restart_file, & caller = "register_OCMIP2_CFC", verbosity=verbosity) - ind_flux(2) = aof_set_coupler_flux('cfc_12_flux', & - flux_type = 'air_sea_gas_flux', implementation = 'ocmip2', & + ind_flux(2) = atmos_ocn_coupler_flux('cfc_12_flux', & + flux_type='air_sea_gas_flux', implementation='ocmip2', & param = (/ 9.36e-07, 9.7561e-06 /), & - ice_restart_file = default_ice_restart_file, & - ocean_restart_file = default_ocean_restart_file, & - caller = "register_OCMIP2_CFC", verbosity=verbosity) + ice_restart_file=default_ice_restart_file, & + ocean_restart_file=default_ocean_restart_file, & + caller="register_OCMIP2_CFC", verbosity=verbosity) if (present(CS)) then ; if (associated(CS)) then CS%ind_cfc_11_flux = ind_flux(1) @@ -459,9 +457,9 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! These two calls unpack the fluxes from the input arrays. ! The -GV%Rho0 changes the sign convention of the flux and changes the units ! of the flux from [Conc. m s-1] to [Conc. kg m-2 T-1]. - call coupler_type_extract_data(fluxes%tr_fluxes, CS%ind_cfc_11_flux, ind_flux, CFC11_flux, & + call extract_coupler_type_data(fluxes%tr_fluxes, CS%ind_cfc_11_flux, CFC11_flux, & scale_factor=-G%US%R_to_kg_m3*GV%Rho0*US%T_to_s, idim=idim, jdim=jdim) - call coupler_type_extract_data(fluxes%tr_fluxes, CS%ind_cfc_12_flux, ind_flux, CFC12_flux, & + call extract_coupler_type_data(fluxes%tr_fluxes, CS%ind_cfc_12_flux, CFC12_flux, & scale_factor=-G%US%R_to_kg_m3*GV%Rho0*US%T_to_s, idim=idim, jdim=jdim) ! Use a tridiagonal solver to determine the concentrations after the @@ -602,14 +600,14 @@ subroutine OCMIP2_CFC_surface_state(sfc_state, h, G, GV, CS) ! These calls load these values into the appropriate arrays in the ! coupler-type structure. - call coupler_type_set_data(CFC11_alpha, CS%ind_cfc_11_flux, ind_alpha, & - sfc_state%tr_fields, idim=idim, jdim=jdim) - call coupler_type_set_data(CFC11_Csurf, CS%ind_cfc_11_flux, ind_csurf, & - sfc_state%tr_fields, idim=idim, jdim=jdim) - call coupler_type_set_data(CFC12_alpha, CS%ind_cfc_12_flux, ind_alpha, & - sfc_state%tr_fields, idim=idim, jdim=jdim) - call coupler_type_set_data(CFC12_Csurf, CS%ind_cfc_12_flux, ind_csurf, & - sfc_state%tr_fields, idim=idim, jdim=jdim) + call set_coupler_type_data(CFC11_alpha, CS%ind_cfc_11_flux, sfc_state%tr_fields, & + solubility=.true., idim=idim, jdim=jdim) + call set_coupler_type_data(CFC11_Csurf, CS%ind_cfc_11_flux, sfc_state%tr_fields, & + idim=idim, jdim=jdim) + call set_coupler_type_data(CFC12_alpha, CS%ind_cfc_12_flux, sfc_state%tr_fields, & + solubility=.true., idim=idim, jdim=jdim) + call set_coupler_type_data(CFC12_Csurf, CS%ind_cfc_12_flux, sfc_state%tr_fields, & + idim=idim, jdim=jdim) end subroutine OCMIP2_CFC_surface_state diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index b4dd93e49e..a051fe3da9 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -3,6 +3,7 @@ module advection_test_tracer ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -20,9 +21,6 @@ module advection_test_tracer use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include @@ -51,7 +49,7 @@ module advection_test_tracer real :: y_origin !< Parameters describing the test functions real :: y_width !< Parameters describing the test functions - integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and + integer, dimension(NTR) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and !! the surface tracer concentrations are to be provided to the coupler. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -153,7 +151,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ ! values to the coupler (if any). This is meta-code and its arguments will ! currently (deliberately) give fatal errors if it is used. if (CS%coupled_tracers) & - CS%ind_tr(m) = aof_set_coupler_flux(trim(name)//'_flux', & + CS%ind_tr(m) = atmos_ocn_coupler_flux(trim(name)//'_flux', & flux_type=' ', implementation=' ', caller="register_advection_test_tracer") enddo @@ -337,9 +335,8 @@ subroutine advection_test_tracer_surface_state(sfc_state, h, G, GV, CS) do m=1,CS%ntr ! This call loads the surface values into the appropriate array in the ! coupler-type structure. - call coupler_type_set_data(CS%tr(:,:,1,m), CS%ind_tr(m), ind_csurf, & - sfc_state%tr_fields, idim=(/isd, is, ie, ied/), & - jdim=(/jsd, js, je, jed/) ) + call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) enddo endif diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index be7aa2b37e..55f061da20 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -3,6 +3,7 @@ module boundary_impulse_tracer ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -21,9 +22,6 @@ module boundary_impulse_tracer use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include @@ -43,7 +41,7 @@ module boundary_impulse_tracer type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? logical :: tracers_may_reinit !< If true, boundary_impulse can be initialized if not found in restart file - integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. integer :: nkml !< Number of layers in mixed layer @@ -131,7 +129,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar ! values to the coupler (if any). This is meta-code and its arguments will ! currently (deliberately) give fatal errors if it is used. if (CS%coupled_tracers) & - CS%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//'_flux', & + CS%ind_tr(m) = atmos_ocn_coupler_flux(trim(var_name)//'_flux', & flux_type=' ', implementation=' ', caller="register_boundary_impulse_tracer") enddo ! Register remaining source time as a restart field @@ -356,9 +354,8 @@ subroutine boundary_impulse_tracer_surface_state(sfc_state, h, G, GV, CS) do m=1,CS%ntr ! This call loads the surface values into the appropriate array in the ! coupler-type structure. - call coupler_type_set_data(CS%tr(:,:,1,m), CS%ind_tr(m), ind_csurf, & - sfc_state%tr_fields, idim=(/isd, is, ie, ied/), & - jdim=(/jsd, js, je, jed/) ) + call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) enddo endif diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 48baddaab9..ccb1a3635b 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -3,6 +3,7 @@ module regional_dyes ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -21,9 +22,6 @@ module regional_dyes use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include @@ -50,7 +48,7 @@ module regional_dyes type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? - integer, allocatable, dimension(:) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + integer, allocatable, dimension(:) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -172,7 +170,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) ! values to the coupler (if any). This is meta-code and its arguments will ! currently (deliberately) give fatal errors if it is used. if (CS%coupled_tracers) & - CS%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//'_flux', & + CS%ind_tr(m) = atmos_ocn_coupler_flux(trim(var_name)//'_flux', & flux_type=' ', implementation=' ', caller="register_dye_tracer") enddo @@ -395,9 +393,8 @@ subroutine dye_tracer_surface_state(sfc_state, h, G, GV, CS) do m=1,CS%ntr ! This call loads the surface values into the appropriate array in the ! coupler-type structure. - call coupler_type_set_data(CS%tr(:,:,1,m), CS%ind_tr(m), ind_csurf, & - sfc_state%tr_fields, idim=(/isd, is, ie, ied/), & - jdim=(/jsd, js, je, jed/) ) + call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) enddo endif diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index c54396eee6..eb49d0beef 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -3,6 +3,7 @@ module dyed_obc_tracer ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coupler_types, only : atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -19,9 +20,6 @@ module dyed_obc_tracer use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include @@ -38,7 +36,7 @@ module dyed_obc_tracer type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? - integer, allocatable, dimension(:) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + integer, allocatable, dimension(:) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -122,7 +120,7 @@ function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! values to the coupler (if any). This is meta-code and its arguments will ! currently (deliberately) give fatal errors if it is used. if (CS%coupled_tracers) & - CS%ind_tr(m) = aof_set_coupler_flux(trim(name)//'_flux', & + CS%ind_tr(m) = atmos_ocn_coupler_flux(trim(name)//'_flux', & flux_type=' ', implementation=' ', caller="register_dyed_obc_tracer") enddo diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 6689cc5149..31d13c811e 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -3,6 +3,7 @@ module ideal_age_example ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -21,9 +22,6 @@ module ideal_age_example use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include @@ -56,7 +54,7 @@ module ideal_age_example !! they are not found in the restart files. logical :: tracer_ages(NTR_MAX) !< Indicates whether each tracer ages. - integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -183,7 +181,7 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! values to the coupler (if any). This is meta-code and its arguments will ! currently (deliberately) give fatal errors if it is used. if (CS%coupled_tracers) & - CS%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//'_flux', & + CS%ind_tr(m) = atmos_ocn_coupler_flux(trim(var_name)//'_flux', & flux_type=' ', implementation=' ', caller="register_ideal_age_tracer") enddo @@ -443,9 +441,8 @@ subroutine ideal_age_tracer_surface_state(sfc_state, h, G, GV, CS) do m=1,CS%ntr ! This call loads the surface values into the appropriate array in the ! coupler-type structure. - call coupler_type_set_data(CS%tr(:,:,1,m), CS%ind_tr(m), ind_csurf, & - sfc_state%tr_fields, idim=(/isd, is, ie, ied/), & - jdim=(/jsd, js, je, jed/) ) + call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) enddo endif diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index ae2c71a87c..e73562dc1d 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -3,6 +3,7 @@ module oil_tracer ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -21,9 +22,6 @@ module oil_tracer use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include @@ -62,7 +60,7 @@ module oil_tracer integer, dimension(NTR_MAX) :: oil_source_k !< Layer of source logical :: oil_may_reinit !< If true, oil tracers may be reset by the initialization code !! if they are not found in the restart files. - integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + integer, dimension(NTR_MAX) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. type(vardesc) :: tr_desc(NTR_MAX) !< Descriptions and metadata for the tracers @@ -190,7 +188,7 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) ! values to the coupler (if any). This is meta-code and its arguments will ! currently (deliberately) give fatal errors if it is used. if (CS%coupled_tracers) & - CS%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//'_flux', & + CS%ind_tr(m) = atmos_ocn_coupler_flux(trim(var_name)//'_flux', & flux_type=' ', implementation=' ', caller="register_oil_tracer") enddo @@ -477,9 +475,8 @@ subroutine oil_tracer_surface_state(sfc_state, h, G, GV, CS) do m=1,CS%ntr ! This call loads the surface values into the appropriate array in the ! coupler-type structure. - call coupler_type_set_data(CS%tr(:,:,1,m), CS%ind_tr(m), ind_csurf, & - sfc_state%tr_fields, idim=(/isd, is, ie, ied/), & - jdim=(/jsd, js, je, jed/) ) + call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) enddo endif diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index df795d3119..9cb94a3054 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -23,9 +23,6 @@ module pseudo_salt_tracer use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index afb341ac16..395eec50c5 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -3,6 +3,7 @@ module USER_tracer_example ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -19,9 +20,6 @@ module USER_tracer_example use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type -use coupler_types_mod, only : coupler_type_set_data, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - implicit none ; private #include @@ -42,7 +40,7 @@ module USER_tracer_example real :: land_val(NTR) = -1.0 !< The value of tr that is used where land is masked out. logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. - integer, dimension(NTR) :: ind_tr !< Indices returned by aof_set_coupler_flux if it is used and the + integer, dimension(NTR) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the timing of diagnostic output. @@ -126,7 +124,7 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS ! values to the coupler (if any). This is meta-code and its arguments will ! currently (deliberately) give fatal errors if it is used. if (CS%coupled_tracers) & - CS%ind_tr(m) = aof_set_coupler_flux(trim(name)//'_flux', & + CS%ind_tr(m) = atmos_ocn_coupler_flux(trim(name)//'_flux', & flux_type=' ', implementation=' ', caller="USER_register_tracer_example") enddo @@ -428,9 +426,8 @@ subroutine USER_tracer_surface_state(sfc_state, h, G, GV, CS) do m=1,ntr ! This call loads the surface values into the appropriate array in the ! coupler-type structure. - call coupler_type_set_data(CS%tr(:,:,1,m), CS%ind_tr(m), ind_csurf, & - sfc_state%tr_fields, idim=(/isd, is, ie, ied/), & - jdim=(/jsd, js, je, jed/) ) + call set_coupler_type_data(CS%tr(:,:,1,m), CS%ind_tr(m), sfc_state%tr_fields, & + idim=(/isd, is, ie, ied/), jdim=(/jsd, js, je, jed/) ) enddo endif From 73304ebf89ee15ce27e2b04debd77ba66232b047 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 24 Jan 2021 08:18:15 -0500 Subject: [PATCH 4/6] Eliminated mpp calls from coupled_driver Channel all infrastructure calls from coupled_driver via the MOM6 framework code. This includes changing the type of one of the arguments and eliminating another argument to initialize_ocean_public_type to pass a MOM_domain_type, and using clone_MOM_domain to create the domain2D element of the Ocean_sfc type. All answers are bitwise identical. --- .../MOM_surface_forcing_gfdl.F90 | 14 ++-- config_src/coupled_driver/ocean_model_MOM.F90 | 79 +++++++------------ 2 files changed, 33 insertions(+), 60 deletions(-) diff --git a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 index 4d2d9dec9b..dd84f1692c 100644 --- a/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 @@ -7,6 +7,9 @@ module MOM_surface_forcing_gfdl !#CTRL# use MOM_controlled_forcing, only : ctrl_forcing_CS use MOM_coms, only : reproducing_sum, field_chksum use MOM_constants, only : hlv, hlf +use MOM_coupler_types, only : coupler_2d_bc_type, coupler_type_write_chksums +use MOM_coupler_types, only : coupler_type_initialized, coupler_type_spawn +use MOM_coupler_types, only : coupler_type_copy_data use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_SUBCOMPONENT use MOM_diag_mediator, only : diag_ctrl, safe_alloc_ptr, time_type @@ -23,7 +26,7 @@ module MOM_surface_forcing_gfdl use MOM_grid, only : ocean_grid_type use MOM_interpolate, only : init_external_field, time_interp_external use MOM_interpolate, only : time_interp_external_init -use MOM_io, only : slasher, write_version_number, MOM_read_data +use MOM_io, only : slasher, write_version_number, MOM_read_data, stdout use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS use MOM_restart, only : restart_init_end, save_restart, restore_state use MOM_string_functions, only : uppercase @@ -33,11 +36,7 @@ module MOM_surface_forcing_gfdl use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init use user_revise_forcing, only : user_revise_forcing_CS -use coupler_types_mod, only : coupler_2d_bc_type, coupler_type_write_chksums -use coupler_types_mod, only : coupler_type_initialized, coupler_type_spawn -use coupler_types_mod, only : coupler_type_copy_data use data_override_mod, only : data_override_init, data_override -use fms_mod, only : stdout implicit none ; private @@ -318,8 +317,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if ((.not.coupler_type_initialized(fluxes%tr_fluxes)) .and. & coupler_type_initialized(IOB%fluxes)) & - call coupler_type_spawn(IOB%fluxes, fluxes%tr_fluxes, & - (/is,is,ie,ie/), (/js,js,je,je/)) + call coupler_type_spawn(IOB%fluxes, fluxes%tr_fluxes, (/is,is,ie,ie/), (/js,js,je,je/)) ! It might prove valuable to use the same array extents as the rest of the ! ocean model, rather than using haloless arrays, in which case the last line ! would be: ( (/isd,is,ie,ied/), (/jsd,js,je,jed/)) @@ -1628,7 +1626,7 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) !! ocean in a coupled model whose checksums are reported integer :: n,m, outunit - outunit = stdout() + outunit = stdout write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep write(outunit,100) 'iobt%u_flux ', field_chksum( iobt%u_flux ) diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 12f803a970..edb06dc9ba 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -17,10 +17,14 @@ module ocean_model_mod use MOM, only : get_ocean_stocks, step_offline use MOM_coms, only : field_chksum use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf +use MOM_coupler_types, only : coupler_1d_bc_type, coupler_2d_bc_type +use MOM_coupler_types, only : coupler_type_spawn, coupler_type_write_chksums +use MOM_coupler_types, only : coupler_type_initialized, coupler_type_copy_data +use MOM_coupler_types, only : coupler_type_set_diags, coupler_type_send_data use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end -use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE -use MOM_domains, only : TO_ALL, Omit_Corners +use MOM_domains, only : MOM_domain_type, domain2d, clone_MOM_domain, get_domain_extent +use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE, TO_ALL, Omit_Corners use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct @@ -31,7 +35,7 @@ module ocean_model_mod use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags use MOM_get_input, only : Get_MOM_Input, directories use MOM_grid, only : ocean_grid_type -use MOM_io, only : close_file, file_exists, read_data, write_version_number +use MOM_io, only : close_file, file_exists, read_data, write_version_number, stdout use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase @@ -52,14 +56,6 @@ module ocean_model_mod use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves -use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type -use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums -use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data -use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain -use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux -use fms_mod, only : stdout #include @@ -107,7 +103,7 @@ module ocean_model_mod !! points of the two velocity components. Valid entries !! include AGRID, BGRID_NE, CGRID_NE, BGRID_SW, and CGRID_SW, !! corresponding to the community-standard Arakawa notation. - !! (These are named integers taken from mpp_parameter_mod.) + !! (These are named integers taken from the MOM_domains module.) !! Following MOM5, stagger is BGRID_NE by default when the !! ocean is initialized, but here it is set to -999 so that !! a global max across ocean and non-ocean processors can be @@ -391,14 +387,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas call MOM_wave_interface_init_lite(param_file) endif - if (associated(OS%grid%Domain%maskmap)) then - call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & - OS%diag, maskmap=OS%grid%Domain%maskmap, & - gas_fields_ocn=gas_fields_ocn) - else - call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & - OS%diag, gas_fields_ocn=gas_fields_ocn) - endif + call initialize_ocean_public_type(OS%grid%Domain, Ocean_sfc, OS%diag, & + gas_fields_ocn=gas_fields_ocn) ! This call can only occur here if the coupler_bc_type variables have been ! initialized already using the information from gas_fields_ocn. @@ -513,8 +503,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.) ! Translate Ice_ocean_boundary into fluxes and forces. - call mpp_get_compute_domain(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), & - index_bnds(3), index_bnds(4)) + call get_domain_extent(Ocean_sfc%Domain, index_bnds(1), index_bnds(2), index_bnds(3), index_bnds(4)) if (do_dyn) then call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, OS%US, & @@ -733,7 +722,7 @@ end subroutine ocean_model_end subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the !! internal ocean state (in). - type(time_type), intent(in) :: Time !< The model time at this call, needed for mpp_write calls. + type(time_type), intent(in) :: Time !< The model time at this call, needed for writing files. character(len=*), optional, intent(in) :: directory !< An optional directory into which to !! write these restart files. character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time-stamp) @@ -765,16 +754,12 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) end subroutine ocean_model_save_restart !> Initialize the public ocean type -subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, & - gas_fields_ocn) - type(domain2D), intent(in) :: input_domain !< The ocean model domain description +subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, gas_fields_ocn) + type(MOM_domain_type), intent(in) :: input_domain !< The ocean model domain description type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly - !! visible ocean surface properties after initialization, whose - !! elements are allocated here. - type(diag_ctrl), intent(in) :: diag !< A structure that regulates diagnsotic output - logical, dimension(:,:), & - optional, intent(in) :: maskmap !< A mask indicating which virtual processors - !! are actually in use. If missing, all are used. + !! visible ocean surface properties after + !! initialization, whose elements are allocated here. + type(diag_ctrl), intent(in) :: diag !< A structure that regulates diagnostic output type(coupler_1d_bc_type), & optional, intent(in) :: gas_fields_ocn !< If present, this type describes the !! ocean and surface-ice fields that will participate @@ -786,14 +771,9 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, ! and have no halos. integer :: isc, iec, jsc, jec - call mpp_get_layout(input_domain,layout) - call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz) - if (PRESENT(maskmap)) then - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain, maskmap=maskmap) - else - call mpp_define_domains((/1,xsz,1,ysz/),layout,Ocean_sfc%Domain) - endif - call mpp_get_compute_domain(Ocean_sfc%Domain, isc, iec, jsc, jec) + call clone_MOM_domain(input_domain, Ocean_sfc%Domain, halo_size=0, symmetric=.false.) + + call get_domain_extent(Ocean_sfc%Domain, isc, iec, jsc, jec) allocate ( Ocean_sfc%t_surf (isc:iec,jsc:jec), & Ocean_sfc%s_surf (isc:iec,jsc:jec), & @@ -849,8 +829,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec call pass_vector(sfc_state%u, sfc_state%v, G%Domain) - call mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & - jsc_bnd, jec_bnd) + call get_domain_extent(Ocean_sfc%Domain, isc_bnd, iec_bnd, jsc_bnd, jec_bnd) if (present(patm)) then ! Check that the inidicies in patm are (isc_bnd:iec_bnd,jsc_bnd:jec_bnd). if (.not.present(press_to_z)) call MOM_error(FATAL, & @@ -1044,20 +1023,17 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) integer , intent(in) :: isc !< The starting i-index of array2D integer , intent(in) :: jsc !< The starting j-index of array2D - integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j + integer :: g_isc, g_iec, g_jsc, g_jec, g_isd, g_ied, g_jsd, g_jed, i, j if (.not.associated(OS)) return if (.not.OS%is_ocean_pe) return -! The problem is %areaT is on MOM domain but Ice_Ocean_Boundary%... is on mpp domain. -! We want to return the MOM data on the mpp (compute) domain -! Get MOM domain extents - call mpp_get_compute_domain(OS%grid%Domain%mpp_domain, g_isc, g_iec, g_jsc, g_jec) - call mpp_get_data_domain (OS%grid%Domain%mpp_domain, g_isd, g_ied, g_jsd, g_jed) + ! The problem is that %areaT is on MOM domain but Ice_Ocean_Boundary%... is on a haloless domain. + ! We want to return the MOM data on the haloless (compute) domain + call get_domain_extent(OS%grid%Domain, g_isc, g_iec, g_jsc, g_jec, g_isd, g_ied, g_jsd, g_jed) g_isc = g_isc-g_isd+1 ; g_iec = g_iec-g_isd+1 ; g_jsc = g_jsc-g_jsd+1 ; g_jec = g_jec-g_jsd+1 - select case(name) case('area') array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) @@ -1127,7 +1103,7 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) !! visible ocean surface fields. integer :: n, m, outunit - outunit = stdout() + outunit = stdout write(outunit,*) "BEGIN CHECKSUM(ocean_type):: ", id, timestep write(outunit,100) 'ocean%t_surf ', field_chksum(ocn%t_surf ) @@ -1180,8 +1156,7 @@ subroutine ocean_model_get_UV_surf(OS, Ocean, name, array2D, isc, jsc) G => OS%grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - call mpp_get_compute_domain(Ocean%Domain, isc_bnd, iec_bnd, & - jsc_bnd, jec_bnd) + call get_domain_extent(Ocean%Domain, isc_bnd, iec_bnd, jsc_bnd, jec_bnd) i0 = is - isc_bnd ; j0 = js - jsc_bnd From a54f47a6f3683c9d4c6332fa0be7a697dd3d5da5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 24 Jan 2021 13:13:14 -0500 Subject: [PATCH 5/6] +Eliminated fms calls from solo_driver Channel all infrastructure calls from solo_driver via the MOM6 framework code. This includes adding 2 more interfaces to MOM_ensemble_manager and making the affinity routines to those that are publicly accessible from MOM_domains. Several spelling errors in comments were also corrected. All answers are bitwise identical, but some subroutines are accessible from new modules. --- config_src/solo_driver/MOM_driver.F90 | 39 +++++++++----------------- src/framework/MOM_domain_infra.F90 | 19 +++++++------ src/framework/MOM_domains.F90 | 5 ++-- src/framework/MOM_ensemble_manager.F90 | 6 +++- 4 files changed, 33 insertions(+), 36 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index c9383a4287..584282f27f 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -33,15 +33,20 @@ program MOM_main use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized use MOM, only : step_offline use MOM_coms, only : Set_PElist - use MOM_domains, only : MOM_infra_init, MOM_infra_end + use MOM_domains, only : MOM_infra_init, MOM_infra_end, set_MOM_thread_affinity + use MOM_ensemble_manager, only : ensemble_manager_init, get_ensemble_size + use MOM_ensemble_manager, only : ensemble_pelist_setup use MOM_error_handler, only : MOM_error, MOM_mesg, WARNING, FATAL, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type use MOM_file_parser, only : close_param_file use MOM_forcing_type, only : forcing, mech_forcing, forcing_diagnostics use MOM_forcing_type, only : mech_forcing_diags, MOM_forcing_chksum, MOM_mech_forcing_chksum - use MOM_get_input, only : directories + use MOM_get_input, only : get_MOM_input, directories use MOM_grid, only : ocean_grid_type + use MOM_ice_shelf, only : initialize_ice_shelf, ice_shelf_end, ice_shelf_CS + use MOM_ice_shelf, only : shelf_calc_flux, add_shelf_forces, ice_shelf_save_restart + use MOM_ice_shelf, only : initialize_ice_shelf_fluxes, initialize_ice_shelf_forces use MOM_interpolate, only : time_interp_external_init use MOM_io, only : file_exists, open_file, close_file use MOM_io, only : check_nml_error, io_infra_init, io_infra_end @@ -50,30 +55,19 @@ program MOM_main use MOM_string_functions,only : uppercase use MOM_surface_forcing, only : set_forcing, forcing_save_restart use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS - use MOM_time_manager, only : time_type, set_date, get_date - use MOM_time_manager, only : real_to_time, time_type_to_real + use MOM_time_manager, only : time_type, set_date, get_date, real_to_time, time_type_to_real use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(>), operator(<), operator(>=) use MOM_time_manager, only : increment_date, set_calendar_type, month_name - use MOM_time_manager, only : JULIAN, GREGORIAN, NOLEAP, THIRTY_DAY_MONTHS - use MOM_time_manager, only : NO_CALENDAR + use MOM_time_manager, only : JULIAN, GREGORIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR use MOM_tracer_flow_control, only : tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type + use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init + use MOM_wave_interface, only : MOM_wave_interface_init_lite, Update_Surface_Waves use MOM_write_cputime, only : write_cputime, MOM_write_cputime_init use MOM_write_cputime, only : write_cputime_start_clock, write_cputime_CS - use MOM_get_input, only : get_MOM_input - use ensemble_manager_mod, only : ensemble_manager_init, get_ensemble_size - use ensemble_manager_mod, only : ensemble_pelist_setup - use fms_affinity_mod, only : fms_affinity_init, fms_affinity_set,fms_affinity_get - - use MOM_ice_shelf, only : initialize_ice_shelf, ice_shelf_end, ice_shelf_CS - use MOM_ice_shelf, only : shelf_calc_flux, add_shelf_forces, ice_shelf_save_restart - use MOM_ice_shelf, only : initialize_ice_shelf_fluxes, initialize_ice_shelf_forces - - use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init - use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves implicit none @@ -253,13 +247,8 @@ program MOM_main endif endif -!$ call fms_affinity_init -!$ call fms_affinity_set('OCEAN', use_hyper_thread, ocean_nthreads) -!$ call omp_set_num_threads(ocean_nthreads) -!$OMP PARALLEL -!$ write(6,*) "ocean_solo OMPthreading ", fms_affinity_get(), omp_get_thread_num(), omp_get_num_threads() -!$ flush(6) -!$OMP END PARALLEL + ! This call sets the number and affinity of threads with openMP. + !$ call set_MOM_thread_affinity(ocean_nthreads, use_hyper_thread) ! Read ocean_solo restart, which can override settings from the namelist. if (file_exists(trim(dirs%restart_input_dir)//'ocean_solo.res')) then @@ -337,7 +326,7 @@ program MOM_main call callTree_waypoint("done surface_forcing_init") - call get_param(param_file,mod_name,"USE_WAVES",Use_Waves,& + call get_param(param_file,mod_name, "USE_WAVES", Use_Waves, & "If true, enables surface wave modules.",default=.false.) if (use_waves) then call MOM_wave_interface_init(Time, grid, GV, US, param_file, Waves_CSp, diag) diff --git a/src/framework/MOM_domain_infra.F90 b/src/framework/MOM_domain_infra.F90 index 5ced2e33c0..1f0594ef0d 100644 --- a/src/framework/MOM_domain_infra.F90 +++ b/src/framework/MOM_domain_infra.F90 @@ -498,7 +498,7 @@ subroutine pass_var_complete_3d(id_update, array, MOM_dom, sideflag, position, h end subroutine pass_var_complete_3d !> pass_vector_2d does a halo update for a pair of two-dimensional arrays -!! representing the compontents of a two-dimensional horizontal vector. +!! representing the components of a two-dimensional horizontal vector. subroutine pass_vector_2d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete, halo, & clock) real, dimension(:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector @@ -557,7 +557,7 @@ end subroutine pass_vector_2d !> fill_vector_symmetric_edges_2d does an usual set of halo updates that only !! fill in the values at the edge of a pair of symmetric memory two-dimensional -!! arrays representing the compontents of a two-dimensional horizontal vector. +!! arrays representing the components of a two-dimensional horizontal vector. !! If symmetric memory is not being used, this subroutine does nothing except to !! possibly turn optional cpu clocks on or off. subroutine fill_vector_symmetric_edges_2d(u_cmpt, v_cmpt, MOM_dom, stagger, scalar, & @@ -644,7 +644,7 @@ subroutine fill_vector_symmetric_edges_2d(u_cmpt, v_cmpt, MOM_dom, stagger, scal end subroutine fill_vector_symmetric_edges_2d !> pass_vector_3d does a halo update for a pair of three-dimensional arrays -!! representing the compontents of a three-dimensional horizontal vector. +!! representing the components of a three-dimensional horizontal vector. subroutine pass_vector_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete, halo, & clock) real, dimension(:,:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector @@ -702,7 +702,7 @@ subroutine pass_vector_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete, end subroutine pass_vector_3d !> pass_vector_start_2d starts a halo update for a pair of two-dimensional arrays -!! representing the compontents of a two-dimensional horizontal vector. +!! representing the components of a two-dimensional horizontal vector. function pass_vector_start_2d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete, halo, & clock) real, dimension(:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector @@ -759,7 +759,7 @@ function pass_vector_start_2d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, compl end function pass_vector_start_2d !> pass_vector_start_3d starts a halo update for a pair of three-dimensional arrays -!! representing the compontents of a three-dimensional horizontal vector. +!! representing the components of a three-dimensional horizontal vector. function pass_vector_start_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, complete, halo, & clock) real, dimension(:,:,:), intent(inout) :: u_cmpt !< The nominal zonal (u) component of the vector @@ -815,7 +815,7 @@ function pass_vector_start_3d(u_cmpt, v_cmpt, MOM_dom, direction, stagger, compl end function pass_vector_start_3d !> pass_vector_complete_2d completes a halo update for a pair of two-dimensional arrays -!! representing the compontents of a two-dimensional horizontal vector. +!! representing the components of a two-dimensional horizontal vector. subroutine pass_vector_complete_2d(id_update, u_cmpt, v_cmpt, MOM_dom, direction, stagger, halo, & clock) integer, intent(in) :: id_update !< The integer id of this update which has been @@ -869,7 +869,7 @@ subroutine pass_vector_complete_2d(id_update, u_cmpt, v_cmpt, MOM_dom, direction end subroutine pass_vector_complete_2d !> pass_vector_complete_3d completes a halo update for a pair of three-dimensional -!! arrays representing the compontents of a three-dimensional horizontal vector. +!! arrays representing the components of a three-dimensional horizontal vector. subroutine pass_vector_complete_3d(id_update, u_cmpt, v_cmpt, MOM_dom, direction, stagger, halo, & clock) integer, intent(in) :: id_update !< The integer id of this update which has been @@ -1371,7 +1371,7 @@ function MOM_thread_affinity_set() !$ MOM_thread_affinity_set = (ocean_nthreads > 1 ) end function MOM_thread_affinity_set -!> set_MOM_thread_affinity sest the number of openMP threads to use with the ocean. +!> set_MOM_thread_affinity sets the number of openMP threads to use with the ocean. subroutine set_MOM_thread_affinity(ocean_nthreads, ocean_hyper_thread) integer, intent(in) :: ocean_nthreads !< Number of openMP threads to use for the ocean model logical, intent(in) :: ocean_hyper_thread !< If true, use hyper threading @@ -1379,10 +1379,13 @@ subroutine set_MOM_thread_affinity(ocean_nthreads, ocean_hyper_thread) ! Local variables !$ integer :: omp_get_thread_num, omp_get_num_threads !< These are the results of openMP functions + !$ call fms_affinity_init() ! fms_affinity_init can be safely called more than once. !$ call fms_affinity_set('OCEAN', ocean_hyper_thread, ocean_nthreads) !$ call omp_set_num_threads(ocean_nthreads) + !$OMP PARALLEL !$ write(6,*) "MOM_domains_mod OMPthreading ", fms_affinity_get(), omp_get_thread_num(), omp_get_num_threads() !$ flush(6) + !$OMP END PARALLEL end subroutine set_MOM_thread_affinity !> This subroutine retrieves the 1-d domains that make up the 2d-domain in a MOM_domain diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 9ccef2888e..d230ecdf74 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -32,6 +32,7 @@ module MOM_domains ! Domain types and creation and destruction routines public :: MOM_domain_type, domain2D, domain1D public :: MOM_domains_init, create_MOM_domain, clone_MOM_domain, deallocate_MOM_domain +public :: MOM_thread_affinity_set, set_MOM_thread_affinity ! Domain query routines public :: get_domain_extent, get_domain_components, compute_block_extent, get_global_shape public :: PE_here, root_PE, num_PEs @@ -52,7 +53,7 @@ module MOM_domains contains !> MOM_domains_init initializes a MOM_domain_type variable, based on the information -!! read in from a param_file_type, and optionally returns data describing various' +!! read in from a param_file_type, and optionally returns data describing various !! properties of the domain type. subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & NIHALO, NJHALO, NIGLOBAL, NJGLOBAL, NIPROC, NJPROC, & @@ -260,7 +261,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & min_halo(1) = n_halo(1) n_halo(2) = max(n_halo(2), min_halo(2)) min_halo(2) = n_halo(2) - ! These are generally used only with static memory, so they are considerd layout params. + ! These are generally used only with static memory, so they are considered layout params. call log_param(param_file, mdl, "!NIHALO min_halo", n_halo(1), layoutParam=.true.) call log_param(param_file, mdl, "!NJHALO min_halo", n_halo(2), layoutParam=.true.) endif diff --git a/src/framework/MOM_ensemble_manager.F90 b/src/framework/MOM_ensemble_manager.F90 index 191dd79c9a..df1c30fc74 100644 --- a/src/framework/MOM_ensemble_manager.F90 +++ b/src/framework/MOM_ensemble_manager.F90 @@ -3,12 +3,16 @@ module MOM_ensemble_manager ! This file is part of MOM6. See LICENSE.md for the license. +use ensemble_manager_mod, only : ensemble_manager_init, ensemble_pelist_setup use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size use ensemble_manager_mod, only : get_ensemble_pelist, get_ensemble_filter_pelist implicit none ; private -public get_ensemble_id, get_ensemble_size, get_ensemble_pelist, get_ensemble_filter_pelist +public :: ensemble_manager_init, ensemble_pelist_setup +public :: get_ensemble_id, get_ensemble_size +public :: get_ensemble_pelist, get_ensemble_filter_pelist +! There need to be documented APIs in this module. end module MOM_ensemble_manager From 6712015b710865ab94a82c898c5146d10d4eaa6c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 25 Jan 2021 17:13:01 -0500 Subject: [PATCH 6/6] +Added 7 thin wrapper routines to MOM_io_infra.F90 Added explicitly documented interfaces to close_file, flux_file, io_infra_init, io_infra_end, get_file_info, get_file_fields, and get_field_atts to MOM_io_infra.F90. Also changed from get_file_atts to get_field_atts for the routine that is available via MOM_io.F90 and used in MOM_restart, since this name captures the use of this call and reflects which of the underlying routines the overloaded interface mpp_get_atts resolves to. All answers are bitwise identical, but there is a localized interface name change, and not all of the optional arguments in the underlying FMS or mpp routines are being made available for use with MOM6 code. --- src/framework/MOM_io.F90 | 4 +- src/framework/MOM_io_infra.F90 | 96 +++++++++++++++++++++++++++++----- src/framework/MOM_restart.F90 | 8 +-- 3 files changed, 89 insertions(+), 19 deletions(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 2a547dbdd1..9c0cb3a228 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -11,7 +11,7 @@ module MOM_io use MOM_file_parser, only : log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io_infra, only : MOM_read_data, read_data, MOM_read_vector, read_field_chksum -use MOM_io_infra, only : file_exists, get_file_info, get_file_atts, get_file_fields +use MOM_io_infra, only : file_exists, get_file_info, get_file_fields, get_field_atts use MOM_io_infra, only : open_file, close_file, field_size, fieldtype, field_exists use MOM_io_infra, only : flush_file, get_filename_appendix, get_ensemble_id use MOM_io_infra, only : get_file_times, axistype, get_axis_data @@ -35,7 +35,7 @@ module MOM_io public :: MOM_write_field, var_desc, modify_vardesc, query_vardesc ! The following are simple pass throughs of routines from MOM_io_infra or other modules public :: close_file, field_exists, field_size, fieldtype, get_filename_appendix -public :: file_exists, flush_file, get_file_info, get_file_atts, get_file_fields +public :: file_exists, flush_file, get_file_info, get_file_fields, get_field_atts public :: get_file_times, open_file, get_axis_data public :: MOM_read_data, MOM_read_vector, read_data, read_field_chksum public :: slasher, write_field, write_version_number diff --git a/src/framework/MOM_io_infra.F90 b/src/framework/MOM_io_infra.F90 index a854cd6d2a..1a075b63ef 100644 --- a/src/framework/MOM_io_infra.F90 +++ b/src/framework/MOM_io_infra.F90 @@ -5,38 +5,39 @@ module MOM_io_infra use MOM_domain_infra, only : MOM_domain_type, AGRID, BGRID_NE, CGRID_NE use MOM_domain_infra, only : get_simple_array_i_ind, get_simple_array_j_ind +use MOM_domain_infra, only : domain2d, CENTER, CORNER, NORTH_FACE, EAST_FACE use MOM_error_infra, only : MOM_error=>MOM_err, NOTE, FATAL, WARNING use ensemble_manager_mod, only : get_ensemble_id use fms_mod, only : write_version_number, open_namelist_file, check_nml_error use fms_io_mod, only : file_exist, field_exist, field_size, read_data -use fms_io_mod, only : io_infra_end=>fms_io_exit, get_filename_appendix -use mpp_domains_mod, only : domain2d, CENTER, CORNER, NORTH_FACE=>NORTH, EAST_FACE=>EAST -use mpp_io_mod, only : mpp_open, close_file=>mpp_close +use fms_io_mod, only : fms_io_exit, get_filename_appendix +use mpp_io_mod, only : mpp_open, mpp_close, mpp_flush use mpp_io_mod, only : write_metadata=>mpp_write_meta, mpp_write -use mpp_io_mod, only : get_field_atts=>mpp_get_atts, mpp_attribute_exist +use mpp_io_mod, only : mpp_get_atts, mpp_attribute_exist use mpp_io_mod, only : mpp_get_axes, axistype, get_axis_data=>mpp_get_axis_data -use mpp_io_mod, only : mpp_get_fields, fieldtype, flush_file=>mpp_flush +use mpp_io_mod, only : mpp_get_fields, fieldtype +use mpp_io_mod, only : mpp_get_info +use mpp_io_mod, only : get_file_times=>mpp_get_times +use mpp_io_mod, only : mpp_io_init +! These are encoding constants. use mpp_io_mod, only : APPEND_FILE=>MPP_APPEND, ASCII_FILE=>MPP_ASCII use mpp_io_mod, only : MULTIPLE=>MPP_MULTI, NETCDF_FILE=>MPP_NETCDF use mpp_io_mod, only : OVERWRITE_FILE=>MPP_OVERWR, READONLY_FILE=>MPP_RDONLY use mpp_io_mod, only : SINGLE_FILE=>MPP_SINGLE, WRITEONLY_FILE=>MPP_WRONLY -use mpp_io_mod, only : get_file_info=>mpp_get_info, get_file_atts=>mpp_get_atts -use mpp_io_mod, only : get_file_fields=>mpp_get_fields, get_file_times=>mpp_get_times -use mpp_io_mod, only : io_infra_init=>mpp_io_init implicit none ; private ! These interfaces are actually implemented or have explicit interfaces in this file. -public :: MOM_read_data, MOM_read_vector, write_field, open_file +public :: MOM_read_data, MOM_read_vector, write_field, open_file, close_file, flush_file public :: file_exists, field_exists, read_field_chksum +public :: get_file_info, get_file_fields, get_field_atts, io_infra_init, io_infra_end ! The following are simple pass throughs of routines from other modules. They need ! to have explicit interfaces added to this file. -public :: close_file, field_size, fieldtype, get_filename_appendix -public :: flush_file, get_file_info, get_file_atts, get_file_fields, get_field_atts -public :: get_file_times, read_data, axistype, get_axis_data +public :: fieldtype, axistype, field_size, get_filename_appendix +public :: get_file_times, read_data, get_axis_data public :: write_metadata, write_version_number, get_ensemble_id -public :: open_namelist_file, check_nml_error, io_infra_init, io_infra_end +public :: open_namelist_file, check_nml_error ! These are encoding constants. public :: APPEND_FILE, ASCII_FILE, MULTIPLE, NETCDF_FILE, OVERWRITE_FILE public :: READONLY_FILE, SINGLE_FILE, WRITEONLY_FILE @@ -122,6 +123,34 @@ function FMS_file_exists(filename, domain, no_domain) end function FMS_file_exists +!> close_file closes a file (or fileset). If the file handle does not point to an open file, +!! close_file simply returns without doing anything. +subroutine close_file(unit) + integer, intent(out) :: unit !< The I/O unit for the file to be closed + + call mpp_close(unit) +end subroutine close_file + +!> Ensure that the output stream associated with a unit is fully sent to dis. +subroutine flush_file(unit) + integer, intent(out) :: unit !< The I/O unit for the file to flush + + call mpp_flush(unit) +end subroutine flush_file + +!> Initialize the underlying I/O infrastructure +subroutine io_infra_init(maxunits) + integer, optional, intent(in) :: maxunits !< An optional maximum number of file + !! unit numbers that can be used. + call mpp_io_init(maxunit=maxunits) +end subroutine io_infra_init + +!> Gracefully close out and terminate the underlying I/O infrastructure +subroutine io_infra_end() + call fms_io_exit() +end subroutine io_infra_end + + !> open_file opens a file for parallel or single-file I/O. subroutine open_file(unit, file, action, form, threading, fileset, nohdrs, domain, MOM_domain) integer, intent(out) :: unit !< The I/O unit for the opened file @@ -150,6 +179,47 @@ subroutine open_file(unit, file, action, form, threading, fileset, nohdrs, domai endif end subroutine open_file +!> Get information about the number of dimensions, variables, global attributes and time levels +!! in the file associated with an open file unit +subroutine get_file_info(unit, ndim, nvar, natt, ntime) + integer, intent(in) :: unit !< The I/O unit for the open file + integer, optional, intent(out) :: ndim !< The number of dimensions in the file + integer, optional, intent(out) :: nvar !< The number of variables in the file + integer, optional, intent(out) :: natt !< The number of global attributes in the file + integer, optional, intent(out) :: ntime !< The number of time levels in the file + + ! Local variables + integer :: ndims, nvars, natts, ntimes + + call mpp_get_info( unit, ndims, nvars, natts, ntimes ) + + if (present(ndim)) ndim = ndims + if (present(nvar)) nvar = nvars + if (present(natt)) natt = natts + if (present(ntime)) ntime = ntimes + +end subroutine get_file_info + +!> Set up the field information (e.g., names and metadata) for all of the variables in a file. The +!! argument fields must be allocated with a size that matches the number of variables in a file. +subroutine get_file_fields(unit, fields) + integer, intent(in) :: unit !< The I/O unit for the open file + type(fieldtype), dimension(:), intent(inout) :: fields !< Field-type descriptions of all of + !! the variables in a file. + call mpp_get_fields(unit, fields) +end subroutine get_file_fields + +!> Extract information from a field type, as stored or as found in a file +subroutine get_field_atts(field, name, units, longname, checksum) + type(fieldtype), intent(in) :: field !< The field to extract information from + character(len=*), optional, intent(out) :: name !< The variable name + character(len=*), optional, intent(out) :: units !< The units of the variable + character(len=*), optional, intent(out) :: longname !< The long name of the variable + integer(kind=8), dimension(:), & + optional, intent(out) :: checksum !< The checksums of the variable in a file + call mpp_get_atts(field, name=name, units=units, longname=longname, checksum=checksum) +end subroutine get_field_atts + !> Field_exists returns true if the field indicated by field_name is present in the !! file file_name. If file_name does not exist, it returns false. function field_exists(filename, field_name, domain, no_domain, MOM_domain) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 73a41c5aa5..6780eff644 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -10,7 +10,7 @@ module MOM_restart use MOM_grid, only : ocean_grid_type use MOM_io, only : create_file, fieldtype, file_exists, open_file, close_file use MOM_io, only : MOM_read_data, read_data, MOM_write_field, read_field_chksum -use MOM_io, only : get_file_info, get_file_atts, get_file_fields, get_file_times +use MOM_io, only : get_file_info, get_file_fields, get_field_atts, get_file_times use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc, get_filename_appendix use MOM_io, only : MULTIPLE, NETCDF_FILE, READONLY_FILE, SINGLE_FILE use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE @@ -1160,10 +1160,10 @@ subroutine restore_state(filename, directory, day, G, CS) call get_file_info(unit(n), ndim, nvar, natt, ntime) allocate(fields(nvar)) - call get_file_fields(unit(n),fields(1:nvar)) + call get_file_fields(unit(n), fields(1:nvar)) do m=1, nvar - call get_file_atts(fields(m),name=varname) + call get_field_atts(fields(m), name=varname) do i=1,CS%num_obsolete_vars if (adjustl(lowercase(trim(varname))) == adjustl(lowercase(trim(CS%restart_obsolete(i)%field_name)))) then call MOM_error(FATAL, "MOM_restart restore_state: Attempting to use obsolete restart field "//& @@ -1194,7 +1194,7 @@ subroutine restore_state(filename, directory, day, G, CS) call get_checksum_loop_ranges(G, pos, isL, ieL, jsL, jeL) do i=1, nvar - call get_file_atts(fields(i),name=varname) + call get_field_atts(fields(i), name=varname) if (lowercase(trim(varname)) == lowercase(trim(CS%restart_field(m)%var_name))) then checksum_data = -1 if (CS%checksum_required) then