From 418dec6d36e994049dcbc20b152b7bd4c3ffabb1 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Wed, 1 Feb 2023 15:29:05 -0500 Subject: [PATCH 01/15] write the time data based on how FMS is compiled --- diag_manager/diag_data.F90 | 5 +++++ diag_manager/diag_manager.F90 | 9 ++++++--- diag_manager/fms_diag_file_object.F90 | 5 ++--- 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/diag_manager/diag_data.F90 b/diag_manager/diag_data.F90 index c75929579e..8b3ff05738 100644 --- a/diag_manager/diag_data.F90 +++ b/diag_manager/diag_data.F90 @@ -392,7 +392,12 @@ MODULE diag_data_mod REAL :: FILL_VALUE = 9.9692099683868690e+36 #endif + !! @note `pack_size` and `pack_size_str` are set in diag_manager_init depending on how FMS was compiled + !! if FMS was compiled with default reals as 64bit, it will be set to 1 and "double", + !! if FMS was compiled with default reals as 32bit, it will set to 2 and "float" + !! This is to reproduce previous diag manager behavior. INTEGER :: pack_size = 1 !< 1 for double and 2 for float + CHARACTER(len=10) :: pack_size_str="double" !< Pack size as a string to be used in fms2_io register call ! REAL :: EMPTY = 0.0 diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index a83abc2a25..173b479c03 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -230,8 +230,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, use_clock_average, diag_null - + & use_modern_diag, use_clock_average, diag_null, pack_size_str USE diag_data_mod, ONLY: fileobj, fileobjU, fnum_for_domain, fileobjND USE diag_table_mod, ONLY: parse_diag_table USE diag_output_mod, ONLY: get_diag_global_att, set_diag_global_att @@ -3828,7 +3827,11 @@ SUBROUTINE diag_manager_init(diag_model_subset, time_init, err_msg) ! Determine pack_size from how many bytes a real value has (how compiled) pack_size = SIZE(TRANSFER(0.0_DblKind, (/0.0, 0.0, 0.0, 0.0/))) - IF ( pack_size.NE.1 .AND. pack_size.NE.2 ) THEN + IF (pack_size .EQ. 1) then + pack_size_str = "double" + else if (pack_size .EQ. 2) then + pack_size_str = "float" + else IF ( fms_error_handler('diag_manager_mod::diag_manager_init', 'unknown pack_size. Must be 1, or 2.', & & err_msg) ) RETURN END IF diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index 7e3765c1f4..ff3dd2eb4a 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -32,7 +32,7 @@ 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, avg_name, no_units + time_diurnal, time_power, time_none, avg_name, no_units, pack_size_str use time_manager_mod, only: time_type, operator(>), operator(/=), operator(==), get_date, get_calendar_type, & VALID_CALENDAR_TYPES, operator(>=), date_to_string, & OPERATOR(/), OPERATOR(+), operator(<) @@ -903,8 +903,7 @@ subroutine write_var_metadata(fileobj, variable_name, dimensions, long_name, uni 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_field(fileobj, variable_name, pack_size_str, 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) & From 215fb7fe5b3d4e0d6b3fcf834cfa5608ce94d7eb Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Wed, 1 Feb 2023 16:01:02 -0500 Subject: [PATCH 02/15] Implement capability to specifiy which time in a time average period to use when setting filename --- diag_manager/diag_data.F90 | 3 ++ diag_manager/fms_diag_file_object.F90 | 23 +++++++++++- diag_manager/fms_diag_yaml.F90 | 41 ++++++++++++++++++++- test_fms/diag_manager/test_diag_manager2.sh | 19 +++++++++- test_fms/diag_manager/test_diag_yaml.F90 | 6 ++- 5 files changed, 87 insertions(+), 5 deletions(-) diff --git a/diag_manager/diag_data.F90 b/diag_manager/diag_data.F90 index 8b3ff05738..ede6f231af 100644 --- a/diag_manager/diag_data.F90 +++ b/diag_manager/diag_data.F90 @@ -123,6 +123,9 @@ MODULE diag_data_mod 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 + INTEGER, PARAMETER :: begin_time = 1 !< Use the begining of the time average bounds + INTEGER, PARAMETER :: middle_time = 2 !< Use the middle of the time average bounds + INTEGER, PARAMETER :: end_time = 3 !< Use the end of the time average bounds !> @} !> @brief Contains the coordinates of the local domain to output. diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index ff3dd2eb4a..4bbff13be9 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -32,7 +32,8 @@ 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, avg_name, no_units, pack_size_str + time_diurnal, time_power, time_none, avg_name, no_units, pack_size_str, & + middle_time, begin_time, end_time use time_manager_mod, only: time_type, operator(>), operator(/=), operator(==), get_date, get_calendar_type, & VALID_CALENDAR_TYPES, operator(>=), date_to_string, & OPERATOR(/), OPERATOR(+), operator(<) @@ -114,6 +115,7 @@ module fms_diag_file_object_mod procedure, public :: get_file_unlimdim procedure, public :: get_file_sub_region procedure, public :: get_file_new_file_freq + procedure, public :: get_filename_time procedure, public :: get_file_new_file_freq_units procedure, public :: get_file_start_time procedure, public :: get_file_duration @@ -311,6 +313,23 @@ pure logical function has_diag_yaml_file (this) has_diag_yaml_file = associated(this%diag_yaml_file) end function has_diag_yaml_file +!> \brief Get the time to use to determine the filename, if using a wildcard file name (i.e ocn%4yr%2mo%2dy%2hr) +!! \return The time to use when determining the filename +function get_filename_time(this) & + result(res) + class(fmsDiagFile_type), intent(in) :: this !< The file object + type(time_type) :: res + + select case (this%diag_yaml_file%get_filename_time()) + case (begin_time) + res = this%last_output + case (middle_time) + res = (this%last_output + this%next_close)/2 + case (end_time) + res = this%next_close + end select +end function get_filename_time + !> \brief Logical function to determine if the variable field_ids has been allocated or associated !! \return .True. if field_ids exists .False. if field_ids has not been set pure logical function has_field_ids (this) @@ -826,7 +845,7 @@ subroutine open_diag_file(this, time_step, file_is_opened) !< If using a wildcard file name (i.e ocn%4yr%2mo%2dy%2hr), get the basename (i.e ocn) pos = INDEX(diag_file_name, '%') if (pos > 0) base_name = diag_file_name(1:pos-1) - suffix = get_time_string(diag_file_name, time_step) !TODO fname_time? + suffix = get_time_string(diag_file_name, diag_file%get_filename_time()) base_name = trim(base_name)//trim(suffix) else base_name = trim(diag_file_name) diff --git a/diag_manager/fms_diag_yaml.F90 b/diag_manager/fms_diag_yaml.F90 index a1e4baa192..fac4fdee60 100644 --- a/diag_manager/fms_diag_yaml.F90 +++ b/diag_manager/fms_diag_yaml.F90 @@ -33,7 +33,8 @@ module fms_diag_yaml_mod use diag_data_mod, only: DIAG_NULL, DIAG_OCEAN, DIAG_ALL, DIAG_OTHER, set_base_time, latlon_gridtype, & index_gridtype, null_gridtype, DIAG_SECONDS, DIAG_MINUTES, DIAG_HOURS, DIAG_DAYS, & DIAG_MONTHS, DIAG_YEARS, time_average, time_rms, time_max, time_min, time_sum, & - time_diurnal, time_power, time_none, r8, i8, r4, i4, DIAG_NOT_REGISTERED + time_diurnal, time_power, time_none, r8, i8, r4, i4, DIAG_NOT_REGISTERED, & + middle_time, begin_time, end_time use yaml_parser_mod, only: open_and_parse_file, get_value_from_key, get_num_blocks, get_nkeys, & get_block_ids, get_key_value, get_key_ids, get_key_name use mpp_mod, only: mpp_error, FATAL, mpp_pe, mpp_root_pe, stdout @@ -104,6 +105,9 @@ module fms_diag_yaml_mod !! 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 :: filename_time !< The time to use when setting the name of + !! new files: begin, middle, or end of the + !! time_bounds 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 @@ -142,6 +146,7 @@ module fms_diag_yaml_mod procedure, public :: get_file_duration_units procedure, public :: get_file_varlist procedure, public :: get_file_global_meta + procedure, public :: get_filename_time 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. @@ -513,6 +518,10 @@ subroutine fill_in_diag_files(diag_yaml_id, diag_file_id, fileobj) is_optional=.true.) call set_new_file_freq(fileobj, freq_buffer, buffer) + deallocate(buffer) + call diag_get_value_from_key(diag_yaml_id, diag_file_id, "filename_time", buffer, is_optional=.true.) + call set_filename_time(fileobj, 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 diag_get_value_from_key(diag_yaml_id, diag_file_id, "file_duration", freq_buffer, is_optional=.true.) @@ -750,6 +759,27 @@ subroutine set_new_file_freq(fileobj, new_file_freq, new_file_freq_units) enddo end subroutine set_new_file_freq +!> @brief This checks if the filename_time in a diag file is correct and sets the integer equivalent +subroutine set_filename_time(fileobj, filename_time) + type(diagYamlFiles_type), intent(inout) :: fileobj !< diagYamlFiles_type obj to check + character(len=*), intent(in) :: filename_time !< filename_time as it is read from the yaml + + select case (trim(filename_time)) + case ("") + fileobj%filename_time = middle_time !< This is the default + case ("begin") + fileobj%filename_time = begin_time + case ("middle") + fileobj%filename_time = middle_time + case ("end") + fileobj%filename_time = end_time + case default + call mpp_error(FATAL, trim(filename_time)//" is an invalid filename_time & + &The acceptable values are begin, middle, and end. & + &Check your entry for file "//trim(fileobj%file_fname)) + end select +end subroutine set_filename_time + !> @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, file_duration_units) @@ -1025,6 +1055,15 @@ pure function get_file_global_meta (diag_files_obj) & character (:), allocatable :: res(:,:) !< What is returned res = diag_files_obj%file_global_meta end function get_file_global_meta +!> @brief Get the integer equivalent of the time to use to determine the filename, +!! if using a wildcard file name (i.e ocn%4yr%2mo%2dy%2hr) +!! @return the integer equivalent of the time to use to determine the filename +pure function get_filename_time(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%filename_time +end function !> @brief Inquiry for whether file_global_meta is allocated !! @return Flag indicating if file_global_meta is allocated function is_global_meta(diag_files_obj) & diff --git a/test_fms/diag_manager/test_diag_manager2.sh b/test_fms/diag_manager/test_diag_manager2.sh index 2cee1c65bd..5fe58de19c 100755 --- a/test_fms/diag_manager/test_diag_manager2.sh +++ b/test_fms/diag_manager/test_diag_manager2.sh @@ -514,6 +514,7 @@ title: test_diag_manager base_date: 2 1 1 0 0 0 diag_files: - file_name: wild_card_name%4yr%2mo%2dy%2hr + filename_time: end freq: 6 freq_units: hours time_units: hours @@ -752,7 +753,23 @@ diag_files: var_name: var1 reduction: none kind: r4 -- file_name: file8%4yr%2mo%2dy%2hr +- file_name: file8%4yr%2mo%2dy%2hr%2min + 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 +- file_name: file9%4yr%2mo%2dy%2hr%2min + filename_time: begin freq: 1 1 1 freq_units: hours hours hours time_units: hours diff --git a/test_fms/diag_manager/test_diag_yaml.F90 b/test_fms/diag_manager/test_diag_yaml.F90 index c097980783..3024412854 100644 --- a/test_fms/diag_manager/test_diag_yaml.F90 +++ b/test_fms/diag_manager/test_diag_yaml.F90 @@ -25,7 +25,7 @@ program test_diag_yaml use fms_diag_yaml_mod 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 + & time_average, r4, middle_time, end_time use time_manager_mod, only: set_calendar_type, JULIAN use mpp_mod use platform_mod @@ -210,6 +210,10 @@ subroutine compare_diag_files(res) call compare_result("file_fname 2", res(2)%get_file_fname(), "normal") call compare_result("file_fname 3", res(3)%get_file_fname(), "normal2") + call compare_result("get_filename_time 1", res(1)%get_filename_time(), end_time) + call compare_result("get_filename_time 2", res(2)%get_filename_time(), middle_time) + call compare_result("get_filename_time 3", res(3)%get_filename_time(), middle_time) + call compare_result("file_freq 1", res(1)%get_file_freq(), 6) call compare_result("file_freq 2", res(2)%get_file_freq(), 24) call compare_result("file_freq 3", res(3)%get_file_freq(), -1) From 488dfa195f0f9abb2fb4c9e74d63f14b00b92be0 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Thu, 2 Feb 2023 14:40:14 -0500 Subject: [PATCH 03/15] Fix race conditions + add send_data tests --- diag_manager/diag_manager.F90 | 5 +- test_fms/diag_manager/test_diag_manager2.sh | 10 ++ test_fms/diag_manager/test_modern_diag.F90 | 137 +++++++++++++++++--- 3 files changed, 131 insertions(+), 21 deletions(-) diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index a83abc2a25..2960de0f58 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -1616,7 +1616,7 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, & CHARACTER(len=128) :: error_string, error_string1 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: field_out !< Local copy of field - class(*), pointer, dimension(:,:,:,:) :: field_modern => null() !< i8 4d remapped pointer + class(*), pointer, dimension(:,:,:,:) :: field_modern !< i8 4d remapped pointer ! If diag_field_id is < 0 it means that this field is not registered, simply return IF ( diag_field_id <= 0 ) THEN send_data_3d = .FALSE. @@ -1647,6 +1647,7 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, & IF ( fms_error_handler('diag_manager_mod::send_data_3d', err_msg_local, err_msg) ) RETURN END IF if (use_modern_diag) then !> Set up array lengths for remapping + field_modern => null() ie = SIZE(field,1) je = SIZE(field,2) ke = SIZE(field,3) @@ -1666,7 +1667,7 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, & modern_if: iF (use_modern_diag) then send_data_3d = fms_diag_object%fms_diag_accept_data(diag_field_id, field_modern, time, is_in, js_in, ks_in, & & mask, rmask, ie_in, je_in, ke_in, weight, err_msg) - deallocate (field_modern) + nullify (field_modern) elSE ! modern_if ! oor_mask is only used for checking out of range values. ALLOCATE(oor_mask(SIZE(field,1),SIZE(field,2),SIZE(field,3)), STAT=status) diff --git a/test_fms/diag_manager/test_diag_manager2.sh b/test_fms/diag_manager/test_diag_manager2.sh index 2cee1c65bd..a76e80e0b3 100755 --- a/test_fms/diag_manager/test_diag_manager2.sh +++ b/test_fms/diag_manager/test_diag_manager2.sh @@ -652,6 +652,16 @@ title: test_diag_manager base_date: 2 1 1 0 0 0 diag_files: +- file_name: static_file + freq: -1 + freq_units: hours + time_units: hours + unlimdim: time + varlist: + - module: atm_mod + var_name: var7 + reduction: none + kind: r4 - file_name: file1 freq: 6 freq_units: hours diff --git a/test_fms/diag_manager/test_modern_diag.F90 b/test_fms/diag_manager/test_modern_diag.F90 index f557470dc1..8d9e6d20e9 100644 --- a/test_fms/diag_manager/test_modern_diag.F90 +++ b/test_fms/diag_manager/test_modern_diag.F90 @@ -26,14 +26,25 @@ program test_modern_diag mpp_get_UG_compute_domain use diag_manager_mod, only: diag_manager_init, diag_manager_end, diag_axis_init, register_diag_field, & diag_axis_add_attribute, diag_field_add_attribute, diag_send_complete, & - diag_manager_set_time_end + diag_manager_set_time_end, send_data, register_static_field +use platform_mod, only: r8_kind, r4_kind use fms_mod, only: fms_init, fms_end -use mpp_mod, only: FATAL, mpp_error, mpp_npes, mpp_pe, mpp_root_pe, mpp_broadcast +use mpp_mod, only: FATAL, mpp_error, mpp_npes, mpp_pe, mpp_root_pe, mpp_broadcast, input_nml_file use time_manager_mod, only: time_type, set_calendar_type, set_date, JULIAN, set_time use fms_diag_object_mod,only: dump_diag_obj implicit none +!> @brief Type to hold all the dummy data variables +type data_type + real(kind=r8_kind), allocatable :: var1(:,:) !< Dummy data for var1 + real(kind=r8_kind), allocatable :: var2(:,:) !< Dummy data for var2 + real(kind=r8_kind), allocatable :: var3(:,:) !< Dummy data for var3 + real(kind=r8_kind), allocatable :: var4(:,:,:) !< Dummy data for var4 + real(kind=r8_kind), allocatable :: var5(:) !< Dummy data for var5 + real(kind=r8_kind), allocatable :: var6(:) !< Dummy data for var6 +end type data_type + type(time_type) :: Time !< Time of the simulation integer, dimension(2) :: layout !< Layout to use when setting up the domain integer, dimension(2) :: io_layout !< io layout to use when setting up the io domain @@ -55,18 +66,30 @@ program test_modern_diag integer :: id_y3 !< axis id for the y dimension in the cube sphere domain integer :: id_UG !< axis id for the unstructured dimension integer :: id_z !< axis id for the z dimention +integer :: id_z2 !< axis id for the z dimention integer :: id_var1 !< diag_field id for var in lon/lat grid integer :: id_var2 !< diag_field id for var in lat/lon grid integer :: id_var3 !< diag_field id for var in cube sphere grid integer :: id_var4 !< diag_field id for 3d var in cube sphere grid integer :: id_var5 !< diag_field id for var in UG grid integer :: id_var6 !< diag_field id for var that is not domain decomposed -integer :: id_var7 !< Scalar var +integer :: id_var7 !< 1D var +integer :: id_var8 !< Scalar var +type(data_type) :: var_data !< Dummy variable data to send to diag_manager +logical :: used !< Used for send_data call +integer :: io_status !< Status after reading the namelist +logical :: debug = .false. !< Flag used to ignore the axis/field_ids checks in the test. + !! Useful when using a portion or a different diag_table.yaml + +namelist / test_modern_diag_nml / debug call fms_init call set_calendar_type(JULIAN) call diag_manager_init +read (input_nml_file, test_modern_diag_nml, iostat=io_status) +if (io_status > 0) call mpp_error(FATAL,'=>test_modern_diag: Error reading input.nml') + nx = 96 ny = 96 nz = 5 @@ -108,7 +131,9 @@ program test_modern_diag id_ug = diag_axis_init("grid_index", real(ug_dim_data), "none", "U", long_name="grid indices", & set_name="land", DomainU=land_domain, aux="geolon_t geolat_t") -id_z = diag_axis_init('z', z, 'point_Z', 'z', long_name='point_Z') +id_z2 = diag_axis_init('z_edge', z, 'point_Z', 'z', long_name='point_Z') +id_z = diag_axis_init('z', z, 'point_Z', 'z', long_name='point_Z', edges = id_z2) + call diag_axis_add_attribute (id_z, 'formula', 'p(n,k,j,i) = ap(k) + b(k)*ps(n,j,i)') call diag_axis_add_attribute (id_z, 'integer', 10) call diag_axis_add_attribute (id_z, '1d integer', (/10, 10/)) @@ -116,12 +141,15 @@ program test_modern_diag call diag_axis_add_attribute (id_x, '1d real', (/10./)) call diag_axis_add_attribute (id_ug, 'compress', 'x y') -if (id_x .ne. 1) call mpp_error(FATAL, "The x axis does not have the expected id") -if (id_y .ne. 2) call mpp_error(FATAL, "The y axis does not have the expected id") -if (id_x3 .ne. 3) call mpp_error(FATAL, "The x3 axis does not have the expected id") -if (id_y3 .ne. 4) call mpp_error(FATAL, "The y3 axis does not have the expected id") -if (id_ug .ne. 5) call mpp_error(FATAL, "The ug axis does not have the expected id") -if (id_z .ne. 6) call mpp_error(FATAL, "The z axis does not have the expected id") +if (.not. debug) then + if (id_x .ne. 1) call mpp_error(FATAL, "The x axis does not have the expected id") + if (id_y .ne. 2) call mpp_error(FATAL, "The y axis does not have the expected id") + if (id_x3 .ne. 3) call mpp_error(FATAL, "The x3 axis does not have the expected id") + if (id_y3 .ne. 4) call mpp_error(FATAL, "The y3 axis does not have the expected id") + if (id_ug .ne. 5) call mpp_error(FATAL, "The ug axis does not have the expected id") + if (id_z2 .ne. 6) call mpp_error(FATAL, "The z2 axis does not have the expected id") + if (id_z .ne. 7) call mpp_error(FATAL, "The z axis does not have the expected id") +endif ! Register the variables id_var1 = register_diag_field ('ocn_mod', 'var1', (/id_x, id_y/), Time, 'Var in a lon/lat domain', 'mullions') @@ -136,14 +164,18 @@ program test_modern_diag !< This has the same name as var1, but it should have a different id because the module is different !! so it should have its own diag_obj id_var7 = register_diag_field ('lnd_mod', 'var1', Time, 'Some scalar var', 'mullions') - -if (id_var1 .ne. 1) call mpp_error(FATAL, "var1 does not have the expected id") -if (id_var2 .ne. 2) call mpp_error(FATAL, "var2 does not have the expected id") -if (id_var3 .ne. 3) call mpp_error(FATAL, "var3 does not have the expected id") -if (id_var4 .ne. 4) call mpp_error(FATAL, "var4 does not have the expected id") -if (id_var5 .ne. 5) call mpp_error(FATAL, "var5 does not have the expected id") -if (id_var6 .ne. 6) call mpp_error(FATAL, "var6 does not have the expected id") -if (id_var7 .ne. 7) call mpp_error(FATAL, "var7 does not have the expected id") +id_var8 = register_static_field ('atm_mod', 'var7', (/id_z/), "Be static!", "none") + +if (.not. debug) then + if (id_var1 .ne. 1) call mpp_error(FATAL, "var1 does not have the expected id") + if (id_var2 .ne. 2) call mpp_error(FATAL, "var2 does not have the expected id") + if (id_var3 .ne. 3) call mpp_error(FATAL, "var3 does not have the expected id") + if (id_var4 .ne. 4) call mpp_error(FATAL, "var4 does not have the expected id") + if (id_var5 .ne. 5) call mpp_error(FATAL, "var5 does not have the expected id") + if (id_var6 .ne. 6) call mpp_error(FATAL, "var6 does not have the expected id") + if (id_var7 .ne. 7) call mpp_error(FATAL, "var7 does not have the expected id") + if (id_var8 .ne. 8) call mpp_error(FATAL, "var8 does not have the expected id") +endif call diag_field_add_attribute (id_var1, "some string", "this is a string") call diag_field_add_attribute (id_var1, "integer", 10) @@ -160,9 +192,24 @@ program test_modern_diag call diag_manager_set_time_end(Time) call diag_manager_set_time_end(set_date(2,1,2,0,0,0)) +call allocate_dummy_data(var_data, domain, Domain_cube_sph, land_domain, nz) do i=1,23 - call diag_send_complete(set_date(2,1,1,i,0,0)) + Time = set_date(2,1,1,i,0,0) + call set_dummy_data(var_data, i) + used = send_data(id_var1, var_data%var1, Time) + used = send_data(id_var2, var_data%var2, Time) + used = send_data(id_var3, var_data%var3, Time) + used = send_data(id_var4, var_data%var4, Time) + used = send_data(id_var5, var_data%var5, Time) + used = send_data(id_var6, var_data%var6, Time) + used = send_data(id_var7, var_data%var6, Time) + + !TODO I don't know about this (scalar field) or how this is suppose to work #WUT + used = send_data(id_var8, var_data%var6, Time) + + call diag_send_complete(Time) enddo +call deallocate_dummy_data(var_data) call diag_manager_end(Time) call fms_end @@ -172,6 +219,57 @@ program test_modern_diag include "../fms2_io/create_atmosphere_domain.inc" include "../fms2_io/create_land_domain.inc" +!> @brief Allocates the dummy data to send to send_data +subroutine allocate_dummy_data(var, lat_lon_domain, cube_sphere, lnd_domain, nz) + type(data_type), intent(inout) :: var !< Data var to allocate + type(domain2d), intent(in) :: lat_lon_domain !< Lat/Lon domain + type(domain2d), intent(in) :: cube_sphere !< Cube sphere domain + type(domainug), intent(in) :: lnd_domain !< Land domain + integer, intent(in) :: nz !< Number of Z points + + integer :: nland !< Size of the unstructured grid per PE + integer :: is !< Starting x compute index + integer :: ie !< Ending x compute index + integer :: js !< Starting y compute index + integer :: je !< Ending y compute index + + call mpp_get_compute_domain(lat_lon_domain, is, ie, js, je) + allocate(var%var1(is:ie, js:je)) !< Variable in a lat/lon domain + allocate(var%var2(js:je, is:ie)) !< Variable in a lat/lon domain with flipped dimensions + + call mpp_get_compute_domain(cube_sphere, is, ie, js, je) + allocate(var%var3(is:ie, js:je)) !< Variable in a cube sphere domain + allocate(var%var4(is:ie, js:je, nz)) !< Variable in a 3D cube sphere domain + + call mpp_get_UG_compute_domain(lnd_domain, size=nland) + allocate(var%var5(nz)) !< Variable in the land unstructured domain + + allocate(var%var6(nz)) !< 1D variable not domain decomposed + +end subroutine allocate_dummy_data + +!> @brief Allocates the dummy data to send to send_data +subroutine deallocate_dummy_data(var) + type(data_type), intent(inout) :: var !< Data var to deallocate + + deallocate(var%var1, var%var2, var%var3, var%var4, var%var5, var%var6) +end subroutine deallocate_dummy_data + +!> @brief Sets the dummy_data to use in send_data +subroutine set_dummy_data(var, data_value) + type(data_type), intent(inout) :: var !< Data type to set + integer, intent(in) :: data_value !< Value to send the data as + + var%var1 = real(data_value, kind=r8_kind) + var%var2 = real(data_value + 1, kind=r8_kind) + var%var3 = real(data_value + 2, kind=r8_kind) + var%var4 = real(data_value + 3, kind=r8_kind) + var%var5 = real(data_value + 4, kind=r8_kind) + var%var6 = real(data_value + 5, kind=r8_kind) + +end subroutine set_dummy_data + +!> @brief Sets up a lat/lon domain subroutine set_up_2D_domain(Domain, layout, nx, ny, io_layout) type(domain2d), intent(out) :: Domain !< 2D domain integer, intent(in) :: layout(:) !< Layout to use when setting up the domain @@ -184,6 +282,7 @@ subroutine set_up_2D_domain(Domain, layout, nx, ny, io_layout) call mpp_define_io_domain(Domain, io_layout) end subroutine set_up_2D_domain +!> @brief Sets up a cube sphere domain subroutine set_up_cube_sph_domain(Domain_cube_sph, nx, ny, io_layout) type(domain2d), intent(out) :: Domain_cube_sph !< 2D domain integer, intent(in) :: nx !< Number of x points From a1fca6d867daa5cb4ebd2c917c9f0900273e5088 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Mon, 6 Feb 2023 15:06:08 -0500 Subject: [PATCH 04/15] Attempt to add the diurnal axis --- diag_manager/fms_diag_axis_object.F90 | 124 +++++++++++++++++++- diag_manager/fms_diag_field_object.F90 | 21 +++- diag_manager/fms_diag_file_object.F90 | 41 ++++++- diag_manager/fms_diag_object.F90 | 2 + test_fms/diag_manager/test_diag_manager2.sh | 10 ++ 5 files changed, 188 insertions(+), 10 deletions(-) diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index 13d73a8337..881eb8a17c 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -35,11 +35,13 @@ module fms_diag_axis_object_mod use platform_mod, only: r8_kind, r4_kind, i4_kind, i8_kind use diag_data_mod, only: diag_atttype, max_axes, NO_DOMAIN, TWO_D_DOMAIN, UG_DOMAIN, & direction_down, direction_up, fmsDiagAttribute_type, max_axis_attributes, & - MAX_SUBAXES, DIAG_NULL, index_gridtype, latlon_gridtype + MAX_SUBAXES, DIAG_NULL, index_gridtype, latlon_gridtype, pack_size_str, & + get_base_year, get_base_month, get_base_day, get_base_hour, get_base_minute,& + get_base_second use mpp_mod, only: FATAL, mpp_error, uppercase, mpp_pe, mpp_root_pe, stdout use fms2_io_mod, only: FmsNetcdfFile_t, FmsNetcdfDomainFile_t, FmsNetcdfUnstructuredDomainFile_t, & & register_axis, register_field, register_variable_attribute, write_data - use fms_diag_yaml_mod, only: subRegion_type + use fms_diag_yaml_mod, only: subRegion_type, diag_yaml use diag_grid_mod, only: get_local_indices_cubesphere => get_local_indexes use axis_utils2_mod, only: nearest_index implicit none @@ -49,7 +51,8 @@ module fms_diag_axis_object_mod public :: fmsDiagAxis_type, fms_diag_axis_object_init, fms_diag_axis_object_end, & & get_domain_and_domain_type, diagDomain_t, & & DIAGDOMAIN2D_T, fmsDiagSubAxis_type, fmsDiagAxisContainer_type, fmsDiagFullAxis_type, DIAGDOMAINUG_T - public :: define_new_axis, define_subaxis, parse_compress_att, get_axis_id_from_name + public :: define_new_axis, define_subaxis, parse_compress_att, get_axis_id_from_name, define_diurnal_axis, & + & fmsDiagDiurnalAxis_type !> @} @@ -115,6 +118,22 @@ module fms_diag_axis_object_mod procedure :: fill_subaxis END TYPE fmsDiagSubAxis_type + !> @brief Type to hold the diurnal axis + !> @ingroup diag_axis_object_mod + TYPE, extends(fmsDiagAxis_type) :: fmsDiagDiurnalAxis_type + INTEGER , private :: ndiurnal_samples !< The number of diurnal samples + CHARACTER(len=:), ALLOCATABLE, private :: axis_name !< The diurnal axis name + CHARACTER(len=:), ALLOCATABLE, private :: long_name !< The longname of the diurnal axis + CHARACTER(len=:), ALLOCATABLE, private :: units !< The units + INTEGER , private :: edges_id !< The id of the diurnal edges + CHARACTER(len=:), ALLOCATABLE, private :: edges_name !< The name of the edges axis + CLASS(*), ALLOCATABLE, private :: diurnal_data(:) !< The diurnal data + + contains + procedure :: get_diurnal_axis_samples + procedure :: write_diurnal_metadata + END TYPE fmsDiagDiurnalAxis_type + !> @brief Type to hold the diagnostic axis description. !> @ingroup diag_axis_object_mod TYPE, extends(fmsDiagAxis_type) :: fmsDiagFullAxis_type @@ -291,6 +310,9 @@ subroutine write_axis_metadata(this, fileobj, parent_axis) diag_axis => parent_axis end select endif + type is (fmsDiagDiurnalAxis_type) + call this%write_diurnal_metadata(fileobj) + return end select !< Add the axis as a dimension in the netcdf file based on the type of axis_domain and the fileobj type @@ -386,9 +408,73 @@ subroutine write_axis_data(this, fileobj, parent_axis) call write_data(fileobj, this%subaxis_name, parent_axis%axis_data(i:j)) end select endif + type is (fmsDiagDiurnalAxis_type) + call write_data(fileobj, this%axis_name, this%diurnal_data) end select end subroutine write_axis_data + + !> @brief Defined a new diurnal axis + subroutine define_diurnal_axis(diag_axis, naxis, n_diurnal_samples, is_edges) + class(fmsDiagAxisContainer_type), target, intent(inout) :: diag_axis(:) !< Array of axis containers + integer, intent(inout) :: naxis !< Number of axis that have + !! been defined + integer, intent(in) :: n_diurnal_samples !< The number of diurnal samples + !! for the curent axis + logical, intent(in) :: is_edges !< Flag indicating if this is + !! an edge axis + + CHARACTER(32) :: axis_name !< name of the axis + CHARACTER(32) :: long_name !< long name of the axis + CHARACTER(32) :: edges_name !< name of the axis edge + CHARACTER(128) :: units !< units of the axis + real(kind=r8_kind), allocatable :: diurnal_data(:) !< Data for the axis + integer :: edges_id !< Id of the axis edge + integer :: i !< For do loops + + naxis = naxis + 1 + + axis_name = '' + edges_name = '' + if (is_edges) then + WRITE (axis_name,'(a,i2.2)') 'time_of_day_edges_', n_diurnal_samples + long_name = "time of day edges" + allocate(diurnal_data(n_diurnal_samples + 1)) + diurnal_data(1) = 0.0 + edges_id = diag_null + do i = 1, n_diurnal_samples + diurnal_data(i+1) = 24.0* REAL(i)/n_diurnal_samples + enddo + else + WRITE (axis_name,'(a,i2.2)') 'time_of_day_', n_diurnal_samples + long_name = "time of day" + allocate(diurnal_data(n_diurnal_samples)) + edges_id = naxis -1 !< The diurnal edges is the last defined axis + do i = 1, n_diurnal_samples + diurnal_data(i) = 24.0*(REAL(i)-0.5)/n_diurnal_samples + enddo + endif + + WRITE (units,11) 'hours', get_base_year(), 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) + + allocate(fmsDiagDiurnalAxis_type :: diag_axis(naxis)%axis) + select type (diurnal_axis => diag_axis(naxis)%axis) + type is (fmsDiagDiurnalAxis_type) + diurnal_axis%axis_id = naxis + diurnal_axis%ndiurnal_samples = n_diurnal_samples + diurnal_axis%axis_name = trim(axis_name) + diurnal_axis%long_name = trim(long_name) + diurnal_axis%units = trim(units) + diurnal_axis%diurnal_data = diurnal_data + diurnal_axis%edges_id = edges_id + if (is_edges) & + WRITE (edges_name,'(a,i2.2)') 'time_of_day_edges_', n_diurnal_samples + diurnal_axis%edges_name = trim(edges_name) + end select + end subroutine define_diurnal_axis + !< @brief Determine if the axis is in the unstructured grid !! @return .True. if the axis is in unstructured grid pure logical function is_unstructured_grid(this) @@ -996,6 +1082,8 @@ pure function get_parent_axis_id(this) & parent_axis_id = diag_null type is (fmsDiagSubAxis_type) parent_axis_id = this%parent_axis_id + type is (fmsDiagDiurnalAxis_type) + parent_axis_id = diag_null end select end function @@ -1058,6 +1146,36 @@ pure function get_axis_id_from_name(axis_name, diag_axis, naxis) & end function get_axis_id_from_name + !< @brief Get the number of diurnal samples for a diurnal axis + !! @return The number of diurnal samples + pure function get_diurnal_axis_samples(this) & + result(n_diurnal_samples) + + class(fmsDiagDiurnalAxis_type), intent(in) :: this !< Axis Object + integer :: n_diurnal_samples + + n_diurnal_samples = this%ndiurnal_samples + end function get_diurnal_axis_samples + + !< @brief Writes out the metadata for a diurnal axis + subroutine write_diurnal_metadata(this, fileobj) + class(fmsDiagDiurnalAxis_type), intent(in) :: this !< Diurnal axis Object + class(FmsNetcdfFile_t), intent(inout) :: fileobj !< Fms2_io fileobj to write the data to + + character(len=50) :: dim_name(1) !< Array of dimension names for fms2_io + + dim_name(1) = this%axis_name + call register_axis(fileobj, this%axis_name, size(this%diurnal_data)) + call register_field(fileobj, this%axis_name, pack_size_str, dim_name) + call register_variable_attribute(fileobj, this%axis_name, "units", & + &trim(this%units), str_len=len_trim(this%units)) + call register_variable_attribute(fileobj, this%axis_name, "long_name", & + &trim(this%long_name), str_len=len_trim(this%long_name)) + if (this%edges_id .ne. diag_null) & + call register_variable_attribute(fileobj, this%axis_name, "edges", & + &trim(this%edges_name), str_len=len_trim(this%edges_name)) + end subroutine write_diurnal_metadata + #endif end module fms_diag_axis_object_mod !> @} diff --git a/diag_manager/fms_diag_field_object.F90 b/diag_manager/fms_diag_field_object.F90 index 30f8a45412..75cac92bd3 100644 --- a/diag_manager/fms_diag_field_object.F90 +++ b/diag_manager/fms_diag_field_object.F90 @@ -1001,25 +1001,29 @@ pure function get_longname_to_write(this, field_yaml) & end function get_longname_to_write !> @brief Determine the dimension names to use when registering the field to fms2_io -subroutine get_dimnames(this, diag_axis, unlim_dimname, dimnames, is_regional) - class (fmsDiagField_type), target, intent(inout) :: this !< diag field +subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is_regional) + class (fmsDiagField_type), target, intent(inout) :: this !< diag field class(fmsDiagAxisContainer_type), target, intent(in) :: diag_axis(:) !< Diag_axis object + type(diagYamlFilesVar_type), intent(in) :: field_yaml !< Field info from diag_table yaml character(len=*), intent(in) :: unlim_dimname !< The name of unlimited dimension character(len=120), allocatable, intent(out) :: dimnames(:) !< Array of the dimension names !! for the field logical, intent(in) :: is_regional !< Flag indicating if the field is regional - integer :: i !< For do loops - integer :: naxis !< Number of axis for the field + integer :: i !< For do loops + integer :: naxis !< Number of axis for the field class(fmsDiagAxisContainer_type), pointer :: axis_ptr !diag_axis(this%axis_ids(i), for convenience - !TODO there may be more stuff needed for the diurnal axis if (this%is_static()) then naxis = size(this%axis_ids) else naxis = size(this%axis_ids) + 1 !< Adding 1 more dimension for the unlimited dimension endif + if (field_yaml%has_n_diurnal()) then + naxis = naxis + 1 !< Adding 1 more dimension for the diurnal axis + endif + allocate(dimnames(naxis)) do i = 1, size(this%axis_ids) @@ -1027,6 +1031,11 @@ subroutine get_dimnames(this, diag_axis, unlim_dimname, dimnames, is_regional) dimnames(i) = axis_ptr%axis%get_axis_name(is_regional) enddo + !< The second to last dimension is always the diurnal axis + if (field_yaml%has_n_diurnal()) then + dimnames(naxis - 1) = 'time_of_day_'//int2str(field_yaml%get_n_diurnal()) + endif + !< The last dimension is always the unlimited dimensions if (.not. this%is_static()) dimnames(naxis) = unlim_dimname @@ -1072,7 +1081,7 @@ subroutine write_field_metadata(this, fileobj, file_id, yaml_id, diag_axis, unli var_name = field_yaml%get_var_outname() if (allocated(this%axis_ids)) then - call this%get_dimnames(diag_axis, unlim_dimname, dimnames, is_regional) + call this%get_dimnames(diag_axis, field_yaml, unlim_dimname, dimnames, is_regional) call register_field_wrap(fileobj, var_name, this%get_var_skind(field_yaml), dimnames) else call register_field_wrap(fileobj, var_name, this%get_var_skind(field_yaml)) diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index 4bbff13be9..9a68d74de5 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -41,7 +41,7 @@ module fms_diag_file_object_mod 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, & fmsDiagAxisContainer_type, DIAGDOMAIN2D_T, DIAGDOMAINUG_T, & - fmsDiagFullAxis_type, define_subaxis + fmsDiagFullAxis_type, define_subaxis, define_diurnal_axis, fmsDiagDiurnalAxis_type use fms_diag_field_object_mod, only: fmsDiagField_type use mpp_mod, only: mpp_get_current_pelist, mpp_npes, mpp_root_pe, mpp_pe, mpp_error, FATAL, stdout, & uppercase, lowercase @@ -93,6 +93,7 @@ module fms_diag_file_object_mod contains procedure, public :: add_field_and_yaml_id + procedure, public :: init_diurnal_axis procedure, public :: has_file_metadata_from_model procedure, public :: has_fileobj procedure, public :: has_diag_yaml_file @@ -271,6 +272,44 @@ subroutine add_field_and_yaml_id (this, new_field_id, yaml_id) endif end subroutine add_field_and_yaml_id +!> \brief Initializes a diurnal axis for a fileobj +!! \note This is going to be called for every variable in the file, if the variable is not a diurnal variable +!! it will do nothing. It only defined a diurnal axis once. +subroutine init_diurnal_axis(this, diag_axis, naxis, yaml_id) + class(fmsDiagFile_type), intent(inout) :: this !< The file object + class(fmsDiagAxisContainer_type), intent(inout) :: diag_axis(:) !< Array of diag_axis object + integer, intent(inout) :: naxis !< Number of diag_axis that heve been defined + integer, intent(in) :: yaml_id !< The ID to the variable's yaml + + integer :: i !< For do loops + type(diagYamlFilesVar_type), pointer :: field_yaml !< pointer to the yaml entry + + field_yaml => diag_yaml%get_diag_field_from_id(yaml_id) + + !< Go away if the file does not need a diurnal axis + if (.not. field_yaml%has_n_diurnal()) return + + !< Check if the diurnal axis is already defined for this number of diurnal samples + do i = 1, this%number_of_axis + select type(axis=>diag_axis(this%axis_ids(i))%axis) + type is (fmsDiagDiurnalAxis_type) + if(field_yaml%get_n_diurnal() .eq. axis%get_diurnal_axis_samples()) return + end select + end do + + !< If it is not already defined, define it + call define_diurnal_axis(diag_axis, naxis, field_yaml%get_n_diurnal(), .true.) + call define_diurnal_axis(diag_axis, naxis, field_yaml%get_n_diurnal(), .False.) + + !< Add it to the list of axis for the file + this%number_of_axis = this%number_of_axis + 1 + this%axis_ids(this%number_of_axis) = naxis !< This is the diurnal axis edges + + this%number_of_axis = this%number_of_axis + 1 + this%axis_ids(this%number_of_axis) = naxis - 1 !< This the diurnal axis + +end subroutine init_diurnal_axis + !> \brief Set the time_ops variable in the diag_file object subroutine set_file_time_ops(this, VarYaml, is_static) class(fmsDiagFile_type), intent(inout) :: this !< The file object diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 93e615b177..95bcb93ef7 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -224,6 +224,7 @@ integer function fms_register_diag_field_obj & fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i)) call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain()) + call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i)) call fileptr%add_axes(axes, this%diag_axis, this%registered_axis) call fileptr%add_start_time(init_time) call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static()) @@ -232,6 +233,7 @@ integer function fms_register_diag_field_obj & do i = 1, size(file_ids) fileptr => this%FMS_diag_files(file_ids(i))%FMS_diag_file call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i)) + call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i)) call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain()) call fileptr%add_axes(axes, this%diag_axis, this%registered_axis) call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static()) diff --git a/test_fms/diag_manager/test_diag_manager2.sh b/test_fms/diag_manager/test_diag_manager2.sh index 03e98ce327..7d15ad7b0f 100755 --- a/test_fms/diag_manager/test_diag_manager2.sh +++ b/test_fms/diag_manager/test_diag_manager2.sh @@ -794,6 +794,16 @@ diag_files: var_name: var1 reduction: average kind: r4 +- file_name: file10_diurnal + freq: 1 + freq_units: days + time_units: hours + unlimdim: time + varlist: + - module: ocn_mod + var_name: var1 + reduction: diurnal12 + kind: r4 _EOF my_test_count=`expr $my_test_count + 1` From 73354c328f3ea7f6964c31610c970439ee1b7f20 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Mon, 6 Feb 2023 15:15:26 -0500 Subject: [PATCH 05/15] Remote extra whitespace --- diag_manager/fms_diag_file_object.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index 9a68d74de5..7873124100 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -274,7 +274,7 @@ end subroutine add_field_and_yaml_id !> \brief Initializes a diurnal axis for a fileobj !! \note This is going to be called for every variable in the file, if the variable is not a diurnal variable -!! it will do nothing. It only defined a diurnal axis once. +!! it will do nothing. It only defined a diurnal axis once. subroutine init_diurnal_axis(this, diag_axis, naxis, yaml_id) class(fmsDiagFile_type), intent(inout) :: this !< The file object class(fmsDiagAxisContainer_type), intent(inout) :: diag_axis(:) !< Array of diag_axis object From feea901b20506a63f90fc11a11e3afc3a8e2f9a3 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Mon, 6 Feb 2023 16:37:34 -0500 Subject: [PATCH 06/15] Attempt to add the sub z axis --- diag_manager/fms_diag_axis_object.F90 | 131 +++++++++++++++----- diag_manager/fms_diag_field_object.F90 | 27 ++-- diag_manager/fms_diag_file_object.F90 | 35 ++++-- diag_manager/fms_diag_object.F90 | 4 +- diag_manager/fms_diag_yaml.F90 | 2 +- test_fms/diag_manager/test_diag_manager2.sh | 6 + 6 files changed, 156 insertions(+), 49 deletions(-) diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index 881eb8a17c..ddb0602e51 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -52,7 +52,7 @@ module fms_diag_axis_object_mod & get_domain_and_domain_type, diagDomain_t, & & DIAGDOMAIN2D_T, fmsDiagSubAxis_type, fmsDiagAxisContainer_type, fmsDiagFullAxis_type, DIAGDOMAINUG_T public :: define_new_axis, define_subaxis, parse_compress_att, get_axis_id_from_name, define_diurnal_axis, & - & fmsDiagDiurnalAxis_type + & fmsDiagDiurnalAxis_type, create_new_z_subaxis !> @} @@ -97,6 +97,7 @@ module fms_diag_axis_object_mod procedure :: get_parent_axis_id procedure :: get_subaxes_id procedure :: get_axis_name + procedure :: is_z_axis procedure :: write_axis_metadata procedure :: write_axis_data procedure :: add_structured_axis_ids @@ -107,13 +108,13 @@ module fms_diag_axis_object_mod !> @brief Type to hold the subaxis !> @ingroup diag_axis_object_mod TYPE, extends(fmsDiagAxis_type) :: fmsDiagSubAxis_type - CHARACTER(len=:), ALLOCATABLE, private :: subaxis_name !< Name of the subaxis - INTEGER , private :: starting_index !< Starting index of the subaxis relative to the - !! parent axis - INTEGER , private :: ending_index !< Ending index of the subaxis relative to the - !! parent axis - type(subRegion_type) , private :: subRegion !< Bounds of the subaxis (lat/lon or indices) - INTEGER , private :: parent_axis_id !< Id of the parent_axis + CHARACTER(len=:), ALLOCATABLE , private :: subaxis_name !< Name of the subaxis + INTEGER , private :: starting_index !< Starting index of the subaxis relative to the + !! parent axis + INTEGER , private :: ending_index !< Ending index of the subaxis relative to the + !! parent axis + INTEGER , private :: parent_axis_id !< Id of the parent_axis + real(kind=r4_kind), allocatable, private :: zbounds(:) !< Bounds of the Z axis contains procedure :: fill_subaxis END TYPE fmsDiagSubAxis_type @@ -295,11 +296,14 @@ subroutine write_axis_metadata(this, fileobj, parent_axis) integer :: i !< For do loops type(fmsDiagFullAxis_type), pointer :: diag_axis !< Local pointer to the diag_axis + integer :: type_of_domain !< The type of domain the current axis is in + select type(this) type is (fmsDiagFullAxis_type) axis_name => this%axis_name axis_length = this%length diag_axis => this + type_of_domain = this%type_of_domain type is (fmsDiagSubAxis_type) axis_name => this%subaxis_name axis_length = this%ending_index - this%starting_index + 1 @@ -310,6 +314,7 @@ subroutine write_axis_metadata(this, fileobj, parent_axis) diag_axis => parent_axis end select endif + type_of_domain = NO_DOMAIN !< All subaxes are treated as non-domain decomposed (each rank writes it own file) type is (fmsDiagDiurnalAxis_type) call this%write_diurnal_metadata(fileobj) return @@ -324,7 +329,7 @@ subroutine write_axis_metadata(this, fileobj, parent_axis) call register_axis(fileobj, axis_name, axis_length) call register_field(fileobj, axis_name, diag_axis%type_of_data, (/axis_name/)) type is (FmsNetcdfDomainFile_t) - select case (diag_axis%type_of_domain) + select case (type_of_domain) case (NO_DOMAIN) !< Here the fileobj is domain decomposed, but the axis is not !! Domain decomposed fileobjs can have axis that are not domain decomposed (i.e "Z" axis) @@ -336,7 +341,7 @@ subroutine write_axis_metadata(this, fileobj, parent_axis) call register_field(fileobj, axis_name, diag_axis%type_of_data, (/axis_name/)) end select type is (FmsNetcdfUnstructuredDomainFile_t) - select case (diag_axis%type_of_domain) + select case (type_of_domain) case (UG_DOMAIN) !< Here the axis is in a unstructured domain call register_axis(fileobj, axis_name) @@ -675,21 +680,25 @@ end subroutine get_compute_domain !!!!!!!!!!!!!!!!!! SUB AXIS PROCEDURES !!!!!!!!!!!!!!!!! !> @brief Fills in the information needed to define a subaxis - subroutine fill_subaxis(this, starting_index, ending_index, axis_id, parent_id, parent_axis_name, subRegion) - class(fmsDiagSubAxis_type), INTENT(INOUT) :: this !< diag_sub_axis obj - integer , intent(in) :: starting_index !< Starting index of the subRegion for the PE - integer , intent(in) :: ending_index !< Ending index of the subRegion for the PE - integer , intent(in) :: axis_id !< Axis id to assign to the subaxis - integer , intent(in) :: parent_id !< The id of the parent axis, the subaxis belongs to - type(subRegion_type) , intent(in) :: subRegion !< SubRegion definition as it is defined in the yaml - character(len=*) , intent(in) :: parent_axis_name !< Name of the parent_axis + subroutine fill_subaxis(this, starting_index, ending_index, axis_id, parent_id, parent_axis_name, zbounds) + class(fmsDiagSubAxis_type) , INTENT(INOUT) :: this !< diag_sub_axis obj + integer , intent(in) :: starting_index !< Starting index of the subRegion for the PE + integer , intent(in) :: ending_index !< Ending index of the subRegion for the PE + integer , intent(in) :: axis_id !< Axis id to assign to the subaxis + integer , intent(in) :: parent_id !< The id of the parent axis, the subaxis belongs to + character(len=*) , intent(in) :: parent_axis_name !< Name of the parent_axis + real(kind=r4_kind), optional, intent(in) :: zbounds(2) !< Bounds of the z-axis this%axis_id = axis_id this%starting_index = starting_index this%ending_index = ending_index this%parent_axis_id = parent_id - this%subRegion = subRegion this%subaxis_name = trim(parent_axis_name)//"_sub01" + + if (present(zbounds)) then + allocate(this%zbounds(2)) + this%zbounds = zbounds + endif end subroutine fill_subaxis !> @brief Get the ntiles in a domain @@ -793,6 +802,17 @@ pure function get_axis_name(this, is_regional) & end select end function get_axis_name + !< @brief Determine if the axis is a Z axis by looking at the cartesian name + !! @return .True. if the axis is a Z axis + pure logical function is_z_axis(this) + class(fmsDiagAxis_type), intent(in) :: this !< Axis object + is_z_axis = .false. + select type (this) + type is (fmsDiagFullAxis_type) + if (this%cart_name .eq. "Z") is_z_axis = .true. + end select + end function + !> @brief Check if a cart_name is valid and crashes if it isn't subroutine check_if_valid_cart_name(cart_name) character(len=*), intent(in) :: cart_name @@ -919,7 +939,7 @@ subroutine define_subaxis_index(diag_axis, axis_ids, naxis, subRegion, write_on_ !< If the PE's compute is not inside the subRegion, define a null subaxis and go to the next axis if (.not. need_to_define_axis) then call define_new_axis(diag_axis, parent_axis, naxis, axis_ids(i), & - subRegion, diag_null, diag_null) + diag_null, diag_null) cycle endif @@ -927,7 +947,7 @@ subroutine define_subaxis_index(diag_axis, axis_ids, naxis, subRegion, write_on_ write_on_this_pe = .true. call define_new_axis(diag_axis, parent_axis, naxis, axis_ids(i), & - subRegion, starting_index, ending_index) + starting_index, ending_index) end select enddo @@ -994,7 +1014,7 @@ subroutine define_subaxis_latlon(diag_axis, axis_ids, naxis, subRegion, is_cube_ write_on_this_pe = .true. call define_new_axis(diag_axis, parent_axis, naxis, axis_ids(i), & - subRegion, starting_index, ending_index) + starting_index, ending_index) end select select_axis_type enddo loop_over_axis_ids else if_is_cube_sphere @@ -1033,24 +1053,25 @@ subroutine define_subaxis_latlon(diag_axis, axis_ids, naxis, subRegion, is_cube_ write_on_this_pe = .true. call define_new_axis(diag_axis, parent_axis, naxis, axis_ids(i), & - subRegion, starting_index, ending_index) + starting_index, ending_index) end select enddo loop_over_axis_ids2 endif if_is_cube_sphere end subroutine define_subaxis_latlon - !< Creates a new subaxis and fills it will all the information it needs - subroutine define_new_axis(diag_axis, parent_axis, naxis, parent_id, subRegion, & - starting_index, ending_index) + !> @brief Creates a new subaxis and fills it will all the information it needs + subroutine define_new_axis(diag_axis, parent_axis, naxis, parent_id, & + starting_index, ending_index, new_axis_id, zbounds) class(fmsDiagAxisContainer_type), target, intent(inout) :: diag_axis(:) !< Diag_axis object class(fmsDiagFullAxis_type), intent(inout) :: parent_axis !< The parent axis integer, intent(inout) :: naxis !< The number of axis that !! have been defined integer, intent(in) :: parent_id !< Id of the parent axis - type(subRegion_type), intent(in) :: subRegion !< SubRegion definition from the yaml integer, intent(in) :: starting_index !< PE's Starting index integer, intent(in) :: ending_index !< PE's Ending index + integer, optional, intent(out) :: new_axis_id !< Axis id of the axis this is creating + real(kind=r4_kind), optional, intent(in) :: zbounds(2) !< Bounds of the Z axis naxis = naxis + 1 !< This is the axis id of the new axis! @@ -1061,11 +1082,12 @@ subroutine define_new_axis(diag_axis, parent_axis, naxis, parent_id, subRegion, !< Allocate the new axis as a subaxis and fill it allocate(fmsDiagSubAxis_type :: diag_axis(naxis)%axis) diag_axis(naxis)%axis%axis_id = naxis + if (present(new_axis_id)) new_axis_id = naxis select type (sub_axis => diag_axis(naxis)%axis) type is (fmsDiagSubAxis_type) call sub_axis%fill_subaxis(starting_index, ending_index, naxis, parent_id, & - parent_axis%axis_name, subRegion) + parent_axis%axis_name, zbounds) end select end subroutine define_new_axis @@ -1176,6 +1198,59 @@ subroutine write_diurnal_metadata(this, fileobj) &trim(this%edges_name), str_len=len_trim(this%edges_name)) end subroutine write_diurnal_metadata + !> @brief Creates a new z subaxis to use + subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_axis_id, nfile_axis) + real(kind=r4_kind), intent(in) :: zbounds(2) !< Bounds of the Z axis + integer, intent(inout) :: var_axis_ids(:) !< The variable's axis_ids + class(fmsDiagAxisContainer_type), target, intent(inout) :: diag_axis(:) !< Array of diag_axis objects + integer, intent(inout) :: naxis !< Number of axis that have been + !! registered + integer, intent(inout) :: file_axis_id(:) !< The file's axis_ids + integer, intent(inout) :: nfile_axis !< Number of axis that have been + !! defined in file + + class(*), pointer :: zaxis_data(:) !< The data of the full zaxis + integer :: subaxis_indices(2) !< The starting and ending indices of the subaxis relative to the full + !! axis + integer :: i !< For do loops + integer :: zaxis_id !< The id of the full zaxis + integer :: subaxis_id !< The id of the new z subaxis + + !< Determine if the axis was already created + do i = 1, nfile_axis + select type (axis => diag_axis(file_axis_id(i))%axis) + type is (fmsDiagSubAxis_type) + if (axis%zbounds(1) .eq. zbounds(1) .and. axis%zbounds(2) .eq. zbounds(2)) return + end select + enddo + + !< Determine which of the variable's axis is the zaxis! + do i = 1, size(var_axis_ids) + select type (parent_axis => diag_axis(var_axis_ids(i))%axis) + type is (fmsDiagFullAxis_type) + if (parent_axis%cart_name .eq. "Z") then + zaxis_id = i + zaxis_data => parent_axis%axis_data + + select type(zaxis_data) + type is (real(kind=r4_kind)) + !TODO need to include the conversion to "real" because nearest_index doesn't take r4s and r8s + subaxis_indices(1) = nearest_index(real(zbounds(1)), real(zaxis_data)) + subaxis_indices(2) = nearest_index(real(zbounds(2)), real(zaxis_data)) + type is (real(kind=r8_kind)) + subaxis_indices(1) = nearest_index(real(zbounds(1)), real(zaxis_data)) + subaxis_indices(2) = nearest_index(real(zbounds(2)), real(zaxis_data)) + end select + + call define_new_axis(diag_axis, parent_axis, naxis, zaxis_id, & + &subaxis_indices(1), subaxis_indices(2), subaxis_id, zbounds) + var_axis_ids(i) = subaxis_id + return + endif + end select + enddo + + end subroutine #endif end module fms_diag_axis_object_mod !> @} diff --git a/diag_manager/fms_diag_field_object.F90 b/diag_manager/fms_diag_field_object.F90 index 75cac92bd3..ca2216fd1a 100644 --- a/diag_manager/fms_diag_field_object.F90 +++ b/diag_manager/fms_diag_field_object.F90 @@ -1001,7 +1001,7 @@ pure function get_longname_to_write(this, field_yaml) & end function get_longname_to_write !> @brief Determine the dimension names to use when registering the field to fms2_io -subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is_regional) +subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is_regional, has_zbounds) class (fmsDiagField_type), target, intent(inout) :: this !< diag field class(fmsDiagAxisContainer_type), target, intent(in) :: diag_axis(:) !< Diag_axis object type(diagYamlFilesVar_type), intent(in) :: field_yaml !< Field info from diag_table yaml @@ -1009,6 +1009,8 @@ subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is character(len=120), allocatable, intent(out) :: dimnames(:) !< Array of the dimension names !! for the field logical, intent(in) :: is_regional !< Flag indicating if the field is regional + logical, intent(in) :: has_zbounds !< Flag indicating if this variable has a + !! sub_zaxis integer :: i !< For do loops integer :: naxis !< Number of axis for the field @@ -1026,11 +1028,22 @@ subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is allocate(dimnames(naxis)) - do i = 1, size(this%axis_ids) - axis_ptr => diag_axis(this%axis_ids(i)) - dimnames(i) = axis_ptr%axis%get_axis_name(is_regional) - enddo - + !< Duplicated do loops for #performance + if (has_zbounds) then + do i = 1, size(this%axis_ids) + axis_ptr => diag_axis(this%axis_ids(i)) + if (axis_ptr%axis%is_z_axis()) then + dimnames(i) = axis_ptr%axis%get_axis_name(is_regional)//"_sub01" + else + dimnames(i) = axis_ptr%axis%get_axis_name(is_regional) + endif + enddo + else + do i = 1, size(this%axis_ids) + axis_ptr => diag_axis(this%axis_ids(i)) + dimnames(i) = axis_ptr%axis%get_axis_name(is_regional) + enddo + endif !< The second to last dimension is always the diurnal axis if (field_yaml%has_n_diurnal()) then dimnames(naxis - 1) = 'time_of_day_'//int2str(field_yaml%get_n_diurnal()) @@ -1081,7 +1094,7 @@ subroutine write_field_metadata(this, fileobj, file_id, yaml_id, diag_axis, unli var_name = field_yaml%get_var_outname() if (allocated(this%axis_ids)) then - call this%get_dimnames(diag_axis, field_yaml, unlim_dimname, dimnames, is_regional) + call this%get_dimnames(diag_axis, field_yaml, unlim_dimname, dimnames, is_regional, field_yaml%has_var_zbounds()) call register_field_wrap(fileobj, var_name, this%get_var_skind(field_yaml), dimnames) else call register_field_wrap(fileobj, var_name, this%get_var_skind(field_yaml)) diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index 7873124100..196495010f 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -41,7 +41,8 @@ module fms_diag_file_object_mod 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, & fmsDiagAxisContainer_type, DIAGDOMAIN2D_T, DIAGDOMAINUG_T, & - fmsDiagFullAxis_type, define_subaxis, define_diurnal_axis, fmsDiagDiurnalAxis_type + fmsDiagFullAxis_type, define_subaxis, define_diurnal_axis, fmsDiagDiurnalAxis_type, & + create_new_z_subaxis use fms_diag_field_object_mod, only: fmsDiagField_type use mpp_mod, only: mpp_get_current_pelist, mpp_npes, mpp_root_pe, mpp_pe, mpp_error, FATAL, stdout, & uppercase, lowercase @@ -671,18 +672,30 @@ subroutine set_file_domain(this, domain, type_of_domain) end subroutine set_file_domain !> @brief Loops through a variable's axis_ids and adds them to the FMSDiagFile object if they don't exist -subroutine add_axes(this, axis_ids, diag_axis, naxis) +subroutine add_axes(this, axis_ids, diag_axis, naxis, yaml_id) class(fmsDiagFile_type), intent(inout) :: this !< The file object integer, INTENT(in) :: axis_ids(:) !< Array of axes_ids class(fmsDiagAxisContainer_type), intent(inout) :: diag_axis(:) !< Diag_axis object integer, intent(inout) :: naxis !< Number of axis that have been registered + integer, intent(in) :: yaml_id !< Yaml id of the yaml section for this var - integer :: i, j !< For do loops - logical :: is_cube_sphere !< Flag indicating if the file's domain is a cubesphere - logical :: axis_found !< Flag indicating that the axis was already to the file obj + type(diagYamlFilesVar_type), pointer :: field_yaml !< pointer to the yaml entry + + integer :: i, j !< For do loops + logical :: is_cube_sphere !< Flag indicating if the file's domain is a cubesphere + logical :: axis_found !< Flag indicating that the axis was already to the file obj + integer, allocatable :: var_axis_ids(:) !< Array of the variable's axis ids is_cube_sphere = .false. + field_yaml => diag_yaml%get_diag_field_from_id(yaml_id) + var_axis_ids = axis_ids + + if (field_yaml%has_var_zbounds()) then + call create_new_z_subaxis(field_yaml%get_var_zbounds(), var_axis_ids, diag_axis, naxis, & + this%axis_ids, this%number_of_axis) + endif + select type(this) type is (subRegionalFile_type) if (.not. this%is_subaxis_defined) then @@ -690,15 +703,15 @@ subroutine add_axes(this, axis_ids, diag_axis, naxis) if (this%domain%get_ntiles() .eq. 6) is_cube_sphere = .true. endif - call define_subaxis(diag_axis, axis_ids, naxis, this%get_file_sub_region(), & + call define_subaxis(diag_axis, var_axis_ids, naxis, this%get_file_sub_region(), & is_cube_sphere, this%write_on_this_pe) this%is_subaxis_defined = .true. !> add the axis to the list of axis in the file if (this%write_on_this_pe) then - do i = 1, size(axis_ids) + do i = 1, size(var_axis_ids) this%number_of_axis = this%number_of_axis + 1 !< This is the current number of axis in the file - this%axis_ids(this%number_of_axis) = diag_axis(axis_ids(i))%axis%get_subaxes_id() + this%axis_ids(this%number_of_axis) = diag_axis(var_axis_ids(i))%axis%get_subaxes_id() enddo else this%axis_ids = diag_null @@ -706,11 +719,11 @@ subroutine add_axes(this, axis_ids, diag_axis, naxis) endif return type is (fmsDiagFile_type) - do i = 1, size(axis_ids) + do i = 1, size(var_axis_ids) axis_found = .false. do j = 1, this%number_of_axis !> Check if the axis already exists, move on - if (axis_ids(i) .eq. this%axis_ids(j)) then + if (var_axis_ids(i) .eq. this%axis_ids(j)) then axis_found = .true. cycle endif @@ -719,7 +732,7 @@ subroutine add_axes(this, axis_ids, diag_axis, naxis) if (.not. axis_found) then !> If the axis does not exist add it to the list this%number_of_axis = this%number_of_axis + 1 - this%axis_ids(this%number_of_axis) = axis_ids(i) + this%axis_ids(this%number_of_axis) = var_axis_ids(i) endif enddo end select diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 95bcb93ef7..79e899769e 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -225,7 +225,7 @@ integer function fms_register_diag_field_obj & call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i)) call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain()) call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i)) - call fileptr%add_axes(axes, this%diag_axis, this%registered_axis) + call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i)) call fileptr%add_start_time(init_time) call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static()) enddo @@ -235,7 +235,7 @@ integer function fms_register_diag_field_obj & call fileptr%add_field_and_yaml_id(fieldptr%get_id(), diag_field_indices(i)) call fileptr%init_diurnal_axis(this%diag_axis, this%registered_axis, diag_field_indices(i)) call fileptr%set_file_domain(fieldptr%get_domain(), fieldptr%get_type_of_domain()) - call fileptr%add_axes(axes, this%diag_axis, this%registered_axis) + call fileptr%add_axes(axes, this%diag_axis, this%registered_axis, diag_field_indices(i)) call fileptr%set_file_time_ops (fieldptr%diag_field(i), fieldptr%is_static()) enddo elseif (present(init_time)) then !only inti time present diff --git a/diag_manager/fms_diag_yaml.F90 b/diag_manager/fms_diag_yaml.F90 index fac4fdee60..4305266711 100644 --- a/diag_manager/fms_diag_yaml.F90 +++ b/diag_manager/fms_diag_yaml.F90 @@ -1368,7 +1368,7 @@ end function has_var_units !! @return true if obj%var_zbounds is allocated pure logical function has_var_zbounds (obj) class(diagYamlFilesVar_type), intent(in) :: obj !< diagYamlvar_type object to initialize - has_var_zbounds = any(obj%var_zbounds .eq. diag_null) + has_var_zbounds = any(obj%var_zbounds .ne. diag_null) end function has_var_zbounds !> @brief Checks if obj%var_attributes is allocated !! @return true if obj%var_attributes is allocated diff --git a/test_fms/diag_manager/test_diag_manager2.sh b/test_fms/diag_manager/test_diag_manager2.sh index 7d15ad7b0f..5039e3fe6f 100755 --- a/test_fms/diag_manager/test_diag_manager2.sh +++ b/test_fms/diag_manager/test_diag_manager2.sh @@ -697,6 +697,12 @@ diag_files: var_name: var6 reduction: average kind: r8 + - module: atm_mod + var_name: var4 + output_name: var4_bounded + reduction: average + kind: r8 + zbounds: 2.0 3.0 - file_name: file3 freq: 6 freq_units: hours From 92145cb069988ac37b45a0e695b1a6afd24bf230 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Mon, 6 Feb 2023 16:39:50 -0500 Subject: [PATCH 07/15] Fix line length limit --- diag_manager/fms_diag_file_object.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index 196495010f..a93533c89e 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -41,8 +41,8 @@ module fms_diag_file_object_mod 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, & fmsDiagAxisContainer_type, DIAGDOMAIN2D_T, DIAGDOMAINUG_T, & - fmsDiagFullAxis_type, define_subaxis, define_diurnal_axis, fmsDiagDiurnalAxis_type, & - create_new_z_subaxis + fmsDiagFullAxis_type, define_subaxis, define_diurnal_axis, & + fmsDiagDiurnalAxis_type, create_new_z_subaxis use fms_diag_field_object_mod, only: fmsDiagField_type use mpp_mod, only: mpp_get_current_pelist, mpp_npes, mpp_root_pe, mpp_pe, mpp_error, FATAL, stdout, & uppercase, lowercase From e1c34a94086c1c6acd60d287793d7bd494265f6a Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Mon, 6 Feb 2023 16:59:32 -0500 Subject: [PATCH 08/15] fix so that the correct metadata for a sub z axis gets written --- diag_manager/fms_diag_axis_object.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index ddb0602e51..2ae02ab0b3 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -1213,7 +1213,6 @@ subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_ax integer :: subaxis_indices(2) !< The starting and ending indices of the subaxis relative to the full !! axis integer :: i !< For do loops - integer :: zaxis_id !< The id of the full zaxis integer :: subaxis_id !< The id of the new z subaxis !< Determine if the axis was already created @@ -1229,7 +1228,6 @@ subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_ax select type (parent_axis => diag_axis(var_axis_ids(i))%axis) type is (fmsDiagFullAxis_type) if (parent_axis%cart_name .eq. "Z") then - zaxis_id = i zaxis_data => parent_axis%axis_data select type(zaxis_data) @@ -1242,7 +1240,7 @@ subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_ax subaxis_indices(2) = nearest_index(real(zbounds(2)), real(zaxis_data)) end select - call define_new_axis(diag_axis, parent_axis, naxis, zaxis_id, & + call define_new_axis(diag_axis, parent_axis, naxis, parent_axis%axis_id, & &subaxis_indices(1), subaxis_indices(2), subaxis_id, zbounds) var_axis_ids(i) = subaxis_id return From 0d82f45814ded6f6e996482fb148cfc1a5c5ef32 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Mon, 6 Feb 2023 17:51:37 -0500 Subject: [PATCH 09/15] Fix so that you don't write both the sub z axis and the zaxis --- diag_manager/fms_diag_axis_object.F90 | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index 2ae02ab0b3..2aa4efe1c9 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -1214,12 +1214,18 @@ subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_ax !! axis integer :: i !< For do loops integer :: subaxis_id !< The id of the new z subaxis + logical :: axis_found !< Flag that indicated if the zsubaxis already exists !< Determine if the axis was already created + axis_found = .false. do i = 1, nfile_axis select type (axis => diag_axis(file_axis_id(i))%axis) type is (fmsDiagSubAxis_type) - if (axis%zbounds(1) .eq. zbounds(1) .and. axis%zbounds(2) .eq. zbounds(2)) return + if (axis%zbounds(1) .eq. zbounds(1) .and. axis%zbounds(2) .eq. zbounds(2)) then + axis_found = .true. + subaxis_id = file_axis_id(i) + exit + endif end select enddo @@ -1228,6 +1234,11 @@ subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_ax select type (parent_axis => diag_axis(var_axis_ids(i))%axis) type is (fmsDiagFullAxis_type) if (parent_axis%cart_name .eq. "Z") then + !< If the axis was previously defined set the var_axis_ids and leave + if (axis_found) then + var_axis_ids(i) = subaxis_id + return + endif zaxis_data => parent_axis%axis_data select type(zaxis_data) From 073d98f18a524606e3f20fc7b6c2e114f141dc05 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 7 Feb 2023 16:32:07 -0500 Subject: [PATCH 10/15] Add edges_names when defining the diurnal axis --- diag_manager/fms_diag_axis_object.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index 881eb8a17c..8c6641195b 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -453,6 +453,7 @@ subroutine define_diurnal_axis(diag_axis, naxis, n_diurnal_samples, is_edges) do i = 1, n_diurnal_samples diurnal_data(i) = 24.0*(REAL(i)-0.5)/n_diurnal_samples enddo + WRITE (edges_name,'(a,i2.2)') 'time_of_day_edges_', n_diurnal_samples endif WRITE (units,11) 'hours', get_base_year(), get_base_month(), & From 3ac08c6eca17f8d1c85c55818d7237983fd22427 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 21 Feb 2023 13:56:18 -0500 Subject: [PATCH 11/15] Fix string length and added some more documentation updates --- diag_manager/diag_data.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/diag_manager/diag_data.F90 b/diag_manager/diag_data.F90 index ede6f231af..8fd4b08410 100644 --- a/diag_manager/diag_data.F90 +++ b/diag_manager/diag_data.F90 @@ -398,9 +398,12 @@ MODULE diag_data_mod !! @note `pack_size` and `pack_size_str` are set in diag_manager_init depending on how FMS was compiled !! if FMS was compiled with default reals as 64bit, it will be set to 1 and "double", !! if FMS was compiled with default reals as 32bit, it will set to 2 and "float" + !! The time variables will written in the precision defined by `pack_size_str` !! This is to reproduce previous diag manager behavior. + !TODO This may not be mixed precision friendly INTEGER :: pack_size = 1 !< 1 for double and 2 for float - CHARACTER(len=10) :: pack_size_str="double" !< Pack size as a string to be used in fms2_io register call + CHARACTER(len=6) :: pack_size_str="double" !< Pack size as a string to be used in fms2_io register call + !! set to "double" or "float" ! REAL :: EMPTY = 0.0 From c0fae86d585d02f28a6961ea7d2b72f395c572a6 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 7 Mar 2023 11:05:04 -0500 Subject: [PATCH 12/15] simplify the register_field call --- diag_manager/fms_diag_axis_object.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index 8c6641195b..f3627fe571 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -1163,11 +1163,8 @@ subroutine write_diurnal_metadata(this, fileobj) class(fmsDiagDiurnalAxis_type), intent(in) :: this !< Diurnal axis Object class(FmsNetcdfFile_t), intent(inout) :: fileobj !< Fms2_io fileobj to write the data to - character(len=50) :: dim_name(1) !< Array of dimension names for fms2_io - - dim_name(1) = this%axis_name call register_axis(fileobj, this%axis_name, size(this%diurnal_data)) - call register_field(fileobj, this%axis_name, pack_size_str, dim_name) + call register_field(fileobj, this%axis_name, pack_size_str, (/this%axis_name/)) call register_variable_attribute(fileobj, this%axis_name, "units", & &trim(this%units), str_len=len_trim(this%units)) call register_variable_attribute(fileobj, this%axis_name, "long_name", & From b9c468dbb541711f620e1be0e406e00b83a80f7d Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 7 Mar 2023 11:39:02 -0500 Subject: [PATCH 13/15] gnu compile fix? --- diag_manager/fms_diag_axis_object.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index f3627fe571..f18a9b0900 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -1164,7 +1164,7 @@ subroutine write_diurnal_metadata(this, fileobj) class(FmsNetcdfFile_t), intent(inout) :: fileobj !< Fms2_io fileobj to write the data to call register_axis(fileobj, this%axis_name, size(this%diurnal_data)) - call register_field(fileobj, this%axis_name, pack_size_str, (/this%axis_name/)) + call register_field(fileobj, this%axis_name, pack_size_str, (/trim(this%axis_name)/)) call register_variable_attribute(fileobj, this%axis_name, "units", & &trim(this%units), str_len=len_trim(this%units)) call register_variable_attribute(fileobj, this%axis_name, "long_name", & From cd34f1f1d0dd185e2864c39a88fbd903667c539c Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Wed, 8 Mar 2023 12:13:47 -0500 Subject: [PATCH 14/15] Remove things that Tom is not going to like, add some documentation, plus clean up --- diag_manager/fms_diag_field_object.F90 | 12 +++--------- diag_manager/fms_diag_file_object.F90 | 4 ++++ 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/diag_manager/fms_diag_field_object.F90 b/diag_manager/fms_diag_field_object.F90 index 74ac255fdf..fc6f3eb217 100644 --- a/diag_manager/fms_diag_field_object.F90 +++ b/diag_manager/fms_diag_field_object.F90 @@ -1001,7 +1001,7 @@ pure function get_longname_to_write(this, field_yaml) & end function get_longname_to_write !> @brief Determine the dimension names to use when registering the field to fms2_io -subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is_regional, has_zbounds) +subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is_regional) class (fmsDiagField_type), target, intent(inout) :: this !< diag field class(fmsDiagAxisContainer_type), target, intent(in) :: diag_axis(:) !< Diag_axis object type(diagYamlFilesVar_type), intent(in) :: field_yaml !< Field info from diag_table yaml @@ -1009,8 +1009,6 @@ subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is character(len=120), allocatable, intent(out) :: dimnames(:) !< Array of the dimension names !! for the field logical, intent(in) :: is_regional !< Flag indicating if the field is regional - logical, intent(in) :: has_zbounds !< Flag indicating if this variable has a - !! sub_zaxis integer :: i !< For do loops integer :: naxis !< Number of axis for the field @@ -1029,7 +1027,7 @@ subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is allocate(dimnames(naxis)) !< Duplicated do loops for #performance - if (has_zbounds) then + if (field_yaml%has_var_zbounds()) then do i = 1, size(this%axis_ids) axis_ptr => diag_axis(this%axis_ids(i)) if (axis_ptr%axis%is_z_axis()) then @@ -1044,10 +1042,6 @@ subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is dimnames(i) = axis_ptr%axis%get_axis_name(is_regional) enddo endif - !< The second to last dimension is always the diurnal axis - if (field_yaml%has_n_diurnal()) then - dimnames(naxis - 1) = 'time_of_day_'//int2str(field_yaml%get_n_diurnal()) - endif !< The second to last dimension is always the diurnal axis if (field_yaml%has_n_diurnal()) then @@ -1099,7 +1093,7 @@ subroutine write_field_metadata(this, fileobj, file_id, yaml_id, diag_axis, unli var_name = field_yaml%get_var_outname() if (allocated(this%axis_ids)) then - call this%get_dimnames(diag_axis, field_yaml, unlim_dimname, dimnames, is_regional, field_yaml%has_var_zbounds()) + call this%get_dimnames(diag_axis, field_yaml, unlim_dimname, dimnames, is_regional) call register_field_wrap(fileobj, var_name, this%get_var_skind(field_yaml), dimnames) else call register_field_wrap(fileobj, var_name, this%get_var_skind(field_yaml)) diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index a93533c89e..fd2985ffb8 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -689,6 +689,10 @@ subroutine add_axes(this, axis_ids, diag_axis, naxis, yaml_id) is_cube_sphere = .false. field_yaml => diag_yaml%get_diag_field_from_id(yaml_id) + !< Created a copy here, because if the variable has a z subaxis var_axis_ids will be modified in + !! `create_new_z_subaxis` to contain the id of the new z subaxis instead of the parent axis, + !! which will be added to the the list of axis in the file object (axis_ids is intent(in), + !! which is why the copy was needed) var_axis_ids = axis_ids if (field_yaml%has_var_zbounds()) then From 0c4fe97b64b578463ddc567a8d69c7fc30b7e8b5 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Thu, 9 Mar 2023 14:12:39 -0500 Subject: [PATCH 15/15] Remove a # to prevent possible issues --- diag_manager/fms_diag_field_object.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/diag_manager/fms_diag_field_object.F90 b/diag_manager/fms_diag_field_object.F90 index fc6f3eb217..f82ca0d842 100644 --- a/diag_manager/fms_diag_field_object.F90 +++ b/diag_manager/fms_diag_field_object.F90 @@ -1026,7 +1026,7 @@ subroutine get_dimnames(this, diag_axis, field_yaml, unlim_dimname, dimnames, is allocate(dimnames(naxis)) - !< Duplicated do loops for #performance + !< Duplicated do loops for performance if (field_yaml%has_var_zbounds()) then do i = 1, size(this%axis_ids) axis_ptr => diag_axis(this%axis_ids(i))