diff --git a/diag_manager/diag_data.F90 b/diag_manager/diag_data.F90 index 5bf3aec3e..8a289ba54 100644 --- a/diag_manager/diag_data.F90 +++ b/diag_manager/diag_data.F90 @@ -121,6 +121,8 @@ MODULE diag_data_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. @@ -378,6 +380,10 @@ MODULE diag_data_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 4007a40aa..855eaa29a 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -208,7 +208,7 @@ MODULE diag_manager_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 @@ MODULE diag_manager_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 @@ SUBROUTINE diag_manager_init(diag_model_subset, time_init, err_msg) & 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 @@ SUBROUTINE diag_manager_init(diag_model_subset, time_init, err_msg) 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 @@ SUBROUTINE diag_manager_init(diag_model_subset, time_init, err_msg) 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 ce926170e..b7135867c 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -32,9 +32,10 @@ module fms_diag_file_object_mod 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 @@ module fms_diag_file_object_mod 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 @@ module fms_diag_file_object_mod 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 3811cfcc0..95e92694d 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -456,9 +456,11 @@ subroutine fms_diag_send_complete(this, time_step) 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 779f3d5fa..de18228dc 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 @@ TYPE(time_type) FUNCTION diag_time_inc(time, output_freq, output_units, err_msg) !! 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 b3137d38b..8e42b5cc8 100644 --- a/diag_manager/fms_diag_yaml.F90 +++ b/diag_manager/fms_diag_yaml.F90 @@ -56,6 +56,7 @@ module fms_diag_yaml_mod 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 @@ module fms_diag_yaml_mod !> @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 @@ function get_total_num_vars(diag_yaml_id, diag_file_id) & !> @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 4dfbd1360..1a3b6b75b 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 9ec803ebe..537e5824d 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 aaed7f1dd..ace739b1c 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 000000000..eb67eb345 --- /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