From 77649b22e71c6927e81cbeb7a773df20ee704936 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Feb 2021 16:26:41 -0500 Subject: [PATCH] +Cleanup of MOM_diag_manager_infra interfaces Renamed the interfaces send_data_fms_wrapper to send_data_infra, and register_..._field_fms_wrapper to register_..._field_infra. Also removed some of the optional arguments from these interfaces that are never used in MOM6 and rearranged the order of the optional arguments to send_data_infra to make more sense given how they are used in MOM6. Also regularized the formatting of the argument descriptions in MOM_diag_manager_infra.F90 to match the patterns elsewhere in the MOM6 code and corrected some incorrect comments. In addition, removed the error messages about obsolete diagnostics from found_in_table() and put them back into the MOM_obsolete_diagnostics module in the new local subroutine diag_found(). All answers are bitwise identical, although there are some interface changes. --- src/diagnostics/MOM_obsolete_diagnostics.F90 | 56 ++- src/framework/MOM_diag_manager_infra.F90 | 426 +++++++++--------- src/framework/MOM_diag_mediator.F90 | 130 +++--- src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 | 74 +-- 4 files changed, 339 insertions(+), 347 deletions(-) diff --git a/src/diagnostics/MOM_obsolete_diagnostics.F90 b/src/diagnostics/MOM_obsolete_diagnostics.F90 index 8243b15cf7..86034292b5 100644 --- a/src/diagnostics/MOM_obsolete_diagnostics.F90 +++ b/src/diagnostics/MOM_obsolete_diagnostics.F90 @@ -35,30 +35,50 @@ subroutine register_obsolete_diagnostics(param_file, diag) foundEntry = .false. ! Each obsolete entry, with replacement name is available. - if (found_in_diagtable(diag, 'Net_Heat', 'net_heat_surface or net_heat_coupler')) foundEntry = .true. - if (found_in_diagtable(diag, 'PmE', 'PRCmE')) foundEntry = .true. - if (found_in_diagtable(diag, 'froz_precip', 'fprec')) foundEntry = .true. - if (found_in_diagtable(diag, 'liq_precip', 'lprec')) foundEntry = .true. - if (found_in_diagtable(diag, 'virt_precip', 'vprec')) foundEntry = .true. - if (found_in_diagtable(diag, 'froz_runoff', 'frunoff')) foundEntry = .true. - if (found_in_diagtable(diag, 'liq_runoff', 'lrunoff')) foundEntry = .true. - if (found_in_diagtable(diag, 'calving_heat_content', 'heat_content_frunoff')) foundEntry = .true. - if (found_in_diagtable(diag, 'precip_heat_content', 'heat_content_lprec')) foundEntry = .true. - if (found_in_diagtable(diag, 'evap_heat_content', 'heat_content_massout')) foundEntry = .true. - if (found_in_diagtable(diag, 'runoff_heat_content', 'heat_content_lrunoff')) foundEntry = .true. - if (found_in_diagtable(diag, 'latent_fprec')) foundEntry = .true. - if (found_in_diagtable(diag, 'latent_calve')) foundEntry = .true. - if (found_in_diagtable(diag, 'heat_rest', 'heat_restore')) foundEntry = .true. - if (found_in_diagtable(diag, 'KPP_dTdt', 'KPP_NLT_dTdt')) foundEntry = .true. - if (found_in_diagtable(diag, 'KPP_dSdt', 'KPP_NLT_dSdt')) foundEntry = .true. + if (diag_found(diag, 'Net_Heat', 'net_heat_surface or net_heat_coupler')) foundEntry = .true. + if (diag_found(diag, 'PmE', 'PRCmE')) foundEntry = .true. + if (diag_found(diag, 'froz_precip', 'fprec')) foundEntry = .true. + if (diag_found(diag, 'liq_precip', 'lprec')) foundEntry = .true. + if (diag_found(diag, 'virt_precip', 'vprec')) foundEntry = .true. + if (diag_found(diag, 'froz_runoff', 'frunoff')) foundEntry = .true. + if (diag_found(diag, 'liq_runoff', 'lrunoff')) foundEntry = .true. + if (diag_found(diag, 'calving_heat_content', 'heat_content_frunoff')) foundEntry = .true. + if (diag_found(diag, 'precip_heat_content', 'heat_content_lprec')) foundEntry = .true. + if (diag_found(diag, 'evap_heat_content', 'heat_content_massout')) foundEntry = .true. + if (diag_found(diag, 'runoff_heat_content', 'heat_content_lrunoff')) foundEntry = .true. + if (diag_found(diag, 'latent_fprec')) foundEntry = .true. + if (diag_found(diag, 'latent_calve')) foundEntry = .true. + if (diag_found(diag, 'heat_rest', 'heat_restore')) foundEntry = .true. + if (diag_found(diag, 'KPP_dTdt', 'KPP_NLT_dTdt')) foundEntry = .true. + if (diag_found(diag, 'KPP_dSdt', 'KPP_NLT_dSdt')) foundEntry = .true. if (causeFatal) then; errType = FATAL else ; errType = WARNING ; endif if (foundEntry .and. is_root_pe()) & - call MOM_error(errType, 'MOM_obsolete_diagnostics: '//& - 'Obsolete diagnostics found in diag_table') + call MOM_error(errType, 'MOM_obsolete_diagnostics: Obsolete diagnostics found in diag_table.') end subroutine register_obsolete_diagnostics +!> Determines whether an obsolete parameter appears in the diag_table. +logical function diag_found(diag, varName, newVarName) + type(diag_ctrl), intent(in) :: diag !< A structure used to control diagnostics. + character(len=*), intent(in) :: varName !< The obsolete diagnostic name + character(len=*), optional, intent(in) :: newVarName !< The valid name of this diagnostic + ! Local + integer :: handle ! Integer handle returned from diag_manager + + diag_found = found_in_diagtable(diag, varName) + + if (diag_found .and. is_root_pe()) then + if (present(newVarName)) then + call MOM_error(WARNING, 'MOM_obsolete_params: '//'diag_table entry "'// & + trim(varName)//'" found. Use ''"'//trim(newVarName)//'" instead.' ) + else + call MOM_error(WARNING, 'MOM_obsolete_params: '//'diag_table entry "'// & + trim(varName)//'" is obsolete.' ) + endif + endif + +end function diag_found end module MOM_obsolete_diagnostics diff --git a/src/framework/MOM_diag_manager_infra.F90 b/src/framework/MOM_diag_manager_infra.F90 index 7617d9ed91..702c464814 100644 --- a/src/framework/MOM_diag_manager_infra.F90 +++ b/src/framework/MOM_diag_manager_infra.F90 @@ -23,26 +23,23 @@ module MOM_diag_manager_infra use time_manager_mod, only : time_type use MOM_domain_infra, only : MOM_domain_type use MOM_error_handler, only : MOM_error, FATAL, WARNING -implicit none ; private +implicit none ; private !> transmit data for diagnostic output -interface register_diag_field_fms_wrapper - module procedure register_diag_field_fms_wrapper_scalar - module procedure register_diag_field_fms_wrapper_array -end interface register_diag_field_fms_wrapper +interface register_diag_field_infra + module procedure register_diag_field_infra_scalar + module procedure register_diag_field_infra_array +end interface register_diag_field_infra !> transmit data for diagnostic output -interface send_data_fms_wrapper - module procedure send_data_fms_wrapper_0d - module procedure send_data_fms_wrapper_1d - module procedure send_data_fms_wrapper_2d - module procedure send_data_fms_wrapper_3d +interface send_data_infra + module procedure send_data_infra_0d, send_data_infra_1d + module procedure send_data_infra_2d, send_data_infra_3d #ifdef OVERLOAD_R8 - module procedure send_data_fms_wrapper_2d_r8 - module procedure send_data_fms_wrapper_3d_r8 + module procedure send_data_infra_2d_r8, send_data_infra_3d_r8 #endif -end interface send_data_fms_wrapper +end interface send_data_infra !> Add an attribute to a diagnostic field interface MOM_diag_field_add_attribute @@ -59,10 +56,10 @@ module MOM_diag_manager_infra public get_MOM_diag_axis_name public MOM_diag_manager_init public MOM_diag_manager_end -public send_data_fms_wrapper +public send_data_infra public MOM_diag_field_add_attribute -public register_diag_field_fms_wrapper -public register_static_field_fms_wrapper +public register_diag_field_infra +public register_static_field_infra public get_MOM_diag_field_id ! Public data public null_axis_id @@ -131,7 +128,7 @@ end function MOM_diag_axis_init !> Returns the short name of the axis subroutine get_MOM_diag_axis_name(id, name) - integer, intent(in) :: id !< The axis numeric id + integer, intent(in) :: id !< The axis numeric id character(len=*), intent(out) :: name !< The short name of the axis call fms_get_diag_axis_name(id, name) @@ -144,18 +141,18 @@ integer function get_MOM_diag_field_id(module_name, field_name) character(len=*), intent(in) :: field_name !< A field name string to query. - get_MOM_diag_field_id=-1 + get_MOM_diag_field_id = -1 get_MOM_diag_field_id = get_diag_field_id_fms(module_name, field_name) end function get_MOM_diag_field_id !> Initializes the diagnostic manager subroutine MOM_diag_manager_init(diag_model_subset, time_init, err_msg) - integer, optional, intent(in) :: diag_model_subset !< An optional diagnostic subset + integer, optional, intent(in) :: diag_model_subset !< An optional diagnostic subset integer, dimension(6), optional, intent(in) :: time_init !< An optional reference time for diagnostics !! The default uses the value contained in the !! diag_table. Format is Y-M-D-H-M-S - character(len=*), intent(out), optional :: err_msg !< Error message. + character(len=*), optional, intent(out) :: err_msg !< Error message. call FMS_diag_manager_init(diag_model_subset, time_init, err_msg) end subroutine MOM_diag_manager_init @@ -169,224 +166,215 @@ subroutine MOM_diag_manager_end(time) end subroutine MOM_diag_manager_end !> Register a MOM diagnostic field for scalars -integer function register_diag_field_fms_wrapper_scalar(module_name, field_name, init_time, & - & long_name, units, missing_value, range, standard_name, do_not_log, err_msg, & - & area, volume, realm) - character(len=*), intent(in) :: module_name !< The name of the associated module - character(len=*), intent(in) :: field_name !< The name of the field - type(time_type), optional, intent(in) :: init_time !< The registration time. - character(len=*), optional, intent(in) :: long_name !< A long name for the field - character(len=*), optional, intent(in) :: units !< Field metric. - character(len=*), optional, intent(in) :: standard_name !< A standard name for the field - real, optional, intent(in) :: missing_value !< Missing value attribute. - real, dimension(2), optional, intent(in) :: range !< A valid range of the field - logical, optional, intent(in) :: do_not_log !< if TRUE, field information is not logged - character(len=*), optional, intent(out):: err_msg !< Log message. - integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute - integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute - character(len=*), optional, intent(in):: realm !< String to set as the value to the modeling_realm attribute - - - register_diag_field_fms_wrapper_scalar = register_diag_field_fms(module_name, field_name, init_time, & - long_name, units, missing_value, range, standard_name, do_not_log, err_msg, & - area, volume, realm) - -end function register_diag_field_fms_wrapper_scalar +integer function register_diag_field_infra_scalar(module_name, field_name, init_time, & + long_name, units, missing_value, range, standard_name, do_not_log, & + err_msg, area, volume) + character(len=*), intent(in) :: module_name !< The name of the associated module + character(len=*), intent(in) :: field_name !< The name of the field + type(time_type), optional, intent(in) :: init_time !< The registration time + character(len=*), optional, intent(in) :: long_name !< A long name for the field + character(len=*), optional, intent(in) :: units !< Field units + character(len=*), optional, intent(in) :: standard_name !< A standard name for the field + real, optional, intent(in) :: missing_value !< Missing value attribute + real, dimension(2), optional, intent(in) :: range !< A valid range of the field + logical, optional, intent(in) :: do_not_log !< if TRUE, field information is not logged + character(len=*), optional, intent(out):: err_msg !< An error message to return + integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute + integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute + + register_diag_field_infra_scalar = register_diag_field_fms(module_name, field_name, init_time, & + long_name, units, missing_value, range, standard_name, do_not_log, err_msg, area, volume) + +end function register_diag_field_infra_scalar !> Register a MOM diagnostic field for scalars -integer function register_diag_field_fms_wrapper_array(module_name, field_name, axes, init_time, & - & long_name, units, missing_value, range, mask_variant, standard_name, verbose, do_not_log, & - & err_msg, interp_method, tile_count, & - & area, volume, realm) - character(len=*), intent(in) :: module_name !< The name of the associated module - character(len=*), intent(in) :: field_name !< The name of the field - integer, INTENT(in) :: axes(:) !< Diagnostic ID of 1 dimensional axis attributes for the field. - type(time_type), optional, intent(in) :: init_time !< The registration time. - character(len=*), optional, intent(in) :: long_name !< A long name for the field - character(len=*), optional, intent(in) :: units !< Field metric. - real, optional, intent(in) :: missing_value !< Missing value attribute. - real, dimension(2), optional, intent(in) :: range !< A valid range of the field - logical, optional, intent(in) :: mask_variant !< If true, the field mask is varying in time. - character(len=*), optional, intent(in) :: standard_name !< A standard name for the field - logical, optional, intent(in) :: verbose !< If true, provide additional log information - logical, optional, intent(in) :: do_not_log !< if TRUE, field information is not logged - character(len=*), optional, intent(in) :: interp_method !< Not documented - integer, optional, intent(in) :: tile_count !< The tile number for the current PE - character(len=*), optional, intent(out):: err_msg !< Log message. - integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute - integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute - character(len=*), optional, intent(in):: realm !< String to set as the value to the modeling_realm attribute - - - register_diag_field_fms_wrapper_array = register_diag_field_fms(module_name, field_name, axes, init_time, & - & long_name, units, missing_value, range, mask_variant, standard_name, verbose, do_not_log, & - & err_msg, interp_method, tile_count, & - & area, volume, realm) - -end function register_diag_field_fms_wrapper_array - - -integer function register_static_field_fms_wrapper(module_name, field_name, axes, long_name, units,& - & missing_value, range, mask_variant, standard_name, do_not_log, interp_method,& - & tile_count, area, volume, realm) - character(len=*), intent(in) :: module_name !< The name of the associated module - character(len=*), intent(in) :: field_name !< The name of the field - integer, INTENT(in) :: axes(:) !< Diagnostic ID of 1 dimensional axis attributes for the field. - character(len=*), optional, intent(in) :: long_name !< A long name for the field - character(len=*), optional, intent(in) :: units !< Field metric. - real, optional, intent(in) :: missing_value !< Missing value attribute. - real, dimension(2), optional, intent(in) :: range !< A valid range of the field - logical, optional, intent(in) :: mask_variant !< If true, the field mask is varying in time. - character(len=*), optional, intent(in) :: standard_name !< A standard name for the field - logical, optional, intent(in) :: do_not_log !< if TRUE, field information is not logged - character(len=*), optional, intent(in) :: interp_method !< Not documented - integer, optional, intent(in) :: tile_count !< The tile number for the current PE - integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute - integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute - character(len=*), optional, intent(in):: realm !< String to set as the value to the modeling_realm attribute - - - register_static_field_fms_wrapper = register_static_field_fms(module_name, field_name, axes, long_name, units,& +integer function register_diag_field_infra_array(module_name, field_name, axes, init_time, & + long_name, units, missing_value, range, mask_variant, standard_name, verbose, & + do_not_log, err_msg, interp_method, tile_count, area, volume) + character(len=*), intent(in) :: module_name !< The name of the associated module + character(len=*), intent(in) :: field_name !< The name of the field + integer, dimension(:), intent(in) :: axes !< Diagnostic IDs of axis attributes for the field + type(time_type), optional, intent(in) :: init_time !< The registration time + character(len=*), optional, intent(in) :: long_name !< A long name for the field + character(len=*), optional, intent(in) :: units !< Units of the field + real, optional, intent(in) :: missing_value !< Missing value attribute + real, dimension(2), optional, intent(in) :: range !< A valid range of the field + logical, optional, intent(in) :: mask_variant !< If true, the field mask is varying in time + character(len=*), optional, intent(in) :: standard_name !< A standard name for the field + logical, optional, intent(in) :: verbose !< If true, provide additional log information + logical, optional, intent(in) :: do_not_log !< if TRUE, field information is not logged + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should + !! not be interpolated as a scalar + integer, optional, intent(in) :: tile_count !< The tile number for the current PE + character(len=*), optional, intent(out):: err_msg !< An error message to return + integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute + integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute + + register_diag_field_infra_array = register_diag_field_fms(module_name, field_name, axes, init_time, & + long_name, units, missing_value, range, mask_variant, standard_name, verbose, do_not_log, & + err_msg, interp_method, tile_count, area, volume) + +end function register_diag_field_infra_array + + +integer function register_static_field_infra(module_name, field_name, axes, long_name, units, & + missing_value, range, mask_variant, standard_name, do_not_log, interp_method, & + tile_count, area, volume) + character(len=*), intent(in) :: module_name !< The name of the associated module + character(len=*), intent(in) :: field_name !< The name of the field + integer, dimension(:), intent(in) :: axes !< Diagnostic IDs of axis attributes for the field + character(len=*), optional, intent(in) :: long_name !< A long name for the field + character(len=*), optional, intent(in) :: units !< Units of the field + real, optional, intent(in) :: missing_value !< Missing value attribute + real, dimension(2), optional, intent(in) :: range !< A valid range of the field + logical, optional, intent(in) :: mask_variant !< If true, the field mask is varying in time + character(len=*), optional, intent(in) :: standard_name !< A standard name for the field + logical, optional, intent(in) :: do_not_log !< if TRUE, field information is not logged + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should + !! not be interpolated as a scalar + integer, optional, intent(in) :: tile_count !< The tile number for the current PE + integer, optional, intent(in) :: area !< Diagnostic ID of the field containing the area attribute + integer, optional, intent(in) :: volume !< Diagnostic ID of the field containing the volume attribute + + register_static_field_infra = register_static_field_fms(module_name, field_name, axes, long_name, units,& & missing_value, range, mask_variant, standard_name, dynamic=.false.,do_not_log=do_not_log, & - interp_method=interp_method,tile_count=tile_count, area=area, volume=volume, realm=realm) -end function register_static_field_fms_wrapper + interp_method=interp_method,tile_count=tile_count, area=area, volume=volume) +end function register_static_field_infra !> Returns true if the argument data are successfully passed to a diagnostic manager !! with the indicated unique reference id, false otherwise. -logical function send_data_fms_wrapper_0d(diag_field_id, field, time, err_msg) - integer, intent(in) :: diag_field_id !< A unique identifier for this data to the diagnostic manager - real, intent(in) :: field !< Floating point value being recorded - TYPE(time_type), intent(in), optional :: time !< Time slice for this record - CHARACTER(len=*), intent(out), optional :: err_msg !< An optional error message +logical function send_data_infra_0d(diag_field_id, field, time, err_msg) + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + real, intent(in) :: field !< The value being recorded + TYPE(time_type), optional, intent(in) :: time !< The time for the current record + CHARACTER(len=*), optional, intent(out) :: err_msg !< An optional error message - send_data_fms_wrapper_0d= send_data_fms(diag_field_id, field, time, err_msg) -end function send_data_fms_wrapper_0d + send_data_infra_0d = send_data_fms(diag_field_id, field, time, err_msg) +end function send_data_infra_0d !> Returns true if the argument data are successfully passed to a diagnostic manager !! with the indicated unique reference id, false otherwise. -logical function send_data_fms_wrapper_1d(diag_field_id, field, time, is_in, mask, rmask, ie_in, weight, err_msg) - integer, intent(in) :: diag_field_id !< A unique identifier for this data to the diagnostic manager - real, dimension(:), intent(in) :: field !< A rank 1 array of floating point values being recorded - type (time_type), intent(in), optional :: time !< The time for the current record. - logical, intent(in), dimension(:), optional :: mask !< An optional rank 1 logical mask. - real, intent(in), dimension(:), optional :: rmask !< An optional rank 1 mask array - integer, intent(in), optional :: is_in !< An optional starting index for subsetting the data being recorded. - integer, intent(in), optional :: ie_in !< An optional end index for subsetting the data being recorded. - real, intent(in), optional :: weight !< An optional scalar weight factor to apply to the current record - !! in the case where data a data reduction in time is being performed. - character(len=*), intent(out), optional :: err_msg !< A log indicating the status of the post upon - !! returning to the calling routine. - - send_data_fms_wrapper_1d= send_data_fms(diag_field_id, field, time, is_in, mask, rmask, ie_in, weight, err_msg) - -end function send_data_fms_wrapper_1d +logical function send_data_infra_1d(diag_field_id, field, is_in, ie_in, time, mask, rmask, weight, err_msg) + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + real, dimension(:), intent(in) :: field !< A 1-d array of values being recorded + integer, optional, intent(in) :: is_in !< The starting index for the data being recorded + integer, optional, intent(in) :: ie_in !< The end index for the data being recorded + type(time_type), optional, intent(in) :: time !< The time for the current record + logical, dimension(:), optional, intent(in) :: mask !< An optional rank 1 logical mask + real, dimension(:), optional, intent(in) :: rmask !< An optional rank 1 mask array + real, optional, intent(in) :: weight !< A scalar weight factor to apply to the current + !! record if there is averaging in time + character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon + !! returning to the calling routine + + send_data_infra_1d = send_data_fms(diag_field_id, field, time, is_in, mask, rmask, ie_in, weight, err_msg) + +end function send_data_infra_1d !> Returns true if the argument data are successfully passed to a diagnostic manager !! with the indicated unique reference id, false otherwise. -logical function send_data_fms_wrapper_2d(diag_field_id, field, time, is_in, js_in, mask, rmask, & - & ie_in, je_in, weight, err_msg) - integer, intent(in) :: diag_field_id !< A unique identifier for this data to the diagnostic manager - real, dimension(:,:), intent(in) :: field !< A rank 1 array of floating point values being recorded - type (time_type), intent(in), optional :: time !< The time for the current record. - logical, intent(in), dimension(:,:), optional :: mask !< An optional rank 1 logical mask. - real, intent(in), dimension(:,:), optional :: rmask !< An optional rank 1 mask array - integer, intent(in), optional :: is_in !< An optional i starting index for subsetting the data being recorded. - integer, intent(in), optional :: ie_in !< An optional i end index for subsetting the data being recorded. - integer, intent(in), optional :: js_in !< An optional j starting index for subsetting the data being recorded. - integer, intent(in), optional :: je_in !< An optional j end index for subsetting the data being recorded. - real, intent(in), optional :: weight !< An optional scalar weight factor to apply to the current record - !! in the case where data a data reduction in time is being performed. - character(len=*), intent(out), optional :: err_msg !< A log indicating the status of the post upon - !! returning to the calling routine. - - send_data_fms_wrapper_2d= send_data_fms(diag_field_id, field, time, is_in, js_in, mask, & +logical function send_data_infra_2d(diag_field_id, field, is_in, ie_in, js_in, je_in, & + time, mask, rmask, weight, err_msg) + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + real, dimension(:,:), intent(in) :: field !< A 2-d array of values being recorded + integer, optional, intent(in) :: is_in !< The starting i-index for the data being recorded + integer, optional, intent(in) :: ie_in !< The end i-index for the data being recorded + integer, optional, intent(in) :: js_in !< The starting j-index for the data being recorded + integer, optional, intent(in) :: je_in !< The end j-index for the data being recorded + type(time_type), optional, intent(in) :: time !< The time for the current record + logical, dimension(:,:), optional, intent(in) :: mask !< An optional 2-d logical mask + real, dimension(:,:), optional, intent(in) :: rmask !< An optional 2-d mask array + real, optional, intent(in) :: weight !< A scalar weight factor to apply to the current + !! record if there is averaging in time + character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon + !! returning to the calling routine + + send_data_infra_2d = send_data_fms(diag_field_id, field, time, is_in, js_in, mask, & rmask, ie_in, je_in, weight, err_msg) -end function send_data_fms_wrapper_2d +end function send_data_infra_2d -#ifdef OVERLOAD_R8 !> Returns true if the argument data are successfully passed to a diagnostic manager !! with the indicated unique reference id, false otherwise. -logical function send_data_fms_wrapper_2d_r8(diag_field_id, field, time, is_in, js_in, mask, rmask, & - & ie_in, je_in, weight, err_msg) - integer, intent(in) :: diag_field_id !< A unique identifier for this data to the diagnostic manager - real(kind=8), dimension(:,:), intent(in) :: field !< A rank 1 array of floating point values being recorded - type (time_type), intent(in), optional :: time !< The time for the current record. - logical, intent(in), dimension(:,:), optional :: mask !< An optional rank 1 logical mask. - real, intent(in), dimension(:,:), optional :: rmask !< An optional rank 1 mask array - integer, intent(in), optional :: is_in !< An optional i starting index for subsetting the data being recorded. - integer, intent(in), optional :: ie_in !< An optional i end index for subsetting the data being recorded. - integer, intent(in), optional :: js_in !< An optional j starting index for subsetting the data being recorded. - integer, intent(in), optional :: je_in !< An optional j end index for subsetting the data being recorded. - real, intent(in), optional :: weight !< An optional scalar weight factor to apply to the current record - !! in the case where data a data reduction in time is being performed. - character(len=*), intent(out), optional :: err_msg !< A log indicating the status of the post upon - !! returning to the calling routine. - - send_data_fms_wrapper_2d_r8 = send_data_fms(diag_field_id, field, time, is_in, js_in, mask, & - rmask, ie_in, je_in, weight, err_msg) +logical function send_data_infra_3d(diag_field_id, field, is_in, ie_in, js_in, je_in, ks_in, ke_in, & + time, mask, rmask, weight, err_msg) + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + real, dimension(:,:,:), intent(in) :: field !< A rank 1 array of floating point values being recorded + integer, optional, intent(in) :: is_in !< The starting i-index for the data being recorded + integer, optional, intent(in) :: ie_in !< The end i-index for the data being recorded + integer, optional, intent(in) :: js_in !< The starting j-index for the data being recorded + integer, optional, intent(in) :: je_in !< The end j-index for the data being recorded + integer, optional, intent(in) :: ks_in !< The starting k-index for the data being recorded + integer, optional, intent(in) :: ke_in !< The end k-index for the data being recorded + type(time_type), optional, intent(in) :: time !< The time for the current record + logical, dimension(:,:,:), optional, intent(in) :: mask !< An optional 3-d logical mask + real, dimension(:,:,:), optional, intent(in) :: rmask !< An optional 3-d mask array + real, optional, intent(in) :: weight !< A scalar weight factor to apply to the current + !! record if there is averaging in time + character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon + !! returning to the calling routine + + send_data_infra_3d = send_data_fms(diag_field_id, field, time, is_in, js_in, ks_in, mask, & + rmask, ie_in, je_in, ke_in, weight, err_msg) + +end function send_data_infra_3d -end function send_data_fms_wrapper_2d_r8 -#endif +#ifdef OVERLOAD_R8 !> Returns true if the argument data are successfully passed to a diagnostic manager !! with the indicated unique reference id, false otherwise. -logical function send_data_fms_wrapper_3d(diag_field_id, field, time, is_in, js_in, ks_in, mask, rmask, & - & ie_in, je_in, ke_in, weight, err_msg) - integer, intent(in) :: diag_field_id !< A unique identifier for this data to the diagnostic manager - real, dimension(:,:,:), intent(in) :: field !< A rank 1 array of floating point values being recorded - type (time_type), intent(in), optional :: time !< The time for the current record. - logical, intent(in), dimension(:,:,:), optional :: mask !< An optional rank 1 logical mask. - real, intent(in), dimension(:,:,:), optional :: rmask !< An optional rank 1 mask array - integer, intent(in), optional :: is_in !< An optional i starting index for subsetting the data being recorded. - integer, intent(in), optional :: ie_in !< An optional i end index for subsetting the data being recorded. - integer, intent(in), optional :: js_in !< An optional j starting index for subsetting the data being recorded. - integer, intent(in), optional :: je_in !< An optional j end index for subsetting the data being recorded. - integer, intent(in), optional :: ks_in !< An optional k starting index for subsetting the data being recorded. - integer, intent(in), optional :: ke_in !< An optional k end index for subsetting the data being recorded. - real, intent(in), optional :: weight !< An optional scalar weight factor to apply to the current record - !! in the case where data a data reduction in time is being performed. - character(len=*), intent(out), optional :: err_msg !< A log indicating the status of the post upon - !! returning to the calling routine. - - send_data_fms_wrapper_3d = send_data_fms(diag_field_id, field, time, is_in, js_in, ks_in, mask, & - rmask, ie_in, je_in, ke_in, weight, err_msg) - -end function send_data_fms_wrapper_3d +logical function send_data_infra_2d_r8(diag_field_id, field, is_in, ie_in, js_in, je_in, & + time, mask, rmask, weight, err_msg) + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + real(kind=8), dimension(:,:), intent(in) :: field !< A 2-d array of values being recorded + integer, optional, intent(in) :: is_in !< The starting i-index for the data being recorded + integer, optional, intent(in) :: ie_in !< The end i-index for the data being recorded + integer, optional, intent(in) :: js_in !< The starting j-index for the data being recorded + integer, optional, intent(in) :: je_in !< The end j-index for the data being recorded + type(time_type), optional, intent(in) :: time !< The time for the current record + logical, dimension(:,:), optional, intent(in) :: mask !< An optional 2-d logical mask + real, dimension(:,:), optional, intent(in) :: rmask !< An optional 2-d mask array + real, optional, intent(in) :: weight !< A scalar weight factor to apply to the current + !! record if there is averaging in time + character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon + !! returning to the calling routine + + send_data_infra_2d_r8 = send_data_fms(diag_field_id, field, time, is_in, js_in, mask, & + rmask, ie_in, je_in, weight, err_msg) +end function send_data_infra_2d_r8 -#ifdef OVERLOAD_R8 !> Returns true if the argument data are successfully passed to a diagnostic manager !! with the indicated unique reference id, false otherwise. -logical function send_data_fms_wrapper_3d_r8(diag_field_id, field, time, is_in, js_in, ks_in, mask, rmask, & - & ie_in, je_in, ke_in, weight, err_msg) - integer, intent(in) :: diag_field_id !< A unique identifier for this data to the diagnostic manager - real(kind=8), dimension(:,:,:), intent(in) :: field !< A rank 1 array of floating point values being recorded - type (time_type), intent(in), optional :: time !< The time for the current record. - logical, intent(in), dimension(:,:,:), optional :: mask !< An optional rank 1 logical mask. - real, intent(in), dimension(:,:,:), optional :: rmask !< An optional rank 1 mask array - integer, intent(in), optional :: is_in !< An optional i starting index for subsetting the data being recorded. - integer, intent(in), optional :: ie_in !< An optional i end index for subsetting the data being recorded. - integer, intent(in), optional :: js_in !< An optional j starting index for subsetting the data being recorded. - integer, intent(in), optional :: je_in !< An optional j end index for subsetting the data being recorded. - integer, intent(in), optional :: ks_in !< An optional k starting index for subsetting the data being recorded. - integer, intent(in), optional :: ke_in !< An optional k end index for subsetting the data being recorded. - real, intent(in), optional :: weight !< An optional scalar weight factor to apply to the current record - !! in the case where data a data reduction in time is being performed. - character(len=*), intent(out), optional :: err_msg !< A log indicating the status of the post upon - !! returning to the calling routine. - - send_data_fms_wrapper_3d_r8 = send_data_fms(diag_field_id, field, time, is_in, js_in, ks_in, mask, rmask, & +logical function send_data_infra_3d_r8(diag_field_id, field, is_in, ie_in, js_in, je_in, ks_in, ke_in, & + time, mask, rmask, weight, err_msg) + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + real(kind=8), dimension(:,:,:), intent(in) :: field !< A rank 1 array of floating point values being recorded + integer, optional, intent(in) :: is_in !< The starting i-index for the data being recorded + integer, optional, intent(in) :: ie_in !< The end i-index for the data being recorded + integer, optional, intent(in) :: js_in !< The starting j-index for the data being recorded + integer, optional, intent(in) :: je_in !< The end j-index for the data being recorded + integer, optional, intent(in) :: ks_in !< The starting k-index for the data being recorded + integer, optional, intent(in) :: ke_in !< The end k-index for the data being recorded + type(time_type), optional, intent(in) :: time !< The time for the current record + logical, dimension(:,:,:), optional, intent(in) :: mask !< An optional 3-d logical mask + real, dimension(:,:,:), optional, intent(in) :: rmask !< An optional 3-d mask array + real, optional, intent(in) :: weight !< A scalar weight factor to apply to the current + !! record if there is averaging in time + character(len=*), optional, intent(out) :: err_msg !< A log indicating the status of the post upon + !! returning to the calling routine + + send_data_infra_3d_r8 = send_data_fms(diag_field_id, field, time, is_in, js_in, ks_in, mask, rmask, & ie_in, je_in, ke_in, weight, err_msg) -end function send_data_fms_wrapper_3d_r8 +end function send_data_infra_3d_r8 #endif !> Add a real scalar attribute to a diagnostic field subroutine MOM_diag_field_add_attribute_scalar_r(diag_field_id, att_name, att_value) - integer, intent(in) :: diag_field_id !< A unique numeric field id - character(len=*), intent(in) :: att_name !< The name of the attribute - real, intent(in) :: att_value !< A real scalar value + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + character(len=*), intent(in) :: att_name !< The name of the attribute + real, intent(in) :: att_value !< A real scalar value call FMS_diag_field_add_attribute(diag_field_id, att_name, att_value) @@ -394,9 +382,9 @@ end subroutine MOM_diag_field_add_attribute_scalar_r !> Add an integer attribute to a diagnostic field subroutine MOM_diag_field_add_attribute_scalar_i(diag_field_id, att_name, att_value) - integer, intent(in) :: diag_field_id !< A unique numeric field id - character(len=*), intent(in) :: att_name !< The name of the attribute - integer, intent(in) :: att_value !< A real scalar value + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + character(len=*), intent(in) :: att_name !< The name of the attribute + integer, intent(in) :: att_value !< An integer scalar value call FMS_diag_field_add_attribute(diag_field_id, att_name, att_value) @@ -404,9 +392,9 @@ end subroutine MOM_diag_field_add_attribute_scalar_i !> Add a character string attribute to a diagnostic field subroutine MOM_diag_field_add_attribute_scalar_c(diag_field_id, att_name, att_value) - integer, intent(in) :: diag_field_id !< A unique numeric field id - character(len=*), intent(in) :: att_name !< The name of the attribute - character(len=*), intent(in) :: att_value !< A real scalar value + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + character(len=*), intent(in) :: att_name !< The name of the attribute + character(len=*), intent(in) :: att_value !< A character string value call FMS_diag_field_add_attribute(diag_field_id, att_name, att_value) @@ -414,9 +402,9 @@ end subroutine MOM_diag_field_add_attribute_scalar_c !> Add a real list of attributes attribute to a diagnostic field subroutine MOM_diag_field_add_attribute_r1d(diag_field_id, att_name, att_value) - integer, intent(in) :: diag_field_id !< A unique numeric field id - character(len=*), intent(in) :: att_name !< The name of the attribute - real, dimension(:), intent(in) :: att_value !< A real scalar value + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + character(len=*), intent(in) :: att_name !< The name of the attribute + real, dimension(:), intent(in) :: att_value !< An array of real values call FMS_diag_field_add_attribute(diag_field_id, att_name, att_value) @@ -424,14 +412,12 @@ end subroutine MOM_diag_field_add_attribute_r1d !> Add a integer list of attributes attribute to a diagnostic field subroutine MOM_diag_field_add_attribute_i1d(diag_field_id, att_name, att_value) - integer, intent(in) :: diag_field_id !< A unique numeric field id - character(len=*), intent(in) :: att_name !< The name of the attribute - integer, dimension(:), intent(in) :: att_value !< A integer list of values + integer, intent(in) :: diag_field_id !< The diagnostic manager identifier for this field + character(len=*), intent(in) :: att_name !< The name of the attribute + integer, dimension(:), intent(in) :: att_value !< An array of integer values call FMS_diag_field_add_attribute(diag_field_id, att_name, att_value) end subroutine MOM_diag_field_add_attribute_i1d - - end module MOM_diag_manager_infra diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 90496f05a7..b4cce081a0 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -9,11 +9,11 @@ module MOM_diag_mediator use MOM_coms, only : PE_here use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diag_manager_infra, only : MOM_diag_manager_init, MOM_diag_manager_end -use MOM_diag_manager_infra, only : diag_axis_init=>MOM_diag_axis_init, get_MOM_diag_axis_name -use MOM_diag_manager_infra, only : send_data_fms_wrapper, MOM_diag_field_add_attribute, EAST, NORTH -use MOM_diag_manager_infra, only : register_diag_field_fms_wrapper, register_static_field_fms_wrapper -use MOM_diag_manager_infra, only : get_MOM_diag_field_id, DIAG_FIELD_NOT_FOUND +use MOM_diag_manager_infra, only : MOM_diag_manager_init, MOM_diag_manager_end +use MOM_diag_manager_infra, only : diag_axis_init=>MOM_diag_axis_init, get_MOM_diag_axis_name +use MOM_diag_manager_infra, only : send_data_infra, MOM_diag_field_add_attribute, EAST, NORTH +use MOM_diag_manager_infra, only : register_diag_field_infra, register_static_field_infra +use MOM_diag_manager_infra, only : get_MOM_diag_field_id, DIAG_FIELD_NOT_FOUND use MOM_diag_remap, only : diag_remap_ctrl, diag_remap_update, diag_remap_calc_hmask use MOM_diag_remap, only : diag_remap_init, diag_remap_end, diag_remap_do_remap use MOM_diag_remap, only : vertically_reintegrate_diag_field, vertically_interpolate_diag_field @@ -1271,9 +1271,9 @@ subroutine post_data_0d(diag_field_id, field, diag_cs, is_static) if (diag_cs%diag_as_chksum) then call chksum0(locfield, diag%debug_str, logunit=diag_cs%chksum_iounit) elseif (is_stat) then - used = send_data_fms_wrapper(diag%fms_diag_id, locfield) + used = send_data_infra(diag%fms_diag_id, locfield) elseif (diag_cs%ave_enabled) then - used = send_data_fms_wrapper(diag%fms_diag_id, locfield, diag_cs%time_end) + used = send_data_infra(diag%fms_diag_id, locfield, diag_cs%time_end) endif diag => diag%next enddo @@ -1323,9 +1323,9 @@ subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) if (diag_cs%diag_as_chksum) then call zchksum(locfield, diag%debug_str, logunit=diag_cs%chksum_iounit) elseif (is_stat) then - used = send_data_fms_wrapper(diag%fms_diag_id, locfield) + used = send_data_infra(diag%fms_diag_id, locfield) elseif (diag_cs%ave_enabled) then - used = send_data_fms_wrapper(diag%fms_diag_id, locfield, diag_cs%time_end, weight=diag_cs%time_int) + used = send_data_infra(diag%fms_diag_id, locfield, time=diag_cs%time_end, weight=diag_cs%time_int) endif if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) deallocate( locfield ) @@ -1479,26 +1479,26 @@ subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) if (present(mask)) then call assert(size(locfield) == size(locmask), & 'post_data_2d_low is_stat: mask size mismatch: '//diag%debug_str) - used = send_data_fms_wrapper(diag%fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=locmask) + used = send_data_infra(diag%fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, rmask=locmask) !elseif (associated(diag%axes%mask2d)) then ! used = send_data(diag%fms_diag_id, locfield, & - ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%axes%mask2d) + ! is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, rmask=diag%axes%mask2d) else - used = send_data_fms_wrapper(diag%fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) + used = send_data_infra(diag%fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev) endif elseif (diag_cs%ave_enabled) then if (associated(locmask)) then call assert(size(locfield) == size(locmask), & 'post_data_2d_low: mask size mismatch: '//diag%debug_str) - used = send_data_fms_wrapper(diag%fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, rmask=locmask) + used = send_data_infra(diag%fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & + time=diag_cs%time_end, weight=diag_cs%time_int, rmask=locmask) else - used = send_data_fms_wrapper(diag%fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int) + used = send_data_infra(diag%fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & + time=diag_cs%time_end, weight=diag_cs%time_int) endif endif endif @@ -1767,26 +1767,26 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) if (present(mask)) then call assert(size(locfield) == size(locmask), & 'post_data_3d_low is_stat: mask size mismatch: '//diag%debug_str) - used = send_data_fms_wrapper(diag%fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=locmask) + used = send_data_infra(diag%fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, rmask=locmask) !elseif (associated(diag%axes%mask2d)) then ! used = send_data(diag%fms_diag_id, locfield, & - ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%axes%mask2d) + ! is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, rmask=diag%axes%mask2d) else - used = send_data_fms_wrapper(diag%fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) + used = send_data_infra(diag%fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev) endif elseif (diag_cs%ave_enabled) then if (associated(locmask)) then call assert(size(locfield) == size(locmask), & 'post_data_3d_low: mask size mismatch: '//diag%debug_str) - used = send_data_fms_wrapper(diag%fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, rmask=locmask) + used = send_data_infra(diag%fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & + time=diag_cs%time_end, weight=diag_cs%time_int, rmask=locmask) else - used = send_data_fms_wrapper(diag%fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int) + used = send_data_infra(diag%fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & + time=diag_cs%time_end, weight=diag_cs%time_int) endif endif endif @@ -1842,16 +1842,15 @@ subroutine post_xy_average(diag_cs, diag, field) diag_cs%diag_remap_cs(coord)%h, & staggered_in_x, staggered_in_y, & diag%axes%is_layer, diag%v_extensive, & - field, & - averaged_field, averaged_mask) + field, averaged_field, averaged_mask) endif if (diag_cs%diag_as_chksum) then call zchksum(averaged_field, trim(diag%debug_str)//'_xyave', & logunit=diag_CS%chksum_iounit) else - used = send_data_fms_wrapper(diag%fms_xyave_diag_id, averaged_field, diag_cs%time_end, & - weight=diag_cs%time_int, mask=averaged_mask) + used = send_data_infra(diag%fms_xyave_diag_id, averaged_field, & + time=diag_cs%time_end, weight=diag_cs%time_int, mask=averaged_mask) endif end subroutine post_xy_average @@ -2391,13 +2390,13 @@ integer function register_diag_field_expand_axes(module_name, field_name, axes, ! If interp_method is provided we must use it if (area_id>0) then if (volume_id>0) then - fms_id = register_diag_field_fms_wrapper(module_name, field_name, axes%handles, & + fms_id = register_diag_field_infra(module_name, field_name, axes%handles, & init_time, long_name=long_name, units=units, missing_value=missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & interp_method=interp_method, tile_count=tile_count, area=area_id, volume=volume_id) else - fms_id = register_diag_field_fms_wrapper(module_name, field_name, axes%handles, & + fms_id = register_diag_field_infra(module_name, field_name, axes%handles, & init_time, long_name=long_name, units=units, missing_value=missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & @@ -2405,13 +2404,13 @@ integer function register_diag_field_expand_axes(module_name, field_name, axes, endif else if (volume_id>0) then - fms_id = register_diag_field_fms_wrapper(module_name, field_name, axes%handles, & + fms_id = register_diag_field_infra(module_name, field_name, axes%handles, & init_time, long_name=long_name, units=units, missing_value=missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & interp_method=interp_method, tile_count=tile_count, volume=volume_id) else - fms_id = register_diag_field_fms_wrapper(module_name, field_name, axes%handles, & + fms_id = register_diag_field_infra(module_name, field_name, axes%handles, & init_time, long_name=long_name, units=units, missing_value=missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & @@ -2422,13 +2421,13 @@ integer function register_diag_field_expand_axes(module_name, field_name, axes, ! If interp_method is not provided and the field is not at an h-point then interp_method='none' if (area_id>0) then if (volume_id>0) then - fms_id = register_diag_field_fms_wrapper(module_name, field_name, axes%handles, & + fms_id = register_diag_field_infra(module_name, field_name, axes%handles, & init_time, long_name=long_name, units=units, missing_value=missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & interp_method='none', tile_count=tile_count, area=area_id, volume=volume_id) else - fms_id = register_diag_field_fms_wrapper(module_name, field_name, axes%handles, & + fms_id = register_diag_field_infra(module_name, field_name, axes%handles, & init_time, long_name=long_name, units=units, missing_value=missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & @@ -2436,13 +2435,13 @@ integer function register_diag_field_expand_axes(module_name, field_name, axes, endif else if (volume_id>0) then - fms_id = register_diag_field_fms_Wrapper(module_name, field_name, axes%handles, & + fms_id = register_diag_field_infra(module_name, field_name, axes%handles, & init_time, long_name=long_name, units=units, missing_value=missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & interp_method='none', tile_count=tile_count, volume=volume_id) else - fms_id = register_diag_field_fms_wrapper(module_name, field_name, axes%handles, & + fms_id = register_diag_field_infra(module_name, field_name, axes%handles, & init_time, long_name=long_name, units=units, missing_value=missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & @@ -2703,10 +2702,10 @@ function register_scalar_field(module_name, field_name, init_time, diag_cs, & fms_id = diag_cs%num_chksum_diags + 1 diag_cs%num_chksum_diags = fms_id else - fms_id = register_diag_field_fms_wrapper(module_name, field_name, init_time, & - long_name=long_name, units=units, missing_value=MOM_missing_value, & - range=range, standard_name=standard_name, do_not_log=do_not_log, & - err_msg=err_msg) + fms_id = register_diag_field_infra(module_name, field_name, init_time, & + long_name=long_name, units=units, missing_value=MOM_missing_value, & + range=range, standard_name=standard_name, do_not_log=do_not_log, & + err_msg=err_msg) endif if (fms_id /= DIAG_FIELD_NOT_FOUND) then @@ -2734,10 +2733,10 @@ function register_scalar_field(module_name, field_name, init_time, diag_cs, & if (present(cmor_standard_name)) posted_cmor_standard_name = cmor_standard_name if (present(cmor_long_name)) posted_cmor_long_name = cmor_long_name - fms_id = register_diag_field_fms_wrapper(module_name, cmor_field_name, init_time, & - long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=MOM_missing_value, range=range, & - standard_name=trim(posted_cmor_standard_name), do_not_log=do_not_log, err_msg=err_msg) + fms_id = register_diag_field_infra(module_name, cmor_field_name, init_time, & + long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & + missing_value=MOM_missing_value, range=range, & + standard_name=trim(posted_cmor_standard_name), do_not_log=do_not_log, err_msg=err_msg) if (fms_id /= DIAG_FIELD_NOT_FOUND) then if (dm_id == -1) then dm_id = get_new_diag_id(diag_cs) @@ -2817,7 +2816,7 @@ function register_static_field(module_name, field_name, axes, & fms_id = diag_cs%num_chksum_diags + 1 diag_cs%num_chksum_diags = fms_id else - fms_id = register_static_field_fms_wrapper(module_name, field_name, axes%handles, & + fms_id = register_static_field_infra(module_name, field_name, axes%handles, & long_name=long_name, units=units, missing_value=MOM_missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & do_not_log=do_not_log, & @@ -2869,11 +2868,11 @@ function register_static_field(module_name, field_name, axes, & if (present(cmor_standard_name)) posted_cmor_standard_name = cmor_standard_name if (present(cmor_long_name)) posted_cmor_long_name = cmor_long_name - fms_id = register_static_field_fms_wrapper(module_name, cmor_field_name, & - axes%handles, long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & - standard_name=trim(posted_cmor_standard_name), do_not_log=do_not_log, & - interp_method=interp_method, tile_count=tile_count, area=area) + fms_id = register_static_field_infra(module_name, cmor_field_name, axes%handles, & + long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & + missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & + standard_name=trim(posted_cmor_standard_name), do_not_log=do_not_log, & + interp_method=interp_method, tile_count=tile_count, area=area) if (fms_id /= DIAG_FIELD_NOT_FOUND) then if (dm_id == -1) then dm_id = get_new_diag_id(diag_cs) @@ -4303,31 +4302,18 @@ end subroutine downsample_mask_3d !> Fakes a register of a diagnostic to find out if an obsolete !! parameter appears in the diag_table. -logical function found_in_diagtable(diag, varName, newVarName) +logical function found_in_diagtable(diag, varName) type(diag_ctrl), intent(in) :: diag !< A structure used to control diagnostics. character(len=*), intent(in) :: varName !< The obsolete diagnostic name - character(len=*), optional, intent(in) :: newVarName !< The valid name of this diagnostic ! Local integer :: handle ! Integer handle returned from diag_manager ! We use register_static_field_fms() instead of register_static_field() so ! that the diagnostic does not appear in the available diagnostics list. - handle = register_static_field_fms_wrapper('ocean_model', varName, & - diag%axesT1%handles, 'Obsolete parameter', 'N/A') + handle = register_static_field_infra('ocean_model', varName, diag%axesT1%handles) found_in_diagtable = (handle>0) - if (handle>0 .and. is_root_pe()) then - if (present(newVarName)) then - call MOM_error(WARNING, 'MOM_obsolete_params: '// & - 'diag_table entry "'//trim(varName)//'" found. Use '// & - '"'//trim(newVarName)//'" instead.' ) - else - call MOM_error(WARNING, 'MOM_obsolete_params: '// & - 'diag_table entry "'//trim(varName)//'" is obsolete.' ) - endif - endif - end function found_in_diagtable end module MOM_diag_mediator diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index dbf4037a35..2a3066dfbd 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -4,10 +4,10 @@ module MOM_IS_diag_mediator ! This file is a part of SIS2. See LICENSE.md for the license. use MOM_coms, only : PE_here -use MOM_diag_manager_infra, only : MOM_diag_manager_init, send_data_fms_wrapper, MOM_diag_axis_init +use MOM_diag_manager_infra, only : MOM_diag_manager_init, send_data_infra, MOM_diag_axis_init use MOM_diag_manager_infra, only : EAST, NORTH -use MOM_diag_manager_infra, only : register_static_field_fms_wrapper -use MOM_diag_manager_infra, only : register_diag_field_fms_wrapper +use MOM_diag_manager_infra, only : register_static_field_infra +use MOM_diag_manager_infra, only : register_diag_field_infra use MOM_error_handler, only : MOM_error, FATAL, is_root_pe, assert use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -25,7 +25,7 @@ module MOM_IS_diag_mediator public enable_averages public MOM_IS_diag_mediator_init, MOM_IS_diag_mediator_end, set_IS_diag_mediator_grid public MOM_IS_diag_mediator_close_registration, get_diag_time_end -public MOM_diag_axis_init, register_static_field_fms_wrapper +public MOM_diag_axis_init, register_static_field_infra !> 2D/3D axes type to contain 1D axes handles and pointers to masks type, public :: axesType @@ -289,48 +289,48 @@ subroutine post_IS_data(diag_field_id, field, diag_cs, is_static, mask) if (is_stat) then if (present(mask)) then - used = send_data_fms_wrapper(fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, mask=mask) + used = send_data_infra(fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, mask=mask) elseif(i_data .and. associated(diag%mask2d)) then ! used = send_data(fms_diag_id, locfield, & -! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%mask2d) - used = send_data_fms_wrapper(fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) +! is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, rmask=diag%mask2d) + used = send_data_infra(fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev) elseif((.not.i_data) .and. associated(diag%mask2d_comp)) then ! used = send_data(fms_diag_id, locfield, & -! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%mask2d_comp) - used = send_data_fms_wrapper(fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) +! is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, rmask=diag%mask2d_comp) + used = send_data_infra(fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev) else - used = send_data_fms_wrapper(fms_diag_id, locfield, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) + used = send_data_infra(fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev) endif elseif (diag_cs%ave_enabled) then if (present(mask)) then - used = send_data_fms_wrapper(fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int, mask=mask) -! used = send_data(fms_diag_id, locfield, diag_cs%time_end, & -! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & -! weight=diag_cs%time_int) + used = send_data_infra(fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & + time=diag_cs%time_end, weight=diag_cs%time_int, mask=mask) +! used = send_data(fms_diag_id, locfield, & +! is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & +! time=diag_cs%time_end, weight=diag_cs%time_int) elseif(i_data .and. associated(diag%mask2d)) then -! used = send_data(fms_diag_id, locfield, diag_cs%time_end, & -! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & -! weight=diag_cs%time_int, rmask=diag%mask2d) - used = send_data_fms_wrapper(fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int) +! used = send_data(fms_diag_id, locfield, & +! is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & +! time=diag_cs%time_end, weight=diag_cs%time_int, rmask=diag%mask2d) + used = send_data_infra(fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & + time=diag_cs%time_end, weight=diag_cs%time_int) elseif((.not.i_data) .and. associated(diag%mask2d_comp)) then -! used = send_data(fms_diag_id, locfield, diag_cs%time_end, & -! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & -! weight=diag_cs%time_int, rmask=diag%mask2d_comp) - used = send_data_fms_wrapper(fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int) +! used = send_data(fms_diag_id, locfield, & +! is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & +! time=diag_cs%time_end, weight=diag_cs%time_int, rmask=diag%mask2d_comp) + used = send_data_infra(fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & + time=diag_cs%time_end, weight=diag_cs%time_int) else - used = send_data_fms_wrapper(fms_diag_id, locfield, diag_cs%time_end, & - is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag_cs%time_int) + used = send_data_infra(fms_diag_id, locfield, & + is_in=isv, ie_in=iev, js_in=jsv, je_in=jev, & + time=diag_cs%time_end, weight=diag_cs%time_int) endif endif @@ -453,7 +453,7 @@ function register_MOM_IS_diag_field(module_name, field_name, axes, init_time, & diag_cs => axes%diag_cs primary_id = -1 - fms_id = register_diag_field_fms_wrapper(module_name, field_name, axes%handles, & + fms_id = register_diag_field_infra(module_name, field_name, axes%handles, & init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & @@ -542,7 +542,7 @@ integer function register_MOM_IS_static_field(module_name, field_name, axes, & diag_cs => axes%diag_cs primary_id = -1 - fms_id = register_static_field_fms_wrapper(module_name, field_name, axes%handles, & + fms_id = register_static_field_infra(module_name, field_name, axes%handles, & long_name=long_name, units=units, missing_value=MOM_missing_value, & range=range, mask_variant=mask_variant, standard_name=standard_name, & do_not_log=do_not_log, &