From 401f41f0c91225ebded3cf2a207768511558e42c Mon Sep 17 00:00:00 2001 From: uramirez8707 <49168881+uramirez8707@users.noreply.github.com> Date: Wed, 15 Jun 2022 14:19:48 -0400 Subject: [PATCH] feat: finish register diag field routines (#984) --- diag_manager/diag_data.F90 | 1 + diag_manager/diag_manager.F90 | 32 ++- diag_manager/fms_diag_axis_object.F90 | 19 +- diag_manager/fms_diag_file_object.F90 | 100 +++++++- diag_manager/fms_diag_object.F90 | 269 ++++++++++---------- diag_manager/fms_diag_yaml.F90 | 29 ++- test_fms/diag_manager/Makefile.am | 1 - test_fms/diag_manager/test_diag_manager2.sh | 3 - test_fms/diag_manager/test_diag_yaml.F90 | 10 +- 9 files changed, 280 insertions(+), 184 deletions(-) diff --git a/diag_manager/diag_data.F90 b/diag_manager/diag_data.F90 index 1527801221..f6167fb79a 100644 --- a/diag_manager/diag_data.F90 +++ b/diag_manager/diag_data.F90 @@ -101,6 +101,7 @@ MODULE diag_data_mod INTEGER, PARAMETER :: NO_DOMAIN = 1 !< Use the FmsNetcdfFile_t fileobj INTEGER, PARAMETER :: TWO_D_DOMAIN = 2 !< Use the FmsNetcdfDomainFile_t fileobj INTEGER, PARAMETER :: UG_DOMAIN = 3 !< Use the FmsNetcdfUnstructuredDomainFile_t fileobj + INTEGER, PARAMETER :: SUB_REGIONAL = 4 !< This is a file with a sub_region use the FmsNetcdfFile_t fileobj INTEGER, PARAMETER :: DIRECTION_UP = 1 !< The axis points up if positive INTEGER, PARAMETER :: DIRECTION_DOWN = -1 !< The axis points down if positive INTEGER, PARAMETER :: GLO_REG_VAL = -999 !< Value used in the region specification of the diag_table diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index 5bc455ee56..14c088847c 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -473,21 +473,25 @@ INTEGER FUNCTION register_diag_field_scalar_modern(module_name, field_name, init CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the modeling_realm attribute #ifdef use_yaml - integer, allocatable :: diag_file_indices(:) !< indices where the field was found + integer, allocatable :: diag_field_indices(:) !< indices where the field was found - diag_file_indices = find_diag_field(field_name) - if (diag_file_indices(1) .eq. diag_null) then + diag_field_indices = find_diag_field(field_name) + if (diag_field_indices(1) .eq. diag_null) then !< The field was not found in the table, so return diag_null register_diag_field_scalar_modern = diag_null - deallocate(diag_file_indices) + deallocate(diag_field_indices) return endif registered_variables = registered_variables + 1 register_diag_field_scalar_modern = registered_variables - !< TO DO: Fill in the diag_obj - deallocate(diag_file_indices) + call diag_objs(registered_variables)%setID(registered_variables) + call diag_objs(registered_variables)%register(module_name, field_name, init_time, diag_field_indices, & + & longname=long_name, units=units, missing_value=missing_value, varrange=var_range, & + & standname=standard_name, do_not_log=do_not_log, err_msg=err_msg, & + & area=area, volume=volume, realm=realm) + deallocate(diag_field_indices) #endif end function register_diag_field_scalar_modern @@ -520,21 +524,25 @@ INTEGER FUNCTION register_diag_field_array_modern(module_name, field_name, axes, CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the modeling_realm attribute #ifdef use_yaml - integer, allocatable :: diag_file_indices(:) !< indices where the field was found + integer, allocatable :: diag_field_indices(:) !< indices of diag_field yaml where the field was found - diag_file_indices = find_diag_field(field_name) - if (diag_file_indices(1) .eq. diag_null) then + diag_field_indices = find_diag_field(field_name) + if (diag_field_indices(1) .eq. diag_null) then !< The field was not found in the table, so return diag_null register_diag_field_array_modern = diag_null - deallocate(diag_file_indices) + deallocate(diag_field_indices) return endif registered_variables = registered_variables + 1 register_diag_field_array_modern = registered_variables - !< TO DO: Fill in the diag_obj - deallocate(diag_file_indices) + call diag_objs(registered_variables)%setID(registered_variables) + call diag_objs(registered_variables)%register(module_name, field_name, init_time, diag_field_indices, axes, & + & longname=long_name, units=units, missing_value=missing_value, varrange=var_range, & + & mask_variant=mask_variant, standname=standard_name, do_not_log=do_not_log, err_msg=err_msg, & + & interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm) + deallocate(diag_field_indices) #endif end function register_diag_field_array_modern diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index adfc009466..6c27786e85 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -41,7 +41,7 @@ module fms_diag_axis_object_mod PRIVATE public :: diagAxis_t, set_subaxis, fms_diag_axis_init, fms_diag_axis_object_init, fms_diag_axis_object_end, & - & get_domain_and_domain_type, axis_obj + & get_domain_and_domain_type, axis_obj, diagDomain_t, sub_axis_objs !> @} !> @brief Type to hold the domain info for an axis @@ -76,6 +76,7 @@ module fms_diag_axis_object_mod INTEGER :: starting_index !< Starting index of the subaxis relative to the parent axis INTEGER :: ending_index !< Ending index of the subaxis relative to the parent axis class(*) , ALLOCATABLE :: bounds !< Bounds of the subaxis (lat/lon or indices) + INTEGER :: parent_axis_id !< Id of the parent_axis contains procedure :: exists => check_if_subaxis_exists END TYPE subaxis_t @@ -121,6 +122,8 @@ module fms_diag_axis_object_mod integer :: number_of_axis !< Number of axis that has been registered type(diagAxis_t), ALLOCATABLE, TARGET :: axis_obj(:) !< Diag_axis objects logical :: module_is_initialized !< Flag indicating if the module is initialized + integer :: nsubaxis_objs !< Number of sub_axis that has been registered + type(subaxis_t), ALLOCATABLE, Target :: sub_axis_objs(:) !< Registered sub_axis objects !> @addtogroup fms_diag_yaml_mod !> @{ @@ -319,10 +322,14 @@ function get_axis_length(obj) & end function !> @brief Set the subaxis of the axis obj - subroutine set_subaxis(obj, bounds) - class(diagAxis_t), INTENT(INOUT) :: obj !< diag_axis obj + !> @return A sub_axis id corresponding to the indices of the sub_axes in the sub_axes_objs array + function set_subaxis(obj, bounds) & + result(sub_axes_id) + class(diagAxis_t), INTENT(INOUT) :: obj !< diag_axis obj class(*), INTENT(INOUT) :: bounds(:) !< bound of the subaxis + integer :: sub_axes_id + integer :: i !< For do loops !< Check if the subaxis for this bouds already exists @@ -332,7 +339,11 @@ subroutine set_subaxis(obj, bounds) !< TO DO: everything obj%nsubaxis = obj%nsubaxis + 1 - end subroutine + + nsubaxis_objs = nsubaxis_objs + 1 + sub_axes_id = nsubaxis_objs + !< TO DO: set the parent_axis_id + end function !!!!!!!!!!!!!!!!!! SUB AXIS PROCEDURES !!!!!!!!!!!!!!!!! !> @brief Check if a subaxis was already defined diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index 45d6b45c45..d16f3055fc 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -26,11 +26,12 @@ module fms_diag_file_object_mod !use mpp_mod, only: mpp_error, FATAL use fms2_io_mod, only: FmsNetcdfFile_t, FmsNetcdfUnstructuredDomainFile_t, FmsNetcdfDomainFile_t -use diag_data_mod, only: DIAG_NULL +use diag_data_mod, only: DIAG_NULL, NO_DOMAIN, max_axes, SUB_REGIONAL #ifdef use_yaml use fms_diag_yaml_mod, only: diag_yaml, diagYamlObject_type, diagYamlFiles_type #endif - +use fms_diag_axis_object_mod, only: diagDomain_t +use mpp_mod, only: mpp_error, FATAL implicit none private @@ -44,10 +45,13 @@ module fms_diag_file_object_mod private integer :: id !< The number associated with this file in the larger array of files class(FmsNetcdfFile_t), allocatable :: fileobj !< fms2_io file object for this history file - character(len=1) :: file_domain_type !< (I don't think we will need this) #ifdef use_yaml type(diagYamlFiles_type), pointer :: diag_yaml_file => null() !< Pointer to the diag_yaml_file data #endif + integer :: type_of_domain !< The type of domain to use to open the file + !! NO_DOMAIN, TWO_D_DOMAIN, UG_DOMAIN, SUB_REGIONAL + class(diagDomain_t), pointer :: domain !< The domain to use, + !! null if NO_DOMAIN or SUB_REGIONAL character(len=:) , dimension(:), allocatable :: file_metadata_from_model !< File metadata that comes from !! the model. integer, dimension(:), allocatable :: var_ids !< Variable IDs corresponding to file_varlist @@ -57,18 +61,21 @@ module fms_diag_file_object_mod logical, dimension(:), private, allocatable :: var_reg !< Array corresponding to `file_varlist`, .true. !! if the variable has been registered and !! `file_var_index` has been set for the variable + integer, dimension(:), allocatable :: axis_ids !< Array of axis ids in the file + integer, dimension(:), allocatable :: sub_axis_ids !< Array of axis ids in the file + integer :: number_of_axis !< Number of axis in the file contains - procedure, public :: has_file_metadata_from_model procedure, public :: has_fileobj #ifdef use_yaml procedure, public :: has_diag_yaml_file + procedure, public :: set_file_domain + procedure, public :: add_axes #endif procedure, public :: has_var_ids procedure, public :: get_id ! TODO procedure, public :: get_fileobj ! TODO - procedure, public :: get_file_domain_type ! TODO procedure, public :: get_diag_yaml_file ! TODO procedure, public :: get_file_metadata_from_model procedure, public :: get_var_ids @@ -128,6 +135,23 @@ logical function fms_diag_files_object_init () FMS_diag_files(i)%var_ids = DIAG_NULL FMS_diag_files(i)%var_reg = .FALSE. FMS_diag_files(i)%var_index = DIAG_NULL + + !> These will be set in a set_file_domain + FMS_diag_files(i)%type_of_domain = NO_DOMAIN + FMS_diag_files(i)%domain => null() + + !> This will be set in a add_axes + allocate(FMS_diag_files(i)%axis_ids(max_axes)) + + !> If the file has a sub_regional, define it as one and allocate the sub_axis_ids array. + !! This will be set in a add_axes + if (FMS_diag_files(i)%has_file_sub_region()) then + FMS_diag_files(i)%type_of_domain = SUB_REGIONAL + allocate(FMS_diag_files(i)%sub_axis_ids(max_axes)) + FMS_diag_files(i)%sub_axis_ids = diag_null + endif + + FMS_diag_files(i)%number_of_axis = 0 enddo set_ids_loop fms_diag_files_object_init = .true. else @@ -181,13 +205,6 @@ end function get_id ! class(FmsNetcdfFile_t) :: res ! res = obj%fileobj !end function get_fileobj -!> \brief Returns a copy of the value of file_domain_type -!! \return A copy of file_domain_type -pure function get_file_domain_type (obj) result (res) - class(fmsDiagFile_type), intent(in) :: obj !< The file object - character(1) :: res - res = obj%file_domain_type -end function get_file_domain_type !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! TODO !!> \brief Returns a copy of the value of diag_yaml_file @@ -399,5 +416,64 @@ pure function has_file_global_meta (obj) result(res) logical :: res res = obj%diag_yaml_file%has_file_global_meta() end function has_file_global_meta + +!> @brief Set the domain and the type_of_domain for a file +!> @details This subroutine is going to be called once by every variable in the file +!! in register_diag_field. It will update the domain and the type_of_domain if needed and verify that +!! all the variables are in the same domain +subroutine set_file_domain(obj, domain, type_of_domain) + class(fmsDiagFile_type), intent(inout) :: obj !< The file object + integer, INTENT(in) :: type_of_domain !< fileobj_type to use + CLASS(diagDomain_t), INTENT(in), target :: domain !< Domain + + !! If this a sub_regional, don't do anything here + if (obj%type_of_domain .eq. SUB_REGIONAL) return + + if (type_of_domain .ne. obj%type_of_domain) then + !! If the current type_of_domain in the file obj is not the same as the variable calling this subroutine + + if (type_of_domain .eq. NO_DOMAIN .or. obj%type_of_domain .eq. NO_DOMAIN) then + !! If they are not the same then one of them can be NO_DOMAIN + !! (i.e a file can have variables that are not domain decomposed and variables that are) + + if (type_of_domain .ne. NO_DOMAIN) then + !! Update the file's type_of_domain and domain if needed + obj%type_of_domain = type_of_domain + obj%domain => domain + endif + + else + !! If they are not the same and of them is not NO_DOMAIN, then crash because the variables don't have the + !! same domain (i.e a file has a variable is that in a 2D domain and one that is in a UG domain) + + call mpp_error(FATAL, "The file: "//obj%get_file_fname()//" has variables that are not in the same domain") + endif + endif + +end subroutine set_file_domain + +!> @brief Loops through a variable's axis_ids and adds them to the FMSDiagFile object if they don't exist +subroutine add_axes(obj, axis_ids) + class(fmsDiagFile_type), intent(inout) :: obj !< The file object + integer, INTENT(in) :: axis_ids(:) !< Array of axes_ids + + integer :: i, j !< For do loops + + do i = 1, size(axis_ids) + do j = 1, obj%number_of_axis + !> Check if the axis already exists, if it does leave this do loop + if (axis_ids(i) .eq. obj%axis_ids(j)) exit + enddo + + !> If the axis does not exist add it to the list + obj%number_of_axis = obj%number_of_axis + 1 + obj%axis_ids(obj%number_of_axis) = axis_ids(i) + + !> If this is a sub_regional file, set up the sub_axes + !> TO DO: + !! + enddo + +end subroutine add_axes #endif end module fms_diag_file_object_mod diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index df9fc037c9..58287bf767 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -8,15 +8,16 @@ module fms_diag_object_mod !! that contains all of the information of the variable. It is extended by a type that holds the !! appropriate buffer for the data for manipulation. use diag_data_mod, only: diag_null, CMOR_MISSING_VALUE, diag_null_string -use diag_data_mod, only: r8, r4, i8, i4, string, null_type_int +use diag_data_mod, only: r8, r4, i8, i4, string, null_type_int, NO_DOMAIN use diag_data_mod, only: diag_null, diag_not_found, diag_not_registered, diag_registered_id use diag_axis_mod, only: diag_axis_type use mpp_mod, only: fatal, note, warning, mpp_error #ifdef use_yaml -use fms_diag_yaml_mod, only: diagYamlFilesVar_type -use fms_diag_file_object_mod, only: fmsDiagFile_type +use fms_diag_yaml_mod, only: diagYamlFilesVar_type, get_diag_fields_entries, get_diag_files_id +use fms_diag_file_object_mod, only: fmsDiagFile_type, FMS_diag_files #endif +use fms_diag_axis_object_mod, only: diagDomain_t, get_domain_and_domain_type use time_manager_mod, ONLY: time_type !!!set_time, set_date, get_time, time_type, OPERATOR(>=), OPERATOR(>),& !!! & OPERATOR(<), OPERATOR(==), OPERATOR(/=), OPERATOR(/), OPERATOR(+), ASSIGNMENT(=), get_date, & @@ -59,14 +60,15 @@ module fms_diag_object_mod type fmsDiagObject_type #ifdef use_yaml type (diagYamlFilesVar_type), allocatable, dimension(:) :: diag_field !< info from diag_table for this variable - type (fmsDiagFile_type), pointer, dimension(:) :: diag_files !< Array pointing to files that contain - !! the objects variable + integer, allocatable, dimension(:) :: file_ids !< Ids of the FMS_diag_files the variable + !! belongs to #endif integer, allocatable, private :: diag_id !< unique id for varable character(len=:), allocatable, dimension(:) :: metadata !< metadata for the variable logical, allocatable, private :: static !< true if this is a static var logical, allocatable, private :: registered !< true when registered logical, allocatable, private :: mask_variant !< If there is a mask variant + logical, allocatable, private :: do_not_log !< .true. if no need to log the diag_field logical, allocatable, private :: local !< If the output is local TYPE(time_type), private :: init_time !< The initial time integer, allocatable, private :: vartype !< the type of varaible @@ -77,7 +79,6 @@ module fms_diag_object_mod character(len=:), allocatable, private :: modname !< the module character(len=:), allocatable, private :: realm !< String to set as the value !! to the modeling_realm attribute - character(len=:), allocatable, private :: err_msg !< An error message character(len=:), allocatable, private :: interp_method !< The interp method to be used !! when regridding the field in post-processing. !! Valid options are "conserve_order1", @@ -86,11 +87,13 @@ module fms_diag_object_mod integer, allocatable, dimension(:), private :: output_units integer, allocatable, private :: t integer, allocatable, private :: tile_count !< The number of tiles - integer, allocatable, dimension(:), private :: axis_ids !< variable axis IDs + integer, pointer, dimension(:), private :: axis_ids !< variable axis IDs + class(diagDomain_t), pointer, private :: domain !< Domain + INTEGER , private :: type_of_domain !< The type of domain ("NO_DOMAIN", + !! "TWO_D_DOMAIN", or "UG_DOMAIN") integer, allocatable, private :: area, volume !< The Area and Volume class(*), allocatable, private :: missing_value !< The missing fill value - class(*), allocatable, private :: data_RANGE !< The range of the variable data - type (diag_axis_type), allocatable, dimension(:) :: axis !< The axis object + class(*), allocatable, private :: data_RANGE(:) !< The range of the variable data class(*), allocatable :: vardata0 !< Scalar data buffer class(*), allocatable, dimension(:) :: vardata1 !< 1D data buffer class(*), allocatable, dimension(:,:) :: vardata2 !< 2D data buffer @@ -116,9 +119,6 @@ module fms_diag_object_mod ! Is variable allocated check functions !TODO procedure :: has_diag_field procedure :: has_diag_id -#ifdef use_yaml - procedure :: has_diag_files -#endif procedure :: has_metadata procedure :: has_static procedure :: has_registered @@ -132,18 +132,15 @@ module fms_diag_object_mod procedure :: has_units procedure :: has_modname procedure :: has_realm - procedure :: has_err_msg procedure :: has_interp_method procedure :: has_frequency procedure :: has_output_units procedure :: has_t procedure :: has_tile_count - procedure :: has_axis_ids procedure :: has_area procedure :: has_volume procedure :: has_missing_value procedure :: has_data_RANGE - procedure :: has_axis ! Get functions procedure :: get_diag_id => fms_diag_get_id procedure :: get_metadata @@ -158,13 +155,11 @@ module fms_diag_object_mod procedure :: get_units procedure :: get_modname procedure :: get_realm - procedure :: get_err_msg procedure :: get_interp_method procedure :: get_frequency procedure :: get_output_units procedure :: get_t procedure :: get_tile_count - procedure :: get_axis_ids procedure :: get_area procedure :: get_volume procedure :: get_missing_value @@ -212,73 +207,75 @@ end subroutine diag_obj_init !> \Description Fills in and allocates (when necessary) the values in the diagnostic object subroutine fms_register_diag_field_obj & !(dobj, modname, varname, axes, time, longname, units, missing_value, metadata) - (dobj, modname, varname, axes, init_time, & + (dobj, modname, varname, init_time, diag_field_indices, axes, & longname, units, missing_value, varRange, mask_variant, standname, & do_not_log, err_msg, interp_method, tile_count, area, volume, realm, metadata) - class(fmsDiagObject_type) , intent(inout) :: dobj - CHARACTER(len=*), INTENT(in) :: modname !< The module name - CHARACTER(len=*), INTENT(in) :: varname !< The variable name - INTEGER, INTENT(in) :: axes(:) !< The axes indicies - TYPE(time_type), INTENT(in) :: init_time !< Initial time - CHARACTER(len=*), OPTIONAL, INTENT(in) :: longname !< THe variables long name - CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< The units of the variables - CHARACTER(len=*), OPTIONAL, INTENT(in) :: standname !< The variables stanard name - class(*), OPTIONAL, INTENT(in) :: missing_value - class(*), OPTIONAL, INTENT(in) :: varRANGE(2) - LOGICAL, OPTIONAL, INTENT(in) :: mask_variant - LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< if TRUE, field info is not logged - CHARACTER(len=*), OPTIONAL, INTENT(out):: err_msg !< Error message to be passed back up - CHARACTER(len=*), OPTIONAL, INTENT(in) :: interp_method !< The interp method to be used when - !! regridding the field in post-processing. - !! Valid options are "conserve_order1", - !! "conserve_order2", and "none". - INTEGER, OPTIONAL, INTENT(in) :: tile_count !< the number of tiles - INTEGER, OPTIONAL, INTENT(in) :: area !< diag_field_id containing the cell area field - INTEGER, OPTIONAL, INTENT(in) :: volume !< diag_field_id containing the cell volume field - CHARACTER(len=*), OPTIONAL, INTENT(in):: realm !< String to set as the value to the modeling_realm attribute - character(len=*), optional, intent(in), dimension(:) :: metadata !< metedata for the variable + class(fmsDiagObject_type), INTENT(inout) :: dobj !< Diaj_obj to fill + CHARACTER(len=*), INTENT(in) :: modname !< The module name + CHARACTER(len=*), INTENT(in) :: varname !< The variable name + TYPE(time_type), INTENT(in) :: init_time !< Initial time !< TO DO + integer, INTENT(in) :: diag_field_indices(:) !< Array of indices to the field + !! in the yaml object + INTEGER, TARGET, OPTIONAL, INTENT(in) :: axes(:) !< The axes indicies + CHARACTER(len=*), OPTIONAL, INTENT(in) :: longname !< THe variables long name + CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< The units of the variables + CHARACTER(len=*), OPTIONAL, INTENT(in) :: standname !< The variables stanard name + class(*), OPTIONAL, INTENT(in) :: missing_value !< Missing value to add as a attribute + class(*), OPTIONAL, INTENT(in) :: varRANGE(2) !< Range to add as a attribute + LOGICAL, OPTIONAL, INTENT(in) :: mask_variant !< Mask + LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< if TRUE, field info is not logged + CHARACTER(len=*), OPTIONAL, INTENT(out) :: err_msg !< Error message to be passed back up + CHARACTER(len=*), OPTIONAL, INTENT(in) :: interp_method !< The interp method to be used when + !! regridding the field in post-processing. + !! Valid options are "conserve_order1", + !! "conserve_order2", and "none". + INTEGER, OPTIONAL, INTENT(in) :: tile_count !< the number of tiles + INTEGER, OPTIONAL, INTENT(in) :: area !< diag_field_id of the cell area field + INTEGER, OPTIONAL, INTENT(in) :: volume !< diag_field_id of the cell volume field + CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the value to the + !! modeling_realm attribute + character(len=*), optional, INTENT(in) :: metadata(:) !< metedata for the variable + + integer :: i !< For do loops + integer :: j !< dobj%file_ids(i) (for less typing :) + +#ifdef use_yaml !> Fill in information from the register call - allocate(character(len=MAX_LEN_VARNAME) :: dobj%varname) dobj%varname = trim(varname) - allocate(character(len=len(modname)) :: dobj%modname) dobj%modname = trim(modname) -!> Grab the information from the diag_table -! TO DO: -! dobj%diag_field = get_diag_table_field(trim(varname)) -! dobj%diag_field = diag_yaml%get_diag_field( - !! TODO : Discuss design. Is this a premature return that somehow should - !! indicate a warning or failure to the calling function and/or the log files? -! if (is_field_type_null(dobj%diag_field)) then -! dobj%diag_id = diag_not_found -! dobj%vartype = diag_null -! return -! endif -!> TO DO: Add all the info from the diag_axis obj -!! axes will need to be changed to optional, so this subroutine can be used for both scalar and array fields -!! the domain_type and domain will be need to added to the dobj -! if (present(axes)) -! dobj%axes => axes ! or something -! call get_domain_and_domain_type(dobj%axes, dobj%domain_type, dobj%domain, dobj%varname) - !! Send all the axes_info to the diag_files -! else -! dobj%domain_type = NO_DOMAIN -! endif +!> Fill in diag_field and find the ids of the files that this variable is in + dobj%diag_field = get_diag_fields_entries(diag_field_indices) + dobj%file_ids = get_diag_files_id(diag_field_indices) -!> get the optional arguments if included and the diagnostic is in the diag table - if (present(longname)) then - allocate(character(len=len(longname)) :: dobj%longname) - dobj%longname = trim(longname) - endif - if (present(standname)) then - allocate(character(len=len(standname)) :: dobj%standname) - dobj%standname = trim(standname) + if (present(axes)) then + dobj%axis_ids => axes + call get_domain_and_domain_type(dobj%axis_ids, dobj%type_of_domain, dobj%domain, dobj%varname) + do i = 1, size(dobj%file_ids) + j = dobj%file_ids(i) + call FMS_diag_files(j)%set_file_domain(dobj%domain, dobj%type_of_domain) + call FMS_diag_files(j)%add_axes(axes) + enddo + !> TO DO: + !! Mark the field as registered in the diag_files + else + !> The variable is a scalar + dobj%type_of_domain = NO_DOMAIN + dobj%domain => null() endif - if (present(units)) then - allocate(character(len=len(units)) :: dobj%units) - dobj%units = trim(units) + +!> get the optional arguments if included and the diagnostic is in the diag table + if (present(longname)) dobj%longname = trim(longname) + if (present(standname)) dobj%standname = trim(standname) + if (present(units)) dobj%units = trim(units) + if (present(realm)) dobj%realm = trim(realm) + if (present(interp_method)) dobj%interp_method = trim(interp_method) + if (present(tile_count)) then + allocate(dobj%tile_count) + dobj%tile_count = tile_count endif + if (present(metadata)) then allocate(character(len=MAX_LEN_META) :: dobj%metadata(size(metadata))) dobj%metadata = metadata @@ -310,12 +307,63 @@ subroutine fms_register_diag_field_obj & end select endif -! write(6,*)"IKIND for diag_fields(1) is",dobj%diag_fields(1)%ikind -! write(6,*)"IKIND for "//trim(varname)//" is ",dobj%diag_field%ikind -!> Set the registered flag to true - dobj%registered = .true. - ! save it in the diag object container. + if (present(varRANGE)) then + select type (varRANGE) + type is (integer(kind=i4_kind)) + allocate(integer(kind=i4_kind) :: dobj%data_RANGE(2)) + dobj%data_RANGE = varRANGE + type is (integer(kind=i8_kind)) + allocate(integer(kind=i8_kind) :: dobj%data_RANGE(2)) + dobj%data_RANGE = varRANGE + type is (real(kind=r4_kind)) + allocate(integer(kind=r4_kind) :: dobj%data_RANGE(2)) + dobj%data_RANGE = varRANGE + type is (real(kind=r8_kind)) + allocate(integer(kind=r8_kind) :: dobj%data_RANGE(2)) + dobj%data_RANGE = varRANGE + class default + call mpp_error("fms_register_diag_field_obj", & + "The varRange passed to register a diagnostic is not a r8, r4, i8, or i4",& + FATAL) + end select + else + allocate(real :: dobj%data_RANGE(2)) + select type (varRANGE => dobj%data_RANGE) + type is (real) + varRANGE = real(CMOR_MISSING_VALUE) + end select + endif + + if (present(area)) then + if (area < 0) call mpp_error("fms_register_diag_field_obj", & + "The area id passed with field_name"//trim(varname)//" has not been registered."& + "Check that there is a register_diag_field call for the AREA measure and that is in the"& + "diag_table.yaml", FATAL) + allocate(dobj%area) + dobj%area = area + endif + + if (present(volume)) then + if (volume < 0) call mpp_error("fms_register_diag_field_obj", & + "The volume id passed with field_name"//trim(varname)//" has not been registered."& + "Check that there is a register_diag_field call for the VOLUME measure and that is in the"& + "diag_table.yaml", FATAL) + allocate(dobj%volume) + dobj%volume = volume + endif + if (present(mask_variant)) then + allocate(dobj%mask_variant) + dobj%mask_variant = mask_variant + endif + + if (present(do_not_log)) then + allocate(dobj%do_not_log) + dobj%do_not_log = do_not_log + endif + + dobj%registered = .true. +#endif end subroutine fms_register_diag_field_obj !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> \brief Sets the diag_id. This can only be done if a variable is unregistered @@ -620,18 +668,6 @@ pure function get_realm (obj) & rslt = diag_null_string endif end function get_realm -!> @brief Gets err_msg -!! @return copy of The error message stored in err_msg or an empty string if not allocated -pure function get_err_msg (obj) & -result(rslt) - class (fmsDiagObject_type), intent(in) :: obj !< diag object - character(len=:), allocatable :: rslt - if (allocated(obj%err_msg)) then - rslt = obj%err_msg - else - rslt = diag_null_string - endif -end function get_err_msg !> @brief Gets interp_method !! @return copy of The interpolation method or an empty string if not allocated pure function get_interp_method (obj) & @@ -696,20 +732,6 @@ pure function get_tile_count (obj) & rslt = DIAG_NULL endif end function get_tile_count -!> @brief Gets axis_ids -!! @return copy of The axis IDs array or a diag_null if no axis IDs are set -pure function get_axis_ids (obj) & -result(rslt) - class (fmsDiagObject_type), intent(in) :: obj !< diag object - integer, allocatable, dimension(:) :: rslt - if (allocated(obj%axis_ids)) then - allocate(rslt(size(obj%axis_ids))) - rslt = obj%axis_ids - else - allocate(rslt(1)) - rslt = diag_null - endif -end function get_axis_ids !> @brief Gets area !! @return copy of the area or diag_null if not allocated pure function get_area (obj) & @@ -769,20 +791,20 @@ end function get_missing_value function get_data_RANGE (obj) & result(rslt) class (fmsDiagObject_type), intent(in) :: obj !< diag object - class(*),allocatable :: rslt + class(*),allocatable :: rslt(:) if (allocated(obj%data_RANGE)) then select type (r => obj%data_RANGE) type is (integer(kind=i4_kind)) - allocate (integer(kind=i4_kind) :: rslt) + allocate (integer(kind=i4_kind) :: rslt(2)) rslt = r type is (integer(kind=i8_kind)) - allocate (integer(kind=i8_kind) :: rslt) + allocate (integer(kind=i8_kind) :: rslt(2)) rslt = r type is (real(kind=r4_kind)) - allocate (integer(kind=i4_kind) :: rslt) + allocate (integer(kind=i4_kind) :: rslt(2)) rslt = r type is (real(kind=r8_kind)) - allocate (integer(kind=i4_kind) :: rslt) + allocate (integer(kind=i4_kind) :: rslt(2)) rslt = r class default call mpp_error ("get_data_RANGE", & @@ -954,14 +976,6 @@ pure logical function has_diag_id (obj) class (fmsDiagObject_type), intent(in) :: obj !< diag object has_diag_id = allocated(obj%diag_id) end function has_diag_id -#ifdef use_yaml -!> @brief Checks if obj%diag_files pointer is associated -!! @return true if obj%diag_files is associated -pure logical function has_diag_files (obj) - class (fmsDiagObject_type), intent(in) :: obj !< diag object - has_diag_files = associated(obj%diag_files) -end function has_diag_files -#endif !> @brief Checks if obj%metadata is allocated !! @return true if obj%metadata is allocated pure logical function has_metadata (obj) @@ -1040,12 +1054,6 @@ pure logical function has_realm (obj) class (fmsDiagObject_type), intent(in) :: obj !< diag object has_realm = allocated(obj%realm) end function has_realm -!> @brief Checks if obj%err_msg is allocated -!! @return true if obj%err_msg is allocated -pure logical function has_err_msg (obj) - class (fmsDiagObject_type), intent(in) :: obj !< diag object - has_err_msg = allocated(obj%err_msg) -end function has_err_msg !> @brief Checks if obj%interp_method is allocated !! @return true if obj%interp_method is allocated pure logical function has_interp_method (obj) @@ -1076,12 +1084,6 @@ pure logical function has_tile_count (obj) class (fmsDiagObject_type), intent(in) :: obj !< diag object has_tile_count = allocated(obj%tile_count) end function has_tile_count -!> @brief Checks if obj%axis_ids is allocated -!! @return true if obj%axis_ids is allocated -pure logical function has_axis_ids (obj) - class (fmsDiagObject_type), intent(in) :: obj !< diag object - has_axis_ids = allocated(obj%axis_ids) -end function has_axis_ids !> @brief Checks if obj%area is allocated !! @return true if obj%area is allocated pure logical function has_area (obj) @@ -1106,11 +1108,4 @@ pure logical function has_data_RANGE (obj) class (fmsDiagObject_type), intent(in) :: obj !< diag object has_data_RANGE = allocated(obj%data_RANGE) end function has_data_RANGE -!> @brief Checks if obj%axis is allocated -!! @return true if obj%axis is allocated -pure logical function has_axis (obj) - class (fmsDiagObject_type), intent(in) :: obj !< diag object - has_axis = allocated(obj%axis) -end function has_axis - end module fms_diag_object_mod diff --git a/diag_manager/fms_diag_yaml.F90 b/diag_manager/fms_diag_yaml.F90 index 53511a26fd..bfe713579d 100644 --- a/diag_manager/fms_diag_yaml.F90 +++ b/diag_manager/fms_diag_yaml.F90 @@ -47,7 +47,7 @@ module fms_diag_yaml_mod public :: diag_yaml_object_init, diag_yaml_object_end public :: diagYamlObject_type, get_diag_yaml_obj, get_title, get_basedate, get_diag_files, get_diag_fields public :: diagYamlFiles_type, diagYamlFilesVar_type -public :: get_num_unique_fields, find_diag_field, get_diag_fields_entries, get_diag_files_entries +public :: get_num_unique_fields, find_diag_field, get_diag_fields_entries, get_diag_files_id !> @} integer, parameter :: basedate_size = 6 @@ -1222,40 +1222,41 @@ function get_diag_fields_entries(indices) & end function get_diag_fields_entries -!> @brief Gets the diag_files entries corresponding to the indices of the sorted variable_list -!! @return Array of diag_files -function get_diag_files_entries(indices) & - result(diag_file) +!> @brief Finds the indices of the diag_yaml%diag_files(:) corresponding to fields in variable_list(indices) +!! @return indices of the diag_yaml%diag_files(:) +function get_diag_files_id(indices) & + result(file_id) integer, intent(in) :: indices(:) !< Indices of the field in the sorted variable_list - type(diagYamlFiles_type), dimension (:), allocatable :: diag_file + integer, allocatable :: file_id(:) + integer :: field_id !< Indices of the field in the diag_yaml field array integer :: i !< For do loops - integer :: field_id !< Indices of the field in the diag_yaml array - integer :: file_id !< Indices of the file in the diag_yaml array character(len=120) :: filename !< Filename of the field integer, allocatable :: file_indices(:) !< Indices of the file in the sorted variable_list - allocate(diag_file(size(indices))) + allocate(file_id(size(indices))) do i = 1, size(indices) field_id = variable_list%diag_field_indices(indices(i)) + !< Get the filename of the field filename = diag_yaml%diag_fields(field_id)%var_fname + !< File indice of that file in the array of list of sorted files file_indices = fms_find_my_string(file_list%file_pointer, size(file_list%file_pointer), & & trim(filename)//c_null_char) if (size(file_indices) .ne. 1) & - & call mpp_error(FATAL, "get_diag_files_entries: Error getting the correct number of file indices!") + & call mpp_error(FATAL, "get_diag_files_id: Error getting the correct number of file indices!") if (file_indices(1) .eq. diag_null) & - & call mpp_error(FATAL, "get_diag_files_entries: Error finding the filename in the diag_files") + & call mpp_error(FATAL, "get_diag_files_id: Error finding the filename in the diag_files yaml") - file_id = file_list%diag_file_indices(file_indices(1)) - diag_file(i) = diag_yaml%diag_files(file_id) + !< Get the index of the file in the diag_yaml file + file_id(i) = file_list%diag_file_indices(file_indices(1)) end do -end function get_diag_files_entries +end function get_diag_files_id #endif end module fms_diag_yaml_mod !> @} diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am index d2262129d4..94dbc18774 100644 --- a/test_fms/diag_manager/Makefile.am +++ b/test_fms/diag_manager/Makefile.am @@ -37,7 +37,6 @@ test_diag_manager_SOURCES = test_diag_manager.F90 test_diag_manager_time_SOURCES = test_diag_manager_time.F90 test_diag_update_buffer_SOURCES= test_diag_update_buffer.F90 test_diag_yaml_SOURCES = test_diag_yaml.F90 -test_diag_object_container_SOURCES = test_diag_object_container.F90 test_diag_dlinked_list_SOURCES = test_diag_dlinked_list.F90 test_diag_ocean_SOURCES = test_diag_ocean.F90 test_modern_diag_SOURCES = test_modern_diag.F90 diff --git a/test_fms/diag_manager/test_diag_manager2.sh b/test_fms/diag_manager/test_diag_manager2.sh index 40cff2c612..f6c4b0e43d 100755 --- a/test_fms/diag_manager/test_diag_manager2.sh +++ b/test_fms/diag_manager/test_diag_manager2.sh @@ -641,9 +641,6 @@ test_expect_success "Test the diag_ocean feature in diag_manager_init (test $my_ mpirun -n 2 ../test_diag_ocean ' -test_expect_success "test_diag_object_container (test $my_test_count)" ' - mpirun -n 1 ../test_diag_object_container -' test_expect_success "test_diag_dlinked_list (test $my_test_count)" ' mpirun -n 1 ../test_diag_dlinked_list ' diff --git a/test_fms/diag_manager/test_diag_yaml.F90 b/test_fms/diag_manager/test_diag_yaml.F90 index 845991b900..dbbabe2b76 100644 --- a/test_fms/diag_manager/test_diag_yaml.F90 +++ b/test_fms/diag_manager/test_diag_yaml.F90 @@ -56,6 +56,10 @@ end subroutine compare_result_1d type(diagYamlFiles_type), allocatable, dimension (:) :: diag_files !< Files from the diag_yaml type(diagYamlFilesVar_type), allocatable, dimension(:) :: diag_fields !< Fields from the diag_yaml +type(diagYamlObject_type) :: my_yaml !< diagYamlObject obtained from diag_yaml_object_init +type(diagYamlObject_type) :: ans !< expected diagYamlObject +integer, ALLOCATABLE :: diag_files_ids(:) !< Ids of the diag_files +#endif namelist / check_crashes_nml / checking_crashes @@ -108,7 +112,11 @@ end subroutine compare_result_1d call compare_result("sst - fieldname", diag_fields(2)%get_var_varname(), "sst") deallocate(diag_fields) - diag_files = get_diag_files_entries(indices) + diag_files_ids = get_diag_files_id(indices) + allocate(diag_files(size(diag_files_ids))) + + diag_files(1) = my_yaml%diag_files(diag_files_ids(1)) + diag_files(2) = my_yaml%diag_files(diag_files_ids(2)) call compare_result("sst - nfiles", size(diag_files), 2) call compare_result("sst - filename", diag_files(1)%get_file_fname(), "normal") call compare_result("sst - filename", diag_files(2)%get_file_fname(), "wild_card_name%4yr%2mo%2dy%2hr")