From 96bd5c25945c09ee948c614d24e59f9ac7fcaf3c Mon Sep 17 00:00:00 2001 From: Niki Zadeh Date: Wed, 17 May 2017 16:04:41 -0400 Subject: [PATCH 01/10] New overloads needed for SIS2 split --- coupler/coupler_types.F90 | 551 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 551 insertions(+) diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index 4ba8502323..c03e9a9d55 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -390,6 +390,10 @@ module coupler_types_mod !{ interface coupler_type_copy !{ module procedure coupler_type_copy_1d_2d module procedure coupler_type_copy_1d_3d + module procedure coupler_type_copy_2d_2d + module procedure coupler_type_copy_2d_3d + module procedure coupler_type_copy_3d_2d + module procedure coupler_type_copy_3d_3d end interface coupler_type_copy !} ! @@ -1205,4 +1209,551 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & 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. +!! +!! Template: +!! +!! ~~~~~~~~~~{.f90} +!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & +!! diag_name, axes, time, suffix = 'something') +!! ~~~~~~~~~~ +subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & + diag_name, axes, time, suffix) !{ + +! +!----------------------------------------------------------------------- +! modules +!----------------------------------------------------------------------- +! + +use time_manager_mod, only: time_type +use diag_manager_mod, only: register_diag_field +use mpp_mod, only: mpp_error, FATAL + +implicit none + +! +!----------------------------------------------------------------------- +! arguments +!----------------------------------------------------------------------- +! + +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 + +! +!----------------------------------------------------------------------- +! local parameters +!----------------------------------------------------------------------- +! + +character(len=64), parameter :: sub_name = 'coupler_type_copy_1d_2d' +character(len=256), parameter :: error_header = & + '==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):' + +! +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- +! + +character(len=128) :: error_msg +integer :: m +integer :: n + +! +! ===================================================================== +! begin executable code +! ===================================================================== +! + +! +! Error if output fields is not zero +! + +if (var_out%num_bcs .ne. 0) then !{ + call mpp_error(FATAL, trim(error_header) // ' Number of output fields is non-zero') +endif !} + +var_out%num_bcs = var_in%num_bcs + +! +! Return if no input fields +! + +if (var_in%num_bcs .ne. 0) then !{ + if (associated(var_out%bc)) then !{ + call mpp_error(FATAL, trim(error_header) // ' var_out%bc already associated') + endif !} + allocate ( var_out%bc(var_out%num_bcs) ) + do n = 1, var_out%num_bcs !{ + var_out%bc(n)%name = var_in%bc(n)%name + var_out%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index + var_out%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file + var_out%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file + var_out%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure + var_out%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed + var_out%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice + var_out%bc(n)%mol_wt = var_in%bc(n)%mol_wt + var_out%bc(n)%num_fields = var_in%bc(n)%num_fields + if (associated(var_out%bc(n)%field)) then !{ + write (error_msg, *) trim(error_header), ' var_out%bc(', n, ')%field already associated' + call mpp_error(FATAL, trim(error_msg)) + endif !} + allocate ( var_out%bc(n)%field(var_out%bc(n)%num_fields) ) + do m = 1, var_out%bc(n)%num_fields !{ + if (present(suffix)) then !{ + var_out%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) + else !}{ + var_out%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name + endif !} + var_out%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name + var_out%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units + var_out%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean + if (associated(var_out%bc(n)%field(m)%values)) then !{ + write (error_msg, *) trim(error_header), ' var_out%bc(', n, ')%field(', m, ')%values already associated' + call mpp_error(FATAL, trim(error_msg)) + endif !} + allocate ( var_out%bc(n)%field(m)%values(is:ie,js:je) ) + var_out%bc(n)%field(m)%values = 0.0 + if (diag_name .ne. ' ') then !{ + if (size(axes) .lt. 2) then !{ + call mpp_error(FATAL, trim(error_header) // ' axes less than 2 elements') + endif !} + var_out%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & + var_out%bc(n)%field(m)%name, axes(1:2), Time, & + var_out%bc(n)%field(m)%long_name, var_out%bc(n)%field(m)%units ) + endif !} + enddo !} m + enddo !} n + +endif !} + +return + +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. +!! +!! Template: +!! +!! ~~~~~~~~~~{.f90} +!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & +!! diag_name, axes, time, suffix = 'something') +!! ~~~~~~~~~~ +!! +!! \throw FATAL, "Number of output fields is non-zero" +!! \throw FATAL, "var_out%bc already associated" +!! \throw FATAL, "var_out%bc([n])%field already associated" +!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" +!! \throw FATAL, "axes less than 3 elements" +subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & + diag_name, axes, time, suffix) !{ + +! +!----------------------------------------------------------------------- +! modules +!----------------------------------------------------------------------- +! + +use time_manager_mod, only: time_type +use diag_manager_mod, only: register_diag_field +use mpp_mod, only: mpp_error, FATAL + +implicit none + +! +!----------------------------------------------------------------------- +! arguments +!----------------------------------------------------------------------- +! +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 + +! +!----------------------------------------------------------------------- +! local parameters +!----------------------------------------------------------------------- +! + +character(len=64), parameter :: sub_name = 'coupler_type_copy_1d_3d' +character(len=256), parameter :: error_header = & + '==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):' + +! +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- +! + +character(len=128) :: error_msg +integer :: m +integer :: n + +! +! ===================================================================== +! begin executable code +! ===================================================================== +! + +! +! Error if output fields is not zero +! + +if (var_out%num_bcs .ne. 0) then !{ + call mpp_error(FATAL, trim(error_header) // ' Number of output fields is non-zero') +endif !} + +var_out%num_bcs = var_in%num_bcs + +! +! Return if no input fields +! + +if (var_in%num_bcs .ne. 0) then !{ + if (associated(var_out%bc)) then !{ + call mpp_error(FATAL, trim(error_header) // ' var_out%bc already associated') + endif !} + allocate ( var_out%bc(var_out%num_bcs) ) + do n = 1, var_out%num_bcs !{ + var_out%bc(n)%name = var_in%bc(n)%name + var_out%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index + var_out%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file + var_out%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file + var_out%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure + var_out%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed + var_out%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice + var_out%bc(n)%mol_wt = var_in%bc(n)%mol_wt + var_out%bc(n)%num_fields = var_in%bc(n)%num_fields + if (associated(var_out%bc(n)%field)) then !{ + write (error_msg, *) trim(error_header), ' var_out%bc(', n, ')%field already associated' + call mpp_error(FATAL, trim(error_msg)) + endif !} + allocate ( var_out%bc(n)%field(var_out%bc(n)%num_fields) ) + do m = 1, var_out%bc(n)%num_fields !{ + if (present(suffix)) then !{ + var_out%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // suffix + else !}{ + var_out%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name + endif !} + var_out%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name + var_out%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units + var_out%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean + if (associated(var_out%bc(n)%field(m)%values)) then !{ + write (error_msg, *) trim(error_header), ' var_out%bc(', n, ')%field(', m, ')%values already associated' + call mpp_error(FATAL, trim(error_msg)) + endif !} + allocate ( var_out%bc(n)%field(m)%values(is:ie,js:je,kd) ) + var_out%bc(n)%field(m)%values = 0.0 + if (diag_name .ne. ' ') then !{ + if (size(axes) .lt. 3) then !{ + call mpp_error(FATAL, trim(error_header) // ' axes less than 3 elements') + endif !} + var_out%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & + var_out%bc(n)%field(m)%name, axes(1:3), Time, & + var_out%bc(n)%field(m)%long_name, var_out%bc(n)%field(m)%units ) + endif !} + enddo !} m + enddo !} n + +endif !} + +return + +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. +!! +!! Template: +!! +!! ~~~~~~~~~~{.f90} +!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & +!! diag_name, axes, time, suffix = 'something') +!! ~~~~~~~~~~ +subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & + diag_name, axes, time, suffix) !{ + +! +!----------------------------------------------------------------------- +! modules +!----------------------------------------------------------------------- +! + +use time_manager_mod, only: time_type +use diag_manager_mod, only: register_diag_field +use mpp_mod, only: mpp_error, FATAL + +implicit none + +! +!----------------------------------------------------------------------- +! arguments +!----------------------------------------------------------------------- +! + +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 + +! +!----------------------------------------------------------------------- +! local parameters +!----------------------------------------------------------------------- +! + +character(len=64), parameter :: sub_name = 'coupler_type_copy_1d_2d' +character(len=256), parameter :: error_header = & + '==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):' + +! +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- +! + +character(len=128) :: error_msg +integer :: m +integer :: n + +! +! ===================================================================== +! begin executable code +! ===================================================================== +! + +! +! Error if output fields is not zero +! + +if (var_out%num_bcs .ne. 0) then !{ + call mpp_error(FATAL, trim(error_header) // ' Number of output fields is non-zero') +endif !} + +var_out%num_bcs = var_in%num_bcs + +! +! Return if no input fields +! + +if (var_in%num_bcs .ne. 0) then !{ + if (associated(var_out%bc)) then !{ + call mpp_error(FATAL, trim(error_header) // ' var_out%bc already associated') + endif !} + allocate ( var_out%bc(var_out%num_bcs) ) + do n = 1, var_out%num_bcs !{ + var_out%bc(n)%name = var_in%bc(n)%name + var_out%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index + var_out%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file + var_out%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file + var_out%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure + var_out%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed + var_out%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice + var_out%bc(n)%mol_wt = var_in%bc(n)%mol_wt + var_out%bc(n)%num_fields = var_in%bc(n)%num_fields + if (associated(var_out%bc(n)%field)) then !{ + write (error_msg, *) trim(error_header), ' var_out%bc(', n, ')%field already associated' + call mpp_error(FATAL, trim(error_msg)) + endif !} + allocate ( var_out%bc(n)%field(var_out%bc(n)%num_fields) ) + do m = 1, var_out%bc(n)%num_fields !{ + if (present(suffix)) then !{ + var_out%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // trim(suffix) + else !}{ + var_out%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name + endif !} + var_out%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name + var_out%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units + var_out%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean + if (associated(var_out%bc(n)%field(m)%values)) then !{ + write (error_msg, *) trim(error_header), ' var_out%bc(', n, ')%field(', m, ')%values already associated' + call mpp_error(FATAL, trim(error_msg)) + endif !} + allocate ( var_out%bc(n)%field(m)%values(is:ie,js:je) ) + var_out%bc(n)%field(m)%values = 0.0 + if (diag_name .ne. ' ') then !{ + if (size(axes) .lt. 2) then !{ + call mpp_error(FATAL, trim(error_header) // ' axes less than 2 elements') + endif !} + var_out%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & + var_out%bc(n)%field(m)%name, axes(1:2), Time, & + var_out%bc(n)%field(m)%long_name, var_out%bc(n)%field(m)%units ) + endif !} + enddo !} m + enddo !} n + +endif !} + +return + +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. +!! +!! Template: +!! +!! ~~~~~~~~~~{.f90} +!! call coupler_type_copy(var_in, var_out, is, ie, js, je, kd, & +!! diag_name, axes, time, suffix = 'something') +!! ~~~~~~~~~~ +!! +!! \throw FATAL, "Number of output fields is non-zero" +!! \throw FATAL, "var_out%bc already associated" +!! \throw FATAL, "var_out%bc([n])%field already associated" +!! \throw FATAL, "var_out%bc([n])%field([m])%values already associated" +!! \throw FATAL, "axes less than 3 elements" +subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & + diag_name, axes, time, suffix) !{ + +! +!----------------------------------------------------------------------- +! modules +!----------------------------------------------------------------------- +! + +use time_manager_mod, only: time_type +use diag_manager_mod, only: register_diag_field +use mpp_mod, only: mpp_error, FATAL + +implicit none + +! +!----------------------------------------------------------------------- +! arguments +!----------------------------------------------------------------------- +! +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 + +! +!----------------------------------------------------------------------- +! local parameters +!----------------------------------------------------------------------- +! + +character(len=64), parameter :: sub_name = 'coupler_type_copy_1d_3d' +character(len=256), parameter :: error_header = & + '==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):' + +! +!----------------------------------------------------------------------- +! local variables +!----------------------------------------------------------------------- +! + +character(len=128) :: error_msg +integer :: m +integer :: n + +! +! ===================================================================== +! begin executable code +! ===================================================================== +! + +! +! Error if output fields is not zero +! + +if (var_out%num_bcs .ne. 0) then !{ + call mpp_error(FATAL, trim(error_header) // ' Number of output fields is non-zero') +endif !} + +var_out%num_bcs = var_in%num_bcs + +! +! Return if no input fields +! + +if (var_in%num_bcs .ne. 0) then !{ + if (associated(var_out%bc)) then !{ + call mpp_error(FATAL, trim(error_header) // ' var_out%bc already associated') + endif !} + allocate ( var_out%bc(var_out%num_bcs) ) + do n = 1, var_out%num_bcs !{ + var_out%bc(n)%name = var_in%bc(n)%name + var_out%bc(n)%atm_tr_index = var_in%bc(n)%atm_tr_index + var_out%bc(n)%ice_restart_file = var_in%bc(n)%ice_restart_file + var_out%bc(n)%ocean_restart_file = var_in%bc(n)%ocean_restart_file + var_out%bc(n)%use_atm_pressure = var_in%bc(n)%use_atm_pressure + var_out%bc(n)%use_10m_wind_speed = var_in%bc(n)%use_10m_wind_speed + var_out%bc(n)%pass_through_ice = var_in%bc(n)%pass_through_ice + var_out%bc(n)%mol_wt = var_in%bc(n)%mol_wt + var_out%bc(n)%num_fields = var_in%bc(n)%num_fields + if (associated(var_out%bc(n)%field)) then !{ + write (error_msg, *) trim(error_header), ' var_out%bc(', n, ')%field already associated' + call mpp_error(FATAL, trim(error_msg)) + endif !} + allocate ( var_out%bc(n)%field(var_out%bc(n)%num_fields) ) + do m = 1, var_out%bc(n)%num_fields !{ + if (present(suffix)) then !{ + var_out%bc(n)%field(m)%name = trim(var_in%bc(n)%field(m)%name) // suffix + else !}{ + var_out%bc(n)%field(m)%name = var_in%bc(n)%field(m)%name + endif !} + var_out%bc(n)%field(m)%long_name = var_in%bc(n)%field(m)%long_name + var_out%bc(n)%field(m)%units = var_in%bc(n)%field(m)%units + var_out%bc(n)%field(m)%mean = var_in%bc(n)%field(m)%mean + if (associated(var_out%bc(n)%field(m)%values)) then !{ + write (error_msg, *) trim(error_header), ' var_out%bc(', n, ')%field(', m, ')%values already associated' + call mpp_error(FATAL, trim(error_msg)) + endif !} + allocate ( var_out%bc(n)%field(m)%values(is:ie,js:je,kd) ) + var_out%bc(n)%field(m)%values = 0.0 + if (diag_name .ne. ' ') then !{ + if (size(axes) .lt. 3) then !{ + call mpp_error(FATAL, trim(error_header) // ' axes less than 3 elements') + endif !} + var_out%bc(n)%field(m)%id_diag = register_diag_field(diag_name, & + var_out%bc(n)%field(m)%name, axes(1:3), Time, & + var_out%bc(n)%field(m)%long_name, var_out%bc(n)%field(m)%units ) + endif !} + enddo !} m + enddo !} n + +endif !} + +return + +end subroutine coupler_type_copy_3d_3d !} + end module coupler_types_mod !} From d40f6da7cbfce2e29e9fba2e938359c8186db7ec Mon Sep 17 00:00:00 2001 From: Thomas Robinson Date: Mon, 12 Jun 2017 10:16:13 -0400 Subject: [PATCH 02/10] Produces a more descriptive error message when data values are out of range. --- time_interp/time_interp.F90 | 22 +++++++++++++++++++--- time_manager/time_manager.F90 | 14 ++++++++++++++ 2 files changed, 33 insertions(+), 3 deletions(-) diff --git a/time_interp/time_interp.F90 b/time_interp/time_interp.F90 index 04a764d453..880551f78d 100644 --- a/time_interp/time_interp.F90 +++ b/time_interp/time_interp.F90 @@ -32,7 +32,8 @@ module time_interp_mod operator(+), operator(-), operator(>), & operator(<), operator( // ), operator( / ), & operator(>=), operator(<=), operator( * ), & - operator(==), print_date, print_time + operator(==), print_date, print_time,& + time_list_error, date_to_string use fms_mod, only: write_version_number, & error_mesg, FATAL, stdout, stdlog, & @@ -662,6 +663,7 @@ subroutine time_interp_list ( Time, Timelist, weight, index1, index2, modtime, e integer :: n, hr, mn, se, mtime type(time_type) :: T, Ts, Te, Td, Period, Time_mod +character(len=:),allocatable :: terr, tserr, teerr if ( .not. module_is_initialized ) call time_interp_init @@ -727,7 +729,14 @@ subroutine time_interp_list ( Time, Timelist, weight, index1, index2, modtime, e ! time falls before starting list value else if ( T < Ts ) then if (mtime == NONE) then - if(fms_error_handler ('time_interp_list','time before range of list',err_msg)) return + call time_list_error(T,terr) + call time_list_error(Ts,tserr) + call time_list_error(Te,teerr) + if(fms_error_handler ('time_interp_list',& + 'time '//trim(terr)//' ('//date_to_string(T)//' is before range of list '//trim(tserr)//'-'//trim(teerr)//& + '('//date_to_string(Ts)//' - '//date_to_string(Te)//')',& + err_msg)) return + deallocate(terr,tserr,teerr) endif Td = Te-Ts weight = 1. - ((Ts-T) // (Period-Td)) @@ -753,7 +762,14 @@ subroutine time_interp_list ( Time, Timelist, weight, index1, index2, modtime, e ! time falls after ending list value else if ( T > Te ) then if (mtime == NONE) then - if(fms_error_handler ('time_interp_list','time after range of list',err_msg)) return + call time_list_error(T,terr) + call time_list_error(Ts,tserr) + call time_list_error(Te,teerr) + if(fms_error_handler ('time_interp_list',& + 'time '//trim(terr)//' ('//date_to_string(T)//' is after range of list '//trim(tserr)//'-'//trim(teerr)//& + '('//date_to_string(Ts)//' - '//date_to_string(Te)//')',& + err_msg)) return + deallocate(terr,tserr,teerr) endif Td = Te-Ts weight = (T-Te) // (Period-Td) diff --git a/time_manager/time_manager.F90 b/time_manager/time_manager.F90 index 10b6fc816a..11567a3bbb 100644 --- a/time_manager/time_manager.F90 +++ b/time_manager/time_manager.F90 @@ -90,6 +90,7 @@ module time_manager_mod ! Subroutines and functions operating on time_type public set_time, increment_time, decrement_time, get_time, interval_alarm public repeat_alarm, time_type_to_real, real_to_time_type +public time_list_error ! List of available calendar types public THIRTY_DAY_MONTHS, JULIAN, GREGORIAN, NOLEAP, NO_CALENDAR, INVALID_CALENDAR @@ -3265,6 +3266,19 @@ function date_to_string(time, err_msg) end function date_to_string +!> \author Tom Robinson +!! \email thomas.robinson@noaa.gov +!! \brief This routine converts the integer t%days to a string +subroutine time_list_error (T,Terr) + type(time_type), intent(in) :: t !< time_type input + character(len=:), allocatable :: terr !< String holding the t%days +!> Allocate the string + allocate (character(len=10) :: terr) +!> Write the integer to the string + write (terr,'(I0)') t%days +end subroutine time_list_error + + end module time_manager_mod ! From 0df61c4c1b27ee72523ff06a97cc907868ad1c12 Mon Sep 17 00:00:00 2001 From: Nic Hannah Date: Thu, 9 Mar 2017 15:55:28 +1100 Subject: [PATCH 03/10] Allow a peset to have size 1. #28 --- mpp/include/mpp_util_mpi.inc | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/mpp/include/mpp_util_mpi.inc b/mpp/include/mpp_util_mpi.inc index cc3cdc42c0..7369a10d45 100644 --- a/mpp/include/mpp_util_mpi.inc +++ b/mpp/include/mpp_util_mpi.inc @@ -73,14 +73,13 @@ function get_peset(pelist) if( .NOT.PRESENT(pelist) )then !set it to current_peset_num get_peset = current_peset_num; return end if - if( size(pelist(:)).EQ.1 .AND. npes.GT.1 )then !collective ops on single PEs should return - get_peset = 0; return - end if !--- first make sure pelist is monotonically increasing. - do n = 2, size(pelist(:)) - if(pelist(n) <= pelist(n-1)) call mpp_error(FATAL, "GET_PESET: pelist is not monotonically increasing") - enddo + if (size(pelist(:)) .GT. 1) then + do n = 2, size(pelist(:)) + if(pelist(n) <= pelist(n-1)) call mpp_error(FATAL, "GET_PESET: pelist is not monotonically increasing") + enddo + endif allocate( sorted(size(pelist(:))) ) sorted = pelist From ad559d0e086d523ffe43134a1d3448d49c055e6d Mon Sep 17 00:00:00 2001 From: Nicholas Hannah Date: Wed, 14 Jun 2017 14:20:49 +1000 Subject: [PATCH 04/10] Check that npes is not smaller than ensemble_size. https://github.com/NOAA-GFDL/MOM6/issues/391 --- coupler/ensemble_manager.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/coupler/ensemble_manager.F90 b/coupler/ensemble_manager.F90 index ebd53997a5..a0582acc7c 100644 --- a/coupler/ensemble_manager.F90 +++ b/coupler/ensemble_manager.F90 @@ -72,6 +72,9 @@ subroutine ensemble_manager_init() pe = mpp_pe() npes = mpp_npes() + if (npes < ensemble_size) then + call mpp_error(FATAL,'npes must be >= ensemble_size') + endif total_npes_pm = npes/ensemble_size if (mod(npes, total_npes_pm) /= 0) call mpp_error(FATAL,'ensemble_size must be divis by npes') From f97fba758f656871193e9ca33891f45c536a7e6c Mon Sep 17 00:00:00 2001 From: Nicholas Hannah Date: Wed, 14 Jun 2017 14:22:17 +1000 Subject: [PATCH 05/10] Coupler arrays need to be contiguous to support domain transofmrations. See https://github.com/NOAA-GFDL/MOM6/issues/391. --- coupler/coupler_types.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index 4ba8502323..029b4e9997 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -239,7 +239,7 @@ module coupler_types_mod !{ type, public :: coupler_3d_values_type character(len=fm_field_name_len) :: name = ' ' !< name - real, pointer, dimension(:,:,:) :: values => NULL() !< values + real, pointer, contiguous, dimension(:,:,:) :: values => NULL() !< values logical :: mean = .true. !< mean logical :: override = .false. !< override integer :: id_diag = 0 !< id_diag @@ -275,7 +275,7 @@ module coupler_types_mod !{ type, public :: coupler_2d_values_type character(len=fm_field_name_len) :: name = ' ' !< name - real, pointer, dimension(:,:) :: values => NULL() !< values + real, pointer, contiguous, dimension(:,:) :: values => NULL() !< values logical :: mean = .true. !< mean logical :: override = .false. !< override integer :: id_diag = 0 !< id_diag From 1d5f06aaee3719557565554b60ddb8277bc0fbac Mon Sep 17 00:00:00 2001 From: Jessica Liptak Date: Tue, 18 Jul 2017 13:57:20 -0400 Subject: [PATCH 06/10] set 'max_field_attribute' to 4 in diag_data.f90 --- diag_manager/diag_data.F90 | 4 ++-- diag_manager/diag_manager.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/diag_manager/diag_data.F90 b/diag_manager/diag_data.F90 index 28dad8cb0d..2cef701276 100644 --- a/diag_manager/diag_data.F90 +++ b/diag_manager/diag_data.F90 @@ -668,7 +668,7 @@ MODULE diag_data_mod ! Cause a fatal error if the output field has a value outside the ! given range for a variable. ! - ! + ! ! Maximum number of user definable attributes per field. ! ! @@ -708,7 +708,7 @@ MODULE diag_data_mod LOGICAL :: oor_warnings_fatal = .FALSE. LOGICAL :: region_out_use_alt_value = .TRUE. - INTEGER :: max_field_attributes = 2 !< Maximum number of user definable attributes per field. + INTEGER :: max_field_attributes = 4 !< Maximum number of user definable attributes per field. Liptak: Changed from 2 to 4 20170718 INTEGER :: max_file_attributes = 2 !< Maximum number of user definable global attributes per file. INTEGER :: max_axis_attributes = 4 !< Maximum number of user definable attributes per axis. LOGICAL :: prepend_date = .TRUE. !< Should the history file have the start date prepended to the file name diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index 5d6902b8e0..c81c85fe93 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -162,7 +162,7 @@ MODULE diag_manager_mod ! If .TRUE. then diag_manager_mod will issue a FATAL error if any values for the output field are ! outside the given range. ! - ! + ! ! Maximum number of user definable attributes per field. ! ! From 282f3bff8726045b8cf158c9b2f0ed13a876fec3 Mon Sep 17 00:00:00 2001 From: raymond Menzel Date: Thu, 20 Jul 2017 17:45:00 -0400 Subject: [PATCH 07/10] changed verify to index in diag_table.F90 --- diag_manager/diag_output.F90 | 2 +- diag_manager/diag_table.F90 | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/diag_manager/diag_output.F90 b/diag_manager/diag_output.F90 index ed50dfabd1..7b9ba167f8 100644 --- a/diag_manager/diag_output.F90 +++ b/diag_manager/diag_output.F90 @@ -131,7 +131,7 @@ SUBROUTINE diag_output_init(file_name, FORMAT, file_title, file_unit,& IF ( domain .NE. NULL_DOMAIN2D ) THEN CALL mpp_open(file_unit, file_name, action=MPP_OVERWR, form=form,& & threading=threading, fileset=fileset, domain=domain) - ELSEif (domainU .NE. NULL_DOMAINUG) THEN + ELSE IF (domainU .NE. NULL_DOMAINUG) THEN CALL mpp_open(file_unit, file_name, action=MPP_OVERWR, form=form,& & threading=threading, fileset=fileset, domain_UG=domainU) ELSE diff --git a/diag_manager/diag_table.F90 b/diag_manager/diag_table.F90 index b4bb892a98..4d7db43faf 100644 --- a/diag_manager/diag_table.F90 +++ b/diag_manager/diag_table.F90 @@ -457,8 +457,8 @@ SUBROUTINE parse_diag_table(diag_subset, istat, err_msg) & CALL error_mesg("diag_table_mod::parse_diag_table",& & TRIM(local_err_msg)//" (line: "//TRIM(line_number)//").", WARNING) CYCLE parser - ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. VERIFY('ocean', lowercase(temp_file%file_name)) == 0).OR.& - & (diag_subset_output == DIAG_OCEAN .AND. VERIFY('ocean', lowercase(temp_file%file_name)) /= 0) ) THEN + ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. INDEX('ocean', lowercase(temp_file%file_name)) .NE. 0).OR.& + & (diag_subset_output == DIAG_OCEAN .AND. INDEX('ocean', lowercase(temp_file%file_name)) .EQ. 0) ) THEN CYCLE parser ELSE IF ( temp_file%new_file_freq > 0 ) THEN ! Call the init_file subroutine. The '1' is for the tile_count CALL init_file(temp_file%file_name, temp_file%output_freq, temp_file%iOutput_freq_units, temp_file%file_format,& @@ -485,8 +485,8 @@ SUBROUTINE parse_diag_table(diag_subset, istat, err_msg) & CALL error_mesg("diag_table_mod::Parse_diag_table",& & TRIM(local_err_msg)//" (line: "//TRIM(line_number)//").",WARNING) CYCLE parser - ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. VERIFY('ocean', lowercase(temp_field%file_name)) == 0).OR.& - & (diag_subset_output == DIAG_OCEAN .AND. VERIFY('ocean', lowercase(temp_field%file_name)) /= 0) ) THEN + ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. INDEX('ocean', lowercase(temp_field%file_name)) .NE. 0).OR.& + & (diag_subset_output == DIAG_OCEAN .AND. INDEX('ocean', lowercase(temp_field%file_name)) .EQ. 0) ) THEN CYCLE parser ELSE IF ( lowercase(TRIM(temp_field%spatial_ops)) == 'none' ) THEN CALL init_input_field(temp_field%module_name, temp_field%field_name, 1) From d4786911db681de69a0150736f0adc304c9a07bf Mon Sep 17 00:00:00 2001 From: Seth Underwood Date: Fri, 21 Jul 2017 17:10:36 -0400 Subject: [PATCH 08/10] Fix INDEX when checking for ocean files The original fix to replace VERIFY with INDEX needed to also swap the arguements. this update resolves that. This update also increases max_input_fields default value to 600 --- diag_manager/diag_data.F90 | 4 ++-- diag_manager/diag_table.F90 | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/diag_manager/diag_data.F90 b/diag_manager/diag_data.F90 index 2cef701276..47df7134fb 100644 --- a/diag_manager/diag_data.F90 +++ b/diag_manager/diag_data.F90 @@ -638,7 +638,7 @@ MODULE diag_data_mod ! ! Maximum number of output fields. Increase via the diag_manager_nml namelist. ! - ! + ! ! Maximum number of input fields. Increase via the diag_manager_nml namelist. ! ! @@ -690,7 +690,7 @@ MODULE diag_data_mod LOGICAL :: mix_snapshot_average_fields =.FALSE. INTEGER :: max_files = 31 !< Maximum number of output files allowed. Increase via diag_manager_nml. INTEGER :: max_output_fields = 300 !< Maximum number of output fields. Increase via diag_manager_nml. - INTEGER :: max_input_fields = 300 !< Maximum number of input fields. Increase via diag_manager_nml. + INTEGER :: max_input_fields = 600 !< Maximum number of input fields. Increase via diag_manager_nml. INTEGER :: max_out_per_in_field = 150 !< Maximum number of output_fields per input_field. Increase via diag_manager_nml. INTEGER :: max_axes = 60 !< Maximum number of independent axes. LOGICAL :: do_diag_field_log = .FALSE. diff --git a/diag_manager/diag_table.F90 b/diag_manager/diag_table.F90 index 4d7db43faf..ba5750de5a 100644 --- a/diag_manager/diag_table.F90 +++ b/diag_manager/diag_table.F90 @@ -457,8 +457,8 @@ SUBROUTINE parse_diag_table(diag_subset, istat, err_msg) & CALL error_mesg("diag_table_mod::parse_diag_table",& & TRIM(local_err_msg)//" (line: "//TRIM(line_number)//").", WARNING) CYCLE parser - ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. INDEX('ocean', lowercase(temp_file%file_name)) .NE. 0).OR.& - & (diag_subset_output == DIAG_OCEAN .AND. INDEX('ocean', lowercase(temp_file%file_name)) .EQ. 0) ) THEN + ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. INDEX(lowercase(temp_file%file_name), "ocean") .NE. 0).OR.& + & (diag_subset_output == DIAG_OCEAN .AND. INDEX(lowercase(temp_file%file_name), "ocean") .EQ. 0) ) THEN CYCLE parser ELSE IF ( temp_file%new_file_freq > 0 ) THEN ! Call the init_file subroutine. The '1' is for the tile_count CALL init_file(temp_file%file_name, temp_file%output_freq, temp_file%iOutput_freq_units, temp_file%file_format,& @@ -485,8 +485,8 @@ SUBROUTINE parse_diag_table(diag_subset, istat, err_msg) & CALL error_mesg("diag_table_mod::Parse_diag_table",& & TRIM(local_err_msg)//" (line: "//TRIM(line_number)//").",WARNING) CYCLE parser - ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. INDEX('ocean', lowercase(temp_field%file_name)) .NE. 0).OR.& - & (diag_subset_output == DIAG_OCEAN .AND. INDEX('ocean', lowercase(temp_field%file_name)) .EQ. 0) ) THEN + ELSE IF ( (diag_subset_output == DIAG_OTHER .AND. INDEX(lowercase(temp_field%file_name), "ocean") .NE. 0).OR.& + & (diag_subset_output == DIAG_OCEAN .AND. INDEX(lowercase(temp_field%file_name), "ocean") .EQ. 0) ) THEN CYCLE parser ELSE IF ( lowercase(TRIM(temp_field%spatial_ops)) == 'none' ) THEN CALL init_input_field(temp_field%module_name, temp_field%field_name, 1) From f46fcc39d43fbab222814b6f87277071d01cceab Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 7 Aug 2017 14:00:33 -0400 Subject: [PATCH 09/10] Hard-coded coupler_types string lengths Hard-coded string legths in coupler_types to eliminate a false dependency on the field manager. All answers are bitwise identical. --- coupler/coupler_types.F90 | 167 ++++++++++++++++++-------------------- 1 file changed, 79 insertions(+), 88 deletions(-) diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index 7fc055a69f..b90f86774c 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -168,16 +168,11 @@ module coupler_types_mod !! fms_mod !! write_version_number !! -!! -!! field_manager_mod -!! fm_field_name_len, fm_string_len, fm_dump_list -!! !! use fms_mod, only: write_version_number use fms_io_mod, only: restart_file_type, register_restart_field use fms_io_mod, only: query_initialized, restore_state -use field_manager_mod, only: fm_field_name_len, fm_string_len use time_manager_mod, only: time_type use diag_manager_mod, only: register_diag_field, send_data use data_override_mod, only: data_override @@ -216,38 +211,38 @@ module coupler_types_mod ! type, public :: coupler_3d_values_type - character(len=fm_field_name_len) :: name = ' ' !< The diagnostic name for this array + character(len=48) :: name = ' ' !< The diagnostic name for this array real, 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=fm_string_len) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=fm_string_len) :: 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 + !! 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_3d_values_type type, public :: coupler_3d_field_type - character(len=fm_field_name_len) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields - type(coupler_3d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=fm_string_len) :: flux_type = ' ' !< flux_type - character(len=fm_string_len) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=fm_string_len) :: ice_restart_file = ' ' !< ice_restart_file - character(len=fm_string_len) :: 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. - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt + character(len=48) :: name = ' ' !< name + integer :: num_fields = 0 !< num_fields + type(coupler_3d_values_type), pointer, dimension(:) :: field => NULL() !< field + character(len=128) :: flux_type = ' ' !< flux_type + character(len=128) :: implementation = ' ' !< implementation + real, pointer, dimension(:) :: param => NULL() !< param + logical, pointer, dimension(:) :: flag => NULL() !< flag + 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. + logical :: use_atm_pressure !< use_atm_pressure + logical :: use_10m_wind_speed !< use_10m_wind_speed + logical :: pass_through_ice !< pass_through_ice + real :: mol_wt = 0.0 !< mol_wt end type coupler_3d_field_type type, public :: coupler_3d_bc_type @@ -264,38 +259,38 @@ module coupler_types_mod ! type, public :: coupler_2d_values_type - character(len=fm_field_name_len) :: name = ' ' !< The diagnostic name for this array + character(len=48) :: name = ' ' !< The diagnostic name for this array real, 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=fm_string_len) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=fm_string_len) :: 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 + !! 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_values_type type, public :: coupler_2d_field_type - character(len=fm_field_name_len) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields + character(len=48) :: name = ' ' !< name + integer :: num_fields = 0 !< num_fields type(coupler_2d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=fm_string_len) :: flux_type = ' ' !< flux_type - character(len=fm_string_len) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=fm_string_len) :: ice_restart_file = ' ' !< ice_restart_file - character(len=fm_string_len) :: 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. - logical :: use_atm_pressure !< use_atm_pressure - logical :: use_10m_wind_speed !< use_10m_wind_speed - logical :: pass_through_ice !< pass_through_ice - real :: mol_wt = 0.0 !< mol_wt + character(len=128) :: flux_type = ' ' !< flux_type + character(len=128) :: implementation = ' ' !< implementation + real, pointer, dimension(:) :: param => NULL() !< param + logical, pointer, dimension(:) :: flag => NULL() !< flag + 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. + logical :: use_atm_pressure !< use_atm_pressure + logical :: use_10m_wind_speed !< use_10m_wind_speed + logical :: pass_through_ice !< pass_through_ice + real :: mol_wt = 0.0 !< mol_wt end type coupler_2d_field_type type, public :: coupler_2d_bc_type @@ -311,33 +306,33 @@ module coupler_types_mod ! type, public :: coupler_1d_values_type - character(len=fm_field_name_len) :: name = ' ' !< The diagnostic name for this array - real, 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=fm_string_len) :: long_name = ' ' !< The diagnostic long_name for this array - character(len=fm_string_len) :: 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 + character(len=48) :: name = ' ' !< The diagnostic name for this array + real, 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_values_type type, public :: coupler_1d_field_type - character(len=fm_field_name_len) :: name = ' ' !< name - integer :: num_fields = 0 !< num_fields + character(len=48) :: name = ' ' !< name + integer :: num_fields = 0 !< num_fields type(coupler_1d_values_type), pointer, dimension(:) :: field => NULL() !< field - character(len=fm_string_len) :: flux_type = ' ' !< flux_type - character(len=fm_string_len) :: implementation = ' ' !< implementation - real, pointer, dimension(:) :: param => NULL() !< param - logical, pointer, dimension(:) :: flag => NULL() !< flag - integer :: atm_tr_index = 0 !< atm_tr_index - character(len=fm_string_len) :: ice_restart_file = ' ' !< ice_restart_file - character(len=fm_string_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 - real :: mol_wt = 0.0 !< mol_wt + character(len=128) :: flux_type = ' ' !< flux_type + character(len=128) :: implementation = ' ' !< implementation + real, pointer, dimension(:) :: param => NULL() !< param + logical, pointer, dimension(:) :: flag => NULL() !< flag + 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 + logical :: use_atm_pressure !< use_atm_pressure + logical :: use_10m_wind_speed !< use_10m_wind_speed + logical :: pass_through_ice !< pass_through_ice + real :: mol_wt = 0.0 !< mol_wt end type coupler_1d_field_type type, public :: coupler_1d_bc_type @@ -363,14 +358,9 @@ module coupler_types_mod integer, public :: ind_deposition !< ind_deposition integer, public :: ind_runoff !< ind_runoff -logical, save :: module_is_initialized = .false. - -! !---------------------------------------------------------------------- ! 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. @@ -546,6 +536,7 @@ subroutine coupler_types_init integer :: field_index, outunit character(len=128) :: error_msg +logical, save :: module_is_initialized = .false. ! ! ===================================================================== From d4865fac55ae708504b1175bb73e03723004f037 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 7 Aug 2017 18:27:55 -0400 Subject: [PATCH 10/10] Set coupler_type ind_... variables in declarations Set the coupler_type sub-element indicies (like ind_flux) in their declarations. These should be turned into parameters with the next FMS city release, but this would interfere with certain openMP directives. coupler_types_init no longer sets anything related to the coupler_types module, and it should be extracted and moved into a more logical module with the next FMS city release. All answers are bitwise identical. --- coupler/coupler_types.F90 | 108 +++++++++----------------------------- 1 file changed, 24 insertions(+), 84 deletions(-) diff --git a/coupler/coupler_types.F90 b/coupler/coupler_types.F90 index b90f86774c..397b46cca3 100644 --- a/coupler/coupler_types.F90 +++ b/coupler/coupler_types.F90 @@ -343,20 +343,22 @@ module coupler_types_mod ! !---------------------------------------------------------------------- -! - -! The quality of documentation in these comments is pathetic. -integer, public :: ind_u10 !< ind_u10 -integer, public :: ind_psurf !< ind_psurf -integer, public :: ind_pcair !< ind_pcair -integer, public :: ind_csurf !< ind_csurf -integer, public :: ind_alpha !< The index of the solubility array for a tracer -integer, public :: ind_sc_no !< The index for the Schmidt number for a tracer flux -integer, public :: ind_flux !< The index for the tracer flux -integer, public :: ind_deltap !< ind_deltap -integer, public :: ind_kw !< ind_kw -integer, public :: ind_deposition !< ind_deposition -integer, public :: ind_runoff !< ind_runoff +! 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_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 @@ -534,8 +536,8 @@ subroutine coupler_types_init !----------------------------------------------------------------------- ! -integer :: field_index, outunit -character(len=128) :: error_msg +integer :: outunit +character(len=128) :: error_msg logical, save :: module_is_initialized = .false. ! @@ -628,22 +630,14 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "air_sea_gas_flux_generic/atm" list') endif !} -field_index = 0 - -field_index = field_index + 1 -ind_pcair = field_index call fm_util_set_value('air_sea_gas_flux_generic/atm/name', 'pcair', index = ind_pcair) call fm_util_set_value('air_sea_gas_flux_generic/atm/long_name', 'Atmospheric concentration', index = ind_pcair) call fm_util_set_value('air_sea_gas_flux_generic/atm/units', 'mol/mol', index = ind_pcair) -field_index = field_index + 1 -ind_u10 = field_index call fm_util_set_value('air_sea_gas_flux_generic/atm/name', 'u10', index = ind_u10) call fm_util_set_value('air_sea_gas_flux_generic/atm/long_name', 'Wind speed at 10 m', index = ind_u10) call fm_util_set_value('air_sea_gas_flux_generic/atm/units', 'm/s', index = ind_u10) -field_index = field_index + 1 -ind_psurf = field_index call fm_util_set_value('air_sea_gas_flux_generic/atm/name', 'psurf', index = ind_psurf) call fm_util_set_value('air_sea_gas_flux_generic/atm/long_name', 'Surface atmospheric pressure', index = ind_psurf) call fm_util_set_value('air_sea_gas_flux_generic/atm/units', 'Pa', index = ind_psurf) @@ -654,25 +648,17 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "air_sea_gas_flux_generic/ice" list') endif !} -field_index = 0 - -field_index = field_index + 1 -ind_alpha = field_index -call fm_util_set_value('air_sea_gas_flux_generic/ice/name', 'alpha', index = ind_alpha) +call fm_util_set_value('air_sea_gas_flux_generic/ice/name', 'alpha', index = ind_alpha) call fm_util_set_value('air_sea_gas_flux_generic/ice/long_name', 'Solubility w.r.t. atmosphere', index = ind_alpha) -call fm_util_set_value('air_sea_gas_flux_generic/ice/units', 'mol/m^3/atm', index = ind_alpha) +call fm_util_set_value('air_sea_gas_flux_generic/ice/units', 'mol/m^3/atm', index = ind_alpha) -field_index = field_index + 1 -ind_csurf = field_index -call fm_util_set_value('air_sea_gas_flux_generic/ice/name', 'csurf', index = ind_csurf) +call fm_util_set_value('air_sea_gas_flux_generic/ice/name', 'csurf', index = ind_csurf) call fm_util_set_value('air_sea_gas_flux_generic/ice/long_name', 'Ocean concentration', index = ind_csurf) -call fm_util_set_value('air_sea_gas_flux_generic/ice/units', 'mol/m^3', index = ind_csurf) +call fm_util_set_value('air_sea_gas_flux_generic/ice/units', 'mol/m^3', index = ind_csurf) -field_index = field_index + 1 -ind_sc_no = field_index -call fm_util_set_value('air_sea_gas_flux_generic/ice/name', 'sc_no', index = ind_sc_no) +call fm_util_set_value('air_sea_gas_flux_generic/ice/name', 'sc_no', index = ind_sc_no) call fm_util_set_value('air_sea_gas_flux_generic/ice/long_name', 'Schmidt number', index = ind_sc_no) -call fm_util_set_value('air_sea_gas_flux_generic/ice/units', 'dimensionless', index = ind_sc_no) +call fm_util_set_value('air_sea_gas_flux_generic/ice/units', 'dimensionless', index = ind_sc_no) !> Add the flux output field(s). @@ -680,22 +666,14 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "air_sea_gas_flux_generic/flux" list') endif !} -field_index = 0 - -field_index = field_index + 1 -ind_flux = field_index call fm_util_set_value('air_sea_gas_flux_generic/flux/name', 'flux', index = ind_flux) call fm_util_set_value('air_sea_gas_flux_generic/flux/long_name', 'Surface flux', index = ind_flux) call fm_util_set_value('air_sea_gas_flux_generic/flux/units', 'mol/m^2/s', index = ind_flux) -field_index = field_index + 1 -ind_deltap = field_index call fm_util_set_value('air_sea_gas_flux_generic/flux/name', 'deltap', index = ind_deltap) call fm_util_set_value('air_sea_gas_flux_generic/flux/long_name', 'Ocean-air delta pressure', index = ind_deltap) call fm_util_set_value('air_sea_gas_flux_generic/flux/units', 'uatm', index = ind_deltap) -field_index = field_index + 1 -ind_kw = field_index call fm_util_set_value('air_sea_gas_flux_generic/flux/name', 'kw', index = ind_kw) call fm_util_set_value('air_sea_gas_flux_generic/flux/long_name', 'Piston velocity', index = ind_kw) call fm_util_set_value('air_sea_gas_flux_generic/flux/units', 'm/s', index = ind_kw) @@ -742,22 +720,14 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "air_sea_gas_flux/atm" list') endif !} -field_index = 0 - -field_index = field_index + 1 -ind_pcair = field_index call fm_util_set_value('air_sea_gas_flux/atm/name', 'pcair', index = ind_pcair) call fm_util_set_value('air_sea_gas_flux/atm/long_name', 'Atmospheric concentration', index = ind_pcair) call fm_util_set_value('air_sea_gas_flux/atm/units', 'mol/mol', index = ind_pcair) -field_index = field_index + 1 -ind_u10 = field_index call fm_util_set_value('air_sea_gas_flux/atm/name', 'u10', index = ind_u10) call fm_util_set_value('air_sea_gas_flux/atm/long_name', 'Wind speed at 10 m', index = ind_u10) call fm_util_set_value('air_sea_gas_flux/atm/units', 'm/s', index = ind_u10) -field_index = field_index + 1 -ind_psurf = field_index call fm_util_set_value('air_sea_gas_flux/atm/name', 'psurf', index = ind_psurf) call fm_util_set_value('air_sea_gas_flux/atm/long_name', 'Surface atmospheric pressure', index = ind_psurf) call fm_util_set_value('air_sea_gas_flux/atm/units', 'Pa', index = ind_psurf) @@ -768,16 +738,10 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "air_sea_gas_flux/ice" list') endif !} -field_index = 0 - -field_index = field_index + 1 -ind_alpha = field_index call fm_util_set_value('air_sea_gas_flux/ice/name', 'alpha', index = ind_alpha) call fm_util_set_value('air_sea_gas_flux/ice/long_name', 'Solubility from atmosphere times Schmidt number term', index = ind_alpha) call fm_util_set_value('air_sea_gas_flux/ice/units', 'mol/m^3/atm', index = ind_alpha) -field_index = field_index + 1 -ind_csurf = field_index call fm_util_set_value('air_sea_gas_flux/ice/name', 'csurf', index = ind_csurf) call fm_util_set_value('air_sea_gas_flux/ice/long_name', 'Ocean concentration times Schmidt number term', index = ind_csurf) call fm_util_set_value('air_sea_gas_flux/ice/units', 'mol/m^3', index = ind_csurf) @@ -788,10 +752,6 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "air_sea_gas_flux/flux" list') endif !} -field_index = 0 - -field_index = field_index + 1 -ind_flux = field_index call fm_util_set_value('air_sea_gas_flux/flux/name', 'flux', index = ind_flux) call fm_util_set_value('air_sea_gas_flux/flux/long_name', 'Surface flux', index = ind_flux) call fm_util_set_value('air_sea_gas_flux/flux/units', 'mol/m^2/s', index = ind_flux) @@ -834,10 +794,6 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "air_sea_deposition/atm" list') endif !} -field_index = 0 - -field_index = field_index + 1 -ind_deposition = field_index call fm_util_set_value('air_sea_deposition/atm/name', 'deposition', index = ind_deposition) call fm_util_set_value('air_sea_deposition/atm/long_name', 'Atmospheric deposition', index = ind_deposition) call fm_util_set_value('air_sea_deposition/atm/units', 'kg/m^2/s', index = ind_deposition) @@ -848,8 +804,6 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "air_sea_deposition/ice" list') endif !} -field_index = 0 - call fm_util_set_value('air_sea_deposition/ice/name', ' ', index = 0) call fm_util_set_value('air_sea_deposition/ice/long_name', ' ', index = 0) call fm_util_set_value('air_sea_deposition/ice/units', ' ', index = 0) @@ -860,10 +814,6 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "air_sea_deposition/flux" list') endif !} -field_index = 0 - -field_index = field_index + 1 -ind_flux = field_index call fm_util_set_value('air_sea_deposition/flux/name', 'flux', index = ind_flux) call fm_util_set_value('air_sea_deposition/flux/long_name', 'Surface deposition', index = ind_flux) call fm_util_set_value('air_sea_deposition/flux/units', 'mol/m^2/s', index = ind_flux) @@ -902,10 +852,6 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "land_sea_runoff/atm" list') endif !} -field_index = 0 - -field_index = field_index + 1 -ind_runoff = field_index call fm_util_set_value('land_sea_runoff/atm/name', 'runoff', index = ind_runoff) call fm_util_set_value('land_sea_runoff/atm/long_name', 'Concentration in land runoff', index = ind_runoff) call fm_util_set_value('land_sea_runoff/atm/units', 'mol/m^3', index = ind_runoff) @@ -916,8 +862,6 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "land_sea_runoff/ice" list') endif !} -field_index = 0 - call fm_util_set_value('land_sea_runoff/ice/name', ' ', index = 0) call fm_util_set_value('land_sea_runoff/ice/long_name', ' ', index = 0) call fm_util_set_value('land_sea_runoff/ice/units', ' ', index = 0) @@ -928,10 +872,6 @@ subroutine coupler_types_init call mpp_error(FATAL, trim(error_header) // ' Could not set the "land_sea_runoff/flux" list') endif !} -field_index = 0 - -field_index = field_index + 1 -ind_flux = field_index call fm_util_set_value('land_sea_runoff/flux/name', 'flux', index = ind_flux) call fm_util_set_value('land_sea_runoff/flux/long_name', 'Concentration in land runoff', index = ind_flux) call fm_util_set_value('land_sea_runoff/flux/units', 'mol/m^3', index = ind_flux)