From 2a9699ddb474ca2a7e4a6398f160e32be458ebcb Mon Sep 17 00:00:00 2001 From: uramirez8707 <49168881+uramirez8707@users.noreply.github.com> Date: Thu, 18 Jan 2024 12:50:25 -0500 Subject: [PATCH] fix: Modern Diag Manager changes for reproducibility (#1435) --- diag_manager/fms_diag_axis_object.F90 | 36 +++++++++++++++++-- diag_manager/fms_diag_field_object.F90 | 28 ++++++++++++++- diag_manager/fms_diag_file_object.F90 | 34 ++++++++++++++++-- diag_manager/fms_diag_object.F90 | 13 +++++-- diag_manager/fms_diag_output_buffer.F90 | 21 +++++++++++ test_fms/diag_manager/check_time_avg.F90 | 6 ++++ test_fms/diag_manager/test_modern_diag.F90 | 4 +-- .../diag_manager/test_reduction_methods.F90 | 2 ++ test_fms/diag_manager/test_time_avg.sh | 4 +++ 9 files changed, 137 insertions(+), 11 deletions(-) diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index e74ccabef..0a913dc60 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -171,6 +171,8 @@ module fms_diag_axis_object_mod INTEGER , private :: domain_position !< The position in the doman (NORTH, EAST or CENTER) integer, allocatable , private :: structured_ids(:) !< If the axis is in the unstructured grid, !! this is the axis ids of the structured axis + CHARACTER(len=:), ALLOCATABLE, private :: set_name !< Name of the axis set. This is to distinguish + !! two axis with the same name contains @@ -184,6 +186,8 @@ module fms_diag_axis_object_mod PROCEDURE :: get_global_io_domain PROCEDURE :: get_aux PROCEDURE :: has_aux + PROCEDURE :: get_set_name + PROCEDURE :: has_set_name ! TO DO: ! Get/has/is subroutines as needed END TYPE fmsDiagFullAxis_type @@ -270,6 +274,8 @@ subroutine register_diag_axis_obj(this, axis_name, axis_data, units, cart_name, if (present(aux)) this%aux = trim(aux) if (present(req)) this%req = trim(req) + this%set_name = "" + if (present(set_name)) this%set_name = trim(set_name) this%nsubaxis = 0 this%num_attributes = 0 @@ -604,6 +610,27 @@ pure function has_aux(this) & if (allocated(this%aux)) rslt = trim(this%aux) .ne. "" end function has_aux + !> @brief Determine if an axis object has a set_name + !! @return .true. if an axis object has a set_name + pure function has_set_name(this) & + result(rslt) + class(fmsDiagFullAxis_type), intent(in) :: this !< diag_axis obj + logical :: rslt + + rslt = .false. + if (allocated(this%set_name)) rslt = trim(this%set_name) .ne. "" + end function has_set_name + + !> @brief Get the set name of an axis object + !! @return the set name of an axis object + pure function get_set_name(this) & + result(rslt) + class(fmsDiagFullAxis_type), intent(in) :: this !< diag_axis obj + character(len=:), allocatable :: rslt + + rslt = this%set_name + end function get_set_name + !> @brief Get the auxiliary name of an axis object !! @return the auxiliary name of an axis object pure function get_aux(this) & @@ -1263,11 +1290,12 @@ end function parse_compress_att !< @brief Determine the axis id of a axis !! @return Axis id - pure function get_axis_id_from_name(axis_name, diag_axis, naxis) & + pure function get_axis_id_from_name(axis_name, diag_axis, naxis, set_name) & result(axis_id) class(fmsDiagAxisContainer_type), intent(in) :: diag_axis(:) !< Array of axis object character(len=*), intent(in) :: axis_name !< Name of the axis integer, intent(in) :: naxis !< Number of axis that have been registered + character(len=*), intent(in) :: set_name !< Name of the axis set integer :: axis_id integer :: i !< For do loops @@ -1277,8 +1305,10 @@ pure function get_axis_id_from_name(axis_name, diag_axis, naxis) & select type(axis => diag_axis(i)%axis) type is (fmsDiagFullAxis_type) if (trim(axis%axis_name) .eq. trim(axis_name)) then - axis_id = i - return + if (trim(axis%set_name) .eq. trim(set_name)) then + axis_id = i + return + endif endif end select enddo diff --git a/diag_manager/fms_diag_field_object.F90 b/diag_manager/fms_diag_field_object.F90 index 380bcda31..6ff8a96e8 100644 --- a/diag_manager/fms_diag_field_object.F90 +++ b/diag_manager/fms_diag_field_object.F90 @@ -173,6 +173,8 @@ module fms_diag_field_object_mod procedure :: is_halo_present procedure :: find_missing_value procedure :: has_mask_allocated + procedure :: is_variable_in_file + procedure :: get_field_file_name end type fmsDiagField_type !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! variables !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! type(fmsDiagField_type) :: null_ob @@ -1011,7 +1013,7 @@ pure function get_longname_to_write(this, field_yaml) & endif if (rslt .eq. "") then !! If the long name is not defined in the yaml and in the register_diag_field !! use the variable name - rslt = field_yaml%get_var_outname() + rslt = field_yaml%get_var_varname() endif end function get_longname_to_write @@ -1743,5 +1745,29 @@ pure logical function has_mask_allocated(this) has_mask_allocated = allocated(this%mask) end function has_mask_allocated +!> @brief Determine if the variable is in the file +!! @return .True. if the varibale is in the file +pure function is_variable_in_file(this, file_id) & +result(res) + class(fmsDiagField_type), intent(in) :: this !< field object to check + integer, intent(in) :: file_id !< File id to check + logical :: res + + integer :: i + + res = .false. + if (any(this%file_ids .eq. file_id)) res = .true. +end function is_variable_in_file + +!> @brief Determine the name of the first file the variable is in +!! @return filename +function get_field_file_name(this) & + result(res) + class(fmsDiagField_type), intent(in) :: this !< Field object to query + character(len=:), allocatable :: res + + res = this%diag_field(1)%get_var_fname() +end function get_field_file_name + #endif end module fms_diag_field_object_mod diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index 211d5519c..8255f1565 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -47,7 +47,7 @@ module fms_diag_file_object_mod use fms_diag_field_object_mod, only: fmsDiagField_type use fms_diag_output_buffer_mod, only: fmsDiagOutputBuffer_type use mpp_mod, only: mpp_get_current_pelist, mpp_npes, mpp_root_pe, mpp_pe, mpp_error, FATAL, stdout, & - uppercase, lowercase + uppercase, lowercase, NOTE implicit none private @@ -1162,6 +1162,13 @@ subroutine write_field_data(this, field_obj, buffer_obj) if (diag_file%unlim_dimension_level .eq. 1) & call buffer_obj(diag_file%buffer_ids(i))%write_buffer(fms2io_fileobj) else + if (.not. buffer_obj(diag_file%buffer_ids(i))%is_there_data_to_write()) then + ! Only print the error message once + if (diag_file%unlim_dimension_level .eq. 1) & + call mpp_error(NOTE, "Send data was never called. Writing fill values for variable "//& + field_obj(field_id)%get_varname()//" in mod "//field_obj(field_id)%get_modname()) + cycle + endif call buffer_obj(diag_file%buffer_ids(i))%write_buffer(fms2io_fileobj, & unlim_dim_level=diag_file%unlim_dimension_level) endif @@ -1386,6 +1393,8 @@ subroutine write_field_metadata(this, diag_field, diag_axis) integer :: i !< For do loops logical :: is_regional !< Flag indicating if the field is in a regional file character(len=255) :: cell_measures !< cell_measures attributes for the field + logical :: need_associated_files !< .True. if the 'associated_files' global attribute is needed + character(len=255) :: associated_files !< Associated files attribute to add is_regional = this%is_regional() @@ -1396,19 +1405,38 @@ subroutine write_field_metadata(this, diag_field, diag_axis) if (.not. diag_file%field_registered(i)) cycle !TODO do something else here field_ptr => diag_field(diag_file%field_ids(i)) - !TODO I think if the area and the volume field are no in the same file, a global attribute containing the - !the file that the fields are in needs to be added cell_measures = "" + associated_files = "" + need_associated_files = .false. if (field_ptr%has_area()) then cell_measures = "area: "//diag_field(field_ptr%get_area())%get_varname(to_write=.true.) + + !! Determine if the area field is already in the file. If it is not create the "associated_files" attribute + !! which contains the file name of the file the area field is in. This is needed for PP/fregrid. + if (.not. diag_field(field_ptr%get_area())%is_variable_in_file(diag_file%id)) then + need_associated_files = .true. + associated_files = "area: "//diag_field(field_ptr%get_area())%get_field_file_name()//".nc" + endif endif if (field_ptr%has_volume()) then cell_measures = trim(cell_measures)//" volume: "//diag_field(field_ptr%get_volume())%get_varname(to_write=.true.) + + !! Determine if the volume field is already in the file. If it is not create the "associated_files" attribute + !! which contains the file name of the file the volume field is in. This is needed for PP/fregrid. + if (.not. diag_field(field_ptr%get_volume())%is_variable_in_file(diag_file%id)) then + need_associated_files = .true. + associated_files = trim(associated_files)//& + " volume:"//diag_field(field_ptr%get_volume())%get_field_file_name()//".nc" + endif endif call field_ptr%write_field_metadata(fms2io_fileobj, diag_file%id, diag_file%yaml_ids(i), diag_axis, & this%FMS_diag_file%get_file_unlimdim(), is_regional, cell_measures) + + if (need_associated_files) & + call register_global_attribute(fms2io_fileobj, "associated_files", trim(ADJUSTL(associated_files)), & + str_len=len_trim(ADJUSTL(associated_files))) enddo end subroutine write_field_metadata diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 4d88d6a24..8f513c1e6 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -775,8 +775,12 @@ subroutine fms_diag_do_io(this, is_end_of_run) ! loop through the buffers and finish reduction if needed buff_loop: do ibuff=1, SIZE(buff_ids) diag_buff => this%FMS_diag_output_buffers(buff_ids(ibuff)) - field_yaml => diag_yaml%get_diag_field_from_id(diag_buff%get_yaml_id()) + field_yaml => diag_yaml%diag_fields(diag_buff%get_yaml_id()) diag_field => this%FMS_diag_fields(diag_buff%get_field_id()) + + ! Go away if there is no data to write + if (.not. diag_buff%is_there_data_to_write()) cycle + ! sets missing value mval = diag_field%find_missing_value(missing_val) ! time_average and greater values all involve averaging so need to be "finished" before written @@ -899,6 +903,8 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight !< Go away if finished doing math for this buffer if (buffer_ptr%is_done_with_math()) cycle + call buffer_ptr%set_send_data_called() + bounds_out = bounds if (.not. using_blocking) then !< Set output bounds to start at 1:size(buffer_ptr%buffer) @@ -1045,6 +1051,7 @@ subroutine fms_diag_axis_add_attribute(this, axis_id, att_name, att_value) class(*), intent(in) :: att_value(:) !< The attribute value to add character(len=20) :: axis_names(2) !< Names of the uncompress axis + character(len=20) :: set_name !< Name of the axis set integer :: uncmx_ids(2) !< Ids of the uncompress axis integer :: j !< For do loops #ifndef use_yaml @@ -1067,8 +1074,10 @@ subroutine fms_diag_axis_add_attribute(this, axis_id, att_name, att_value) !! and the ids of the axis and add it to the axis object so it can be written to netcdf files !! that use this axis axis_names = parse_compress_att(att_value) + set_name = "" + if (axis%has_set_name()) set_name = axis%get_set_name() do j = 1, size(axis_names) - uncmx_ids(j) = get_axis_id_from_name(axis_names(j), this%diag_axis, this%registered_axis) + uncmx_ids(j) = get_axis_id_from_name(axis_names(j), this%diag_axis, this%registered_axis, set_name) if (uncmx_ids(j) .eq. diag_null) call mpp_error(FATAL, & &"Error parsing the compress attribute for axis: "//trim(axis%get_axis_name())//& &". Be sure that the axes in the compress attribute are registered") diff --git a/diag_manager/fms_diag_output_buffer.F90 b/diag_manager/fms_diag_output_buffer.F90 index eed366bee..96163e30a 100644 --- a/diag_manager/fms_diag_output_buffer.F90 +++ b/diag_manager/fms_diag_output_buffer.F90 @@ -54,6 +54,7 @@ module fms_diag_output_buffer_mod integer :: field_id !< The id of the field the buffer belongs to integer :: yaml_id !< The id of the yaml id the buffer belongs to logical :: done_with_math !< .True. if done doing the math + logical :: send_data_called !< .True. if send_data has been called type(time_type) :: time !< The last time the data was received contains @@ -65,6 +66,8 @@ module fms_diag_output_buffer_mod procedure :: get_yaml_id procedure :: init_buffer_time procedure :: update_buffer_time + procedure :: is_there_data_to_write + procedure :: set_send_data_called procedure :: is_done_with_math procedure :: set_done_with_math procedure :: write_buffer @@ -180,6 +183,7 @@ subroutine allocate_buffer(this, buff_type, ndim, buff_sizes, field_name, diurna allocate(this%num_elements(n_samples)) this%num_elements = 0 this%done_with_math = .false. + this%send_data_called = .false. allocate(this%buffer_dims(5)) this%buffer_dims(1) = buff_sizes(1) this%buffer_dims(2) = buff_sizes(2) @@ -658,5 +662,22 @@ pure function get_buffer_dims(this) get_buffer_dims = this%buffer_dims(1:4) end function +!> @brief Determine if there is any data to write (i.e send_data has been called) +!! @return .true. if there is data to write +function is_there_data_to_write(this) & + result(res) + class(fmsDiagOutputBuffer_type), intent(inout) :: this !< Buffer object + + logical :: res + + res = this%send_data_called +end function + +!> @brief Sets send_data_called to .true. +subroutine set_send_data_called(this) + class(fmsDiagOutputBuffer_type), intent(inout) :: this !< Buffer object + + this%send_data_called = .true. +end subroutine set_send_data_called #endif end module fms_diag_output_buffer_mod diff --git a/test_fms/diag_manager/check_time_avg.F90 b/test_fms/diag_manager/check_time_avg.F90 index 6a1d52753..e729619f7 100644 --- a/test_fms/diag_manager/check_time_avg.F90 +++ b/test_fms/diag_manager/check_time_avg.F90 @@ -78,6 +78,12 @@ program check_time_avg call read_data(fileobj, "var0_avg", cdata_out(1,1,1,1), unlim_dim_level=ti) call check_data_0d(cdata_out(1,1,1,1), ti) + cdata_out = -999_r4_kind + print *, "Checking answers for IOnASphere - time_level:", string(ti) + call read_data(fileobj, "IOnASphere", cdata_out(1,1,1,1), unlim_dim_level=ti) + if (cdata_out(1,1,1,1) .ne. -666._r4_kind) & + call mpp_error(FATAL, "IOnASphere is not set to the expected value (_FillVal)") + cdata_out = -999_r4_kind print *, "Checking answers for var1_avg - time_level:", string(ti) call read_data(fileobj, "var1_avg", cdata_out(:,1,1,1), unlim_dim_level=ti) diff --git a/test_fms/diag_manager/test_modern_diag.F90 b/test_fms/diag_manager/test_modern_diag.F90 index b39eb4459..f32b5c5da 100644 --- a/test_fms/diag_manager/test_modern_diag.F90 +++ b/test_fms/diag_manager/test_modern_diag.F90 @@ -124,8 +124,8 @@ program test_modern_diag Time = set_date(2,1,1,0,0,0) ! Register the diags axis -id_x = diag_axis_init('x', x, 'point_E', 'x', long_name='point_E', Domain2=Domain) -id_y = diag_axis_init('y', y, 'point_N', 'y', long_name='point_N', Domain2=Domain) +id_x = diag_axis_init('x', x, 'point_E', 'x', long_name='point_E', Domain2=Domain, set_name="land") +id_y = diag_axis_init('y', y, 'point_N', 'y', long_name='point_N', Domain2=Domain, set_name="land") id_x3 = diag_axis_init('x3', x, 'point_E', 'x', Domain2=Domain_cube_sph) id_y3 = diag_axis_init('y3', y, 'point_E', 'y', Domain2=Domain_cube_sph) diff --git a/test_fms/diag_manager/test_reduction_methods.F90 b/test_fms/diag_manager/test_reduction_methods.F90 index d47d21895..a3a20f909 100644 --- a/test_fms/diag_manager/test_reduction_methods.F90 +++ b/test_fms/diag_manager/test_reduction_methods.F90 @@ -63,6 +63,7 @@ program test_reduction_methods integer :: id_var2 !< diag_field id for 2d var integer :: id_var3 !< diag_field id for 3d var integer :: id_var4 !< diag_field id for 4d var + integer :: id_var999 !< diag_field id for a var that send_data is not called for integer :: io_status !< Status after reading the namelist type(block_control_type) :: my_block !< Returns instantiated @ref block_control_type logical :: message !< Flag for outputting debug message @@ -169,6 +170,7 @@ program test_reduction_methods 'mullions', missing_value = missing_value) id_var4 = register_diag_field ('ocn_mod', 'var4', (/id_x, id_y, id_z, id_w/), Time, 'Var4d', & 'mullions', missing_value = missing_value) + id_var999 = register_diag_field ('ocn_mod', 'IOnASphere', Time, missing_value=missing_value) !< Get the data domain indices (1 based) isd1 = isc-isd+1 diff --git a/test_fms/diag_manager/test_time_avg.sh b/test_fms/diag_manager/test_time_avg.sh index 7c9752231..bc9c6601b 100755 --- a/test_fms/diag_manager/test_time_avg.sh +++ b/test_fms/diag_manager/test_time_avg.sh @@ -66,6 +66,10 @@ diag_files: reduction: average zbounds: 2. 3. kind: r4 + - module: ocn_mod + var_name: IOnASphere + reduction: average + kind: r4 - file_name: test_avg_regional time_units: hours unlimdim: time