From cfed13988a52444847e8c5be70b014363b557483 Mon Sep 17 00:00:00 2001 From: uramirez8707 <49168881+uramirez8707@users.noreply.github.com> Date: Fri, 8 Sep 2023 09:13:21 -0400 Subject: [PATCH] modern_diag_manager: Update output_buffer_obj (#1354) * Add some needed members to the buffer obj, restructure the init_buffer routine to match the old diag manager, adjust tests, add a flag that indicates when done writing data to the diag_file, set output buffers to fill value if masked * inits done_with_math --- diag_manager/Makefile.am | 2 +- diag_manager/fms_diag_file_object.F90 | 21 +++- diag_manager/fms_diag_object.F90 | 69 ++++++----- diag_manager/fms_diag_output_buffer.F90 | 109 ++++++++++++------ .../include/fms_diag_reduction_methods.inc | 8 +- test_fms/diag_manager/test_diag_buffer.F90 | 18 +-- 6 files changed, 139 insertions(+), 88 deletions(-) diff --git a/diag_manager/Makefile.am b/diag_manager/Makefile.am index 024f9316e8..3e15f9b24a 100644 --- a/diag_manager/Makefile.am +++ b/diag_manager/Makefile.am @@ -104,7 +104,7 @@ diag_manager_mod.$(FC_MODEXT): diag_axis_mod.$(FC_MODEXT) diag_data_mod.$(FC_MOD fms_diag_time_reduction_mod.$(FC_MODEXT) fms_diag_outfield_mod.$(FC_MODEXT) \ fms_diag_fieldbuff_update_mod.$(FC_MODEXT) fms_diag_output_buffer_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) \ - fms_diag_reduction_methods_mod.$(FC_MODEXT) + fms_diag_reduction_methods_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT) fms_diag_reduction_methods_mod.$(FC_MODEXT): fms_diag_bbox_mod.$(FC_MODEXT) fms_diag_output_buffer_mod.$(FC_MODEXT) \ diag_data_mod.$(FC_MODEXT) diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index e2c05da68f..b33b9d0431 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -67,6 +67,10 @@ module fms_diag_file_object_mod TYPE(time_type) :: next_output !< Time of the next write TYPE(time_type) :: next_next_output !< Time of the next next write TYPE(time_type) :: no_more_data !< Time to stop receiving data for this file + logical :: done_writing_data!< Set to .True. if finished writing data + !! This is be initialized to .false. and set to true for + !! static files after the first write and for + !! files that are using the file_duration functionality !< This will be used when using the new_file_freq keys in the diag_table.yaml TYPE(time_type) :: next_close !< Time to close the file @@ -129,6 +133,7 @@ module fms_diag_file_object_mod procedure, public :: get_file_duration_units procedure, public :: get_file_varlist procedure, public :: get_file_global_meta + procedure, public :: is_done_writing_data procedure, public :: has_file_fname procedure, public :: has_file_frequnit procedure, public :: has_file_freq @@ -233,6 +238,7 @@ logical function fms_diag_files_object_init (files_array) obj%number_of_axis = 0 !> Set the start_time of the file to the base_time and set up the *_output variables + obj%done_writing_data = .false. obj%start_time = get_base_time() obj%last_output = get_base_time() obj%next_output = diag_time_inc(obj%start_time, obj%get_file_freq(), obj%get_file_frequnit()) @@ -559,6 +565,14 @@ pure function get_file_global_meta (this) result(res) res = this%diag_yaml_file%get_file_global_meta() end function get_file_global_meta +!> \brief Determines if done writing data +!! \return .True. if done writing data +pure function is_done_writing_data (this) result(res) + class(fmsDiagFile_type), intent(in) :: this !< The file object + logical :: res + res = this%done_writing_data +end function is_done_writing_data + !> \brief Checks if file_fname is allocated in the yaml object !! \return true if file_fname is allocated pure function has_file_fname (this) result(res) @@ -1122,9 +1136,9 @@ end subroutine write_time_metadata !> \brief Write out the field data to the file subroutine write_field_data(this, field_obj, buffer_obj) - class(fmsDiagFileContainer_type), intent(in), target :: this !< The diag file object to write to - type(fmsDiagField_type), intent(in), target :: field_obj(:) !< The field object to write from - type(fmsDiagOutputBuffer_type), intent(in), target :: buffer_obj(:) !< The buffer object with the data + class(fmsDiagFileContainer_type), intent(in), target :: this !< The diag file object to write to + type(fmsDiagField_type), intent(in), target :: field_obj(:) !< The field object to write from + type(fmsDiagOutputBuffer_type), intent(inout), target :: buffer_obj(:) !< The buffer object with the data class(fmsDiagFile_type), pointer :: diag_file !< Diag_file object to open class(FmsNetcdfFile_t), pointer :: fms2io_fileobj !< Fileobj to write to @@ -1261,6 +1275,7 @@ subroutine update_current_new_file_freq_index(this, time_step) diag_file%get_file_duration_units()) else !< At this point you are done writing data + diag_file%done_writing_data = .true. diag_file%no_more_data = diag_time_inc(diag_file%no_more_data, VERY_LARGE_FILE_FREQ, DIAG_DAYS) diag_file%next_output = diag_file%no_more_data diag_file%next_next_output = diag_file%no_more_data diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 907f0c6613..0a3953a8bb 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -22,7 +22,7 @@ module fms_diag_object_mod &DIAG_FIELD_NOT_FOUND, diag_not_registered, max_axes, TWO_D_DOMAIN, & &get_base_time, NULL_AXIS_ID, get_var_type, diag_not_registered, & &time_none, time_max, time_min, time_sum, time_average, time_diurnal, & - &time_power, time_rms + &time_power, time_rms, r8 USE time_manager_mod, ONLY: set_time, set_date, get_time, time_type, OPERATOR(>=), OPERATOR(>),& & OPERATOR(<), OPERATOR(==), OPERATOR(/=), OPERATOR(/), OPERATOR(+), ASSIGNMENT(=), get_date, & @@ -199,8 +199,9 @@ integer function fms_register_diag_field_obj & LOGICAL, OPTIONAL, INTENT(in) :: static !< True if the variable is static #ifdef use_yaml - class (fmsDiagFile_type), pointer :: fileptr => null() !< Pointer to the diag_file - class (fmsDiagField_type), pointer :: fieldptr => null() !< Pointer to the diag_field + class (fmsDiagFile_type), pointer :: fileptr !< Pointer to the diag_file + class (fmsDiagField_type), pointer :: fieldptr !< Pointer to the diag_field + class (fmsDiagOutputBuffer_type), pointer :: bufferptr !< Pointer to the output buffer integer, allocatable :: file_ids(:) !< The file IDs for this variable integer :: i !< For do loops integer, allocatable :: diag_field_indices(:) !< indices where the field was found in the yaml @@ -225,13 +226,17 @@ integer function fms_register_diag_field_obj & !> Use pointers for convenience fieldptr => this%FMS_diag_fields(this%registered_variables) +!> Get the file IDs from the field indicies from the yaml + file_ids = get_diag_files_id(diag_field_indices) + call fieldptr%set_file_ids(file_ids) !> Initialize buffer_ids of this field with the diag_field_indices(diag_field_indices) !! of the sorted variable list fieldptr%buffer_ids = get_diag_field_ids(diag_field_indices) do i = 1, size(fieldptr%buffer_ids) - call this%FMS_diag_output_buffers(fieldptr%buffer_ids(i))%set_field_id(this%registered_variables) - call this%FMS_diag_output_buffers(fieldptr%buffer_ids(i))%set_yaml_id(fieldptr%buffer_ids(i)) + bufferptr => this%FMS_diag_output_buffers(fieldptr%buffer_ids(i)) + call bufferptr%set_field_id(this%registered_variables) + call bufferptr%set_yaml_id(fieldptr%buffer_ids(i)) enddo !> Allocate and initialize member buffer_allocated of this field @@ -243,9 +248,7 @@ integer function fms_register_diag_field_obj & mask_variant= mask_variant, standname=standname, do_not_log=do_not_log, err_msg=err_msg, & interp_method=interp_method, tile_count=tile_count, area=area, volume=volume, realm=realm, & static=static) -!> Get the file IDs from the field indicies from the yaml - file_ids = get_diag_files_id(diag_field_indices) - call fieldptr%set_file_ids(file_ids) + !> Add the axis information, initial time, and field IDs to the files if (present(axes) .and. present(init_time)) then do i = 1, size(file_ids) @@ -734,7 +737,7 @@ end subroutine fms_diag_do_io function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight, & bounds, using_blocking, time) & result(error_msg) - class(fmsDiagObject_type), intent(in), target :: this !< Diag Object + class(fmsDiagObject_type), intent(inout), target:: this !< Diag Object class(*), intent(in) :: field_data(:,:,:,:) !< Field data integer, intent(in) :: diag_field_id !< ID of the input field logical, intent(in), target :: oor_mask(:,:,:,:) !< mask @@ -770,9 +773,22 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight logical :: block_in_subregion !< .True. if the current block is part of the subregion integer :: starting !< Starting index of the subregion relative to the compute domain integer :: ending !< Ending index of the subregion relative to the compute domain + real(kind=r8_kind) :: missing_value !< Missing_value for data points that are masked + !! This will obtained as r8 and converted to the right type as + !! needed. This is to avoid yet another select type ... !TODO mostly everything field_ptr => this%FMS_diag_fields(diag_field_id) + if (field_ptr%has_missing_value()) then + select type (missing_val => field_ptr%get_missing_value(r8)) + type is (real(kind=r8_kind)) + missing_value = missing_val + class default + call mpp_error(FATAl, "The missing value for the field:"//trim(field_ptr%get_varname())//& + &" was not allocated to the correct type. This shouldn't have happened") + end select + endif + buffer_loop: do ids = 1, size(field_ptr%buffer_ids) error_msg = "" buffer_id = this%FMS_diag_fields(diag_field_id)%buffer_ids(ids) @@ -786,6 +802,9 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight !< Go away if the file is a subregional file and the current PE does not have any data for it if (.not. file_ptr%writing_on_this_pe()) cycle + !< Go away if finished doing math for this buffer + if (buffer_ptr%is_done_with_math()) cycle + bounds_out = bounds if (.not. using_blocking) then !< Set output bounds to start at 1:size(buffer_ptr%buffer) @@ -843,7 +862,7 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight reduction_method = field_yaml_ptr%get_var_reduction() select case(reduction_method) case (time_none) - error_msg = buffer_ptr%do_time_none_wrapper(field_data, oor_mask, bounds_in, bounds_out) + error_msg = buffer_ptr%do_time_none_wrapper(field_data, oor_mask, bounds_in, bounds_out, missing_value) if (trim(error_msg) .ne. "") then return endif @@ -858,6 +877,10 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight error_msg = "The reduction method is not supported. "//& "Only none, min, max, sum, average, power, rms, and diurnal are supported." end select + + if (field_ptr%is_static() .or. file_ptr%FMS_diag_file%is_done_writing_data()) then + call buffer_ptr%set_done_with_math() + endif enddo buffer_loop #else error_msg = "" @@ -1151,7 +1174,6 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) class(DiagYamlFilesVar_type), pointer :: ptr_diag_field_yaml !< Pointer to a field from yaml fields integer, allocatable :: axis_ids(:) !< Pointer to indices of axes of the field variable integer :: var_type !< Stores type of the field data (r4, r8, i4, i8, and string) represented as an integer. - class(*), allocatable :: missing_value !< Missing value to initialize the data to character(len=128), allocatable :: var_name !< Field name to initialize output buffers logical :: is_scalar !< Flag indicating that the variable is a scalar integer :: yaml_id !< Yaml id for the buffer @@ -1165,29 +1187,6 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) ! Get variable/field name var_name = this%Fms_diag_fields(field_id)%get_varname() - ! Get missing value for the field - !TODO class (*) is weird missing_value = this%FMS_diag_fields(field_id)%get_missing_value(var_type) - !!should work ... - if (this%FMS_diag_fields(field_id)%has_missing_value()) then - select type (my_type => this%FMS_diag_fields(field_id)%get_missing_value(var_type)) - type is (real(kind=r4_kind)) - missing_value = real(my_type, kind=r4_kind) - type is (real(kind=r8_kind)) - missing_value = real(my_type, kind=r8_kind) - class default - call mpp_error( FATAL, 'fms_diag_object_mod:allocate_diag_field_output_buffers Invalid type') - end select - else - select type (my_type => get_default_missing_value(var_type)) - type is (real(kind=r4_kind)) - missing_value = real(my_type, kind=r4_kind) - type is (real(kind=r8_kind)) - missing_value = real(my_type, kind=r8_kind) - class default - call mpp_error( FATAL, 'fms_diag_object_mod:allocate_diag_field_output_buffers Invalid type') - end select - endif - ! Determine dimensions of the field is_scalar = this%FMS_diag_fields(field_id)%is_scalar() @@ -1223,7 +1222,7 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) ptr_diag_buffer_obj => this%FMS_diag_output_buffers(buffer_id) call ptr_diag_buffer_obj%allocate_buffer(field_data(1, 1, 1, 1), ndims, axes_length(1:5), & this%FMS_diag_fields(field_id)%get_varname(), num_diurnal_samples) - call ptr_diag_buffer_obj%initialize_buffer(missing_value, var_name) + call ptr_diag_buffer_obj%initialize_buffer(ptr_diag_field_yaml%get_var_reduction(), var_name) if (allocated(axis_ids)) deallocate(axis_ids) enddo diff --git a/diag_manager/fms_diag_output_buffer.F90 b/diag_manager/fms_diag_output_buffer.F90 index 6c284812cd..e17d9ec909 100644 --- a/diag_manager/fms_diag_output_buffer.F90 +++ b/diag_manager/fms_diag_output_buffer.F90 @@ -27,13 +27,15 @@ module fms_diag_output_buffer_mod #ifdef use_yaml use platform_mod use iso_c_binding -use time_manager_mod, only: time_type +use time_manager_mod, only: time_type, operator(==) use mpp_mod, only: mpp_error, FATAL -use diag_data_mod, only: DIAG_NULL, DIAG_NOT_REGISTERED, i4, i8, r4, r8 +use diag_data_mod, only: DIAG_NULL, DIAG_NOT_REGISTERED, i4, i8, r4, r8, get_base_time, MIN_VALUE, MAX_VALUE, EMPTY, & + time_min, time_max use fms2_io_mod, only: FmsNetcdfFile_t, write_data, FmsNetcdfDomainFile_t, FmsNetcdfUnstructuredDomainFile_t use fms_diag_yaml_mod, only: diag_yaml use fms_diag_bbox_mod, only: fmsDiagIbounds_type use fms_diag_reduction_methods_mod, only: do_time_none +use fms_diag_time_utils_mod, only: diag_time_inc implicit none @@ -53,6 +55,7 @@ module fms_diag_output_buffer_mod integer, allocatable :: axis_ids(:) !< Axis ids for the buffer 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 contains procedure :: add_axis_ids @@ -61,6 +64,8 @@ module fms_diag_output_buffer_mod procedure :: get_field_id procedure :: set_yaml_id procedure :: get_yaml_id + procedure :: is_done_with_math + procedure :: set_done_with_math procedure :: write_buffer !! These are needed because otherwise the write_data calls will go into the wrong interface procedure :: write_buffer_wrapper_netcdf @@ -188,6 +193,7 @@ subroutine allocate_buffer(this, buff_type, ndim, buff_sizes, field_name, diurna allocate(this%num_elements(n_samples)) this%num_elements = 0 this%count_0d = 0 + this%done_with_math = .false. allocate(this%buffer_dims(5)) this%buffer_dims(1) = buff_sizes(1) this%buffer_dims(2) = buff_sizes(2) @@ -233,47 +239,51 @@ subroutine get_buffer (this, buff_out, field_name) end select end subroutine -!> @brief Initializes a buffer to a given fill value. -subroutine initialize_buffer (this, fillval, field_name) - class(fmsDiagOutputBuffer_type), intent(inout) :: this !< allocated 5D buffer object - class(*), intent(in) :: fillval !< fill value, must be same type as the allocated buffer - character(len=*), intent(in) :: field_name !< field name for error output +!> @brief Initializes a buffer based on the reduction method +subroutine initialize_buffer (this, reduction_method, field_name) + class(fmsDiagOutputBuffer_type), intent(inout) :: this !< allocated 5D buffer object + integer, intent(in) :: reduction_method !< The reduction method for the field + character(len=*), intent(in) :: field_name !< field name for error output if(.not. allocated(this%buffer)) call mpp_error(FATAL, 'initialize_buffer: field:'// field_name // & 'buffer not yet allocated, allocate_buffer() must be called on this object first.') - ! have to check fill value and buffer types match + select type(buff => this%buffer) type is(real(r8_kind)) - select type(fillval) - type is(real(r8_kind)) - buff = fillval - class default - call mpp_error(FATAL, 'initialize_buffer: fillval does not match up with allocated buffer type(r8_kind)' // & - ' for field' // field_name ) + select case (reduction_method) + case (time_min) + buff = real(MIN_VALUE, kind=r8_kind) + case (time_max) + buff = real(MAX_VALUE, kind=r8_kind) + case default + buff = real(EMPTY, kind=r8_kind) end select type is(real(r4_kind)) - select type(fillval) - type is(real(r4_kind)) - buff = fillval - class default - call mpp_error(FATAL, 'initialize_buffer: fillval does not match up with allocated buffer type(r4_kind)' // & - ' for field' // field_name ) + select case (reduction_method) + case (time_min) + buff = real(MIN_VALUE, kind=r4_kind) + case (time_max) + buff = real(MAX_VALUE, kind=r4_kind) + case default + buff = real(EMPTY, kind=r4_kind) end select type is(integer(i8_kind)) - select type(fillval) - type is(integer(i8_kind)) - buff = fillval - class default - call mpp_error(FATAL, 'initialize_buffer: fillval does not match up with allocated buffer type(i8_kind)' // & - ' for field' // field_name ) + select case (reduction_method) + case (time_min) + buff = int(MIN_VALUE, kind=i8_kind) + case (time_max) + buff = int(MAX_VALUE, kind=i8_kind) + case default + buff = int(EMPTY, kind=i8_kind) end select type is(integer(i4_kind)) - select type(fillval) - type is(integer(i4_kind)) - buff = fillval - class default - call mpp_error(FATAL, 'initialize_buffer: fillval does not match up with allocated buffer type(i4_kind)' // & - ' for field' // field_name ) + select case (reduction_method) + case (time_min) + buff = int(MIN_VALUE, kind=i4_kind) + case (time_max) + buff = int(MAX_VALUE, kind=i4_kind) + case default + buff = int(EMPTY, kind=i4_kind) end select class default call mpp_error(FATAL, 'initialize buffer_5d: buffer allocated to invalid data type, this shouldnt happen') @@ -331,6 +341,24 @@ subroutine set_yaml_id(this, yaml_id) this%yaml_id = yaml_id end subroutine set_yaml_id +!> @brief Determine if finished with math +!! @return this%done_with_math +function is_done_with_math(this) & + result(res) + class(fmsDiagOutputBuffer_type), intent(in) :: this !< Buffer object + logical :: res + + res = this%done_with_math +end function is_done_with_math + +!> @brief Set done_with_math to .true. +subroutine set_done_with_math(this) + class(fmsDiagOutputBuffer_type), intent(inout) :: this !< Buffer object + integer :: res + + this%done_with_math = .true. +end subroutine set_done_with_math + !> @brief Get the yaml id of the buffer !! @return the yaml id of the buffer function get_yaml_id(this) & @@ -344,9 +372,9 @@ end function get_yaml_id !> @brief Write the buffer to the file subroutine write_buffer(this, fms2io_fileobj, unlim_dim_level) - class(fmsDiagOutputBuffer_type), intent(in) :: this !< buffer object to write - class(FmsNetcdfFile_t), intent(in) :: fms2io_fileobj !< fileobj to write to - integer, optional, intent(in) :: unlim_dim_level !< unlimited dimension + class(fmsDiagOutputBuffer_type), intent(inout) :: this !< buffer object to write + class(FmsNetcdfFile_t), intent(in) :: fms2io_fileobj !< fileobj to write to + integer, optional, intent(in) :: unlim_dim_level !< unlimited dimension select type(fms2io_fileobj) type is (FmsNetcdfFile_t) @@ -359,6 +387,10 @@ subroutine write_buffer(this, fms2io_fileobj, unlim_dim_level) call mpp_error(FATAL, "The file "//trim(fms2io_fileobj%path)//" is not one of the accepted types"//& " only FmsNetcdfFile_t, FmsNetcdfDomainFile_t, and FmsNetcdfUnstructuredDomainFile_t are accepted.") end select + + call this%initialize_buffer(diag_yaml%diag_fields(this%yaml_id)%get_var_reduction(), & + diag_yaml%diag_fields(this%yaml_id)%get_var_outname()) + !TODO Set the counters back to 0 end subroutine write_buffer !> @brief Write the buffer to the FmsNetcdfFile_t fms2io_fileobj @@ -438,13 +470,14 @@ end subroutine write_buffer_wrapper_u !> @brief Does the time_none reduction method on the buffer object !! @return Error message if the math was not successful -function do_time_none_wrapper(this, field_data, mask, bounds_in, bounds_out) & +function do_time_none_wrapper(this, field_data, mask, bounds_in, bounds_out, missing_value) & result(err_msg) class(fmsDiagOutputBuffer_type), intent(inout) :: this !< buffer object to write class(*), intent(in) :: field_data(:,:,:,:) !< Buffer data for current time type(fmsDiagIbounds_type), intent(in) :: bounds_in !< Indicies for the buffer passed in type(fmsDiagIbounds_type), intent(in) :: bounds_out !< Indicies for the output buffer logical, intent(in) :: mask(:,:,:,:) !< Mask for the field + real(kind=r8_kind), intent(in) :: missing_value !< Missing_value for data points that are masked character(len=50) :: err_msg !TODO This does not need to be done for every time step @@ -454,14 +487,14 @@ function do_time_none_wrapper(this, field_data, mask, bounds_in, bounds_out) & type is (real(kind=r8_kind)) select type (field_data) type is (real(kind=r8_kind)) - call do_time_none(output_buffer, field_data, mask, bounds_in, bounds_out) + call do_time_none(output_buffer, field_data, mask, bounds_in, bounds_out, missing_value) class default err_msg="the output buffer and the buffer send in are not of the same type (r8_kind)" end select type is (real(kind=r4_kind)) select type (field_data) type is (real(kind=r4_kind)) - call do_time_none(output_buffer, field_data, mask, bounds_in, bounds_out) + call do_time_none(output_buffer, field_data, mask, bounds_in, bounds_out, real(missing_value, kind=r4_kind)) class default err_msg="the output buffer and the buffer send in are not of the same type (r4_kind)" end select diff --git a/diag_manager/include/fms_diag_reduction_methods.inc b/diag_manager/include/fms_diag_reduction_methods.inc index 0d6633285b..ddb6b8c926 100644 --- a/diag_manager/include/fms_diag_reduction_methods.inc +++ b/diag_manager/include/fms_diag_reduction_methods.inc @@ -18,7 +18,7 @@ !*********************************************************************** !> @brief Do the time_none reduction method (i.e copy the correct portion of the input data) -subroutine DO_TIME_NONE_ (data_out, data_in, mask, bounds_in, bounds_out) +subroutine DO_TIME_NONE_ (data_out, data_in, mask, bounds_in, bounds_out, missing_value) real(FMS_TRM_KIND_), intent(inout) :: data_out(:,:,:,:,:) !< output data real(FMS_TRM_KIND_), intent(in) :: data_in(:,:,:,:) !< data to update the buffer with logical, intent(in) :: mask(:,:,:,:) !< mask @@ -26,6 +26,7 @@ subroutine DO_TIME_NONE_ (data_out, data_in, mask, bounds_in, bounds_out) !! of the input buffer type(fmsDiagIbounds_type), intent(in) :: bounds_out !< indices indicating the correct portion !! of the output buffer + real(FMS_TRM_KIND_), intent(in) :: missing_value !< Missing_value for data points that are masked integer :: is_in, ie_in, js_in, je_in, ks_in, ke_in !< Starting and ending indices of each dimention for !! the input buffer @@ -46,8 +47,11 @@ subroutine DO_TIME_NONE_ (data_out, data_in, mask, bounds_in, bounds_out) ks_in = bounds_in%get_kmin() ke_in = bounds_in%get_kmax() - where (mask(is_in:ie_in, js_in:je_in, ks_in:ke_in, :)) & + where (mask(is_in:ie_in, js_in:je_in, ks_in:ke_in, :)) data_out(is_out:ie_out, js_out:je_out, ks_out:ke_out, :, 1) = & data_in(is_in:ie_in, js_in:je_in, ks_in:ke_in, :) + elsewhere + data_out(is_out:ie_out, js_out:je_out, ks_out:ke_out, :, 1) = missing_value + end where end subroutine DO_TIME_NONE_ \ No newline at end of file diff --git a/test_fms/diag_manager/test_diag_buffer.F90 b/test_fms/diag_manager/test_diag_buffer.F90 index e339e9055e..bdaaa10c9d 100644 --- a/test_fms/diag_manager/test_diag_buffer.F90 +++ b/test_fms/diag_manager/test_diag_buffer.F90 @@ -25,7 +25,7 @@ program test_diag_buffer use platform_mod, only: r8_kind, r4_kind, i8_kind, i4_kind use fms_mod, only: string, fms_init, fms_end use mpp_mod, only: mpp_error, FATAL - use diag_data_mod, only: i4, i8, r4, r8 + use diag_data_mod, only: i4, i8, r4, r8, time_none, EMPTY implicit none @@ -46,11 +46,11 @@ program test_diag_buffer do i=0, 5 if (i < 5) buff_sizes(i+1) = i+5 call buffobj(i+1)%allocate_buffer(r8_data, i, buff_sizes, fname) - call buffobj(i+1)%initialize_buffer( real(i, kind=r8_kind) , fname) + call buffobj(i+1)%initialize_buffer(time_none, fname) call buffobj(i+1)%get_buffer(p_val, fname) select type(p_val) type is (real(kind=r8_kind)) - if (any(p_val .ne. real(i, kind=r8_kind))) & + if (any(p_val .ne. real(EMPTY, kind=r8_kind))) & call mpp_error(FATAL, "r8_buffer:: The "//string(i)//"d buffer was not initialized to the correct value") do j = 1, 5 if (size(p_val, j) .ne. buff_sizes(j)) & @@ -68,11 +68,11 @@ program test_diag_buffer do i=0, 5 if (i < 5) buff_sizes(i+1) = i+5 call buffobj(i+1)%allocate_buffer(r4_data, i, buff_sizes, fname) - call buffobj(i+1)%initialize_buffer( real(i, kind=r4_kind) , fname) + call buffobj(i+1)%initialize_buffer(time_none, fname) call buffobj(i+1)%get_buffer(p_val, fname) select type(p_val) type is (real(kind=r4_kind)) - if (any(p_val .ne. real(i, kind=r4_kind))) & + if (any(p_val .ne. real(EMPTY, kind=r4_kind))) & call mpp_error(FATAL, "r4_buffer:: The "//string(i)//"d buffer was not initialized to the correct value") do j = 1, 5 if (size(p_val, j) .ne. buff_sizes(j)) & @@ -90,11 +90,11 @@ program test_diag_buffer do i=0, 5 if (i < 5) buff_sizes(i+1) = i+5 call buffobj(i+1)%allocate_buffer(i8_data, i, buff_sizes, fname) - call buffobj(i+1)%initialize_buffer( int(i, kind=i8_kind) , fname) + call buffobj(i+1)%initialize_buffer(time_none, fname) call buffobj(i+1)%get_buffer(p_val, fname) select type(p_val) type is (integer(kind=i8_kind)) - if (any(p_val .ne. int(i, kind=i8_kind))) & + if (any(p_val .ne. int(EMPTY, kind=i8_kind))) & call mpp_error(FATAL, "i8_buffer:: The "//string(i)//"d buffer was not initialized to the correct value") do j = 1, 5 if (size(p_val, j) .ne. buff_sizes(j)) & @@ -112,11 +112,11 @@ program test_diag_buffer do i=0, 5 if (i < 5) buff_sizes(i+1) = i+5 call buffobj(i+1)%allocate_buffer(i4_data, i, buff_sizes, fname) - call buffobj(i+1)%initialize_buffer( int(i, kind=i4_kind) , fname) + call buffobj(i+1)%initialize_buffer(time_none, fname) call buffobj(i+1)%get_buffer(p_val, fname) select type(p_val) type is (integer(kind=i4_kind)) - if (any(p_val .ne. int(i, kind=i4_kind))) & + if (any(p_val .ne. int(EMPTY, kind=i4_kind))) & call mpp_error(FATAL, "i4_buffer:: The "//string(i)//"d buffer was not initialized to the correct value") do j = 1, 5 if (size(p_val, j) .ne. buff_sizes(j)) &