modern_diag: add the write_data calls (NOAA-GFDL#1320)

* add the write_data calls

* fix the test_flexible_time after the update

diag_manager/Makefile.am

@@ -88,7 +88,7 @@ diag_manager_mod.$(FC_MODEXT): diag_axis_mod.$(FC_MODEXT) diag_data_mod.$(FC_MOD
                                fms_diag_object_container_mod.$(FC_MODEXT) fms_diag_axis_object_mod.$(FC_MODEXT) \
                                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_output_buffer_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT)
 
 # Mod files are built and then installed as headers.
 MODFILES = \

diag_manager/fms_diag_file_object.F90

@@ -45,7 +45,7 @@ module fms_diag_file_object_mod
                                     fmsDiagFullAxis_type, define_subaxis, define_diurnal_axis, &
                                     fmsDiagDiurnalAxis_type, create_new_z_subaxis
 use fms_diag_field_object_mod, only: fmsDiagField_type
-use fms_diag_output_buffer_mod, only: fmsDiagOutputBufferContainer_type
+use fms_diag_output_buffer_mod, only: fmsDiagOutputBufferContainer_type, fmsDiagOutputBuffer_class
 use mpp_mod, only: mpp_get_current_pelist, mpp_npes, mpp_root_pe, mpp_pe, mpp_error, FATAL, stdout, &
                    uppercase, lowercase
 
@@ -161,6 +161,7 @@ module fms_diag_file_object_mod
   procedure :: open_diag_file
   procedure :: write_global_metadata
   procedure :: write_time_metadata
+  procedure :: write_field_data
   procedure :: write_axis_metadata
   procedure :: write_field_metadata
   procedure :: write_axis_data
@@ -1119,6 +1120,41 @@ subroutine write_time_metadata(this)
 
 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(fmsDiagOutputBufferContainer_type), intent(in), target :: buffer_obj(:)  !< The buffer object with the data
+
+  class(fmsDiagFile_type), pointer     :: diag_file      !< Diag_file object to open
+  class(FmsNetcdfFile_t),  pointer     :: fileobj        !< Fileobj to write to
+  integer                              :: i              !< For do loops
+  integer                              :: field_id       !< The id of the field writing the data from
+
+  diag_file => this%FMS_diag_file
+  fileobj => diag_file%fileobj
+
+  !TODO This may be offloaded in the future
+  if (diag_file%is_static) then
+    !< Here the file is static so there is no need for the unlimited dimension
+    !! as a variables are static
+    do i = 1, diag_file%number_of_buffers
+      call buffer_obj(diag_file%buffer_ids(i))%write_buffer(fileobj)
+    enddo
+  else
+    do i = 1, diag_file%number_of_buffers
+      field_id = buffer_obj(diag_file%buffer_ids(i))%get_field_id()
+      if (field_obj(field_id)%is_static()) then
+        !< If the variable is static, only write it the first time
+        if (diag_file%unlim_dimension_level .eq. 1) call buffer_obj(diag_file%buffer_ids(i))%write_buffer(fileobj)
+      else
+        call buffer_obj(diag_file%buffer_ids(i))%write_buffer(fileobj, unlim_dim_level=diag_file%unlim_dimension_level)
+      endif
+    enddo
+  endif
+
+end subroutine write_field_data
+
 !> \brief Determine if it is time to close the file
 !! \return .True. if it is time to close the file
 logical function is_time_to_close_file (this, time_step)

diag_manager/fms_diag_object.F90

@@ -227,7 +227,7 @@ integer function fms_register_diag_field_obj &
   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(diag_field_indices(i))
+    call this%FMS_diag_output_buffers(fieldptr%buffer_ids(i))%set_yaml_id(fieldptr%buffer_ids(i))
   enddo
 
 !> Allocate and initialize member buffer_allocated of this field
@@ -719,7 +719,7 @@ subroutine fms_diag_do_io(this, is_end_of_run)
     if (diag_file%is_time_to_write(model_time)) then
       call diag_file%increase_unlim_dimension_level()
       call diag_file%write_time_data()
-      !TODO call diag_file%add_variable_data()
+      call diag_file%write_field_data(this%FMS_diag_fields, this%FMS_diag_output_buffers)
       call diag_file%update_next_write(model_time)
       call diag_file%update_current_new_file_freq_index(model_time)
       if (diag_file%is_time_to_close_file(model_time)) call diag_file%close_diag_file()

diag_manager/fms_diag_output_buffer.F90

@@ -24,18 +24,19 @@
 !! buffer0-5d types extend fmsDiagBuffer_class, and upon allocation
 !! are added to the module's buffer_lists depending on it's dimension
 module fms_diag_output_buffer_mod
-
+#ifdef use_yaml
 use platform_mod
 use iso_c_binding
 use time_manager_mod, only: time_type
 use mpp_mod, only: mpp_error, FATAL
 use diag_data_mod, only: DIAG_NULL, DIAG_NOT_REGISTERED, i4, i8, r4, r8
+use fms2_io_mod, only: FmsNetcdfFile_t, write_data, FmsNetcdfDomainFile_t, FmsNetcdfUnstructuredDomainFile_t
+use fms_diag_yaml_mod, only: diag_yaml
 
 implicit none
 
 private
 
-#ifdef use_yaml
 !> @brief Object that holds buffered data and other diagnostics
 !! Abstract to ensure use through its extensions(buffer0-5d types)
 type, abstract :: fmsDiagOutputBuffer_class
@@ -72,6 +73,11 @@ module fms_diag_output_buffer_mod
   procedure :: get_field_id
   procedure :: set_yaml_id
   procedure :: get_yaml_id
+  procedure :: write_buffer
+  !! These are needed because otherwise the write_data calls will go into the wrong interface
+  procedure :: write_buffer_wrapper_netcdf
+  procedure :: write_buffer_wrapper_domain
+  procedure :: write_buffer_wrapper_u
 end type
 
 !> Scalar buffer type to extend fmsDiagBufferContainer_type
@@ -1497,5 +1503,108 @@ function get_yaml_id(this) &
 
   res = this%yaml_id
 end function get_yaml_id
+
+!> @brief Write the buffer to the file
+subroutine write_buffer(this, fileobj, unlim_dim_level)
+  class(fmsDiagOutputBufferContainer_type), intent(in) :: this            !< buffer object to write
+  class(FmsNetcdfFile_t),                   intent(in) :: fileobj         !< fileobj to write to
+  integer, optional,                        intent(in) :: unlim_dim_level !< unlimited dimension
+
+  select type(fileobj)
+  type is (FmsNetcdfFile_t)
+    call this%write_buffer_wrapper_netcdf(fileobj, unlim_dim_level=unlim_dim_level)
+  type is (FmsNetcdfDomainFile_t)
+    call this%write_buffer_wrapper_domain(fileobj, unlim_dim_level=unlim_dim_level)
+  type is (FmsNetcdfUnstructuredDomainFile_t)
+    call this%write_buffer_wrapper_u(fileobj, unlim_dim_level=unlim_dim_level)
+  class default
+    call mpp_error(FATAL, "The file "//trim(fileobj%path)//" is not one of the accepted types"//&
+      " only FmsNetcdfFile_t, FmsNetcdfDomainFile_t, and FmsNetcdfUnstructuredDomainFile_t are accepted.")
+  end select
+end subroutine write_buffer
+
+!> @brief Write the buffer to the FmsNetcdfFile_t fileobj
+subroutine write_buffer_wrapper_netcdf(this, fileobj, unlim_dim_level)
+  class(fmsDiagOutputBufferContainer_type), intent(in) :: this            !< buffer object to write
+  type(FmsNetcdfFile_t),                    intent(in) :: fileobj         !< fileobj to write to
+  integer, optional,                        intent(in) :: unlim_dim_level !< unlimited dimension
+
+  character(len=:), allocatable :: varname !< name of the variable
+
+  varname = diag_yaml%diag_fields(this%yaml_id)%get_var_outname()
+  select type(buffer_obj=>this%diag_buffer_obj)
+  type is (outputBuffer0d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer(1), unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer1d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer2d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer3d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer4d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer5d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  class default
+    call mpp_error(FATAL, "The field:"//trim(varname)//" does not have a valid buffer object type."//&
+      " Only 0d, 1d, 2d, 3d, 4d, and 5d buffers are supported.")
+  end select
+end subroutine write_buffer_wrapper_netcdf
+
+!> @brief Write the buffer to the FmsNetcdfDomainFile_t fileobj
+subroutine write_buffer_wrapper_domain(this, fileobj, unlim_dim_level)
+  class(fmsDiagOutputBufferContainer_type), intent(in) :: this            !< buffer object to write
+  type(FmsNetcdfDomainFile_t),              intent(in) :: fileobj         !< fileobj to write to
+  integer, optional,                        intent(in) :: unlim_dim_level !< unlimited dimension
+
+  character(len=:), allocatable :: varname !< name of the variable
+
+  varname = diag_yaml%diag_fields(this%yaml_id)%get_var_outname()
+  select type(buffer_obj=>this%diag_buffer_obj)
+  type is (outputBuffer0d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer(1), unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer1d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer2d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer3d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer4d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer5d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  class default
+    call mpp_error(FATAL, "The field:"//trim(varname)//" does not have a valid buffer object type."//&
+      " Only 0d, 1d, 2d, 3d, 4d, and 5d buffers are supported.")
+  end select
+end subroutine write_buffer_wrapper_domain
+
+!> @brief Write the buffer to the FmsNetcdfUnstructuredDomainFile_t fileobj
+subroutine write_buffer_wrapper_u(this, fileobj, unlim_dim_level)
+  class(fmsDiagOutputBufferContainer_type), intent(in) :: this            !< buffer object to write
+  type(FmsNetcdfUnstructuredDomainFile_t),  intent(in) :: fileobj         !< fileobj to write to
+  integer, optional,                        intent(in) :: unlim_dim_level !< unlimited dimension
+
+  character(len=:), allocatable :: varname !< name of the variable
+
+  varname = diag_yaml%diag_fields(this%yaml_id)%get_var_outname()
+  select type(buffer_obj=>this%diag_buffer_obj)
+  type is (outputBuffer0d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer(1), unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer1d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer2d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer3d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer4d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  type is (outputBuffer5d_type)
+    call write_data(fileobj, varname, buffer_obj%buffer, unlim_dim_level=unlim_dim_level)
+  class default
+    call mpp_error(FATAL, "The field:"//trim(varname)//" does not have a valid buffer object type."//&
+      " Only 0d, 1d, 2d, 3d, 4d, and 5d buffers are supported.")
+  end select
+end subroutine write_buffer_wrapper_u
 #endif
 end module fms_diag_output_buffer_mod

test_fms/diag_manager/test_flexible_time.F90

@@ -21,15 +21,19 @@
 program test_flexible_time
 use   fms_mod,          only: fms_init, fms_end
 use   time_manager_mod, only: set_date, time_type, increment_date, set_calendar_type, &
-                              JULIAN, set_time
+                              JULIAN, set_time, operator(+)
 use   diag_manager_mod, only: diag_manager_init, diag_axis_init, register_diag_field, &
-                              diag_manager_set_time_end, diag_send_complete, diag_manager_end
+                              diag_manager_set_time_end, diag_send_complete, diag_manager_end, &
+                              send_data
 use   mpp_mod,          only: FATAL, mpp_error
+use   platform_mod,     only: r8_kind
 
 implicit none
 
+real(kind=r8_kind)                :: var_data(2)      !< Dummy data
+logical                           :: used             !< .True. if send_data was sucessful
 type(time_type)                   :: Time             !< Time of the simulation
-type(time_type)                   :: Start_Time       !< Start time of the simulation
+type(time_type)                   :: Time_step        !< Start time of the simulation
 type(time_type)                   :: End_Time         !< End Time of the simulation
 integer :: i
 integer :: id_z, id_var
@@ -39,18 +43,22 @@ program test_flexible_time
 call diag_manager_init
 
 !< Starting time of the simulation
-Start_Time = set_date(2,1,1,3,0,0) !02/01/01 hour 3
+Time = set_date(2,1,1,3,0,0) !02/01/01 hour 3
 
 !< Set up a dummy variable
 id_z  = diag_axis_init('z',  (/1. ,2. /),  'point_Z', 'z', long_name='point_Z')
-id_var = register_diag_field  ('atm_mod', 'var1', (/id_z/), Start_Time, 'Var not domain decomposed', 'mullions')
+id_var = register_diag_field  ('atm_mod', 'var1', (/id_z/), Time, 'Var not domain decomposed', 'mullions')
 
 !< Set up the end of the simulation (i.e 2 days long)
 End_Time = set_date(2,1,3,3,0,0)
 call diag_manager_set_time_end(End_Time)
 
 !< Set up the simulation
+Time_step = set_time (3600,0) !< 1 hour
 do i=1,48
+  var_data = real(i, kind=r8_kind)
+  Time = Time + Time_step
+  used = send_data(id_var, var_data, Time)
   call diag_send_complete(set_time(3600,0))
 enddo