coupler_types.F90

!***********************************************************************
!*                   GNU Lesser General Public License
!*
!* This file is part of the GFDL Flexible Modeling System (FMS).
!*
!* FMS is free software: you can redistribute it and/or modify it under
!* the terms of the GNU Lesser General Public License as published by
!* the Free Software Foundation, either version 3 of the License, or (at
!* your option) any later version.
!*
!* FMS is distributed in the hope that it will be useful, but WITHOUT
!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
!* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
!* for more details.
!*
!* You should have received a copy of the GNU Lesser General Public
!* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
!***********************************************************************
!> @defgroup coupler_types_mod coupler_types_mod
!> @ingroup coupler
!> @brief This module contains type declarations for the coupler.
!> @author Richard Slater, John Dunne
 
!> @addtogroup coupler_types_mod
!> @{
module coupler_types_mod
  use fms_mod,           only: write_version_number, lowercase
  use fms2_io_mod,       only: fmsnetcdfdomainfile_t, open_file, register_restart_field
  use fms2_io_mod,       only: register_axis, unlimited, variable_exists, check_if_open
  use fms2_io_mod,       only: register_field, get_num_dimensions, variable_att_exists
  use fms2_io_mod,       only: get_variable_attribute, get_dimension_size, get_dimension_names
  use fms2_io_mod,       only: register_variable_attribute, get_variable_dimension_names
  use fms2_io_mod,       only: get_variable_num_dimensions
  use time_manager_mod,  only: time_type
  use diag_manager_mod,  only: register_diag_field, send_data
  use data_override_mod, only: data_override
  use mpp_domains_mod,   only: domain2d, mpp_redistribute
  use mpp_mod,           only: mpp_error, fatal, mpp_chksum
  use fms_string_utils_mod,  only: string
  use platform_mod,      only: r4_kind, r8_kind, i8_kind, fms_file_len, fms_path_len
 
  implicit none
  private
 
 
  ! Include variable "version" to be written to log file.
#include<file_version.h>
 
  public coupler_types_init
  public coupler_type_copy, coupler_type_spawn, coupler_type_set_diags
  public coupler_type_write_chksums, coupler_type_send_data, coupler_type_data_override
  public coupler_type_register_restarts, coupler_type_restore_state
  public coupler_type_increment_data, coupler_type_rescale_data
  public coupler_type_copy_data, coupler_type_redistribute_data
  public coupler_type_destructor, coupler_type_initialized
  public coupler_type_extract_data, coupler_type_set_data
 
  public coupler_type_copy_1d_2d
  public coupler_type_copy_1d_3d
 
  character(len=*), parameter :: mod_name = 'coupler_types_mod'
 
!> @}
 
  !! mixed precision methodology for the encapsulated types:
  !!
  !!                      bc(:) (coupler_nd_real8_field) -> field(:) (coupler_nd_real8_values)
  !! coupler_nd_bc_type <
  !!                      bc_r4(:) (coupler_nd_real4_field) -> field(:) (coupler_nd_real4_values)
  !!
  !! Arrays (values + field) are typically directly allocated and then 'spawn' can be used to create a new type
  !! from a previously allocated 'template' type
 
  !> Coupler data for 3D values
  !> @ingroup coupler_types_mod
  type, public :: coupler_3d_real8_values_type
    character(len=48)       :: name = ' '  !< The diagnostic name for this array
    logical                 :: mean = .true. !< mean
    logical                 :: override = .false. !< override
    integer                 :: id_diag = 0 !< The diagnostic id for this array
    character(len=128)      :: long_name = ' ' !< The diagnostic long_name for this array
    character(len=128)      :: units = ' ' !< The units for this array
    integer                 :: id_rest = 0 !< The id of this array in the restart field
    logical                 :: may_init = .true. !< If true, there is an internal method
                                           !! that can be used to initialize this field
                                           !! if it can not be read from a restart file
    real(r8_kind), pointer, contiguous, dimension(:,:,:) :: values => null() !< The pointer to the
                                           !! array of values for this field; this
                                           !! should be changed to allocatable
  end type coupler_3d_real8_values_type
 
  !> Coupler data for 3D fields
  !> @ingroup coupler_types_mod
  type, public :: coupler_3d_real8_field_type
    character(len=48)                 :: name = ' ' !< name
    integer                           :: num_fields = 0 !< num_fields
    type(coupler_3d_real8_values_type), pointer, dimension(:) :: field => null() !< field
    character(len=128)                :: flux_type = ' ' !< flux_type
    character(len=128)                :: implementation = ' ' !< implementation
    logical, pointer, dimension(:)    :: flag => null() !< flag
    integer                           :: atm_tr_index = 0 !< atm_tr_index
    character(len=FMS_FILE_LEN)       :: ice_restart_file = ' ' !< ice_restart_file
    character(len=FMS_FILE_LEN)       :: ocean_restart_file = ' ' !< ocean_restart_file
    type(fmsnetcdfdomainfile_t), pointer :: fms2_io_rest_type => null() !< A pointer to the restart_file_type
                                                                        !! That is used for this field
    logical                           :: use_atm_pressure !< use_atm_pressure
    logical                           :: use_10m_wind_speed !< use_10m_wind_speed
    logical                           :: pass_through_ice !< pass_through_ice
    real(r8_kind), pointer, dimension(:)       :: param => null() !< param
    real(r8_kind)                              :: mol_wt = 0.0_r8_kind !< mol_wt
  end type coupler_3d_real8_field_type
 
  !> Coupler data for 3D values
  !> @ingroup coupler_types_mod
  type, public :: coupler_3d_real4_values_type
    character(len=48)       :: name = ' '  !< The diagnostic name for this array
    logical                 :: mean = .true. !< mean
    logical                 :: override = .false. !< override
    integer                 :: id_diag = 0 !< The diagnostic id for this array
    character(len=128)      :: long_name = ' ' !< The diagnostic long_name for this array
    character(len=128)      :: units = ' ' !< The units for this array
    integer                 :: id_rest = 0 !< The id of this array in the restart field
    logical                 :: may_init = .true. !< If true, there is an internal method
                                           !! that can be used to initialize this field
                                           !! if it can not be read from a restart file
    real(r4_kind), pointer, contiguous, dimension(:,:,:) :: values => null() !< The pointer to the
                                           !! array of values for this field; this
                                           !! should be changed to allocatable
  end type coupler_3d_real4_values_type
 
  !> Coupler data for 3D fields
  !> @ingroup coupler_types_mod
  type, public :: coupler_3d_real4_field_type
    character(len=48)                 :: name = ' ' !< name
    integer                           :: num_fields = 0 !< num_fields
    type(coupler_3d_real4_values_type), pointer, dimension(:) :: field => null() !< field
    character(len=128)                :: flux_type = ' ' !< flux_type
    character(len=128)                :: implementation = ' ' !< implementation
    logical, pointer, dimension(:)    :: flag => null() !< flag
    integer                           :: atm_tr_index = 0 !< atm_tr_index
    character(len=FMS_FILE_LEN)       :: ice_restart_file = ' ' !< ice_restart_file
    character(len=FMS_FILE_LEN)       :: ocean_restart_file = ' ' !< ocean_restart_file
    type(fmsnetcdfdomainfile_t), pointer :: fms2_io_rest_type => null() !< A pointer to the restart_file_type
                                                                        !! That is used for this field
    logical                           :: use_atm_pressure !< use_atm_pressure
    logical                           :: use_10m_wind_speed !< use_10m_wind_speed
    logical                           :: pass_through_ice !< pass_through_ice
    !> precision needs to be r8_kind since this array is retrieved from the field_manager routine
    !! fm_util_get_real_array which only returns a r8_kind
    !! Might be able to change to allocatable(?) to do a conversion
    real(r8_kind), pointer, dimension(:)       :: param => null() !< param
    real(r8_kind)                              :: mol_wt = 0.0_r8_kind !< mol_wt
  end type coupler_3d_real4_field_type
 
  !> Coupler data for 3D boundary conditions
  !> @ingroup coupler_types_mod
  type, public :: coupler_3d_bc_type
    integer                                            :: num_bcs = 0  !< The number of boundary condition fields
    type(coupler_3d_real8_field_type), dimension(:), pointer :: bc => null() !< A pointer to the array of boundary
                                                    !! TODO above should be renamed eventually to indicate kind=8
    type(coupler_3d_real4_field_type), dimension(:), pointer :: bc_r4 => null() !< A pointer to the array of boundary
    logical    :: set = .false.       !< If true, this type has been initialized
    integer    :: isd, isc, iec, ied  !< The i-direction data and computational domain index ranges for this type
    integer    :: jsd, jsc, jec, jed  !< The j-direction data and computational domain index ranges for this type
    integer    :: ks, ke              !< The k-direction index ranges for this type
  end type coupler_3d_bc_type
 
 
  !> Coupler data for 2D values
  !> @ingroup coupler_types_mod
  type, public    :: coupler_2d_real8_values_type
    character(len=48)       :: name = ' '  !< The diagnostic name for this array
    real(r8_kind), pointer, contiguous, dimension(:,:) :: values => null() !< The pointer to the
                                           !! array of values for this field; this
                                           !! should be changed to allocatable
    logical                 :: mean = .true. !< mean
    logical                 :: override = .false. !< override
    integer                 :: id_diag = 0 !< The diagnostic id for this array
    character(len=128)      :: long_name = ' ' !< The diagnostic long_name for this array
    character(len=128)      :: units = ' ' !< The units for this array
    integer                 :: id_rest = 0 !< The id of this array in the restart field
    logical                 :: may_init = .true. !< If true, there is an internal method
                                           !! that can be used to initialize this field
                                           !! if it can not be read from a restart file
  end type coupler_2d_real8_values_type
 
  !> Coupler data for 2D fields
  !> @ingroup coupler_types_mod
  type, public    :: coupler_2d_real8_field_type
    character(len=48)                 :: name = ' ' !< name
    integer                           :: num_fields = 0 !< num_fields
    type(coupler_2d_real8_values_type), pointer, dimension(:)   :: field => null() !< field
    character(len=128)                :: flux_type = ' ' !< flux_type
    character(len=128)                :: implementation = ' ' !< implementation
    real(r8_kind), pointer, dimension(:)       :: param => null() !< param
    logical, pointer, dimension(:)    :: flag => null() !< flag
    integer                           :: atm_tr_index = 0 !< atm_tr_index
    character(len=FMS_FILE_LEN)       :: ice_restart_file = ' ' !< ice_restart_file
    character(len=FMS_FILE_LEN)       :: ocean_restart_file = ' ' !< ocean_restart_file
    type(fmsnetcdfdomainfile_t), pointer :: fms2_io_rest_type => null() !< A pointer to the restart_file_type
                                                                        !! That is used for this field
    logical                           :: use_atm_pressure !< use_atm_pressure
    logical                           :: use_10m_wind_speed !< use_10m_wind_speed
    logical                           :: pass_through_ice !< pass_through_ice
    real(r8_kind)                              :: mol_wt = 0.0_r8_kind !< mol_wt
  end type coupler_2d_real8_field_type
 
  !> Coupler data for 2D values
  !> @ingroup coupler_types_mod
  type, public    :: coupler_2d_real4_values_type
    character(len=44)       :: name = ' '  !< The diagnostic name for this array
    real(r4_kind), pointer, contiguous, dimension(:,:) :: values => null() !< The pointer to the
                                           !! array of values for this field; this
                                           !! should be changed to allocatable
    logical                 :: mean = .true. !< mean
    logical                 :: override = .false. !< override
    integer                 :: id_diag = 0 !< The diagnostic id for this array
    character(len=124)      :: long_name = ' ' !< The diagnostic long_name for this array
    character(len=124)      :: units = ' ' !< The units for this array
    integer                 :: id_rest = 0 !< The id of this array in the restart field
    logical                 :: may_init = .true. !< If true, there is an internal method
                                           !! that can be used to initialize this field
                                           !! if it can not be read from a restart file
  end type coupler_2d_real4_values_type
 
  !> Coupler data for 2D fields
  !> @ingroup coupler_types_mod
  type, public    :: coupler_2d_real4_field_type
    character(len=44)                 :: name = ' ' !< name
    integer                           :: num_fields = 0 !< num_fields
    type(coupler_2d_real4_values_type), pointer, dimension(:)   :: field => null() !< field
    character(len=124)                :: flux_type = ' ' !< flux_type
    character(len=124)                :: implementation = ' ' !< implementation
    !> precision needs to be r8_kind since this array is retrieved from the field_manager routine
    !! fm_util_get_real_array which only returns a r8_kind
    !! Might be able to change to allocatable(?) to do a conversion
    real(r8_kind), pointer, dimension(:)       :: param => null() !< param
    logical, pointer, dimension(:)    :: flag => null() !< flag
    integer                           :: atm_tr_index = 0 !< atm_tr_index
    character(len=FMS_FILE_LEN)       :: ice_restart_file = ' ' !< ice_restart_file
    character(len=FMS_FILE_LEN)       :: ocean_restart_file = ' ' !< ocean_restart_file
    type(fmsnetcdfdomainfile_t), pointer :: fms2_io_rest_type => null() !< A pointer to the restart_file_type
                                                                        !! That is used for this field
    logical                           :: use_atm_pressure !< use_atm_pressure
    logical                           :: use_10m_wind_speed !< use_10m_wind_speed
    logical                           :: pass_through_ice !< pass_through_ice
    real(r8_kind)                              :: mol_wt = 0.0_r8_kind !< mol_wt
  end type coupler_2d_real4_field_type
 
  !> Coupler data for 2D boundary conditions
  !> @ingroup coupler_types_mod
  type, public    :: coupler_2d_bc_type
    integer                                            :: num_bcs = 0  !< The number of boundary condition fields
    type(coupler_2d_real8_field_type), dimension(:), pointer :: bc => null() !< A pointer to the array of boundary
                                                                       !! condition fields
    type(coupler_2d_real4_field_type), dimension(:), pointer :: bc_r4 => null() !< A pointer to the array of boundary
                                                                       !! condition fields
    logical    :: set = .false.       !< If true, this type has been initialized
    integer    :: isd, isc, iec, ied  !< The i-direction data and computational domain index ranges for this type
    integer    :: jsd, jsc, jec, jed  !< The j-direction data and computational domain index ranges for this type
  end type coupler_2d_bc_type
 
  !> Coupler data for 1D values
  !> @ingroup coupler_types_mod
  type, public    :: coupler_1d_real8_values_type
    character(len=48)           :: name = ' '  !< The diagnostic name for this array
    real(r8_kind), pointer, dimension(:) :: values => null() !< The pointer to the array of values
    logical                     :: mean = .true. !< mean
    logical                     :: override = .false. !< override
    integer                     :: id_diag = 0 !< The diagnostic id for this array
    character(len=128)          :: long_name = ' ' !< The diagnostic long_name for this array
    character(len=128)          :: units = ' ' !< The units for this array
    logical                     :: may_init = .true. !< If true, there is an internal method
                                               !! that can be used to initialize this field
                                               !! if it can not be read from a restart file
  end type coupler_1d_real8_values_type
 
  !> Coupler data for 1D fields
  !> @ingroup coupler_types_mod
  type, public    :: coupler_1d_real8_field_type
    character(len=48)              :: name = ' ' !< name
    integer                        :: num_fields = 0 !< num_fields
    type(coupler_1d_real8_values_type), pointer, dimension(:)   :: field => null() !< field
    character(len=128)             :: flux_type = ' ' !< flux_type
    character(len=128)             :: implementation = ' ' !< implementation
    !> precision has been explicitly defined
    !! to be r8_kind during mixedmode update to field_manager
    !! this explicit definition can be removed during the coupler update and be made into FMS_CP_KIND_
    real(r8_kind), pointer, dimension(:) :: param => null() !< param
    logical, pointer, dimension(:) :: flag => null() !< flag
    integer                        :: atm_tr_index = 0 !< atm_tr_index
    character(len=FMS_FILE_LEN)    :: ice_restart_file = ' ' !< ice_restart_file
    character(len=FMS_FILE_LEN)    :: ocean_restart_file = ' ' !< ocean_restart_file
    logical                        :: use_atm_pressure !< use_atm_pressure
    logical                        :: use_10m_wind_speed !< use_10m_wind_speed
    logical                        :: pass_through_ice !< pass_through_ice
    !> precision has been explicitly defined
    !! to be r8_kind during mixedmode update to field_manager
    !! this explicit definition can be removed during the coupler update and be made into FMS_CP_KIND_
    real(r8_kind)                  :: mol_wt = 0.0_r8_kind !< mol_wt
 
 end type coupler_1d_real8_field_type
 
  !> Coupler data for 1D values
  !> @ingroup coupler_types_mod
  type, public    :: coupler_1d_real4_values_type
    character(len=48)           :: name = ' '  !< The diagnostic name for this array
    real(r4_kind), pointer, dimension(:) :: values => null() !< The pointer to the array of values
    logical                     :: mean = .true. !< mean
    logical                     :: override = .false. !< override
    integer                     :: id_diag = 0 !< The diagnostic id for this array
    character(len=128)          :: long_name = ' ' !< The diagnostic long_name for this array
    character(len=128)          :: units = ' ' !< The units for this array
    logical                     :: may_init = .true. !< If true, there is an internal method
                                               !! that can be used to initialize this field
                                               !! if it can not be read from a restart file
  end type coupler_1d_real4_values_type
 
  !> Coupler data for 1D fields
  !> @ingroup coupler_types_mod
  type, public    :: coupler_1d_real4_field_type
    character(len=48)              :: name = ' ' !< name
    integer                        :: num_fields = 0 !< num_fields
    type(coupler_1d_real4_values_type), pointer, dimension(:)   :: field => null() !< field
    character(len=128)             :: flux_type = ' ' !< flux_type
    character(len=128)             :: implementation = ' ' !< implementation
    !> precision needs to be r8_kind since this array is retrieved from the field_manager routine
    !! fm_util_get_real_array which only returns a r8_kind
    !! Might be able to change to allocatable(?) to do a conversion
    real(r8_kind), pointer, dimension(:) :: param => null() !< param
    logical, pointer, dimension(:) :: flag => null() !< flag
    integer                        :: atm_tr_index = 0 !< atm_tr_index
    character(len=FMS_FILE_LEN)    :: ice_restart_file = ' ' !< ice_restart_file
    character(len=FMS_FILE_LEN)    :: ocean_restart_file = ' ' !< ocean_restart_file
    logical                        :: use_atm_pressure !< use_atm_pressure
    logical                        :: use_10m_wind_speed !< use_10m_wind_speed
    logical                        :: pass_through_ice !< pass_through_ice
    !> This is also read in r8 from the field manager, but since its not a pointer the conversion is allowed
    real(r8_kind)                  :: mol_wt = 0.0_r8_kind !< mol_wt
 
 end type coupler_1d_real4_field_type
 
  !> Coupler data for 1D boundary conditions
  !> @ingroup coupler_types_mod
  type, public    :: coupler_1d_bc_type
    integer                                            :: num_bcs = 0  !< The number of boundary condition fields
    type(coupler_1d_real8_field_type), dimension(:), pointer :: bc => null() !< A pointer to the array of boundary
                                                                       !! condition fields
    type(coupler_1d_real4_field_type), dimension(:), pointer :: bc_r4 => null() !< A pointer to the array of boundary
                                                                       !! condition fields
    logical    :: set = .false.       !< If true, this type has been initialized
  end type coupler_1d_bc_type
 
  !> @addtogroup coupler_types_mod
  !> @{
  ! The following public parameters can help in selecting the sub-elements of a
  ! coupler type.  There are duplicate values because different boundary
  ! conditions have different sub-elements.
  ! Note: These should be parameters, but doing so would break openMP directives.
  integer, public :: ind_pcair = 1 !< The index of the atmospheric concentration
  integer, public :: ind_u10 = 2   !< The index of the 10 m wind speed
  integer, public :: ind_psurf = 3 !< The index of the surface atmospheric pressure
  integer, public :: ind_alpha = 1 !< The index of the solubility array for a tracer
  integer, public :: ind_csurf = 2 !< The index of the ocean surface concentration
  integer, public :: ind_sc_no = 3 !< The index for the Schmidt number for a tracer flux
  integer, public :: ind_flux = 1  !< The index for the tracer flux
  integer, public :: ind_deltap= 2 !< The index for ocean-air gas partial pressure change
  integer, public :: ind_kw = 3    !< The index for the piston velocity
  integer, public :: ind_flux0 = 4 !< The index for the piston velocity
  integer, public :: ind_deposition = 1 !< The index for the atmospheric deposition flux
  integer, public :: ind_runoff = 1 !< The index for a runoff flux
  !> @}
 
  ! Interface definitions for overloaded routines
 
  !> This is the interface to spawn one coupler_bc_type into another and then
  !! register diagnostics associated with the new type.
  !> @ingroup coupler_types_mod
  interface  coupler_type_copy
    module procedure coupler_type_copy_1d_2d, coupler_type_copy_1d_3d
    module procedure coupler_type_copy_2d_2d, coupler_type_copy_2d_3d
    module procedure coupler_type_copy_3d_2d, coupler_type_copy_3d_3d
  end interface coupler_type_copy
 
  !> This is the interface to spawn one coupler_bc_type into another.
  !> @ingroup coupler_types_mod
  interface  coupler_type_spawn
    module procedure ct_spawn_1d_2d, ct_spawn_2d_2d, ct_spawn_3d_2d
    module procedure ct_spawn_1d_3d, ct_spawn_2d_3d, ct_spawn_3d_3d
  end interface coupler_type_spawn
 
  !> This is the interface to copy the field data from one coupler_bc_type
  !! to another of the same rank, size and decomposition.
  !> @ingroup coupler_types_mod
  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
 
  !> This is the interface to redistribute the field data from one coupler_bc_type
  !! to another of the same rank and global size, but a different decomposition.
  !> @ingroup coupler_types_mod
  interface coupler_type_redistribute_data
    module procedure ct_redistribute_data_2d, ct_redistribute_data_3d
  end interface coupler_type_redistribute_data
 
  !> This is the interface to rescale the field data in a coupler_bc_type.
  !> @ingroup coupler_types_mod
  interface coupler_type_rescale_data
    module procedure ct_rescale_data_2d_r4, ct_rescale_data_3d_r4
    module procedure ct_rescale_data_2d_r8, ct_rescale_data_3d_r8
  end interface coupler_type_rescale_data
 
  !> This is the interface to increment the field data from one coupler_bc_type
  !! with the data from another.  Both must have the same horizontal size and
  !! decomposition, but a 2d type may be incremented by a 2d or 3d type
  !> @ingroup coupler_types_mod
  interface coupler_type_increment_data
    module procedure ct_increment_data_2d_2d, ct_increment_data_3d_3d
    module procedure ct_increment_data_2d_3d_r4, ct_increment_data_2d_3d_r8
  end interface coupler_type_increment_data
 
  !> This is the interface to extract a field in a coupler_bc_type into an array.
  !> @ingroup coupler_types_mod
  interface coupler_type_extract_data
    module procedure ct_extract_data_2d_r4, ct_extract_data_2d_r8
    module procedure ct_extract_data_3d_r4, ct_extract_data_3d_r8
    module procedure ct_extract_data_3d_2d_r4, ct_extract_data_3d_2d_r8
  end interface coupler_type_extract_data
 
  !> This is the interface to set a field in a coupler_bc_type from an array.
  !> @ingroup coupler_types_mod
  interface coupler_type_set_data
    module procedure ct_set_data_2d_r4, ct_set_data_3d_r4, ct_set_data_2d_3d_r4
    module procedure ct_set_data_2d_r8, ct_set_data_3d_r8, ct_set_data_2d_3d_r8
  end interface coupler_type_set_data
 
  !> This is the interface to set diagnostics for the arrays in a coupler_bc_type.
  !> @ingroup coupler_types_mod
  interface coupler_type_set_diags
    module procedure ct_set_diags_2d, ct_set_diags_3d
  end interface coupler_type_set_diags
 
  !> This is the interface to write out checksums for the elements of a coupler_bc_type.
  !> @ingroup coupler_types_mod
  interface coupler_type_write_chksums
    module procedure ct_write_chksums_2d, ct_write_chksums_3d
  end interface coupler_type_write_chksums
 
  !> This is the interface to write out diagnostics of the arrays in a coupler_bc_type.
  !> @ingroup coupler_types_mod
  interface coupler_type_send_data
    module procedure ct_send_data_2d, ct_send_data_3d
  end interface coupler_type_send_data
 
  !> This is the interface to override the values of the arrays in a coupler_bc_type.
  !> @ingroup coupler_types_mod
  interface coupler_type_data_override
    module procedure ct_data_override_2d, ct_data_override_3d
  end interface coupler_type_data_override
 
  !> This is the interface to register the fields in a coupler_bc_type to be saved
  !! in restart files.
  !> @ingroup coupler_types_mod
  interface coupler_type_register_restarts
    module procedure ct_register_restarts_2d, ct_register_restarts_3d
  end interface coupler_type_register_restarts
 
  !> This is the interface to read in the fields in a coupler_bc_type that have
  !! been saved in restart files.
  !> @ingroup coupler_types_mod
  interface coupler_type_restore_state
    module procedure ct_restore_state_2d, ct_restore_state_3d
  end interface coupler_type_restore_state
 
  !> This function interface indicates whether a coupler_bc_type has been initialized.
  !> @ingroup coupler_types_mod
  interface coupler_type_initialized
    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.
  !> @ingroup coupler_types_mod
  interface coupler_type_destructor
    module procedure ct_destructor_1d, ct_destructor_2d, ct_destructor_3d
  end interface coupler_type_destructor
 
contains
 
!> @addtogroup coupler_types_mod
!> @{
 
  !> @brief Initialize the coupler types
  subroutine coupler_types_init
 
    logical, save   :: module_is_initialized = .false.
 
    ! Return if already initialized
    if (module_is_initialized) then
      return
    endif
 
    ! Write out the version of the file to the log file.
    call write_version_number(trim(mod_name), version)
 
    module_is_initialized = .true.
 
    return
  end subroutine  coupler_types_init  !}
 
 
  !> @brief Copy fields from one coupler type to another. 1-D to 2-D version for generic coupler_type_copy.
  !!
  !! @throw FATAL, "Number of output fields exceeds zero"
  subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je,&
      & diag_name, axes, time, suffix)
    type(coupler_1d_bc_type), intent(in)    :: var_in !< variable to copy information from
    type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to
    integer, intent(in)                     :: is !< lower bound of first dimension
    integer, intent(in)                     :: ie !< upper bound of first dimension
    integer, intent(in)                     :: js !< lower bound of second dimension
    integer, intent(in)                     :: je !< upper bound of second dimension
    character(len=*), intent(in)            :: diag_name !< name for diagnostic file--if blank, then
                                                         !! don't 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
    character(len=*), intent(in), optional  :: suffix !< optional suffix to make the name identifier unique
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (coupler_type_copy_1d_2d):'
 
    if (var_out%num_bcs > 0) then
      ! It is an error if the number of output fields exceeds zero, because it means this
      ! type has already been populated.
      call mpp_error(fatal, trim(error_header) // ' Number of output fields exceeds zero')
    endif
 
    if (var_in%num_bcs >= 0)&
        & call ct_spawn_1d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix)
 
    if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' '))&
        & call ct_set_diags_2d(var_out, diag_name, axes, time)
  end subroutine  coupler_type_copy_1d_2d
 
  !> @brief Copy fields from one coupler type to another. 1-D to 3-D version for generic coupler_type_copy.
  !!
  !!
  !! @throw FATAL, "Number of output fields is exceeds zero"
  subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd,&
      & diag_name, axes, time, suffix)
    type(coupler_1d_bc_type), intent(in)    :: var_in !< variable to copy information from
    type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to
    integer, intent(in)                     :: is !< lower bound of first dimension
    integer, intent(in)                     :: ie !< upper bound of first dimension
    integer, intent(in)                     :: js !< lower bound of second dimension
    integer, intent(in)                     :: je !< upper bound of second dimension
    integer, intent(in)                     :: kd !< third dimension
    character(len=*), intent(in)            :: diag_name !< name for diagnostic file--if blank, then
                                                         !! don't 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
    character(len=*), intent(in), optional  :: suffix !< optional suffix to make the name identifier unique
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (coupler_type_copy_1d_3d):'
 
    if (var_out%num_bcs > 0) then
      ! It is an error if the number of output fields exceeds zero, because it means this
      ! type has already been populated.
      call mpp_error(fatal, trim(error_header) // ' Number of output fields exceeds zero')
    endif
 
    if (var_in%num_bcs >= 0)&
        & call ct_spawn_1d_3d(var_in, var_out,  (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix)
 
    if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' '))&
        & call ct_set_diags_3d(var_out, diag_name, axes, time)
  end subroutine  coupler_type_copy_1d_3d
 
  !> @brief Copy fields from one coupler type to another. 2-D to 2-D version for generic coupler_type_copy.
  !!
  !! @throw FATAL, "Number of output fields is exceeds zero"
  subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je,&
      & diag_name, axes, time, suffix)
    type(coupler_2d_bc_type), intent(in)    :: var_in !< variable to copy information from
    type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to
    integer, intent(in)                     :: is !< lower bound of first dimension
    integer, intent(in)                     :: ie !< upper bound of first dimension
    integer, intent(in)                     :: js !< lower bound of second dimension
    integer, intent(in)                     :: je !< upper bound of second dimension
    character(len=*), intent(in)            :: diag_name !< name for diagnostic file--if blank, then
                                                         !! don't 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
    character(len=*), intent(in), optional  :: suffix !< optional suffix to make the name identifier unique
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (coupler_type_copy_2d_2d):'
 
    if (var_out%num_bcs > 0) then
      ! It is an error if the number of output fields exceeds zero, because it means this
      ! type has already been populated.
      call mpp_error(fatal, trim(error_header) // ' Number of output fields exceeds zero')
    endif
 
    if (var_in%num_bcs >= 0)&
        & call ct_spawn_2d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix)
 
    if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' '))&
        & call ct_set_diags_2d(var_out, diag_name, axes, time)
  end subroutine  coupler_type_copy_2d_2d
 
  !> @brief Copy fields from one coupler type to another. 2-D to 3-D version for generic coupler_type_copy.
  !!
  !! @throw FATAL, "Number of output fields is exceeds zero"
  subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd,&
      & diag_name, axes, time, suffix)
    type(coupler_2d_bc_type), intent(in)    :: var_in !< variable to copy information from
    type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to
    integer, intent(in)                     :: is !< lower bound of first dimension
    integer, intent(in)                     :: ie !< upper bound of first dimension
    integer, intent(in)                     :: js !< lower bound of second dimension
    integer, intent(in)                     :: je !< upper bound of second dimension
    integer, intent(in)                     :: kd !< third dimension
    character(len=*), intent(in)            :: diag_name !< name for diagnostic file--if blank, then
                                                         !! don't 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
    character(len=*), intent(in), optional  :: suffix !< optional suffix to make the name identifier unique
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (coupler_type_copy_2d_3d):'
 
    if (var_out%num_bcs > 0) then
      ! It is an error if the number of output fields exceeds zero, because it means this
      ! type has already been populated.
      call mpp_error(fatal, trim(error_header) // ' Number of output fields exceeds zero')
    endif
 
    if (var_in%num_bcs >= 0)&
        & call ct_spawn_2d_3d(var_in, var_out,  (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix)
 
    if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' '))&
        & call ct_set_diags_3d(var_out, diag_name, axes, time)
  end subroutine  coupler_type_copy_2d_3d
 
  !> @brief Copy fields from one coupler type to another. 3-D to 2-D version for generic coupler_type_copy.
  !!
  !! @throw FATAL, "Number of output fields is exceeds zero"
  subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je,&
      & diag_name, axes, time, suffix)
    type(coupler_3d_bc_type), intent(in)    :: var_in !< variable to copy information from
    type(coupler_2d_bc_type), intent(inout) :: var_out !< variable to copy information to
    integer, intent(in)                     :: is !< lower bound of first dimension
    integer, intent(in)                     :: ie !< upper bound of first dimension
    integer, intent(in)                     :: js !< lower bound of second dimension
    integer, intent(in)                     :: je !< upper bound of second dimension
    character(len=*), intent(in)            :: diag_name !< name for diagnostic file--if blank, then
                                                         !! don't 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
    character(len=*), intent(in), optional  :: suffix !< optional suffix to make the name identifier unique
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (coupler_type_copy_3d_2d):'
 
    if (var_out%num_bcs > 0) then
      ! It is an error if the number of output fields exceeds zero, because it means this
      ! type has already been populated.
      call mpp_error(fatal, trim(error_header) // ' Number of output fields exceeds zero')
    endif
 
    if (var_in%num_bcs >= 0)&
        & call ct_spawn_3d_2d(var_in, var_out, (/ is, is, ie, ie /), (/ js, js, je, je /), suffix)
 
    if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' '))&
        & call ct_set_diags_2d(var_out, diag_name, axes, time)
  end subroutine  coupler_type_copy_3d_2d
 
  !> @brief Copy fields from one coupler type to another. 3-D to 3-D version for generic coupler_type_copy.
  !!
  !! @throw FATAL, "Number of output fields exceeds zero"
  subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd,&
      & diag_name, axes, time, suffix)
    type(coupler_3d_bc_type), intent(in)    :: var_in !< variable to copy information from
    type(coupler_3d_bc_type), intent(inout) :: var_out !< variable to copy information to
    integer, intent(in)                     :: is !< lower bound of first dimension
    integer, intent(in)                     :: ie !< upper bound of first dimension
    integer, intent(in)                     :: js !< lower bound of second dimension
    integer, intent(in)                     :: je !< upper bound of second dimension
    integer, intent(in)                     :: kd !< third dimension
    character(len=*), intent(in)            :: diag_name !< name for diagnostic file--if blank, then
                                                         !! don't 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
    character(len=*), intent(in), optional  :: suffix !< optional suffix to make the name identifier unique
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (coupler_type_copy_3d_3d):'
 
    if (var_out%num_bcs > 0) then
      ! It is an error if the number of output fields exceeds zero, because it means this
      ! type has already been populated.
      call mpp_error(fatal, trim(error_header) // ' Number of output fields exceeds zero')
    endif
 
    if (var_in%num_bcs >= 0)&
        & call ct_spawn_3d_3d(var_in, var_out,  (/ is, is, ie, ie /), (/ js, js, je, je /), (/1, kd/), suffix)
 
    if ((var_out%num_bcs > 0) .and. (diag_name .ne. ' '))&
        & call ct_set_diags_3d(var_out, diag_name, axes, time)
  end subroutine  coupler_type_copy_3d_3d
 
 
  !> @brief Generate one coupler type using another as a template. 1-D to 2-D version for generic coupler_type_spawn.
  !!
  !! @throw FATAL, "The output type has already been initialized"
  !! @throw FATAL, "The parent type has not been initialized"
  !! @throw FATAL, "Disordered i-dimension index bound list"
  !! @throw FATAL, "Disordered j-dimension index bound list"
  !! @throw FATAL, "var%bc already assocated"
  !! @throw FATAL, "var%bc('n')%field already associated"
  !! @throw FATAL, "var%bc('n')%field('m')%values already associated"
  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.
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (CT_spawn_1d_2d):'
    character(len=400)      :: error_msg
    integer                 :: m, n
 
    if (present(as_needed)) then
      if (as_needed) then
        if ((var%set) .or. (.not.var_in%set)) return
      endif
    endif
 
    if (var%set)&
        & call mpp_error(fatal, trim(error_header) // ' The output type has already been initialized.')
    if (.not.var_in%set)&
        & call mpp_error(fatal, trim(error_header) // ' The parent type has not been initialized.')
 
    ! check only one kind is used
    if(var_in%num_bcs .gt. 0) then
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both initialized,"//&
                         " only one should be associated per type.")
        else
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both uninitialized,"//&
                               " one must be associated to copy field data.")
        endif
      endif
    endif
 
    var%num_bcs = var_in%num_bcs
    var%set = .true.
 
    if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim
      call mpp_error(fatal, trim(error_msg))
    endif
    if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list  ', jdim
      call mpp_error(fatal, trim(error_msg))
    endif
    var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4)
    var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4)
 
    if (var%num_bcs > 0) then
      if (associated(var_in%bc)) then
        if (associated(var%bc)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc already associated')
        endif
        allocate ( var%bc(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc(n)%name = var_in%bc(n)%name
          var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index
          var%bc(n)%flux_type = var_in%bc(n)%flux_type
          var%bc(n)%implementation = var_in%bc(n)%implementation
          var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file
          var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file
          var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure
          var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed
          var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice
          var%bc(n)%mol_wt = var_in%bc(n)%mol_wt
          var%bc(n)%num_fields = var_in%bc(n)%num_fields
          if (associated(var%bc(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc(n)%field(var%bc(n)%num_fields) )
          do m = 1, var%bc(n)%num_fields
            if (present(suffix)) then
              var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix)
            else
              var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name
            endif
            var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name
            var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units
            var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init
            var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean
            if (associated(var%bc(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header),&
                  & ' var%bc(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) )
            var%bc(n)%field(m)%values(:,:) = 0.0_r8_kind
          enddo
        enddo
      else if( associated(var_in%bc_r4)) then
        if (associated(var%bc_r4)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc_r4 already associated')
        endif
        allocate ( var%bc_r4(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc_r4(n)%name = var_in%bc_r4(n)%name
          var%bc_r4(n)%atm_tr_index = var_in%bc_r4(n)%atm_tr_index
          var%bc_r4(n)%flux_type = var_in%bc_r4(n)%flux_type
          var%bc_r4(n)%implementation = var_in%bc_r4(n)%implementation
          var%bc_r4(n)%ice_restart_file = var_in%bc_r4(n)%ice_restart_file
          var%bc_r4(n)%ocean_restart_file = var_in%bc_r4(n)%ocean_restart_file
          var%bc_r4(n)%use_atm_pressure = var_in%bc_r4(n)%use_atm_pressure
          var%bc_r4(n)%use_10m_wind_speed = var_in%bc_r4(n)%use_10m_wind_speed
          var%bc_r4(n)%pass_through_ice = var_in%bc_r4(n)%pass_through_ice
          var%bc_r4(n)%mol_wt = var_in%bc_r4(n)%mol_wt
          var%bc_r4(n)%num_fields = var_in%bc_r4(n)%num_fields
          if (associated(var%bc_r4(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc_r4(n)%field(var%bc_r4(n)%num_fields) )
          do m = 1, var%bc_r4(n)%num_fields
            if (present(suffix)) then
              var%bc_r4(n)%field(m)%name = trim(var_in%bc_r4(n)%field(m)%name) // trim(suffix)
            else
              var%bc_r4(n)%field(m)%name = var_in%bc_r4(n)%field(m)%name
            endif
            var%bc_r4(n)%field(m)%long_name = var_in%bc_r4(n)%field(m)%long_name
            var%bc_r4(n)%field(m)%units = var_in%bc_r4(n)%field(m)%units
            var%bc_r4(n)%field(m)%may_init = var_in%bc_r4(n)%field(m)%may_init
            var%bc_r4(n)%field(m)%mean = var_in%bc_r4(n)%field(m)%mean
            if (associated(var%bc_r4(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header),&
                  & ' var%bc_r4(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc_r4(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) )
            var%bc_r4(n)%field(m)%values(:,:) = 0.0_r4_kind
          enddo
        enddo
      else
        call mpp_error(fatal, error_header//"passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
      endif
    endif
  end subroutine  ct_spawn_1d_2d
 
  !> @brief Generate one coupler type using another as a template. 1-D to 3-D version for generic CT_spawn.
  !!
  !! @throw FATAL, "The output type has already been initialized"
  !! @throw FATAL, "The parent type has not been initialized"
  !! @throw FATAL, "Disordered i-dimension index bound list"
  !! @throw FATAL, "Disordered j-dimension index bound list"
  !! @throw FATAL, "var%bc already assocated"
  !! @throw FATAL, "var%bc('n')%field already associated"
  !! @throw FATAL, "var%bc('n')%field('m')%values already associated"
  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.
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (CT_spawn_1d_3d):'
    character(len=400)      :: error_msg
    integer                 :: m, n
 
    if (present(as_needed)) then
      if (as_needed) then
        if ((var%set) .or. (.not.var_in%set)) return
      endif
    endif
 
    if (var%set)&
        & call mpp_error(fatal, trim(error_header) // ' The output type has already been initialized.')
    if (.not.var_in%set)&
        & call mpp_error(fatal, trim(error_header) // ' The parent type has not been initialized.')
 
    ! check only one kind is used
    if(var_in%num_bcs .gt. 0) then
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc)) then
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both initialized,"// &
                                " only one should be associated per type")
        else
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both uninitialized,"// &
                                " one must be associated to copy field data")
        endif
      endif
    endif
 
    var%num_bcs = var_in%num_bcs
    var%set = .true.
 
    ! Store the array extents that are to be used with this bc_type.
    if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim
      call mpp_error(fatal, trim(error_msg))
    endif
    if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list  ', jdim
      call mpp_error(fatal, trim(error_msg))
    endif
    var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4)
    var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4)
    var%ks  = kdim(1) ; var%ke  = kdim(2)
 
    if (var%num_bcs > 0) then
      if (kdim(1) > kdim(2)) then
        write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list  ', kdim
        call mpp_error(fatal, trim(error_msg))
      endif
      if( associated(var_in%bc)) then
        if (associated(var%bc)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc already associated')
        endif
        allocate ( var%bc(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc(n)%name = var_in%bc(n)%name
          var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index
          var%bc(n)%flux_type = var_in%bc(n)%flux_type
          var%bc(n)%implementation = var_in%bc(n)%implementation
          var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file
          var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file
          var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure
          var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed
          var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice
          var%bc(n)%mol_wt = var_in%bc(n)%mol_wt
          var%bc(n)%num_fields = var_in%bc(n)%num_fields
          if (associated(var%bc(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc(n)%field(var%bc(n)%num_fields) )
          do m = 1, var%bc(n)%num_fields
            if (present(suffix)) then
              var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix)
            else
              var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name
            endif
            var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name
            var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units
            var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init
            var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean
            if (associated(var%bc(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) )
            var%bc(n)%field(m)%values(:,:,:) = 0.0_r8_kind
          enddo
        enddo
      else if(associated(var_in%bc_r4)) then
        if (associated(var%bc_r4)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc_r4 already associated')
        endif
        allocate ( var%bc_r4(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc_r4(n)%name = var_in%bc_r4(n)%name
          var%bc_r4(n)%atm_tr_index = var_in%bc_r4(n)%atm_tr_index
          var%bc_r4(n)%flux_type = var_in%bc_r4(n)%flux_type
          var%bc_r4(n)%implementation = var_in%bc_r4(n)%implementation
          var%bc_r4(n)%ice_restart_file = var_in%bc_r4(n)%ice_restart_file
          var%bc_r4(n)%ocean_restart_file = var_in%bc_r4(n)%ocean_restart_file
          var%bc_r4(n)%use_atm_pressure = var_in%bc_r4(n)%use_atm_pressure
          var%bc_r4(n)%use_10m_wind_speed = var_in%bc_r4(n)%use_10m_wind_speed
          var%bc_r4(n)%pass_through_ice = var_in%bc_r4(n)%pass_through_ice
          var%bc_r4(n)%mol_wt = var_in%bc_r4(n)%mol_wt
          var%bc_r4(n)%num_fields = var_in%bc_r4(n)%num_fields
          if (associated(var%bc_r4(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc_r4(n)%field(var%bc_r4(n)%num_fields) )
          do m = 1, var%bc_r4(n)%num_fields
            if (present(suffix)) then
              var%bc_r4(n)%field(m)%name = trim(var_in%bc_r4(n)%field(m)%name) // trim(suffix)
            else
              var%bc_r4(n)%field(m)%name = var_in%bc_r4(n)%field(m)%name
            endif
            var%bc_r4(n)%field(m)%long_name = var_in%bc_r4(n)%field(m)%long_name
            var%bc_r4(n)%field(m)%units = var_in%bc_r4(n)%field(m)%units
            var%bc_r4(n)%field(m)%may_init = var_in%bc_r4(n)%field(m)%may_init
            var%bc_r4(n)%field(m)%mean = var_in%bc_r4(n)%field(m)%mean
            if (associated(var%bc_r4(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc_r4(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) )
            var%bc_r4(n)%field(m)%values(:,:,:) = 0.0_r4_kind
          enddo
        enddo
      else
        call mpp_error(fatal, error_header//"passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
      endif
    endif
  end subroutine  ct_spawn_1d_3d
 
 
  !> @brief Generate one coupler type using another as a template. 2-D to 2-D version for generic CT_spawn.
  !!
  !! @throw FATAL, "The output type has already been initialized"
  !! @throw FATAL, "The parent type has not been initialized"
  !! @throw FATAL, "Disordered i-dimension index bound list"
  !! @throw FATAL, "Disordered j-dimension index bound list"
  !! @throw FATAL, "var%bc already assocated"
  !! @throw FATAL, "var%bc('n')%field already associated"
  !! @throw FATAL, "var%bc('n')%field('m')%values already associated"
  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.
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (CT_spawn_2d_2d):'
    character(len=400)      :: error_msg
    integer                 :: m, n
 
    if (present(as_needed)) then
      if (as_needed) then
        if ((var%set) .or. (.not.var_in%set)) return
      endif
    endif
 
    if (var%set)&
        & call mpp_error(fatal, trim(error_header) // ' The output type has already been initialized.')
    if (.not.var_in%set)&
        & call mpp_error(fatal, trim(error_header) // ' The parent type has not been initialized.')
 
    ! check only one kind is used
    if(var_in%num_bcs .gt. 0) then
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both initialized,"// &
                                " only one should be associated per type")
        else
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both uninitialized,"// &
                                " one must be associated to copy field data")
        endif
      endif
    endif
 
    var%num_bcs = var_in%num_bcs
    var%set = .true.
 
    if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim
      call mpp_error(fatal, trim(error_msg))
    endif
    if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list  ', jdim
      call mpp_error(fatal, trim(error_msg))
    endif
    var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4)
    var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4)
 
    if (var%num_bcs > 0) then
      if(associated(var_in%bc)) then
        if (associated(var%bc)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc already associated')
        endif
        allocate ( var%bc(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc(n)%name = var_in%bc(n)%name
          var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index
          var%bc(n)%flux_type = var_in%bc(n)%flux_type
          var%bc(n)%implementation = var_in%bc(n)%implementation
          var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file
          var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file
          var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure
          var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed
          var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice
          var%bc(n)%mol_wt = var_in%bc(n)%mol_wt
          var%bc(n)%num_fields = var_in%bc(n)%num_fields
          if (associated(var%bc(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc(n)%field(var%bc(n)%num_fields) )
          do m = 1, var%bc(n)%num_fields
            if (present(suffix)) then
              var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix)
            else
              var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name
            endif
            var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name
            var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units
            var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init
            var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean
            if (associated(var%bc(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) )
            var%bc(n)%field(m)%values(:,:) = 0.0_r8_kind
          enddo
        enddo
      else if (associated(var_in%bc_r4)) then
        if (associated(var%bc_r4)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc_r4 already associated')
        endif
        allocate ( var%bc_r4(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc_r4(n)%name = var_in%bc_r4(n)%name
          var%bc_r4(n)%atm_tr_index = var_in%bc_r4(n)%atm_tr_index
          var%bc_r4(n)%flux_type = var_in%bc_r4(n)%flux_type
          var%bc_r4(n)%implementation = var_in%bc_r4(n)%implementation
          var%bc_r4(n)%ice_restart_file = var_in%bc_r4(n)%ice_restart_file
          var%bc_r4(n)%ocean_restart_file = var_in%bc_r4(n)%ocean_restart_file
          var%bc_r4(n)%use_atm_pressure = var_in%bc_r4(n)%use_atm_pressure
          var%bc_r4(n)%use_10m_wind_speed = var_in%bc_r4(n)%use_10m_wind_speed
          var%bc_r4(n)%pass_through_ice = var_in%bc_r4(n)%pass_through_ice
          var%bc_r4(n)%mol_wt = var_in%bc_r4(n)%mol_wt
          var%bc_r4(n)%num_fields = var_in%bc_r4(n)%num_fields
          if (associated(var%bc_r4(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc_r4(n)%field(var%bc_r4(n)%num_fields) )
          do m = 1, var%bc_r4(n)%num_fields
            if (present(suffix)) then
              var%bc_r4(n)%field(m)%name = trim(var_in%bc_r4(n)%field(m)%name) // trim(suffix)
            else
              var%bc_r4(n)%field(m)%name = var_in%bc_r4(n)%field(m)%name
            endif
            var%bc_r4(n)%field(m)%long_name = var_in%bc_r4(n)%field(m)%long_name
            var%bc_r4(n)%field(m)%units = var_in%bc_r4(n)%field(m)%units
            var%bc_r4(n)%field(m)%may_init = var_in%bc_r4(n)%field(m)%may_init
            var%bc_r4(n)%field(m)%mean = var_in%bc_r4(n)%field(m)%mean
            if (associated(var%bc_r4(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc_r4(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) )
            var%bc_r4(n)%field(m)%values(:,:) = 0.0_r4_kind
          enddo
        enddo
      else
        call mpp_error(fatal, error_header//"passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
      endif
    endif
  end subroutine  ct_spawn_2d_2d
 
  !> @brief Generate one coupler type using another as a template. 2-D to 3-D version for generic CT_spawn.
  !!
  !! @throw FATAL, "The output type has already been initialized"
  !! @throw FATAL, "The parent type has not been initialized"
  !! @throw FATAL, "Disordered i-dimension index bound list"
  !! @throw FATAL, "Disordered j-dimension index bound list"
  !! @throw FATAL, "Disordered k-dimension index bound list"
  !! @throw FATAL, "var%bc already assocated"
  !! @throw FATAL, "var%bc('n')%field already associated"
  !! @throw FATAL, "var%bc('n')%field('m')%values already associated"
  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.
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (CT_spawn_2d_3d):'
    character(len=400)      :: error_msg
    integer                 :: m, n
 
    if (present(as_needed)) then
      if (as_needed) then
        if ((var%set) .or. (.not.var_in%set)) return
      endif
    endif
 
    if (var%set)&
        & call mpp_error(fatal, trim(error_header) // ' The output type has already been initialized.')
    if (.not.var_in%set)&
        & call mpp_error(fatal, trim(error_header) // ' The parent type has not been initialized.')
 
    if(var_in%num_bcs .gt. 0) then
      ! check only one kind is used
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both initialized,"// &
                                " only one should be associated per type")
        else
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both uninitialized,"// &
                                " one must be associated to copy field data")
        endif
      endif
    endif
 
    var%num_bcs = var_in%num_bcs
    var%set = .true.
 
    ! Store the array extents that are to be used with this bc_type.
    if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim
      call mpp_error(fatal, trim(error_msg))
    endif
    if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list  ', jdim
      call mpp_error(fatal, trim(error_msg))
    endif
    if (kdim(1) > kdim(2)) then
      write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list  ', kdim
      call mpp_error(fatal, trim(error_msg))
    endif
    var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4)
    var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4)
    var%ks  = kdim(1) ; var%ke = kdim(2)
 
    if (var%num_bcs > 0) then
      if( associated(var_in%bc)) then
        if (associated(var%bc)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc already associated')
        endif
        allocate ( var%bc(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc(n)%name = var_in%bc(n)%name
          var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index
          var%bc(n)%flux_type = var_in%bc(n)%flux_type
          var%bc(n)%implementation = var_in%bc(n)%implementation
          var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file
          var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file
          var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure
          var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed
          var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice
          var%bc(n)%mol_wt = var_in%bc(n)%mol_wt
          var%bc(n)%num_fields = var_in%bc(n)%num_fields
          if (associated(var%bc(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc(n)%field(var%bc(n)%num_fields) )
          do m = 1, var%bc(n)%num_fields
            if (present(suffix)) then
              var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix)
            else
              var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name
            endif
            var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name
            var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units
            var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init
            var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean
            if (associated(var%bc(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) )
            var%bc(n)%field(m)%values(:,:,:) = 0.0_r8_kind
          enddo
        enddo
      else if(associated(var_in%bc_r4)) then
        if (associated(var%bc_r4)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc_r4 already associated')
        endif
        allocate ( var%bc_r4(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc_r4(n)%name = var_in%bc_r4(n)%name
          var%bc_r4(n)%atm_tr_index = var_in%bc_r4(n)%atm_tr_index
          var%bc_r4(n)%flux_type = var_in%bc_r4(n)%flux_type
          var%bc_r4(n)%implementation = var_in%bc_r4(n)%implementation
          var%bc_r4(n)%ice_restart_file = var_in%bc_r4(n)%ice_restart_file
          var%bc_r4(n)%ocean_restart_file = var_in%bc_r4(n)%ocean_restart_file
          var%bc_r4(n)%use_atm_pressure = var_in%bc_r4(n)%use_atm_pressure
          var%bc_r4(n)%use_10m_wind_speed = var_in%bc_r4(n)%use_10m_wind_speed
          var%bc_r4(n)%pass_through_ice = var_in%bc_r4(n)%pass_through_ice
          var%bc_r4(n)%mol_wt = var_in%bc_r4(n)%mol_wt
          var%bc_r4(n)%num_fields = var_in%bc_r4(n)%num_fields
          if (associated(var%bc_r4(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc_r4(n)%field(var%bc_r4(n)%num_fields) )
          do m = 1, var%bc_r4(n)%num_fields
            if (present(suffix)) then
              var%bc_r4(n)%field(m)%name = trim(var_in%bc_r4(n)%field(m)%name) // trim(suffix)
            else
              var%bc_r4(n)%field(m)%name = var_in%bc_r4(n)%field(m)%name
            endif
            var%bc_r4(n)%field(m)%long_name = var_in%bc_r4(n)%field(m)%long_name
            var%bc_r4(n)%field(m)%units = var_in%bc_r4(n)%field(m)%units
            var%bc_r4(n)%field(m)%may_init = var_in%bc_r4(n)%field(m)%may_init
            var%bc_r4(n)%field(m)%mean = var_in%bc_r4(n)%field(m)%mean
            if (associated(var%bc_r4(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc_r4(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) )
            var%bc_r4(n)%field(m)%values(:,:,:) = 0.0_r4_kind
          enddo
        enddo
      else
        call mpp_error(fatal, error_header//"passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
      endif
    endif
  end subroutine  ct_spawn_2d_3d
 
  !> @brief Generate one coupler type using another as a template. 3-D to 2-D version for generic CT_spawn.
  !!
  !! @throw FATAL, "The output type has already been initialized"
  !! @throw FATAL, "The parent type has not been initialized"
  !! @throw FATAL, "Disordered i-dimension index bound list"
  !! @throw FATAL, "Disordered j-dimension index bound list"
  !! @throw FATAL, "var%bc already assocated"
  !! @throw FATAL, "var%bc('n')%field already associated"
  !! @throw FATAL, "var%bc('n')%field('m')%values already associated"
  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.
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (CT_spawn_3d_2d):'
    character(len=400)      :: error_msg
    integer                 :: m, n
 
    if (present(as_needed)) then
      if (as_needed) then
        if ((var%set) .or. (.not.var_in%set)) return
      endif
    endif
 
    if (var%set)&
        & call mpp_error(fatal, trim(error_header) // ' The output type has already been initialized.')
    if (.not.var_in%set)&
        & call mpp_error(fatal, trim(error_header) // ' The parent type has not been initialized.')
 
    if(var_in%num_bcs .gt. 0) then
      ! check only one kind is used
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both initialized,"// &
                                " only one should be associated per type")
        else
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both uninitialized,"// &
                                " one must be associated to copy field data")
        endif
      endif
    endif
 
    var%num_bcs = var_in%num_bcs
    var%set = .true.
 
    if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim
      call mpp_error(fatal, trim(error_msg))
    endif
    if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list  ', jdim
      call mpp_error(fatal, trim(error_msg))
    endif
    var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4)
    var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4)
 
    if (var%num_bcs > 0) then
      ! if using r8_kind reals
      if( associated(var_in%bc)) then
        if (associated(var%bc)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc already associated')
        endif
        allocate ( var%bc(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc(n)%name = var_in%bc(n)%name
          var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index
          var%bc(n)%flux_type = var_in%bc(n)%flux_type
          var%bc(n)%implementation = var_in%bc(n)%implementation
          var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file
          var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file
          var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure
          var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed
          var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice
          var%bc(n)%mol_wt = var_in%bc(n)%mol_wt
          var%bc(n)%num_fields = var_in%bc(n)%num_fields
          if (associated(var%bc(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc(n)%field(var%bc(n)%num_fields) )
          do m = 1, var%bc(n)%num_fields
            if (present(suffix)) then
              var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix)
            else
              var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name
            endif
            var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name
            var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units
            var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init
            var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean
            if (associated(var%bc(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) )
            var%bc(n)%field(m)%values(:,:) = 0.0_r8_kind
          enddo
        enddo
      ! if using r4_kind reals (same logic)
      else if (associated(var_in%bc_r4)) then
        if (associated(var%bc_r4)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc_r4 already associated')
        endif
        allocate ( var%bc_r4(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc_r4(n)%name = var_in%bc_r4(n)%name
          var%bc_r4(n)%atm_tr_index = var_in%bc_r4(n)%atm_tr_index
          var%bc_r4(n)%flux_type = var_in%bc_r4(n)%flux_type
          var%bc_r4(n)%implementation = var_in%bc_r4(n)%implementation
          var%bc_r4(n)%ice_restart_file = var_in%bc_r4(n)%ice_restart_file
          var%bc_r4(n)%ocean_restart_file = var_in%bc_r4(n)%ocean_restart_file
          var%bc_r4(n)%use_atm_pressure = var_in%bc_r4(n)%use_atm_pressure
          var%bc_r4(n)%use_10m_wind_speed = var_in%bc_r4(n)%use_10m_wind_speed
          var%bc_r4(n)%pass_through_ice = var_in%bc_r4(n)%pass_through_ice
          var%bc_r4(n)%mol_wt = var_in%bc_r4(n)%mol_wt
          var%bc_r4(n)%num_fields = var_in%bc_r4(n)%num_fields
          if (associated(var%bc_r4(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc_r4(n)%field(var%bc_r4(n)%num_fields) )
          do m = 1, var%bc_r4(n)%num_fields
            if (present(suffix)) then
              var%bc_r4(n)%field(m)%name = trim(var_in%bc_r4(n)%field(m)%name) // trim(suffix)
            else
              var%bc_r4(n)%field(m)%name = var_in%bc_r4(n)%field(m)%name
            endif
            var%bc_r4(n)%field(m)%long_name = var_in%bc_r4(n)%field(m)%long_name
            var%bc_r4(n)%field(m)%units = var_in%bc_r4(n)%field(m)%units
            var%bc_r4(n)%field(m)%may_init = var_in%bc_r4(n)%field(m)%may_init
            var%bc_r4(n)%field(m)%mean = var_in%bc_r4(n)%field(m)%mean
            if (associated(var%bc_r4(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc_r4(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed) )
            var%bc_r4(n)%field(m)%values(:,:) = 0.0_r4_kind
          enddo
        enddo
      else
        call mpp_error(fatal, error_header//"passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
      endif
    endif
  end subroutine  ct_spawn_3d_2d
 
  !> @brief Generate one coupler type using another as a template. 3-D to 3-D version for generic CT_spawn.
  !!
  !! @throw FATAL, "The output type has already been initialized"
  !! @throw FATAL, "The parent type has not been initialized"
  !! @throw FATAL, "Disordered i-dimension index bound list"
  !! @throw FATAL, "Disordered j-dimension index bound list"
  !! @throw FATAL, "Disordered k-dimension index bound list"
  !! @throw FATAL, "var%bc already assocated"
  !! @throw FATAL, "var%bc('n')%field already associated"
  !! @throw FATAL, "var%bc('n')%field('m')%values already associated"
  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.
 
    character(len=*), parameter :: error_header =&
        & '==>Error from coupler_types_mod (CT_spawn_3d_3d):'
    character(len=400)      :: error_msg
    integer                 :: m, n
 
    if (present(as_needed)) then
      if (as_needed) then
        if ((var%set) .or. (.not.var_in%set)) return
      endif
    endif
 
    if (var%set)&
        & call mpp_error(fatal, trim(error_header) // ' The output type has already been initialized.')
    if (.not.var_in%set)&
        & call mpp_error(fatal, trim(error_header) // ' The parent type has not been initialized.')
 
    if(var_in%num_bcs .gt. 0) then
      ! check only one kind is used
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc)) then
          call mpp_error(fatal, error_header//"var_in%bc and var_in%bc_r4 are both initialized,"//&
                                "only one should be allocated per type")
        else
          call mpp_error(fatal, error_header//"var_in%bc and var%bc_r4 are both uninitialized,"//&
                                " one must be associated to copy field data")
        endif
      endif
    endif
 
    var%num_bcs = var_in%num_bcs
    var%set = .true.
 
    if ((idim(1) > idim(2)) .or. (idim(3) > idim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered i-dimension index bound list ', idim
      call mpp_error(fatal, trim(error_msg))
    endif
    if ((jdim(1) > jdim(2)) .or. (jdim(3) > jdim(4))) then
      write (error_msg, *) trim(error_header), ' Disordered j-dimension index bound list  ', jdim
      call mpp_error(fatal, trim(error_msg))
    endif
    if (kdim(1) > kdim(2)) then
      write (error_msg, *) trim(error_header), ' Disordered k-dimension index bound list  ', kdim
      call mpp_error(fatal, trim(error_msg))
    endif
    var%isd = idim(1) ; var%isc = idim(2) ; var%iec = idim(3) ; var%ied = idim(4)
    var%jsd = jdim(1) ; var%jsc = jdim(2) ; var%jec = jdim(3) ; var%jed = jdim(4)
    var%ks  = kdim(1) ; var%ke  = kdim(2)
 
    if (var%num_bcs > 0) then
      if(associated(var_in%bc)) then
        if (associated(var%bc)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc already associated')
        endif
        allocate ( var%bc(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc(n)%name = var_in%bc(n)%name
          var%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index
          var%bc(n)%flux_type = var_in%bc(n)%flux_type
          var%bc(n)%implementation = var_in%bc(n)%implementation
          var%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file
          var%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file
          var%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure
          var%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed
          var%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice
          var%bc(n)%mol_wt = var_in%bc(n)%mol_wt
          var%bc(n)%num_fields = var_in%bc(n)%num_fields
          if (associated(var%bc(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc(n)%field(var%bc(n)%num_fields) )
          do m = 1, var%bc(n)%num_fields
            if (present(suffix)) then
              var%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix)
            else
              var%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name
            endif
            var%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name
            var%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units
            var%bc(n)%field(m)%may_init = var_in%bc(n)%field(m)%may_init
            var%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean
            if (associated(var%bc(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header), ' var%bc(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
 
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) )
            var%bc(n)%field(m)%values(:,:,:) = 0.0_r8_kind
          enddo
        enddo
      else if(associated(var_in%bc_r4)) then
        if (associated(var%bc_r4)) then
          call mpp_error(fatal, trim(error_header) // ' var%bc_r4 already associated')
        endif
        allocate ( var%bc_r4(var%num_bcs) )
        do n = 1, var%num_bcs
          var%bc_r4(n)%name = var_in%bc_r4(n)%name
          var%bc_r4(n)%atm_tr_index = var_in%bc_r4(n)%atm_tr_index
          var%bc_r4(n)%flux_type = var_in%bc_r4(n)%flux_type
          var%bc_r4(n)%implementation = var_in%bc_r4(n)%implementation
          var%bc_r4(n)%ice_restart_file = var_in%bc_r4(n)%ice_restart_file
          var%bc_r4(n)%ocean_restart_file = var_in%bc_r4(n)%ocean_restart_file
          var%bc_r4(n)%use_atm_pressure = var_in%bc_r4(n)%use_atm_pressure
          var%bc_r4(n)%use_10m_wind_speed = var_in%bc_r4(n)%use_10m_wind_speed
          var%bc_r4(n)%pass_through_ice = var_in%bc_r4(n)%pass_through_ice
          var%bc_r4(n)%mol_wt = var_in%bc_r4(n)%mol_wt
          var%bc_r4(n)%num_fields = var_in%bc_r4(n)%num_fields
          if (associated(var%bc_r4(n)%field)) then
            write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field already associated'
            call mpp_error(fatal, trim(error_msg))
          endif
          allocate ( var%bc_r4(n)%field(var%bc_r4(n)%num_fields) )
          do m = 1, var%bc_r4(n)%num_fields
            if (present(suffix)) then
              var%bc_r4(n)%field(m)%name = trim(var_in%bc_r4(n)%field(m)%name) // trim(suffix)
            else
              var%bc_r4(n)%field(m)%name = var_in%bc_r4(n)%field(m)%name
            endif
            var%bc_r4(n)%field(m)%long_name = var_in%bc_r4(n)%field(m)%long_name
            var%bc_r4(n)%field(m)%units = var_in%bc_r4(n)%field(m)%units
            var%bc_r4(n)%field(m)%may_init = var_in%bc_r4(n)%field(m)%may_init
            var%bc_r4(n)%field(m)%mean = var_in%bc_r4(n)%field(m)%mean
            if (associated(var%bc_r4(n)%field(m)%values)) then
              write (error_msg, *) trim(error_header), ' var%bc_r4(', n, ')%field(', m, ')%values already associated'
              call mpp_error(fatal, trim(error_msg))
            endif
 
            ! Note that this may be allocating a zero-sized array, which is legal in Fortran.
            allocate ( var%bc_r4(n)%field(m)%values(var%isd:var%ied,var%jsd:var%jed,var%ks:var%ke) )
            var%bc_r4(n)%field(m)%values(:,:,:) = 0.0_r4_kind
          enddo
        enddo
      else
        call mpp_error(fatal, error_header//"passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
      endif
    endif
  end subroutine  ct_spawn_3d_3d
 
 
  !> @brief Copy all elements of coupler_2d_bc_type.
  !! Do a direct copy of the data in all elements of one
  !! coupler_2d_bc_type into another.  Both must have the same array sizes.
  !!
  !! @throw FATAL, "bc_index is present and exceeds var_in%num_bcs."
  !! @throw FATAL, "field_index is present and exceeds num_fields for var_in%bc(bc_incdx)%name"
  !! @throw FATAL, "bc_index must be present if field_index is present."
  !! @throw FATAL, "There is an i-direction computational domain size mismatch."
  !! @throw FATAL, "There is an j-direction computational domain size mismatch."
  !! @throw FATAL, "Excessive i-direction halo size for the input structure."
  !! @throw FATAL, "Excessive i-direction halo size for the input structure."
  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
    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
    logical :: copy_bc
    integer :: i, j, m, n, n1, n2, halo, i_off, j_off
 
 
    if (present(bc_index)) then
      if (bc_index > var_in%num_bcs)&
          & call mpp_error(fatal, "CT_copy_data_2d: bc_index is present and exceeds var_in%num_bcs.")
      if (present(field_index)) then
        if( associated(var_in%bc)) then
          if (field_index > var_in%bc(bc_index)%num_fields)&
            & call mpp_error(fatal, "CT_copy_data_2d: field_index is present and exceeds num_fields for" //&
            & trim(var_in%bc(bc_index)%name) )
        else
          if (field_index > var_in%bc_r4(bc_index)%num_fields)&
            & call mpp_error(fatal, "CT_copy_data_2d: field_index is present and exceeds num_fields for" //&
            & trim(var_in%bc_r4(bc_index)%name) )
        endif
      endif
    elseif (present(field_index)) then
      call mpp_error(fatal, "CT_copy_data_2d: bc_index must be present if field_index is present.")
    endif
 
    halo = 0
    if (present(halo_size)) halo = halo_size
 
    n1 = 1
    n2 = var_in%num_bcs
    if (present(bc_index)) then
      n1 = bc_index
      n2 = bc_index
    endif
 
    if (n2 >= n1) then
      ! A more consciencious implementation would include a more descriptive error messages.
      if ((var_in%iec-var_in%isc) /= (var%iec-var%isc))&
          & call mpp_error(fatal, "CT_copy_data_2d: There is an i-direction computational domain size mismatch.")
      if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc))&
          & call mpp_error(fatal, "CT_copy_data_2d: There is a j-direction computational domain size mismatch.")
      if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo))&
          & call mpp_error(fatal, "CT_copy_data_2d: Excessive i-direction halo size for the input structure.")
      if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo))&
          & call mpp_error(fatal, "CT_copy_data_2d: Excessive j-direction halo size for the input structure.")
      if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo))&
          & call mpp_error(fatal, "CT_copy_data_2d: Excessive i-direction halo size for the output structure.")
      if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo))&
          & call mpp_error(fatal, "CT_copy_data_2d: Excessive j-direction halo size for the output structure.")
 
      i_off = var_in%isc - var%isc
      j_off = var_in%jsc - var%jsc
    endif
 
    if(var_in%set .and. var_in%num_bcs .gt. 0) then
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, "CT_copy_data_2d var_in%bc and var_in%bc_r4 are both initialized,"//&
                                " only one should be associated per type")
        else
          call mpp_error(fatal, "CT_copy_data_2d var_in%bc and var_in%bc_r4 are both uninitialized,"//&
                                " one must be associated to copy field data.")
        endif
      endif
    endif
 
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if (associated(var_in%bc) .or. var_in%num_bcs .lt. 1) then
      do n = n1, n2
        copy_bc = .true.
        if (copy_bc .and. present(exclude_flux_type))&
            & copy_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type))
        if (copy_bc .and. present(only_flux_type))&
            & copy_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type))
        if (copy_bc .and. present(pass_through_ice))&
            & copy_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice)
        if (.not.copy_bc) cycle
 
        do m = 1, var%bc(n)%num_fields
          if (present(field_index)) then
            if (m /= field_index) cycle
          endif
          if ( associated(var%bc(n)%field(m)%values) ) then
            do j=var%jsc-halo,var%jec+halo
              do i=var%isc-halo,var%iec+halo
                var%bc(n)%field(m)%values(i,j) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off)
              enddo
            enddo
          endif
        enddo
      enddo
    else if (associated(var_in%bc_r4)) then
      do n = n1, n2
        copy_bc = .true.
        if (copy_bc .and. present(exclude_flux_type))&
            & copy_bc = .not.(trim(var%bc_r4(n)%flux_type) == trim(exclude_flux_type))
        if (copy_bc .and. present(only_flux_type))&
            & copy_bc = (trim(var%bc_r4(n)%flux_type) == trim(only_flux_type))
        if (copy_bc .and. present(pass_through_ice))&
            & copy_bc = (pass_through_ice .eqv. var%bc_r4(n)%pass_through_ice)
        if (.not.copy_bc) cycle
 
        do m = 1, var%bc_r4(n)%num_fields
          if (present(field_index)) then
            if (m /= field_index) cycle
          endif
          if ( associated(var%bc_r4(n)%field(m)%values) ) then
            do j=var%jsc-halo,var%jec+halo
              do i=var%isc-halo,var%iec+halo
                var%bc_r4(n)%field(m)%values(i,j) = var_in%bc_r4(n)%field(m)%values(i+i_off,j+j_off)
              enddo
            enddo
          endif
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_copy_data_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_copy_data_2d
 
  !> @brief Copy all elements of coupler_3d_bc_type
  !!
  !! Do a direct copy of the data in all elements of one
  !! coupler_3d_bc_type into another.  Both must have the same array sizes.
  !!
  !! @throw FATAL, "bc_index is present and exceeds var_in%num_bcs."
  !! @throw FATAL, "field_index is present and exceeds num_fields for var_in%bc(bc_incdx)%name"
  !! @throw FATAL, "bc_index must be present if field_index is present."
  !! @throw FATAL, "There is an i-direction computational domain size mismatch."
  !! @throw FATAL, "There is an j-direction computational domain size mismatch."
  !! @throw FATAL, "There is an k-direction computational domain size mismatch."
  !! @throw FATAL, "Excessive i-direction halo size for the input structure."
  !! @throw FATAL, "Excessive i-direction halo size for the input structure."
  !! @throw FATAL, "Excessive k-direction halo size for the input structure."
  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
    logical :: copy_bc
    integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, k_off
 
    if (present(bc_index)) then
      if (bc_index > var_in%num_bcs) &
          call mpp_error(fatal, "CT_copy_data_3d: bc_index is present and exceeds var_in%num_bcs.")
      if (present(field_index)) then
        if( associated(var_in%bc)) then
          if (field_index > var_in%bc(bc_index)%num_fields)&
            & call mpp_error(fatal, "CT_copy_data_3d: field_index is present and exceeds num_fields for" //&
            & trim(var_in%bc(bc_index)%name) )
        else
          if (field_index > var_in%bc_r4(bc_index)%num_fields)&
            & call mpp_error(fatal, "CT_copy_data_3d: field_index is present and exceeds num_fields for" //&
            & trim(var_in%bc_r4(bc_index)%name) )
        endif
      endif
    elseif (present(field_index)) then
      call mpp_error(fatal, "CT_copy_data_3d: bc_index must be present if field_index is present.")
    endif
 
    halo = 0
    if (present(halo_size)) halo = halo_size
 
    n1 = 1
    n2 = var_in%num_bcs
    if (present(bc_index)) then
      n1 = bc_index
      n2 = bc_index
    endif
 
    if (n2 >= n1) then
      ! A more consciencious implementation would include a more descriptive error messages.
      if ((var_in%iec-var_in%isc) /= (var%iec-var%isc))&
          & call mpp_error(fatal, "CT_copy_data_3d: There is an i-direction computational domain size mismatch.")
      if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc))&
          & call mpp_error(fatal, "CT_copy_data_3d: There is a j-direction computational domain size mismatch.")
      if ((var_in%ke-var_in%ks) /= (var%ke-var%ks))&
          & call mpp_error(fatal, "CT_copy_data_3d: There is a k-direction computational domain size mismatch.")
      if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo))&
          & call mpp_error(fatal, "CT_copy_data_3d: Excessive i-direction halo size for the input structure.")
      if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo))&
          & call mpp_error(fatal, "CT_copy_data_3d: Excessive j-direction halo size for the input structure.")
      if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo))&
          & call mpp_error(fatal, "CT_copy_data_3d: Excessive i-direction halo size for the output structure.")
      if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo))&
          & call mpp_error(fatal, "CT_copy_data_3d: Excessive j-direction halo size for the output structure.")
 
      i_off = var_in%isc - var%isc
      j_off = var_in%jsc - var%jsc
      k_off = var_in%ks - var%ks
    endif
 
    if(var_in%set .and. var_in%num_bcs .gt. 0) then
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, "CT_copy_data_3d: var_in%bc and var_in%bc_r4 are both initialized,"//&
                                " only one should be associated per type")
        else
          call mpp_error(fatal, "CT_copy_data_3d: var_in%bc and var_in%bc_r4 are both uninitialized,"//&
                                " one must be associated to copy field data.")
        endif
      endif
    endif
 
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if (associated(var_in%bc) .or. var_in%num_bcs .lt. 1) then
      do n = n1, n2
        copy_bc = .true.
        if (copy_bc .and. present(exclude_flux_type))&
            & copy_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type))
        if (copy_bc .and. present(only_flux_type))&
            & copy_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type))
        if (copy_bc .and. present(pass_through_ice))&
            & copy_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice)
        if (.not.copy_bc) cycle
 
        do m = 1, var_in%bc(n)%num_fields
          if (present(field_index)) then
            if (m /= field_index) cycle
          endif
          if ( associated(var%bc(n)%field(m)%values) ) then
            do k=var%ks,var%ke
              do j=var%jsc-halo,var%jec+halo
                do i=var%isc-halo,var%iec+halo
                  var%bc(n)%field(m)%values(i,j,k) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off,k+k_off)
                enddo
              enddo
            enddo
          endif
        enddo
      enddo
    else if (associated(var_in%bc_r4)) then
      do n = n1, n2
        copy_bc = .true.
        if (copy_bc .and. present(exclude_flux_type))&
            & copy_bc = .not.(trim(var%bc_r4(n)%flux_type) == trim(exclude_flux_type))
        if (copy_bc .and. present(only_flux_type))&
            & copy_bc = (trim(var%bc_r4(n)%flux_type) == trim(only_flux_type))
        if (copy_bc .and. present(pass_through_ice))&
            & copy_bc = (pass_through_ice .eqv. var%bc_r4(n)%pass_through_ice)
        if (.not.copy_bc) cycle
 
        do m = 1, var_in%bc_r4(n)%num_fields
          if (present(field_index)) then
            if (m /= field_index) cycle
          endif
          if ( associated(var%bc_r4(n)%field(m)%values) ) then
            do k=var%ks,var%ke
              do j=var%jsc-halo,var%jec+halo
                do i=var%isc-halo,var%iec+halo
                  var%bc_r4(n)%field(m)%values(i,j,k) = var_in%bc_r4(n)%field(m)%values(i+i_off,j+j_off,k+k_off)
                enddo
              enddo
            enddo
          endif
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_copy_data_3d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_copy_data_3d
 
  !> @brief Copy all elements of coupler_2d_bc_type to coupler_3d_bc_type
  !!
  !! Do a direct copy of the data in all elements of one coupler_2d_bc_type into a
  !! coupler_3d_bc_type.  Both must have the same array sizes for the first two dimensions, while
  !! the extend of the 3rd dimension that is being filled may be specified via optional arguments..
  !!
  !! @throw FATAL, "bc_index is present and exceeds var_in%num_bcs."
  !! @throw FATAL, "field_index is present and exceeds num_fields for var_in%bc(bc_incdx)%name"
  !! @throw FATAL, "bc_index must be present if field_index is present."
  !! @throw FATAL, "There is an i-direction computational domain size mismatch."
  !! @throw FATAL, "There is an j-direction computational domain size mismatch."
  !! @throw FATAL, "Excessive i-direction halo size for the input structure."
  !! @throw FATAL, "Excessive i-direction halo size for the input structure."
  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.
 
    logical :: copy_bc
    integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, ks, ke
 
    if (present(bc_index)) then
      if (bc_index > var_in%num_bcs)&
          & call mpp_error(fatal, "CT_copy_data_2d_3d: bc_index is present and exceeds var_in%num_bcs.")
      if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields)&
          & call mpp_error(fatal, "CT_copy_data_2d_3d: field_index is present and exceeds num_fields for" //&
          & trim(var_in%bc(bc_index)%name) )
      endif
    elseif (present(field_index)) then
      call mpp_error(fatal, "CT_copy_data_2d_3d: bc_index must be present if field_index is present.")
    endif
 
    halo = 0
    if (present(halo_size)) halo = halo_size
 
    n1 = 1
    n2 = var_in%num_bcs
    if (present(bc_index)) then
      n1 = bc_index
      n2 = bc_index
    endif
 
    if (n2 >= n1) then
      ! A more consciencious implementation would include a more descriptive error messages.
      if ((var_in%iec-var_in%isc) /= (var%iec-var%isc))&
          & call mpp_error(fatal, "CT_copy_data_2d_3d: There is an i-direction computational domain size mismatch.")
      if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc))&
          & call mpp_error(fatal, "CT_copy_data_2d_3d: There is a j-direction computational domain size mismatch.")
      if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo))&
          & call mpp_error(fatal, "CT_copy_data_2d_3d: Excessive i-direction halo size for the input structure.")
      if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo))&
          & call mpp_error(fatal, "CT_copy_data_2d_3d: Excessive j-direction halo size for the input structure.")
      if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo))&
          & call mpp_error(fatal, "CT_copy_data_2d_3d: Excessive i-direction halo size for the output structure.")
      if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo))&
          & call mpp_error(fatal, "CT_copy_data_2d_3d: Excessive j-direction halo size for the output structure.")
    endif
 
    i_off = var_in%isc - var%isc
    j_off = var_in%jsc - var%jsc
 
    if(var_in%set .and. var_in%num_bcs .gt. 0) then
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, "CT_copy_data_2d_3d: var_in%bc and var_in%bc_r4 are both initialized,"//&
                                " only one should be associated per type")
        else
          call mpp_error(fatal, "CT_copy_data_2d_3d: var_in%bc and var_in%bc_r4 are both uninitialized,"//&
                                " one must be associated to copy field data.")
        endif
      endif
    endif
 
    ! if using r8_kind
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if (associated(var_in%bc) .or. var_in%num_bcs .lt. 1) then
      do n = n1, n2
        copy_bc = .true.
        if (copy_bc .and. present(exclude_flux_type))&
            & copy_bc = .not.(trim(var_in%bc(n)%flux_type) == trim(exclude_flux_type))
        if (copy_bc .and. present(only_flux_type))&
            & copy_bc = (trim(var_in%bc(n)%flux_type) == trim(only_flux_type))
        if (copy_bc .and. present(pass_through_ice))&
            & copy_bc = (pass_through_ice .eqv. var_in%bc(n)%pass_through_ice)
        if (.not.copy_bc) cycle
 
        do m = 1, var_in%bc(n)%num_fields
          if (present(field_index)) then
            if (m /= field_index) cycle
          endif
          if ( associated(var%bc(n)%field(m)%values) ) then
            ks = var%ks
            if (present(ind3_start)) ks = max(ks, ind3_start)
            ke = var%ke
            if (present(ind3_end)) ke = max(ke, ind3_end)
            do k=ks,ke
              do j=var%jsc-halo,var%jec+halo
                do i=var%isc-halo,var%iec+halo
                  var%bc(n)%field(m)%values(i,j,k) = var_in%bc(n)%field(m)%values(i+i_off,j+j_off)
                enddo
              enddo
            enddo
          endif
        enddo
      enddo
    ! if using r4_kind (same logic)
    else if (associated(var_in%bc_r4)) then
      do n = n1, n2
        copy_bc = .true.
        if (copy_bc .and. present(exclude_flux_type))&
            & copy_bc = .not.(trim(var_in%bc_r4(n)%flux_type) == trim(exclude_flux_type))
        if (copy_bc .and. present(only_flux_type))&
            & copy_bc = (trim(var_in%bc_r4(n)%flux_type) == trim(only_flux_type))
        if (copy_bc .and. present(pass_through_ice))&
            & copy_bc = (pass_through_ice .eqv. var_in%bc_r4(n)%pass_through_ice)
        if (.not.copy_bc) cycle
 
        do m = 1, var_in%bc_r4(n)%num_fields
          if (present(field_index)) then
            if (m /= field_index) cycle
          endif
          if ( associated(var%bc_r4(n)%field(m)%values) ) then
            ks = var%ks
            if (present(ind3_start)) ks = max(ks, ind3_start)
            ke = var%ke
            if (present(ind3_end)) ke = max(ke, ind3_end)
            do k=ks,ke
              do j=var%jsc-halo,var%jec+halo
                do i=var%isc-halo,var%iec+halo
                  var%bc_r4(n)%field(m)%values(i,j,k) = var_in%bc_r4(n)%field(m)%values(i+i_off,j+j_off)
                enddo
              enddo
            enddo
          endif
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_copy_data_2d_3d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_copy_data_2d_3d
 
 
  !> @brief Redistribute the data in all elements of a coupler_2d_bc_type
  !!
  !! Redistributes the data in all elements of one coupler_2d_bc_type
  !! into another, which may be on different processors with a different decomposition.
  !!
  !! @throw FATAL, "Mismatch in num_bcs in CT_copy_data_2d."
  !! @throw FATAL, "Mismatch in the total number of fields in CT_redistribute_data_2d."
  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 (intent in)
    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
 
    real(r4_kind), pointer, dimension(:,:) :: null_ptr2D_r4 => null()
    real(r8_kind), pointer, dimension(:,:) :: null_ptr2D_r8 => null()
    logical :: do_in, do_out, do_complete
    integer :: m, n, fc, fc_in, fc_out
 
    do_complete = .true.
    if (present(complete)) do_complete = complete
 
    ! Figure out whether this PE has valid input or output fields or both.
    do_in = var_in%set
    do_out = var_out%set
 
    if(var_in%set .and. var_in%num_bcs .gt. 0) then
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, "CT_redistribute_data_2d: var_in%bc and var_in%bc_r4 are both initialized,"//&
                                " only one should be associated per type")
        else
          call mpp_error(fatal, "CT_redistribute_data_2d: var_in%bc and var_in%bc_r4 are both initialized,"//&
                                " only one must be associated per type to redistribute field data.")
        endif
      endif
    endif
 
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if(associated(var_in%bc) .or. associated(var_out%bc) .or. var_in%num_bcs .lt. 1) then
      fc_in = 0 ; fc_out = 0
      if (do_in) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc(n)%num_fields
            if (associated(var_in%bc(n)%field(m)%values)) fc_in = fc_in + 1
          enddo
        enddo
      endif
      if (fc_in == 0) do_in = .false.
      if (do_out) then
        do n = 1, var_out%num_bcs
          do m = 1, var_out%bc(n)%num_fields
            if (associated(var_out%bc(n)%field(m)%values)) fc_out = fc_out + 1
          enddo
        enddo
      endif
      if (fc_out == 0) do_out = .false.
 
      if (do_in .and. do_out) then
        if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(fatal,&
            & "Mismatch in num_bcs in CT_copy_data_2d.")
        if (fc_in /= fc_out) call mpp_error(fatal,&
            & "Mismatch in the total number of fields in CT_redistribute_data_2d.")
      endif
 
      if (.not.(do_in .or. do_out)) return
 
      fc = 0
      if (do_in .and. do_out) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc(n)%num_fields
            if ( associated(var_in%bc(n)%field(m)%values) .neqv.&
                & associated(var_out%bc(n)%field(m)%values) ) &
                call mpp_error(fatal,&
                & "CT_redistribute_data_2d: Mismatch in which var_in and var_out fields are associated"// &
                & "Boundary condition:"//string(n)//" Field:"//string(m))
            if ( associated(var_in%bc(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values,&
                  & domain_out, var_out%bc(n)%field(m)%values,&
                  & complete=(do_complete.and.(fc==fc_in)) )
            endif
          enddo
        enddo
      elseif (do_in) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc(n)%num_fields
            if ( associated(var_in%bc(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values,&
                  & domain_out, null_ptr2d_r8,&
                  & complete=(do_complete.and.(fc==fc_in)) )
            endif
          enddo
        enddo
      elseif (do_out) then
        do n = 1, var_out%num_bcs
          do m = 1, var_out%bc(n)%num_fields
            if ( associated(var_out%bc(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, null_ptr2d_r8,&
                  & domain_out, var_out%bc(n)%field(m)%values,&
                  & complete=(do_complete.and.(fc==fc_out)) )
            endif
          enddo
        enddo
      endif
    ! same logic just uses r4_kind
    else if( associated(var_in%bc_r4) .or. associated(var_out%bc_r4)) then
      fc_in = 0 ; fc_out = 0
      if (do_in) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc_r4(n)%num_fields
            if (associated(var_in%bc_r4(n)%field(m)%values)) fc_in = fc_in + 1
          enddo
        enddo
      endif
      if (fc_in == 0) do_in = .false.
      if (do_out) then
        do n = 1, var_out%num_bcs
          do m = 1, var_out%bc_r4(n)%num_fields
            if (associated(var_out%bc_r4(n)%field(m)%values)) fc_out = fc_out + 1
          enddo
        enddo
      endif
      if (fc_out == 0) do_out = .false.
 
      if (do_in .and. do_out) then
        if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(fatal,&
            & "Mismatch in num_bcs in CT_copy_data_2d.")
        if (fc_in /= fc_out) call mpp_error(fatal,&
            & "Mismatch in the total number of fields in CT_redistribute_data_2d.")
      endif
 
      if (.not.(do_in .or. do_out)) return
 
      fc = 0
      if (do_in .and. do_out) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc_r4(n)%num_fields
            if ( associated(var_in%bc_r4(n)%field(m)%values) .neqv.&
                & associated(var_out%bc_r4(n)%field(m)%values) ) &
                call mpp_error(fatal,&
                & "CT_redistribute_data_2d: Mismatch in which var_in and var_out fields are associated"// &
                & "Boundary condition:"//string(n)//" Field:"//string(m))
            if ( associated(var_in%bc_r4(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, var_in%bc_r4(n)%field(m)%values,&
                  & domain_out, var_out%bc_r4(n)%field(m)%values,&
                  & complete=(do_complete.and.(fc==fc_in)) )
            endif
          enddo
        enddo
      elseif (do_in) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc_r4(n)%num_fields
            if ( associated(var_in%bc_r4(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, var_in%bc_r4(n)%field(m)%values,&
                  & domain_out, null_ptr2d_r4,&
                  & complete=(do_complete.and.(fc==fc_in)) )
            endif
          enddo
        enddo
      elseif (do_out) then
        do n = 1, var_out%num_bcs
          do m = 1, var_out%bc_r4(n)%num_fields
            if ( associated(var_out%bc_r4(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, null_ptr2d_r4,&
                  & domain_out, var_out%bc_r4(n)%field(m)%values,&
                  & complete=(do_complete.and.(fc==fc_out)) )
            endif
          enddo
        enddo
      endif
    else
      call mpp_error(fatal, "CT_redistribute_data_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_redistribute_data_2d
 
  !> @brief Redistributes the data in all elements of one coupler_2d_bc_type
  !!
  !! Redistributes 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_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 (intent in)
    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
 
    real(r4_kind), pointer, dimension(:,:,:) :: null_ptr3D_r4 => null()
    real(r8_kind), pointer, dimension(:,:,:) :: null_ptr3D_r8 => null()
    logical :: do_in, do_out, do_complete
    integer :: m, n, fc, fc_in, fc_out
 
    do_complete = .true.
    if (present(complete)) do_complete = complete
 
    ! Figure out whether this PE has valid input or output fields or both.
    do_in = var_in%set
    do_out = var_out%set
 
    fc_in = 0
    fc_out = 0
 
    if(var_in%set .and. var_in%num_bcs .gt. 0) then
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, "CT_redistribute_data_3d: var_in%bc and var_in%bc_r4 are both initialized,"//&
                                " only one should be associated per type")
        else
          call mpp_error(fatal, "CT_redistribute_data_3d: var_in%bc and var_in%bc_r4 are both initialized,"//&
                                " only one must be associated per type to redistribute field data.")
        endif
      endif
    endif
 
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if( associated(var_in%bc) .or. associated(var_out%bc) .or. var_in%num_bcs .lt. 1) then
      if (do_in) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc(n)%num_fields
            if (associated(var_in%bc(n)%field(m)%values)) fc_in = fc_in + 1
          enddo
        enddo
      endif
      if (fc_in == 0) do_in = .false.
      if (do_out) then
        do n = 1, var_out%num_bcs
          do m = 1, var_out%bc(n)%num_fields
            if (associated(var_out%bc(n)%field(m)%values)) fc_out = fc_out + 1
          enddo
        enddo
      endif
      if (fc_out == 0) do_out = .false.
 
      if (do_in .and. do_out) then
        if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(fatal,&
            & "Mismatch in num_bcs in CT_copy_data_3d.")
        if (fc_in /= fc_out) call mpp_error(fatal,&
            & "Mismatch in the total number of fields in CT_redistribute_data_3d.")
      endif
 
      if (.not.(do_in .or. do_out)) return
 
      fc = 0
      if (do_in .and. do_out) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc(n)%num_fields
            if ( associated(var_in%bc(n)%field(m)%values) .neqv.&
                & associated(var_out%bc(n)%field(m)%values) )&
                & call mpp_error(fatal,&
                & "CT_redistribute_data_3d: Mismatch in which var_in and var_out fields are associated"// &
                & "Boundary condition:"//string(n)//" Field:"//string(m))
            if ( associated(var_in%bc(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values,&
                  & domain_out, var_out%bc(n)%field(m)%values,&
                  & complete=(do_complete.and.(fc==fc_in)) )
            endif
          enddo
        enddo
      elseif (do_in) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc(n)%num_fields
            if ( associated(var_in%bc(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, var_in%bc(n)%field(m)%values,&
                  & domain_out, null_ptr3d_r8,&
                  & complete=(do_complete.and.(fc==fc_in)) )
            endif
          enddo
        enddo
      elseif (do_out) then
        do n = 1, var_out%num_bcs
          do m = 1, var_out%bc(n)%num_fields
            if ( associated(var_out%bc(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, null_ptr3d_r8,&
                  & domain_out, var_out%bc(n)%field(m)%values,&
                  & complete=(do_complete.and.(fc==fc_out)) )
            endif
          enddo
        enddo
      endif
    ! if using r4_kind, bc_r4 will be associated
    else if(associated(var_in%bc_r4) .or. associated(var_out%bc_r4)) then
      if (do_in) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc_r4(n)%num_fields
            if (associated(var_in%bc_r4(n)%field(m)%values)) fc_in = fc_in + 1
          enddo
        enddo
      endif
      if (fc_in == 0) do_in = .false.
      if (do_out) then
        do n = 1, var_out%num_bcs
          do m = 1, var_out%bc_r4(n)%num_fields
            if (associated(var_out%bc_r4(n)%field(m)%values)) fc_out = fc_out + 1
          enddo
        enddo
      endif
      if (fc_out == 0) do_out = .false.
 
      if (do_in .and. do_out) then
        if (var_in%num_bcs /= var_out%num_bcs) call mpp_error(fatal,&
            & "Mismatch in num_bcs in CT_copy_data_3d.")
        if (fc_in /= fc_out) call mpp_error(fatal,&
            & "Mismatch in the total number of fields in CT_redistribute_data_3d.")
      endif
 
      if (.not.(do_in .or. do_out)) return
 
      fc = 0
      if (do_in .and. do_out) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc_r4(n)%num_fields
            if ( associated(var_in%bc_r4(n)%field(m)%values) .neqv.&
                & associated(var_out%bc_r4(n)%field(m)%values) )&
                & call mpp_error(fatal,&
                & "CT_redistribute_data_3d: Mismatch in which var_in and var_out fields are associated"// &
                & "Boundary condition:"//string(n)//" Field:"//string(m))
            if ( associated(var_in%bc_r4(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, var_in%bc_r4(n)%field(m)%values,&
                  & domain_out, var_out%bc_r4(n)%field(m)%values,&
                  & complete=(do_complete.and.(fc==fc_in)) )
            endif
          enddo
        enddo
      elseif (do_in) then
        do n = 1, var_in%num_bcs
          do m = 1, var_in%bc_r4(n)%num_fields
            if ( associated(var_in%bc_r4(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, var_in%bc_r4(n)%field(m)%values,&
                  & domain_out, null_ptr3d_r4,&
                  & complete=(do_complete.and.(fc==fc_in)) )
            endif
          enddo
        enddo
      elseif (do_out) then
        do n = 1, var_out%num_bcs
          do m = 1, var_out%bc_r4(n)%num_fields
            if ( associated(var_out%bc_r4(n)%field(m)%values) ) then
              fc = fc + 1
              call mpp_redistribute(domain_in, null_ptr3d_r4,&
                  & domain_out, var_out%bc_r4(n)%field(m)%values,&
                  & complete=(do_complete.and.(fc==fc_out)) )
            endif
          enddo
        enddo
      endif
    else
      call mpp_error(fatal, "CT_redistribute_data_3d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_redistribute_data_3d
 
 
 
 
  !> @brief Increment data in all elements of one coupler_2d_bc_type
  !!
  !! Do a direct increment of the data in all elements of one coupler_2d_bc_type into another.  Both
  !! must have the same array sizes.
  !!
  !! @throw FATAL, "bc_index is present and exceeds var_in%num_bcs."
  !! @throw FATAL, "field_index is present and exceeds num_fields for var_in%bc(bc_incdx)%name"
  !! @throw FATAL, "bc_index must be present if field_index is present."
  !! @throw FATAL, "There is an i-direction computational domain size mismatch."
  !! @throw FATAL, "There is an j-direction computational domain size mismatch."
  !! @throw FATAL, "Excessive i-direction halo size for the input structure."
  !! @throw FATAL, "Excessive i-direction halo size for the input structure."
  subroutine ct_increment_data_2d_2d(var_in, var, halo_size, bc_index, field_index,&
      & scale_factor, scale_prev, 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 add to the other type
    type(coupler_2d_bc_type),   intent(inout) :: var !< The BC_type structure whose fields are being incremented
    integer,          optional, intent(in)    :: halo_size !< The extent of the halo to increment; 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
    real(r8_kind),    optional, intent(in)    :: scale_factor  !< A scaling factor for the data that is being added
    real(r8_kind),    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.
    logical,          optional, intent(in)    :: pass_through_ice !< If true, only increment BCs whose
                                                         !! value of pass_through ice matches this
 
    real(r8_kind) :: scale, sc_prev
    logical :: increment_bc
    integer :: i, j, m, n, n1, n2, halo, i_off, j_off
 
    scale = 1.0_r8_kind
    if (present(scale_factor)) scale = scale_factor
    sc_prev = 1.0_r8_kind
    if (present(scale_prev)) sc_prev = scale_prev
 
    if (present(bc_index)) then
      if (bc_index > var_in%num_bcs)&
          & call mpp_error(fatal, "CT_increment_data_2d_2d: bc_index is present and exceeds var_in%num_bcs.")
      if (present(field_index)) then
        if( associated(var_in%bc)) then
          if (field_index > var_in%bc(bc_index)%num_fields)&
              & call mpp_error(fatal, "CT_increment_data_2d_2d: field_index is present and exceeds num_fields for" //&
              & trim(var_in%bc(bc_index)%name) )
        else
          if (field_index > var_in%bc_r4(bc_index)%num_fields)&
              & call mpp_error(fatal, "CT_increment_data_2d_2d: field_index is present and exceeds num_fields for" //&
              & trim(var_in%bc_r4(bc_index)%name) )
        endif
      endif
    elseif (present(field_index)) then
      call mpp_error(fatal, "CT_increment_data_2d_2d: bc_index must be present if field_index is present.")
    endif
 
    halo = 0
    if (present(halo_size)) halo = halo_size
 
    n1 = 1
    n2 = var_in%num_bcs
    if (present(bc_index)) then
      n1 = bc_index
      n2 = bc_index
    endif
 
    if (n2 >= n1) then
      ! A more consciencious implementation would include a more descriptive error messages.
      if ((var_in%iec-var_in%isc) /= (var%iec-var%isc))&
          & call mpp_error(fatal, "CT_increment_data_2d: There is an i-direction computational domain size mismatch.")
      if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc))&
          & call mpp_error(fatal, "CT_increment_data_2d: There is a j-direction computational domain size mismatch.")
      if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo))&
          & call mpp_error(fatal, "CT_increment_data_2d: Excessive i-direction halo size for the input structure.")
      if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo))&
          & call mpp_error(fatal, "CT_increment_data_2d: Excessive j-direction halo size for the input structure.")
      if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo))&
          & call mpp_error(fatal, "CT_increment_data_2d: Excessive i-direction halo size for the output structure.")
      if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo))&
          & call mpp_error(fatal, "CT_increment_data_2d: Excessive j-direction halo size for the output structure.")
 
      i_off = var_in%isc - var%isc
      j_off = var_in%jsc - var%jsc
    endif
 
    ! check only one kind used
    if(var_in%set .and. var_in%num_bcs .gt. 0) then
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, "CT_increment_data_2d_2d: var_in%bc and var_in%bc_r4 are both initialized,"// &
                                " only one should be associated per type")
        else
          call mpp_error(fatal, "CT_increment_data_2d_2d: var_in%bc and var_in%bc_r4 are both initialized,"// &
                                " only one must be associated per type to increment field data.")
        endif
      endif
    endif
 
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if(associated(var_in%bc) .or. var_in%num_bcs .lt. 1) then
      do n = n1, n2
        increment_bc = .true.
        if (increment_bc .and. present(exclude_flux_type))&
            & increment_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type))
        if (increment_bc .and. present(only_flux_type))&
            & increment_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type))
        if (increment_bc .and. present(pass_through_ice))&
            & increment_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice)
        if (.not.increment_bc) cycle
 
        do m = 1, var_in%bc(n)%num_fields
          if (present(field_index)) then
            if (m /= field_index) cycle
          endif
          if ( associated(var%bc(n)%field(m)%values) ) then
            do j=var%jsc-halo,var%jec+halo
              do i=var%isc-halo,var%iec+halo
                var%bc(n)%field(m)%values(i,j) = sc_prev * var%bc(n)%field(m)%values(i,j) +&
                    & scale * var_in%bc(n)%field(m)%values(i+i_off,j+j_off)
              enddo
            enddo
          endif
        enddo
      enddo
    else if(associated(var_in%bc_r4)) then
      do n = n1, n2
        increment_bc = .true.
        if (increment_bc .and. present(exclude_flux_type))&
            & increment_bc = .not.(trim(var%bc_r4(n)%flux_type) == trim(exclude_flux_type))
        if (increment_bc .and. present(only_flux_type))&
            & increment_bc = (trim(var%bc_r4(n)%flux_type) == trim(only_flux_type))
        if (increment_bc .and. present(pass_through_ice))&
            & increment_bc = (pass_through_ice .eqv. var%bc_r4(n)%pass_through_ice)
        if (.not.increment_bc) cycle
 
        do m = 1, var_in%bc_r4(n)%num_fields
          if (present(field_index)) then
            if (m /= field_index) cycle
          endif
          if ( associated(var%bc_r4(n)%field(m)%values) ) then
            do j=var%jsc-halo,var%jec+halo
              do i=var%isc-halo,var%iec+halo
                var%bc_r4(n)%field(m)%values(i,j) = real(sc_prev,r4_kind) * var%bc_r4(n)%field(m)%values(i,j) +&
                    & real(scale,r4_kind) * var_in%bc_r4(n)%field(m)%values(i+i_off,j+j_off)
              enddo
            enddo
          endif
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_increment_data_2d_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_increment_data_2d_2d
 
 
  !> @brief Increment data in all elements of one coupler_3d_bc_type
  !!
  !! Do a direct increment of the data in all elements of one coupler_3d_bc_type into another.  Both
  !! must have the same array sizes.
  !!
  !! @throw FATAL, "bc_index is present and exceeds var_in%num_bcs."
  !! @throw FATAL, "field_index is present and exceeds num_fields for var_in%bc(bc_incdx)%name"
  !! @throw FATAL, "bc_index must be present if field_index is present."
  !! @throw FATAL, "There is an i-direction computational domain size mismatch."
  !! @throw FATAL, "There is an j-direction computational domain size mismatch."
  !! @throw FATAL, "There is an k-direction computational domain size mismatch."
  !! @throw FATAL, "Excessive i-direction halo size for the input structure."
  !! @throw FATAL, "Excessive i-direction halo size for the input structure."
  !! @throw FATAL, "Excessive k-direction halo size for the input structure."
  subroutine ct_increment_data_3d_3d(var_in, var, halo_size, bc_index, field_index,&
      & scale_factor, scale_prev, 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 add to the other type
    type(coupler_3d_bc_type),   intent(inout) :: var !< The BC_type structure whose fields are being incremented
    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
    real(r8_kind),    optional, intent(in)    :: scale_factor  !< A scaling factor for the data that is being added
    real(r8_kind),    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.
    logical,          optional, intent(in)    :: pass_through_ice !< If true, only increment BCs whose
                                                         !! value of pass_through ice matches this
 
    real(r8_kind) :: scale, sc_prev
    logical :: increment_bc
    integer :: i, j, k, m, n, n1, n2, halo, i_off, j_off, k_off
 
    scale = 1.0_r8_kind
    if (present(scale_factor)) scale = scale_factor
    sc_prev = 1.0_r8_kind
    if (present(scale_prev)) sc_prev = scale_prev
 
    if (present(bc_index)) then
      if (bc_index > var_in%num_bcs)&
          & call mpp_error(fatal, "CT_increment_data_3d_3d: bc_index is present and exceeds var_in%num_bcs.")
      if(associated(var_in%bc)) then
        if (present(field_index)) then ; if (field_index > var_in%bc(bc_index)%num_fields)&
            & call mpp_error(fatal, "CT_increment_data_3d_3d: field_index is present and exceeds num_fields for" //&
            & trim(var_in%bc(bc_index)%name) )
        endif
      else if(associated(var_in%bc_r4)) then
        if (present(field_index)) then ; if (field_index > var_in%bc_r4(bc_index)%num_fields)&
            & call mpp_error(fatal, "CT_increment_data_3d_3d: field_index is present and exceeds num_fields for" //&
            & trim(var_in%bc_r4(bc_index)%name) )
        endif
      endif
    elseif (present(field_index)) then
      call mpp_error(fatal, "CT_increment_data_3d_3d: bc_index must be present if field_index is present.")
    endif
 
    halo = 0
    if (present(halo_size)) halo = halo_size
 
    n1 = 1
    n2 = var_in%num_bcs
    if (present(bc_index)) then
      n1 = bc_index
      n2 = bc_index
    endif
 
    if (n2 >= n1) then
      ! A more consciencious implementation would include a more descriptive error messages.
      if ((var_in%iec-var_in%isc) /= (var%iec-var%isc))&
          & call mpp_error(fatal, "CT_increment_data_3d: There is an i-direction computational domain size mismatch.")
      if ((var_in%jec-var_in%jsc) /= (var%jec-var%jsc))&
          & call mpp_error(fatal, "CT_increment_data_3d: There is a j-direction computational domain size mismatch.")
      if ((var_in%ke-var_in%ks) /= (var%ke-var%ks))&
          & call mpp_error(fatal, "CT_increment_data_3d: There is a k-direction computational domain size mismatch.")
      if ((var_in%isc-var_in%isd < halo) .or. (var_in%ied-var_in%iec < halo))&
          & call mpp_error(fatal, "CT_increment_data_3d: Excessive i-direction halo size for the input structure.")
      if ((var_in%jsc-var_in%jsd < halo) .or. (var_in%jed-var_in%jec < halo))&
          & call mpp_error(fatal, "CT_increment_data_3d: Excessive j-direction halo size for the input structure.")
      if ((var%isc-var%isd < halo) .or. (var%ied-var%iec < halo))&
          & call mpp_error(fatal, "CT_increment_data_3d: Excessive i-direction halo size for the output structure.")
      if ((var%jsc-var%jsd < halo) .or. (var%jed-var%jec < halo))&
          & call mpp_error(fatal, "CT_increment_data_3d: Excessive j-direction halo size for the output structure.")
 
      i_off = var_in%isc - var%isc
      j_off = var_in%jsc - var%jsc
      k_off = var_in%ks - var%ks
    endif
 
    ! check only one kind used
    if(var_in%set .and. var_in%num_bcs .gt. 0) then
      if(associated(var_in%bc) .eqv. associated(var_in%bc_r4)) then
        if( associated(var_in%bc) ) then
          call mpp_error(fatal, "CT_increment_data_3d_3d: var_in%bc and var_in%bc_r4 are both initialized,"//&
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_increment_data_3d_3d: var_in%bc and var_in%bc_r4 are both uninitialized,"//&
                                " only one must be associated per type to increment field data.")
        endif
      endif
    endif
 
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if(associated(var_in%bc) .or. var_in%num_bcs .lt. 1) then
      do n = n1, n2
        increment_bc = .true.
        if (increment_bc .and. present(exclude_flux_type))&
            & increment_bc = .not.(trim(var%bc(n)%flux_type) == trim(exclude_flux_type))
        if (increment_bc .and. present(only_flux_type))&
            & increment_bc = (trim(var%bc(n)%flux_type) == trim(only_flux_type))
        if (increment_bc .and. present(pass_through_ice))&
            & increment_bc = (pass_through_ice .eqv. var%bc(n)%pass_through_ice)
        if (.not.increment_bc) cycle
 
        do m = 1, var_in%bc(n)%num_fields
          if (present(field_index)) then
            if (m /= field_index) cycle
          endif
          if ( associated(var%bc(n)%field(m)%values) ) then
            do k=var%ks,var%ke
              do j=var%jsc-halo,var%jec+halo
                do i=var%isc-halo,var%iec+halo
                  var%bc(n)%field(m)%values(i,j,k) = sc_prev * var%bc(n)%field(m)%values(i,j,k) +&
                      & scale * var_in%bc(n)%field(m)%values(i+i_off,j+j_off,k+k_off)
                enddo
              enddo
            enddo
          endif
        enddo
      enddo
    else if(associated(var_in%bc_r4)) then
      do n = n1, n2
        increment_bc = .true.
        if (increment_bc .and. present(exclude_flux_type))&
            & increment_bc = .not.(trim(var%bc_r4(n)%flux_type) == trim(exclude_flux_type))
        if (increment_bc .and. present(only_flux_type))&
            & increment_bc = (trim(var%bc_r4(n)%flux_type) == trim(only_flux_type))
        if (increment_bc .and. present(pass_through_ice))&
            & increment_bc = (pass_through_ice .eqv. var%bc_r4(n)%pass_through_ice)
        if (.not.increment_bc) cycle
 
        do m = 1, var_in%bc_r4(n)%num_fields
          if (present(field_index)) then
            if (m /= field_index) cycle
          endif
          if ( associated(var%bc_r4(n)%field(m)%values) ) then
            do k=var%ks,var%ke
              do j=var%jsc-halo,var%jec+halo
                do i=var%isc-halo,var%iec+halo
                  var%bc_r4(n)%field(m)%values(i,j,k) = real(sc_prev,r4_kind) * var%bc_r4(n)%field(m)%values(i,j,k) +&
                      & real(scale,r4_kind) * var_in%bc_r4(n)%field(m)%values(i+i_off,j+j_off,k+k_off)
                enddo
              enddo
            enddo
          endif
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_increment_data_3d_3d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_increment_data_3d_3d
 
  !! @brief Register the diagnostics of a coupler_2d_bc_type
  !!
  !! @throw FATAL, "axes has less than 2 elements"
  subroutine ct_set_diags_2d(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 !< Module name for diagnostic file--if blank, then
                                                         !! don't 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
 
    integer :: m, n
 
    if (diag_name == ' ') return
 
    if (size(axes) < 2) then
      call mpp_error(fatal, '==>Error from coupler_types_mod' //&
          & '(coupler_types_set_diags_3d): axes has less than 2 elements')
    endif
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_set_diags_2d: var%bc and var%bc_r4 are both initialized,"//&
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_set_diags_2d: var%bc and var%bc_r4 are both initialized,"//&
                                "one should be associated per type to register fields with diag manager")
        endif
      endif
    endif
 
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
      do n = 1, var%num_bcs
        do m = 1, var%bc(n)%num_fields
          var%bc(n)%field(m)%id_diag = register_diag_field(diag_name,&
              & var%bc(n)%field(m)%name, axes(1:2), time,&
              & var%bc(n)%field(m)%long_name, var%bc(n)%field(m)%units)
        enddo
      enddo
    else if(associated(var%bc_r4)) then
      do n = 1, var%num_bcs
        do m = 1, var%bc_r4(n)%num_fields
          var%bc_r4(n)%field(m)%id_diag = register_diag_field(diag_name,&
              & var%bc_r4(n)%field(m)%name, axes(1:2), time,&
              & var%bc_r4(n)%field(m)%long_name, var%bc_r4(n)%field(m)%units)
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_set_diags_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
 
 
  end subroutine ct_set_diags_2d
 
  !> @brief Register the diagnostics of a coupler_3d_bc_type.
  !!
  !! @throw FATAL, "axes has less than 3 elements"
  subroutine ct_set_diags_3d(var, diag_name, axes, time)
    type(coupler_3d_bc_type), intent(inout) :: var  !< BC_type structure for which to register diagnostics
    character(len=*),         intent(in)    :: diag_name !< Module name for diagnostic file--if blank, then
                                                         !! don't 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
 
    integer :: m, n
 
    if (diag_name == ' ') return
 
    if (size(axes) < 3) then
      call mpp_error(fatal, '==>Error from coupler_types_mod' //&
          & '(coupler_types_set_diags_3d): axes has less than 3 elements')
    endif
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_set_diags_3d: var%bc and var%bc_r4 are both initialized,"//&
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_set_diags_3d: var%bc and var%bc_r4 are both uninitialized,"//&
                                "one should be associated per type to register fields with diag manager")
        endif
      endif
    endif
 
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
      do n = 1, var%num_bcs
        do m = 1, var%bc(n)%num_fields
          var%bc(n)%field(m)%id_diag = register_diag_field(diag_name,&
              & var%bc(n)%field(m)%name, axes(1:3), time,&
              & var%bc(n)%field(m)%long_name, var%bc(n)%field(m)%units )
        enddo
      enddo
    else if(associated(var%bc_r4)) then
      do n = 1, var%num_bcs
        do m = 1, var%bc_r4(n)%num_fields
          var%bc_r4(n)%field(m)%id_diag = register_diag_field(diag_name,&
              & var%bc_r4(n)%field(m)%name, axes(1:3), time,&
              & var%bc_r4(n)%field(m)%long_name, var%bc_r4(n)%field(m)%units )
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_set_diags_3d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_set_diags_3d
 
 
  !> @brief Write out all diagnostics of elements of a coupler_2d_bc_type
  subroutine ct_send_data_2d(var, Time, return_statuses)
    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
    logical, allocatable, optional, intent(out) :: return_statuses(:,:) !< Return status of send data calls
                                                          !! first index is index of boundary condition
                                                          !! second index is field/value within that boundary condition
 
    integer :: m, n
    logical :: used
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_send_data_2d: var%bc and var%bc_r4 are both initialized,"//&
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_send_data_2d: var%bc and var%bc_r4 are both uninitialized,"//&
                                "one should be associated per type to send data to diag fields")
        endif
      endif
    endif
 
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
 
      ! allocate array for returned send data statuses
      if( present(return_statuses) .and. var%num_bcs .gt. 0) then
        allocate(return_statuses(var%num_bcs, var%bc(1)%num_fields))
      endif
 
      do n = 1, var%num_bcs
        do m = 1, var%bc(n)%num_fields
          if (var%bc(n)%field(m)%id_diag > 0) then
            used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, time)
            if(allocated(return_statuses)) return_statuses(n,m) = used
          endif
        enddo
      enddo
 
    else if(associated(var%bc_r4)) then
 
      ! allocate array for returned send data statuses
      if( present(return_statuses) .and. var%num_bcs .gt. 0) then
        allocate(return_statuses(var%num_bcs, var%bc_r4(1)%num_fields))
      endif
 
      do n = 1, var%num_bcs
        do m = 1, var%bc_r4(n)%num_fields
          if (var%bc_r4(n)%field(m)%id_diag > 0) then
            used = send_data(var%bc_r4(n)%field(m)%id_diag, var%bc_r4(n)%field(m)%values, time)
            if(allocated(return_statuses)) return_statuses(n,m) = used
          endif
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_send_data_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_send_data_2d
 
  !> @brief Write out all diagnostics of elements of a coupler_3d_bc_type
  subroutine ct_send_data_3d(var, Time, return_statuses)
    type(coupler_3d_bc_type), intent(in) :: var  !< BC_type structure with the diagnostics to write
    type(time_type),          intent(in) :: time !< The current model time
    logical, allocatable, optional, intent(out) :: return_statuses(:,:) !< Return status of send data calls
                                                          !! first index is index of boundary condition
                                                          !! second index is field/value within that boundary condition
 
    integer :: m, n
    logical :: used
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_send_data_3d: var%bc and var%bc_r4 are both initialized,"//&
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_send_data_3d: var%bc and var%bc_r4 are both uninitialized,"//&
                                "one should be associated per type to send data to diag fields")
        endif
      endif
    endif
 
    ! num_bcs .lt. 1 -> loop doesn't run but shouldn't error out
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
 
      ! allocate array for returned send data statuses
      if( present(return_statuses) .and. var%num_bcs .gt. 0) then
        allocate(return_statuses(var%num_bcs, var%bc(1)%num_fields))
      endif
 
      do n = 1, var%num_bcs
        do m = 1, var%bc(n)%num_fields
          if (var%bc(n)%field(m)%id_diag > 0) then
            used = send_data(var%bc(n)%field(m)%id_diag, var%bc(n)%field(m)%values, time)
            if(allocated(return_statuses)) return_statuses(n,m) = used
          endif
        enddo
      enddo
    else if(associated(var%bc_r4)) then
 
      ! allocate array for returned send data statuses
      if( present(return_statuses) .and. var%num_bcs .gt. 0) then
        allocate(return_statuses(var%num_bcs, var%bc_r4(1)%num_fields))
      endif
 
      do n = 1, var%num_bcs
        do m = 1, var%bc_r4(n)%num_fields
          if (var%bc_r4(n)%field(m)%id_diag > 0) then
            used = send_data(var%bc_r4(n)%field(m)%id_diag, var%bc_r4(n)%field(m)%values, time)
            if(allocated(return_statuses)) return_statuses(n,m) = used
          endif
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_send_data_3d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_send_data_3d
 
  !! @brief Register the fields in a coupler_2d_bc_type to be saved in restart files
  !! This subroutine registers the fields in a coupler_2d_bc_type to be saved in restart files
  !! specified in the field table.
  subroutine ct_register_restarts_2d(var, bc_rest_files, num_rest_files, mpp_domain, to_read, ocean_restart, directory)
    type(coupler_2d_bc_type), intent(inout) :: var  !< BC_type structure to be registered for restarts
    type(fmsnetcdfdomainfile_t),  dimension(:), pointer  :: bc_rest_files !< Structures describing the restart files
    integer,                  intent(out) :: num_rest_files !< The number of restart files to use
    type(domain2d),           intent(in)  :: mpp_domain     !< The FMS domain to use for this registration call
    logical,                  intent(in)  :: to_read        !< Flag indicating if reading/writing a file
    logical,         optional,intent(in)  :: ocean_restart  !< If true, use the ocean restart file name.
    character(len=*),optional,intent(in)  :: directory      !< Directory where to open the file
 
    character(len=FMS_FILE_LEN), dimension(max(1,var%num_bcs)) :: rest_file_names
    character(len=FMS_FILE_LEN) :: file_nm
    logical :: ocn_rest
    integer :: f, n, m
 
    character(len=20), allocatable, dimension(:)             :: dim_names !< Array of dimension names
    character(len=20)                          :: io_type   !< flag indicating io type: "read" "overwrite"
    logical, dimension(max(1,var%num_bcs))     :: file_is_open !< flag indicating if file is open
    character(len=FMS_PATH_LEN)                          :: dir       !< Directory where to open the file
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_register_restarts_2d: var%bc and var%bc_r4 are both initialized,"//&
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_register_restarts_2d: var%bc and var%bc_r4 are both uninitialized,"//&
                                "one should be associated per type to register restart fields")
        endif
      endif
    endif
 
    ocn_rest = .true.
    if (present(ocean_restart)) ocn_rest = ocean_restart
 
    if (present(directory)) dir = trim(directory)
 
    if (to_read) then
        io_type = "read"
        if (.not. present(directory)) dir = "INPUT/"
    else
        io_type = "overwrite"
        if (.not. present(directory)) dir = "RESTART/"
    endif
 
    num_rest_files = 0
 
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
      ! Determine the number and names of the restart files
      do n = 1, var%num_bcs
        if (var%bc(n)%num_fields <= 0) cycle
        file_nm = trim(var%bc(n)%ice_restart_file)
        if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file)
        do f = 1, num_rest_files
          if (trim(file_nm) == trim(rest_file_names(f))) exit
        enddo
        if (f>num_rest_files) then
          num_rest_files = num_rest_files + 1
          rest_file_names(f) = trim(file_nm)
        endif
      enddo
 
      if (num_rest_files == 0) return
 
      allocate(bc_rest_files(num_rest_files))
 
      !< Open the files
      do n = 1, num_rest_files
          file_is_open(n) = open_file(bc_rest_files(n), trim(dir)//rest_file_names(n), io_type, mpp_domain, &
                                    & is_restart=.true.)
          if (file_is_open(n)) then
              call register_axis_wrapper(bc_rest_files(n), to_read=to_read)
          endif
      enddo
 
      ! Register the fields with the restart files
      do n = 1, var%num_bcs
        if (var%bc(n)%num_fields <= 0) cycle
 
        file_nm = trim(var%bc(n)%ice_restart_file)
        if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file)
        do f = 1, num_rest_files
          if (trim(file_nm) == trim(rest_file_names(f))) exit
        enddo
 
        var%bc(n)%fms2_io_rest_type => bc_rest_files(f)
 
        do m = 1, var%bc(n)%num_fields
          if (file_is_open(f)) then
              if( to_read .and. variable_exists(bc_rest_files(f), var%bc(n)%field(m)%name)) then
                  !< If reading get the dimension names from the file
                  allocate(dim_names(get_variable_num_dimensions(bc_rest_files(f), var%bc(n)%field(m)%name)))
                  call get_variable_dimension_names(bc_rest_files(f), &
                  & var%bc(n)%field(m)%name, dim_names)
              else
                  !< If writing use dummy dimension names
                  allocate(dim_names(3))
                  dim_names(1) = "xaxis_1"
                  dim_names(2) = "yaxis_1"
                  dim_names(3) = "Time"
              endif !< to_read
 
              call register_restart_field(bc_rest_files(f),&
              & var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, dim_names, &
              & is_optional=var%bc(n)%field(m)%may_init )
 
              deallocate(dim_names)
          endif !< If file_is_open
        enddo !< num_fields
      enddo !< num_bcs
    else if(associated(var%bc_r4)) then
      ! Determine the number and names of the restart files
      do n = 1, var%num_bcs
        if (var%bc_r4(n)%num_fields <= 0) cycle
        file_nm = trim(var%bc_r4(n)%ice_restart_file)
        if (ocn_rest) file_nm = trim(var%bc_r4(n)%ocean_restart_file)
        do f = 1, num_rest_files
          if (trim(file_nm) == trim(rest_file_names(f))) exit
        enddo
        if (f>num_rest_files) then
          num_rest_files = num_rest_files + 1
          rest_file_names(f) = trim(file_nm)
        endif
      enddo
 
      if (num_rest_files == 0) return
 
      allocate(bc_rest_files(num_rest_files))
 
      !< Open the files
      do n = 1, num_rest_files
          file_is_open(n) = open_file(bc_rest_files(n), trim(dir)//rest_file_names(n), io_type, mpp_domain, &
                                    & is_restart=.true.)
          if (file_is_open(n)) then
              call register_axis_wrapper(bc_rest_files(n), to_read=to_read)
          endif
      enddo
 
      ! Register the fields with the restart files
      do n = 1, var%num_bcs
        if (var%bc_r4(n)%num_fields <= 0) cycle
 
        file_nm = trim(var%bc_r4(n)%ice_restart_file)
        if (ocn_rest) file_nm = trim(var%bc_r4(n)%ocean_restart_file)
        do f = 1, num_rest_files
          if (trim(file_nm) == trim(rest_file_names(f))) exit
        enddo
 
        var%bc_r4(n)%fms2_io_rest_type => bc_rest_files(f)
 
        do m = 1, var%bc_r4(n)%num_fields
          if (file_is_open(f)) then
              if( to_read .and. variable_exists(bc_rest_files(f), var%bc_r4(n)%field(m)%name)) then
                  !< If reading get the dimension names from the file
                  allocate(dim_names(get_variable_num_dimensions(bc_rest_files(f), var%bc_r4(n)%field(m)%name)))
                  call get_variable_dimension_names(bc_rest_files(f), &
                  & var%bc_r4(n)%field(m)%name, dim_names)
              else
                  !< If writing use dummy dimension names
                  allocate(dim_names(3))
                  dim_names(1) = "xaxis_1"
                  dim_names(2) = "yaxis_1"
                  dim_names(3) = "Time"
              endif !< to_read
 
              call register_restart_field(bc_rest_files(f),&
              & var%bc_r4(n)%field(m)%name, var%bc_r4(n)%field(m)%values, dim_names, &
              & is_optional=var%bc_r4(n)%field(m)%may_init )
 
              deallocate(dim_names)
          endif !< If file_is_open
        enddo !< num_fields
      enddo !< num_bcs
    else
      call mpp_error(fatal, "CT_register_restarts_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif ! associated(var%bc/r4)
 
  end subroutine ct_register_restarts_2d
 
  !< If reading a restart, register the dimensions that are in the file
  subroutine register_axis_wrapper_read(fileobj)
    type(fmsnetcdfdomainfile_t), intent(inout) :: fileobj !< Domain decomposed fileobj
 
    character(len=20), dimension(:), allocatable :: file_dim_names !< Array of dimension names
    integer :: i !< No description
    integer :: dim_size !< Size of the dimension
    integer :: ndims !< Number of dimensions in the file
    logical :: is_domain_decomposed !< Flag indication if domain decomposed
    character(len=1) :: buffer !< string buffer
 
    ndims = get_num_dimensions(fileobj)
    allocate(file_dim_names(ndims))
 
    call get_dimension_names(fileobj, file_dim_names)
 
    do i = 1, ndims
       is_domain_decomposed = .false.
 
       !< Check if the dimension is also a variable
       if (variable_exists(fileobj, file_dim_names(i))) then
 
          !< If the variable exists look for the "cartesian_axis" or "axis" variable attribute
          if (variable_att_exists(fileobj, file_dim_names(i), "axis")) then
              call get_variable_attribute(fileobj, file_dim_names(i), "axis", buffer)
 
              !< If the attribute exists and it is "x" or "y" register it as a domain decomposed dimension
              if (lowercase(buffer) .eq. "x" .or. lowercase(buffer) .eq. "y" ) then
                  is_domain_decomposed = .true.
                  call register_axis(fileobj, file_dim_names(i), buffer)
              endif
 
          else if (variable_att_exists(fileobj, file_dim_names(i), "cartesian_axis")) then
              call get_variable_attribute(fileobj, file_dim_names(i), "cartesian_axis", buffer)
 
              !< If the attribute exists and it "x" or "y" register it as a domain decomposed dimension
              if (lowercase(buffer) .eq. "x" .or. lowercase(buffer) .eq. "y" ) then
                  is_domain_decomposed = .true.
                  call register_axis(fileobj, file_dim_names(i), buffer)
              endif
 
          endif !< If variable attribute exists
       endif !< If variable exists
 
       if (.not. is_domain_decomposed) then
          call get_dimension_size(fileobj, file_dim_names(i), dim_size)
          call register_axis(fileobj, file_dim_names(i), dim_size)
       endif
 
    end do
 
  end subroutine register_axis_wrapper_read
 
  !< If writing a restart, register the variables with dummy axis names
  subroutine register_axis_wrapper_write(fileobj, nz)
    type(fmsnetcdfdomainfile_t), intent(inout) :: fileobj !< Domain decomposed fileobj
    integer, intent(in), optional :: nz !< length of the z dimension
 
    character(len=20) :: dim_names(4) !< Array of dimension names
 
    dim_names(1) = "xaxis_1"
    dim_names(2) = "yaxis_1"
 
    call register_axis(fileobj, dim_names(1), "x")
    call register_axis(fileobj, dim_names(2), "y")
 
    !< If nz is present register a zaxis
    if (.not. present(nz)) then
       dim_names(3) = "Time"
       call register_axis(fileobj, dim_names(3), unlimited)
    else
       dim_names(3) = "zaxis_1"
       dim_names(4) = "Time"
 
       call register_axis(fileobj, dim_names(3), nz)
       call register_axis(fileobj, dim_names(4), unlimited)
    endif !< if (.not. present(nz))
 
    !< Add the dimension names as variable so that the combiner can work correctly
    call register_field(fileobj, dim_names(1), "double", (/dim_names(1)/))
    call register_variable_attribute(fileobj, dim_names(1), "axis", "X", str_len=1)
 
    call register_field(fileobj, dim_names(2), "double", (/dim_names(2)/))
    call register_variable_attribute(fileobj, dim_names(2), "axis", "Y", str_len=1)
 
  end subroutine register_axis_wrapper_write
 
  subroutine register_axis_wrapper(fileobj, to_read, nz)
    type(fmsnetcdfdomainfile_t), intent(inout) :: fileobj !< Domain decomposed fileobj
    logical, intent(in) :: to_read !< Flag indicating if reading file
    integer, intent(in), optional :: nz !< length of the z dimension
 
    if (to_read) then
        call register_axis_wrapper_read(fileobj)
    else
        call register_axis_wrapper_write(fileobj, nz)
    endif
 
  end subroutine register_axis_wrapper
 
  !! @brief Register the fields in a coupler_3d_bc_type to be saved in restart files
  !! This subroutine registers the fields in a coupler_2d_bc_type to be saved in restart files
  !! specified in the field table.
  subroutine ct_register_restarts_3d(var, bc_rest_files, num_rest_files, mpp_domain, to_read, ocean_restart, directory)
    type(coupler_3d_bc_type), intent(inout) :: var  !< BC_type structure to be registered for restarts
    type(fmsnetcdfdomainfile_t),  dimension(:), pointer  :: bc_rest_files !< Structures describing the restart files
    integer,                  intent(out) :: num_rest_files !< The number of restart files to use
    type(domain2d),           intent(in)  :: mpp_domain     !< The FMS domain to use for this registration call
    logical,                  intent(in)  :: to_read        !< Flag indicating if reading/writing a file
    logical,         optional,intent(in)  :: ocean_restart  !< If true, use the ocean restart file name.
    character(len=*),optional,intent(in)  :: directory      !< Directory where to open the file
 
    character(len=FMS_FILE_LEN), dimension(max(1,var%num_bcs)) :: rest_file_names
    character(len=FMS_FILE_LEN) :: file_nm
    logical :: ocn_rest
    integer :: f, n, m
 
    character(len=20), allocatable, dimension(:) :: dim_names !< Array of dimension names
    character(len=20)                          :: io_type   !< flag indicating io type: "read" "overwrite"
    logical, dimension(max(1,var%num_bcs))     :: file_is_open !< Flag indicating if file is open
    character(len=FMS_PATH_LEN)                :: dir       !< Directory where to open the file
    integer                                    :: nz        !< Length of the z direction of each file
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_register_restarts_3d: var%bc and var%bc_r4 are both initialized,"//&
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_register_restarts_3d: var%bc and var%bc_r4 are both uninitialized,"//&
                                "one should be associated per type to register restart fields")
        endif
      endif
    endif
 
    ocn_rest = .true.
    if (present(ocean_restart)) ocn_rest = ocean_restart
 
    if (present(directory)) dir = trim(directory)
 
    if (to_read) then
        io_type = "read"
        if (.not. present(directory)) dir = "INPUT/"
    else
        io_type = "overwrite"
        if (.not. present(directory)) dir = "RESTART/"
    endif
 
    nz = var%ke - var%ks + 1 !< NOTE: This assumes that the z dimension is the same for every variable
    num_rest_files = 0
 
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
      ! Determine the number and names of the restart files
      do n = 1, var%num_bcs
        if (var%bc(n)%num_fields <= 0) cycle
        file_nm = trim(var%bc(n)%ice_restart_file)
        if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file)
        do f = 1, num_rest_files
          if (trim(file_nm) == trim(rest_file_names(f))) exit
        enddo
        if (f>num_rest_files) then
          num_rest_files = num_rest_files + 1
          rest_file_names(f) = trim(file_nm)
        endif
      enddo
 
      if (num_rest_files == 0) return
 
      allocate(bc_rest_files(num_rest_files))
 
      !< Open the files
      do n = 1, num_rest_files
          file_is_open(n) = open_file(bc_rest_files(n), trim(dir)//rest_file_names(n), io_type, mpp_domain, &
                                    & is_restart=.true.)
          if (file_is_open(n)) then
 
              if (to_read) then
                  call register_axis_wrapper(bc_rest_files(n), to_read=to_read)
              else
                  call register_axis_wrapper(bc_rest_files(n), to_read=to_read, nz=nz)
              endif
          endif
      enddo
 
      ! Register the fields with the restart files
      do n = 1, var%num_bcs
        if (var%bc(n)%num_fields <= 0) cycle
 
        file_nm = trim(var%bc(n)%ice_restart_file)
        if (ocn_rest) file_nm = trim(var%bc(n)%ocean_restart_file)
        do f = 1, num_rest_files
          if (trim(file_nm) == trim(rest_file_names(f))) exit
        enddo
 
        var%bc(n)%fms2_io_rest_type => bc_rest_files(f)
 
        do m = 1, var%bc(n)%num_fields
          if (file_is_open(f)) then
              if( to_read .and. variable_exists(bc_rest_files(f), var%bc(n)%field(m)%name)) then
                  !< If reading get the dimension names from the file
                  allocate(dim_names(get_variable_num_dimensions(bc_rest_files(f), var%bc(n)%field(m)%name)))
                  call get_variable_dimension_names(bc_rest_files(f), &
                  & var%bc(n)%field(m)%name, dim_names)
              else
                  !< If writing use dummy dimension names
                  allocate(dim_names(4))
                  dim_names(1) = "xaxis_1"
                  dim_names(2) = "yaxis_1"
                  dim_names(3) = "zaxis_1"
                  dim_names(4) = "Time"
              endif !< to_read
 
              call register_restart_field(bc_rest_files(f),&
                  & var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, dim_names, &
                  & is_optional=var%bc(n)%field(m)%may_init )
              deallocate(dim_names)
          endif !< If file_is_open
        enddo !< num_fields
      enddo !< num_bcs
    else if(associated(var%bc_r4)) then
      ! Determine the number and names of the restart files
      do n = 1, var%num_bcs
        if (var%bc_r4(n)%num_fields <= 0) cycle
        file_nm = trim(var%bc_r4(n)%ice_restart_file)
        if (ocn_rest) file_nm = trim(var%bc_r4(n)%ocean_restart_file)
        do f = 1, num_rest_files
          if (trim(file_nm) == trim(rest_file_names(f))) exit
        enddo
        if (f>num_rest_files) then
          num_rest_files = num_rest_files + 1
          rest_file_names(f) = trim(file_nm)
        endif
      enddo
 
      if (num_rest_files == 0) return
 
      allocate(bc_rest_files(num_rest_files))
 
      !< Open the files
      do n = 1, num_rest_files
          file_is_open(n) = open_file(bc_rest_files(n), trim(dir)//rest_file_names(n), io_type, mpp_domain, &
                                    & is_restart=.true.)
          if (file_is_open(n)) then
 
              if (to_read) then
                  call register_axis_wrapper(bc_rest_files(n), to_read=to_read)
              else
                  call register_axis_wrapper(bc_rest_files(n), to_read=to_read, nz=nz)
              endif
          endif
      enddo
 
      ! Register the fields with the restart files
      do n = 1, var%num_bcs
        if (var%bc_r4(n)%num_fields <= 0) cycle
 
        file_nm = trim(var%bc_r4(n)%ice_restart_file)
        if (ocn_rest) file_nm = trim(var%bc_r4(n)%ocean_restart_file)
        do f = 1, num_rest_files
          if (trim(file_nm) == trim(rest_file_names(f))) exit
        enddo
 
        var%bc_r4(n)%fms2_io_rest_type => bc_rest_files(f)
 
        do m = 1, var%bc_r4(n)%num_fields
          if (file_is_open(f)) then
              if( to_read .and. variable_exists(bc_rest_files(f), var%bc_r4(n)%field(m)%name)) then
                  !< If reading get the dimension names from the file
                  allocate(dim_names(get_variable_num_dimensions(bc_rest_files(f), var%bc_r4(n)%field(m)%name)))
                  call get_variable_dimension_names(bc_rest_files(f), &
                  & var%bc_r4(n)%field(m)%name, dim_names)
              else
                  !< If writing use dummy dimension names
                  allocate(dim_names(4))
                  dim_names(1) = "xaxis_1"
                  dim_names(2) = "yaxis_1"
                  dim_names(3) = "zaxis_1"
                  dim_names(4) = "Time"
              endif !< to_read
 
              call register_restart_field(bc_rest_files(f),&
                  & var%bc_r4(n)%field(m)%name, var%bc_r4(n)%field(m)%values, dim_names, &
                  & is_optional=var%bc_r4(n)%field(m)%may_init )
              deallocate(dim_names)
          endif !< If file_is_open
        enddo !< num_fields
      enddo !< num_bcs
    else
      call mpp_error(fatal, "CT_register_restarts_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_register_restarts_3d
 
  subroutine ct_restore_state_2d(var, use_fms2_io, directory, all_or_nothing, all_required, test_by_field)
    type(coupler_2d_bc_type), intent(inout) :: var  !< BC_type structure to restore from restart files
    character(len=*), optional, intent(in)  :: directory !< A directory where the restart files should
                                                    !! be found.  The default for FMS is 'INPUT'.
    logical,        optional, intent(in)    :: all_or_nothing !< If true and there are non-mandatory
                                                    !! restart fields, it is still an error if some
                                                    !! fields are read successfully but others are not.
    logical,        optional, intent(in)    :: all_required !< If true, all fields must be successfully
                                                    !! read from the restart file, even if they were
                                                    !! registered as not mandatory.
    logical,        optional, intent(in)    :: test_by_field !< If true, all or none of the variables
                                                    !! in a single field must be read successfully.
    logical,        intent(in)    :: use_fms2_io !< This is just to distinguish the interfaces
 
    integer :: n, m, num_fld
    character(len=80) :: unset_varname
    logical :: any_set, all_set, all_var_set, any_var_set, var_set
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_restore_state_2d: var%bc and var%bc_r4 are both initialized," // &
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_restore_state_2d: var%bc and var%bc_r4 are both uninitialized," // &
                                "one should be associated per type to restore state from restart")
        endif
      endif
    endif
 
    any_set = .false.
    all_set = .true.
    num_fld = 0
    unset_varname = ""
 
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
      do n = 1, var%num_bcs
        any_var_set = .false.
        all_var_set = .true.
        do m = 1, var%bc(n)%num_fields
          var_set = .false.
          if (check_if_open(var%bc(n)%fms2_io_rest_type)) then
              var_set = variable_exists(var%bc(n)%fms2_io_rest_type, var%bc(n)%field(m)%name)
          endif
 
          if (.not.var_set) unset_varname = trim(var%bc(n)%field(m)%name)
          if (var_set) any_set = .true.
          if (all_set) all_set = var_set
          if (var_set) any_var_set = .true.
          if (all_var_set) all_var_set = var_set
        enddo
 
        num_fld = num_fld + var%bc(n)%num_fields
        if ((var%bc(n)%num_fields > 0) .and. present(test_by_field)) then
          if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(fatal,&
              & "CT_restore_state_2d: test_by_field is true, and "//&
              & trim(unset_varname)//" was not read but some other fields in "//&
              & trim(trim(var%bc(n)%name))//" were.")
        endif
      enddo
    else if(associated(var%bc_r4)) then
      do n = 1, var%num_bcs
        any_var_set = .false.
        all_var_set = .true.
        do m = 1, var%bc_r4(n)%num_fields
          var_set = .false.
          if (check_if_open(var%bc_r4(n)%fms2_io_rest_type)) then
              var_set = variable_exists(var%bc_r4(n)%fms2_io_rest_type, var%bc_r4(n)%field(m)%name)
          endif
 
          if (.not.var_set) unset_varname = trim(var%bc_r4(n)%field(m)%name)
          if (var_set) any_set = .true.
          if (all_set) all_set = var_set
          if (var_set) any_var_set = .true.
          if (all_var_set) all_var_set = var_set
        enddo
 
        num_fld = num_fld + var%bc_r4(n)%num_fields
        if ((var%bc_r4(n)%num_fields > 0) .and. present(test_by_field)) then
          if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(fatal,&
              & "CT_restore_state_2d: test_by_field is true, and "//&
              & trim(unset_varname)//" was not read but some other fields in "//&
              & trim(trim(var%bc_r4(n)%name))//" were.")
        endif
      enddo
    else
      call mpp_error(fatal, "CT_restore_state_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
 
    if ((num_fld > 0) .and. present(all_or_nothing)) then
      if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(fatal,&
          & "CT_restore_state_2d: all_or_nothing is true, and "//&
          & trim(unset_varname)//" was not read but some other fields were.")
    endif
 
    if (present(all_required)) then
      if (all_required .and. .not.all_set) then
        call mpp_error(fatal, "CT_restore_state_2d: all_required is true, but "//&
            & trim(unset_varname)//" was not read from its restart file.")
      endif
    endif
  end subroutine ct_restore_state_2d
 
  !> @brief Read in fields from restart files into a coupler_3d_bc_type
  !!
  !! This subroutine reads in the fields in a coupler_3d_bc_type that have been saved in restart
  !! files.
  subroutine ct_restore_state_3d(var, use_fms2_io, directory, all_or_nothing, all_required, test_by_field)
    type(coupler_3d_bc_type), intent(inout) :: var  !< BC_type structure to restore from restart files
    character(len=*), optional, intent(in)  :: directory !< A directory where the restart files should
                                                    !! be found.  The default for FMS is 'INPUT'.
    logical,        intent(in)              :: use_fms2_io !< This is just to distinguish the interfaces
    logical,        optional, intent(in)    :: all_or_nothing !< If true and there are non-mandatory
                                                    !! restart fields, it is still an error if some
                                                    !! fields are read successfully but others are not.
    logical,        optional, intent(in)    :: all_required !< If true, all fields must be successfully
                                                    !! read from the restart file, even if they were
                                                    !! registered as not mandatory.
    logical,        optional, intent(in)    :: test_by_field !< If true, all or none of the variables
                                                    !! in a single field must be read successfully.
 
    integer :: n, m, num_fld
    character(len=80) :: unset_varname
    logical :: any_set, all_set, all_var_set, any_var_set, var_set
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_restore_state_3d: var%bc and var%bc_r4 are both initialized," // &
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_restore_state_3d: var%bc and var%bc_r4 are both uninitialized," // &
                                "one should be associated per type to restore state from restart")
        endif
      endif
    endif
 
    any_set = .false.
    all_set = .true.
    num_fld = 0
    unset_varname = ""
 
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
      do n = 1, var%num_bcs
        any_var_set = .false.
        all_var_set = .true.
        do m = 1, var%bc(n)%num_fields
          var_set = .false.
          if (check_if_open(var%bc(n)%fms2_io_rest_type)) then
              var_set = variable_exists(var%bc(n)%fms2_io_rest_type, var%bc(n)%field(m)%name)
          endif
 
          if (.not.var_set) unset_varname = trim(var%bc(n)%field(m)%name)
 
          if (var_set) any_set = .true.
          if (all_set) all_set = var_set
          if (var_set) any_var_set = .true.
          if (all_var_set) all_var_set = var_set
        enddo
 
        num_fld = num_fld + var%bc(n)%num_fields
        if ((var%bc(n)%num_fields > 0) .and. present(test_by_field)) then
          if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(fatal,&
              & "CT_restore_state_3d: test_by_field is true, and "//&
              & trim(unset_varname)//" was not read but some other fields in "//&
              & trim(trim(var%bc(n)%name))//" were.")
        endif
      enddo
    else if(associated(var%bc_r4)) then
      do n = 1, var%num_bcs
        any_var_set = .false.
        all_var_set = .true.
        do m = 1, var%bc_r4(n)%num_fields
          var_set = .false.
          if (check_if_open(var%bc_r4(n)%fms2_io_rest_type)) then
              var_set = variable_exists(var%bc_r4(n)%fms2_io_rest_type, var%bc_r4(n)%field(m)%name)
          endif
 
          if (.not.var_set) unset_varname = trim(var%bc_r4(n)%field(m)%name)
 
          if (var_set) any_set = .true.
          if (all_set) all_set = var_set
          if (var_set) any_var_set = .true.
          if (all_var_set) all_var_set = var_set
        enddo
 
        num_fld = num_fld + var%bc_r4(n)%num_fields
        if ((var%bc_r4(n)%num_fields > 0) .and. present(test_by_field)) then
          if (test_by_field .and. (all_var_set .neqv. any_var_set)) call mpp_error(fatal,&
              & "CT_restore_state_3d: test_by_field is true, and "//&
              & trim(unset_varname)//" was not read but some other fields in "//&
              & trim(trim(var%bc(n)%name))//" were.")
        endif
      enddo
    else
      call mpp_error(fatal, "CT_restore_state_3d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
 
 
    if ((num_fld > 0) .and. present(all_or_nothing)) then
      if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(fatal,&
          & "CT_restore_state_3d: all_or_nothing is true, and "//&
          & trim(unset_varname)//" was not read but some other fields were.")
    endif
 
    if (present(all_required)) then
      if (all_required .and. .not.all_set) then
        call mpp_error(fatal, "CT_restore_state_3d: all_required is true, but "//&
            & trim(unset_varname)//" was not read from its restart file.")
      endif
    endif
  end subroutine ct_restore_state_3d
 
 
  !> @brief Potentially override the values in a coupler_2d_bc_type
  subroutine ct_data_override_2d(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
    integer :: m, n
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_data_override_2d: var%bc and var%bc_r4 are both initialized," // &
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_data_override_2d: var%bc and var%bc_r4 are both uninitialized," // &
                                "one should be associated per type to perform data override")
        endif
      endif
    endif
 
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
      do n = 1, var%num_bcs
        do m = 1, var%bc(n)%num_fields
          call data_override(gridname, var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, time)
        enddo
      enddo
    else if(associated(var%bc_r4)) then
      do n = 1, var%num_bcs
        do m = 1, var%bc_r4(n)%num_fields
          call data_override(gridname, var%bc_r4(n)%field(m)%name, var%bc_r4(n)%field(m)%values, time)
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_data_override_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_data_override_2d
 
  !> @brief Potentially override the values in a coupler_3d_bc_type
  subroutine ct_data_override_3d(gridname, var, Time)
    character(len=3),         intent(in)    :: gridname !< 3-character long model grid ID
    type(coupler_3d_bc_type), intent(inout) :: var  !< BC_type structure to override
    type(time_type),          intent(in)    :: time !< The current model time
    !! TODO remove this when data_override is merged in
    real(r8_kind), allocatable :: r8_field_values(:,:,:)
 
    integer :: m, n
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_data_override_3d: var%bc and var%bc_r4 are both initialized," // &
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_data_override_3d: var%bc and var%bc_r4 are both uninitialized," // &
                                "one should be associated per type to perform data override")
        endif
      endif
    endif
 
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
      do n = 1, var%num_bcs
        do m = 1, var%bc(n)%num_fields
          call data_override(gridname, var%bc(n)%field(m)%name, var%bc(n)%field(m)%values, time)
        enddo
      enddo
    else if(associated(var%bc_r4)) then
      do n = 1, var%num_bcs
        do m = 1, var%bc_r4(n)%num_fields
          call data_override(gridname, var%bc_r4(n)%field(m)%name, var%bc_r4(n)%field(m)%values, time)
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_data_override_3d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
 
  end subroutine ct_data_override_3d
 
 
  !> @brief Write out checksums for the elements of a coupler_2d_bc_type
  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
 
    character(len=120) :: var_name
    integer :: m, n
    integer(i8_kind) :: chks ! A checksum for the field
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_write_chksums_2d: var%bc and var%bc_r4 are both initialized," // &
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_write_chksums_2d: var%bc and var%bc_r4 are both uninitialized," // &
                                "one should be associated per type to write checksums for fields")
        endif
      endif
    endif
 
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
      do n = 1, var%num_bcs
        do m = 1, var%bc(n)%num_fields
          if (present(name_lead)) then
            var_name = trim(name_lead)//trim(var%bc(n)%field(m)%name)
          else
            var_name = trim(var%bc(n)%field(m)%name)
          endif
          chks = mpp_chksum(var%bc(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec))
          if(outunit.ne.0) write(outunit, '("   CHECKSUM:: ",A40," = ",Z20)') trim(var_name), chks
        enddo
      enddo
    else if(associated(var%bc_r4)) then
      do n = 1, var%num_bcs
        do m = 1, var%bc_r4(n)%num_fields
          if (present(name_lead)) then
            var_name = trim(name_lead)//trim(var%bc_r4(n)%field(m)%name)
          else
            var_name = trim(var%bc_r4(n)%field(m)%name)
          endif
          chks = mpp_chksum(var%bc_r4(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec))
          if(outunit.ne.0) write(outunit, '("   CHECKSUM:: ",A40," = ",Z20)') trim(var_name), chks
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_write_chksums_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
  end subroutine ct_write_chksums_2d
 
  !> @brief 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
 
    character(len=120) :: var_name
    integer :: m, n
    integer(i8_kind) :: chks ! A checksum for the field
 
    if(var%set .and. var%num_bcs .gt. 0) then
      if(associated(var%bc) .eqv. associated(var%bc_r4)) then
        if( associated(var%bc) ) then
          call mpp_error(fatal, "CT_write_chksums_3d: var%bc and var%bc_r4 are both initialized," // &
                                "only one should be associated per type")
        else
          call mpp_error(fatal, "CT_write_chksums_3d: var%bc and var%bc_r4 are both uninitialized," // &
           "one should be associated per type to write checksums for fields")
        endif
      endif
    endif
 
    if(associated(var%bc) .or. var%num_bcs .lt. 1) then
      do n = 1, var%num_bcs
        do m = 1, var%bc(n)%num_fields
          if (present(name_lead)) then
            var_name = trim(name_lead)//trim(var%bc(n)%field(m)%name)
          else
            var_name = trim(var%bc(n)%field(m)%name)
          endif
          chks = mpp_chksum(var%bc(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec,:))
          if(outunit.ne.0) write(outunit, '("   CHECKSUM:: ",A40," = ",Z20)') trim(var_name), chks
        enddo
      enddo
    else if(associated(var%bc_r4)) then
      do n = 1, var%num_bcs
        do m = 1, var%bc_r4(n)%num_fields
          if (present(name_lead)) then
            var_name = trim(name_lead)//trim(var%bc_r4(n)%field(m)%name)
          else
            var_name = trim(var%bc_r4(n)%field(m)%name)
          endif
          chks = mpp_chksum(var%bc_r4(n)%field(m)%values(var%isc:var%iec,var%jsc:var%jec,:))
          if(outunit.ne.0) write(outunit, '("   CHECKSUM:: ",A40," = ",Z20)') trim(var_name), chks
        enddo
      enddo
    else
      call mpp_error(fatal, "CT_write_chksums_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
    endif
 
  end subroutine ct_write_chksums_3d
 
  !> @brief Indicate whether a coupler_1d_bc_type has been initialized.
  !! @return Logical
  logical function ct_initialized_1d(var)
    type(coupler_1d_bc_type), intent(in) :: var  !< BC_type structure to check initialization
 
    ct_initialized_1d = var%set
  end function ct_initialized_1d
 
  !> @brief Indicate whether a coupler_2d_bc_type has been initialized.
  !! @return Logical
  logical function ct_initialized_2d(var)
    type(coupler_2d_bc_type), intent(in) :: var  !< BC_type structure to check initialization
 
    ct_initialized_2d = var%set
  end function ct_initialized_2d
 
  !> @brief Indicate whether a coupler_3d_bc_type has been initialized.
  !! @return Logical
  logical function ct_initialized_3d(var)
    type(coupler_3d_bc_type), intent(in) :: var  !< BC_type structure to check initialization
 
    ct_initialized_3d = var%set
  end function ct_initialized_3d
 
  !> @brief 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
 
    integer :: m, n
 
    if (var%num_bcs > 0) then
      if(associated(var%bc)) then
        do n = 1, var%num_bcs
          do m = 1, var%bc(n)%num_fields
            deallocate ( var%bc(n)%field(m)%values )
          enddo
          deallocate ( var%bc(n)%field )
        enddo
        deallocate ( var%bc )
      else if(associated(var%bc_r4)) then
        do n = 1, var%num_bcs
          do m = 1, var%bc_r4(n)%num_fields
            deallocate ( var%bc_r4(n)%field(m)%values )
          enddo
          deallocate ( var%bc_r4(n)%field )
        enddo
        deallocate ( var%bc_r4 )
      else
        call mpp_error(fatal, "CT_destructor_1d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
      endif
    endif
 
    var%num_bcs = 0
    var%set = .false.
  end subroutine ct_destructor_1d
 
  !> @brief 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
 
    integer :: m, n
 
    if (var%num_bcs > 0) then
      if(associated(var%bc)) then
        do n = 1, var%num_bcs
          do m = 1, var%bc(n)%num_fields
            deallocate ( var%bc(n)%field(m)%values )
          enddo
          deallocate ( var%bc(n)%field )
        enddo
        deallocate ( var%bc )
      else if(associated(var%bc_r4)) then
        do n = 1, var%num_bcs
          do m = 1, var%bc_r4(n)%num_fields
            deallocate ( var%bc_r4(n)%field(m)%values )
          enddo
          deallocate ( var%bc_r4(n)%field )
        enddo
        deallocate ( var%bc_r4 )
      else
        call mpp_error(fatal, "CT_destructor_2d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
      endif
    endif
 
    var%num_bcs = 0
    var%set = .false.
  end subroutine ct_destructor_2d
 
  !> @brief Deallocate all data associated with a coupler_3d_bc_type
  subroutine ct_destructor_3d(var)
    type(coupler_3d_bc_type), intent(inout) :: var  !< BC_type structure to be deconstructed
 
    integer :: m, n
 
    if (var%num_bcs > 0) then
      if(associated(var%bc)) then
        do n = 1, var%num_bcs
          do m = 1, var%bc(n)%num_fields
            deallocate ( var%bc(n)%field(m)%values )
          enddo
          deallocate ( var%bc(n)%field )
        enddo
        deallocate ( var%bc )
      else if(associated(var%bc_r4)) then
        do n = 1, var%num_bcs
          do m = 1, var%bc_r4(n)%num_fields
            deallocate ( var%bc_r4(n)%field(m)%values )
          enddo
          deallocate ( var%bc_r4(n)%field )
        enddo
        deallocate ( var%bc_r4 )
      else
        call mpp_error(fatal, "CT_destructor_3d: passed in type has unassociated coupler_field_type"// &
                              " pointers for both bc and bc_r4")
      endif
 
    endif
 
    var%num_bcs = 0
    var%set = .false.
  end subroutine ct_destructor_3d
 
#include "coupler_types_r4.fh"
#include "coupler_types_r8.fh"
 
end module coupler_types_mod
!> @}
! close documentation grouping