diff --git a/diag_manager/Makefile.am b/diag_manager/Makefile.am
index 1b67920de..433901b48 100644
--- a/diag_manager/Makefile.am
+++ b/diag_manager/Makefile.am
@@ -69,7 +69,7 @@ diag_util_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_axis_mod.$(FC_MODEXT
diag_grid_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT) fms_diag_bbox_mod.$(FC_MODEXT)
fms_diag_time_utils_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT)
diag_table_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_util_mod.$(FC_MODEXT)
-fms_diag_yaml_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT)
+fms_diag_yaml_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT)
fms_diag_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_file_object_mod.$(FC_MODEXT) fms_diag_field_object_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) \
fms_diag_time_utils_mod.$(FC_MODEXT) \
fms_diag_output_buffer_mod.$(FC_MODEXT) \
diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90
index 436a629ed..d16a9a3f7 100644
--- a/diag_manager/diag_manager.F90
+++ b/diag_manager/diag_manager.F90
@@ -3859,6 +3859,9 @@ SUBROUTINE diag_manager_set_time_end(Time_end_in)
TYPE (time_type), INTENT(in) :: Time_end_in
Time_end = Time_end_in
+ if (use_modern_diag) then
+ call fms_diag_object%set_time_end(time_end_in)
+ endif
END SUBROUTINE diag_manager_set_time_end
diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90
index 5f9a2536a..f9248a2cf 100644
--- a/diag_manager/fms_diag_file_object.F90
+++ b/diag_manager/fms_diag_file_object.F90
@@ -186,7 +186,7 @@ module fms_diag_file_object_mod
procedure :: write_field_metadata
procedure :: write_axis_data
procedure :: writing_on_this_pe
- procedure :: is_time_to_write
+ procedure :: check_file_times
procedure :: is_time_to_close_file
procedure :: write_time_data
procedure :: update_next_write
@@ -200,6 +200,7 @@ module fms_diag_file_object_mod
procedure :: close_diag_file
procedure :: set_model_time
procedure :: get_model_time
+ procedure :: time_to_start_doing_math
end type fmsDiagFileContainer_type
!type(fmsDiagFile_type), dimension (:), allocatable, target :: FMS_diag_file !< The array of diag files
@@ -264,8 +265,12 @@ logical function fms_diag_files_object_init (files_array)
!! Set this to the time passed in to diag_manager_init
!! This will be the base_time if nothing was passed in
!! This time is appended to the filename if the prepend_date namelist is .True.
- obj%start_time = diag_init_time
- obj%last_output = diag_init_time
+ if (obj%has_file_start_time()) then
+ obj%start_time = obj%get_file_start_time()
+ else
+ obj%start_time = diag_init_time
+ endif
+ obj%last_output = obj%start_time
obj%model_time = diag_init_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())
@@ -274,7 +279,12 @@ logical function fms_diag_files_object_init (files_array)
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)
+ if (obj%has_file_duration()) then
+ obj%next_close = diag_time_inc(obj%start_time, obj%get_file_duration(), &
+ obj%get_file_duration_units())
+ else
+ obj%next_close = diag_time_inc(obj%start_time, VERY_LARGE_FILE_FREQ, DIAG_DAYS)
+ endif
endif
obj%is_file_open = .false.
@@ -597,7 +607,7 @@ end function get_file_new_file_freq_units
!! \return Copy of file_start_time
pure function get_file_start_time (this) result(res)
class(fmsDiagFile_type), intent(in) :: this !< The file object
- character (len=:), allocatable :: res
+ type(time_type):: res
res = this%diag_yaml_file%get_file_start_time()
end function get_file_start_time
@@ -639,6 +649,7 @@ pure function is_done_writing_data (this) result(res)
class(fmsDiagFile_type), intent(in) :: this !< The file object
logical :: res
res = this%done_writing_data
+ if (this%is_file_open) res = .false.
end function is_done_writing_data
!> \brief Checks if file_fname is allocated in the yaml object
@@ -1014,6 +1025,11 @@ subroutine add_start_time(this, start_time)
!! this%start_time was already set to the diag_init_time
if (start_time .eq. diag_init_time) return
+ !< If the start_time sent is is greater than or equal to the start time already
+ !! in the diag file obj return because either this%start_time was already updated
+ !! or the file has start_time defined in the yaml
+ if (this%start_time >= start_time) return
+
if (this%start_time .ne. diag_init_time) then
!> If the this%start_time is not equal to the diag_init_time from the diag_table
!! this%start_time was already updated so make sure it is the same for the current variable
@@ -1383,11 +1399,14 @@ 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)
+logical function is_time_to_close_file (this, time_step, force_close)
class(fmsDiagFileContainer_type), intent(in), target :: this !< The file object
TYPE(time_type), intent(in) :: time_step !< Current model step time
+ logical, intent(in) :: force_close !< if .true. return true
- if (time_step >= this%FMS_diag_file%next_close) then
+ if (force_close) then
+ is_time_to_close_file = .true.
+ elseif (time_step >= this%FMS_diag_file%next_close) then
is_time_to_close_file = .true.
else
if (this%FMS_diag_file%is_static) then
@@ -1398,8 +1417,18 @@ logical function is_time_to_close_file (this, time_step)
endif
end function
+!> \brief Determine if it is time to start doing mathz
+!! \return .True. if it is time to start doing mathz
+logical function time_to_start_doing_math (this)
+ class(fmsDiagFileContainer_type), intent(in), target :: this !< The file object
+ time_to_start_doing_math = .false.
+ if (this%FMS_diag_file%model_time >= this%FMS_diag_file%start_time) then
+ time_to_start_doing_math = .true.
+ endif
+end function
+
!> \brief Determine if it is time to "write" to the file
-logical function is_time_to_write(this, time_step, output_buffers, diag_fields, do_not_write)
+subroutine check_file_times(this, time_step, output_buffers, diag_fields, do_not_write)
class(fmsDiagFileContainer_type), intent(inout), target :: this !< The file object
TYPE(time_type), intent(in) :: time_step !< Current model step time
type(fmsDiagOutputBuffer_type), intent(in) :: output_buffers(:) !< Array of output buffer.
@@ -1411,7 +1440,6 @@ logical function is_time_to_write(this, time_step, output_buffers, diag_fields,
do_not_write = .false.
if (time_step > this%FMS_diag_file%next_output) then
- is_time_to_write = .true.
if (this%FMS_diag_file%is_static) return
if (time_step > this%FMS_diag_file%next_next_output) then
if (this%FMS_diag_file%get_file_freq() .eq. 0) then
@@ -1421,9 +1449,7 @@ logical function is_time_to_write(this, time_step, output_buffers, diag_fields,
call this%FMS_diag_file%check_buffer_times(output_buffers, diag_fields)
this%FMS_diag_file%next_output = time_step
this%FMS_diag_file%next_next_output = time_step
- is_time_to_write = .true.
endif
- return
elseif (this%FMS_diag_file%num_registered_fields .eq. 0) then
!! If no variables have been registered, write a dummy time dimension for the first level
!! At least one time level is needed for the combiner to work ...
@@ -1433,26 +1459,20 @@ logical function is_time_to_write(this, time_step, output_buffers, diag_fields,
this%FMS_diag_file%data_has_been_written = .true.
this%FMS_diag_file%unlim_dimension_level = 1
endif
- is_time_to_write =.false.
else
!! Only fail if send data has actually been called for at least one variable
if (this%FMS_diag_file%has_send_data_been_called(output_buffers, .false.)) &
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.")
- is_time_to_write =.false.
endif
endif
else
- is_time_to_write = .false.
- if (this%FMS_diag_file%is_static) then
- ! This is to ensure that static files get finished in the begining of the run
- if (this%FMS_diag_file%unlim_dimension_level .eq. 1) is_time_to_write = .true.
- else if(this%FMS_diag_file%get_file_freq() .eq. 0) then
+ if(this%FMS_diag_file%get_file_freq() .eq. 0) then
do_not_write = .true.
endif
endif
-end function is_time_to_write
+end subroutine check_file_times
!> \brief Determine if the current PE has data to write
logical function writing_on_this_pe(this)
@@ -1532,7 +1552,6 @@ subroutine update_current_new_file_freq_index(this, time_step)
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
@@ -1776,10 +1795,11 @@ subroutine write_axis_data(this, diag_axis)
end subroutine write_axis_data
!< @brief Closes the diag_file
-subroutine close_diag_file(this, output_buffers, diag_fields)
+subroutine close_diag_file(this, output_buffers, model_end_time, diag_fields)
class(fmsDiagFileContainer_type), intent(inout), target :: this !< The file object
type(fmsDiagOutputBuffer_type), intent(in) :: output_buffers(:) !< Array of output buffers
!! This is needed for error checking
+ type(time_type), intent(in) :: model_end_time !< Time that simulation ends
type(fmsDiagField_type), intent(in), optional :: diag_fields(:) !< Array of diag fields
!! This is needed for error checking
@@ -1805,9 +1825,11 @@ subroutine close_diag_file(this, output_buffers, diag_fields)
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)
+ this%FMS_diag_file%next_close = model_end_time
endif
+ if (this%FMS_diag_file%model_time >= model_end_time) &
+ this%FMS_diag_file%done_writing_data = .true.
if (this%FMS_diag_file%has_send_data_been_called(output_buffers, .True., diag_fields)) return
end subroutine close_diag_file
diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90
index 7f8ad6d9a..dad97e13f 100644
--- a/diag_manager/fms_diag_object.F90
+++ b/diag_manager/fms_diag_object.F90
@@ -70,6 +70,8 @@ module fms_diag_object_mod
logical, private :: fields_initialized=.false. !< True if the fmsDiagObject is initialized
logical, private :: buffers_initialized=.false. !< True if the fmsDiagObject is initialized
logical, private :: axes_initialized=.false. !< True if the fmsDiagObject is initialized
+ type(time_type) :: model_end_time !< The time that the simulation is going to end
+ !! (set by calling diag_manager_set_time_end)
#endif
contains
procedure :: init => fms_diag_object_init
@@ -94,6 +96,7 @@ module fms_diag_object_mod
procedure :: fms_diag_field_add_cell_measures
procedure :: allocate_diag_field_output_buffers
procedure :: fms_diag_compare_window
+ procedure :: set_time_end
#ifdef use_yaml
procedure :: get_diag_buffer
#endif
@@ -821,7 +824,6 @@ subroutine fms_diag_do_io(this, end_time)
!< Go away if the file is a subregional file and the current PE does not have any data for it
if (.not. diag_file%writing_on_this_pe()) cycle
- if (diag_file%FMS_diag_file%is_done_writing_data()) cycle
if (present (end_time)) then
force_write = .true.
@@ -829,6 +831,7 @@ subroutine fms_diag_do_io(this, end_time)
else
model_time => diag_file%get_model_time()
endif
+ if (diag_file%FMS_diag_file%is_done_writing_data()) cycle
call diag_file%open_diag_file(model_time, file_is_opened_this_time_step)
if (file_is_opened_this_time_step) then
@@ -842,7 +845,7 @@ subroutine fms_diag_do_io(this, end_time)
call diag_file%write_axis_data(this%diag_axis)
endif
- finish_writing = diag_file%is_time_to_write(model_time, this%FMS_diag_output_buffers, &
+ call diag_file%check_file_times(model_time, this%FMS_diag_output_buffers, &
this%FMS_diag_fields, do_not_write)
unlim_dim_was_increased = .false.
@@ -881,16 +884,15 @@ subroutine fms_diag_do_io(this, end_time)
call diag_file%write_time_data()
call diag_file%flush_diag_file()
call diag_file%update_next_write(model_time)
- endif
-
- if (finish_writing) then
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(this%FMS_diag_output_buffers, &
- diag_fields = this%FMS_diag_fields)
+ if (diag_file%is_time_to_close_file(model_time, force_write)) &
+ call diag_file%close_diag_file(this%FMS_diag_output_buffers, &
+ this%model_end_time, diag_fields = this%FMS_diag_fields)
else if (force_write) then
call diag_file%prepare_for_force_write()
call diag_file%write_time_data()
- call diag_file%close_diag_file(this%FMS_diag_output_buffers, diag_fields = this%FMS_diag_fields)
+ call diag_file%close_diag_file(this%FMS_diag_output_buffers, &
+ this%model_end_time, diag_fields = this%FMS_diag_fields)
endif
enddo
#endif
@@ -979,6 +981,7 @@ function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight
if (buffer_ptr%is_done_with_math()) cycle
if (present(time)) call file_ptr%set_model_time(time)
+ if (.not. file_ptr%time_to_start_doing_math()) cycle
bounds_out = bounds
if (.not. using_blocking) then
@@ -1503,4 +1506,13 @@ function fms_diag_compare_window(this, field, field_id, &
#endif
end function fms_diag_compare_window
+!> @brief Set the model_end_time in a diag object
+subroutine set_time_end(this, time_end_in)
+ class(fmsDiagObject_type), intent(inout) :: this !< Diag Object
+ type(time_type), intent(in) :: time_end_in !< Time at the end of the simulation
+#ifdef use_yaml
+ this%model_end_time = time_end_in
+#endif
+end subroutine
+
end module fms_diag_object_mod
diff --git a/diag_manager/fms_diag_time_utils.F90 b/diag_manager/fms_diag_time_utils.F90
index 9bc306b56..f14227122 100644
--- a/diag_manager/fms_diag_time_utils.F90
+++ b/diag_manager/fms_diag_time_utils.F90
@@ -27,7 +27,7 @@
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(-), set_date
+ get_date, get_time, operator(>), operator(<), operator(-), set_date, set_time
use diag_data_mod, only: END_OF_RUN, EVERY_TIME, DIAG_SECONDS, DIAG_MINUTES, DIAG_HOURS, DIAG_DAYS, DIAG_MONTHS, &
DIAG_YEARS, use_clock_average
USE constants_mod, ONLY: SECONDS_PER_DAY, SECONDS_PER_HOUR, SECONDS_PER_MINUTE
@@ -40,6 +40,7 @@ module fms_diag_time_utils_mod
public :: diag_time_inc
public :: get_time_string
public :: get_date_dif
+public :: set_time_type
contains
@@ -383,4 +384,38 @@ REAL FUNCTION get_date_dif(t2, t1, units)
CALL mpp_error(FATAL, 'diag_util_mod::diag_date_dif illegal time units')
END IF
END FUNCTION get_date_dif
+
+!> @brief Sets up a time_type based on 6 member array of integers defining the
+!! [year month day hour min sec]
+subroutine set_time_type(time_int, time)
+ integer, intent(in) :: time_int(6) !< The time in the format [year month day hour min second]
+ type(time_type), intent(inout) :: time !< The time converted to the time_type
+
+ integer :: year !< Year of the time type
+ integer :: month !< Month of the time type
+ integer :: day !< Day of the time type
+ integer :: hour !< Hour of the time type
+ integer :: minute !< Minute of the time type
+ integer :: second !< Second of the time type
+
+ year = time_int(1)
+ month = time_int(2)
+ day = time_int(3)
+ hour = time_int(4)
+ minute = time_int(5)
+ second = time_int(6)
+
+ ! Set up the time type for time passed in
+ IF ( get_calendar_type() /= NO_CALENDAR ) THEN
+ IF ( year==0 .OR. month==0 .OR. day==0 ) THEN
+ call mpp_error(FATAL, 'fms_diag_time_utils_mod::set_time_type'//&
+ & 'The year/month/day can not equal zero')
+ END IF
+ time = set_date(year, month, day, hour, minute, second)
+ ELSE
+ ! No calendar - ignore year and month
+ time = set_time(NINT(hour*SECONDS_PER_HOUR)+NINT(minute*SECONDS_PER_MINUTE)+second, &
+ & day)
+ END IF
+end subroutine set_time_type
end module fms_diag_time_utils_mod
diff --git a/diag_manager/fms_diag_yaml.F90 b/diag_manager/fms_diag_yaml.F90
index 26f631414..5288e7f45 100644
--- a/diag_manager/fms_diag_yaml.F90
+++ b/diag_manager/fms_diag_yaml.F90
@@ -45,6 +45,8 @@ module fms_diag_yaml_mod
fms_f2c_string
use platform_mod, only: r4_kind, i4_kind, r8_kind, i8_kind, FMS_FILE_LEN
use fms_mod, only: lowercase
+use fms_diag_time_utils_mod, only: set_time_type
+use time_manager_mod, only: time_type, date_to_string
use fms2_io_mod, only: file_exists, get_instance_filename
implicit none
@@ -112,8 +114,9 @@ module fms_diag_yaml_mod
!! 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”
+ type(time_type) :: file_start_time !< Time to start the file for the
+ !! first time.
+ logical :: file_start_time_set !< .True. if file_start_time has been set
integer :: filename_time !< The time to use when setting the name of
!! new files: begin, middle, or end of the
!! time_bounds
@@ -561,6 +564,7 @@ subroutine fill_in_diag_files(diag_yaml_id, diag_file_id, yaml_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
+ integer :: start_time_int(6) !< The start_time as read in from the diag_table yaml
yaml_fileobj%file_frequnit = 0
@@ -583,8 +587,14 @@ subroutine fill_in_diag_files(diag_yaml_id, diag_file_id, yaml_fileobj)
call set_filename_time(yaml_fileobj, buffer)
deallocate(buffer)
- call diag_get_value_from_key(diag_yaml_id, diag_file_id, "start_time", &
- yaml_fileobj%file_start_time, is_optional=.true.)
+ start_time_int = diag_null
+ yaml_fileobj%file_start_time_set = .false.
+ call get_value_from_key(diag_yaml_id, diag_file_id, "start_time", &
+ start_time_int, is_optional=.true.)
+ if (any(start_time_int .ne. diag_null)) then
+ yaml_fileobj%file_start_time_set = .true.
+ call set_time_type(start_time_int, yaml_fileobj%file_start_time)
+ endif
call diag_get_value_from_key(diag_yaml_id, diag_file_id, "file_duration", buffer, is_optional=.true.)
call parse_key(yaml_fileobj%file_fname, buffer, yaml_fileobj%file_duration, yaml_fileobj%file_duration_units, &
"file_duration")
@@ -1070,7 +1080,7 @@ end function get_file_new_file_freq_units
pure function get_file_start_time (this) &
result (res)
class (diagYamlFiles_type), intent(in) :: this !< The object being inquiried
- character (len=:), allocatable :: res !< What is returned
+ type(time_type) :: res !< What is returned
res = this%file_start_time
end function get_file_start_time
!> @brief Inquiry for diag_files_obj%file_duration
@@ -1325,7 +1335,7 @@ end function has_file_new_file_freq_units
!! @return true if diag_file_obj%file_start_time is allocated
pure logical function has_file_start_time (this)
class(diagYamlFiles_type), intent(in) :: this !< diagYamlFiles_type object to initialize
- has_file_start_time = allocated(this%file_start_time)
+ has_file_start_time = this%file_start_time_set
end function has_file_start_time
!> @brief diag_file_obj%file_duration is allocated on th stack, so this is always true
!! @return true
@@ -1593,7 +1603,8 @@ subroutine dump_diag_yaml_obj( filename )
if(files(i)%has_file_new_file_freq()) write(unit_num, *) 'new_file_freq:', files(i)%get_file_new_file_freq()
if(files(i)%has_file_new_file_freq_units()) write(unit_num, *) 'new_file_freq_units:', &
& files(i)%get_file_new_file_freq_units()
- if(files(i)%has_file_start_time()) write(unit_num, *) 'start_time:', files(i)%get_file_start_time()
+ if(files(i)%has_file_start_time()) write(unit_num, *) 'start_time:', &
+ & date_to_string(files(i)%get_file_start_time())
if(files(i)%has_file_duration()) write(unit_num, *) 'duration:', files(i)%get_file_duration()
if(files(i)%has_file_duration_units()) write(unit_num, *) 'duration_units:', files(i)%get_file_duration_units()
if(files(i)%has_file_varlist()) write(unit_num, *) 'varlist:', files(i)%get_file_varlist()
@@ -1720,8 +1731,11 @@ subroutine fms_diag_yaml_out()
enddo
call fms_f2c_string(vals2(i)%val6, adjustl(tmpstr1))
call fms_f2c_string(vals2(i)%val7, get_diag_unit_string(fileptr%file_new_file_freq_units))
- call fms_f2c_string(vals2(i)%val8, trim(fileptr%get_file_start_time()))
- st_vals(i) = fileptr%get_file_start_time()
+ if (fileptr%has_file_start_time()) then
+ call fms_f2c_string(vals2(i)%val8, trim(date_to_string(fileptr%get_file_start_time())))
+ else
+ call fms_f2c_string(vals2(i)%val8, "")
+ endif
tmpstr1 = ''
do k=1, SIZE(fileptr%file_duration)
if(fileptr%file_duration(k) .eq. diag_null) exit
diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am
index 94d41a12a..ad07d12e2 100644
--- a/test_fms/diag_manager/Makefile.am
+++ b/test_fms/diag_manager/Makefile.am
@@ -34,7 +34,7 @@ check_PROGRAMS = test_diag_manager test_diag_manager_time \
check_time_min check_time_max check_time_sum check_time_avg test_diag_diurnal check_time_diurnal \
check_time_pow check_time_rms check_subregional test_cell_measures test_var_masks \
check_var_masks test_multiple_send_data test_diag_out_yaml test_output_every_freq \
- test_dm_weights test_prepend_date test_ens_runs test_diag_attribute_add
+ test_dm_weights test_prepend_date test_ens_runs test_multi_file test_diag_attribute_add
# This is the source code for the test.
test_output_every_freq_SOURCES = test_output_every_freq.F90
@@ -65,6 +65,7 @@ test_var_masks_SOURCES = test_var_masks.F90
check_var_masks_SOURCES = check_var_masks.F90
test_multiple_send_data_SOURCES = test_multiple_send_data.F90
test_prepend_date_SOURCES = test_prepend_date.F90
+test_multi_file_SOURCES = test_multi_file.F90
test_ens_runs_SOURCES = test_ens_runs.F90
test_diag_attribute_add_SOURCES = test_diag_attribute_add.F90
@@ -76,7 +77,8 @@ SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \
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_pow.sh test_time_rms.sh test_time_diurnal.sh test_cell_measures.sh \
test_subregional.sh test_var_masks.sh test_multiple_send_data.sh test_output_every_freq.sh \
- test_dm_weights.sh test_flush_nc_file.sh test_prepend_date.sh test_ens_runs.sh test_diag_attribute_add.sh
+ test_dm_weights.sh test_flush_nc_file.sh test_prepend_date.sh test_ens_runs.sh test_multi_file.sh \
+ test_diag_attribute_add.sh
testing_utils.mod: testing_utils.$(OBJEXT)
@@ -85,7 +87,7 @@ EXTRA_DIST = test_diag_manager2.sh check_crashes.sh test_time_none.sh test_time_
test_time_sum.sh test_time_avg.sh test_time_pow.sh test_time_rms.sh test_time_diurnal.sh \
test_cell_measures.sh test_subregional.sh test_var_masks.sh test_multiple_send_data.sh \
test_flush_nc_file.sh test_dm_weights.sh test_output_every_freq.sh test_prepend_date.sh \
- test_ens_runs.sh test_diag_attribute_add.sh
+ test_ens_runs.sh test_multi_file.sh test_diag_attribute_add.sh
if USING_YAML
skipflag=""
diff --git a/test_fms/diag_manager/test_diag_manager2.sh b/test_fms/diag_manager/test_diag_manager2.sh
index 3b4092108..1c54a5496 100755
--- a/test_fms/diag_manager/test_diag_manager2.sh
+++ b/test_fms/diag_manager/test_diag_manager2.sh
@@ -1137,7 +1137,7 @@ diag_files:
unlimdim: time
new_file_freq: 6
new_file_freq_units: hours
- start_time: 2 1 1 0 0 0
+ start_time: 00020101.000000
file_duration: 12
file_duration_units: hours
varlist:
@@ -1199,7 +1199,7 @@ diag_files:
unlimdim: time
new_file_freq: 6 3 1
new_file_freq_units: hours hours hours
- start_time: 2 1 1 0 0 0
+ start_time: 00020101.000000
file_duration: 12 3 9
file_duration_units: hours hours hours
varlist:
@@ -1230,7 +1230,7 @@ diag_files:
unlimdim: time
new_file_freq: 6 3 1
new_file_freq_units: hours hours hours
- start_time: 2 1 1 0 0 0
+ start_time: 00020101.000000
file_duration: 12 3 9
file_duration_units: hours hours hours
varlist:
diff --git a/test_fms/diag_manager/test_diag_yaml.F90 b/test_fms/diag_manager/test_diag_yaml.F90
index 57dfe5ba4..442ddce46 100644
--- a/test_fms/diag_manager/test_diag_yaml.F90
+++ b/test_fms/diag_manager/test_diag_yaml.F90
@@ -26,7 +26,7 @@ program test_diag_yaml
use diag_data_mod, only: DIAG_NULL, DIAG_ALL, get_base_year, get_base_month, get_base_day, get_base_hour, &
& get_base_minute, get_base_second, diag_data_init, DIAG_HOURS, DIAG_NULL, DIAG_DAYS, &
& time_average, r4, middle_time, end_time, time_none
-use time_manager_mod, only: set_calendar_type, JULIAN
+use time_manager_mod, only: set_calendar_type, JULIAN, date_to_string
use mpp_mod
use platform_mod
@@ -243,9 +243,9 @@ subroutine compare_diag_files(res)
call compare_result("file_duration_units 2", res(2)%get_file_duration_units(), DIAG_NULL)
call compare_result("file_duration_units 3", res(3)%get_file_duration_units(), DIAG_NULL)
- call compare_result("file_start_time 1", res(1)%get_file_start_time(), "2 1 1 0 0 0")
- call compare_result("file_start_time 2", res(2)%get_file_start_time(), "")
- call compare_result("file_start_time 3", res(3)%get_file_start_time(), "")
+ call compare_result("file_start_time 1", date_to_string(res(1)%get_file_start_time()), "00020101.000000")
+ if (res(2)%has_file_start_time()) call mpp_error(FATAL, "The second file should not have a start time")
+ if (res(3)%has_file_start_time()) call mpp_error(FATAL, "The third file should not have a start time")
varlist = res(1)%get_file_varlist()
if (.not. allocated(varlist)) call mpp_error(FATAL, "The varlist for the first file was not set")
diff --git a/test_fms/diag_manager/test_multi_file.F90 b/test_fms/diag_manager/test_multi_file.F90
new file mode 100644
index 000000000..f3461c500
--- /dev/null
+++ b/test_fms/diag_manager/test_multi_file.F90
@@ -0,0 +1,211 @@
+!***********************************************************************
+!* 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 .
+!***********************************************************************
+program test_multi_file
+ use fms_mod, only: fms_init, fms_end
+ use diag_manager_mod, only: diag_manager_init, diag_axis_init, register_diag_field, send_data, &
+ diag_send_complete, diag_manager_set_time_end, diag_manager_end
+ use mpp_mod, only: mpp_error, mpp_pe, mpp_root_pe, FATAL, input_nml_file
+ use time_manager_mod, only: time_type, set_calendar_type, JULIAN, set_time, set_date, operator(+)
+ use fms2_io_mod
+
+ implicit none
+
+ type(time_type) :: Time !< Time of the simulation
+ type(time_type) :: Time_step !< Time_step of the simulation
+ integer :: nx !< Number of x points
+ integer :: ny !< Number of y points
+ integer :: id_x !< Axis id for the x dimension
+ integer :: id_y !< Axis id for the y dimension
+ integer :: id_var1 !< Field id for 1st variable
+ integer :: id_var2 !< Field id for 2nd variable
+ logical :: used !< Dummy argument to send_data
+ real, allocatable :: x(:) !< X axis data
+ real, allocatable :: y(:) !< Y axis_data
+ real, allocatable :: var1_data(:,:) !< Data for variable 1
+ integer :: i !< For do loops
+ integer :: ntimes !< Number of times to run the simulation for
+ integer :: io_status !< Status after reading the namelist
+
+ integer :: test_case = 1 !< Test case to do:
+ !! 1 Test new_file_freq
+ !! 2 Test file start_time and file_duration with new_file_freq
+ !! 3 Test file start_time and file_duration without new_file_freq
+ !! 4 Flexible output timings
+ namelist / test_multi_file_nml / test_case
+
+ call fms_init()
+ call set_calendar_type(JULIAN)
+ call diag_manager_init()
+
+ read (input_nml_file, test_multi_file_nml, iostat=io_status)
+ if (io_status > 0) call mpp_error(FATAL,'=>test_multi_file: Error reading input.nml')
+
+ nx = 10
+ ny = 15
+
+ ntimes = 24
+
+ allocate(x(nx), y(ny))
+ allocate(var1_data(nx,ny))
+ do i=1,nx
+ x(i) = i
+ enddo
+ do i=1,ny
+ y(i) = -91 + i
+ enddo
+
+ Time = set_date(2,1,1,0,0,0)
+ Time_step = set_time (3600,0) !< 1 hour
+
+ id_x = diag_axis_init('x', x, 'point_E', 'x', long_name='point_E')
+ id_y = diag_axis_init('y', y, 'point_N', 'y', long_name='point_N')
+
+ id_var1 = register_diag_field ('atmos', 'ua', (/id_x, id_y/), Time)
+
+ call diag_manager_set_time_end(set_date(2,1,2,0,0,0))
+ do i = 1, ntimes
+ Time = Time + Time_step
+ var1_data = real(i)
+ used = send_data(id_var1, var1_data, Time)
+ call diag_send_complete(Time_step)
+ enddo
+
+ call diag_manager_end(Time)
+
+ call check_answers()
+ call fms_end()
+
+ contains
+
+ subroutine check_file(fileobj, expected_ntimes, start, filename, expected_ans)
+ type(FmsNetcdfFile_t), intent(in) :: fileobj
+ integer, intent(in) :: start
+ integer, intent(in) :: expected_ntimes
+ character(len=*), intent(in) :: filename
+ real, optional, intent(in) :: expected_ans
+
+ integer :: j
+ real :: ans_var
+ real :: vardata_out(nx, ny)
+ integer :: ntimes
+
+ call get_dimension_size(fileobj, "time", ntimes)
+ if (ntimes .ne. expected_ntimes) call mpp_error(FATAL, "The time dimension for "//trim(filename)//&
+ " is not the correct size!")
+ do j = 1, ntimes
+ ans_var = real((start + 2*(j-1) + 1) + (start + 2*(j-1) + 2) ) / real(2.)
+ if (present(expected_ans) .and. j .eq. 1) ans_var = expected_ans
+ call read_data(fileobj, "ua", vardata_out, unlim_dim_level = j)
+ if (any(vardata_out .ne. ans_var)) &
+ call mpp_error(FATAL, "The data in "//trim(filename)//" is not the expected result!")
+ enddo
+ end subroutine
+
+ subroutine check_answers_case_1()
+ type(FmsNetcdfFile_t) :: fileobj
+
+ if (.not. open_file(fileobj, "test_multi_file_0002_01_01_12.nc", "read")) &
+ call mpp_error(FATAL, "Unable to open the file: test_multi_file_0002_01_01_12.nc")
+ call check_file(fileobj, 6, 0, "test_multi_file_0002_01_01_12.nc")
+ call close_file(fileobj)
+
+ if (.not. open_file(fileobj, "test_multi_file_0002_01_02_00.nc", "read")) &
+ call mpp_error(FATAL, "Unable to open the file: test_multi_file_0002_01_02_00.nc")
+ call check_file(fileobj, 6, 12, "test_multi_file_0002_01_02_00.nc")
+
+ if (file_exists("test_multi_file_0002_01_02_12.nc")) &
+ call mpp_error(FATAL, "The file test_multi_file_0002_01_02_12.nc should not exist!")
+
+ call close_file(fileobj)
+ end subroutine check_answers_case_1
+
+ subroutine check_answers_case_2()
+ type(FmsNetcdfFile_t) :: fileobj
+
+ if (file_exists("test_multi_file_0002_01_01_04.nc")) &
+ call mpp_error(FATAL, "The file test_multi_file_0002_01_01_04 should not exist!")
+
+ if (file_exists("test_multi_file_0002_01_01_08.nc")) &
+ call mpp_error(FATAL, "The file test_multi_file_0002_01_01_08 should not exist!")
+
+ if (file_exists("test_multi_file_0002_01_01_12.nc")) &
+ call mpp_error(FATAL, "The file test_multi_file_0002_01_01_12 should not exist!")
+
+ if (file_exists("test_multi_file_0002_01_02_00.nc")) &
+ call mpp_error(FATAL, "The file test_multi_file_0002_01_02_00 should not exist!")
+
+ if (.not. open_file(fileobj, "test_multi_file_0002_01_01_16.nc", "read")) &
+ call mpp_error(FATAL, "Unable to open the file: test_multi_file_0002_01_01_16.nc")
+ call check_file(fileobj, 2, 12, "test_multi_file_0002_01_01_16.nc", expected_ans = real(13))
+ call close_file(fileobj)
+
+ if (.not. open_file(fileobj, "test_multi_file_0002_01_01_20.nc", "read")) &
+ call mpp_error(FATAL, "Unable to open the file: test_multi_file_0002_01_01_20.nc")
+ call check_file(fileobj, 2, 16, "test_multi_file_0002_01_01_20.nc")
+ call close_file(fileobj)
+
+ end subroutine check_answers_case_2
+
+ subroutine check_answers_case_3()
+ type(FmsNetcdfFile_t) :: fileobj
+
+ if (.not. open_file(fileobj, "test_multi_file.nc", "read")) &
+ call mpp_error(FATAL, "Unable to open the file: test_multi_file.nc")
+ call check_file(fileobj, 4, 12, "test_multi_file.nc", expected_ans = real(13))
+ call close_file(fileobj)
+ end subroutine check_answers_case_3
+
+ subroutine check_answers_case_4()
+ type(FmsNetcdfFile_t) :: fileobj
+
+ if (.not. open_file(fileobj, "test_multi_file_0002_01_01_04.nc", "read")) &
+ call mpp_error(FATAL, "Unable to open the file: test_multi_file_0002_01_01_04.nc")
+ call check_file(fileobj, 2, 0, "test_multi_file_0002_01_01_04.nc")
+ call close_file(fileobj)
+
+ if (.not. open_file(fileobj, "test_multi_file_0002_01_01_08.nc", "read")) &
+ call mpp_error(FATAL, "Unable to open the file: test_multi_file_0002_01_01_08.nc")
+ call check_file(fileobj, 2, 4, "test_multi_file_0002_01_01_08.nc")
+ call close_file(fileobj)
+
+ if (.not. open_file(fileobj, "test_multi_file_0002_01_01_10.nc", "read")) &
+ call mpp_error(FATAL, "Unable to open the file: test_multi_file_0002_01_01_10.nc")
+ call check_file(fileobj, 1, 8, "test_multi_file_0002_01_01_10.nc")
+ call close_file(fileobj)
+
+ if (.not. open_file(fileobj, "test_multi_file_0002_01_01_22.nc", "read")) &
+ call mpp_error(FATAL, "Unable to open the file: test_multi_file_0002_01_01_22.nc")
+ call check_file(fileobj, 6, 10, "test_multi_file_0002_01_01_22.nc")
+ call close_file(fileobj)
+
+ end subroutine check_answers_case_4
+
+ subroutine check_answers()
+ select case (test_case)
+ case (1)
+ call check_answers_case_1()
+ case (2)
+ call check_answers_case_2()
+ case (3)
+ call check_answers_case_3()
+ case (4)
+ call check_answers_case_4()
+ end select
+ end subroutine check_answers
+end program test_multi_file
\ No newline at end of file
diff --git a/test_fms/diag_manager/test_multi_file.sh b/test_fms/diag_manager/test_multi_file.sh
new file mode 100755
index 000000000..1f23da381
--- /dev/null
+++ b/test_fms/diag_manager/test_multi_file.sh
@@ -0,0 +1,160 @@
+#!/bin/sh
+
+#***********************************************************************
+#* 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 .
+#***********************************************************************
+
+# Set common test settings.
+. ../test-lib.sh
+
+if [ -z "${skipflag}" ]; then
+# create and enter directory for in/output files
+output_dir
+
+###########################################################################
+# CASE 1: In this example, a file is going to be created every 12 hours, it is going to use the
+# end of the time_bounds (i.e 2 1 1 0 12 0 and 2 1 1 1 0 0) for the filename
+cat <<_EOF > diag_table.yaml
+title: test_diag_manager_01
+base_date: 2 1 1 0 0 0
+diag_files:
+- file_name: test_multi_file%4yr%2mo%2dy%2hr
+ time_units: days
+ unlimdim: time
+ freq: 2 hours
+ new_file_freq: 12 hours
+ module: atmos
+ reduction: average
+ kind: r4
+ filename_time: end
+ varlist:
+ - var_name: ua
+_EOF
+
+# remove any existing files that would result in false passes during checks
+rm -f *.nc
+my_test_count=1
+printf "&diag_manager_nml \n use_modern_diag=.true. \n/" | cat > input.nml
+test_expect_success "Running diag_manager (test $my_test_count)" '
+ mpirun -n 1 ../test_multi_file
+'
+
+###########################################################################
+# CASE 2: In this example, a file is going to be created starting from [2 1 1 12 0 0],
+# every 4 hours, for 8 hours (so 2 files!)
+rm -f *.nc
+cat <<_EOF > diag_table.yaml
+title: test_diag_manager_01
+base_date: 2 1 1 0 0 0
+diag_files:
+- file_name: test_multi_file%4yr%2mo%2dy%2hr
+ time_units: days
+ unlimdim: time
+ freq: 2 hours
+ start_time: 2 1 1 12 0 0
+ new_file_freq: 4 hours
+ file_duration: 8 hours
+ module: atmos
+ reduction: average
+ kind: r4
+ filename_time: end
+ varlist:
+ - var_name: ua
+_EOF
+
+cat <<_EOF > input.nml
+&diag_manager_nml
+ use_modern_diag=.true.
+/
+&test_multi_file_nml
+ test_case = 2
+/
+_EOF
+test_expect_success "Running diag_manager (test $my_test_count)" '
+ mpirun -n 1 ../test_multi_file
+'
+
+###########################################################################
+# CASE 3: In this example, a file is going to be created using data from [2 1 12 0 0]
+# to [2 1 1 20 0 0] (8 hours!)
+rm -f *.nc
+cat <<_EOF > diag_table.yaml
+title: test_diag_manager_01
+base_date: 2 1 1 0 0 0
+diag_files:
+- file_name: test_multi_file
+ time_units: days
+ unlimdim: time
+ freq: 2 hours
+ start_time: 2 1 1 12 0 0
+ file_duration: 8 hours
+ module: atmos
+ reduction: average
+ kind: r4
+ varlist:
+ - var_name: ua
+_EOF
+
+cat <<_EOF > input.nml
+&diag_manager_nml
+ use_modern_diag=.true.
+/
+&test_multi_file_nml
+ test_case = 3
+/
+_EOF
+test_expect_success "Running diag_manager (test $my_test_count)" '
+ mpirun -n 1 ../test_multi_file
+'
+
+###########################################################################
+# CASE 4: In this example, a file is going to be created every 4 hours for 8 hours
+# (so 2 files), then every 2 hours for 2 hours (so 1 file), then every 12 hours for 12 hours
+# (so 1 file)
+rm -f *.nc
+cat <<_EOF > diag_table.yaml
+title: test_diag_manager_01
+base_date: 2 1 1 0 0 0
+diag_files:
+- file_name: test_multi_file%4yr%2mo%2dy%2hr
+ time_units: days
+ unlimdim: time
+ freq: 2 hours, 2 hours, 2 hours
+ new_file_freq: 4 hours, 2 hours, 12 hours
+ file_duration: 8 hours, 2 hours, 12 hours
+ filename_time: end
+ module: atmos
+ reduction: average
+ kind: r4
+ varlist:
+ - var_name: ua
+_EOF
+
+cat <<_EOF > input.nml
+&diag_manager_nml
+ use_modern_diag=.true.
+/
+&test_multi_file_nml
+ test_case = 4
+/
+_EOF
+test_expect_success "Running diag_manager (test $my_test_count)" '
+ mpirun -n 1 ../test_multi_file
+'
+fi
+test_done