From 169f094284bda2cbb1b41b8d2647406560601ff1 Mon Sep 17 00:00:00 2001
From: uramirez8707 <49168881+uramirez8707@users.noreply.github.com>
Date: Fri, 16 Dec 2022 08:17:10 -0500
Subject: [PATCH] feat: Add flexible timing feature in modern diag_manager
(#1077)
---
diag_manager/diag_data.F90 | 6 +
diag_manager/diag_manager.F90 | 13 +-
diag_manager/fms_diag_file_object.F90 | 215 +++++++++++++++----
diag_manager/fms_diag_object.F90 | 6 +-
diag_manager/fms_diag_time_utils.F90 | 109 ++++++++--
diag_manager/fms_diag_yaml.F90 | 298 +++++++++++++++++----------
test_fms/diag_manager/Makefile.am | 3 +-
test_fms/diag_manager/check_crashes.sh | 2 +-
test_fms/diag_manager/test_diag_manager2.sh | 74 ++++++-
test_fms/diag_manager/test_flexible_time.F90 | 63 ++++++
10 files changed, 615 insertions(+), 174 deletions(-)
create mode 100644 test_fms/diag_manager/test_flexible_time.F90
diff --git a/diag_manager/diag_data.F90 b/diag_manager/diag_data.F90
index bb41a98c..20e72ae4 100644
--- a/diag_manager/diag_data.F90
+++ b/diag_manager/diag_data.F90
@@ -120,6 +120,8 @@ use platform_mod
INTEGER, PARAMETER :: time_sum = 5 !< The reudction method is sum
INTEGER, PARAMETER :: time_diurnal = 6 !< The reduction method is diurnal
INTEGER, PARAMETER :: time_power = 7 !< The reduction method is power
+ CHARACTER(len=7) :: avg_name = 'average' !< Name of the average fields
+ CHARACTER(len=8) :: no_units = "NO UNITS"!< String indicating that the variable has no units
!> @}
!> @brief Contains the coordinates of the local domain to output.
@@ -377,6 +379,10 @@ use platform_mod
!! .TRUE. is only supported if the diag_manager_init
!! routine is called with the optional time_init parameter.
LOGICAL :: use_modern_diag = .false. !< Namelist flag to use the modernized diag_manager code
+ LOGICAL :: use_clock_average = .false. !< .TRUE. if the averaging of variable is done based on the clock
+ !! For example, if doing daily averages and your start the simulation in
+ !! day1_hour3, it will do the average between day1_hour3 to day2_hour 0
+ !! the default behavior will do the average between day1 hour3 to day2 hour3
!
REAL :: FILL_VALUE = NF_FILL_REAL !< Fill value used. Value will be NF90_FILL_REAL if using the
diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90
index 4007a40a..855eaa29 100644
--- a/diag_manager/diag_manager.F90
+++ b/diag_manager/diag_manager.F90
@@ -208,7 +208,7 @@ use platform_mod
& get_ticks_per_second
USE mpp_mod, ONLY: mpp_get_current_pelist, mpp_pe, mpp_npes, mpp_root_pe, mpp_sum
- USE mpp_mod, ONLY: input_nml_file
+ USE mpp_mod, ONLY: input_nml_file, mpp_error
USE fms_mod, ONLY: error_mesg, FATAL, WARNING, NOTE, stdout, stdlog, write_version_number,&
& fms_error_handler, check_nml_error, lowercase
@@ -231,7 +231,7 @@ use platform_mod
& use_cmor, issue_oor_warnings, oor_warnings_fatal, oor_warning, pack_size,&
& max_out_per_in_field, flush_nc_files, region_out_use_alt_value, max_field_attributes, output_field_type,&
& max_file_attributes, max_axis_attributes, prepend_date, DIAG_FIELD_NOT_FOUND, diag_init_time,diag_data_init,&
- & use_modern_diag, diag_null
+ & use_modern_diag, use_clock_average, diag_null
USE diag_data_mod, ONLY: fileobj, fileobjU, fnum_for_domain, fileobjND
USE diag_table_mod, ONLY: parse_diag_table
@@ -3923,7 +3923,8 @@ INTEGER FUNCTION register_diag_field_array_old(module_name, field_name, axes, in
& max_input_fields, max_axes, do_diag_field_log, write_bytes_in_file, debug_diag_manager,&
& max_num_axis_sets, max_files, use_cmor, issue_oor_warnings,&
& oor_warnings_fatal, max_out_per_in_field, flush_nc_files, region_out_use_alt_value, max_field_attributes,&
- & max_file_attributes, max_axis_attributes, prepend_date, field_log_separator, use_modern_diag
+ & max_file_attributes, max_axis_attributes, prepend_date, field_log_separator, use_modern_diag, &
+ & use_clock_average
! If the module was already initialized do nothing
IF ( module_is_initialized ) RETURN
@@ -3977,6 +3978,10 @@ INTEGER FUNCTION register_diag_field_array_old(module_name, field_name, axes, in
END IF
END IF
+ IF (.not. use_modern_diag .and. use_clock_average) &
+ call mpp_error(FATAL, "diag_manager_mod: You cannot set use_modern_diag=.false. and &
+ & use_clock_average=.true. in diag_manager_nml")
+
IF ( mpp_pe() == mpp_root_pe() ) THEN
WRITE (stdlog_unit, diag_manager_nml)
END IF
@@ -4037,7 +4042,7 @@ INTEGER FUNCTION register_diag_field_array_old(module_name, field_name, axes, in
END IF
if (use_modern_diag) then
- CALL fms_diag_object%init(diag_subset_output)
+ CALL fms_diag_object%init(diag_subset_output)
endif
if (.not. use_modern_diag) then
CALL parse_diag_table(DIAG_SUBSET=diag_subset_output, ISTAT=mystat, ERR_MSG=err_msg_local)
diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90
index ce926170..b7135867 100644
--- a/diag_manager/fms_diag_file_object.F90
+++ b/diag_manager/fms_diag_file_object.F90
@@ -32,9 +32,10 @@ use diag_data_mod, only: DIAG_NULL, NO_DOMAIN, max_axes, SUB_REGIONAL, get_base_
TWO_D_DOMAIN, UG_DOMAIN, prepend_date, DIAG_DAYS, VERY_LARGE_FILE_FREQ, &
get_base_year, get_base_month, get_base_day, get_base_hour, get_base_minute, &
get_base_second, time_unit_list, time_average, time_rms, time_max, time_min, time_sum, &
- time_diurnal, time_power, time_none
+ time_diurnal, time_power, time_none, avg_name, no_units
use time_manager_mod, only: time_type, operator(>), operator(/=), operator(==), get_date, get_calendar_type, &
- VALID_CALENDAR_TYPES, operator(>=), date_to_string
+ VALID_CALENDAR_TYPES, operator(>=), date_to_string, &
+ OPERATOR(/), OPERATOR(+), operator(<)
use fms_diag_time_utils_mod, only: diag_time_inc, get_time_string, get_date_dif
use fms_diag_yaml_mod, only: diag_yaml, diagYamlObject_type, diagYamlFiles_type, subRegion_type, diagYamlFilesVar_type
use fms_diag_axis_object_mod, only: diagDomain_t, get_domain_and_domain_type, fmsDiagAxis_type, &
@@ -60,9 +61,12 @@ type :: fmsDiagFile_type
TYPE(time_type) :: last_output !< Time of the last time output was writen
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
!< This will be used when using the new_file_freq keys in the diag_table.yaml
- TYPE(time_type) :: next_open !< The next time to open the file
+ TYPE(time_type) :: next_close !< Time to close the file
+ logical :: is_file_open !< .True. if the file is opened
+
class(FmsNetcdfFile_t), allocatable :: fileobj !< fms2_io file object for this history file
type(diagYamlFiles_type), pointer :: diag_yaml_file => null() !< Pointer to the diag_yaml_file data
integer :: type_of_domain !< The type of domain to use to open the file
@@ -147,8 +151,10 @@ type fmsDiagFileContainer_type
procedure :: write_axis_data
procedure :: writing_on_this_pe
procedure :: is_time_to_write
+ procedure :: is_time_to_close_file
procedure :: write_time_data
procedure :: update_next_write
+ procedure :: update_current_new_file_freq_index
procedure :: increase_unlimited_dimension
procedure :: close_diag_file
end type fmsDiagFileContainer_type
@@ -209,7 +215,22 @@ logical function fms_diag_files_object_init (files_array)
obj%last_output = get_base_time()
obj%next_output = diag_time_inc(obj%start_time, obj%get_file_freq(), obj%get_file_frequnit())
obj%next_next_output = diag_time_inc(obj%next_output, obj%get_file_freq(), obj%get_file_frequnit())
- obj%next_open = get_base_time()
+
+ if (obj%has_file_new_file_freq()) then
+ obj%next_close = diag_time_inc(obj%start_time, obj%get_file_new_file_freq(), &
+ obj%get_file_new_file_freq_units())
+ else
+ obj%next_close = diag_time_inc(obj%start_time, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
+ endif
+ obj%is_file_open = .false.
+
+ if(obj%has_file_duration()) then
+ obj%no_more_data = diag_time_inc(obj%start_time, obj%get_file_duration(), &
+ obj%get_file_duration_units())
+ else
+ obj%no_more_data = diag_time_inc(obj%start_time, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
+ endif
+
obj%time_ops = .false.
obj%unlimited_dimension = 0
obj%is_static = obj%get_file_freq() .eq. -1
@@ -653,6 +674,20 @@ subroutine add_start_time(this, start_time)
this%last_output = start_time
this%next_output = diag_time_inc(start_time, this%get_file_freq(), this%get_file_frequnit())
this%next_next_output = diag_time_inc(this%next_output, this%get_file_freq(), this%get_file_frequnit())
+ if (this%has_file_new_file_freq()) then
+ this%next_close = diag_time_inc(this%start_time, this%get_file_new_file_freq(), &
+ this%get_file_new_file_freq_units())
+ else
+ this%next_close = diag_time_inc(this%start_time, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
+ endif
+
+ if(this%has_file_duration()) then
+ this%no_more_data = diag_time_inc(this%start_time, this%get_file_duration(), &
+ this%get_file_duration_units())
+ else
+ this%no_more_data = diag_time_inc(this%start_time, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
+ endif
+
endif
end subroutine
@@ -667,7 +702,7 @@ subroutine dump_file_obj(this, unit_num)
write( unit_num, *) 'last_output', date_to_string(this%last_output)
write( unit_num, *) 'next_output', date_to_string(this%next_output)
write( unit_num, *)'next_next_output', date_to_string(this%next_next_output)
- write( unit_num, *)'next_open', date_to_string(this%next_open)
+ write( unit_num, *)'next_close', date_to_string(this%next_close)
if( allocated(this%fileobj)) write( unit_num, *)'fileobj path', this%fileobj%path
@@ -714,8 +749,8 @@ subroutine open_diag_file(this, time_step, file_is_opened)
domain => diag_file%domain
file_is_opened = .false.
- !< Go away if it is not time to open the file
- if (diag_file%next_open > time_step) return
+ !< Go away if it the file is already open
+ if (diag_file%is_file_open) return
is_regional = .false.
!< Figure out what fileobj to use!
@@ -736,9 +771,6 @@ subroutine open_diag_file(this, time_step, file_is_opened)
allocate(FmsNetcdfUnstructuredDomainFile_t :: diag_file%fileobj)
end select
end select
- else
- !< In this case, we are opening a new file so close the current the file
- call this%close_diag_file()
endif
!< Figure out what to name of the file
@@ -812,18 +844,29 @@ subroutine open_diag_file(this, time_step, file_is_opened)
end select
end select
- if (diag_file%has_file_new_file_freq()) then
- diag_file%next_open = diag_time_inc(diag_file%next_open, diag_file%get_file_new_file_freq(), &
- diag_file%get_file_new_file_freq_units())
- else
- diag_file%next_open = diag_time_inc(diag_file%next_open, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
- endif
-
file_is_opened = .true.
+ diag_file%is_file_open = file_is_opened
domain => null()
diag_file => null()
end subroutine open_diag_file
+!< @brief Writes a variable's metadata in the netcdf file
+subroutine write_var_metadata(fileobj, variable_name, dimensions, long_name, units)
+ class(FmsNetcdfFile_t), intent(inout) :: fileobj !< The file object to write into
+ character(len=*) , intent(in) :: variable_name !< The name of the time variables
+ character(len=*) , intent(in) :: dimensions(:) !< The dimensions of the variable
+ character(len=*) , intent(in) :: long_name !< The long_name of the variable
+ character(len=*) , intent(in) :: units !< The units of the variable
+
+ !TODO harcodded double
+ call register_field(fileobj, variable_name, "double", dimensions)
+ call register_variable_attribute(fileobj, variable_name, "long_name", &
+ trim(long_name), str_len=len_trim(long_name))
+ if (trim(units) .ne. no_units) &
+ call register_variable_attribute(fileobj, variable_name, "units", &
+ trim(units), str_len=len_trim(units))
+end subroutine write_var_metadata
+
!> \brief Write the time metadata to the diag file
subroutine write_time_metadata(this)
class(fmsDiagFileContainer_type), intent(inout), target :: this !< The file object
@@ -834,6 +877,7 @@ subroutine write_time_metadata(this)
character(len=50) :: calendar !< The calendar name
character(len=:), allocatable :: time_var_name !< The name of the time variable as it is defined in the yaml
+ character(len=50) :: dimensions(2) !< Array of dimensions names for the variable
diag_file => this%FMS_diag_file
fileobj => diag_file%fileobj
@@ -846,14 +890,14 @@ subroutine write_time_metadata(this)
& get_base_month(), get_base_day(), get_base_hour(), get_base_minute(), get_base_second()
11 FORMAT(a, ' since ', i4.4, '-', i2.2, '-', i2.2, ' ', i2.2, ':', i2.2, ':', i2.2)
- !TODO harcodded "double"
- call register_field(fileobj, time_var_name, "double", (/time_var_name/))
- call register_variable_attribute(fileobj, time_var_name, "units", trim(time_units_str), &
- str_len=len_trim(time_units_str))
+ dimensions(1) = "nv"
+ dimensions(2) = trim(time_var_name)
+
+ call write_var_metadata(fileobj, time_var_name, dimensions(2:2), &
+ time_var_name, time_units_str)
+ !< Add additional variables to the time variable
call register_variable_attribute(fileobj, time_var_name, "axis", "T", str_len=1 )
- call register_variable_attribute(fileobj, time_var_name, "long_name", trim(time_var_name), &
- str_len=len_trim(time_var_name) )
!TODO no need to have both attributes, probably?
calendar = valid_calendar_types(get_calendar_type())
@@ -862,11 +906,41 @@ subroutine write_time_metadata(this)
call register_variable_attribute(fileobj, time_var_name, "calendar", &
lowercase(trim(calendar)), str_len=len_trim(calendar))
- if (diag_file%time_ops) call register_variable_attribute(fileobj, time_var_name, "bounds", &
- trim(time_var_name)//"_bounds", str_len=len_trim(time_var_name//"_bounds"))
+ if (diag_file%time_ops) then
+ call register_variable_attribute(fileobj, time_var_name, "bounds", &
+ trim(time_var_name)//"_bounds", str_len=len_trim(time_var_name//"_bounds"))
+
+ !< Write out the "average_*" variables metadata
+ call write_var_metadata(fileobj, avg_name//"_T1", dimensions(2:2), &
+ "Start time for average period", time_units_str)
+ call write_var_metadata(fileobj, avg_name//"_T2", dimensions(2:2), &
+ "End time for average period", time_units_str)
+ call write_var_metadata(fileobj, avg_name//"_DT", dimensions(2:2), &
+ "Length time for average period", time_units_str)
+
+ !< Write out the *_bounds variable metadata
+ call register_axis(fileobj, "nv", 2) !< Time bounds need a vertex number
+ call write_var_metadata(fileobj, "nv", dimensions(1:1), &
+ "vertex number", no_units)
+ call write_var_metadata(fileobj, time_var_name//"_bounds", dimensions, &
+ trim(time_var_name)//" axis boundaries", time_units_str)
+ endif
end subroutine write_time_metadata
+!> \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)
+ class(fmsDiagFileContainer_type), intent(in), target :: this !< The file object
+ TYPE(time_type), intent(in) :: time_step !< Current model step time
+
+ if (time_step >= this%FMS_diag_file%next_close) then
+ is_time_to_close_file = .true.
+ else
+ is_time_to_close_file = .false.
+ endif
+end function
+
!> \brief Determine if it is time to "write" to the file
logical function is_time_to_write(this, time_step)
class(fmsDiagFileContainer_type), intent(in), target :: this !< The file object
@@ -875,7 +949,7 @@ logical function is_time_to_write(this, time_step)
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) &
+ if (time_step > this%FMS_diag_file%next_next_output) &
call mpp_error(FATAL, this%FMS_diag_file%get_file_fname()//&
&": Diag_manager_mod:: You skipped a time_step. Be sure that diag_send_complete is called at every time step "&
&" needed by the file.")
@@ -898,33 +972,75 @@ logical function writing_on_this_pe(this)
end function
!> \brief Write out the time data to the file
-subroutine write_time_data(this, time_step)
- class(fmsDiagFileContainer_type), intent(in), target :: this !< The file object
- TYPE(time_type), intent(in) :: time_step !< Current model step time
+subroutine write_time_data(this)
+ class(fmsDiagFileContainer_type), intent(in), target :: this !< The file object
real :: dif !< The time as a real number
class(fmsDiagFile_type), pointer :: diag_file !< Diag_file object to open
class(FmsNetcdfFile_t), pointer :: fileobj !< The fileobj to write to
+ TYPE(time_type) :: middle_time !< The middle time of the averaging period
+
+ real :: T1 !< The beginning time of the averaging period
+ real :: T2 !< The ending time of the averaging period
+ real :: DT !< The difference between the ending and beginning time of the averaging period
diag_file => this%FMS_diag_file
fileobj => diag_file%fileobj
- !> dif is the time as a real that is evaluated
- dif = get_date_dif(time_step, get_base_time(), diag_file%get_file_timeunit())
- select type (fileobj)
- type is (FmsNetcdfDomainFile_t)
- call write_data(fileobj, diag_file%get_file_unlimdim(), dif, &
- unlim_dim_level=diag_file%unlimited_dimension)
- type is (FmsNetcdfUnstructuredDomainFile_t)
- call write_data(fileobj, diag_file%get_file_unlimdim(), dif, &
- unlim_dim_level=diag_file%unlimited_dimension)
- type is (FmsNetcdfFile_t)
- call write_data(fileobj, diag_file%get_file_unlimdim(), dif, &
- unlim_dim_level=diag_file%unlimited_dimension)
- end select
+ if (diag_file%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
+ dif = get_date_dif(diag_file%next_output, get_base_time(), diag_file%get_file_timeunit())
+ endif
+
+ call write_data(fileobj, diag_file%get_file_unlimdim(), dif, &
+ unlim_dim_level=diag_file%unlimited_dimension)
+
+ if (diag_file%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())
+ DT = T2 - T1
+
+ call write_data(fileobj, avg_name//"_T1", T1, unlim_dim_level=diag_file%unlimited_dimension)
+ call write_data(fileobj, avg_name//"_T2", T2, unlim_dim_level=diag_file%unlimited_dimension)
+ call write_data(fileobj, avg_name//"_DT", DT, unlim_dim_level=diag_file%unlimited_dimension)
+ call write_data(fileobj, trim(diag_file%get_file_unlimdim())//"_bounds", &
+ (/T1, T2/), unlim_dim_level=diag_file%unlimited_dimension)
+
+ if (diag_file%unlimited_dimension .eq. 1) then
+ call write_data(fileobj, "nv", (/1, 2/))
+ endif
+ endif
end subroutine write_time_data
+!> \brief Updates the current_new_file_freq_index if using a new_file_freq
+subroutine update_current_new_file_freq_index(this, time_step)
+ class(fmsDiagFileContainer_type), intent(inout), target :: this !< The file object
+ TYPE(time_type), intent(in) :: time_step !< Current model step time
+
+ class(fmsDiagFile_type), pointer :: diag_file !< Diag_file object to open
+
+ diag_file => this%FMS_diag_file
+
+ if (time_step >= diag_file%no_more_data) then
+ call diag_file%diag_yaml_file%increase_new_file_freq_index()
+
+ if (diag_file%has_file_duration()) then
+ diag_file%no_more_data = diag_time_inc(diag_file%no_more_data, diag_file%get_file_duration(), &
+ diag_file%get_file_duration_units())
+ else
+ !< At this point you are done writing data
+ 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
+ diag_file%last_output = diag_file%no_more_data
+ diag_file%next_close = diag_file%no_more_data
+ endif
+ endif
+end subroutine update_current_new_file_freq_index
+
!> \brief Set up the next_output and next_next_output variable in a file obj
subroutine update_next_write(this, time_step)
class(fmsDiagFileContainer_type), intent(in), target :: this !< The file object
@@ -934,9 +1050,11 @@ subroutine update_next_write(this, time_step)
diag_file => this%FMS_diag_file
if (diag_file%is_static) then
+ diag_file%last_output = diag_file%next_output
diag_file%next_output = diag_time_inc(diag_file%next_output, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
diag_file%next_next_output = diag_time_inc(diag_file%next_output, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
else
+ diag_file%last_output = diag_file%next_output
diag_file%next_output = diag_time_inc(diag_file%next_output, diag_file%get_file_freq(), &
diag_file%get_file_frequnit())
diag_file%next_next_output = diag_time_inc(diag_file%next_output, diag_file%get_file_freq(), &
@@ -1008,6 +1126,8 @@ end subroutine write_axis_data
subroutine close_diag_file(this)
class(fmsDiagFileContainer_type), intent(inout), target :: this !< The file object
+ if (.not. this%FMS_diag_file%is_file_open) return
+
!< The select types are needed here because otherwise the code will go to the
!! wrong close_file routine and things will not close propertly
select type( fileobj => this%FMS_diag_file%fileobj)
@@ -1019,6 +1139,17 @@ subroutine close_diag_file(this)
call close_file(fileobj)
end select
+ !< Reset the unlimited dimension back to 0, in case the fileobj is re-used
+ this%FMS_diag_file%unlimited_dimension = 0
+ this%FMS_diag_file%is_file_open = .false.
+
+ if (this%FMS_diag_file%has_file_new_file_freq()) then
+ this%FMS_diag_file%next_close = diag_time_inc(this%FMS_diag_file%next_close, &
+ this%FMS_diag_file%get_file_new_file_freq(), &
+ this%FMS_diag_file%get_file_new_file_freq_units())
+ else
+ this%FMS_diag_file%next_close = diag_time_inc(this%FMS_diag_file%next_close, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
+ endif
end subroutine close_diag_file
#endif
diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90
index 3811cfcc..95e92694 100644
--- a/diag_manager/fms_diag_object.F90
+++ b/diag_manager/fms_diag_object.F90
@@ -456,9 +456,11 @@ CALL MPP_ERROR(FATAL,"You can not use the modern diag manager without compiling
if (diag_file%is_time_to_write(time_step)) then
call diag_file%increase_unlimited_dimension()
- call diag_file%write_time_data(time_step)
- !TODO call diag_file%add_variable_data()
+ call diag_file%write_time_data()
+ !TODO call diag_file%add_variable_data()
call diag_file%update_next_write(time_step)
+ call diag_file%update_current_new_file_freq_index(time_step)
+ if (diag_file%is_time_to_close_file(time_step)) call diag_file%close_diag_file
endif
enddo
#endif
diff --git a/diag_manager/fms_diag_time_utils.F90 b/diag_manager/fms_diag_time_utils.F90
index 779f3d5f..de18228d 100644
--- a/diag_manager/fms_diag_time_utils.F90
+++ b/diag_manager/fms_diag_time_utils.F90
@@ -27,9 +27,9 @@
module fms_diag_time_utils_mod
use time_manager_mod, only: time_type, increment_date, increment_time, get_calendar_type, NO_CALENDAR, leap_year, &
- get_date, get_time, operator(>), operator(<), operator(-)
+ get_date, get_time, operator(>), operator(<), operator(-), set_date
use diag_data_mod, only: END_OF_RUN, EVERY_TIME, DIAG_SECONDS, DIAG_MINUTES, DIAG_HOURS, DIAG_DAYS, DIAG_MONTHS, &
- DIAG_YEARS
+ DIAG_YEARS, use_clock_average
USE constants_mod, ONLY: SECONDS_PER_DAY, SECONDS_PER_HOUR, SECONDS_PER_MINUTE
use fms_mod, only: fms_error_handler
use mpp_mod, only: mpp_error, FATAL
@@ -52,65 +52,144 @@ contains
!! An empty string indicates the next output
!! time was found successfully.
+ if (use_clock_average) then
+ diag_time_inc = diag_clock_time_inc(time, output_freq, output_units, err_msg)
+ else
+ diag_time_inc = diag_forecast_time_inc(time, output_freq, output_units, err_msg)
+ endif
+ end function diag_time_inc
+
+ !> @brief Determine the next time data/file is to be written based on the frequency and units using the clock.
+ !! For example, if doing daily averages and the input time is day1_hour3, the output time will be day2_hour0.
+ !! @return the next time data/file is to be written
+ TYPE(time_type) FUNCTION diag_clock_time_inc(time, output_freq, output_units, err_msg)
+ TYPE(time_type), INTENT(in) :: time !< Current model time.
+ INTEGER, INTENT(in) :: output_freq !< Output frequency number value.
+ INTEGER, INTENT(in) :: output_units !< Output frequency unit.
+ CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg !< Function error message.
+ !! An empty string indicates the next output
+ !! time was found successfully.
CHARACTER(len=128) :: error_message_local !< Local variable to store the error_message
+ integer :: cyear !< The current year stored in the time type
+ integer :: cmonth !< The current month stored in the time type
+ integer :: cday !< The current day stored in the time type
+ integer :: chour !< The current hour stored in the time type
+ integer :: cmin !< The current minute stored in the time type
+ integer :: csecond !< The current second stored in the time type
+ type(time_type) :: my_time !< Time set at the begining of the
IF ( PRESENT(err_msg) ) err_msg = ''
error_message_local = ''
+ IF ( get_calendar_type() == NO_CALENDAR) then
+ error_message_local = 'If using use_clock_average =.TRUE., your calendar must be set.'
+ IF ( fms_error_handler('diag_clock_time_inc',error_message_local,err_msg) ) RETURN
+ endif
+
! special values for output frequency are -1 for output at end of run
! and 0 for every timestep. Need to check for these here?
! Return zero time increment, hopefully this value is never used
IF ( output_freq == END_OF_RUN .OR. output_freq == EVERY_TIME ) THEN
- diag_time_inc = time
+ diag_clock_time_inc = time
+ RETURN
+ END IF
+
+ call get_date(Time, cyear, cmonth, cday, chour, cmin, csecond)
+
+ select case (output_units)
+ case (DIAG_SECONDS)
+ my_time = set_date(cyear, cmonth, cday, chour, cmin, csecond) !< set my_time to the begining of the hour
+ diag_clock_time_inc = increment_date(my_time, 0, 0, 0, 0, 0, output_freq, err_msg=error_message_local)
+ case (DIAG_MINUTES)
+ my_time = set_date(cyear, cmonth, cday, chour, cmin, 0) !< set my_time to the begining of the hour
+ diag_clock_time_inc = increment_date(my_time, 0, 0, 0, 0, output_freq, 0, err_msg=error_message_local)
+ case (DIAG_HOURS)
+ my_time = set_date(cyear, cmonth, cday, chour, 0, 0) !< set my_time to the begining of the hour
+ diag_clock_time_inc = increment_date(my_time, 0, 0, 0, output_freq, 0, 0, err_msg=error_message_local)
+ case (DIAG_DAYS)
+ my_time = set_date(cyear, cmonth, cday, 0, 0, 0) !< set my_time to the begining of the day
+ diag_clock_time_inc = increment_date(my_time, 0, 0, output_freq, 0, 0, 0, err_msg=error_message_local)
+ case (DIAG_MONTHS)
+ my_time = set_date(cyear, cmonth, 1, 0, 0, 0) !< set my_time to the begining of the month
+ diag_clock_time_inc = increment_date(my_time, 0, output_freq, 0, 0, 0, 0, err_msg=error_message_local)
+ case (DIAG_YEARS)
+ my_time = set_date(cyear, 1, 1, 0, 0, 0) !< set my_time to the begining of the year
+ diag_clock_time_inc = increment_date(my_time, output_freq, 0, 0, 0, 0, 0, err_msg=error_message_local)
+ end select
+
+ end function diag_clock_time_inc
+
+ !> @brief Determine the next time data/file is to be written based on the frequency and units using forecast time.
+ !! For example, if doing daily averages and the input time is day1_hour3, the output time will be day2_hour3.
+ !! @return the next time data/file is to be written
+ TYPE(time_type) FUNCTION diag_forecast_time_inc(time, output_freq, output_units, err_msg)
+ TYPE(time_type), INTENT(in) :: time !< Current model time.
+ INTEGER, INTENT(in) :: output_freq !< Output frequency number value.
+ INTEGER, INTENT(in) :: output_units !< Output frequency unit.
+ CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg !< Function error message.
+ !! An empty string indicates the next output
+ !! time was found successfully.
+
+ CHARACTER(len=128) :: error_message_local !< Local variable to store the error_message
+
+ IF ( PRESENT(err_msg) ) err_msg = ''
+ error_message_local = ''
+
+ ! special values for output frequency are -1 for output at end of run
+ ! and 0 for every timestep. Need to check for these here?
+ ! Return zero time increment, hopefully this value is never used
+ IF ( output_freq == END_OF_RUN .OR. output_freq == EVERY_TIME ) THEN
+ diag_forecast_time_inc = time
RETURN
END IF
! Make sure calendar was not set after initialization
IF ( output_units == DIAG_SECONDS ) THEN
IF ( get_calendar_type() == NO_CALENDAR ) THEN
- diag_time_inc = increment_time(time, output_freq, 0, err_msg=error_message_local)
+ diag_forecast_time_inc = increment_time(time, output_freq, 0, err_msg=error_message_local)
ELSE
- diag_time_inc = increment_date(time, 0, 0, 0, 0, 0, output_freq, err_msg=error_message_local)
+ diag_forecast_time_inc = increment_date(time, 0, 0, 0, 0, 0, output_freq, err_msg=error_message_local)
END IF
ELSE IF ( output_units == DIAG_MINUTES ) THEN
IF ( get_calendar_type() == NO_CALENDAR ) THEN
- diag_time_inc = increment_time(time, NINT(output_freq*SECONDS_PER_MINUTE), 0, &
+ diag_forecast_time_inc = increment_time(time, NINT(output_freq*SECONDS_PER_MINUTE), 0, &
&err_msg=error_message_local)
ELSE
- diag_time_inc = increment_date(time, 0, 0, 0, 0, output_freq, 0, err_msg=error_message_local)
+ diag_forecast_time_inc = increment_date(time, 0, 0, 0, 0, output_freq, 0, err_msg=error_message_local)
END IF
ELSE IF ( output_units == DIAG_HOURS ) THEN
IF ( get_calendar_type() == NO_CALENDAR ) THEN
- diag_time_inc = increment_time(time, NINT(output_freq*SECONDS_PER_HOUR), 0, err_msg=error_message_local)
+ diag_forecast_time_inc = increment_time(time, NINT(output_freq*SECONDS_PER_HOUR), 0, &
+ &err_msg=error_message_local)
ELSE
- diag_time_inc = increment_date(time, 0, 0, 0, output_freq, 0, 0, err_msg=error_message_local)
+ diag_forecast_time_inc = increment_date(time, 0, 0, 0, output_freq, 0, 0, err_msg=error_message_local)
END IF
ELSE IF ( output_units == DIAG_DAYS ) THEN
IF (get_calendar_type() == NO_CALENDAR) THEN
- diag_time_inc = increment_time(time, 0, output_freq, err_msg=error_message_local)
+ diag_forecast_time_inc = increment_time(time, 0, output_freq, err_msg=error_message_local)
ELSE
- diag_time_inc = increment_date(time, 0, 0, output_freq, 0, 0, 0, err_msg=error_message_local)
+ diag_forecast_time_inc = increment_date(time, 0, 0, output_freq, 0, 0, 0, err_msg=error_message_local)
END IF
ELSE IF ( output_units == DIAG_MONTHS ) THEN
IF (get_calendar_type() == NO_CALENDAR) THEN
error_message_local = 'output units of months NOT allowed with no calendar'
ELSE
- diag_time_inc = increment_date(time, 0, output_freq, 0, 0, 0, 0, err_msg=error_message_local)
+ diag_forecast_time_inc = increment_date(time, 0, output_freq, 0, 0, 0, 0, err_msg=error_message_local)
END IF
ELSE IF ( output_units == DIAG_YEARS ) THEN
IF ( get_calendar_type() == NO_CALENDAR ) THEN
error_message_local = 'output units of years NOT allowed with no calendar'
ELSE
- diag_time_inc = increment_date(time, output_freq, 0, 0, 0, 0, 0, err_msg=error_message_local)
+ diag_forecast_time_inc = increment_date(time, output_freq, 0, 0, 0, 0, 0, err_msg=error_message_local)
END IF
ELSE
error_message_local = 'illegal output units'
END IF
IF ( error_message_local /= '' ) THEN
- IF ( fms_error_handler('diag_time_inc',error_message_local,err_msg) ) RETURN
+ IF ( fms_error_handler('diag_forecast_time_inc',error_message_local,err_msg) ) RETURN
END IF
- END FUNCTION diag_time_inc
+ END FUNCTION diag_forecast_time_inc
!> @brief This function determines a string based on current time.
!! This string is used as suffix in output file name
diff --git a/diag_manager/fms_diag_yaml.F90 b/diag_manager/fms_diag_yaml.F90
index b3137d38..8e42b5cc 100644
--- a/diag_manager/fms_diag_yaml.F90
+++ b/diag_manager/fms_diag_yaml.F90
@@ -56,6 +56,7 @@ public :: dump_diag_yaml_obj
integer, parameter :: basedate_size = 6
integer, parameter :: NUM_SUB_REGION_ARRAY = 8
integer, parameter :: MAX_STR_LEN = 255
+integer, parameter :: MAX_FREQ = 12
!> @brief type to hold an array of sorted diag_fiels
@@ -85,73 +86,79 @@ end type subRegion_type
!> @brief type to hold the diag_file information
type diagYamlFiles_type
- character (len=:), private, allocatable :: file_fname !< file name
- integer, private :: file_frequnit !< the frequency unit (DIAG_SECONDS, DIAG_MINUTES, &
- !! DIAG_HOURS, DIAG_DAYS, DIAG_YEARS)
- integer, private :: file_freq !< the frequency of data
- integer, private :: file_timeunit !< The unit of time (DIAG_SECONDS, DIAG_MINUTES, &
- !! DIAG_HOURS, DIAG_DAYS, DIAG_YEARS)
- character (len=:), private, allocatable :: file_unlimdim !< The name of the unlimited dimension
- type(subRegion_type), private :: file_sub_region !< type containing info about the subregion, if any
- integer, private :: file_new_file_freq !< Frequency for closing the existing file
- integer, private :: file_new_file_freq_units !< Time units for creating a new file.
- !! Required if “new_file_freq” used
- !! (DIAG_SECONDS, DIAG_MINUTES, &
- !! DIAG_HOURS, DIAG_DAYS, DIAG_YEARS)
- character (len=:), private, allocatable :: file_start_time !< Time to start the file for the first time. Requires
- !! “new_file_freq”
- integer, private :: file_duration !< How long the file should receive data after start time
- !! in “file_duration_units”. This optional field can only
- !! be used if the start_time field is present. If this field
- !! is absent, then the file duration will be equal to the
- !! frequency for creating new files.
- !! NOTE: The file_duration_units field must also be present if
- !! this field is present.
- integer, private :: file_duration_units !< The file duration units
- !! (DIAG_SECONDS, DIAG_MINUTES, &
- !! DIAG_HOURS, DIAG_DAYS, DIAG_YEARS)
+ private
+ character (len=:), allocatable :: file_fname !< file name
+ integer :: file_frequnit(MAX_FREQ) !< the frequency unit (DIAG_SECONDS,
+ !! DIAG_MINUTES, DIAG_HOURS, DIAG_DAYS,
+ !! DIAG_YEARS)
+ integer :: file_freq(MAX_FREQ) !< the frequency of data
+ integer :: file_timeunit !< The unit of time (DIAG_SECONDS,
+ !! DIAG_MINUTES, DIAG_HOURS, DIAG_DAYS,
+ !! DIAG_YEARS)
+ character (len=:), allocatable :: file_unlimdim !< The name of the unlimited dimension
+ type(subRegion_type) :: file_sub_region !< type containing info about the subregion
+ integer :: file_new_file_freq(MAX_FREQ) !< Frequency for closing the existing file
+ integer :: file_new_file_freq_units(MAX_FREQ) !< Time units for creating a new file.
+ !! Required if “new_file_freq” used
+ !! (DIAG_SECONDS, DIAG_MINUTES, &
+ !! DIAG_HOURS, DIAG_DAYS, DIAG_YEARS)
+ character (len=:), allocatable :: file_start_time !< Time to start the file for the
+ !! first time. Requires “new_file_freq”
+ integer :: file_duration(MAX_FREQ) !< How long the file should receive data
+ !! after start time in file_duration_units.
+ !! This optional field can only be used if
+ !! the start_time field is present. If this
+ !! field is absent, then the file duration
+ !! will be equal to the frequency for
+ !! creating new files. NOTE: The
+ !! file_duration_units field must also
+ !! be present if this field is present.
+ integer :: file_duration_units(MAX_FREQ) !< The file duration units
+ !! (DIAG_SECONDS, DIAG_MINUTES, &
+ !! DIAG_HOURS, DIAG_DAYS, DIAG_YEARS)
+ integer :: current_new_file_freq_index !< The index of the new_file_freq array
!< Need to use `MAX_STR_LEN` because not all filenames/global attributes are the same length
- character (len=MAX_STR_LEN), dimension(:), private, allocatable :: file_varlist !< An array of variable names
- !! within a file
- character (len=MAX_STR_LEN), dimension(:,:), private, allocatable :: file_global_meta !< Array of key(dim=1)
- !! and values(dim=2) to be
- !! added as global meta data to
- !! the file
+ character (len=MAX_STR_LEN), allocatable :: file_varlist(:) !< An array of variable names
+ !! within a file
+ character (len=MAX_STR_LEN), allocatable :: file_global_meta(:,:) !< Array of key(dim=1)
+ !! and values(dim=2) to be
+ !! added as global meta data to
+ !! the file
contains
!> All getter functions (functions named get_x(), for member field named x)
!! return copies of the member variables unless explicitly noted.
- procedure :: size_file_varlist
- procedure :: get_file_fname
- procedure :: get_file_frequnit
- procedure :: get_file_freq
- procedure :: get_file_timeunit
- procedure :: get_file_unlimdim
- procedure :: get_file_sub_region
- procedure :: get_file_new_file_freq
- procedure :: get_file_new_file_freq_units
- procedure :: get_file_start_time
- procedure :: get_file_duration
- procedure :: get_file_duration_units
- procedure :: get_file_varlist
- procedure :: get_file_global_meta
- procedure :: is_global_meta
+ procedure, public :: size_file_varlist
+ procedure, public :: get_file_fname
+ procedure, public :: get_file_frequnit
+ procedure, public :: get_file_freq
+ procedure, public :: get_file_timeunit
+ procedure, public :: get_file_unlimdim
+ procedure, public :: get_file_sub_region
+ procedure, public :: get_file_new_file_freq
+ procedure, public :: get_file_new_file_freq_units
+ procedure, public :: get_file_start_time
+ procedure, public :: get_file_duration
+ procedure, public :: get_file_duration_units
+ procedure, public :: get_file_varlist
+ procedure, public :: get_file_global_meta
+ procedure, public :: is_global_meta
!> Has functions to determine if allocatable variables are true. If a variable is not an allocatable
!! then is will always return .true.
- procedure :: has_file_fname
- procedure :: has_file_frequnit
- procedure :: has_file_freq
- procedure :: has_file_timeunit
- procedure :: has_file_unlimdim
- procedure :: has_file_sub_region
- procedure :: has_file_new_file_freq
- procedure :: has_file_new_file_freq_units
- procedure :: has_file_start_time
- procedure :: has_file_duration
- procedure :: has_file_duration_units
- procedure :: has_file_varlist
- procedure :: has_file_global_meta
-
+ procedure, public :: has_file_fname
+ procedure, public :: has_file_frequnit
+ procedure, public :: has_file_freq
+ procedure, public :: has_file_timeunit
+ procedure, public :: has_file_unlimdim
+ procedure, public :: has_file_sub_region
+ procedure, public :: has_file_new_file_freq
+ procedure, public :: has_file_new_file_freq_units
+ procedure, public :: has_file_start_time
+ procedure, public :: has_file_duration
+ procedure, public :: has_file_duration_units
+ procedure, public :: has_file_varlist
+ procedure, public :: has_file_global_meta
+ procedure, public :: increase_new_file_freq_index
end type diagYamlFiles_type
!> @brief type to hold the info a diag_field
@@ -470,30 +477,31 @@ subroutine fill_in_diag_files(diag_yaml_id, diag_file_id, fileobj)
integer, allocatable :: key_ids(:) !< Id of the gloabl atttributes key/value pairs
character(len=:), ALLOCATABLE :: grid_type !< grid_type as it is read in from the yaml
- character(len=:), ALLOCATABLE :: buffer !< buffer to store any *_units as it is read from the yaml
+ character(len=:), ALLOCATABLE :: freq_buffer !< buffer to store any freq as it is read from the yaml
+ character(len=:), ALLOCATABLE :: buffer !< buffer to store any *_units as it is read from the yaml
call diag_get_value_from_key(diag_yaml_id, diag_file_id, "file_name", fileobj%file_fname)
call diag_get_value_from_key(diag_yaml_id, diag_file_id, "freq_units", buffer)
- call get_value_from_key(diag_yaml_id, diag_file_id, "freq", fileobj%file_freq)
- call set_file_freq(fileobj, buffer)
+ call diag_get_value_from_key(diag_yaml_id, diag_file_id, "freq", freq_buffer)
+ call set_file_freq(fileobj, freq_buffer, buffer)
- deallocate(buffer)
+ deallocate(freq_buffer, buffer)
call diag_get_value_from_key(diag_yaml_id, diag_file_id, "unlimdim", fileobj%file_unlimdim)
call diag_get_value_from_key(diag_yaml_id, diag_file_id, "time_units", buffer)
call set_file_time_units(fileobj, buffer)
deallocate(buffer)
- call get_value_from_key(diag_yaml_id, diag_file_id, "new_file_freq", fileobj%file_new_file_freq, is_optional=.true.)
+ call diag_get_value_from_key(diag_yaml_id, diag_file_id, "new_file_freq", freq_buffer, is_optional=.true.)
call diag_get_value_from_key(diag_yaml_id, diag_file_id, "new_file_freq_units", buffer, &
is_optional=.true.)
- call set_new_file_freq(fileobj, buffer)
+ call set_new_file_freq(fileobj, freq_buffer, buffer)
- deallocate(buffer)
+ deallocate(freq_buffer, buffer)
call diag_get_value_from_key(diag_yaml_id, diag_file_id, "start_time", fileobj%file_start_time, is_optional=.true.)
- call get_value_from_key(diag_yaml_id, diag_file_id, "file_duration", fileobj%file_duration, is_optional=.true.)
+ call diag_get_value_from_key(diag_yaml_id, diag_file_id, "file_duration", freq_buffer, is_optional=.true.)
call diag_get_value_from_key(diag_yaml_id, diag_file_id, "file_duration_units", buffer, &
is_optional=.true.)
- call set_file_duration(fileobj, buffer)
+ call set_file_duration(fileobj, freq_buffer, buffer)
nsubregion = 0
nsubregion = get_num_blocks(diag_yaml_id, "sub_region", parent_block_id=diag_file_id)
@@ -522,7 +530,8 @@ subroutine fill_in_diag_files(diag_yaml_id, diag_file_id, fileobj)
enddo
deallocate(key_ids)
elseif (natt .ne. 0) then
- call mpp_error(FATAL, "diag_yaml_object_init: file "//trim(fileobj%file_fname)//" has multiple global_meta blocks")
+ call mpp_error(FATAL, "diag_yaml_object_init: file "//trim(fileobj%file_fname)//&
+ &" has multiple global_meta blocks")
endif
end subroutine
@@ -658,14 +667,31 @@ end function
!> @brief This checks if the file frequency and file frequency units in a diag file are valid and
!! sets the integer equivalent
-subroutine set_file_freq(fileobj, file_frequnit)
+subroutine set_file_freq(fileobj, file_freq, file_frequnit)
type(diagYamlFiles_type), intent(inout) :: fileobj !< diagYamlFiles_type obj to check
+ character(len=*), intent(in) :: file_freq !< File_freq as it is read from the diag_table
character(len=*), intent(in) :: file_frequnit !< File_freq_units as it is read from the diag_table
- if (.not. (fileobj%file_freq >= -1) ) &
- call mpp_error(FATAL, "freq must be greater than or equal to -1. &
- &Check you entry for"//trim(fileobj%file_fname))
- fileobj%file_frequnit = set_valid_time_units(file_frequnit, "frequnit for file:"//trim(fileobj%file_fname))
+ integer :: i !< For do loops
+ character(len=10) :: file_freq_units(MAX_FREQ) !< Array of file frequencies as a string
+ integer :: err_unit !< Dummy error unit
+
+ file_freq_units = ""
+ read(file_freq, *, iostat=err_unit) fileobj%file_freq
+ read(file_frequnit, *, iostat=err_unit) file_freq_units
+
+ do i = 1, MAX_FREQ
+ if (fileobj%file_freq(i) >= -1) then
+ if (trim(file_freq_units(i)) .eq. "") &
+ call mpp_error(FATAL, "file_freq_units is required. &
+ &Check your entry for file:"//trim(fileobj%file_fname))
+
+ fileobj%file_frequnit(i) = set_valid_time_units(file_freq_units(i), &
+ "file_freq_units for file:"//trim(fileobj%file_fname))
+ else
+ return
+ endif
+ enddo
end subroutine set_file_freq
!> @brief This checks if the time unit in a diag file is valid and sets the integer equivalent
@@ -678,34 +704,89 @@ end subroutine set_file_time_units
!> @brief This checks if the new file frequency and the new file frequency units in a diag file are valid
!! and sets the integer equivalent
-subroutine set_new_file_freq(fileobj, file_new_file_freq_units)
- type(diagYamlFiles_type), intent(inout) :: fileobj !< diagYamlFiles_type obj to check
- character(len=*), intent(in) :: file_new_file_freq_units !< new file freq units as it is read from
+subroutine set_new_file_freq(fileobj, new_file_freq, new_file_freq_units)
+ type(diagYamlFiles_type), intent(inout) :: fileobj !< diagYamlFiles_type obj to check
+ character(len=*), intent(in) :: new_file_freq !< new file freq units as it is read from
+ !! the diag_table
+ character(len=*), intent(in) :: new_file_freq_units !< new file freq units as it is read from
!! the diag_table
- if (fileobj%file_new_file_freq > 0) then
- if (trim(file_new_file_freq_units) .eq. "") &
- call mpp_error(FATAL, "new_file_freq_units is required if using new_file_freq. &
+ integer :: i !< For do loops
+ character(len=10) :: file_new_file_freq_units(MAX_FREQ) !< Array of new file frequencies as string
+ integer :: err_unit !< Dummy error unit
+
+ file_new_file_freq_units = ""
+ read(new_file_freq, *, iostat=err_unit) fileobj%file_new_file_freq
+ read(new_file_freq_units, *, iostat=err_unit) file_new_file_freq_units
+
+ do i = 1, MAX_FREQ
+ if (fileobj%file_new_file_freq(i) > 0) then
+ if (trim(file_new_file_freq_units(i)) .eq. "") &
+ call mpp_error(FATAL, "new_file_freq_units is required if using new_file_freq. &
&Check your entry for file:"//trim(fileobj%file_fname))
- fileobj%file_new_file_freq_units = set_valid_time_units(file_new_file_freq_units, &
+ fileobj%file_new_file_freq_units(i) = set_valid_time_units(file_new_file_freq_units(i), &
"new_file_freq_units for file:"//trim(fileobj%file_fname))
- endif
+ else
+ return
+ endif
+ enddo
end subroutine set_new_file_freq
!> @brief This checks if the file duration and the file duration units in a diag file are valid
!! and sets the integer equivalent
-subroutine set_file_duration(fileobj, file_duration_units)
+subroutine set_file_duration(fileobj, file_duration, file_duration_units)
type(diagYamlFiles_type), intent(inout) :: fileobj !< diagYamlFiles_type obj to check
- character(len=*), intent(in) :: file_duration_units !< file_duration as it is read from the diag_table
-
- if (fileobj%file_duration > 0) then
- if(trim(file_duration_units) .eq. "") &
+ character(len=*), intent(in) :: file_duration !< file_duration as it is read from the yaml
+ character(len=*), intent(in) :: file_duration_units !< file_duration units as it is read from the yaml
+
+ integer :: i !< For do loops
+ character(len=10) :: file_duration_units_array(MAX_FREQ) !< Array of file_duration_units as string
+ integer :: err_unit !< Dummy error unit
+ logical :: mask(MAX_FREQ) !< Array of logical
+ integer :: nfile_duration !< Number of file durations defined
+ integer :: nfile_freq !< Number of file frequencies defined
+ integer :: nnew_file_freq !< Number of new file frequencies defined
+
+ file_duration_units_array = ""
+ read(file_duration, *, iostat=err_unit) fileobj%file_duration
+ read(file_duration_units, *, iostat=err_unit) file_duration_units_array
+
+ nfile_duration = 0
+ do i = 1, MAX_FREQ
+ if (fileobj%file_duration(i) > 0) then
+ if(trim(file_duration_units_array(i)) .eq. "") &
call mpp_error(FATAL, "file_duration_units is required if using file_duration. &
&Check your entry for file:"//trim(fileobj%file_fname))
- fileobj%file_duration_units = set_valid_time_units(file_duration_units, &
+ fileobj%file_duration_units(i) = set_valid_time_units(file_duration_units_array(i), &
"file_duration_units for file:"//trim(fileobj%file_fname))
- endif
+ nfile_duration = nfile_duration + 1
+ else
+ exit
+ endif
+ enddo
+
+ !< Make sure the user send in the correct number of freq, new_file_freq, and file_duration
+ mask = .FALSE.
+ mask = fileobj%file_freq .ne. DIAG_NULL
+ nfile_freq = count(mask)
+
+ mask = .FALSE.
+ mask = fileobj%file_new_file_freq .ne. DIAG_NULL
+ nnew_file_freq = count(mask)
+
+ if (nfile_freq .ne. nfile_duration .and. nfile_freq-1 .ne. nfile_duration) &
+ call mpp_error(FATAL, "freq and file_duration do not have consistent size. &
+ &Check your entry for file:"//trim(fileobj%file_fname))
+
+ if (nfile_freq .ne. nnew_file_freq .and. nfile_freq-1 .ne. nnew_file_freq) &
+ call mpp_error(FATAL, "freq and new_file_freq do not have consistent size. &
+ &Check your entry for file:"//trim(fileobj%file_fname))
+
+ if (nnew_file_freq .ne. nfile_duration .and. nnew_file_freq-1 .ne. nfile_duration) &
+ call mpp_error(FATAL, "new_file_freq and file_duration do not have consistent size. &
+ &Check your entry for file:"//trim(fileobj%file_fname))
+
end subroutine set_file_duration
!> @brief This checks if the kind of a diag field is valid and sets it
@@ -836,7 +917,7 @@ pure function get_file_frequnit (diag_files_obj) &
result (res)
class (diagYamlFiles_type), intent(in) :: diag_files_obj !< The object being inquiried
integer :: res !< What is returned
- res = diag_files_obj%file_frequnit
+ res = diag_files_obj%file_frequnit(diag_files_obj%current_new_file_freq_index)
end function get_file_frequnit
!> @brief Inquiry for diag_files_obj%file_freq
!! @return file_freq of a diag_yaml_file_obj
@@ -844,7 +925,7 @@ pure function get_file_freq(diag_files_obj) &
result (res)
class (diagYamlFiles_type), intent(in) :: diag_files_obj !< The object being inquiried
integer :: res !< What is returned
- res = diag_files_obj%file_freq
+ res = diag_files_obj%file_freq(diag_files_obj%current_new_file_freq_index)
end function get_file_freq
!> @brief Inquiry for diag_files_obj%file_timeunit
!! @return file_timeunit of a diag_yaml_file_obj
@@ -876,7 +957,7 @@ pure function get_file_new_file_freq(diag_files_obj) &
result (res)
class (diagYamlFiles_type), intent(in) :: diag_files_obj !< The object being inquiried
integer :: res !< What is returned
- res = diag_files_obj%file_new_file_freq
+ res = diag_files_obj%file_new_file_freq(diag_files_obj%current_new_file_freq_index)
end function get_file_new_file_freq
!> @brief Inquiry for diag_files_obj%file_new_file_freq_units
!! @return file_new_file_freq_units of a diag_yaml_file_obj
@@ -884,7 +965,7 @@ pure function get_file_new_file_freq_units (diag_files_obj) &
result (res)
class (diagYamlFiles_type), intent(in) :: diag_files_obj !< The object being inquiried
integer :: res !< What is returned
- res = diag_files_obj%file_new_file_freq_units
+ res = diag_files_obj%file_new_file_freq_units(diag_files_obj%current_new_file_freq_index)
end function get_file_new_file_freq_units
!> @brief Inquiry for diag_files_obj%file_start_time
!! @return file_start_time of a diag_yaml_file_obj
@@ -900,7 +981,7 @@ pure function get_file_duration (diag_files_obj) &
result (res)
class (diagYamlFiles_type), intent(in) :: diag_files_obj !< The object being inquiried
integer :: res !< What is returned
- res = diag_files_obj%file_duration
+ res = diag_files_obj%file_duration(diag_files_obj%current_new_file_freq_index)
end function get_file_duration
!> @brief Inquiry for diag_files_obj%file_duration_units
!! @return file_duration_units of a diag_yaml_file_obj
@@ -908,7 +989,7 @@ pure function get_file_duration_units (diag_files_obj) &
result (res)
class (diagYamlFiles_type), intent(in) :: diag_files_obj !< The object being inquiried
integer :: res !< What is returned
- res = diag_files_obj%file_duration_units
+ res = diag_files_obj%file_duration_units(diag_files_obj%current_new_file_freq_index)
end function get_file_duration_units
!> @brief Inquiry for diag_files_obj%file_varlist
!! @return file_varlist of a diag_yaml_file_obj
@@ -936,6 +1017,12 @@ function is_global_meta(diag_files_obj) &
if (allocated(diag_files_obj%file_global_meta)) &
res = .true.
end function
+
+!> @brief Increate the current_new_file_freq_index by 1
+subroutine increase_new_file_freq_index(this)
+ class(diagYamlFiles_type), intent(inout) :: this !< The file object
+ this%current_new_file_freq_index = this%current_new_file_freq_index + 1
+end subroutine
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1056,11 +1143,12 @@ subroutine diag_yaml_files_obj_init(obj)
type(diagYamlFiles_type), intent(out) :: obj !< diagYamlFiles_type object to initialize
obj%file_freq = DIAG_NULL
- obj%file_duration = DIAG_NULL
- obj%file_duration_units = DIAG_NULL
- obj%file_new_file_freq = DIAG_NULL
- obj%file_new_file_freq_units = DIAG_NULL
obj%file_sub_region%tile = DIAG_NULL
+ obj%file_new_file_freq = DIAG_NULL
+ obj%file_duration = DIAG_NULL
+ obj%file_new_file_freq_units = DIAG_NULL
+ obj%file_duration_units = DIAG_NULL
+ obj%current_new_file_freq_index = 1
end subroutine diag_yaml_files_obj_init
!> @brief Checks if obj%file_fname is allocated
@@ -1073,7 +1161,7 @@ end function has_file_fname
!! @return true if obj%file_frequnit is allocated
pure logical function has_file_frequnit (obj)
class(diagYamlFiles_type), intent(in) :: obj !< diagYamlFiles_type object to initialize
- has_file_frequnit = obj%file_frequnit .NE. DIAG_NULL
+ has_file_frequnit = obj%file_frequnit(obj%current_new_file_freq_index) .NE. DIAG_NULL
end function has_file_frequnit
!> @brief obj%file_freq is on the stack, so the object always has it
!! @return true if obj%file_freq is allocated
@@ -1113,13 +1201,13 @@ end function has_file_sub_region
!! @return true
pure logical function has_file_new_file_freq (obj)
class(diagYamlFiles_type), intent(in) :: obj !< diagYamlFiles_type object to initialize
- has_file_new_file_freq = obj%file_new_file_freq .ne. DIAG_NULL
+ has_file_new_file_freq = obj%file_new_file_freq(obj%current_new_file_freq_index) .ne. DIAG_NULL
end function has_file_new_file_freq
!> @brief Checks if obj%file_new_file_freq_units is allocated
!! @return true if obj%file_new_file_freq_units is allocated
pure logical function has_file_new_file_freq_units (obj)
class(diagYamlFiles_type), intent(in) :: obj !< diagYamlFiles_type object to initialize
- has_file_new_file_freq_units = obj%file_new_file_freq_units .ne. diag_null
+ has_file_new_file_freq_units = obj%file_new_file_freq_units(obj%current_new_file_freq_index) .ne. diag_null
end function has_file_new_file_freq_units
!> @brief Checks if obj%file_start_time is allocated
!! @return true if obj%file_start_time is allocated
@@ -1131,13 +1219,13 @@ end function has_file_start_time
!! @return true
pure logical function has_file_duration (obj)
class(diagYamlFiles_type), intent(in) :: obj !< diagYamlFiles_type object to initialize
- has_file_duration = .true.
+ has_file_duration = obj%file_duration(obj%current_new_file_freq_index) .ne. DIAG_NULL
end function has_file_duration
!> @brief obj%file_duration_units is on the stack, so this will retrun true
!! @return true
pure logical function has_file_duration_units (obj)
class(diagYamlFiles_type), intent(in) :: obj !< diagYamlFiles_type object to initialize
- has_file_duration_units = obj%file_duration_units .ne. diag_null
+ has_file_duration_units = obj%file_duration_units(obj%current_new_file_freq_index) .ne. diag_null
end function has_file_duration_units
!> @brief Checks if obj%file_varlist is allocated
!! @return true if obj%file_varlist is allocated
diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am
index 4dfbd136..1a3b6b75 100644
--- a/test_fms/diag_manager/Makefile.am
+++ b/test_fms/diag_manager/Makefile.am
@@ -30,7 +30,7 @@ LDADD = $(top_builddir)/libFMS/libFMS.la
# Build this test program.
check_PROGRAMS = test_diag_manager test_diag_manager_time test_diag_object_container \
test_diag_update_buffer test_diag_dlinked_list \
- test_diag_yaml test_diag_ocean test_modern_diag test_diag_buffer
+ test_diag_yaml test_diag_ocean test_modern_diag test_diag_buffer test_flexible_time
# This is the source code for the test.
test_diag_manager_SOURCES = test_diag_manager.F90
@@ -41,6 +41,7 @@ test_diag_dlinked_list_SOURCES = test_diag_dlinked_list.F90
test_diag_ocean_SOURCES = test_diag_ocean.F90
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_EXTENSIONS = .sh
SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
diff --git a/test_fms/diag_manager/check_crashes.sh b/test_fms/diag_manager/check_crashes.sh
index 9ec803eb..537e5824 100755
--- a/test_fms/diag_manager/check_crashes.sh
+++ b/test_fms/diag_manager/check_crashes.sh
@@ -56,7 +56,7 @@ test_expect_failure "freq units is not valid" '
mpirun -n 1 ../test_diag_yaml
'
-sed 's/freq: 6/freq: -666/g' diag_table.yaml_base > diag_table.yaml
+sed 's/freq: 6/freq: 6 6/g' diag_table.yaml_base > diag_table.yaml
test_expect_failure "freq is less than -1" '
mpirun -n 1 ../test_diag_yaml
'
diff --git a/test_fms/diag_manager/test_diag_manager2.sh b/test_fms/diag_manager/test_diag_manager2.sh
index aaed7f1d..ace739b1 100755
--- a/test_fms/diag_manager/test_diag_manager2.sh
+++ b/test_fms/diag_manager/test_diag_manager2.sh
@@ -737,7 +737,7 @@ diag_files:
corner2: 20, 15
corner3: 10, 25
corner4: 20, 25
-- file_name: wild_card_name%4yr%2mo%2dy%2hr
+- file_name: file6%4yr%2mo%2dy%2hr
freq: 6
freq_units: hours
time_units: hours
@@ -748,11 +748,11 @@ diag_files:
file_duration: 12
file_duration_units: hours
varlist:
- - module: atm_mod
- var_name: var4
+ - module: ocn_mod
+ var_name: var1
reduction: average
kind: r4
-- file_name: file6
+- file_name: file7
freq: 6
freq_units: hours
time_units: hours
@@ -762,6 +762,21 @@ diag_files:
var_name: var1
reduction: none
kind: r4
+- file_name: file8%4yr%2mo%2dy%2hr
+ freq: 1 1 1
+ freq_units: hours hours hours
+ time_units: hours
+ unlimdim: time
+ new_file_freq: 6 3 1
+ new_file_freq_units: hours hours hours
+ start_time: 2 1 1 0 0 0
+ file_duration: 12 3 9
+ file_duration_units: hours hours hours
+ varlist:
+ - module: ocn_mod
+ var_name: var1
+ reduction: average
+ kind: r4
_EOF
my_test_count=`expr $my_test_count + 1`
@@ -773,6 +788,57 @@ _EOF
test_expect_success "Test the modern diag manager end to end (test $my_test_count)" '
mpirun -n 6 ../test_modern_diag
'
+
+printf "&diag_manager_nml \n use_modern_diag = .true. \n use_clock_average = .true. \n /" | cat > input.nml
+cat <<_EOF > diag_table.yaml
+title: test_diag_manager
+base_date: 2 1 1 0 0 0
+
+diag_files:
+- file_name: file1_clock
+ freq: 1
+ freq_units: days
+ time_units: hours
+ unlimdim: time
+ varlist:
+ - module: atm_mod
+ var_name: var1
+ reduction: average
+ kind: r4
+_EOF
+
+my_test_count=`expr $my_test_count + 1`
+ test_expect_success "Test the modern diag manager with use_clock_average = .true. (test $my_test_count)" '
+ mpirun -n 1 ../test_flexible_time
+ '
+
+printf "&diag_manager_nml \n use_modern_diag = .true. \n use_clock_average = .false. \n /" | cat > input.nml
+cat <<_EOF > diag_table.yaml
+title: test_diag_manager
+base_date: 2 1 1 0 0 0
+
+diag_files:
+- file_name: file1_forecast
+ freq: 1
+ freq_units: days
+ time_units: hours
+ unlimdim: time
+ varlist:
+ - module: atm_mod
+ var_name: var1
+ reduction: average
+ kind: r4
+_EOF
+
+my_test_count=`expr $my_test_count + 1`
+ test_expect_success "Test the modern diag manager with use_clock_average = .false. (test $my_test_count)" '
+ mpirun -n 1 ../test_flexible_time
+ '
+printf "&diag_manager_nml \n use_modern_diag = .false. \n use_clock_average = .true. \n /" | cat > input.nml
+ test_expect_failure "Test if use_modern_diag = .false. and use_clock_average = .true. fails (test $my_test_count)" '
+ mpirun -n 1 ../test_flexible_time
+ '
+
else
my_test_count=`expr $my_test_count + 1`
test_expect_failure "test modern diag manager failure when compiled without -Duse-yaml flag (test $my_test_count)" '
diff --git a/test_fms/diag_manager/test_flexible_time.F90 b/test_fms/diag_manager/test_flexible_time.F90
new file mode 100644
index 00000000..eb67eb34
--- /dev/null
+++ b/test_fms/diag_manager/test_flexible_time.F90
@@ -0,0 +1,63 @@
+!***********************************************************************
+!* GNU Lesser General Public License
+!*
+!* This file is part of the GFDL Flexible Modeling System (FMS).
+!*
+!* FMS is free software: you can redistribute it and/or modify it under
+!* the terms of the GNU Lesser General Public License as published by
+!* the Free Software Foundation, either version 3 of the License, or (at
+!* your option) any later version.
+!*
+!* FMS is distributed in the hope that it will be useful, but WITHOUT
+!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+!* for more details.
+!*
+!* You should have received a copy of the GNU Lesser General Public
+!* License along with FMS. If not, see .
+!***********************************************************************
+
+!> @brief This programs tests the flexible timing capability in the modern diag_manager
+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
+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
+use mpp_mod, only: FATAL, mpp_error
+
+implicit none
+
+type(time_type) :: Time !< Time of the simulation
+type(time_type) :: Start_Time !< Start time of the simulation
+type(time_type) :: End_Time !< End Time of the simulation
+integer :: i
+integer :: id_z, id_var
+
+call fms_init()
+call set_calendar_type(JULIAN)
+call diag_manager_init
+
+!< Starting time of the simulation
+Start_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')
+
+!< 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
+do i=1,48
+ !< Increase the time by 1 hour
+ Time = increment_date(Start_Time, 0, 0, 0, i, 0, 0)
+ call diag_send_complete(Time)
+enddo
+
+call diag_manager_end(End_Time)
+
+call fms_end()
+
+end program test_flexible_time
--
2.11.4.GIT