Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Removal of internal FMS use of fms_io and mpp_io #928

Merged
merged 4 commits into from
Apr 1, 2022
Merged

Removal of internal FMS use of fms_io and mpp_io #928

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
5f85d40
lite purge updated to 6deed0a
GFDL-Eric Mar 3, 2022
ecfcdda
revert coupler/ensemble_manager changes
GFDL-Eric Mar 3, 2022
9d3e487
Fixed close_file fail
GFDL-Eric Mar 3, 2022
6a607fa
Moved diag_util fms2_io_mod placement
GFDL-Eric Mar 3, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
331 changes: 1 addition & 330 deletions coupler/coupler_types.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,8 +34,6 @@ module coupler_types_mod
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 fms_io_mod, only: restart_file_type, fms_io_register_restart_field=>register_restart_field
use fms_io_mod, only: query_initialized, restore_state
use time_manager_mod, only: time_type
use diag_manager_mod, only: register_diag_field, send_data
use data_override_mod, only: data_override
Expand Down Expand Up @@ -97,8 +95,6 @@ module coupler_types_mod
integer :: atm_tr_index = 0 !< atm_tr_index
character(len=128) :: ice_restart_file = ' ' !< ice_restart_file
character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file
type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type
!! that is used for this field.
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
Expand Down Expand Up @@ -151,8 +147,6 @@ module coupler_types_mod
integer :: atm_tr_index = 0 !< atm_tr_index
character(len=128) :: ice_restart_file = ' ' !< ice_restart_file
character(len=128) :: ocean_restart_file = ' ' !< ocean_restart_file
type(restart_file_type), pointer :: rest_type => NULL() !< A pointer to the restart_file_type
!! that is used for this field.
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
Expand Down Expand Up @@ -321,17 +315,13 @@ module coupler_types_mod
!! in restart files.
!> @ingroup coupler_types_mod
interface coupler_type_register_restarts
module procedure mpp_io_CT_register_restarts_2d, mpp_io_CT_register_restarts_3d
module procedure mpp_io_CT_register_restarts_to_file_2d, mpp_io_CT_register_restarts_to_file_3d

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 mpp_io_CT_restore_state_2d, mpp_io_CT_restore_state_3d
module procedure CT_restore_state_2d, CT_restore_state_3d
end interface coupler_type_restore_state

Expand Down Expand Up @@ -3340,97 +3330,7 @@ subroutine register_axis_wrapper(fileobj, to_read, nz)
call register_axis_wrapper_write(fileobj, nz)
endif

end subroutine

!! @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 mpp_io_CT_register_restarts_2d(var, bc_rest_files, num_rest_files, mpp_domain, ocean_restart)
type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts
type(restart_file_type), 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, optional, intent(in) :: ocean_restart !< If true, use the ocean restart file name.

character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names
character(len=80) :: file_nm
logical :: ocn_rest
integer :: f, n, m

ocn_rest = .true.
if (present(ocean_restart)) ocn_rest = ocean_restart

! Determine the number and names of the restart files
num_rest_files = 0
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

! Register the fields with the restart files
allocate(bc_rest_files(num_rest_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)%rest_type => bc_rest_files(f)
do m = 1, var%bc(n)%num_fields
var%bc(n)%field(m)%id_rest = fms_io_register_restart_field(bc_rest_files(f),&
& rest_file_names(f), var%bc(n)%field(m)%name, var%bc(n)%field(m)%values,&
& mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init )
enddo
enddo
end subroutine mpp_io_CT_register_restarts_2d

!! @brief Register the fields in a coupler_2d_bc_type to be saved to restart files
!!
!! This subroutine registers the fields in a coupler_2d_bc_type to be saved in the specified
!! restart file.
subroutine mpp_io_CT_register_restarts_to_file_2d(var, file_name, rest_file, mpp_domain, varname_prefix)
type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts
character(len=*), intent(in) :: file_name !< The name of the restart file
type(restart_file_type), pointer :: rest_file !< A (possibly associated) structure describing
!! the restart file
type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call
character(len=*), optional, intent(in) :: varname_prefix !< A prefix for the variable name
!! in the restart file, intended to allow
!! multiple BC_type variables to use the
!! same restart files.

character(len=128) :: var_name
integer :: n, m

! Register the fields with the restart file
if (.not.associated(rest_file)) allocate(rest_file)
do n = 1, var%num_bcs
if (var%bc(n)%num_fields <= 0) cycle

var%bc(n)%rest_type => rest_file
do m = 1, var%bc(n)%num_fields
var_name = trim(var%bc(n)%field(m)%name)
if (present(varname_prefix)) var_name = trim(varname_prefix)//trim(var_name)
var%bc(n)%field(m)%id_rest = fms_io_register_restart_field(rest_file,&
& file_name, var_name, var%bc(n)%field(m)%values,&
& mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init )
enddo
enddo
end subroutine mpp_io_CT_register_restarts_to_file_2d
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
Expand Down Expand Up @@ -3540,93 +3440,6 @@ subroutine CT_register_restarts_3d(var, bc_rest_files, num_rest_files, mpp_domai

end subroutine CT_register_restarts_3d

!! @brief Register the fields in a coupler_3d_bc_type to be saved to restart files
!!
!! This subroutine registers the fields in a coupler_3d_bc_type to be saved in restart files
!! specified in the field table.
subroutine mpp_io_CT_register_restarts_3d(var, bc_rest_files, num_rest_files, mpp_domain, ocean_restart)
type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts
type(restart_file_type), 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, optional, intent(in) :: ocean_restart !< If true, use the ocean restart file name.

character(len=80), dimension(max(1,var%num_bcs)) :: rest_file_names
character(len=80) :: file_nm
logical :: ocn_rest
integer :: f, n, m

ocn_rest = .true.
if (present(ocean_restart)) ocn_rest = ocean_restart

! Determine the number and names of the restart files
num_rest_files = 0
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

! Register the fields with the restart files
allocate(bc_rest_files(num_rest_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)%rest_type => bc_rest_files(f)
do m = 1, var%bc(n)%num_fields
var%bc(n)%field(m)%id_rest = fms_io_register_restart_field(bc_rest_files(f),&
& rest_file_names(f), var%bc(n)%field(m)%name, var%bc(n)%field(m)%values,&
& mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init )
enddo
enddo
end subroutine mpp_io_CT_register_restarts_3d

!> @brief Register the fields in a coupler_3d_bc_type to be saved to restart files
!!
!! Registers the fields in a coupler_3d_bc_type to be saved in the specified restart file.
subroutine mpp_io_CT_register_restarts_to_file_3d(var, file_name, rest_file, mpp_domain, varname_prefix)
type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure to be registered for restarts
character(len=*), intent(in) :: file_name !< The name of the restart file
type(restart_file_type), pointer :: rest_file !< A (possibly associated) structure describing the restart file
type(domain2D), intent(in) :: mpp_domain !< The FMS domain to use for this registration call
character(len=*), optional, intent(in) :: varname_prefix !< A prefix for the variable name
!! in the restart file, intended to allow
!! multiple BC_type variables to use the
!! same restart files.

character(len=128) :: var_name
integer :: n, m

! Register the fields with the restart file
if (.not.associated(rest_file)) allocate(rest_file)
do n = 1, var%num_bcs
if (var%bc(n)%num_fields <= 0) cycle

var%bc(n)%rest_type => rest_file
do m = 1, var%bc(n)%num_fields
var_name = trim(var%bc(n)%field(m)%name)
if (present(varname_prefix)) var_name = trim(varname_prefix)//trim(var_name)
var%bc(n)%field(m)%id_rest = fms_io_register_restart_field(rest_file,&
& file_name, var_name, var%bc(n)%field(m)%values,&
& mpp_domain, mandatory=.not.var%bc(n)%field(m)%may_init )
enddo
enddo
end subroutine mpp_io_CT_register_restarts_to_file_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
Expand Down Expand Up @@ -3689,76 +3502,6 @@ subroutine CT_restore_state_2d(var, use_fms2_io, directory, all_or_nothing, all_
endif
end subroutine CT_restore_state_2d

!> @brief Reads in fields from restart files into a coupler_2d_bc_type
!!
!! This subroutine reads in the fields in a coupler_2d_bc_type that have been saved in restart
!! files.
subroutine mpp_io_CT_restore_state_2d(var, 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.

integer :: n, m, num_fld
character(len=80) :: unset_varname
logical :: any_set, all_set, all_var_set, any_var_set, var_set

any_set = .false.
all_set = .true.
num_fld = 0
unset_varname = ""

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 (var%bc(n)%field(m)%id_rest > 0) then
var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest)
if (.not.var_set) then
call restore_state(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest,&
& directory=directory, nonfatal_missing_files=.true.)
var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest)
endif
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,&
& "mpp_io_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

if ((num_fld > 0) .and. present(all_or_nothing)) then
if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(FATAL,&
& "mpp_io_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, "mpp_io_CT_restore_state_2d: all_required is true, but "//&
& trim(unset_varname)//" was not read from its restart file.")
endif
endif
end subroutine mpp_io_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
Expand Down Expand Up @@ -3826,78 +3569,6 @@ subroutine CT_restore_state_3d(var, use_fms2_io, directory, all_or_nothing, all_
endif
end subroutine CT_restore_state_3d

!> @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 mpp_io_CT_restore_state_3d(var, 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, 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

any_set = .false.
all_set = .true.
num_fld = 0
unset_varname = ""

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 (var%bc(n)%field(m)%id_rest > 0) then
var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest)
if (.not.var_set) then
call restore_state(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest,&
& directory=directory, nonfatal_missing_files=.true.)
var_set = query_initialized(var%bc(n)%rest_type, var%bc(n)%field(m)%id_rest)
endif
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,&
& "mpp_io_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

if ((num_fld > 0) .and. present(all_or_nothing)) then
if (all_or_nothing .and. (all_set .neqv. any_set)) call mpp_error(FATAL,&
& "mpp_io_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, "mpp_io_CT_restore_state_3d: all_required is true, but "//&
& trim(unset_varname)//" was not read from its restart file.")
endif
endif
end subroutine mpp_io_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
Expand Down
Loading