Skip to content

Commit

Permalink
Merge pull request mom-ocean#1352 from Hallberg-NOAA/FMS2_io
Browse files Browse the repository at this point in the history
+Enable FMS2 interface reads (includes merge of PR mom-ocean#1165)
  • Loading branch information
marshallward authored Mar 26, 2021
2 parents b92d763 + f6105cb commit fe9b2a1
Show file tree
Hide file tree
Showing 19 changed files with 7,578 additions and 150 deletions.
616 changes: 616 additions & 0 deletions config_src/infra/FMS2/MOM_axis.F90

Large diffs are not rendered by default.

455 changes: 455 additions & 0 deletions config_src/infra/FMS2/MOM_coms_infra.F90

Large diffs are not rendered by default.

14 changes: 14 additions & 0 deletions config_src/infra/FMS2/MOM_constants.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
!> Provides a few physical constants
module MOM_constants

! This file is part of MOM6. See LICENSE.md for the license.

use constants_mod, only : HLV, HLF

implicit none ; private

!> The constant offset for converting temperatures in Kelvin to Celsius
real, public, parameter :: CELSIUS_KELVIN_OFFSET = 273.15
public :: HLV, HLF

end module MOM_constants
247 changes: 247 additions & 0 deletions config_src/infra/FMS2/MOM_couplertype_infra.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,247 @@
!> This module wraps the FMS coupler types module
module MOM_couplertype_infra

! This file is part of MOM6. See LICENSE.md for the license.

use coupler_types_mod, only : coupler_type_spawn, coupler_type_initialized, coupler_type_destructor
use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data
use coupler_types_mod, only : coupler_type_write_chksums
use coupler_types_mod, only : coupler_type_copy_data, coupler_type_increment_data
use coupler_types_mod, only : coupler_type_extract_data, coupler_type_set_data
use coupler_types_mod, only : ind_flux, ind_alpha, ind_csurf
use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type
use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux
use MOM_time_manager, only : time_type

implicit none ; private

public :: CT_spawn, CT_initialized, CT_destructor
public :: CT_set_diags, CT_send_data, CT_write_chksums
public :: CT_set_data, CT_increment_data
public :: CT_copy_data, CT_extract_data
public :: atmos_ocn_coupler_flux
public :: ind_flux, ind_alpha, ind_csurf
public :: coupler_1d_bc_type, coupler_2d_bc_type

!> This is the interface to spawn one coupler_bc_type into another.
interface CT_spawn
module procedure CT_spawn_1d_2d, CT_spawn_2d_2d
end interface CT_spawn

!> This function interface indicates whether a coupler_bc_type has been initialized.
interface CT_initialized
module procedure CT_initialized_1d, CT_initialized_2d
end interface CT_initialized

!> This is the interface to deallocate any data associated with a coupler_bc_type.
interface CT_destructor
module procedure CT_destructor_1d, CT_destructor_2d
end interface CT_destructor

contains

!> This subroutine sets many of the parameters for calculating an atmosphere-ocean tracer flux
!! and retuns an integer index for that flux.
function atmos_ocn_coupler_flux(name, flux_type, implementation, param, mol_wt, &
ice_restart_file, ocean_restart_file, units, caller, verbosity) &
result (coupler_index)

character(len=*), intent(in) :: name !< A name to use for the flux
character(len=*), intent(in) :: flux_type !< A string describing the type of this flux,
!! perhaps 'air_sea_gas_flux'.
character(len=*), intent(in) :: implementation !< A name describing the specific
!! implementation of this flux, such as 'ocmip2'.
real, dimension(:), optional, intent(in) :: param !< An array of parameters used for the fluxes
real, optional, intent(in) :: mol_wt !< The molecular weight of this tracer
character(len=*), optional, intent(in) :: ice_restart_file !< A sea-ice restart file to use with this flux.
character(len=*), optional, intent(in) :: ocean_restart_file !< An ocean restart file to use with this flux.
character(len=*), optional, intent(in) :: units !< The units of the flux
character(len=*), optional, intent(in) :: caller !< The name of the calling routine
integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity.
integer :: coupler_index !< The resulting integer handle to use for this flux in subsequent calls.

coupler_index = aof_set_coupler_flux(name, flux_type, implementation, &
param=param, mol_wt=mol_wt, ice_restart_file=ice_restart_file, &
ocean_restart_file=ocean_restart_file, &
units=units, caller=caller, verbosity=verbosity)

end function atmos_ocn_coupler_flux

!> Generate a 2-D coupler type using a 1-D coupler type as a template.
subroutine CT_spawn_1d_2d(var_in, var, idim, jdim, suffix, as_needed)
type(coupler_1d_bc_type), intent(in) :: var_in !< structure from which to copy information
type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information
integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of
!! the first dimension in a non-decreasing list
integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of
!! the second dimension in a non-decreasing list
character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique
logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var)
!! is not set and the parent type (var_in) is set.

call coupler_type_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed)

end subroutine CT_spawn_1d_2d

!> Generate one 2-D coupler type using another 2-D coupler type as a template.
subroutine CT_spawn_2d_2d(var_in, var, idim, jdim, suffix, as_needed)
type(coupler_2d_bc_type), intent(in) :: var_in !< structure from which to copy information
type(coupler_2d_bc_type), intent(inout) :: var !< structure into which to copy information
integer, dimension(4), intent(in) :: idim !< The data and computational domain extents of
!! the first dimension in a non-decreasing list
integer, dimension(4), intent(in) :: jdim !< The data and computational domain extents of
!! the second dimension in a non-decreasing list
character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique
logical, optional, intent(in) :: as_needed !< Only do the spawn if the target type (var)
!! is not set and the parent type (var_in) is set.

call coupler_type_spawn(var_in, var, idim, jdim, suffix=suffix, as_needed=as_needed)

end subroutine CT_spawn_2d_2d

!> Copy all elements of the data in of one coupler_2d_bc_type into another. Both must have the same array sizes.
subroutine CT_copy_data(var_in, var, halo_size, bc_index, field_index, &
exclude_flux_type, only_flux_type, pass_through_ice)
type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to copy
type(coupler_2d_bc_type), intent(inout) :: var !< The recipient BC_type structure
integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default
integer, optional, intent(in) :: bc_index !< The index of the boundary condition
!! that is being copied
integer, optional, intent(in) :: field_index !< The index of the field in the
!! boundary condition that is being copied
character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes
!! to exclude from this copy.
character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes
!! to include from this copy.
logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose
!! value of pass_through ice matches this

call coupler_type_copy_data(var_in, var, halo_size, bc_index, field_index, &
exclude_flux_type, only_flux_type, pass_through_ice)
end subroutine CT_copy_data

!> Increment data in all elements of one coupler_2d_bc_type with the data from another. Both
!! must have the same array sizes.
subroutine CT_increment_data(var_in, var, halo_size, scale_factor, scale_prev)
type(coupler_2d_bc_type), intent(in) :: var_in !< coupler_type structure with the data to add to the other type
type(coupler_2d_bc_type), intent(inout) :: var !< The coupler_type structure whose fields are being incremented
integer, optional, intent(in) :: halo_size !< The extent of the halo to increment; 0 by default
real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added
real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here

call coupler_type_increment_data(var_in, var, halo_size=halo_size, scale_factor=scale_factor, &
scale_prev=scale_prev)

end subroutine CT_increment_data

!> Extract a 2d field from a coupler_2d_bc_type into a two-dimensional array.
subroutine CT_extract_data(var_in, bc_index, field_index, array_out, &
scale_factor, halo_size, idim, jdim)
type(coupler_2d_bc_type), intent(in) :: var_in !< BC_type structure with the data to extract
integer, intent(in) :: bc_index !< The index of the boundary condition
!! that is being copied
integer, intent(in) :: field_index !< The index of the field in the boundary
!! condition that is being copied, or the
!! surface flux by default.
real, dimension(1:,1:), intent(out) :: array_out !< The recipient array for the field; its size
!! must match the size of the data being copied
!! unless idim and jdim are supplied.
real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added
integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default
integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of
!! the first dimension of the output array
!! in a non-decreasing list
integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of
!! the second dimension of the output array
!! in a non-decreasing list
call coupler_type_extract_data(var_in, bc_index, field_index, array_out, scale_factor, halo_size, idim, jdim)

end subroutine CT_extract_data

!> Set single 2d field in coupler_2d_bc_type from a two-dimensional array.
subroutine CT_set_data(array_in, bc_index, field_index, var, &
scale_factor, halo_size, idim, jdim)
real, dimension(1:,1:), intent(in) :: array_in !< The source array for the field; its size
!! must match the size of the data being copied
!! unless idim and jdim are supplied.
integer, intent(in) :: bc_index !< The index of the boundary condition
!! that is being copied
integer, intent(in) :: field_index !< The index of the field in the
!! boundary condition that is being set. The
!! surface concentration is set by default.
type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure with the data to set
real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added
integer, optional, intent(in) :: halo_size !< The extent of the halo to copy; 0 by default
integer, dimension(4), optional, intent(in) :: idim !< The data and computational domain extents of
!! the first dimension of the output array
!! in a non-decreasing list
integer, dimension(4), optional, intent(in) :: jdim !< The data and computational domain extents of
!! the second dimension of the output array
!! in a non-decreasing list

integer :: subfield ! An integer indicating which field to set.

call coupler_type_set_data(array_in, bc_index, field_index, var, scale_factor, halo_size, idim, jdim)

end subroutine CT_set_data

!> Register the diagnostics of a coupler_2d_bc_type
subroutine CT_set_diags(var, diag_name, axes, time)
type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics
character(len=*), intent(in) :: diag_name !< name for diagnostic file, or blank not to register the fields
integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration
type(time_type), intent(in) :: time !< model time variable for registering diagnostic field

call coupler_type_set_diags(var, diag_name, axes, time)

end subroutine CT_set_diags

!> Write out all diagnostics of elements of a coupler_2d_bc_type
subroutine CT_send_data(var, Time)
type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure with the diagnostics to write
type(time_type), intent(in) :: time !< The current model time

call coupler_type_send_data(var, Time)
end subroutine CT_send_data

!> Write out checksums for the elements of a coupler_2d_bc_type
subroutine CT_write_chksums(var, outunit, name_lead)
type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure for which to register diagnostics
integer, intent(in) :: outunit !< The index of a open output file
character(len=*), optional, intent(in) :: name_lead !< An optional prefix for the variable names

call coupler_type_write_chksums(var, outunit, name_lead)

end subroutine CT_write_chksums

!> Indicate whether a coupler_1d_bc_type has been initialized.
logical function CT_initialized_1d(var)
type(coupler_1d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed

CT_initialized_1d = coupler_type_initialized(var)
end function CT_initialized_1d

!> Indicate whether a coupler_2d_bc_type has been initialized.
logical function CT_initialized_2d(var)
type(coupler_2d_bc_type), intent(in) :: var !< BC_type structure to be deconstructed

CT_initialized_2d = coupler_type_initialized(var)
end function CT_initialized_2d

!> Deallocate all data associated with a coupler_1d_bc_type
subroutine CT_destructor_1d(var)
type(coupler_1d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed

call coupler_type_destructor(var)

end subroutine CT_destructor_1d

!> Deallocate all data associated with a coupler_2d_bc_type
subroutine CT_destructor_2d(var)
type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be deconstructed

call coupler_type_destructor(var)

end subroutine CT_destructor_2d

end module MOM_couplertype_infra
93 changes: 93 additions & 0 deletions config_src/infra/FMS2/MOM_cpu_clock_infra.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,93 @@
!> Wraps the MPP cpu clock functions
!!
!! The functions and constants should be accessed via mom_cpu_clock
module MOM_cpu_clock_infra

! This file is part of MOM6. See LICENSE.md for the license.

! These interfaces and constants from MPP/FMS will not be directly exposed outside of this module
use fms_mod, only : clock_flag_default
use mpp_mod, only : mpp_clock_begin
use mpp_mod, only : mpp_clock_end, mpp_clock_id
use mpp_mod, only : MPP_CLOCK_COMPONENT => CLOCK_COMPONENT
use mpp_mod, only : MPP_CLOCK_SUBCOMPONENT => CLOCK_SUBCOMPONENT
use mpp_mod, only : MPP_CLOCK_MODULE_DRIVER => CLOCK_MODULE_DRIVER
use mpp_mod, only : MPP_CLOCK_MODULE => CLOCK_MODULE
use mpp_mod, only : MPP_CLOCK_ROUTINE => CLOCK_ROUTINE
use mpp_mod, only : MPP_CLOCK_LOOP => CLOCK_LOOP
use mpp_mod, only : MPP_CLOCK_INFRA => CLOCK_INFRA

implicit none ; private

! Public entities
public :: cpu_clock_id, cpu_clock_begin, cpu_clock_end
public :: CLOCK_COMPONENT, CLOCK_SUBCOMPONENT, CLOCK_MODULE_DRIVER, CLOCK_MODULE
public :: CLOCK_ROUTINE, CLOCK_LOOP, CLOCK_INFRA

!> A granularity value to passed to cpu_clock_id() to indicate the clock is for a
!! component, e.g. the entire MOM6 model
integer, parameter :: CLOCK_COMPONENT = MPP_CLOCK_COMPONENT

!> A granularity value to passed to cpu_clock_id() to indicate the clock is for a
!! sub-component, e.g. dynamics or thermodynamics
integer, parameter :: CLOCK_SUBCOMPONENT = MPP_CLOCK_SUBCOMPONENT

!> A granularity value to passed to cpu_clock_id() to indicate the clock is for a
!! module driver, e.g. a routine that calls multiple other routines
integer, parameter :: CLOCK_MODULE_DRIVER = MPP_CLOCK_MODULE_DRIVER

!> A granularity value to passed to cpu_clock_id() to indicate the clock is for a
!! module, e.g. the main entry routine for a module
integer, parameter :: CLOCK_MODULE = MPP_CLOCK_MODULE

!> A granularity value to passed to cpu_clock_id() to indicate the clock is for a
!! subroutine or function
integer, parameter :: CLOCK_ROUTINE = MPP_CLOCK_ROUTINE

!> A granularity value to passed to cpu_clock_id() to indicate the clock is for a
!! section with in a routine, e.g. around a loop
integer, parameter :: CLOCK_LOOP = MPP_CLOCK_LOOP

!> A granularity value to passed to cpu_clock_id() to indicate the clock is for an
!! infrastructure operation, e.g. a halo update
integer, parameter :: CLOCK_INFRA = MPP_CLOCK_INFRA

contains

!> Turns on clock with handle "id"
subroutine cpu_clock_begin(id)
integer, intent(in) :: id !< Handle for clock

call mpp_clock_begin(id)

end subroutine cpu_clock_begin

!> Turns off clock with handle "id"
subroutine cpu_clock_end(id)
integer, intent(in) :: id !< Handle for clock

call mpp_clock_end(id)

end subroutine cpu_clock_end

!> Returns the integer handle for a named CPU clock.
integer function cpu_clock_id( name, synchro_flag, grain )
character(len=*), intent(in) :: name !< The unique name of the CPU clock
integer, optional, intent(in) :: synchro_flag !< An integer flag that controls whether the PEs
!! are synchronized before the cpu clocks start counting.
!! Synchronization occurs before the start of a clock if this
!! is odd, while additional (expensive) statistics can set
!! for other values. If absent, the default is taken from the
!! settings for FMS.
integer, optional, intent(in) :: grain !< The timing granularity for this clock, usually set to
!! the values of CLOCK_COMPONENT, CLOCK_ROUTINE, CLOCK_LOOP, etc.

if (present(synchro_flag)) then
cpu_clock_id = mpp_clock_id(name, flags=synchro_flag, grain=grain)
else
cpu_clock_id = mpp_clock_id(name, flags=clock_flag_default, grain=grain)
endif

end function cpu_clock_id

end module MOM_cpu_clock_infra
Loading

0 comments on commit fe9b2a1

Please sign in to comment.