Merge branch 'main' into flush_nc_files

diag_manager/diag_manager.F90

@@ -4169,11 +4169,15 @@ SUBROUTINE diag_manager_init(diag_model_subset, time_init, err_msg)
     END IF
 
     IF ( mix_snapshot_average_fields ) THEN
-       IF ( mpp_pe() == mpp_root_pe() ) THEN
+       IF ( .not. use_modern_diag ) THEN
           CALL error_mesg('diag_manager_mod::diag_manager_init', 'Setting diag_manager_nml variable '//&
                & 'mix_snapshot_average_fields = .TRUE. will cause ERRORS in the time coordinates '//&
                & 'of all time averaged fields.  Strongly recommend setting mix_snapshot_average_fields '//&
-               & '= .FALSE.', WARNING)
+               & '= .FALSE.', NOTE)
+       ELSE
+          CALL error_mesg('diag_manager_mod::diag_manager_init', 'mix_snapshot_average_fields = .TRUE. is not '//&
+               & 'supported if use_modern_diag = .TRUE. Please set mix_snapshot_average_fields '//&
+               & 'to .FALSE. and put instantaneous and averaged fields in seperate files!', FATAL)
        END IF
     END IF
     ALLOCATE(output_fields(max_output_fields))

diag_manager/fms_diag_file_object.F90

@@ -95,7 +95,8 @@ module fms_diag_file_object_mod
   integer :: number_of_axis !< Number of axis in the file
   integer, dimension(:), allocatable :: buffer_ids !< array of buffer ids associated with the file
   integer :: number_of_buffers !< Number of buffers that have been added to the file
-  logical :: time_ops !< .True. if file contains variables that are time_min, time_max, time_average or time_sum
+  logical, allocatable :: time_ops !< .True. if file contains variables that are time_min, time_max, time_average,
+                                   !! or time_sum
   integer :: unlim_dimension_level !< The unlimited dimension level currently being written
   logical :: data_has_been_written !< .True. if data has been written for the current unlimited dimension level
   logical :: is_static !< .True. if the frequency is -1
@@ -120,6 +121,7 @@ module fms_diag_file_object_mod
   procedure, public :: add_start_time
   procedure, public :: set_file_time_ops
   procedure, public :: has_field_ids
+  procedure, public :: get_time_ops
   procedure, public :: get_id
 ! TODO  procedure, public :: get_fileobj ! TODO
 ! TODO  procedure, public :: get_diag_yaml_file ! TODO
@@ -159,6 +161,7 @@ module fms_diag_file_object_mod
  procedure, public :: get_buffer_ids
  procedure, public :: get_number_of_buffers
  procedure, public :: has_send_data_been_called
+ procedure, public :: check_buffer_times
 end type fmsDiagFile_type
 
 type, extends (fmsDiagFile_type) :: subRegionalFile_type
@@ -277,7 +280,6 @@ logical function fms_diag_files_object_init (files_array)
        obj%no_more_data = diag_time_inc(obj%start_time, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
      endif
 
-     obj%time_ops = .false.
      obj%unlim_dimension_level = 0
      obj%is_static = obj%get_file_freq() .eq. -1
      obj%nz_subaxis = 0
@@ -375,21 +377,31 @@ subroutine set_file_time_ops(this, VarYaml, is_static)
 
   !< Go away if the file is static
   if (this%is_static) return
+  if (is_static) return
 
-  if (this%time_ops) then
-    if (is_static) return
-    if (VarYaml%get_var_reduction() .eq. time_none) then
-      call mpp_error(FATAL, "The file: "//this%get_file_fname()//&
-                            " has variables that are time averaged and instantaneous")
-    endif
-  else
+  ! Set time_ops the first time this subroutine it is called
+  if (.not. allocated(this%time_ops)) then
     var_reduct = VarYaml%get_var_reduction()
+
     select case (var_reduct)
-      case (time_average, time_rms, time_max, time_min, time_sum, time_diurnal, time_power)
-        this%time_ops = .true.
+    case (time_average, time_rms, time_max, time_min, time_sum, time_diurnal, time_power)
+      this%time_ops = .true.
+    case (time_none)
+      this%time_ops = .false.
     end select
+
+    return
   endif
 
+  if (this%time_ops) then
+    if (VarYaml%get_var_reduction() .eq. time_none) &
+      call mpp_error(FATAL, "The file: "//this%get_file_fname()//&
+                            " has variables that are time averaged and instantaneous")
+  else
+    if (VarYaml%get_var_reduction() .ne. time_none) &
+      call mpp_error(FATAL, "The file: "//this%get_file_fname()//&
+                            " has variables that are time averaged and instantaneous")
+  endif
 end subroutine set_file_time_ops
 
 !> \brief Logical function to determine if the variable file_metadata_from_model has been allocated or associated
@@ -445,6 +457,19 @@ pure function get_id (this) result (res)
   res = this%id
 end function get_id
 
+!> \brief Returns a copy of the value of time_ops
+!! \return A copy of time_ops
+pure function get_time_ops (this) result (res)
+  class(fmsDiagFile_type), intent(in) :: this !< The file object
+  logical :: res
+
+  if (.not. allocated(this%time_ops)) then
+    res = .false.
+  else
+    res = this%time_ops
+  endif
+end function get_time_ops
+
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !! TODO
 !> \brief Returns a copy of the value of fileobj
@@ -1288,7 +1313,7 @@ subroutine write_time_metadata(this)
   call register_variable_attribute(fms2io_fileobj, time_var_name, "calendar", &
     lowercase(trim(calendar)), str_len=len_trim(calendar))
 
-  if (diag_file%time_ops) then
+  if (diag_file%get_time_ops()) then
     call register_variable_attribute(fms2io_fileobj, time_var_name, "bounds", &
       trim(time_var_name)//"_bnds", str_len=len_trim(time_var_name//"_bnds"))
 
@@ -1368,17 +1393,31 @@ logical function is_time_to_close_file (this, time_step)
 end function
 
 !> \brief Determine if it is time to "write" to the file
-logical function is_time_to_write(this, time_step, output_buffers)
+logical function is_time_to_write(this, time_step, output_buffers, do_not_write)
   class(fmsDiagFileContainer_type), intent(inout), target   :: this              !< The file object
   TYPE(time_type),                  intent(in)              :: time_step         !< Current model step time
   type(fmsDiagOutputBuffer_type),   intent(in)              :: output_buffers(:) !< Array of output buffer.
                                                                                  !! This is needed for error messages!
+  logical,                          intent(out)             :: do_not_write      !< .True. only if this is not a new
+                                                                                 !! time step and you are writting
+                                                                                 !! at every time step
 
+  do_not_write = .false.
   if (time_step > this%FMS_diag_file%next_output) then
     is_time_to_write = .true.
     if (this%FMS_diag_file%is_static) return
     if (time_step > this%FMS_diag_file%next_next_output) then
-      if (this%FMS_diag_file%num_registered_fields .eq. 0) then
+      if (this%FMS_diag_file%get_file_freq() .eq. 0) then
+        !! If the diag file is being written at every time step
+        if (time_step .ne. this%FMS_diag_file%next_output) then
+          !! Only write and update the next_output if it is a new time
+          call this%FMS_diag_file%check_buffer_times(output_buffers)
+          this%FMS_diag_file%next_output = time_step
+          this%FMS_diag_file%next_next_output = time_step
+          is_time_to_write = .true.
+        endif
+        return
+      elseif (this%FMS_diag_file%num_registered_fields .eq. 0) then
         !! If no variables have been registered, write a dummy time dimension for the first level
         !! At least one time level is needed for the combiner to work ...
         if (this%FMS_diag_file%unlim_dimension_level .eq. 0) then
@@ -1402,6 +1441,8 @@ logical function is_time_to_write(this, time_step, output_buffers)
     if (this%FMS_diag_file%is_static) then
       ! This is to ensure that static files get finished in the begining of the run
       if (this%FMS_diag_file%unlim_dimension_level .eq. 1) is_time_to_write = .true.
+    else if(this%FMS_diag_file%get_file_freq() .eq. 0) then
+      do_not_write = .true.
     endif
   endif
 end function is_time_to_write
@@ -1439,7 +1480,7 @@ subroutine write_time_data(this)
   !! that at least one time level is written (this is needed for the combiner)
   if (.not. diag_file%data_has_been_written .and. diag_file%unlim_dimension_level .ne. 1) return
 
-  if (diag_file%time_ops) then
+  if (diag_file%get_time_ops()) then
     middle_time = (diag_file%last_output+diag_file%next_output)/2
     dif = get_date_dif(middle_time, get_base_time(), diag_file%get_file_timeunit())
   else
@@ -1449,7 +1490,7 @@ subroutine write_time_data(this)
   call write_data(fms2io_fileobj, diag_file%get_file_unlimdim(), dif, &
     unlim_dim_level=diag_file%unlim_dimension_level)
 
-  if (diag_file%time_ops) then
+  if (diag_file%get_time_ops()) then
     T1 = get_date_dif(diag_file%last_output, get_base_time(), diag_file%get_file_timeunit())
     T2 = get_date_dif(diag_file%next_output, get_base_time(), diag_file%get_file_timeunit())
 
@@ -1799,6 +1840,29 @@ pure function get_number_of_buffers(this)
   get_number_of_buffers = this%number_of_buffers
 end function get_number_of_buffers
 
+!> Check to ensure that send_data was called at the time step for every output buffer in the file
+!! This is only needed when you are output data at every time step
+subroutine check_buffer_times(this, output_buffers)
+  class(fmsDiagFile_type),        intent(in)           :: this              !< file object
+  type(fmsDiagOutputBuffer_type), intent(in), target   :: output_buffers(:) !< Array of output buffers
+
+  integer :: i
+  type(time_type) :: current_buffer_time
+  character(len=:), allocatable :: field_name
+
+  do i = 1, this%number_of_buffers
+    if (i .eq. 1) then
+      current_buffer_time = output_buffers(this%buffer_ids(i))%get_buffer_time()
+      field_name = output_buffers(this%buffer_ids(i))%get_buffer_name()
+    else
+      if (current_buffer_time .ne. output_buffers(this%buffer_ids(i))%get_buffer_time()) &
+        call mpp_error(FATAL, "Send data has not been called at the same time steps for the fields:"//&
+                              field_name//" and "//output_buffers(this%buffer_ids(i))%get_buffer_name()//&
+                              " in file:"//this%get_file_fname())
+    endif
+  enddo
+end subroutine
+
 !> @brief Determine if send_data has been called for any fields in the file. Prints out warnings, if indicated
 !! @return .True. if send_data has been called for any fields in the file
 function has_send_data_been_called(this, output_buffers, print_warnings, diag_fields) &

diag_manager/fms_diag_object.F90

@@ -807,6 +807,7 @@ subroutine fms_diag_do_io(this, end_time)
   real(r8_kind) :: mval !< r8 copy of missing value
   character(len=128) :: error_string !< outputted error string from reducti
   logical :: unlim_dim_was_increased !< .True. if the unlimited dimension index was increased for any of the buffers
+  logical :: do_not_write !< .True. only if this is not a new time step and you are writting at every time step
 
   force_write = .false.
 
@@ -836,7 +837,7 @@ subroutine fms_diag_do_io(this, end_time)
       call diag_file%write_axis_data(this%diag_axis)
     endif
 
-    finish_writing = diag_file%is_time_to_write(model_time, this%FMS_diag_output_buffers)
+    finish_writing = diag_file%is_time_to_write(model_time, this%FMS_diag_output_buffers, do_not_write)
     unlim_dim_was_increased = .false.
 
     ! finish reduction method if its time to write
@@ -850,7 +851,7 @@ subroutine fms_diag_do_io(this, end_time)
       ! Go away if there is no data to write
       if (.not. diag_buff%is_there_data_to_write()) cycle
 
-      if ( diag_buff%is_time_to_finish_reduction(end_time)) then
+      if ( diag_buff%is_time_to_finish_reduction(end_time) .and. .not. do_not_write) then
         ! 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
@@ -1057,21 +1058,22 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight
       endif
     case (time_average)
       error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
-        field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value())
+        field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
+        weight=weight)
       if (trim(error_msg) .ne. "") then
         return
       endif
     case (time_power)
       error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
         field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
-        pow_value=field_yaml_ptr%get_pow_value())
+        weight=weight, pow_value=field_yaml_ptr%get_pow_value())
       if (trim(error_msg) .ne. "") then
         return
       endif
     case (time_rms)
       error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
         field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
-        pow_value = 2)
+        weight=weight, pow_value = 2)
       if (trim(error_msg) .ne. "") then
         return
       endif
@@ -1081,7 +1083,8 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight
       ! sets the diurnal index for reduction within the buffer object
       call buffer_ptr%set_diurnal_section_index(time)
       error_msg = buffer_ptr%do_time_sum_wrapper(field_data, oor_mask, field_ptr%get_var_is_masked(), &
-        field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value())
+        field_ptr%get_mask_variant(), bounds_in, bounds_out, missing_value, field_ptr%has_missing_value(), &
+        weight=weight)
       if (trim(error_msg) .ne. "") then
         return
       endif

diag_manager/fms_diag_output_buffer.F90

@@ -67,6 +67,7 @@ module fms_diag_output_buffer_mod
   type(time_type)       :: next_output        !< The next time to output the data
 
   contains
+  procedure :: get_buffer_name
   procedure :: add_axis_ids
   procedure :: get_axis_ids
   procedure :: set_field_id
@@ -76,6 +77,7 @@ module fms_diag_output_buffer_mod
   procedure :: init_buffer_time
   procedure :: set_next_output
   procedure :: update_buffer_time
+  procedure :: get_buffer_time
   procedure :: is_there_data_to_write
   procedure :: is_time_to_finish_reduction
   procedure :: set_send_data_called
@@ -301,6 +303,17 @@ subroutine initialize_buffer (this, reduction_method, field_name)
 
 end subroutine initialize_buffer
 
+!> @brief Get the name of the field for the output buffer
+!! @return Name of the field for the output buffer
+function get_buffer_name(this) &
+  result(rslt)
+  class(fmsDiagOutputBuffer_type), intent(in) :: this        !< Buffer object
+
+  character(len=:), allocatable :: rslt
+
+  rslt = diag_yaml%diag_fields(this%yaml_id)%get_var_outname()
+end function get_buffer_name
+
 !> @brief Adds the axis ids to the buffer object
 subroutine add_axis_ids(this, axis_ids)
   class(fmsDiagOutputBuffer_type), intent(inout) :: this        !< Buffer object
@@ -400,6 +413,16 @@ subroutine update_buffer_time(this, time)
   endif
 end subroutine update_buffer_time
 
+!> @brief Get the buffer_time from a output buffer object
+!! @return The buffer time
+function get_buffer_time(this) &
+  result(rslt)
+  class(fmsDiagOutputBuffer_type), intent(in) :: this        !< Buffer object
+  type(time_type) :: rslt
+
+  rslt = this%time
+end function get_buffer_time
+
 !> @brief Determine if finished with math
 !! @return this%done_with_math
 function is_done_with_math(this) &
@@ -693,7 +716,7 @@ end function do_time_max_wrapper
 !> @brief Does the time_sum reduction method on the buffer object
 !! @return Error message if the math was not successful
 function do_time_sum_wrapper(this, field_data, mask, is_masked, mask_variant, bounds_in, bounds_out, missing_value, &
-                             has_missing_value, pow_value) &
+                             has_missing_value, pow_value, weight) &
   result(err_msg)
   class(fmsDiagOutputBuffer_type), intent(inout) :: this                !< buffer object to write
   class(*),                        intent(in)    :: field_data(:,:,:,:) !< Buffer data for current time
@@ -708,6 +731,7 @@ function do_time_sum_wrapper(this, field_data, mask, is_masked, mask_variant, bo
   integer, optional,               intent(in)    :: pow_value           !< power value, will calculate field_data^pow
                                                                         !! before adding to buffer should only be
                                                                         !! present if using pow reduction method
+  real(kind=r8_kind), optional,    intent(in)    :: weight              !< The weight to use when suming
   character(len=150) :: err_msg
 
   !TODO This will be expanded for integers
@@ -722,7 +746,7 @@ function do_time_sum_wrapper(this, field_data, mask, is_masked, mask_variant, bo
         endif
         call do_time_sum_update(output_buffer, this%weight_sum, field_data, mask, is_masked, mask_variant, &
                                 bounds_in, bounds_out, missing_value, this%diurnal_section, &
-                                pow=pow_value)
+                                pow=pow_value, weight=weight)
       class default
         err_msg="do_time_sum_wrapper::the output buffer and the buffer send in are not of the same type (r8_kind)"
       end select
@@ -735,7 +759,7 @@ function do_time_sum_wrapper(this, field_data, mask, is_masked, mask_variant, bo
         endif
         call do_time_sum_update(output_buffer, this%weight_sum, field_data, mask, is_masked, mask_variant, &
                                 bounds_in, bounds_out, real(missing_value, kind=r4_kind), &
-                                this%diurnal_section, pow=pow_value)
+                                this%diurnal_section, pow=pow_value, weight=weight)
       class default
         err_msg="do_time_sum_wrapper::the output buffer and the buffer send in are not of the same type (r4_kind)"
       end select