diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index 7680f5b126..9c47141648 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -236,7 +236,8 @@ MODULE diag_manager_mod USE diag_table_mod, ONLY: parse_diag_table USE diag_output_mod, ONLY: get_diag_global_att, set_diag_global_att USE diag_grid_mod, ONLY: diag_grid_init, diag_grid_end - USE fms_diag_object_mod, ONLY: fmsDiagObject_type + USE fms_diag_object_mod, ONLY: fmsDiagObject_type, fms_diag_object_init, fms_register_diag_field_array, & + & fms_register_diag_field_scalar, fms_diag_object_end, fms_register_static_field USE fms_diag_file_object_mod, only: fms_diag_files_object_initialized #ifdef use_yaml use fms_diag_yaml_mod, only: diag_yaml_object_init, diag_yaml_object_end, get_num_unique_fields, find_diag_field @@ -279,9 +280,6 @@ MODULE diag_manager_mod type(time_type) :: Time_end - TYPE(fmsDiagObject_type), ALLOCATABLE :: diag_objs(:) !< Array of diag objects, one for each registered variable - integer :: registered_variables !< Number of registered variables - !> @brief Send data over to output fields. !! !> send_data is overloaded for fields having zero dimension @@ -407,7 +405,7 @@ INTEGER FUNCTION register_diag_field_scalar(module_name, field_name, init_time, CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the modeling_realm attribute if (use_modern_diag) then - register_diag_field_scalar = register_diag_field_scalar_modern(module_name, field_name, init_time, & + register_diag_field_scalar = fms_register_diag_field_scalar(module_name, field_name, init_time, & & long_name=long_name, units=units, missing_value=missing_value, var_range=range, standard_name=standard_name, & & do_not_log=do_not_log, err_msg=err_msg, area=area, volume=volume, realm=realm) else @@ -445,7 +443,7 @@ INTEGER FUNCTION register_diag_field_array(module_name, field_name, axes, init_t CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the modeling_realm attribute if (use_modern_diag) then - register_diag_field_array = register_diag_field_array_modern(module_name, field_name, axes, init_time, & + register_diag_field_array = fms_register_diag_field_array(module_name, field_name, axes, init_time, & & long_name=long_name, units=units, missing_value=missing_value, var_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, volume=volume, realm=realm) @@ -457,99 +455,53 @@ INTEGER FUNCTION register_diag_field_array(module_name, field_name, axes, init_t endif end function register_diag_field_array - !> @brief Registers a scalar field + !> @brief Return field index for subsequent call to send_data. !! @return field index for subsequent call to send_data. - INTEGER FUNCTION register_diag_field_scalar_modern(module_name, field_name, init_time, & - & long_name, units, missing_value, var_range, standard_name, do_not_log, err_msg,& - & area, volume, realm) - CHARACTER(len=*), INTENT(in) :: module_name !< Module where the field comes from - CHARACTER(len=*), INTENT(in) :: field_name !< Name of the field - TYPE(time_type), OPTIONAL, INTENT(in) :: init_time !< Time to start writing data from - CHARACTER(len=*), OPTIONAL, INTENT(in) :: long_name !< Long_name to add as a variable attribute - CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< Units to add as a variable_attribute - CHARACTER(len=*), OPTIONAL, INTENT(in) :: standard_name !< Standard_name to name the variable in the file - REAL, OPTIONAL, INTENT(in) :: missing_value !< Missing value to add as a variable attribute - REAL, OPTIONAL, INTENT(in) :: var_range(2) !< Range to add a variable attribute - LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< If TRUE, field information is not logged - CHARACTER(len=*), OPTIONAL, INTENT(out):: err_msg !< Error_msg from call - INTEGER, OPTIONAL, INTENT(in) :: area !< Id of the area field - INTEGER, OPTIONAL, INTENT(in) :: volume !< Id of the volume field - CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the modeling_realm attribute - -#ifdef use_yaml - integer, allocatable :: diag_field_indices(:) !< indices where the field was found - - diag_field_indices = find_diag_field(field_name, module_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_field_indices) - return - endif - - registered_variables = registered_variables + 1 - register_diag_field_scalar_modern = registered_variables - - 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 + INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, units,& + & missing_value, range, mask_variant, standard_name, DYNAMIC, do_not_log, interp_method,& + & tile_count, area, volume, realm) + CHARACTER(len=*), INTENT(in) :: module_name !< Name of the module, the field is on + CHARACTER(len=*), INTENT(in) :: field_name !< Name of the field + INTEGER, DIMENSION(:), INTENT(in) :: axes !< Axes_id of the field + CHARACTER(len=*), OPTIONAL, INTENT(in) :: long_name !< Longname to be added as a attribute + CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< Units to be added as a attribute + CHARACTER(len=*), OPTIONAL, INTENT(in) :: standard_name !< Standard name to be added as a attribute + real, OPTIONAL, INTENT(in) :: missing_value !< Missing value to be added as a attribute + real, DIMENSION(2), OPTIONAL, INTENT(in) :: range !< Range to be added as a attribute + LOGICAL, OPTIONAL, INTENT(in) :: mask_variant !< Flag indicating if the field is has + !! a mask variant + LOGICAL, OPTIONAL, INTENT(in) :: DYNAMIC !< Flag indicating if the field is dynamic + LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< if TRUE, field information is not logged + 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 !! Number of tiles + INTEGER, OPTIONAL, INTENT(in) :: area !< Field ID for the area field associated + !! with this field + INTEGER, OPTIONAL, INTENT(in) :: volume !< Field ID for the volume field associated + !! with this field + CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the value to the + !! modeling_realm attribute - !> @brief Registers an array field - !> @return field index for subsequent call to send_data. - INTEGER FUNCTION register_diag_field_array_modern(module_name, field_name, axes, init_time, & - & long_name, units, missing_value, var_range, mask_variant, standard_name, verbose,& - & do_not_log, err_msg, interp_method, tile_count, area, volume, realm) - CHARACTER(len=*), INTENT(in) :: module_name !< Module where the field comes from - CHARACTER(len=*), INTENT(in) :: field_name !< Name of the field - INTEGER, INTENT(in) :: axes(:) !< Ids corresponding to the variable axis - TYPE(time_type), OPTIONAL, INTENT(in) :: init_time !< Time to start writing data from - CHARACTER(len=*), OPTIONAL, INTENT(in) :: long_name !< Long_name to add as a variable attribute - CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< Units to add as a variable_attribute - REAL, OPTIONAL, INTENT(in) :: missing_value !< Missing value to add as a variable attribute - REAL, OPTIONAL, INTENT(in) :: var_range(2) !< Range to add a variable attribute - LOGICAL, OPTIONAL, INTENT(in) :: mask_variant !< Mask variant - CHARACTER(len=*), OPTIONAL, INTENT(in) :: standard_name !< Standard_name to name the variable in the file - LOGICAL, OPTIONAL, INTENT(in) :: verbose !< Print more information - LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< If TRUE, field information is not logged - CHARACTER(len=*), OPTIONAL, INTENT(out):: err_msg !< Error_msg from call - 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 current tile number - INTEGER, OPTIONAL, INTENT(in) :: area !< Id of the area field - INTEGER, OPTIONAL, INTENT(in) :: volume !< Id of the volume field - CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the modeling_realm attribute + ! Fatal error if the module has not been initialized. + IF ( .NOT.module_is_initialized ) THEN + ! diag_manager has NOT been initialized + CALL error_mesg ('diag_manager_mod::register_static_field', 'diag_manager has NOT been initialized', FATAL) + END IF -#ifdef use_yaml - integer, allocatable :: diag_field_indices(:) !< indices of diag_field yaml where the field was found - - diag_field_indices = find_diag_field(field_name, module_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_field_indices) - return + if (use_modern_diag) then + register_static_field = fms_register_static_field(module_name, field_name, axes, & + & long_name=long_name, units=units, missing_value=missing_value, range=range, mask_variant=mask_variant, & + & standard_name=standard_name, dynamic=DYNAMIC, do_not_log=do_not_log, interp_method=interp_method,& + & tile_count=tile_count, area=area, volume=volume, realm=realm) + else + register_static_field = register_static_field_old(module_name, field_name, axes, & + & long_name=long_name, units=units, missing_value=missing_value, range=range, mask_variant=mask_variant, & + & standard_name=standard_name, dynamic=DYNAMIC, do_not_log=do_not_log, interp_method=interp_method,& + & tile_count=tile_count, area=area, volume=volume, realm=realm) endif - - registered_variables = registered_variables + 1 - register_diag_field_array_modern = registered_variables - - 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 +END FUNCTION register_static_field !> @brief Registers a scalar field !! @return field index for subsequent call to send_data. @@ -775,7 +727,7 @@ INTEGER FUNCTION register_diag_field_array_old(module_name, field_name, axes, in END FUNCTION register_diag_field_array_old !> @brief Return field index for subsequent call to send_data. !! @return field index for subsequent call to send_data. - INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, units,& + INTEGER FUNCTION register_static_field_old(module_name, field_name, axes, long_name, units,& & missing_value, range, mask_variant, standard_name, DYNAMIC, do_not_log, interp_method,& & tile_count, area, volume, realm) CHARACTER(len=*), INTENT(in) :: module_name, field_name @@ -806,7 +758,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, ! Fatal error if the module has not been initialized. IF ( .NOT.module_is_initialized ) THEN ! diag_manager has NOT been initialized - CALL error_mesg ('diag_manager_mod::register_static_field', 'diag_manager has NOT been initialized', FATAL) + CALL error_mesg ('diag_manager_mod::register_static_field_old', 'diag_manager has NOT been initialized', FATAL) END IF ! Check if OPTIONAL parameters were passed in. @@ -852,10 +804,10 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, & DYNAMIC=dynamic1) END IF - register_static_field = find_input_field(module_name, field_name, 1) - field = register_static_field + register_static_field_old = find_input_field(module_name, field_name, 1) + field = register_static_field_old ! Negative index returned if this field was not found in the diag_table. - IF ( register_static_field < 0 ) RETURN + IF ( register_static_field_old < 0 ) RETURN ! Check that the axes are compatible with each other domain_type = axis_compatible_check(axes,field_name) @@ -872,7 +824,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, END IF CALL init_input_field(module_name, field_name, tile) - register_static_field = find_input_field(module_name, field_name, tile) + register_static_field_old = find_input_field(module_name, field_name, tile) DO j = 1, input_fields(field)%num_output_fields out_num = input_fields(field)%output_fields(j) file_num = output_fields(out_num)%output_file @@ -885,7 +837,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, & files(file_num)%name,output_fields(out_num)%time_method, output_fields(out_num)%pack, tile) END IF END DO - field = register_static_field + field = register_static_field_old END IF ! Store information for this input field into input field table @@ -906,7 +858,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, ! Verify that area and volume do not point to the same variable IF ( PRESENT(volume).AND.PRESENT(area) ) THEN IF ( area.EQ.volume ) THEN - CALL error_mesg ('diag_manager_mod::register_static_field', 'module/output_field '& + CALL error_mesg ('diag_manager_mod::register_static_field_old', 'module/output_field '& &//TRIM(module_name)//'/'// TRIM(field_name)//' AREA and VOLUME CANNOT be the same variable.& & Contact the developers.',& & FATAL) @@ -916,7 +868,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, ! Check for the existence of the area/volume field(s) IF ( PRESENT(area) ) THEN IF ( area < 0 ) THEN - CALL error_mesg ('diag_manager_mod::register_static_field', 'module/output_field '& + CALL error_mesg ('diag_manager_mod::register_static_field_old', 'module/output_field '& &//TRIM(module_name)//'/'// TRIM(field_name)//' AREA measures field NOT found in diag_table.& & Contact the model liaison.n',& & FATAL) @@ -924,7 +876,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, END IF IF ( PRESENT(volume) ) THEN IF ( volume < 0 ) THEN - CALL error_mesg ('diag_manager_mod::register_static_field', 'module/output_field '& + CALL error_mesg ('diag_manager_mod::register_static_field_old', 'module/output_field '& &//TRIM(module_name)//'/'// TRIM(field_name)//' VOLUME measures field NOT found in diag_table& & Contact the model liaison.',& & FATAL) @@ -1035,7 +987,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, file_num = output_fields(out_num)%output_file if (domain_type .eq. DIAG_AXIS_2DDOMAIN) then if (files(file_num)%use_domainUG) then - call error_mesg("diag_manager_mod::register_static_field", & + call error_mesg("diag_manager_mod::register_static_field_old", & "Diagnostics living on a structured grid" & //" and an unstructured grid cannot exist" & //" in the same file (" & @@ -1046,7 +998,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, endif elseif (domain_type .eq. DIAG_AXIS_UGDOMAIN) then if (files(file_num)%use_domain2D) then - call error_mesg("diag_manager_mod::register_static_field", & + call error_mesg("diag_manager_mod::register_static_field_old", & "Diagnostics living on a structured grid" & //" and an unstructured grid cannot exist" & //" in the same file (" & @@ -1146,7 +1098,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, ! minimum on static fields. Setting the time operation to 'NONE' ! for this field. ! - CALL error_mesg ('diag_manager_mod::register_static_field',& + CALL error_mesg ('diag_manager_mod::register_static_field_old',& & 'module/field '//TRIM(msg)//' is STATIC. Cannot perform time operations& & average, maximum, or minimum on static fields. Setting the time operation& & to "NONE" for this field.', WARNING) @@ -1193,7 +1145,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, ! Set the cell_measures attribute in the out file CALL init_field_cell_measures(output_fields(out_num), area=area, volume=volume, err_msg=msg) IF ( LEN_TRIM(msg).GT.0 ) THEN - CALL error_mesg ('diag_manager_mod::register_static_field',& + CALL error_mesg ('diag_manager_mod::register_static_field_old',& & TRIM(msg)//' for module/field '//TRIM(module_name)//'/'//TRIM(field_name),& & FATAL) END IF @@ -1226,7 +1178,7 @@ INTEGER FUNCTION register_static_field(module_name, field_name, axes, long_name, END IF END DO END IF - END FUNCTION register_static_field + END FUNCTION register_static_field_old !> @brief Return the diagnostic field ID of a given variable. !! @return get_diag_field_id will return the ID returned during the register_diag_field call. @@ -3689,7 +3641,7 @@ SUBROUTINE diag_manager_end(time) if (use_modern_diag) then call diag_yaml_object_end call fms_diag_axis_object_end() - if (allocated(diag_objs)) deallocate(diag_objs) + call fms_diag_object_end() endif #endif END SUBROUTINE diag_manager_end @@ -3907,8 +3859,8 @@ SUBROUTINE diag_manager_init(diag_model_subset, time_init, err_msg) if (use_modern_diag) then CALL diag_yaml_object_init(diag_subset_output) CALL fms_diag_axis_object_init() - allocate(diag_objs(get_num_unique_fields())) - registered_variables = 0 + CALL fms_diag_object_init(255, 255) !< TO DO: MAX_LEN_VARNAME and MAX_LEN_META are supposed to be read from + !! the namelist and sent to fms_diag_object fms_diag_files_object_initialized = fms_diag_files_object_init () endif #else diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 4f29820887..0acb7116e7 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -14,7 +14,8 @@ module fms_diag_object_mod 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, get_diag_fields_entries, get_diag_files_id +use fms_diag_yaml_mod, only: diagYamlFilesVar_type, get_diag_fields_entries, get_diag_files_id, & + & find_diag_field, get_num_unique_fields 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 @@ -144,6 +145,11 @@ module fms_diag_object_mod integer,private :: MAX_LEN_VARNAME integer,private :: MAX_LEN_META +logical,private :: module_is_initialized = .false. !< Flag indicating if the module is initialized + +TYPE(fmsDiagObject_type), private, ALLOCATABLE, target :: diag_objs(:) !< Array of diag objects + !! one for each registered variable +integer, private :: registered_variables !< Number of registered variables !type(fmsDiagObject_type) :: diag_object_placeholder (10) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -151,20 +157,43 @@ module fms_diag_object_mod public :: null_ob public :: copy_diag_obj, fms_diag_get_id public :: fms_diag_object_init +public :: fms_diag_object_end +public :: fms_register_diag_field_array +public :: fms_register_diag_field_scalar +public :: fms_register_static_field +public :: get_diag_obj_from_id !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CONTAINS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!> @brief Initiliazes the array of diag_objs based on the number of unique diag_fields in the diag_table subroutine fms_diag_object_init (mlv,mlm) integer, intent(in) :: mlv !< The maximum length of the varname integer, intent(in) :: mlm !< The maximum length of the metadata + + if (module_is_initialized) return + !> Get info from the namelist MAX_LEN_VARNAME = mlv MAX_LEN_META = mlm !> Initialize the null_d variables null_ob%diag_id = DIAG_NULL +#ifdef use_yaml + allocate(diag_objs(get_num_unique_fields())) + registered_variables = 0 +#endif + module_is_initialized = .true. end subroutine fms_diag_object_init + +!> @brief Deallocates the array of diag_objs +subroutine fms_diag_object_end () + if (.not. module_is_initialized) return + + if (allocated(diag_objs)) deallocate(diag_objs) + + module_is_initialized = .false. +end subroutine fms_diag_object_end !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> \Description Sets the diag_id to the not registered value. subroutine diag_obj_init(ob) @@ -179,16 +208,16 @@ 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, init_time, diag_field_indices, axes, & + (dobj, modname, varname, diag_field_indices, axes, init_time, & 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 !< 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 + TYPE(time_type), OPTIONAL, INTENT(in) :: init_time !< Initial time !< TO DO 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 @@ -943,4 +972,163 @@ 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 Registers a scalar field + !! @return field index for subsequent call to send_data. + INTEGER FUNCTION fms_register_diag_field_scalar(module_name, field_name, init_time, & + & long_name, units, missing_value, var_range, standard_name, do_not_log, err_msg,& + & area, volume, realm) + CHARACTER(len=*), INTENT(in) :: module_name !< Module where the field comes from + CHARACTER(len=*), INTENT(in) :: field_name !< Name of the field + TYPE(time_type), OPTIONAL, INTENT(in) :: init_time !< Time to start writing data from + CHARACTER(len=*), OPTIONAL, INTENT(in) :: long_name !< Long_name to add as a variable attribute + CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< Units to add as a variable_attribute + CHARACTER(len=*), OPTIONAL, INTENT(in) :: standard_name !< Standard_name to name the variable in the file + CLASS(*), OPTIONAL, INTENT(in) :: missing_value !< Missing value to add as a variable attribute + CLASS(*), OPTIONAL, INTENT(in) :: var_range(:) !< Range to add a variable attribute + LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< If TRUE, field information is not logged + CHARACTER(len=*), OPTIONAL, INTENT(out):: err_msg !< Error_msg from call + INTEGER, OPTIONAL, INTENT(in) :: area !< Id of the area field + INTEGER, OPTIONAL, INTENT(in) :: volume !< Id of the volume field + CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the modeling_realm attribute + +#ifdef use_yaml + integer, allocatable :: diag_field_indices(:) !< indices where the field was found + + diag_field_indices = find_diag_field(field_name, module_name) + if (diag_field_indices(1) .eq. diag_null) then + !< The field was not found in the table, so return diag_null + fms_register_diag_field_scalar = diag_null + deallocate(diag_field_indices) + return + endif + + registered_variables = registered_variables + 1 + fms_register_diag_field_scalar = registered_variables + + call diag_objs(registered_variables)%setID(registered_variables) + call diag_objs(registered_variables)%register(module_name, field_name, diag_field_indices, init_time=init_time, & + & 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 fms_register_diag_field_scalar + + !> @brief Registers an array field + !> @return field index for subsequent call to send_data. + INTEGER FUNCTION fms_register_diag_field_array(module_name, field_name, axes, init_time, & + & long_name, units, missing_value, var_range, mask_variant, standard_name, verbose,& + & do_not_log, err_msg, interp_method, tile_count, area, volume, realm) + CHARACTER(len=*), INTENT(in) :: module_name !< Module where the field comes from + CHARACTER(len=*), INTENT(in) :: field_name !< Name of the field + INTEGER, INTENT(in) :: axes(:) !< Ids corresponding to the variable axis + TYPE(time_type), OPTIONAL, INTENT(in) :: init_time !< Time to start writing data from + CHARACTER(len=*), OPTIONAL, INTENT(in) :: long_name !< Long_name to add as a variable attribute + CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< Units to add as a variable_attribute + CLASS(*), OPTIONAL, INTENT(in) :: missing_value !< Missing value to add as a variable attribute + CLASS(*), OPTIONAL, INTENT(in) :: var_range(:) !< Range to add a variable attribute + LOGICAL, OPTIONAL, INTENT(in) :: mask_variant !< Mask variant + CHARACTER(len=*), OPTIONAL, INTENT(in) :: standard_name !< Standard_name to name the variable in the file + LOGICAL, OPTIONAL, INTENT(in) :: verbose !< Print more information + LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< If TRUE, field information is not logged + CHARACTER(len=*), OPTIONAL, INTENT(out):: err_msg !< Error_msg from call + 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 current tile number + INTEGER, OPTIONAL, INTENT(in) :: area !< Id of the area field + INTEGER, OPTIONAL, INTENT(in) :: volume !< Id of the volume field + CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the modeling_realm attribute + +#ifdef use_yaml + integer, allocatable :: diag_field_indices(:) !< indices of diag_field yaml where the field was found + + diag_field_indices = find_diag_field(field_name, module_name) + if (diag_field_indices(1) .eq. diag_null) then + !< The field was not found in the table, so return diag_null + fms_register_diag_field_array = diag_null + deallocate(diag_field_indices) + return + endif + + registered_variables = registered_variables + 1 + fms_register_diag_field_array = registered_variables + + call diag_objs(registered_variables)%setID(registered_variables) + call diag_objs(registered_variables)%register(module_name, field_name, diag_field_indices, init_time=init_time, & + & axes=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 fms_register_diag_field_array + +!> @brief Return field index for subsequent call to send_data. +!! @return field index for subsequent call to send_data. +INTEGER FUNCTION fms_register_static_field(module_name, field_name, axes, long_name, units,& + & missing_value, range, mask_variant, standard_name, DYNAMIC, do_not_log, interp_method,& + & tile_count, area, volume, realm) + CHARACTER(len=*), INTENT(in) :: module_name !< Name of the module, the field is on + CHARACTER(len=*), INTENT(in) :: field_name !< Name of the field + INTEGER, DIMENSION(:), INTENT(in) :: axes !< Axes_id of the field + CHARACTER(len=*), OPTIONAL, INTENT(in) :: long_name !< Longname to be added as a attribute + CHARACTER(len=*), OPTIONAL, INTENT(in) :: units !< Units to be added as a attribute + CHARACTER(len=*), OPTIONAL, INTENT(in) :: standard_name !< Standard name to be added as a attribute + real, OPTIONAL, INTENT(in) :: missing_value !< Missing value to be added as a attribute + real, DIMENSION(2), OPTIONAL, INTENT(in) :: range !< Range to be added as a attribute + LOGICAL, OPTIONAL, INTENT(in) :: mask_variant !< Flag indicating if the field is has + !! a mask variant + LOGICAL, OPTIONAL, INTENT(in) :: DYNAMIC !< Flag indicating if the field is dynamic + LOGICAL, OPTIONAL, INTENT(in) :: do_not_log !< if TRUE, field information is not logged + 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 !! Number of tiles + INTEGER, OPTIONAL, INTENT(in) :: area !< Field ID for the area field associated + !! with this field + INTEGER, OPTIONAL, INTENT(in) :: volume !< Field ID for the volume field associated + !! with this field + CHARACTER(len=*), OPTIONAL, INTENT(in) :: realm !< String to set as the value to the + !! modeling_realm attribute + +#ifdef use_yaml + integer, allocatable :: diag_field_indices(:) !< indices where the field was foun + + diag_field_indices = find_diag_field(field_name, module_name) + if (diag_field_indices(1) .eq. diag_null) then + !< The field was not found in the table, so return diag_null + fms_register_static_field = diag_null + deallocate(diag_field_indices) + return + endif + + registered_variables = registered_variables + 1 + fms_register_static_field = registered_variables + + call diag_objs(registered_variables)%setID(registered_variables) + allocate(diag_objs(registered_variables)%static) + diag_objs(registered_variables)%static = .true. + call diag_objs(registered_variables)%register(module_name, field_name, diag_field_indices, axes=axes, & + & longname=long_name, units=units, missing_value=missing_value, varrange=range, & + & standname=standard_name, do_not_log=do_not_log, area=area, volume=volume, realm=realm) + deallocate(diag_field_indices) +#endif +end function fms_register_static_field + +!> @brief Get a pointer to the diag_object from the id. +!> @return A pointer to the diag_object or a null pointer if the id is not valid +FUNCTION get_diag_obj_from_id ( id ) result (obj_ptr) + integer :: id !< Id of the diag_obj to get + class(fmsDiagObject_type), pointer :: obj_ptr + + obj_ptr => null() + IF (id >= 1 .and. id <= registered_variables) THEN + obj_ptr => diag_objs(id) + END IF +END FUNCTION get_diag_obj_from_id end module fms_diag_object_mod