From 07ff0679281f4d99423483f33eb7fc4240f5dc88 Mon Sep 17 00:00:00 2001 From: uramirez8707 <49168881+uramirez8707@users.noreply.github.com> Date: Thu, 24 Aug 2023 14:26:30 -0400 Subject: [PATCH] Implement time_none (#1347) * Add tests and checks --- diag_manager/Makefile.am | 17 +- diag_manager/diag_manager.F90 | 63 ++++- diag_manager/fms_diag_axis_object.F90 | 139 +++++++---- diag_manager/fms_diag_bbox.F90 | 207 +++++++++++++++- diag_manager/fms_diag_object.F90 | 227 +++++++++++++++--- diag_manager/fms_diag_output_buffer.F90 | 35 +++ diag_manager/fms_diag_reduction_methods.F90 | 20 +- .../include/fms_diag_reduction_methods.inc | 53 ++++ .../include/fms_diag_reduction_methods_r4.fh | 35 +++ .../include/fms_diag_reduction_methods_r8.fh | 35 +++ test_fms/diag_manager/check_time_max.F90 | 2 + test_fms/diag_manager/check_time_min.F90 | 2 + test_fms/diag_manager/check_time_none.F90 | 12 +- test_fms/diag_manager/test_time_none.sh | 91 ++++--- 14 files changed, 790 insertions(+), 148 deletions(-) create mode 100644 diag_manager/include/fms_diag_reduction_methods.inc create mode 100644 diag_manager/include/fms_diag_reduction_methods_r4.fh create mode 100644 diag_manager/include/fms_diag_reduction_methods_r8.fh diff --git a/diag_manager/Makefile.am b/diag_manager/Makefile.am index acf839f025..4a482b1d49 100644 --- a/diag_manager/Makefile.am +++ b/diag_manager/Makefile.am @@ -54,7 +54,10 @@ libdiag_manager_la_SOURCES = \ fms_diag_bbox.F90 \ fms_diag_reduction_methods.F90 \ include/fms_diag_fieldbuff_update.inc \ - include/fms_diag_fieldbuff_update.fh + include/fms_diag_fieldbuff_update.fh \ + include/fms_diag_reduction_methods.inc \ + include/fms_diag_reduction_methods_r4.fh \ + include/fms_diag_reduction_methods_r8.fh # Some mods are dependant on other mods in this dir. diag_data_mod.$(FC_MODEXT): fms_diag_bbox_mod.$(FC_MODEXT) @@ -68,7 +71,8 @@ fms_diag_yaml_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_file_object_mod.$(FC_MODEXT) fms_diag_field_object_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) \ fms_diag_time_utils_mod.$(FC_MODEXT) \ fms_diag_output_buffer_mod.$(FC_MODEXT) \ - fms_diag_reduction_methods_mod.$(FC_MODEXT) + fms_diag_reduction_methods_mod.$(FC_MODEXT) \ + fms_diag_bbox_mod.$(FC_MODEXT) fms_diag_field_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT) \ fms_diag_axis_object_mod.$(FC_MODEXT) fms_diag_file_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) fms_diag_field_object_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT) \ @@ -76,7 +80,7 @@ fms_diag_file_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_ fms_diag_object_container_mod.$(FC_MODEXT): fms_diag_object_mod.$(FC_MODEXT) fms_diag_dlinked_list_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT) fms_diag_axis_object_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_time_utils_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) \ diag_grid_mod.$(FC_MODEXT) -fms_diag_time_reduction_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) +fms_diag_time_reduction_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_bbox_mod.$(FC_MODEXT) fms_diag_elem_weight_procs_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_outfield_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_elem_weight_procs_mod.$(FC_MODEXT) fms_diag_fieldbuff_update_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) diag_util_mod.$(FC_MODEXT) \ @@ -89,7 +93,8 @@ diag_manager_mod.$(FC_MODEXT): diag_axis_mod.$(FC_MODEXT) diag_data_mod.$(FC_MOD fms_diag_object_container_mod.$(FC_MODEXT) fms_diag_axis_object_mod.$(FC_MODEXT) \ fms_diag_time_reduction_mod.$(FC_MODEXT) fms_diag_outfield_mod.$(FC_MODEXT) \ fms_diag_fieldbuff_update_mod.$(FC_MODEXT) -fms_diag_output_buffer_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) +fms_diag_output_buffer_mod.$(FC_MODEXT): diag_data_mod.$(FC_MODEXT) fms_diag_yaml_mod.$(FC_MODEXT) \ + fms_diag_reduction_methods_mod.$(FC_MODEXT) fms_diag_reduction_methods_mod.$(FC_MODEXT): fms_diag_bbox_mod.$(FC_MODEXT) fms_diag_output_buffer_mod.$(FC_MODEXT) \ diag_data_mod.$(FC_MODEXT) @@ -118,7 +123,9 @@ MODFILES = \ fms_diag_fieldbuff_update_mod.$(FC_MODEXT) \ fms_diag_reduction_methods_mod.$(FC_MODEXT) \ include/fms_diag_fieldbuff_update.inc \ - include/fms_diag_fieldbuff_update.fh + include/fms_diag_fieldbuff_update.fh \ + include/fms_diag_reduction_methods_r4.fh \ + include/fms_diag_reduction_methods_r8.fh nodist_include_HEADERS = $(MODFILES) BUILT_SOURCES = $(MODFILES) diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index c153b564ef..18972883ef 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -1676,9 +1676,9 @@ LOGICAL FUNCTION diag_send_data(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_remap !< 4d remapped pointer - logical, pointer, dimension(:,:,:,:) :: mask_remap !< 4d remapped pointer - class(*), pointer, dimension(:,:,:,:) :: rmask_remap !< 4d remapped pointer + class(*), allocatable, dimension(:,:,:,:) :: field_remap !< 4d remapped array + logical, allocatable, dimension(:,:,:,:) :: mask_remap !< 4d remapped array + class(*), allocatable, dimension(:,:,:,:) :: rmask_remap !< 4d remapped array REAL(kind=r4_kind), POINTER, DIMENSION(:,:,:) :: rmask_ptr_r4 !< A pointer to r4 type of rmask REAL(kind=r8_kind), POINTER, DIMENSION(:,:,:) :: rmask_ptr_r8 ! Set up array lengths for remapping - field_remap => null() - mask_remap => null() - rmask_remap => null() - ie = SIZE(field,1) - je = SIZE(field,2) - ke = SIZE(field,3) - field_remap(1:ie,1:je,1:ke,1:1) => field - if (present(mask)) mask_remap(1:ie,1:je,1:ke,1:1) => mask - if (present(rmask)) rmask_remap(1:ie,1:je,1:ke,1:1) => rmask + + endif SELECT TYPE (field) TYPE IS (real(kind=r4_kind)) @@ -1741,10 +1735,19 @@ LOGICAL FUNCTION diag_send_data(diag_field_id, field, time, is_in, js_in, ks_in, END SELECT ! Split old and modern2023 here modern_if: iF (use_modern_diag) then + field_name = fms_diag_object%fms_get_field_name_from_id(diag_field_id) + field_remap = copy_3d_to_4d(field, trim(field_name)//"'s data") + if (present(rmask)) rmask_remap = copy_3d_to_4d(rmask, trim(field_name)//"'s mask") + if (present(mask)) then + allocate(mask_remap(1:size(mask,1), 1:size(mask,2), 1:size(mask,3), 1)) + mask_remap(:,:,:,1) = mask + endif diag_send_data = fms_diag_object%fms_diag_accept_data(diag_field_id, field_remap, mask_remap, rmask_remap, & time, is_in, js_in, ks_in, ie_in, je_in, ke_in, weight, & err_msg) - nullify (field_remap) + deallocate (field_remap) + if (allocated(mask_remap)) deallocate(mask_remap) + if (allocated(rmask_remap)) deallocate(rmask_remap) 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) @@ -4480,6 +4483,40 @@ SUBROUTINE diag_field_add_cell_measures(diag_field_id, area, volume) END IF END SUBROUTINE diag_field_add_cell_measures + !> @brief Copies a 3d buffer to a 4d buffer + !> @return a 4d buffer + function copy_3d_to_4d(data_in, field_name) & + result(data_out) + class (*), intent(in) :: data_in(:,:,:) !< Data to copy + character(len=*), intent(in) :: field_name !< Name of the field copying (for error messages) + class (*), allocatable :: data_out(:,:,:,:) + + !TODO this should be extended to integers + select type(data_in) + type is (real(kind=r8_kind)) + allocate(real(kind=r8_kind) :: data_out(1:size(data_in,1), 1:size(data_in,2), 1:size(data_in,3), 1)) + select type (data_out) + type is (real(kind=r8_kind)) + data_out(:,:,:,1) = data_in + class default + call mpp_error(FATAL, "The copy of "//trim(field_name)//& + " was not allocated to the correct type (r8_kind). This shouldn't have happened") + end select + type is (real(kind=r4_kind)) + allocate(real(kind=r4_kind) :: data_out(1:size(data_in,1), 1:size(data_in,2), 1:size(data_in,3), 1)) + select type (data_out) + type is (real(kind=r4_kind)) + data_out(:,:,:,1) = data_in + class default + call mpp_error(FATAL, "The copy of "//trim(field_name)//& + " was not allocated to the correct type (r4_kind). This shouldn't have happened") + end select + class default + call mpp_error(FATAL, "The data for "//trim(field_name)//& + &" is not a valid type. Currently only r4 and r8 are supported") + end select + end function copy_3d_to_4d + END MODULE diag_manager_mod !> @} ! close documentation grouping diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index 14a54387bc..8f22f7d2db 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -115,12 +115,14 @@ module fms_diag_axis_object_mod INTEGER , private :: ending_index !< Ending index of the subaxis relative to the !! parent axis INTEGER , private :: parent_axis_id !< Id of the parent_axis + INTEGER , private :: compute_idx(2) !< Starting and ending index of the compute domain real(kind=r4_kind), allocatable, private :: zbounds(:) !< Bounds of the Z axis contains procedure :: fill_subaxis procedure :: axis_length procedure :: get_starting_index procedure :: get_ending_index + procedure :: get_compute_indices END TYPE fmsDiagSubAxis_type !> @brief Type to hold the diurnal axis @@ -665,7 +667,7 @@ subroutine get_indices(this, compute_idx, corners_indices, starting_index, endin ending_index = diag_null !< If the compute domain of the current PE is outisde of the range of sub_axis, return - if (compute_idx(1) > subregion_start .and. compute_idx(2) > subregion_start) return + if (compute_idx(1) < subregion_start .and. compute_idx(2) < subregion_start) return if (compute_idx(1) > subregion_end .and. compute_idx(2) > subregion_end) return need_to_define_axis = .true. @@ -738,13 +740,16 @@ 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, zbounds) + subroutine fill_subaxis(this, starting_index, ending_index, axis_id, parent_id, parent_axis_name, compute_idx, & + 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 + 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 + integer , intent(in) :: compute_idx(2) !< Starting and ending index of + !! the axis's compute domain real(kind=r4_kind), optional, intent(in) :: zbounds(2) !< Bounds of the z-axis this%axis_id = axis_id @@ -752,6 +757,7 @@ subroutine fill_subaxis(this, starting_index, ending_index, axis_id, parent_id, this%ending_index = ending_index this%parent_axis_id = parent_id this%subaxis_name = trim(parent_axis_name)//"_sub01" + this%compute_idx = compute_idx if (present(zbounds)) then allocate(this%zbounds(2)) @@ -785,6 +791,14 @@ function get_ending_index(this) result(indx) indx = this%ending_index end function get_ending_index + !> @brief Accesses its member compute_indices + !! @return a copy of the ending_index + function get_compute_indices(this) result(indx) + class(fmsDiagSubAxis_type), intent(in) :: this !< diag_sub_axis object + integer :: indx(2) !< Result to return + indx = this%compute_idx + end function get_compute_indices + !> @brief Get the ntiles in a domain !> @return the number of tiles in a domain function get_ntiles(this) & @@ -1022,8 +1036,9 @@ 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 + compute_idx = diag_null call define_new_axis(diag_axis, parent_axis, naxis, axis_ids(i), & - diag_null, diag_null) + diag_null, diag_null, compute_idx) cycle endif @@ -1031,7 +1046,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), & - starting_index, ending_index) + starting_index, ending_index, compute_idx) end select enddo @@ -1047,15 +1062,19 @@ subroutine define_subaxis_latlon(diag_axis, axis_ids, naxis, subRegion, is_cube_ logical, intent(out) :: write_on_this_pe !< .true. if the subregion !! is on this PE - real :: lat(2) !< Starting and ending lattiude of the subRegion - real :: lon(2) !< Starting and ending longitude or the subRegion - integer :: lat_indices(2) !< Starting and ending latitude indices of the subRegion - integer :: lon_indices(2) !< Starting and ending longitude indices of the subRegion - integer :: compute_idx(2) !< Compute domain of the current axis - integer :: starting_index !< Starting index of the subRegion for the current PE - integer :: ending_index !< Ending index of the subRegion for the current PE - logical :: need_to_define_axis !< .true. if it is needed to define the subaxis - integer :: i !< For do loops + real :: lat(2) !< Starting and ending lattiude of the subRegion + real :: lon(2) !< Starting and ending longitude or the subRegion + integer :: lat_indices(2) !< Starting and ending latitude indices of the subRegion + integer :: lon_indices(2) !< Starting and ending longitude indices of the subRegion + integer :: compute_idx(2) !< Compute domain of the current axis + integer :: starting_index(2) !< Starting index of the subRegion for the current PE for the "x" and "y" + !! direction + integer :: ending_index(2) !< Ending index of the subRegion for the current PE for the "x" and "y" direction + logical :: need_to_define_axis(2) !< .true. if it is needed to define the subaxis for the "x" and "y" direction + integer :: i !< For do loops + integer :: parent_axis_ids(2) !< The axis id of the parent axis for the "x" and "y" direction + logical :: is_x_y_axis !< .true. if the axis is x or y + integer :: compute_idx_2(2, 2) !< Starting and ending indices of the compute domain for the "x" and "y" direction !< Get the rectangular coordinates of the subRegion !! If the subRegion is not rectangular, the points outside of the subRegion will be masked @@ -1076,29 +1095,24 @@ subroutine define_subaxis_latlon(diag_axis, axis_ids, naxis, subRegion, is_cube_ select_axis_type: select type (parent_axis => diag_axis(axis_ids(i))%axis) type is (fmsDiagFullAxis_type) !< Get the PEs compute domain - call parent_axis%get_compute_domain(compute_idx, need_to_define_axis) + call parent_axis%get_compute_domain(compute_idx, is_x_y_axis) !< If this is not a "X" or "Y" axis go to the next axis - if (.not. need_to_define_axis) cycle + if (.not. is_x_y_axis) cycle !< Determine if the PE's compute domain is inside the subRegion !! If it is get the starting and ending indices for that PE if (parent_axis%cart_name .eq. "X") then - call parent_axis%get_indices(compute_idx, lon_indices, starting_index, ending_index, & - need_to_define_axis) + call parent_axis%get_indices(compute_idx, lon_indices, starting_index(1), ending_index(1), & + need_to_define_axis(1)) + parent_axis_ids(1) = axis_ids(i) + compute_idx_2(1,:) = compute_idx else if (parent_axis%cart_name .eq. "Y") then - call parent_axis%get_indices(compute_idx, lat_indices, starting_index, ending_index, & - need_to_define_axis) + call parent_axis%get_indices(compute_idx, lat_indices, starting_index(2), ending_index(2), & + need_to_define_axis(2)) + parent_axis_ids(2) = axis_ids(i) + compute_idx_2(2,:) = compute_idx endif - - !< If the PE's compute is not inside the subRegion move to the next axis - if (.not. need_to_define_axis) cycle - - !< If it made it to this point, the current PE is in the subRegion! - write_on_this_pe = .true. - - call define_new_axis(diag_axis, parent_axis, naxis, axis_ids(i), & - starting_index, ending_index) end select select_axis_type enddo loop_over_axis_ids else if_is_cube_sphere @@ -1106,46 +1120,62 @@ subroutine define_subaxis_latlon(diag_axis, axis_ids, naxis, subRegion, is_cube_ select type (parent_axis => diag_axis(axis_ids(i))%axis) type is (fmsDiagFullAxis_type) !< Get the PEs compute domain - call parent_axis%get_compute_domain(compute_idx, need_to_define_axis) + call parent_axis%get_compute_domain(compute_idx, is_x_y_axis) !< If this is not a "X" or "Y" axis go to the next axis - if (.not. need_to_define_axis) cycle + if (.not. is_x_y_axis) cycle !< Get the starting and ending indices of the subregion relative to the global grid if (parent_axis%cart_name .eq. "X") then select type(adata=>parent_axis%axis_data) - type is (real) - lon_indices(1) = nearest_index(lon(1), adata) - lon_indices(2) = nearest_index(lon(2), adata) + 1 + type is (real(kind=r8_kind)) + lon_indices(1) = nearest_index(real(lon(1), kind=r8_kind), adata) + lon_indices(2) = nearest_index(real(lon(2), kind=r8_kind), adata) + 1 + type is (real(kind=r4_kind)) + lon_indices(1) = nearest_index(real(lon(1), kind=r4_kind), adata) + lon_indices(2) = nearest_index(real(lon(2), kind=r4_kind), adata) + 1 end select - call parent_axis%get_indices(compute_idx, lon_indices, starting_index, ending_index, & - need_to_define_axis) + call parent_axis%get_indices(compute_idx, lon_indices, starting_index(1), ending_index(1), & + need_to_define_axis(1)) + parent_axis_ids(1) = axis_ids(i) + compute_idx_2(1,:) = compute_idx else if (parent_axis%cart_name .eq. "Y") then select type(adata=>parent_axis%axis_data) - type is (real) - lat_indices(1) = nearest_index(lat(1), adata) - lat_indices(2) = nearest_index(lat(2), adata) + 1 + type is (real(kind=r8_kind)) + lat_indices(1) = nearest_index(real(lat(1), kind=r8_kind), adata) + lat_indices(2) = nearest_index(real(lat(2), kind=r8_kind), adata) + 1 + type is (real(kind=r4_kind)) + lat_indices(1) = nearest_index(real(lat(1), kind=r4_kind), adata) + lat_indices(2) = nearest_index(real(lat(2), kind=r4_kind), adata) + 1 end select - call parent_axis%get_indices(compute_idx, lat_indices, starting_index, ending_index, & - need_to_define_axis) + call parent_axis%get_indices(compute_idx, lat_indices, starting_index(2), ending_index(2), & + need_to_define_axis(2)) + parent_axis_ids(2) = axis_ids(i) + compute_idx_2(2,:) = compute_idx endif - - !< If the PE's compute is not inside the subRegion move to the next axis - if (.not. need_to_define_axis) cycle - - !< If it made it to this point, the current PE is in the subRegion! - write_on_this_pe = .true. - - call define_new_axis(diag_axis, parent_axis, naxis, axis_ids(i), & - starting_index, ending_index) end select enddo loop_over_axis_ids2 endif if_is_cube_sphere + + !< If the PE's compute is not inside the subRegion move to the next axis + if (any(.not. need_to_define_axis )) return + + !< If it made it to this point, the current PE is in the subRegion! + write_on_this_pe = .true. + + do i = 1, size(parent_axis_ids) + select type (parent_axis => diag_axis(parent_axis_ids(i))%axis) + type is (fmsDiagFullAxis_type) + call define_new_axis(diag_axis, parent_axis, naxis, parent_axis_ids(i), & + starting_index(i), ending_index(i), compute_idx_2(i,:)) + end select + enddo + end subroutine define_subaxis_latlon !> @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) + starting_index, ending_index, compute_idx, 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 @@ -1154,6 +1184,8 @@ subroutine define_new_axis(diag_axis, parent_axis, naxis, parent_id, & integer, intent(in) :: parent_id !< Id of the parent axis integer, intent(in) :: starting_index !< PE's Starting index integer, intent(in) :: ending_index !< PE's Ending index + integer, intent(in) :: compute_idx(2) !< Starting and ending index of + !! the axis's compute domain 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 @@ -1171,7 +1203,7 @@ subroutine define_new_axis(diag_axis, parent_axis, naxis, parent_id, & 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, zbounds) + parent_axis%axis_name, compute_idx, zbounds) end select end subroutine define_new_axis @@ -1333,7 +1365,8 @@ subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_ax end select call define_new_axis(diag_axis, parent_axis, naxis, parent_axis%axis_id, & - &subaxis_indices(1), subaxis_indices(2), subaxis_id, zbounds) + &subaxis_indices(1), subaxis_indices(2), (/lbound(zaxis_data,1), ubound(zaxis_data,1)/), & + &subaxis_id, zbounds) var_axis_ids(i) = subaxis_id return endif diff --git a/diag_manager/fms_diag_bbox.F90 b/diag_manager/fms_diag_bbox.F90 index 956dabd31c..fb05d2b998 100644 --- a/diag_manager/fms_diag_bbox.F90 +++ b/diag_manager/fms_diag_bbox.F90 @@ -30,7 +30,7 @@ !> @{ MODULE fms_diag_bbox_mod - USE fms_mod, ONLY: error_mesg, FATAL, fms_error_handler + USE fms_mod, ONLY: error_mesg, FATAL, fms_error_handler, string implicit none @@ -39,24 +39,30 @@ MODULE fms_diag_bbox_mod !! array index bounds of the spatial component a diag_manager field output !! buffer array. TYPE, public :: fmsDiagIbounds_type - PRIVATE INTEGER :: imin !< Lower i bound. INTEGER :: imax !< Upper i bound. INTEGER :: jmin !< Lower j bound. INTEGER :: jmax !< Upper j bound. INTEGER :: kmin !< Lower k bound. INTEGER :: kmax !< Upper k bound. + logical :: has_halos !< .True. if the buffer has halos + integer :: nhalo_I !< Number of halos in i + integer :: nhalo_J !< Number of halos in j contains procedure :: reset => reset_bounds procedure :: reset_bounds_from_array_4D procedure :: reset_bounds_from_array_5D procedure :: update_bounds + procedure :: set_bounds + procedure :: rebase_input + procedure :: rebase_output procedure :: get_imin procedure :: get_imax procedure :: get_jmin procedure :: get_jmax procedure :: get_kmin procedure :: get_kmax + procedure :: update_index END TYPE fmsDiagIbounds_type !> @brief Data structure holding starting and ending indices in the I, J, and @@ -81,10 +87,52 @@ MODULE fms_diag_bbox_mod procedure :: get_fje end type fmsDiagBoundsHalos_type - public :: recondition_indices + public :: recondition_indices, determine_if_block_is_in_region + + integer, parameter :: xdimension = 1 !< Parameter defining the x dimension + integer, parameter :: ydimension = 2 !< Parameter defining the y dimension + integer, parameter :: zdimension = 3 !< Parameter defininf the z dimension CONTAINS +!> @brief The PEs grid points are divided further into "blocks". This function determines if a block +! has data for a given subregion and dimension +!! @return .true. if the a subergion is inside a block +logical pure function determine_if_block_is_in_region(subregion_start, subregion_end, bounds, dim) + integer, intent(in) :: subregion_start !< Begining of the subregion + integer, intent(in) :: subregion_end !< Ending of the subregion + type(fmsDiagIbounds_type), intent(in) :: bounds !< Starting and ending of the subregion + integer, intent(in) :: dim !< Dimension to check + + integer :: block_start !< Begining index of the block + integer :: block_end !< Ending index of the block + + determine_if_block_is_in_region = .true. + select case (dim) + case (xdimension) + block_start = bounds%imin + block_end = bounds%imax + case (ydimension) + block_start = bounds%jmin + block_end = bounds%jmax + case (zdimension) + block_start = bounds%kmin + block_end = bounds%kmax + end select + + if (block_start < subregion_start .and. block_end < subregion_start) then + determine_if_block_is_in_region = .false. + return + endif + + if (block_start > subregion_end .and. block_end > subregion_end) then + determine_if_block_is_in_region = .false. + return + endif + + determine_if_block_is_in_region = .true. +end function determine_if_block_is_in_region + !> @brief Gets imin of fmsDiagIbounds_type !! @return copy of integer member imin pure integer function get_imin (this) result(rslt) @@ -128,6 +176,41 @@ pure integer function get_kmax (this) result(rslt) rslt = this%kmax end function get_kmax + !> @brief Updates the starting and ending index of a given dimension + subroutine update_index(this, starting_index, ending_index, dim, ignore_halos) + class (fmsDiagIbounds_type), intent(inout) :: this !< The bounding box to update + integer, intent(in) :: starting_index !< Starting index to update to + integer, intent(in) :: ending_index !< Ending index to update to + integer, intent(in) :: dim !< Dimension to update + logical, intent(in) :: ignore_halos !< If .true. halos will be ignored + !! i.e output buffers can ignore halos as + !! they do not get updates. The indices of the + !! Input buffers need to add the number of halos + !! so math is done only on the compute domain + + integer :: nhalox !< Number of halos in x + integer :: nhaloy !< Number of halos in y + + if (ignore_halos) then + nhalox = 0 + nhaloy = 0 + else + nhalox= this%nhalo_I + nhaloy= this%nhalo_J + endif + select case(dim) + case (xdimension) + this%imin = starting_index + nhalox + this%imax = ending_index + nhalox + case (ydimension) + this%jmin = starting_index + nhaloy + this%jmax = ending_index + nhaloy + case (zdimension) + this%kmin = starting_index + this%kmax = ending_index + end select + end subroutine + !> @brief Gets the halo size of fmsDiagBoundsHalos_type in the I dimension !! @return copy of integer member hi pure integer function get_hi (this) result(rslt) @@ -202,11 +285,68 @@ SUBROUTINE update_bounds(this, lower_i, upper_i, lower_j, upper_j, lower_k, uppe this%kmax = MAX(this%kmax, upper_k) END SUBROUTINE update_bounds + !> @brief Sets the bounds of a bounding region + !! @return empty string if sucessful or error message if unsucessful + function set_bounds(this, field_data, lower_i, upper_i, lower_j, upper_j, lower_k, upper_k, has_halos) & + result(error_msg) + CLASS (fmsDiagIbounds_type), intent(inout) :: this !< The bounding box of the field + class(*), intent(in) :: field_data(:,:,:,:) !< Field data + INTEGER, INTENT(in) :: lower_i !< Lower i bound. + INTEGER, INTENT(in) :: upper_i !< Upper i bound. + INTEGER, INTENT(in) :: lower_j !< Lower j bound. + INTEGER, INTENT(in) :: upper_j !< Upper j bound. + INTEGER, INTENT(in) :: lower_k !< Lower k bound. + INTEGER, INTENT(in) :: upper_k !< Upper k bound. + LOGICAL, INTENT(in) :: has_halos !< .true. if the field has halos + + character(len=150) :: error_msg !< Error message to output + + integer :: nhalos_2 !< 2 times the number of halo points + integer :: nhalox !< Number of halos in x + integer :: nhaloy !< Number of halos in y + + error_msg = "" + this%kmin = lower_k + this%kmax = upper_k + this%has_halos = has_halos + this%nhalo_I = 0 + this%nhalo_J = 0 + if (has_halos) then + !upper_i-lower_i+1 is the size of the compute domain + !ubound(field_data,1) is the size of the data domain + nhalos_2 = ubound(field_data,1)-(upper_i-lower_i+1) + if (mod(nhalos_2, 2) .ne. 0) then + error_msg = "There are non-symmetric halos in the first dimension" + return + endif + nhalox = nhalos_2/2 + this%nhalo_I = nhalox + + nhalos_2 = ubound(field_data,2)-(upper_j-lower_j + 1) + if (mod(nhalos_2, 2) .ne. 0) then + error_msg = "There are non-symmetric halos in the second dimension" + return + endif + nhaloy = nhalos_2/2 + this%nhalo_J = nhaloy + + this%imin = 1 + nhalox + this%imax = ubound(field_data,1) - nhalox + this%jmin = 1 + nhaloy + this%jmax = ubound(field_data,2) - nhaloy + else + this%imin = lower_i + this%imax = upper_i + this%jmin = lower_j + this%jmax = upper_j + endif + + end function set_bounds !> @brief Reset the instance bounding box with the bounds determined from the !! first three dimensions of the 5D "array" argument SUBROUTINE reset_bounds_from_array_4D(this, array) CLASS (fmsDiagIbounds_type), INTENT(inout) :: this !< The instance of the bounding box. - REAL, INTENT( in), DIMENSION(:,:,:,:) :: array !< The 4D input array. + class(*), INTENT( in), DIMENSION(:,:,:,:) :: array !< The 4D input array. this%imin = LBOUND(array,1) this%imax = UBOUND(array,1) this%jmin = LBOUND(array,2) @@ -319,6 +459,65 @@ function recondition_indices(indices, field, is_in, js_in, ks_in, & indices%fje = fje end function recondition_indices + !> @brief Rebase the ouput bounds for a given dimension based on the starting and ending indices of + !! a subregion. This is for when blocking is used. + subroutine rebase_output(bounds_out, starting, ending, dim) + CLASS (fmsDiagIbounds_type), INTENT(inout) :: bounds_out !< Bounds to rebase + integer, intent(in) :: starting !< Starting index of the dimension + integer, intent(in) :: ending !< Ending index of the dimension + integer, intent(in) :: dim !< Dimension to update + + !> The starting index is going to be either "starting" if only a section of the + !! block is in the subregion or bounds_out%[]min if the whole section of the block is in the + !! subregion. The -starting+1 s needed so that indices start as 1 since the output buffer has + !! indices 1:size of a subregion + + !> The ending index is going to be either bounds_out%[]max if the whole section of the block + !! is in the subregion or bounds_out%[]min + size of the subregion if only a section of the + !! block is in the susbregion + select case (dim) + case (xdimension) + bounds_out%imin = max(starting, bounds_out%imin)-starting+1 + bounds_out%imax = min(bounds_out%imax, bounds_out%imin + ending-starting) + case (ydimension) + bounds_out%jmin = max(starting, bounds_out%jmin)-starting+1 + bounds_out%jmax = min(bounds_out%jmax, bounds_out%jmin + ending-starting) + case (zdimension) + bounds_out%kmin =max(starting, bounds_out%kmin)-starting+1 + bounds_out%kmax = min(bounds_out%kmax, bounds_out%kmin + ending-starting) + end select + end subroutine + + !> @brief Rebase the input bounds for a given dimension based on the starting and ending indices + !! of a subregion. This is for when blocking is used + subroutine rebase_input(bounds_in, bounds, starting, ending, dim) + CLASS (fmsDiagIbounds_type), INTENT(inout) :: bounds_in !< Bounds to rebase + CLASS (fmsDiagIbounds_type), INTENT(in) :: bounds !< Original indices (i.e is_in, ie_in, + !! passed into diag_manager) + integer, intent(in) :: starting !< Starting index of the dimension + integer, intent(in) :: ending !< Ending index of the dimension + integer, intent(in) :: dim !< Dimension to update + + !> The starting index is going to be either "starting" if only a section of the + !! block is in the subregion or starting-bounds%imin+1 if the whole section of the block is in the + !! subregion. + + !> The ending index is going to be either bounds_out%[]max if the whole section of the block + !! is in the subregion or bounds%[]min + size of the subregion if only a section of the + !! block is in the susbregion + select case (dim) + case (xdimension) + bounds_in%imin = min(abs(starting-bounds%imin+1), starting) + bounds_in%imax = min(bounds_in%imax, (bounds_in%imin + ending-starting)) + case (ydimension) + bounds_in%jmin = min(abs(starting-bounds%jmin+1), starting) + bounds_in%jmax = min(bounds_in%jmax, (bounds_in%jmin + ending-starting)) + case (zdimension) + bounds_in%kmin = min(abs(starting-bounds%kmin+1), starting) + bounds_in%kmax = min(bounds_in%kmax, (bounds_in%kmin + ending-starting)) + end select + end subroutine + END MODULE fms_diag_bbox_mod !> @} ! close documentation grouping diff --git a/diag_manager/fms_diag_object.F90 b/diag_manager/fms_diag_object.F90 index 789b6e55e6..907f0c6613 100644 --- a/diag_manager/fms_diag_object.F90 +++ b/diag_manager/fms_diag_object.F90 @@ -20,7 +20,9 @@ module fms_diag_object_mod use mpp_mod, only: fatal, note, warning, mpp_error, mpp_pe, mpp_root_pe, stdout use diag_data_mod, only: diag_null, diag_not_found, diag_not_registered, diag_registered_id, & &DIAG_FIELD_NOT_FOUND, diag_not_registered, max_axes, TWO_D_DOMAIN, & - &get_base_time, NULL_AXIS_ID, get_var_type, diag_not_registered + &get_base_time, NULL_AXIS_ID, get_var_type, diag_not_registered, & + &time_none, time_max, time_min, time_sum, time_average, time_diurnal, & + &time_power, time_rms USE time_manager_mod, ONLY: set_time, set_date, get_time, time_type, OPERATOR(>=), OPERATOR(>),& & OPERATOR(<), OPERATOR(==), OPERATOR(/=), OPERATOR(/), OPERATOR(+), ASSIGNMENT(=), get_date, & @@ -39,6 +41,7 @@ module fms_diag_object_mod use fms_diag_reduction_methods_mod, only: check_indices_order, init_mask, set_weight use constants_mod, only: SECONDS_PER_DAY #endif +USE fms_diag_bbox_mod, ONLY: fmsDiagIbounds_type, determine_if_block_is_in_region #if defined(_OPENMP) use omp_lib #endif @@ -80,6 +83,7 @@ module fms_diag_object_mod procedure :: fms_get_domain2d procedure :: fms_get_axis_length procedure :: fms_get_diag_field_id_from_name + procedure :: fms_get_field_name_from_id procedure :: fms_get_axis_name_from_id procedure :: fms_diag_accept_data procedure :: fms_diag_send_complete @@ -492,9 +496,9 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm class(fmsDiagObject_type),TARGET, INTENT(inout) :: this !< Diaj_obj to fill INTEGER, INTENT(in) :: diag_field_id !< The ID of the diag field CLASS(*), DIMENSION(:,:,:,:), INTENT(in) :: field_data !< The data for the diag_field - LOGICAL, DIMENSION(:,:,:,:), pointer, INTENT(in) :: mask !< Logical mask indicating the grid + LOGICAL, allocatable, INTENT(in) :: mask(:,:,:,:) !< Logical mask indicating the grid !! points to mask (null if no mask) - CLASS(*), DIMENSION(:,:,:,:), pointer, INTENT(in) :: rmask !< real mask indicating the grid + CLASS(*), allocatable, INTENT(in) :: rmask(:,:,:,:)!< real mask indicating the grid !! points to mask (null if no mask) CLASS(*), INTENT(in), OPTIONAL :: weight !< The weight used for averaging TYPE (time_type), INTENT(in), OPTIONAL :: time !< The current time @@ -504,7 +508,6 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm integer :: is, js, ks !< Starting indicies of the field_data integer :: ie, je, ke !< Ending indicies of the field_data - integer :: n1, n2, n3 !< Size of the 3 indicies of the field data integer :: omp_num_threads !< Number of openmp threads integer :: omp_level !< The openmp active level logical :: buffer_the_data !< True if the user selects to buffer the data and run @@ -516,7 +519,9 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm logical, allocatable, dimension(:,:,:,:) :: oor_mask !< Out of range mask real(kind=r8_kind) :: field_weight !< Weight to use when averaging (it will be converted !! based on the type of field_data when doing the math) - + type(fmsDiagIbounds_type) :: bounds !< Bounds (starting ending indices) for the field + logical :: has_halos !< .True. if field_data contains halos + logical :: using_blocking !< .True. if field_data is passed in blocks #ifndef use_yaml CALL MPP_ERROR(FATAL,"You can not use the modern diag manager without compiling with -Duse_yaml") #else @@ -533,15 +538,23 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm error_string = check_indices_order(is_in, ie_in, js_in, je_in) if (trim(error_string) .ne. "") call mpp_error(FATAL, trim(error_string)//". "//trim(field_info)) + using_blocking = .false. + if ((present(is_in) .and. .not. present(ie_in)) .or. (present(js_in) .and. .not. present(je_in))) & + using_blocking = .true. + + has_halos = .false. + if ((present(is_in) .and. present(ie_in)) .or. (present(js_in) .and. present(je_in))) & + has_halos = .true. + !< If the field has `mask_variant=.true.`, check that mask OR rmask are present if (this%FMS_diag_fields(diag_field_id)%is_mask_variant()) then - if (.not. associated(mask) .and. .not. associated(rmask)) call mpp_error(FATAL, & + if (.not. allocated(mask) .and. .not. allocated(rmask)) call mpp_error(FATAL, & "The field was registered with mask_variant, but mask or rmask are not present in the send_data call. "//& trim(field_info)) endif !< Check that mask and rmask are not both present - if (associated(mask) .and. associated(rmask)) call mpp_error(FATAL, & + if (allocated(mask) .and. allocated(rmask)) call mpp_error(FATAL, & "mask and rmask are both present in the send_data call. "//& trim(field_info)) @@ -560,26 +573,23 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm buffer_the_data = (omp_num_threads > 1 .AND. omp_level > 0) #endif + !> Calculate the i,j,k start and end + ! If is, js, or ks not present default them to 1 + is = 1 + js = 1 + ks = 1 + IF ( PRESENT(is_in) ) is = is_in + IF ( PRESENT(js_in) ) js = js_in + IF ( PRESENT(ks_in) ) ks = ks_in + ie = is+SIZE(field_data, 1)-1 + je = js+SIZE(field_data, 2)-1 + ke = ks+SIZE(field_data, 3)-1 + IF ( PRESENT(ie_in) ) ie = ie_in + IF ( PRESENT(je_in) ) je = je_in + IF ( PRESENT(ke_in) ) ke = ke_in + !If this is true, buffer data main_if: if (buffer_the_data) then - !> Calculate the i,j,k start and end - ! If is, js, or ks not present default them to 1 - is = 1 - js = 1 - ks = 1 - IF ( PRESENT(is_in) ) is = is_in - IF ( PRESENT(js_in) ) js = js_in - IF ( PRESENT(ks_in) ) ks = ks_in - n1 = SIZE(field_data, 1) - n2 = SIZE(field_data, 2) - n3 = SIZE(field_data, 3) - ie = is+n1-1 - je = js+n2-1 - ke = ks+n3-1 - IF ( PRESENT(ie_in) ) ie = ie_in - IF ( PRESENT(je_in) ) je = je_in - IF ( PRESENT(ke_in) ) ke = ke_in - !> Only 1 thread allocates the output buffer and sets set_math_needs_to_be_done !$omp critical if (.not. this%FMS_diag_fields(diag_field_id)%is_data_buffer_allocated()) then @@ -595,9 +605,13 @@ logical function fms_diag_accept_data (this, diag_field_id, field_data, mask, rm fms_diag_accept_data = .TRUE. return else + error_string = bounds%set_bounds(field_data, is, ie, js, je, ks, ke, has_halos) + if (trim(error_string) .ne. "") call mpp_error(FATAL, trim(error_string)//". "//trim(field_info)) + call this%allocate_diag_field_output_buffers(field_data, diag_field_id) - fms_diag_accept_data = this%fms_diag_do_reduction(field_data, diag_field_id, oor_mask, field_weight, & - time, is, js, ks, ie, je, ke) + error_string = this%fms_diag_do_reduction(field_data, diag_field_id, oor_mask, field_weight, & + bounds, using_blocking, Time=Time) + if (trim(error_string) .ne. "") call mpp_error(FATAL, trim(error_string)//". "//trim(field_info)) call this%FMS_diag_fields(diag_field_id)%set_math_needs_to_be_done(.FALSE.) return end if main_if @@ -714,22 +728,141 @@ subroutine fms_diag_do_io(this, is_end_of_run) #endif end subroutine fms_diag_do_io - !> @brief Computes average, min, max, rms error, etc. - !! based on the specified reduction method for the field. - !> @return .True. if no error occurs. -logical function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight, & - time, is_in, js_in, ks_in, ie_in, je_in, ke_in) +!> @brief Computes average, min, max, rms error, etc. +!! based on the specified reduction method for the field. +!> @return Empty string if successful, error message if it fails +function fms_diag_do_reduction(this, field_data, diag_field_id, oor_mask, weight, & + bounds, using_blocking, time) & + result(error_msg) class(fmsDiagObject_type), intent(in), target :: this !< Diag Object class(*), intent(in) :: field_data(:,:,:,:) !< Field data integer, intent(in) :: diag_field_id !< ID of the input field logical, intent(in), target :: oor_mask(:,:,:,:) !< mask real(kind=r8_kind), intent(in) :: weight !< Must be a updated weight + type(fmsDiagIbounds_type), intent(in) :: bounds !< Bounds for the field + logical, intent(in) :: using_blocking !< .True. if field data is passed + !! in blocks type(time_type), intent(in), optional :: time !< Current time - integer, intent(in), optional :: is_in, js_in, ks_in !< Starting indices of the variable - integer, intent(in), optional :: ie_in, je_in, ke_in !< Ending indices of the variable - !TODO Everything - fms_diag_do_reduction = .true. + character(len=50) :: error_msg !< Error message to check + !TODO Mostly everything +#ifdef use_yaml + type(fmsDiagField_type), pointer :: field_ptr !< Pointer to the field's object + type(fmsDiagOutputBuffer_type), pointer :: buffer_ptr !< Pointer to the field's buffer + class(fmsDiagFileContainer_type), pointer :: file_ptr !< Pointer to the field's file + type(diagYamlFilesVar_type), pointer :: field_yaml_ptr !< Pointer to the field's yaml + + integer :: reduction_method !< Integer representing a reduction method + integer :: ids !< For looping through buffer ids + integer :: buffer_id !< Id of the buffer + integer :: file_id !< File id + integer, allocatable :: axis_ids(:) !< Axis ids for the buffer + logical :: is_subregional !< .True. if the buffer is subregional + logical :: reduced_k_range !< .True. is the field is only outputing a section + !! of the z dimension + type(fmsDiagIbounds_type) :: bounds_in !< Starting and ending indices of the input field_data + type(fmsDiagIbounds_type) :: bounds_out !< Starting and ending indices of the output buffer + integer :: i !< For looping through axid ids + integer :: sindex !< Starting index of a subregion + integer :: eindex !< Ending index of a subregion + integer :: compute_idx(2) !< Starting and Ending of the compute domain + character(len=1) :: cart_axis !< Cartesian axis of the axis + logical :: block_in_subregion !< .True. if the current block is part of the subregion + integer :: starting !< Starting index of the subregion relative to the compute domain + integer :: ending !< Ending index of the subregion relative to the compute domain + + !TODO mostly everything + field_ptr => this%FMS_diag_fields(diag_field_id) + buffer_loop: do ids = 1, size(field_ptr%buffer_ids) + error_msg = "" + buffer_id = this%FMS_diag_fields(diag_field_id)%buffer_ids(ids) + file_id = this%FMS_diag_fields(diag_field_id)%file_ids(ids) + + !< Gather all the objects needed for the buffer + field_yaml_ptr => field_ptr%diag_field(ids) + buffer_ptr => this%FMS_diag_output_buffers(buffer_id) + file_ptr => this%FMS_diag_files(file_id) + + !< Go away if the file is a subregional file and the current PE does not have any data for it + if (.not. file_ptr%writing_on_this_pe()) cycle + + bounds_out = bounds + if (.not. using_blocking) then + !< Set output bounds to start at 1:size(buffer_ptr%buffer) + call bounds_out%reset_bounds_from_array_4D(buffer_ptr%buffer(:,:,:,:,1)) + endif + + bounds_in = bounds + if (.not. bounds%has_halos) then + !< If field_data does not contain halos, set bounds_in to start at 1:size(field_data) + call bounds_in%reset_bounds_from_array_4D(field_data) + endif + + is_subregional = file_ptr%is_regional() + reduced_k_range = field_yaml_ptr%has_var_zbounds() + + !< Reset the bounds based on the reduced k range and subregional + is_subregional_reduced_k_range: if (is_subregional .or. reduced_k_range) then + axis_ids = buffer_ptr%get_axis_ids() + block_in_subregion = .true. + axis_loops: do i = 1, size(axis_ids) + !< Move on if the block does not have any data for the subregion + if (.not. block_in_subregion) cycle + + select type (diag_axis => this%diag_axis(axis_ids(i))%axis) + type is (fmsDiagSubAxis_type) + sindex = diag_axis%get_starting_index() + eindex = diag_axis%get_ending_index() + compute_idx = diag_axis%get_compute_indices() + starting=sindex-compute_idx(1)+1 + ending=eindex-compute_idx(1)+1 + if (using_blocking) then + block_in_subregion = determine_if_block_is_in_region(starting, ending, bounds, i) + if (.not. block_in_subregion) cycle + + !< Set bounds_in so that you can the correct section of the data for the block (starting at 1) + call bounds_in%rebase_input(bounds, starting, ending, i) + + !< Set bounds_out to be the correct section relative to the block starting and ending indices + call bounds_out%rebase_output(starting, ending, i) + else + !< Set bounds_in so that only the subregion section of the data will be used (starting at 1) + call bounds_in%update_index(starting, ending, i, .false.) + + !< Set bounds_out to 1:size(subregion) for the PE + call bounds_out%update_index(1, ending-starting+1, i, .true.) + endif + end select + enddo axis_loops + deallocate(axis_ids) + !< Move on to the next buffer if the block does not have any data for the subregion + if (.not. block_in_subregion) cycle + endif is_subregional_reduced_k_range + + !< Determine the reduction method for the buffer + reduction_method = field_yaml_ptr%get_var_reduction() + select case(reduction_method) + case (time_none) + error_msg = buffer_ptr%do_time_none_wrapper(field_data, oor_mask, bounds_in, bounds_out) + if (trim(error_msg) .ne. "") then + return + endif + case (time_min) + case (time_max) + case (time_sum) + case (time_average) + case (time_power) + case (time_rms) + case (time_diurnal) + case default + error_msg = "The reduction method is not supported. "//& + "Only none, min, max, sum, average, power, rms, and diurnal are supported." + end select + enddo buffer_loop +#else + error_msg = "" + CALL MPP_ERROR(FATAL,"You can not use the modern diag manager without compiling with -Duse_yaml") +#endif end function fms_diag_do_reduction !> @brief Adds the diag ids of the Area and or Volume of the diag_field_object @@ -807,6 +940,21 @@ subroutine fms_diag_axis_add_attribute(this, axis_id, att_name, att_value) #endif end subroutine fms_diag_axis_add_attribute +!> \brief Gets the field_name from the diag_field +!> \returns a copy of the field_name +function fms_get_field_name_from_id (this, field_id) & + result(field_name) + + class(fmsDiagObject_type), intent (in) :: this !< The diag object, the caller + integer, intent (in) :: field_id !< Field id to get the name for + character(len=:), allocatable :: field_name +#ifndef use_yaml + CALL MPP_ERROR(FATAL,"You can not use the modern diag manager without compiling with -Duse_yaml") +#else + field_name = this%FMS_diag_fields(field_id)%get_varname() +#endif +end function fms_get_field_name_from_id + !> \brief Gets the diag field ID from the module name and field name. !> \returns a copy of the ID of the diag field or DIAG_FIELD_NOT_FOUND if the field is not registered FUNCTION fms_get_diag_field_id_from_name(this, module_name, field_name) & @@ -1006,7 +1154,8 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) class(*), allocatable :: missing_value !< Missing value to initialize the data to character(len=128), allocatable :: var_name !< Field name to initialize output buffers logical :: is_scalar !< Flag indicating that the variable is a scalar - integer :: yaml_id + integer :: yaml_id !< Yaml id for the buffer + integer :: file_id !< File id for the buffer if (this%FMS_diag_fields(field_id)%buffer_allocated) return @@ -1045,6 +1194,10 @@ subroutine allocate_diag_field_output_buffers(this, field_data, field_id) ! Loop over a number of fields/buffers where this variable occurs do i = 1, size(this%FMS_diag_fields(field_id)%buffer_ids) buffer_id = this%FMS_diag_fields(field_id)%buffer_ids(i) + file_id = this%FMS_diag_fields(field_id)%file_ids(i) + + !< Go away if the file is a subregional file and the current PE does not have any data for it + if (.not. this%FMS_diag_files(file_id)%writing_on_this_pe()) cycle ndims = 0 if (.not. is_scalar) then diff --git a/diag_manager/fms_diag_output_buffer.F90 b/diag_manager/fms_diag_output_buffer.F90 index f23d6ea3d7..6c284812cd 100644 --- a/diag_manager/fms_diag_output_buffer.F90 +++ b/diag_manager/fms_diag_output_buffer.F90 @@ -32,6 +32,8 @@ module fms_diag_output_buffer_mod use diag_data_mod, only: DIAG_NULL, DIAG_NOT_REGISTERED, i4, i8, r4, r8 use fms2_io_mod, only: FmsNetcdfFile_t, write_data, FmsNetcdfDomainFile_t, FmsNetcdfUnstructuredDomainFile_t use fms_diag_yaml_mod, only: diag_yaml +use fms_diag_bbox_mod, only: fmsDiagIbounds_type +use fms_diag_reduction_methods_mod, only: do_time_none implicit none @@ -68,6 +70,7 @@ module fms_diag_output_buffer_mod procedure :: initialize_buffer procedure :: get_buffer procedure :: flush_buffer + procedure :: do_time_none_wrapper end type fmsDiagOutputBuffer_type @@ -432,5 +435,37 @@ subroutine write_buffer_wrapper_u(this, fms2io_fileobj, unlim_dim_level) call write_data(fms2io_fileobj, varname, this%buffer(:,:,:,:,:), unlim_dim_level=unlim_dim_level) end select end subroutine write_buffer_wrapper_u + +!> @brief Does the time_none reduction method on the buffer object +!! @return Error message if the math was not successful +function do_time_none_wrapper(this, field_data, mask, bounds_in, bounds_out) & + result(err_msg) + class(fmsDiagOutputBuffer_type), intent(inout) :: this !< buffer object to write + class(*), intent(in) :: field_data(:,:,:,:) !< Buffer data for current time + type(fmsDiagIbounds_type), intent(in) :: bounds_in !< Indicies for the buffer passed in + type(fmsDiagIbounds_type), intent(in) :: bounds_out !< Indicies for the output buffer + logical, intent(in) :: mask(:,:,:,:) !< Mask for the field + character(len=50) :: err_msg + + !TODO This does not need to be done for every time step + !TODO This will be expanded for integers + err_msg = "" + select type (output_buffer => this%buffer) + type is (real(kind=r8_kind)) + select type (field_data) + type is (real(kind=r8_kind)) + call do_time_none(output_buffer, field_data, mask, bounds_in, bounds_out) + class default + err_msg="the output buffer and the buffer send in are not of the same type (r8_kind)" + end select + type is (real(kind=r4_kind)) + select type (field_data) + type is (real(kind=r4_kind)) + call do_time_none(output_buffer, field_data, mask, bounds_in, bounds_out) + class default + err_msg="the output buffer and the buffer send in are not of the same type (r4_kind)" + end select + end select +end function do_time_none_wrapper #endif end module fms_diag_output_buffer_mod diff --git a/diag_manager/fms_diag_reduction_methods.F90 b/diag_manager/fms_diag_reduction_methods.F90 index 8962638c04..fa4a7b9fcd 100644 --- a/diag_manager/fms_diag_reduction_methods.F90 +++ b/diag_manager/fms_diag_reduction_methods.F90 @@ -29,10 +29,19 @@ !> @{ module fms_diag_reduction_methods_mod use platform_mod, only: r8_kind, r4_kind + use fms_diag_bbox_mod, only: fmsDiagIbounds_type + use mpp_mod implicit none private public :: check_indices_order, init_mask, set_weight + public :: do_time_none + + !> @brief Does the time_none reduction method. See include/fms_diag_reduction_methods.inc + !TODO This needs to be extended to integers + interface do_time_none + module procedure do_time_none_r4, do_time_none_r8 + end interface do_time_none contains @@ -82,8 +91,8 @@ end function check_indices_order !> @return logical mask function init_mask(rmask, mask, field) & result(oor_mask) - LOGICAL, DIMENSION(:,:,:,:), pointer, INTENT(in) :: mask !< The location of the mask - CLASS(*), DIMENSION(:,:,:,:), pointer, INTENT(in) :: rmask !< The masking values + LOGICAL, DIMENSION(:,:,:,:), allocatable, INTENT(in) :: mask !< The location of the mask + CLASS(*), DIMENSION(:,:,:,:), allocatable, INTENT(in) :: rmask !< The masking values CLASS(*), DIMENSION(:,:,:,:), intent(in) :: field !< Field_data logical, allocatable, dimension(:,:,:,:) :: oor_mask !< mask @@ -91,9 +100,9 @@ function init_mask(rmask, mask, field) & ALLOCATE(oor_mask(SIZE(field, 1), SIZE(field, 2), SIZE(field, 3), SIZE(field, 4))) oor_mask = .true. - if (associated(mask)) then + if (allocated(mask)) then oor_mask = mask - elseif (associated(rmask)) then + elseif (allocated(rmask)) then select type (rmask) type is (real(kind=r8_kind)) WHERE (rmask < 0.5_r8_kind) oor_mask = .FALSE. @@ -124,6 +133,9 @@ pure function set_weight(weight) & endif end function set_weight +#include "fms_diag_reduction_methods_r4.fh" +#include "fms_diag_reduction_methods_r8.fh" + end module fms_diag_reduction_methods_mod !> @} ! close documentation grouping \ No newline at end of file diff --git a/diag_manager/include/fms_diag_reduction_methods.inc b/diag_manager/include/fms_diag_reduction_methods.inc new file mode 100644 index 0000000000..0d6633285b --- /dev/null +++ b/diag_manager/include/fms_diag_reduction_methods.inc @@ -0,0 +1,53 @@ +!*********************************************************************** +!* 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 Do the time_none reduction method (i.e copy the correct portion of the input data) +subroutine DO_TIME_NONE_ (data_out, data_in, mask, bounds_in, bounds_out) + real(FMS_TRM_KIND_), intent(inout) :: data_out(:,:,:,:,:) !< output data + real(FMS_TRM_KIND_), intent(in) :: data_in(:,:,:,:) !< data to update the buffer with + logical, intent(in) :: mask(:,:,:,:) !< mask + type(fmsDiagIbounds_type), intent(in) :: bounds_in !< indices indicating the correct portion + !! of the input buffer + type(fmsDiagIbounds_type), intent(in) :: bounds_out !< indices indicating the correct portion + !! of the output buffer + + integer :: is_in, ie_in, js_in, je_in, ks_in, ke_in !< Starting and ending indices of each dimention for + !! the input buffer + integer :: is_out, ie_out, js_out, je_out, ks_out, ke_out !< Starting and ending indices of each dimention for + !! the output buffer + + is_out = bounds_out%get_imin() + ie_out = bounds_out%get_imax() + js_out = bounds_out%get_jmin() + je_out = bounds_out%get_jmax() + ks_out = bounds_out%get_kmin() + ke_out = bounds_out%get_kmax() + + is_in = bounds_in%get_imin() + ie_in = bounds_in%get_imax() + js_in = bounds_in%get_jmin() + je_in = bounds_in%get_jmax() + ks_in = bounds_in%get_kmin() + ke_in = bounds_in%get_kmax() + + where (mask(is_in:ie_in, js_in:je_in, ks_in:ke_in, :)) & + data_out(is_out:ie_out, js_out:je_out, ks_out:ke_out, :, 1) = & + data_in(is_in:ie_in, js_in:je_in, ks_in:ke_in, :) + +end subroutine DO_TIME_NONE_ \ No newline at end of file diff --git a/diag_manager/include/fms_diag_reduction_methods_r4.fh b/diag_manager/include/fms_diag_reduction_methods_r4.fh new file mode 100644 index 0000000000..922972cce3 --- /dev/null +++ b/diag_manager/include/fms_diag_reduction_methods_r4.fh @@ -0,0 +1,35 @@ +!*********************************************************************** +!* 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 . +!*********************************************************************** +!> @file +!> @brief Imports the time reduction methods routines from other include files used +!! in @ref diag_manager_mod + +!> @addtogroup diag_manager_mod +!> @{ + +#undef FMS_TRM_KIND_ +#define FMS_TRM_KIND_ r4_kind + +#undef DO_TIME_NONE_ +#define DO_TIME_NONE_ do_time_none_r4 + +#include "fms_diag_reduction_methods.inc" + +!> @} +! close documentation grouping \ No newline at end of file diff --git a/diag_manager/include/fms_diag_reduction_methods_r8.fh b/diag_manager/include/fms_diag_reduction_methods_r8.fh new file mode 100644 index 0000000000..25c3031a22 --- /dev/null +++ b/diag_manager/include/fms_diag_reduction_methods_r8.fh @@ -0,0 +1,35 @@ +!*********************************************************************** +!* 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 . +!*********************************************************************** +!> @file +!> @brief Imports the time reduction methods routines from other include files used +!! in @ref diag_manager_mod + +!> @addtogroup diag_manager_mod +!> @{ + +#undef FMS_TRM_KIND_ +#define FMS_TRM_KIND_ r8_kind + +#undef DO_TIME_NONE_ +#define DO_TIME_NONE_ do_time_none_r8 + +#include "fms_diag_reduction_methods.inc" + +!> @} +! close documentation grouping \ No newline at end of file diff --git a/test_fms/diag_manager/check_time_max.F90 b/test_fms/diag_manager/check_time_max.F90 index b8e82f3472..e579bada4f 100644 --- a/test_fms/diag_manager/check_time_max.F90 +++ b/test_fms/diag_manager/check_time_max.F90 @@ -25,6 +25,8 @@ program check_time_max use platform_mod, only: r4_kind, r8_kind use testing_utils, only: allocate_buffer, test_normal, test_openmp, test_halos, no_mask, logical_mask, real_mask + implicit none + type(FmsNetcdfFile_t) :: fileobj !< FMS2 fileobj type(FmsNetcdfFile_t) :: fileobj1 !< FMS2 fileobj for subregional file 1 type(FmsNetcdfFile_t) :: fileobj2 !< FMS2 fileobj for subregional file 2 diff --git a/test_fms/diag_manager/check_time_min.F90 b/test_fms/diag_manager/check_time_min.F90 index f0d8f8029d..cb1406070c 100644 --- a/test_fms/diag_manager/check_time_min.F90 +++ b/test_fms/diag_manager/check_time_min.F90 @@ -25,6 +25,8 @@ program check_time_min use platform_mod, only: r4_kind, r8_kind use testing_utils, only: allocate_buffer, test_normal, test_openmp, test_halos, no_mask, logical_mask, real_mask + implicit none + type(FmsNetcdfFile_t) :: fileobj !< FMS2 fileobj type(FmsNetcdfFile_t) :: fileobj1 !< FMS2 fileobj for subregional file 1 type(FmsNetcdfFile_t) :: fileobj2 !< FMS2 fileobj for subregional file 2 diff --git a/test_fms/diag_manager/check_time_none.F90 b/test_fms/diag_manager/check_time_none.F90 index 11844448c0..f703469078 100644 --- a/test_fms/diag_manager/check_time_none.F90 +++ b/test_fms/diag_manager/check_time_none.F90 @@ -25,6 +25,8 @@ program check_time_none use platform_mod, only: r4_kind, r8_kind use testing_utils, only: allocate_buffer, test_normal, test_openmp, test_halos, no_mask, logical_mask, real_mask + implicit none + type(FmsNetcdfFile_t) :: fileobj !< FMS2 fileobj type(FmsNetcdfFile_t) :: fileobj1 !< FMS2 fileobj for subregional file 1 type(FmsNetcdfFile_t) :: fileobj2 !< FMS2 fileobj for subregional file 2 @@ -58,20 +60,20 @@ program check_time_none nw = 2 if (.not. open_file(fileobj, "test_none.nc", "read")) & - call mpp_error(FATAL, "unable to open file") + call mpp_error(FATAL, "unable to open test_none.nc") if (.not. open_file(fileobj1, "test_none_regional.nc.0004", "read")) & - call mpp_error(FATAL, "unable to open file") + call mpp_error(FATAL, "unable to open test_none_regional.nc.0004") if (.not. open_file(fileobj2, "test_none_regional.nc.0005", "read")) & - call mpp_error(FATAL, "unable to open file") + call mpp_error(FATAL, "unable to open test_none_regional.nc.0005") cdata_out = allocate_buffer(1, nx, 1, ny, nz, nw) do i = 1, 8 cdata_out = -999_r4_kind print *, "Checking answers for var0_none - time_level:", string(i) - call read_data(fileobj, "var0_none", cdata_out(1:1,1,1,1), unlim_dim_level=i) !eyeroll + call read_data(fileobj, "var0_none", cdata_out(1,1,1,1), unlim_dim_level=i) call check_data_0d(cdata_out(1,1,1,1), i) cdata_out = -999_r4_kind @@ -120,7 +122,7 @@ subroutine check_data_0d(buffer, time_level) real(time_level*6, kind=r8_kind)/100_r8_kind, kind=r4_kind) if (abs(buffer - buffer_exp) > 0) then - print *, mpp_pe(), time_level, buffer_exp + print *, mpp_pe(), time_level, buffer_exp, buffer call mpp_error(FATAL, "Check_time_none::check_data_0d:: Data is not correct") endif end subroutine check_data_0d diff --git a/test_fms/diag_manager/test_time_none.sh b/test_fms/diag_manager/test_time_none.sh index 0de41c9f1b..7e2597ee87 100755 --- a/test_fms/diag_manager/test_time_none.sh +++ b/test_fms/diag_manager/test_time_none.sh @@ -28,26 +28,62 @@ if [ -z "${skipflag}" ]; then # create and enter directory for in/output files output_dir -#TODO replace with yaml diag_table and set diag_manager_nml::use_modern_diag=.true. -cat <<_EOF > diag_table -test_none -2 1 1 0 0 0 - -"test_none", 6, "hours", 1, "hours", "time" -"test_none_regional", 6, "hours", 1, "hours", "time" - -"ocn_mod", "var0", "var0_none", "test_none", "all", .false., "none", 2 -"ocn_mod", "var1", "var1_none", "test_none", "all", .false., "none", 2 -"ocn_mod", "var2", "var2_none", "test_none", "all", .false., "none", 2 -"ocn_mod", "var3", "var3_none", "test_none", "all", .false., "none", 2 - -"ocn_mod", "var3", "var3_Z", "test_none", "all", .false., "-1 -1 -1 -1 2. 3.", 2 - -"ocn_mod", "var3", "var3_none", "test_none_regional", "all", .false., "78. 81. 78. 81. 2. 3.", 2 #chosen by MKL +cat <<_EOF > diag_table.yaml +title: test_none +base_date: 2 1 1 0 0 0 +diag_files: +- file_name: test_none + freq: 6 hours + time_units: hours + unlimdim: time + varlist: + - module: ocn_mod + var_name: var0 + output_name: var0_none + reduction: none + kind: r4 + - module: ocn_mod + var_name: var1 + output_name: var1_none + reduction: none + kind: r4 + - module: ocn_mod + var_name: var2 + output_name: var2_none + reduction: none + kind: r4 + - module: ocn_mod + var_name: var3 + output_name: var3_none + reduction: none + kind: r4 + - module: ocn_mod + var_name: var3 + output_name: var3_Z + reduction: none + zbounds: 2. 3. + kind: r4 +- file_name: test_none_regional + freq: 6 hours + time_units: hours + unlimdim: time + sub_region: + - grid_type: latlon + corner1: 78. 78. + corner2: 78. 78. + corner3: 81. 81. + corner4: 81. 81. + varlist: + - module: ocn_mod + var_name: var3 + output_name: var3_none + reduction: none + zbounds: 2. 3. + kind: r4 _EOF my_test_count=1 -printf "&test_reduction_methods_nml \n test_case = 0 \n \n/" | cat > input.nml +printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 0 \n/" | cat > input.nml test_expect_success "Running diag_manager with "none" reduction method (test $my_test_count)" ' mpirun -n 6 ../test_reduction_methods ' @@ -56,7 +92,7 @@ test_expect_success "Checking answers for the "none" reduction method (test $my_ ' my_test_count=`expr $my_test_count + 1` -printf "&test_reduction_methods_nml \n test_case = 0 \n mask_case = 1 \n \n/" | cat > input.nml +printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n &test_reduction_methods_nml \n test_case = 0 \n mask_case = 1 \n \n/" | cat > input.nml test_expect_success "Running diag_manager with "none" reduction method, logical mask (test $my_test_count)" ' mpirun -n 6 ../test_reduction_methods ' @@ -65,7 +101,7 @@ test_expect_success "Checking answers for the "none" reduction method, logical m ' my_test_count=`expr $my_test_count + 1` -printf "&test_reduction_methods_nml \n test_case = 0 \n mask_case = 2 \n \n/" | cat > input.nml +printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n &test_reduction_methods_nml \n test_case = 0 \n mask_case = 2 \n \n/" | cat > input.nml test_expect_success "Running diag_manager with "none" reduction method, real mask (test $my_test_count)" ' mpirun -n 6 ../test_reduction_methods ' @@ -73,9 +109,10 @@ test_expect_success "Checking answers for the "none" reduction method, real mask mpirun -n 1 ../check_time_none ' -export OMP_NUM_THREADS=2 +TODO this needs to be set back to 2, once the set_math_needs_to_be_done=.true. portion of the code is implemented +export OMP_NUM_THREADS=1 my_test_count=`expr $my_test_count + 1` -printf "&test_reduction_methods_nml \n test_case = 1 \n \n/" | cat > input.nml +printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 1 \n \n/" | cat > input.nml test_expect_success "Running diag_manager with "none" reduction method with openmp (test $my_test_count)" ' mpirun -n 6 ../test_reduction_methods ' @@ -84,7 +121,7 @@ test_expect_success "Checking answers for the "none" reduction method with openm ' my_test_count=`expr $my_test_count + 1` -printf "&test_reduction_methods_nml \n test_case = 1 \n mask_case = 1 \n \n/" | cat > input.nml +printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 1 \n mask_case = 1 \n \n/" | cat > input.nml test_expect_success "Running diag_manager with "none" reduction method with openmp, logical mask (test $my_test_count)" ' mpirun -n 6 ../test_reduction_methods ' @@ -93,7 +130,7 @@ test_expect_success "Checking answers for the "none" reduction method with openm ' my_test_count=`expr $my_test_count + 1` -printf "&test_reduction_methods_nml \n test_case = 1 \n mask_case = 2 \n \n/" | cat > input.nml +printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 1 \n mask_case = 2 \n \n/" | cat > input.nml test_expect_success "Running diag_manager with "none" reduction method with openmp, real mask (test $my_test_count)" ' mpirun -n 6 ../test_reduction_methods ' @@ -103,7 +140,7 @@ test_expect_success "Checking answers for the "none" reduction method with openm export OMP_NUM_THREADS=1 my_test_count=`expr $my_test_count + 1` -printf "&test_reduction_methods_nml \n test_case = 2 \n \n/" | cat > input.nml +printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 2 \n \n/" | cat > input.nml test_expect_success "Running diag_manager with "none" reduction method with halo output (test $my_test_count)" ' mpirun -n 6 ../test_reduction_methods ' @@ -112,7 +149,7 @@ test_expect_success "Checking answers for the "none" reduction method with halo ' my_test_count=`expr $my_test_count + 1` -printf "&test_reduction_methods_nml \n test_case = 2 \n mask_case = 1 \n \n/" | cat > input.nml +printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 2 \n mask_case = 1 \n \n/" | cat > input.nml test_expect_success "Running diag_manager with "none" reduction method with halo output with logical mask (test $my_test_count)" ' mpirun -n 6 ../test_reduction_methods ' @@ -121,7 +158,7 @@ test_expect_success "Checking answers for the "none" reduction method with halo ' my_test_count=`expr $my_test_count + 1` -printf "&test_reduction_methods_nml \n test_case = 2 \n mask_case = 2 \n \n/" | cat > input.nml +printf "&diag_manager_nml \n use_modern_diag=.true. \n / \n&test_reduction_methods_nml \n test_case = 2 \n mask_case = 2 \n \n/" | cat > input.nml test_expect_success "Running diag_manager with "none" reduction method with halo output with real mask (test $my_test_count)" ' mpirun -n 6 ../test_reduction_methods ' @@ -129,4 +166,4 @@ test_expect_success "Checking answers for the "none" reduction method with halo mpirun -n 1 ../check_time_none ' fi -test_done \ No newline at end of file +test_done