Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Modern Diag Manager:: Repro fixes #1435

Merged
merged 7 commits into from
Jan 18, 2024
36 changes: 33 additions & 3 deletions diag_manager/fms_diag_axis_object.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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) &
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
28 changes: 27 additions & 1 deletion diag_manager/fms_diag_field_object.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
34 changes: 31 additions & 3 deletions diag_manager/fms_diag_file_object.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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()

Expand All @@ -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
Expand Down
13 changes: 11 additions & 2 deletions diag_manager/fms_diag_object.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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")
Expand Down
21 changes: 21 additions & 0 deletions diag_manager/fms_diag_output_buffer.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
6 changes: 6 additions & 0 deletions test_fms/diag_manager/check_time_avg.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
4 changes: 2 additions & 2 deletions test_fms/diag_manager/test_modern_diag.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 2 additions & 0 deletions test_fms/diag_manager/test_reduction_methods.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 4 additions & 0 deletions test_fms/diag_manager/test_time_avg.sh
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading