diff --git a/diag_manager/fms_diag_axis_object.F90 b/diag_manager/fms_diag_axis_object.F90 index 933a4b387..7fd124669 100644 --- a/diag_manager/fms_diag_axis_object.F90 +++ b/diag_manager/fms_diag_axis_object.F90 @@ -813,7 +813,7 @@ 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, compute_idx, & - global_idx, zbounds) + global_idx, zbounds, nz_subaxis) 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 @@ -825,12 +825,21 @@ subroutine fill_subaxis(this, starting_index, ending_index, axis_id, parent_id, integer, optional, intent(in) :: global_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 + integer, optional, intent(in) :: nz_subaxis !< The number of z subaxis that have been defined + !! in the file + + integer :: nsubaxis !< The subaxis number in the axis name subXX + character(len=2) :: nsubaxis_char !< nsubaxis converted to a string + + nsubaxis = 1 + if (present(nz_subaxis)) nsubaxis = nz_subaxis this%axis_id = axis_id this%starting_index = starting_index this%ending_index = ending_index this%parent_axis_id = parent_id - this%subaxis_name = trim(parent_axis_name)//"_sub01" + write(nsubaxis_char, '(i2.2)') nsubaxis + this%subaxis_name = trim(parent_axis_name)//"_sub"//nsubaxis_char this%compute_idx = compute_idx if (present(zbounds)) then @@ -1235,7 +1244,8 @@ end subroutine define_new_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, compute_idx, global_idx, new_axis_id, zbounds) + starting_index, ending_index, compute_idx, global_idx, new_axis_id, zbounds, & + nz_subaxis) class(fmsDiagAxisContainer_type), target, intent(inout) :: diag_axis(:) !< Diag_axis object class(fmsDiagFullAxis_type), intent(inout) :: parent_axis !< The parent axis @@ -1250,6 +1260,8 @@ subroutine define_new_axis(diag_axis, parent_axis, naxis, parent_id, & !! the axis's global 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 + integer, optional, intent(in) :: nz_subaxis !< The number of z subaxis that have been + !! defined in the file naxis = naxis + 1 !< This is the axis id of the new axis! @@ -1265,7 +1277,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, compute_idx, global_idx=global_idx, zbounds=zbounds) + parent_axis%axis_name, compute_idx, global_idx=global_idx, zbounds=zbounds, nz_subaxis=nz_subaxis) end select end subroutine define_new_axis @@ -1377,7 +1389,7 @@ subroutine write_diurnal_metadata(this, fms2io_fileobj) 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) + subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_axis_id, nfile_axis, nz_subaxis) 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 @@ -1386,6 +1398,8 @@ subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_ax 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 + integer, intent(in) :: nz_subaxis !< The number of z subaxis currently + !! defined in the 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 @@ -1431,7 +1445,7 @@ subroutine create_new_z_subaxis(zbounds, var_axis_ids, diag_axis, naxis, file_ax call define_new_axis(diag_axis, parent_axis, naxis, parent_axis%axis_id, & &subaxis_indices(1), subaxis_indices(2), (/lbound(zaxis_data,1), ubound(zaxis_data,1)/), & - &new_axis_id=subaxis_id, zbounds=zbounds) + &new_axis_id=subaxis_id, zbounds=zbounds, nz_subaxis=nz_subaxis) var_axis_ids(i) = subaxis_id return endif diff --git a/diag_manager/fms_diag_file_object.F90 b/diag_manager/fms_diag_file_object.F90 index 4a42fce00..a46f07f52 100644 --- a/diag_manager/fms_diag_file_object.F90 +++ b/diag_manager/fms_diag_file_object.F90 @@ -96,6 +96,7 @@ module fms_diag_file_object_mod logical :: time_ops !< .True. if file contains variables that are time_min, time_max, time_average or time_sum integer :: unlim_dimension_level !< The unlimited dimension level currently being written logical :: is_static !< .True. if the frequency is -1 + integer :: nz_subaxis !< The number of Z axis currently added to the file contains procedure, public :: add_field_and_yaml_id @@ -270,6 +271,7 @@ logical function fms_diag_files_object_init (files_array) obj%time_ops = .false. obj%unlim_dimension_level = 0 obj%is_static = obj%get_file_freq() .eq. -1 + obj%nz_subaxis = 0 nullify(obj) enddo set_ids_loop @@ -775,8 +777,9 @@ subroutine add_axes(this, axis_ids, diag_axis, naxis, yaml_id, buffer_id, output var_axis_ids = axis_ids if (field_yaml%has_var_zbounds()) then + this%nz_subaxis = this%nz_subaxis + 1 call create_new_z_subaxis(field_yaml%get_var_zbounds(), var_axis_ids, diag_axis, naxis, & - this%axis_ids, this%number_of_axis) + this%axis_ids, this%number_of_axis, this%nz_subaxis) endif select type(this) diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am index 6c77601f2..edd89bda0 100644 --- a/test_fms/diag_manager/Makefile.am +++ b/test_fms/diag_manager/Makefile.am @@ -32,7 +32,7 @@ check_PROGRAMS = test_diag_manager test_diag_manager_time \ test_diag_yaml test_diag_ocean test_modern_diag test_diag_buffer \ test_flexible_time test_diag_update_buffer test_reduction_methods check_time_none \ check_time_min check_time_max check_time_sum check_time_avg test_diag_diurnal check_time_diurnal \ - check_time_pow check_time_rms test_cell_measures + check_time_pow check_time_rms check_subregional test_cell_measures # This is the source code for the test. test_diag_manager_SOURCES = test_diag_manager.F90 @@ -54,6 +54,7 @@ check_time_diurnal_SOURCES = testing_utils.F90 check_time_diurnal.F90 check_time_pow_SOURCES = testing_utils.F90 check_time_pow.F90 check_time_rms_SOURCES = testing_utils.F90 check_time_rms.F90 test_cell_measures_SOURCES = test_cell_measures.F90 +check_subregional_SOURCES = check_subregional.F90 TEST_EXTENSIONS = .sh SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ @@ -61,14 +62,15 @@ SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ # Run the test. TESTS = test_diag_manager2.sh test_time_none.sh test_time_min.sh test_time_max.sh test_time_sum.sh \ - test_time_avg.sh test_time_pow.sh test_time_rms.sh test_time_diurnal.sh test_cell_measures.sh + test_time_avg.sh test_time_pow.sh test_time_rms.sh test_time_diurnal.sh test_cell_measures.sh \ + test_subregional.sh testing_utils.mod: testing_utils.$(OBJEXT) # Copy over other needed files to the srcdir EXTRA_DIST = test_diag_manager2.sh check_crashes.sh test_time_none.sh test_time_min.sh test_time_max.sh \ test_time_sum.sh test_time_avg.sh test_time_pow.sh test_time_rms.sh test_time_diurnal.sh \ - test_cell_measures.sh + test_cell_measures.sh test_subregional.sh if USING_YAML skipflag="" diff --git a/test_fms/diag_manager/check_subregional.F90 b/test_fms/diag_manager/check_subregional.F90 new file mode 100644 index 000000000..3b93958cb --- /dev/null +++ b/test_fms/diag_manager/check_subregional.F90 @@ -0,0 +1,139 @@ +!*********************************************************************** +!* 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 Checks the output file after running test_subregional +program check_subregional + use fms_mod, only: fms_init, fms_end, string + use fms2_io_mod, only: FmsNetcdfFile_t, read_data, close_file, open_file, get_dimension_size + use mpp_mod, only: mpp_npes, mpp_error, FATAL, mpp_pe + use platform_mod, only: r4_kind, r8_kind + + implicit none + + call fms_init() + + call check_zsubaxis_file("test_subZaxis.nc") + ! The files are in the same subregion, one of them is defined using latlon and another one indices + call check_subregional_file("test_subregional.nc") + call check_subregional_file("test_subregional2.nc") + + call fms_end() + + contains + + !> @brief Check dimension data + subroutine check_dims(err_msg, actual_data, expected_data) + character(len=*), intent(in) :: err_msg !< Error message to append + real, intent(in) :: actual_data(:) !< Dimension data from file + real, intent(in) :: expected_data(:) !< Expected data + + integer :: i + + do i = 1, size(actual_data) + if (actual_data(i) .ne. expected_data(i)) & + call mpp_error(FATAL, "The data is not expected for "//trim(err_msg)) + enddo + end subroutine check_dims + + !> @brief Check the data for the Z subaxis + subroutine check_zsubaxis_file(file_name) + character(len=*), intent(in) :: file_name !< Name of the file to check + + type(FmsNetcdfFile_t) :: fileobj !< FMS2 fileobj + integer :: dim_size !< dim_size as read in from the file + real, allocatable :: dims(:) !< dimension data as read in from the file + real, allocatable :: dims_exp(:) !< dimensions data expected + + if (.not. open_file(fileobj, file_name, "read")) & + call mpp_error(FATAL, "unable to open "//trim(file_name)) + + call get_dimension_size(fileobj, "z_sub01", dim_size) + if (dim_size .ne. 3) call mpp_error(FATAL, "z_sub01 is not the correct size!") + allocate(dims(dim_size), dims_exp(dim_size)) + call read_data(fileobj, "z_sub01", dims) + dims_exp = (/3., 4., 5. /) + call check_dims("z_sub01",dims, dims_exp) + deallocate(dims, dims_exp) + + call get_dimension_size(fileobj, "z_sub02", dim_size) + if (dim_size .ne. 2) call mpp_error(FATAL, "z_sub02 is not the correct size!") + allocate(dims(dim_size), dims_exp(dim_size)) + call read_data(fileobj, "z_sub02", dims) + dims_exp = (/2., 3./) + call check_dims("z_sub01",dims, dims_exp) + deallocate(dims, dims_exp) + + call close_file(fileobj) + + end subroutine check_zsubaxis_file + + !> @brief Check the data for the subregional file + subroutine check_subregional_file(file_name) + character(len=*), intent(in) :: file_name !< Name of the file to check + + type(FmsNetcdfFile_t) :: fileobj !< FMS2 fileobj + integer :: dim_size !< dim_size as read in from the file + real, allocatable :: dims(:) !< dimension data as read in from the file + real, allocatable :: dims_exp(:) !< dimensions data expected + + if (.not. open_file(fileobj, trim(file_name)//".0003", "read")) & + call mpp_error(FATAL, "unable to open "//trim(file_name)) + + call get_dimension_size(fileobj, "x_sub01", dim_size) + if (dim_size .ne. 6) call mpp_error(FATAL, "x_sub01 is not the correct size!") + allocate(dims(dim_size), dims_exp(dim_size)) + call read_data(fileobj, "x_sub01", dims) + dims_exp = (/60., 61., 62., 63., 64., 65. /) + call check_dims("x_sub01",dims, dims_exp) + deallocate(dims, dims_exp) + + call get_dimension_size(fileobj, "y_sub01", dim_size) + if (dim_size .ne. 5) call mpp_error(FATAL, "y_sub01 is not the correct size!") + allocate(dims(dim_size), dims_exp(dim_size)) + call read_data(fileobj, "y_sub01", dims) + dims_exp = (/60., 61., 62., 63., 64./) + call check_dims("y_sub01",dims, dims_exp) + deallocate(dims, dims_exp) + + call close_file(fileobj) + + if (.not. open_file(fileobj, trim(file_name)//".0004", "read")) & + call mpp_error(FATAL, "unable to open "//trim(file_name)) + + call get_dimension_size(fileobj, "x_sub01", dim_size) + if (dim_size .ne. 6) call mpp_error(FATAL, "x_sub01 is not the correct size!") + allocate(dims(dim_size), dims_exp(dim_size)) + call read_data(fileobj, "x_sub01", dims) + dims_exp = (/60., 61., 62., 63., 64., 65. /) + call check_dims("x_sub01",dims, dims_exp) + deallocate(dims, dims_exp) + + call get_dimension_size(fileobj, "y_sub01", dim_size) + if (dim_size .ne. 1) call mpp_error(FATAL, "y_sub01 is not the correct size!") + allocate(dims(dim_size), dims_exp(dim_size)) + call read_data(fileobj, "y_sub01", dims) + dims_exp = (/65./) + call check_dims("y_sub01",dims, dims_exp) + deallocate(dims, dims_exp) + + call close_file(fileobj) + + end subroutine check_subregional_file + +end program diff --git a/test_fms/diag_manager/test_subregional.sh b/test_fms/diag_manager/test_subregional.sh new file mode 100755 index 000000000..41d43cc6c --- /dev/null +++ b/test_fms/diag_manager/test_subregional.sh @@ -0,0 +1,111 @@ +#!/bin/sh + +#*********************************************************************** +#* GNU Lesser General Public License +#* +#* This file is part of the GFDL Flexible Modeling System (FMS). +#* +#* FMS is free software: you can redistribute it and/or modify it under +#* the terms of the GNU Lesser General Public License as published by +#* the Free Software Foundation, either version 3 of the License, or (at +#* your option) any later version. +#* +#* FMS is distributed in the hope that it will be useful, but WITHOUT +#* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +#* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +#* for more details. +#* +#* You should have received a copy of the GNU Lesser General Public +#* License along with FMS. If not, see . +#*********************************************************************** + +# Set common test settings. +. ../test-lib.sh + +if [ -z "${skipflag}" ]; then +# create and enter directory for in/output files +output_dir + +cat <<_EOF > diag_table.yaml +title: test_subregional +base_date: 2 1 1 0 0 0 + +diag_files: +# This is to test a file with multiple z axis +- file_name: test_subZaxis + freq: 6 hours + time_units: hours + unlimdim: time + varlist: + - module: ocn_mod + var_name: var3 + output_name: var3_Z1 + reduction: none + kind: r4 + zbounds: 2. 3. + - module: ocn_mod + var_name: var3 + output_name: var3_Z2 + reduction: none + kind: r4 + zbounds: 3. 5. +- file_name: test_subregional + freq: 6 hours + time_units: hours + unlimdim: time + sub_region: + - grid_type: latlon + corner1: 60. 60. + corner2: 60. 65. + corner3: 65. 65. + corner4: 65. 60. + varlist: + - module: ocn_mod + var_name: var3 + output_name: var3_min + reduction: min + kind: r4 + - module: ocn_mod + var_name: var3 + output_name: var3_max + reduction: max + kind: r4 +- file_name: test_subregional2 + freq: 6 hours + time_units: hours + unlimdim: time + sub_region: + - grid_type: index + corner1: 60 60 + corner2: 60 65 + corner3: 65 65 + corner4: 65 60 + tile: 1 + varlist: + - module: ocn_mod + var_name: var3 + output_name: var3_min + reduction: min + kind: r4 + - module: ocn_mod + var_name: var3 + output_name: var3_max + reduction: max + kind: r4 +_EOF + +# remove any existing files that would result in false passes during checks +rm -f *.nc + +my_test_count=1 +printf "&diag_manager_nml \n use_modern_diag=.true. \n/" | cat > input.nml +test_expect_success "Running diag_manager with different subregions (test $my_test_count)" ' + mpirun -n 6 ../test_reduction_methods +' + +my_test_count=`expr $my_test_count + 1` +test_expect_success "Checking results from diag_manager with different subregions (test $my_test_count)" ' + mpirun -n 1 ../check_subregional +' +fi +test_done