initial few changes/fixes and testing

diag_manager/fms_diag_field_object.F90

@@ -1028,6 +1028,7 @@ subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is
   integer                                   :: i     !< For do loops
   integer                                   :: naxis !< Number of axis for the field
   class(fmsDiagAxisContainer_type), pointer :: axis_ptr !diag_axis(this%axis_ids(i), for convenience
+  character(len=23)                         :: diurnal_axis_name !< name of the diurnal axis
 
   if (this%is_static()) then
     naxis = size(this%axis_ids)
@@ -1060,7 +1061,8 @@ subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is
 
   !< The second to last dimension is always the diurnal axis
   if (field_yaml%has_n_diurnal()) then
-    dimnames(naxis - 1) = 'time_of_day_'//int2str(field_yaml%get_n_diurnal())
+    WRITE (diurnal_axis_name,'(a,i2.2)') 'time_of_day_', field_yaml%get_n_diurnal()
+    dimnames(naxis - 1) = trim(diurnal_axis_name)
   endif
 
   !< The last dimension is always the unlimited dimensions

diag_manager/fms_diag_object.F90

@@ -203,9 +203,11 @@ integer function fms_register_diag_field_obj &
  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
+ class (diagYamlFilesVar_type), pointer :: yamlfptr
  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
+ logical :: is_diurnal
 #endif
 #ifndef use_yaml
 fms_register_diag_field_obj = DIAG_FIELD_NOT_FOUND
@@ -233,11 +235,18 @@ integer function fms_register_diag_field_obj &
 
 !> Initialize buffer_ids of this field with the diag_field_indices(diag_field_indices)
 !! of the sorted variable list
+  is_diurnal = .false.
   fieldptr%buffer_ids = get_diag_field_ids(diag_field_indices)
   do i = 1, size(fieldptr%buffer_ids)
     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))
+    ! check if diurnal reduction for this buffer and if so set the diurnal sample size 
+    yamlfptr => diag_yaml%diag_fields(fieldptr%buffer_ids(i))
+    if( yamlfptr%get_var_reduction() .eq. time_diurnal) then
+      call bufferptr%set_diurnal_sample_size(yamlfptr%get_n_diurnal())
+      is_diurnal = .true.
+    endif
   enddo
 
 !> Allocate and initialize member buffer_allocated of this field
@@ -257,9 +266,9 @@ integer function fms_register_diag_field_obj &
      call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
      call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
      call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
-     call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
      call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i), &
        fieldptr%buffer_ids(i), this%FMS_diag_output_buffers)
+     call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
      call fileptr%add_start_time(init_time, this%current_model_time)
      call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
     enddo
@@ -268,10 +277,10 @@ integer function fms_register_diag_field_obj &
      fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file
      call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i))
      call fileptr%add_buffer_id(fieldptr%buffer_ids(i))
-     call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
      call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain())
      call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i), &
        fieldptr%buffer_ids(i), this%FMS_diag_output_buffers)
+     call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i))
      call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static())
     enddo
   elseif (present(init_time)) then !only inti time present
@@ -972,6 +981,15 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight
     case (time_power)
     case (time_rms)
     case (time_diurnal)
+      if(.not. present(time)) call mpp_error(FATAL, &
+                            "fms_diag_do_reduction:: time must be present when using diurnal reductions")
+      ! 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_mask_variant(), &
+        bounds_in, bounds_out, missing_value)
+      if (trim(error_msg) .ne. "") then
+        return
+      endif
     case default
       error_msg = "The reduction method is not supported. "//&
         "Only none, min, max, sum, average, power, rms, and diurnal are supported."

diag_manager/fms_diag_output_buffer.F90

@@ -27,7 +27,8 @@ module fms_diag_output_buffer_mod
 #ifdef use_yaml
 use platform_mod
 use iso_c_binding
-use time_manager_mod, only: time_type, operator(==)
+use time_manager_mod, only: time_type, operator(==), get_ticks_per_second, get_time
+use constants_mod, only: SECONDS_PER_DAY
 use mpp_mod, only: mpp_error, FATAL, NOTE
 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
@@ -54,6 +55,10 @@ 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
+  integer               :: diurnal_sample_size = 1  !< dirunal sample size as read in from the reduction method
+                                                    !! ie. diurnal24 = sample size of 24
+  integer               :: diurnal_section    !< the diurnal section (ie 5th index) calculated from the current model
+                                              !! time and sample size if using a diurnal reduction
 
   contains
   procedure :: add_axis_ids
@@ -79,6 +84,9 @@ module fms_diag_output_buffer_mod
   procedure :: do_time_sum_wrapper
   procedure :: diag_reduction_done_wrapper
   procedure :: get_buffer_dims
+  procedure :: get_diurnal_sample_size
+  procedure :: set_diurnal_sample_size
+  procedure :: set_diurnal_section_index
 end type fmsDiagOutputBuffer_type
 
 ! public types
@@ -573,15 +581,15 @@ function do_time_sum_wrapper(this, field_data, mask, is_masked, bounds_in, bound
       select type (field_data)
       type is (real(kind=r8_kind))
         call do_time_sum_update(output_buffer, this%weight_sum, field_data, mask, is_masked, &
-                                bounds_in, bounds_out, missing_value)
+                                bounds_in, bounds_out, missing_value, this%diurnal_section)
       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
     type is (real(kind=r4_kind))
       select type (field_data)
       type is (real(kind=r4_kind))
         call do_time_sum_update(output_buffer, this%weight_sum, field_data, mask, is_masked, bounds_in, bounds_out, &
-          real(missing_value, kind=r4_kind))
+          real(missing_value, kind=r4_kind), this%diurnal_section)
       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
@@ -644,5 +652,33 @@ pure function get_buffer_dims(this)
   get_buffer_dims = this%buffer_dims(1:4)
 end function
 
+!> Get diurnal sample size (amount of diurnal sections) 
+pure integer function get_diurnal_sample_size(this)
+  class(fmsDiagOutputBuffer_type), intent(in) :: this
+  get_diurnal_sample_size = this%diurnal_sample_size
+end function get_diurnal_sample_size
+
+!> Set diurnal sample size (amount of diurnal sections) 
+subroutine set_diurnal_sample_size(this, sample_size)
+  class(fmsDiagOutputBuffer_type), intent(inout) :: this
+  integer, intent(in)                            :: sample_size !< sample size to used to split daily
+                                                               !! data into given amount of sections
+  this%diurnal_sample_size = sample_size
+end subroutine set_diurnal_sample_size 
+
+!> Set diurnal section index based off the current time and previously set diurnal_samplesize
+!! Calculates which diurnal section of daily data the current time is in
+subroutine set_diurnal_section_index(this, time)
+  class(fmsDiagOutputBuffer_type), intent(inout) :: this
+  type(time_type), intent(in)                     :: time !< current model time
+  integer :: seconds, days, ticks
+
+  call get_time(time,seconds,days,ticks) ! get current date
+  ! calculates which diurnal section current time is in for a given amount of diurnal sections(<24)
+  this%diurnal_section = floor( (seconds+real(ticks)/get_ticks_per_second()) &
+                       & * this%diurnal_sample_size/SECONDS_PER_DAY) + 1
+  print *, this%diurnal_section
+end subroutine set_diurnal_section_index
+
 #endif
 end module fms_diag_output_buffer_mod

diag_manager/fms_diag_yaml.F90

@@ -820,15 +820,15 @@ subroutine set_field_reduction(field, reduction_method)
   pow_value = 0
   ioerror = 0
   if (index(reduction_method, "diurnal") .ne. 0) then
-    READ (UNIT=reduction_method(8:LEN_TRIM(reduction_method)), FMT=*, IOSTAT=ioerror) n_diurnal
+    READ (reduction_method(8:LEN_TRIM(reduction_method)),FMT=*, IOSTAT=ioerror) n_diurnal
     if (ioerror .ne. 0) &
       call mpp_error(FATAL, "Error getting the number of diurnal samples from "//trim(reduction_method))
     if (n_diurnal .le. 0) &
       call mpp_error(FATAL, "Diurnal samples should be greater than 0. &
         & Check your entry for file:"//trim(field%var_varname)//" in file "//trim(field%var_fname))
     field%var_reduction = time_diurnal
   elseif (index(reduction_method, "pow") .ne. 0) then
-    READ (UNIT=reduction_method(4:LEN_TRIM(reduction_method)), FMT=*, IOSTAT=ioerror) pow_value
+    READ (reduction_method(4:LEN_TRIM(reduction_method)), FMT=*, IOSTAT=ioerror) pow_value
     if (ioerror .ne. 0) &
       call mpp_error(FATAL, "Error getting the power value from "//trim(reduction_method))
       if (pow_value .le. 0) &

diag_manager/include/fms_diag_reduction_methods.inc

@@ -215,7 +215,7 @@ end subroutine DO_TIME_MAX_
 !!
 !! Where l are the indices passed in through the bounds_in/out
 subroutine DO_TIME_SUM_UPDATE_(data_out, weight_sum, data_in, mask, is_masked, bounds_in, bounds_out, &
-                               missing_value, weight, pow)
+                               missing_value, diurnal_section, weight)
   real(FMS_TRM_KIND_),       intent(inout) :: data_out(:,:,:,:,:) !< output data
   real(r8_kind),       intent(inout) :: weight_sum          !< Sum of weights from the output buffer object
   real(FMS_TRM_KIND_),       intent(in)    :: data_in(:,:,:,:)    !< data to update the buffer with
@@ -226,9 +226,11 @@ subroutine DO_TIME_SUM_UPDATE_(data_out, weight_sum, data_in, mask, is_masked, b
   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
-  real(r8_kind),optional, intent(in) :: weight              !< Weight applied to data_in before added to data_out
-                                                                  !! used for weighted averages, default 1.0
-  real(FMS_TRM_KIND_),optional, intent(in) :: pow                 !< Used for pow reduction, adds field^pow to buffer
+  integer, intent(in)                      :: diurnal_section !< the diurnal "section" if doing a diurnal reduction 
+                                                              !! indicates which index to add data on 5th axis
+                                                              !! if not doing a diurnal reduction, this should always =1
+  real(r8_kind),optional, intent(in)       :: weight          !< Weight applied to data_in before added to data_out
+                                                              !! used for weighted averages, default 1.0
 
   integer :: is_in, ie_in, js_in, je_in, ks_in, ke_in       !< Starting and ending indices of each dimention for
                                                             !! the input buffer
@@ -237,19 +239,14 @@ subroutine DO_TIME_SUM_UPDATE_(data_out, weight_sum, data_in, mask, is_masked, b
   integer :: i, j, k, l !< For looping
   real(FMS_TRM_KIND_) :: weight_loc, pow_loc !< local copies of optional arguments
   integer, parameter  :: kindl = FMS_TRM_KIND_ !< real kind size as set by macro
+  integer :: diurnal
 
   if(present(weight)) then
     weight_loc = weight
   else
     weight_loc = 1.0_kindl
   endif
 
-  if(present(pow)) then
-    pow_loc = weight
-  else
-    pow_loc = 1.0_kindl
-  endif
-
   ! update with given weight for average before write
   weight_sum = weight_sum + weight_loc
 
@@ -275,8 +272,8 @@ subroutine DO_TIME_SUM_UPDATE_(data_out, weight_sum, data_in, mask, is_masked, b
       do j = 0, je_out - js_out
         do i = 0, ie_out - is_out
           where (mask(is_in + i, js_in + j, ks_in + k, :))
-            data_out(is_out + i, js_out + j, ks_out + k, :, 1) =           &
-                       data_out(is_out + i, js_out + j, ks_out + k, :, 1)  &
+            data_out(is_out + i, js_out + j, ks_out + k, :, diurnal_section) =           &
+                       data_out(is_out + i, js_out + j, ks_out + k, :, diurnal_section)  &
                      + (data_in(is_in +i, js_in + j, ks_in + k, :) * weight_loc) ** pow_loc
           elsewhere
             data_out(is_out + i, js_out + j, ks_out + k, :, 1) = missing_value
@@ -289,8 +286,8 @@ subroutine DO_TIME_SUM_UPDATE_(data_out, weight_sum, data_in, mask, is_masked, b
     do k = 0, ke_out - ks_out
       do j = 0, je_out - js_out
         do i = 0, ie_out - is_out
-          data_out(is_out + i, js_out + j, ks_out + k,  :, 1) =  &
-             data_out(is_out + i, js_out + j, ks_out + k, :, 1)  &
+          data_out(is_out + i, js_out + j, ks_out + k,  :, diurnal_section) =  &
+             data_out(is_out + i, js_out + j, ks_out + k, :, diurnal_section)  &
             + (data_in(is_in +i, js_in + j, ks_in + k, :) * weight_loc) ** pow_loc
         enddo
       enddo
@@ -313,12 +310,12 @@ subroutine SUM_UPDATE_DONE_(out_buffer_data, weight_sum, reduction_method, missi
   !logical                            :: has_mask !< whether or not mask is present
 
   if ( has_mask ) then
-    where(out_buffer_data(:,:,:,:,1) .ne. missing_val)
-      out_buffer_data(:,:,:,:,1) = out_buffer_data(:,:,:,:,1) &
+    where(out_buffer_data(:,:,:,:,:) .ne. missing_val)
+      out_buffer_data(:,:,:,:,:) = out_buffer_data(:,:,:,:,:) &
                                    / weight_sum
     endwhere
   else  !not mask variant
-    out_buffer_data(:,:,:,:,1) = out_buffer_data(:,:,:,:,1) &
+    out_buffer_data(:,:,:,:,:) = out_buffer_data(:,:,:,:,:) &
                                / weight_sum
   endif
 

test_fms/diag_manager/Makefile.am

@@ -31,7 +31,7 @@ LDADD = $(top_builddir)/libFMS/libFMS.la
 check_PROGRAMS = test_diag_manager test_diag_manager_time \
  test_diag_dlinked_list test_diag_yaml test_diag_ocean test_modern_diag test_diag_buffer \
  test_flexible_time test_diag_update_buffer test_reduction_methods check_time_none \
- check_time_min check_time_max check_time_sum check_time_avg
+ check_time_min check_time_max check_time_sum check_time_avg test_diag_diurnal
 
 # This is the source code for the test.
 test_diag_manager_SOURCES = test_diag_manager.F90
@@ -44,25 +44,27 @@ test_modern_diag_SOURCES = test_modern_diag.F90
 test_diag_buffer_SOURCES= test_diag_buffer.F90
 test_flexible_time_SOURCES = test_flexible_time.F90
 test_reduction_methods_SOURCES = testing_utils.F90 test_reduction_methods.F90
+test_diag_diurnal_SOURCES = testing_utils.F90 test_diag_diurnal.F90
 check_time_none_SOURCES = testing_utils.F90 check_time_none.F90
 check_time_min_SOURCES = testing_utils.F90 check_time_min.F90
 check_time_max_SOURCES = testing_utils.F90 check_time_max.F90
 check_time_sum_SOURCES = testing_utils.F90 check_time_sum.F90
 check_time_avg_SOURCES = testing_utils.F90 check_time_avg.F90
+check_time_diurnal_SOURCES = testing_utils.F90 check_time_diurnal.F90
 
 TEST_EXTENSIONS = .sh
 SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
                   $(abs_top_srcdir)/test_fms/tap-driver.sh
 
 # Run the test.
 TESTS = test_diag_manager2.sh test_time_none.sh test_time_min.sh test_time_max.sh test_time_sum.sh \
-        test_time_avg.sh
+        test_time_avg.sh test_time_diurnal.sh
 
 testing_utils.mod: testing_utils.$(OBJEXT)
 
 # Copy over other needed files to the srcdir
 EXTRA_DIST = test_diag_manager2.sh check_crashes.sh test_time_none.sh test_time_min.sh test_time_max.sh \
-             test_time_sum.sh test_time_avg.sh
+             test_time_sum.sh test_time_avg.sh test_time_diurnal.sh
 
 if USING_YAML
 skipflag=""