From cfa59aab1e3f51ec0cfa204eb79869fc9d361f96 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Mar 2021 18:27:28 -0400 Subject: [PATCH 1/3] +Add coupler_types interfaces needed by SIS2 Added additional wrappers to the MOM6 framework and MOM_couplertype_infra for coupler_types routines and types that are needed by SIS2. These include support for the use of a coupler_3d_bc_type, including as overloads to the existing coupler_type_spawn, coupler_type_copy_data, coupler_type_increment_data, coupler_type_initialized and coupler_type_write_chksums. There are also new overloaded wrappers in all three files for coupler_type_redistribute_data, coupler_type_data_override, coupler_type_rescale_data. All answers are bitwise identical. --- .../infra/FMS1/MOM_couplertype_infra.F90 | 291 ++++++++++++++++-- .../infra/FMS2/MOM_couplertype_infra.F90 | 291 ++++++++++++++++-- src/framework/MOM_coupler_types.F90 | 289 ++++++++++++++++- 3 files changed, 818 insertions(+), 53 deletions(-) diff --git a/config_src/infra/FMS1/MOM_couplertype_infra.F90 b/config_src/infra/FMS1/MOM_couplertype_infra.F90 index fd947691ca..2d6698b640 100644 --- a/config_src/infra/FMS1/MOM_couplertype_infra.F90 +++ b/config_src/infra/FMS1/MOM_couplertype_infra.F90 @@ -4,33 +4,36 @@ 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_set_diags, coupler_type_send_data, coupler_type_copy_data +use coupler_types_mod, only : coupler_type_write_chksums, coupler_type_redistribute_data +use coupler_types_mod, only : coupler_type_increment_data, coupler_type_rescale_data use coupler_types_mod, only : coupler_type_extract_data, coupler_type_set_data +use coupler_types_mod, only : coupler_type_data_override 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 coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_bc_type use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux +use MOM_domain_infra, only : domain2D 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 :: CT_set_diags, CT_send_data, CT_data_override, CT_write_chksums +public :: CT_set_data, CT_increment_data, CT_rescale_data +public :: CT_copy_data, CT_extract_data, CT_redistribute_data public :: atmos_ocn_coupler_flux public :: ind_flux, ind_alpha, ind_csurf -public :: coupler_1d_bc_type, coupler_2d_bc_type +public :: coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_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 + module procedure CT_spawn_1d_2d, CT_spawn_1d_3d, CT_spawn_2d_2d, CT_spawn_2d_3d + module procedure CT_spawn_3d_2d, CT_spawn_3d_3d 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 + module procedure CT_initialized_1d, CT_initialized_2d, CT_initialized_3d end interface CT_initialized !> This is the interface to deallocate any data associated with a coupler_bc_type. @@ -38,6 +41,35 @@ module MOM_couplertype_infra module procedure CT_destructor_1d, CT_destructor_2d end interface CT_destructor +!> Copy all elements of the data in of one coupler_2d_bc_type or coupler_3d_bc_type +!! into another. Both must have the same array sizes in common dimensions. +interface CT_copy_data + module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d +end interface CT_copy_data + +!> Increment data in all elements of one coupler_2d_bc_type or coupler_3d_bc_type with +!! the data from another. Both must have the same array sizes and rank. +interface CT_increment_data + module procedure CT_increment_data_2d, CT_increment_data_3d, CT_increment_data_2d_3d +end interface CT_increment_data + +!> Rescales the fields in the elements of a coupler_2d_bc_type by multiplying by a factor scale. +!! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. +interface CT_rescale_data + module procedure CT_rescale_data_2d, CT_rescale_data_3d +end interface CT_rescale_data + +!> Redistribute the data in all elements of one coupler_2d_bc_type or coupler_3d_bc_type into +!! another, which may be on different processors with a different decomposition. +interface CT_redistribute_data + module procedure CT_redistribute_data_2d, CT_redistribute_data_3d +end interface CT_redistribute_data + +!> Write out checksums for the elements of a coupler_2d_bc_type or coupler_3d_bc_type +interface CT_write_chksums + module procedure CT_write_chksums_2d, CT_write_chksums_3d +end interface CT_write_chksums + contains !> This subroutine sets many of the parameters for calculating an atmosphere-ocean tracer flux @@ -83,6 +115,24 @@ subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed) end subroutine CT_spawn_1d_2d +!> Generate a 3-D coupler type using a 1-D coupler type as a template. +subroutine CT_spawn_1d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) + type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_3d_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 + integer, dimension(2), intent(in) :: kdim !< The array extents of the third 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, kdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_1d_3d + !> 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 @@ -99,8 +149,60 @@ subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed) end subroutine CT_spawn_2d_2d +!> Generate a 3-D coupler type using a 2-D coupler type as a template. +subroutine CT_spawn_2d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) + type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_3d_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 + integer, dimension(2), intent(in) :: kdim !< The array extents of the third 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, kdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_2d_3d + +!> Generate a 2-D coupler type using a 3-D coupler type as a template. +subroutine CT_spawn_3d_2d(var_in, var, idim, jdim, suffix, as_needed) + type(coupler_3d_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_3d_2d + +!> Generate a 3-D coupler type using another 3-D coupler type as a template. +subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) + type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_3d_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 + integer, dimension(2), intent(in) :: kdim !< The array extents of the third 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, kdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_3d_3d + !> 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, & +subroutine CT_copy_data_2d(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 @@ -118,11 +220,59 @@ subroutine CT_copy_data(var_in, var, halo_size, bc_index, field_index, & 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 +end subroutine CT_copy_data_2d + +!> Copy all elements of the data in of one coupler_3d_bc_type into another. Both must have the same array sizes. +subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice) + type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(coupler_3d_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_3d + +!> Copy all elements of the data in a coupler_2d_bc_type into a coupler_3d_bc_type. +!! Both must have the same array sizes for the first two dimensions, while the extent +!! of the 3rd dimension that is being filled may be specified via optional arguments. +subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice, ind3_start, ind3_end) + type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(coupler_3d_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 + integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd + !! index of the 3d type to fill in. + integer, optional, intent(in) :: ind3_end !< The ending value of the 3rd + !! index of the 3d type to fill in. + + call coupler_type_copy_data(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice, ind3_start, ind3_end) +end subroutine CT_copy_data_2d_3d !> 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) +subroutine CT_increment_data_2d(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 @@ -132,11 +282,90 @@ subroutine CT_increment_data(var_in, var, halo_size, scale_factor, scale_prev) 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 +end subroutine CT_increment_data_2d + +!> Increment data in all elements of one coupler_3d_bc_type with the data from another. Both +!! must have the same array sizes. +subroutine CT_increment_data_3d(var_in, var, halo_size, scale_factor, scale_prev, exclude_flux_type, only_flux_type) + type(coupler_3d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type + type(coupler_3d_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 + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. + + call coupler_type_increment_data(var_in, var, halo_size=halo_size, scale_factor=scale_factor, & + scale_prev=scale_prev, exclude_flux_type=exclude_flux_type, & + only_flux_type=only_flux_type) + +end subroutine CT_increment_data_3d + +!> Rescales the fields in the elements of a coupler_2d_bc_type by multiplying by a factor scale. +!! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. +subroutine CT_rescale_data_2d(var, scale) + type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled + real, intent(in) :: scale !< A scaling factor to multiply fields by + + call coupler_type_rescale_data(var, scale) + +end subroutine CT_rescale_data_2d + +!> Rescales the fields in the elements of a coupler_3d_bc_type by multiplying by a factor scale. +!! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. +subroutine CT_rescale_data_3d(var, scale) + type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled + real, intent(in) :: scale !< A scaling factor to multiply fields by + + call coupler_type_rescale_data(var, scale) + +end subroutine CT_rescale_data_3d + +!> Increment data in the elements of a coupler_2d_bc_type with weighted averages of elements of a +!! coupler_3d_bc_type +subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size) + type(coupler_3d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type + real, dimension(:,:,:), intent(in) :: weights !< An array of normalized weights for the 3d-data to + !! increment the 2d-data. There is no renormalization, + !! so if the weights do not sum to 1 in the 3rd dimension + !! there may be adverse consequences! + 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 + + call coupler_type_increment_data(var_in, weights, var, halo_size=halo_size) + +end subroutine CT_increment_data_2d_3d + + +!> Redistribute the data in all elements of one coupler_2d_bc_type into another, which may be on +!! different processors with a different decomposition. +subroutine CT_redistribute_data_2d(var_in, domain_in, var_out, domain_out, complete) + type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure + type(coupler_2d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) + type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure + logical, optional, intent(in) :: complete !< If true, complete the updates + + call coupler_type_redistribute_data(var_in, domain_in, var_out, domain_out, complete) +end subroutine CT_redistribute_data_2d + +!> Redistribute the data in all elements of one coupler_3d_bc_type into another, which may be on +!! different processors with a different decomposition. +subroutine CT_redistribute_data_3d(var_in, domain_in, var_out, domain_out, complete) + type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure + type(coupler_3d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) + type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure + logical, optional, intent(in) :: complete !< If true, complete the updates + + call coupler_type_redistribute_data(var_in, domain_in, var_out, domain_out, complete) +end subroutine CT_redistribute_data_3d !> 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) + 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 @@ -160,7 +389,7 @@ 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) + 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. @@ -185,6 +414,15 @@ subroutine CT_set_data(array_in, bc_index, field_index, var, & end subroutine CT_set_data +!> Potentially override the values in a coupler_2d_bc_type +subroutine CT_data_override(gridname, var, time) + character(len=3), intent(in) :: gridname !< 3-character long model grid ID + type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to override + type(time_type), intent(in) :: time !< The current model time + + call coupler_type_data_override(gridname, var, time) +end subroutine CT_data_override + !> 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 @@ -205,14 +443,24 @@ subroutine CT_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) +subroutine CT_write_chksums_2d(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 +end subroutine CT_write_chksums_2d + +!> Write out checksums for the elements of a coupler_3d_bc_type +subroutine CT_write_chksums_3d(var, outunit, name_lead) + type(coupler_3d_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_3d !> Indicate whether a coupler_1d_bc_type has been initialized. logical function CT_initialized_1d(var) @@ -228,6 +476,13 @@ logical function CT_initialized_2d(var) CT_initialized_2d = coupler_type_initialized(var) end function CT_initialized_2d +!> Indicate whether a coupler_3d_bc_type has been initialized. +logical function CT_initialized_3d(var) + type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed + + CT_initialized_3d = coupler_type_initialized(var) +end function CT_initialized_3d + !> 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 diff --git a/config_src/infra/FMS2/MOM_couplertype_infra.F90 b/config_src/infra/FMS2/MOM_couplertype_infra.F90 index fd947691ca..2d6698b640 100644 --- a/config_src/infra/FMS2/MOM_couplertype_infra.F90 +++ b/config_src/infra/FMS2/MOM_couplertype_infra.F90 @@ -4,33 +4,36 @@ 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_set_diags, coupler_type_send_data, coupler_type_copy_data +use coupler_types_mod, only : coupler_type_write_chksums, coupler_type_redistribute_data +use coupler_types_mod, only : coupler_type_increment_data, coupler_type_rescale_data use coupler_types_mod, only : coupler_type_extract_data, coupler_type_set_data +use coupler_types_mod, only : coupler_type_data_override 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 coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_bc_type use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux +use MOM_domain_infra, only : domain2D 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 :: CT_set_diags, CT_send_data, CT_data_override, CT_write_chksums +public :: CT_set_data, CT_increment_data, CT_rescale_data +public :: CT_copy_data, CT_extract_data, CT_redistribute_data public :: atmos_ocn_coupler_flux public :: ind_flux, ind_alpha, ind_csurf -public :: coupler_1d_bc_type, coupler_2d_bc_type +public :: coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_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 + module procedure CT_spawn_1d_2d, CT_spawn_1d_3d, CT_spawn_2d_2d, CT_spawn_2d_3d + module procedure CT_spawn_3d_2d, CT_spawn_3d_3d 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 + module procedure CT_initialized_1d, CT_initialized_2d, CT_initialized_3d end interface CT_initialized !> This is the interface to deallocate any data associated with a coupler_bc_type. @@ -38,6 +41,35 @@ module MOM_couplertype_infra module procedure CT_destructor_1d, CT_destructor_2d end interface CT_destructor +!> Copy all elements of the data in of one coupler_2d_bc_type or coupler_3d_bc_type +!! into another. Both must have the same array sizes in common dimensions. +interface CT_copy_data + module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d +end interface CT_copy_data + +!> Increment data in all elements of one coupler_2d_bc_type or coupler_3d_bc_type with +!! the data from another. Both must have the same array sizes and rank. +interface CT_increment_data + module procedure CT_increment_data_2d, CT_increment_data_3d, CT_increment_data_2d_3d +end interface CT_increment_data + +!> Rescales the fields in the elements of a coupler_2d_bc_type by multiplying by a factor scale. +!! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. +interface CT_rescale_data + module procedure CT_rescale_data_2d, CT_rescale_data_3d +end interface CT_rescale_data + +!> Redistribute the data in all elements of one coupler_2d_bc_type or coupler_3d_bc_type into +!! another, which may be on different processors with a different decomposition. +interface CT_redistribute_data + module procedure CT_redistribute_data_2d, CT_redistribute_data_3d +end interface CT_redistribute_data + +!> Write out checksums for the elements of a coupler_2d_bc_type or coupler_3d_bc_type +interface CT_write_chksums + module procedure CT_write_chksums_2d, CT_write_chksums_3d +end interface CT_write_chksums + contains !> This subroutine sets many of the parameters for calculating an atmosphere-ocean tracer flux @@ -83,6 +115,24 @@ subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed) end subroutine CT_spawn_1d_2d +!> Generate a 3-D coupler type using a 1-D coupler type as a template. +subroutine CT_spawn_1d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) + type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_3d_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 + integer, dimension(2), intent(in) :: kdim !< The array extents of the third 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, kdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_1d_3d + !> 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 @@ -99,8 +149,60 @@ subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed) end subroutine CT_spawn_2d_2d +!> Generate a 3-D coupler type using a 2-D coupler type as a template. +subroutine CT_spawn_2d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) + type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_3d_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 + integer, dimension(2), intent(in) :: kdim !< The array extents of the third 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, kdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_2d_3d + +!> Generate a 2-D coupler type using a 3-D coupler type as a template. +subroutine CT_spawn_3d_2d(var_in, var, idim, jdim, suffix, as_needed) + type(coupler_3d_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_3d_2d + +!> Generate a 3-D coupler type using another 3-D coupler type as a template. +subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) + type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_3d_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 + integer, dimension(2), intent(in) :: kdim !< The array extents of the third 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, kdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_3d_3d + !> 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, & +subroutine CT_copy_data_2d(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 @@ -118,11 +220,59 @@ subroutine CT_copy_data(var_in, var, halo_size, bc_index, field_index, & 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 +end subroutine CT_copy_data_2d + +!> Copy all elements of the data in of one coupler_3d_bc_type into another. Both must have the same array sizes. +subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice) + type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(coupler_3d_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_3d + +!> Copy all elements of the data in a coupler_2d_bc_type into a coupler_3d_bc_type. +!! Both must have the same array sizes for the first two dimensions, while the extent +!! of the 3rd dimension that is being filled may be specified via optional arguments. +subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice, ind3_start, ind3_end) + type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(coupler_3d_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 + integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd + !! index of the 3d type to fill in. + integer, optional, intent(in) :: ind3_end !< The ending value of the 3rd + !! index of the 3d type to fill in. + + call coupler_type_copy_data(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice, ind3_start, ind3_end) +end subroutine CT_copy_data_2d_3d !> 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) +subroutine CT_increment_data_2d(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 @@ -132,11 +282,90 @@ subroutine CT_increment_data(var_in, var, halo_size, scale_factor, scale_prev) 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 +end subroutine CT_increment_data_2d + +!> Increment data in all elements of one coupler_3d_bc_type with the data from another. Both +!! must have the same array sizes. +subroutine CT_increment_data_3d(var_in, var, halo_size, scale_factor, scale_prev, exclude_flux_type, only_flux_type) + type(coupler_3d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type + type(coupler_3d_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 + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. + + call coupler_type_increment_data(var_in, var, halo_size=halo_size, scale_factor=scale_factor, & + scale_prev=scale_prev, exclude_flux_type=exclude_flux_type, & + only_flux_type=only_flux_type) + +end subroutine CT_increment_data_3d + +!> Rescales the fields in the elements of a coupler_2d_bc_type by multiplying by a factor scale. +!! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. +subroutine CT_rescale_data_2d(var, scale) + type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled + real, intent(in) :: scale !< A scaling factor to multiply fields by + + call coupler_type_rescale_data(var, scale) + +end subroutine CT_rescale_data_2d + +!> Rescales the fields in the elements of a coupler_3d_bc_type by multiplying by a factor scale. +!! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. +subroutine CT_rescale_data_3d(var, scale) + type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled + real, intent(in) :: scale !< A scaling factor to multiply fields by + + call coupler_type_rescale_data(var, scale) + +end subroutine CT_rescale_data_3d + +!> Increment data in the elements of a coupler_2d_bc_type with weighted averages of elements of a +!! coupler_3d_bc_type +subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size) + type(coupler_3d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type + real, dimension(:,:,:), intent(in) :: weights !< An array of normalized weights for the 3d-data to + !! increment the 2d-data. There is no renormalization, + !! so if the weights do not sum to 1 in the 3rd dimension + !! there may be adverse consequences! + 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 + + call coupler_type_increment_data(var_in, weights, var, halo_size=halo_size) + +end subroutine CT_increment_data_2d_3d + + +!> Redistribute the data in all elements of one coupler_2d_bc_type into another, which may be on +!! different processors with a different decomposition. +subroutine CT_redistribute_data_2d(var_in, domain_in, var_out, domain_out, complete) + type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure + type(coupler_2d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) + type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure + logical, optional, intent(in) :: complete !< If true, complete the updates + + call coupler_type_redistribute_data(var_in, domain_in, var_out, domain_out, complete) +end subroutine CT_redistribute_data_2d + +!> Redistribute the data in all elements of one coupler_3d_bc_type into another, which may be on +!! different processors with a different decomposition. +subroutine CT_redistribute_data_3d(var_in, domain_in, var_out, domain_out, complete) + type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure + type(coupler_3d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) + type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure + logical, optional, intent(in) :: complete !< If true, complete the updates + + call coupler_type_redistribute_data(var_in, domain_in, var_out, domain_out, complete) +end subroutine CT_redistribute_data_3d !> 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) + 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 @@ -160,7 +389,7 @@ 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) + 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. @@ -185,6 +414,15 @@ subroutine CT_set_data(array_in, bc_index, field_index, var, & end subroutine CT_set_data +!> Potentially override the values in a coupler_2d_bc_type +subroutine CT_data_override(gridname, var, time) + character(len=3), intent(in) :: gridname !< 3-character long model grid ID + type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to override + type(time_type), intent(in) :: time !< The current model time + + call coupler_type_data_override(gridname, var, time) +end subroutine CT_data_override + !> 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 @@ -205,14 +443,24 @@ subroutine CT_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) +subroutine CT_write_chksums_2d(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 +end subroutine CT_write_chksums_2d + +!> Write out checksums for the elements of a coupler_3d_bc_type +subroutine CT_write_chksums_3d(var, outunit, name_lead) + type(coupler_3d_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_3d !> Indicate whether a coupler_1d_bc_type has been initialized. logical function CT_initialized_1d(var) @@ -228,6 +476,13 @@ logical function CT_initialized_2d(var) CT_initialized_2d = coupler_type_initialized(var) end function CT_initialized_2d +!> Indicate whether a coupler_3d_bc_type has been initialized. +logical function CT_initialized_3d(var) + type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed + + CT_initialized_3d = coupler_type_initialized(var) +end function CT_initialized_3d + !> 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 diff --git a/src/framework/MOM_coupler_types.F90 b/src/framework/MOM_coupler_types.F90 index 94014d9a56..bb01755a84 100644 --- a/src/framework/MOM_coupler_types.F90 +++ b/src/framework/MOM_coupler_types.F90 @@ -4,31 +4,33 @@ 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 : CT_set_diags, CT_send_data, CT_write_chksums, CT_data_override +use MOM_couplertype_infra, only : CT_copy_data, CT_increment_data, CT_rescale_data +use MOM_couplertype_infra, only : CT_set_data, CT_extract_data, CT_redistribute_data +use MOM_couplertype_infra, only : coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_bc_type use MOM_couplertype_infra, only : ind_flux, ind_alpha, ind_csurf - -use MOM_time_manager, only : time_type +use MOM_domain_infra, only : domain2D +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 :: set_coupler_type_data, extract_coupler_type_data, coupler_type_redistribute_data +public :: coupler_type_copy_data, coupler_type_increment_data, coupler_type_rescale_data +public :: atmos_ocn_coupler_flux, coupler_type_data_override public :: ind_flux, ind_alpha, ind_csurf -public :: coupler_1d_bc_type, coupler_2d_bc_type +public :: coupler_1d_bc_type, coupler_2d_bc_type, coupler_3d_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 + module procedure CT_spawn_1d_2d, CT_spawn_1d_3d, CT_spawn_2d_2d, CT_spawn_2d_3d + module procedure CT_spawn_3d_2d, CT_spawn_3d_3d 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 + module procedure CT_initialized_1d, CT_initialized_2d, CT_initialized_3d end interface coupler_type_initialized !> This is the interface to deallocate any data associated with a coupler_bc_type. @@ -36,6 +38,35 @@ module MOM_coupler_types module procedure CT_destructor_1d, CT_destructor_2d end interface coupler_type_destructor +!> Copy all elements of the data in of one coupler_2d_bc_type or coupler_3d_bc_type +!! into another. Both must have the same array sizes in common dimensions. +interface coupler_type_copy_data + module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d +end interface coupler_type_copy_data + +!> Increment data in all elements of one coupler_2d_bc_type or coupler_3d_bc_type with +!! the data from another. Both must have the same array sizes and rank. +interface coupler_type_increment_data + module procedure CT_increment_data_2d, CT_increment_data_3d, CT_increment_data_2d_3d +end interface coupler_type_increment_data + +!> Rescale the fields in the elements of a coupler_2d_bc_type by multiplying by a factor scale. +!! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. +interface coupler_type_rescale_data + module procedure CT_rescale_data_2d, CT_rescale_data_3d +end interface coupler_type_rescale_data + +!> Redistribute the data in all elements of one coupler_2d_bc_type or coupler_3d_bc_type into +!! another, which may be on different processors with a different decomposition. +interface coupler_type_redistribute_data + module procedure CT_redistribute_data_2d, CT_redistribute_data_3d +end interface coupler_type_redistribute_data + +!> Write out checksums for the elements of a coupler_2d_bc_type or coupler_3d_bc_type +interface coupler_type_write_chksums + module procedure CT_write_chksums_2d, CT_write_chksums_3d +end interface coupler_type_write_chksums + contains !> Generate a 2-D coupler type using a 1-D coupler type as a template. @@ -54,6 +85,24 @@ subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed) end subroutine CT_spawn_1d_2d +!> Generate a 3-D coupler type using a 1-D coupler type as a template. +subroutine CT_spawn_1d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) + type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_3d_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 + integer, dimension(2), intent(in) :: kdim !< The array extents of the third 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, kdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_1d_3d + !> 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 @@ -70,8 +119,60 @@ subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed) end subroutine CT_spawn_2d_2d +!> Generate a 3-D coupler type using a 2-D coupler type as a template. +subroutine CT_spawn_2d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) + type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_3d_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 + integer, dimension(2), intent(in) :: kdim !< The array extents of the third 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, kdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_2d_3d + +!> Generate a 2-D coupler type using a 3-D coupler type as a template. +subroutine CT_spawn_3d_2d(var_in, var, idim, jdim, suffix, as_needed) + type(coupler_3d_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_3d_2d + +!> Generate a 3-D coupler type using another 3-D coupler type as a template. +subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) + type(coupler_3d_bc_type), intent(in) :: var_in !< structure from which to copy information + type(coupler_3d_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 + integer, dimension(2), intent(in) :: kdim !< The array extents of the third 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, kdim, suffix=suffix, as_needed=as_needed) + +end subroutine CT_spawn_3d_3d + !> 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, & +subroutine CT_copy_data_2d(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 @@ -89,11 +190,59 @@ subroutine coupler_type_copy_data(var_in, var, halo_size, bc_index, field_index, 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 +end subroutine CT_copy_data_2d + +!> Copy all elements of the data in of one coupler_3d_bc_type into another. Both must have the same array sizes. +subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice) + type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(coupler_3d_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 CT_copy_data_3d + +!> Copy all elements of the data in a coupler_2d_bc_type into a coupler_3d_bc_type. +!! Both must have the same array sizes for the first two dimensions, while the extent +!! of the 3rd dimension that is being filled may be specified via optional arguments. +subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice, ind3_start, ind3_end) + type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(coupler_3d_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 + integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd + !! index of the 3d type to fill in. + integer, optional, intent(in) :: ind3_end !< The ending value of the 3rd + !! index of the 3d type to fill in. + + call CT_copy_data(var_in, var, halo_size, bc_index, field_index, & + exclude_flux_type, only_flux_type, pass_through_ice, ind3_start, ind3_end) +end subroutine CT_copy_data_2d_3d !> 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) +subroutine CT_increment_data_2d(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 @@ -103,7 +252,96 @@ subroutine coupler_type_increment_data(var_in, var, halo_size, scale_factor, sca 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 +end subroutine CT_increment_data_2d + +!> Increment data in all elements of one coupler_3d_bc_type with the data from another. Both +!! must have the same array sizes. +subroutine CT_increment_data_3d(var_in, var, halo_size, scale_factor, scale_prev, exclude_flux_type, only_flux_type) + type(coupler_3d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type + type(coupler_3d_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 + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. + + call CT_increment_data(var_in, var, halo_size=halo_size, scale_factor=scale_factor, & + scale_prev=scale_prev, exclude_flux_type=exclude_flux_type, & + only_flux_type=only_flux_type) + +end subroutine CT_increment_data_3d + +!> Increment data in the elements of a coupler_2d_bc_type with weighted averages of elements of a +!! coupler_3d_bc_type +subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size) + type(coupler_3d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type + real, dimension(:,:,:), intent(in) :: weights !< An array of normalized weights for the 3d-data to + !! increment the 2d-data. There is no renormalization, + !! so if the weights do not sum to 1 in the 3rd dimension + !! there may be adverse consequences! + 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 + + call CT_increment_data(var_in, weights, var, halo_size=halo_size) + +end subroutine CT_increment_data_2d_3d + +!> Rescales the fields in the elements of a coupler_2d_bc_type by multiplying by a factor scale. +!! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. +subroutine CT_rescale_data_2d(var, scale) + type(coupler_2d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled + real, intent(in) :: scale !< A scaling factor to multiply fields by + + call CT_rescale_data(var, scale) + +end subroutine CT_rescale_data_2d + +!> Rescales the fields in the elements of a coupler_3d_bc_type by multiplying by a factor scale. +!! If scale is 0, this is a direct assignment to 0, so that NaNs will not persist. +subroutine CT_rescale_data_3d(var, scale) + type(coupler_3d_bc_type), intent(inout) :: var !< The BC_type structure whose fields are being rescaled + real, intent(in) :: scale !< A scaling factor to multiply fields by + + call CT_rescale_data(var, scale) + +end subroutine CT_rescale_data_3d + +!> Redistribute the data in all elements of one coupler_2d_bc_type into another, which may be on +!! different processors with a different decomposition. +subroutine CT_redistribute_data_2d(var_in, domain_in, var_out, domain_out, complete) + type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure + type(coupler_2d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) + type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure + logical, optional, intent(in) :: complete !< If true, complete the updates + + call CT_redistribute_data(var_in, domain_in, var_out, domain_out, complete) +end subroutine CT_redistribute_data_2d + +!> Redistribute the data in all elements of one coupler_3d_bc_type into another, which may be on +!! different processors with a different decomposition. +subroutine CT_redistribute_data_3d(var_in, domain_in, var_out, domain_out, complete) + type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy + type(domain2D), intent(in) :: domain_in !< The FMS domain for the input structure + type(coupler_3d_bc_type), intent(inout) :: var_out !< The recipient BC_type structure (data intent out) + type(domain2D), intent(in) :: domain_out !< The FMS domain for the output structure + logical, optional, intent(in) :: complete !< If true, complete the updates + + call CT_redistribute_data(var_in, domain_in, var_out, domain_out, complete) +end subroutine CT_redistribute_data_3d + + +!> Potentially override the values in a coupler_2d_bc_type +subroutine coupler_type_data_override(gridname, var, time) + character(len=3), intent(in) :: gridname !< 3-character long model grid ID + type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to override + type(time_type), intent(in) :: time !< The current model time + + call CT_data_override(gridname, var, time) +end subroutine coupler_type_data_override + !> Extract a 2d field from a coupler_2d_bc_type into a two-dimensional array, using a !! MOM-specific interface. @@ -193,14 +431,24 @@ subroutine coupler_type_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) +subroutine CT_write_chksums_2d(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 +end subroutine CT_write_chksums_2d + +!> Write out checksums for the elements of a coupler_3d_bc_type +subroutine CT_write_chksums_3d(var, outunit, name_lead) + type(coupler_3d_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 CT_write_chksums_3d !> Indicate whether a coupler_1d_bc_type has been initialized. logical function CT_initialized_1d(var) @@ -216,6 +464,13 @@ logical function CT_initialized_2d(var) CT_initialized_2d = CT_initialized(var) end function CT_initialized_2d +!> Indicate whether a coupler_3d_bc_type has been initialized. +logical function CT_initialized_3d(var) + type(coupler_3d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed + + CT_initialized_3d = CT_initialized(var) +end function CT_initialized_3d + !> 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 From 3c1cb2efd6497bcf83b70efc7b4fd2c1752c73f7 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 31 Mar 2021 18:28:34 -0400 Subject: [PATCH 2/3] +Add MOM_domains interfaces needed by SIS2 Added additional domain routine interfaces that are needed by SIS2, including the new function same_domain, which tests whether two domains use the same layout and conforming computational domain sizes, and a new 4d-array variant of redistribute_array because SIS2 uses thickness categories as a 4th dimension. All answers are bitwise identical. --- config_src/infra/FMS1/MOM_domain_infra.F90 | 48 ++++++++++++++++++++-- config_src/infra/FMS2/MOM_domain_infra.F90 | 48 ++++++++++++++++++++-- src/framework/MOM_domains.F90 | 6 ++- 3 files changed, 94 insertions(+), 8 deletions(-) diff --git a/config_src/infra/FMS1/MOM_domain_infra.F90 b/config_src/infra/FMS1/MOM_domain_infra.F90 index fc39777a2f..029561946b 100644 --- a/config_src/infra/FMS1/MOM_domain_infra.F90 +++ b/config_src/infra/FMS1/MOM_domain_infra.F90 @@ -9,7 +9,7 @@ module MOM_domain_infra use mpp_domains_mod, only : domain2D, domain1D use mpp_domains_mod, only : mpp_define_io_domain, mpp_define_domains, mpp_deallocate_domain -use mpp_domains_mod, only : mpp_get_domain_components, mpp_get_domain_extents +use mpp_domains_mod, only : mpp_get_domain_components, mpp_get_domain_extents, mpp_get_layout use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_data_domain, mpp_get_global_domain use mpp_domains_mod, only : mpp_get_boundary, mpp_update_domains use mpp_domains_mod, only : mpp_start_update_domains, mpp_complete_update_domains @@ -42,7 +42,7 @@ module MOM_domain_infra public :: pass_var, pass_vector, fill_symmetric_edges, rescale_comp_data public :: pass_var_start, pass_var_complete, pass_vector_start, pass_vector_complete public :: create_group_pass, do_group_pass, start_group_pass, complete_group_pass -public :: redistribute_array, broadcast_domain, global_field +public :: redistribute_array, broadcast_domain, same_domain, global_field public :: get_simple_array_i_ind, get_simple_array_j_ind public :: MOM_thread_affinity_set, set_MOM_thread_affinity ! These are encoding constant parmeters. @@ -105,7 +105,7 @@ module MOM_domain_infra !> Pass an array from one MOM domain to another interface redistribute_array - module procedure redistribute_array_3d, redistribute_array_2d + module procedure redistribute_array_2d, redistribute_array_3d, redistribute_array_4d end interface redistribute_array !> Copy one MOM_domain_type into another @@ -1232,6 +1232,25 @@ subroutine redistribute_array_3d(Domain1, array1, Domain2, array2, complete) end subroutine redistribute_array_3d +!> Pass a 4-D array from one MOM domain to another +subroutine redistribute_array_4d(Domain1, array1, Domain2, array2, complete) + type(domain2d), & + intent(in) :: Domain1 !< The MOM domain from which to extract information. + real, dimension(:,:,:,:), intent(in) :: array1 !< The array from which to extract information. + type(domain2d), & + intent(in) :: Domain2 !< The MOM domain receiving information. + real, dimension(:,:,:,:), intent(out) :: array2 !< The array receiving information. + logical, optional, intent(in) :: complete !< If true, finish communication before proceeding. + + ! Local variables + logical :: do_complete + + do_complete=.true.;if (PRESENT(complete)) do_complete = complete + + call mpp_redistribute(Domain1, array1, Domain2, array2, do_complete) + +end subroutine redistribute_array_4d + !> Rescale the values of a 4-D array in its computational domain by a constant factor subroutine rescale_comp_data_4d(domain, array, scale) @@ -1923,6 +1942,29 @@ subroutine global_field(domain, local, global) call mpp_global_field(domain, local, global) end subroutine global_field +!> same_domain returns true if two domains use the same list of PEs and layouts and have the same +!! size computational domains, and false if the domains do not conform with each other. +!! Different halo sizes or indexing conventions do not alter the results. +logical function same_domain(domain_a, domain_b) + type(domain2D), intent(in) :: domain_a !< The first domain in the comparison + type(domain2D), intent(in) :: domain_b !< The second domain in the comparison + + ! Local variables + integer :: isc_a, iec_a, jsc_a, jec_a, isc_b, iec_b, jsc_b, jec_b + integer :: layout_a(2), layout_b(2) + + ! This routine currently does a few checks for consistent domains; more could be added. + call mpp_get_layout(domain_a, layout_a) + call mpp_get_layout(domain_b, layout_b) + + call get_domain_extent(domain_a, isc_a, iec_a, jsc_a, jec_a) + call get_domain_extent(domain_b, isc_b, iec_b, jsc_b, jec_b) + + same_domain = (layout_a(1) == layout_b(1)) .and. (layout_a(2) == layout_b(2)) .and. & + (iec_a - isc_a == iec_b - isc_b) .and. (jec_a - jsc_a == jec_b - jsc_b) + +end function same_domain + !> Returns arrays of the i- and j- sizes of the h-point computational domains for each !! element of the grid layout. Any input values in the extent arrays are discarded, so !! they are effectively intent out despite their declared intent of inout. diff --git a/config_src/infra/FMS2/MOM_domain_infra.F90 b/config_src/infra/FMS2/MOM_domain_infra.F90 index fc39777a2f..029561946b 100644 --- a/config_src/infra/FMS2/MOM_domain_infra.F90 +++ b/config_src/infra/FMS2/MOM_domain_infra.F90 @@ -9,7 +9,7 @@ module MOM_domain_infra use mpp_domains_mod, only : domain2D, domain1D use mpp_domains_mod, only : mpp_define_io_domain, mpp_define_domains, mpp_deallocate_domain -use mpp_domains_mod, only : mpp_get_domain_components, mpp_get_domain_extents +use mpp_domains_mod, only : mpp_get_domain_components, mpp_get_domain_extents, mpp_get_layout use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_data_domain, mpp_get_global_domain use mpp_domains_mod, only : mpp_get_boundary, mpp_update_domains use mpp_domains_mod, only : mpp_start_update_domains, mpp_complete_update_domains @@ -42,7 +42,7 @@ module MOM_domain_infra public :: pass_var, pass_vector, fill_symmetric_edges, rescale_comp_data public :: pass_var_start, pass_var_complete, pass_vector_start, pass_vector_complete public :: create_group_pass, do_group_pass, start_group_pass, complete_group_pass -public :: redistribute_array, broadcast_domain, global_field +public :: redistribute_array, broadcast_domain, same_domain, global_field public :: get_simple_array_i_ind, get_simple_array_j_ind public :: MOM_thread_affinity_set, set_MOM_thread_affinity ! These are encoding constant parmeters. @@ -105,7 +105,7 @@ module MOM_domain_infra !> Pass an array from one MOM domain to another interface redistribute_array - module procedure redistribute_array_3d, redistribute_array_2d + module procedure redistribute_array_2d, redistribute_array_3d, redistribute_array_4d end interface redistribute_array !> Copy one MOM_domain_type into another @@ -1232,6 +1232,25 @@ subroutine redistribute_array_3d(Domain1, array1, Domain2, array2, complete) end subroutine redistribute_array_3d +!> Pass a 4-D array from one MOM domain to another +subroutine redistribute_array_4d(Domain1, array1, Domain2, array2, complete) + type(domain2d), & + intent(in) :: Domain1 !< The MOM domain from which to extract information. + real, dimension(:,:,:,:), intent(in) :: array1 !< The array from which to extract information. + type(domain2d), & + intent(in) :: Domain2 !< The MOM domain receiving information. + real, dimension(:,:,:,:), intent(out) :: array2 !< The array receiving information. + logical, optional, intent(in) :: complete !< If true, finish communication before proceeding. + + ! Local variables + logical :: do_complete + + do_complete=.true.;if (PRESENT(complete)) do_complete = complete + + call mpp_redistribute(Domain1, array1, Domain2, array2, do_complete) + +end subroutine redistribute_array_4d + !> Rescale the values of a 4-D array in its computational domain by a constant factor subroutine rescale_comp_data_4d(domain, array, scale) @@ -1923,6 +1942,29 @@ subroutine global_field(domain, local, global) call mpp_global_field(domain, local, global) end subroutine global_field +!> same_domain returns true if two domains use the same list of PEs and layouts and have the same +!! size computational domains, and false if the domains do not conform with each other. +!! Different halo sizes or indexing conventions do not alter the results. +logical function same_domain(domain_a, domain_b) + type(domain2D), intent(in) :: domain_a !< The first domain in the comparison + type(domain2D), intent(in) :: domain_b !< The second domain in the comparison + + ! Local variables + integer :: isc_a, iec_a, jsc_a, jec_a, isc_b, iec_b, jsc_b, jec_b + integer :: layout_a(2), layout_b(2) + + ! This routine currently does a few checks for consistent domains; more could be added. + call mpp_get_layout(domain_a, layout_a) + call mpp_get_layout(domain_b, layout_b) + + call get_domain_extent(domain_a, isc_a, iec_a, jsc_a, jec_a) + call get_domain_extent(domain_b, isc_b, iec_b, jsc_b, jec_b) + + same_domain = (layout_a(1) == layout_b(1)) .and. (layout_a(2) == layout_b(2)) .and. & + (iec_a - isc_a == iec_b - isc_b) .and. (jec_a - jsc_a == jec_b - jsc_b) + +end function same_domain + !> Returns arrays of the i- and j- sizes of the h-point computational domains for each !! element of the grid layout. Any input values in the extent arrays are discarded, so !! they are effectively intent out despite their declared intent of inout. diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index b25a934b97..0cdcc455fc 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -8,7 +8,7 @@ module MOM_domains use MOM_coms_infra, only : sum_across_PEs, min_across_PEs, max_across_PEs use MOM_domain_infra, only : MOM_domain_type, domain2D, domain1D, group_pass_type use MOM_domain_infra, only : create_MOM_domain, clone_MOM_domain, deallocate_MOM_domain -use MOM_domain_infra, only : get_domain_extent, get_domain_components +use MOM_domain_infra, only : get_domain_extent, get_domain_components, same_domain use MOM_domain_infra, only : compute_block_extent, get_global_shape use MOM_domain_infra, only : pass_var, pass_vector, fill_symmetric_edges, global_field_sum use MOM_domain_infra, only : pass_var_start, pass_var_complete @@ -33,8 +33,10 @@ module MOM_domains 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 :: get_domain_extent, get_domain_components, get_global_shape, same_domain public :: PE_here, root_PE, num_PEs +! Blocks are not actively used in MOM6, so this routine could be deprecated. +public :: compute_block_extent ! Single call communication routines public :: pass_var, pass_vector, fill_symmetric_edges, broadcast ! Non-blocking communication routines From 358da7cc44fdd0097008263a7ee21253da702b1b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 6 Apr 2021 18:30:15 -0400 Subject: [PATCH 3/3] Corrected comments describing CT_copy_data Corrected comments describing the various CT_copy_data routines, following suggestions in a review by Keith Lindsay. All answers are bitwise identical. --- config_src/infra/FMS1/MOM_couplertype_infra.F90 | 9 +++++---- config_src/infra/FMS2/MOM_couplertype_infra.F90 | 9 +++++---- src/framework/MOM_coupler_types.F90 | 9 +++++---- 3 files changed, 15 insertions(+), 12 deletions(-) diff --git a/config_src/infra/FMS1/MOM_couplertype_infra.F90 b/config_src/infra/FMS1/MOM_couplertype_infra.F90 index 2d6698b640..3bcccc1dc7 100644 --- a/config_src/infra/FMS1/MOM_couplertype_infra.F90 +++ b/config_src/infra/FMS1/MOM_couplertype_infra.F90 @@ -41,8 +41,9 @@ module MOM_couplertype_infra module procedure CT_destructor_1d, CT_destructor_2d end interface CT_destructor -!> Copy all elements of the data in of one coupler_2d_bc_type or coupler_3d_bc_type -!! into another. Both must have the same array sizes in common dimensions. +!> Copy all elements of the data in either a coupler_2d_bc_type or a coupler_3d_bc_type into +!! another structure of the same or the other type. Both must have the same array sizes in common +!! dimensions, while the details of any expansion from 2d to 3d are controlled by arguments. interface CT_copy_data module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d end interface CT_copy_data @@ -201,7 +202,7 @@ subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) end subroutine CT_spawn_3d_3d -!> Copy all elements of the data in of one coupler_2d_bc_type into another. Both must have the same array sizes. +!> Copy all elements of the data in a coupler_2d_bc_type into another. Both must have the same array sizes. subroutine CT_copy_data_2d(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 @@ -222,7 +223,7 @@ subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & exclude_flux_type, only_flux_type, pass_through_ice) end subroutine CT_copy_data_2d -!> Copy all elements of the data in of one coupler_3d_bc_type into another. Both must have the same array sizes. +!> Copy all elements of the data in a coupler_3d_bc_type into another. Both must have the same array sizes. subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & exclude_flux_type, only_flux_type, pass_through_ice) type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy diff --git a/config_src/infra/FMS2/MOM_couplertype_infra.F90 b/config_src/infra/FMS2/MOM_couplertype_infra.F90 index 2d6698b640..3bcccc1dc7 100644 --- a/config_src/infra/FMS2/MOM_couplertype_infra.F90 +++ b/config_src/infra/FMS2/MOM_couplertype_infra.F90 @@ -41,8 +41,9 @@ module MOM_couplertype_infra module procedure CT_destructor_1d, CT_destructor_2d end interface CT_destructor -!> Copy all elements of the data in of one coupler_2d_bc_type or coupler_3d_bc_type -!! into another. Both must have the same array sizes in common dimensions. +!> Copy all elements of the data in either a coupler_2d_bc_type or a coupler_3d_bc_type into +!! another structure of the same or the other type. Both must have the same array sizes in common +!! dimensions, while the details of any expansion from 2d to 3d are controlled by arguments. interface CT_copy_data module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d end interface CT_copy_data @@ -201,7 +202,7 @@ subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) end subroutine CT_spawn_3d_3d -!> Copy all elements of the data in of one coupler_2d_bc_type into another. Both must have the same array sizes. +!> Copy all elements of the data in a coupler_2d_bc_type into another. Both must have the same array sizes. subroutine CT_copy_data_2d(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 @@ -222,7 +223,7 @@ subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & exclude_flux_type, only_flux_type, pass_through_ice) end subroutine CT_copy_data_2d -!> Copy all elements of the data in of one coupler_3d_bc_type into another. Both must have the same array sizes. +!> Copy all elements of the data in a coupler_3d_bc_type into another. Both must have the same array sizes. subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & exclude_flux_type, only_flux_type, pass_through_ice) type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy diff --git a/src/framework/MOM_coupler_types.F90 b/src/framework/MOM_coupler_types.F90 index bb01755a84..73304f7fe8 100644 --- a/src/framework/MOM_coupler_types.F90 +++ b/src/framework/MOM_coupler_types.F90 @@ -38,8 +38,9 @@ module MOM_coupler_types module procedure CT_destructor_1d, CT_destructor_2d end interface coupler_type_destructor -!> Copy all elements of the data in of one coupler_2d_bc_type or coupler_3d_bc_type -!! into another. Both must have the same array sizes in common dimensions. +!> Copy all elements of the data in either a coupler_2d_bc_type or a coupler_3d_bc_type into +!! another structure of the same or the other type. Both must have the same array sizes in common +!! dimensions, while the details of any expansion from 2d to 3d are controlled by arguments. interface coupler_type_copy_data module procedure CT_copy_data_2d, CT_copy_data_3d, CT_copy_data_2d_3d end interface coupler_type_copy_data @@ -171,7 +172,7 @@ subroutine CT_spawn_3d_3d(var_in, var, idim, jdim, kdim, suffix, as_needed) end subroutine CT_spawn_3d_3d -!> Copy all elements of the data in of one coupler_2d_bc_type into another. Both must have the same array sizes. +!> Copy all elements of the data in a coupler_2d_bc_type into another. Both must have the same array sizes. subroutine CT_copy_data_2d(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 @@ -192,7 +193,7 @@ subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & exclude_flux_type, only_flux_type, pass_through_ice) end subroutine CT_copy_data_2d -!> Copy all elements of the data in of one coupler_3d_bc_type into another. Both must have the same array sizes. +!> Copy all elements of the data in a coupler_3d_bc_type into another. Both must have the same array sizes. subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & exclude_flux_type, only_flux_type, pass_through_ice) type(coupler_3d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy