From be83fd9e7b51d58e5a4ea0813957b94dc795e8db Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Tue, 3 Feb 2026 13:28:21 -0500 Subject: [PATCH 01/19] Add diag manager test to register var with different axes permutations --- test_fms/diag_manager/Makefile.am | 4 +- .../check_generalized_indices.F90 | 133 ++++++++++ .../test_generalized_indicies.F90 | 228 ++++++++++++++++++ test_fms/diag_manager/test_time_none.sh | 59 +++++ 4 files changed, 423 insertions(+), 1 deletion(-) create mode 100644 test_fms/diag_manager/check_generalized_indices.F90 create mode 100644 test_fms/diag_manager/test_generalized_indicies.F90 diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am index c3b8d7d944..7b68392144 100644 --- a/test_fms/diag_manager/Makefile.am +++ b/test_fms/diag_manager/Makefile.am @@ -34,7 +34,7 @@ check_PROGRAMS = test_diag_manager test_diag_manager_time \ check_time_pow check_time_rms check_subregional test_cell_measures test_var_masks \ check_var_masks test_multiple_send_data test_diag_out_yaml test_output_every_freq \ test_dm_weights test_prepend_date test_ens_runs test_diag_multi_file test_diag_attribute_add \ - check_new_file_freq test_zbounds_limits test_multiple_zbounds + check_new_file_freq test_zbounds_limits test_multiple_zbounds test_generalized_indicies check_generalized_indices # This is the source code for the test. test_output_every_freq_SOURCES = test_output_every_freq.F90 @@ -71,6 +71,8 @@ test_diag_attribute_add_SOURCES = test_diag_attribute_add.F90 check_new_file_freq_SOURCES = check_new_file_freq.F90 test_zbounds_limits_SOURCES = test_zbounds_limits.F90 test_multiple_zbounds_SOURCES = test_multiple_zbounds.F90 +test_generalized_indicies_SOURCES = testing_utils.F90 test_generalized_indicies.F90 +check_generalized_indices_SOURCES = testing_utils.F90 check_generalized_indices.F90 TEST_EXTENSIONS = .sh SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ diff --git a/test_fms/diag_manager/check_generalized_indices.F90 b/test_fms/diag_manager/check_generalized_indices.F90 new file mode 100644 index 0000000000..70e935e07e --- /dev/null +++ b/test_fms/diag_manager/check_generalized_indices.F90 @@ -0,0 +1,133 @@ +!*********************************************************************** +!* Apache License 2.0 +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* Licensed under the Apache License, Version 2.0 (the "License"); +!* you may not use this file except in compliance with the License. +!* You may obtain a copy of the License at +!* +!* http://www.apache.org/licenses/LICENSE-2.0 +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied; +!* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A +!* PARTICULAR PURPOSE. See the License for the specific language +!* governing permissions and limitations under the License. +!*********************************************************************** + +!> @brief Checker for test_generalized_indicies output. +!! Verifies swapped-axis variables match identity variables under transpose: +!! var2_id(x,y) == var2_swap(y,x) +!! var3_id(x,y,z) == var3_swap(y,x,z) +program check_generalized_indices + use fms_mod, only: fms_init, fms_end, string + use fms2_io_mod, only: FmsNetcdfFile_t, read_data, open_file, close_file, get_global_attribute + use mpp_mod, only: mpp_error, FATAL, mpp_pe + use platform_mod, only: r4_kind + + implicit none + + type(FmsNetcdfFile_t) :: fileobj + integer :: nx, ny, nz + integer :: i + + real(kind=r4_kind), allocatable :: var2_id(:,:) ! (x,y) + real(kind=r4_kind), allocatable :: var2_swap(:,:) ! (y,x) + real(kind=r4_kind), allocatable :: var3_id(:,:,:) ! (x,y,z) + real(kind=r4_kind), allocatable :: var3_swap(:,:,:) ! (y,x,z) + + call fms_init() + + nx = 96 + ny = 96 + nz = 5 + + if (.not. open_file(fileobj, "test_gen.nc", "read")) & + call mpp_error(FATAL, "unable to open test_gen.nc") + + call check_global_attribute(fileobj, "test_generalized_indices") + + allocate(var2_id(nx,ny), var2_swap(ny,nx)) + allocate(var3_id(nx,ny,nz), var3_swap(ny,nx,nz)) + + ! Output every 6 hours over 48 hours => 8 records + do i = 1, 8 + var2_id = -999._r4_kind + var2_swap = -999._r4_kind + var3_id = -999._r4_kind + var3_swap = -999._r4_kind + + print *, "Checking var2_swap vs var2_id - time_level:", string(i) + call read_data(fileobj, "var2_id", var2_id, unlim_dim_level=i) + call read_data(fileobj, "var2_swap", var2_swap, unlim_dim_level=i) + call check_var2_relation(var2_id, var2_swap) + + print *, "Checking var3_swap vs var3_id - time_level:", string(i) + call read_data(fileobj, "var3_id", var3_id, unlim_dim_level=i) + call read_data(fileobj, "var3_swap", var3_swap, unlim_dim_level=i) + call check_var3_relation(var3_id, var3_swap) + enddo + + call close_file(fileobj) + call fms_end() + +contains + + subroutine check_global_attribute(fileobj, expected_title) + type(FmsNetcdfFile_t), intent(in) :: fileobj + character(len=*), intent(in) :: expected_title + + character(len=100) :: attribute_value + + call get_global_attribute(fileobj, "title", attribute_value) + if (trim(attribute_value) .ne. trim(expected_title)) then + call mpp_error(FATAL, "Global attribute 'title' not expected value.") + endif + end subroutine check_global_attribute + + subroutine check_var2_relation(v_id, v_sw) + real(kind=r4_kind), intent(in) :: v_id(:,:) ! (x,y) + real(kind=r4_kind), intent(in) :: v_sw(:,:) ! (y,x) + + integer :: x, y + + if (size(v_id,1) /= size(v_sw,2) .or. size(v_id,2) /= size(v_sw,1)) then + call mpp_error(FATAL, "check_var2_relation: dimension mismatch between var2_id and var2_swap") + endif + + do x = 1, size(v_id,1) + do y = 1, size(v_id,2) + if (abs(v_id(x,y) - v_sw(y,x)) > 0) then + print *, mpp_pe(), "var2 mismatch at (x,y)=", x, y, " id=", v_id(x,y), " swap(y,x)=", v_sw(y,x) + call mpp_error(FATAL, "check_var2_relation: var2_swap != transpose(var2_id)") + endif + enddo + enddo + end subroutine check_var2_relation + + subroutine check_var3_relation(v_id, v_sw) + real(kind=r4_kind), intent(in) :: v_id(:,:,:) ! (x,y,z) + real(kind=r4_kind), intent(in) :: v_sw(:,:,:) ! (y,x,z) + + integer :: x, y, z + + if (size(v_id,1) /= size(v_sw,2) .or. size(v_id,2) /= size(v_sw,1) .or. size(v_id,3) /= size(v_sw,3)) then + call mpp_error(FATAL, "check_var3_relation: dimension mismatch between var3_id and var3_swap") + endif + + do x = 1, size(v_id,1) + do y = 1, size(v_id,2) + do z = 1, size(v_id,3) + if (abs(v_id(x,y,z) - v_sw(y,x,z)) > 0) then + print *, mpp_pe(), "var3 mismatch at (x,y,z)=", x, y, z, & + " id=", v_id(x,y,z), " swap(y,x,z)=", v_sw(y,x,z) + call mpp_error(FATAL, "check_var3_relation: var3_swap != var3_id with x/y swapped") + endif + enddo + enddo + enddo + end subroutine check_var3_relation + +end program check_generalized_indices + diff --git a/test_fms/diag_manager/test_generalized_indicies.F90 b/test_fms/diag_manager/test_generalized_indicies.F90 new file mode 100644 index 0000000000..a8af882fd5 --- /dev/null +++ b/test_fms/diag_manager/test_generalized_indicies.F90 @@ -0,0 +1,228 @@ +!*********************************************************************** +!* Apache License 2.0 +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* Licensed under the Apache License, Version 2.0 (the "License"); +!* you may not use this file except in compliance with the License. +!* You may obtain a copy of the License at +!* +!* http://www.apache.org/licenses/LICENSE-2.0 +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied; +!* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A +!* PARTICULAR PURPOSE. See the License for the specific language +!* governing permissions and limitations under the License. +!*********************************************************************** + +!> @brief Test generalized axis permutations (x/y for now) for send_data +!! Assumes default configuration parameters: test_normal + no_mask. +program test_generalized_indices + use fms_mod, only: fms_init, fms_end + use testing_utils, only: allocate_buffer + use platform_mod, only: r8_kind + use mpp_mod, only: FATAL, mpp_error, mpp_npes, mpp_pe, mpp_root_pe + use time_manager_mod, only: time_type, set_calendar_type, set_date, JULIAN, set_time, OPERATOR(+) + use diag_manager_mod, only: diag_manager_init, diag_manager_end, diag_axis_init, register_diag_field, & + diag_send_complete, diag_manager_set_time_end, send_data + use mpp_domains_mod, only: domain2d, mpp_define_domains, mpp_define_io_domain, mpp_get_compute_domain + + implicit none + + integer :: nx, ny, nz, nw + integer :: layout(2), io_layout(2) + type(domain2d) :: Domain + integer :: isc, iec, jsc, jec + integer :: nhalox, nhaloy + integer :: ntimes, i + type(time_type) :: Time, Time_step + real(r8_kind) :: missing_value + + ! Axes + integer :: id_x, id_y, id_z, id_w + integer :: axis(4) + + ! Data + real(r8_kind), allocatable :: cdata(:,:,:,:) ! canonical storage: (x,y,z,w) + + ! Permutation test + integer :: p_id(3), p_swap(3) + integer :: id_var2_id, id_var2_swap + integer :: id_var3_id, id_var3_swap + + call fms_init + call set_calendar_type(JULIAN) + call diag_manager_init + + Time = set_date(2,1,1,0,0,0) + Time_step = set_time(3600,0) ! 1 hour + + nx = 96 + ny = 96 + nz = 5 + nw = 2 + ntimes = 48 + + nhalox = 2 + nhaloy = 2 + layout = (/1, mpp_npes()/) + io_layout = (/1, 1/) + + ! Domain + call mpp_define_domains((/1,nx,1,ny/), layout, Domain, name='2D domain', symmetry=.true., & + xhalo=nhalox, yhalo=nhaloy) + call mpp_define_io_domain(Domain, io_layout) + call mpp_get_compute_domain(Domain, isc, iec, jsc, jec) + + ! Data allocation + init (canonical x,y storage) + cdata = allocate_buffer(isc, iec, jsc, jec, nz, nw) + call init_buffer(cdata, isc, iec, jsc, jec, 0) + + ! Axes + id_x = diag_axis_init('x', real((/(i, i=1,nx)/), kind=r8_kind), 'point_E', 'x', long_name='point_E', Domain2=Domain) + id_y = diag_axis_init('y', real((/(i, i=1,ny)/), kind=r8_kind), 'point_N', 'y', long_name='point_N', Domain2=Domain) + id_z = diag_axis_init('z', real((/(i, i=1,nz)/), kind=r8_kind), 'point_Z', 'z', long_name='point_Z') + id_w = diag_axis_init('w', real((/(i, i=1,nw)/), kind=r8_kind), 'point_W', 'n', long_name='point_W') + axis = [id_x, id_y, id_z, id_w] + + missing_value = -666._r8_kind + + ! Define permutations: identity (x,y,z) and swap (y,x,z) + p_id = [1,2,3] + p_swap = [2,1,3] + + ! Register permuted diagnostic fields ONCE + id_var2_id = register_diag_field('ocn_mod', 'var2_id', (/axis(p_id(1)), axis(p_id(2))/), Time, 'Var2d id', & + 'mullions', missing_value=missing_value) + id_var2_swap = register_diag_field('ocn_mod', 'var2_swap', (/axis(p_swap(1)), axis(p_swap(2))/), Time, 'Var2d swap', & + 'mullions', missing_value=missing_value) + + id_var3_id = register_diag_field('ocn_mod', 'var3_id', (/axis(p_id(1)), axis(p_id(2)), axis(p_id(3))/), Time, & + 'Var3d id', 'mullions', missing_value=missing_value) + id_var3_swap = register_diag_field('ocn_mod', 'var3_swap', (/axis(p_swap(1)), axis(p_swap(2)), axis(p_swap(3))/), Time, & + 'Var3d swap', 'mullions', missing_value=missing_value) + + if (mpp_pe() == mpp_root_pe()) then + print *, "Testing generalized indices in default mode (test_normal + no_mask)" + print *, " canonical storage is (x,y,z,w)" + print *, " sending:" + print *, " var2_id with axes (x,y)" + print *, " var2_swap with axes (y,x)" + print *, " var3_id with axes (x,y,z)" + print *, " var3_swap with axes (y,x,z)" + end if + + call diag_manager_set_time_end(set_date(2,1,3,0,0,0)) + + do i = 1, ntimes + Time = Time + Time_step + call set_buffer(cdata, i) + + ! Identity: axes (x,y) / (x,y,z) with canonical storage + call send_var2_perm(id_var2_id, cdata, p_id, Time) + call send_var3_perm(id_var3_id, cdata, p_id, Time) + + ! Swap: axes (y,x) / (y,x,z) while canonical storage remains (x,y,...) -> pack to temp and send + call send_var2_perm(id_var2_swap, cdata, p_swap, Time) + call send_var3_perm(id_var3_swap, cdata, p_swap, Time) + + call diag_send_complete(Time_step) + call diag_send_complete(Time_step) + end do + + call diag_manager_end(Time) + call fms_end + +contains + + subroutine send_var2_perm(id_field, buf, p, Time_in) + integer, intent(in) :: id_field + real(r8_kind), intent(in) :: buf(:,:,:,:) ! canonical (x,y,z,w) + integer, intent(in) :: p(3) + type(time_type), intent(in) :: Time_in + + logical :: used_local + real(r8_kind), allocatable :: tmp2(:,:) + + ! Support only identity (1,2,*) and xy-swap (2,1,*) for 2D + if (p(1)==1 .and. p(2)==2) then + used_local = send_data(id_field, buf(:,:,1,1), Time_in) + else if (p(1)==2 .and. p(2)==1) then + allocate(tmp2(size(buf,2), size(buf,1))) + tmp2 = transpose(buf(:,:,1,1)) + used_local = send_data(id_field, tmp2, Time_in) + deallocate(tmp2) + else + call mpp_error(FATAL, 'send_var2_perm: only p=(1,2,*) or (2,1,*) implemented') + end if + end subroutine send_var2_perm + + + subroutine send_var3_perm(id_field, buf, p, Time_in) + integer, intent(in) :: id_field + real(r8_kind), intent(in) :: buf(:,:,:,:) ! canonical (x,y,z,w) + integer, intent(in) :: p(3) + type(time_type), intent(in) :: Time_in + + logical :: used_local + integer :: nxloc, nyloc, nzloc, k + real(r8_kind), allocatable :: tmp3(:,:,:) + + ! For now, support only keeping z as z + if (p(3) /= 3) call mpp_error(FATAL, 'send_var3_perm: only permutations with p(3)=3 implemented') + + if (p(1)==1 .and. p(2)==2) then + used_local = send_data(id_field, buf(:,:,:,1), Time_in) + + else if (p(1)==2 .and. p(2)==1) then + nxloc = size(buf,1) + nyloc = size(buf,2) + nzloc = size(buf,3) + + allocate(tmp3(nyloc, nxloc, nzloc)) + do k = 1, nzloc + tmp3(:,:,k) = transpose(buf(:,:,k,1)) + end do + + used_local = send_data(id_field, tmp3, Time_in) + deallocate(tmp3) + + else + call mpp_error(FATAL, 'send_var3_perm: only p=(1,2,3) or (2,1,3) implemented') + end if + end subroutine send_var3_perm + + + !> @brief initialized the buffer based on the starting/ending indices + subroutine init_buffer(buffer, is, ie, js, je, nhalo) + real(r8_kind), intent(inout) :: buffer(:,:,:,:) + integer, intent(in) :: is, ie, js, je + integer, intent(in) :: nhalo + + integer :: ii, j, k, l + + do ii = is, ie + do j = js, je + do k = 1, size(buffer, 3) + do l = 1, size(buffer, 4) + buffer(ii-is+1+nhalo, j-js+1+nhalo, k, l) = real(ii, kind=r8_kind)*1000._r8_kind + & + real(j, kind=r8_kind)* 10._r8_kind + & + real(k, kind=r8_kind) + end do + end do + end do + end do + end subroutine init_buffer + + + !> @brief Set the buffer based on the time_index + subroutine set_buffer(buffer, time_index) + real(r8_kind), intent(inout) :: buffer(:,:,:,:) + integer, intent(in) :: time_index + + buffer = nint(buffer) + real(time_index, kind=r8_kind)/100._r8_kind + end subroutine set_buffer + +end program test_generalized_indices + diff --git a/test_fms/diag_manager/test_time_none.sh b/test_fms/diag_manager/test_time_none.sh index baa1c9954c..4c8484f9cc 100755 --- a/test_fms/diag_manager/test_time_none.sh +++ b/test_fms/diag_manager/test_time_none.sh @@ -27,6 +27,63 @@ if [ -z "${parser_skip}" ]; then # create and enter directory for in/output files output_dir +cat <<_EOF > diag_table.yaml +title: test_generalized_indices +base_date: 2 1 1 0 0 0 +diag_files: +- file_name: test_gen + freq: 6 hours + time_units: hours + unlimdim: time + varlist: + - module: ocn_mod + var_name: var2_id + output_name: var2_id + reduction: none + kind: r4 + - module: ocn_mod + var_name: var2_swap + output_name: var2_swap + reduction: none + kind: r4 + - module: ocn_mod + var_name: var3_id + output_name: var3_id + reduction: none + kind: r4 + - module: ocn_mod + var_name: var3_swap + output_name: var3_swap + reduction: none + kind: r4 + +- file_name: test_gen_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_id # or var3_swap, your choice + output_name: var3_id_regional + reduction: none + kind: r4 +_EOF + +touch 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 "Write and read domain-decomposed data with generalized indices" ' + mpirun -n 6 ../test_generalized_indicies +' +test_expect_success "Checking answers for the generalized indices" ' + mpirun -n 1 ../check_generalized_indices +' + cat <<_EOF > diag_table.yaml title: test_none base_date: 2 1 1 0 0 0 @@ -175,6 +232,8 @@ test_expect_success "Checking answers for the "none" reduction method with halo mpirun -n 1 ../check_time_none ' + + cat <<_EOF > diag_table.yaml title: test_none base_date: 2 1 1 0 0 0 From 082437b0c30de2b491a36838e36bd2f705f2410a Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 16 Apr 2026 13:44:27 -0400 Subject: [PATCH 02/19] fix line length --- test_fms/diag_manager/test_generalized_indicies.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test_fms/diag_manager/test_generalized_indicies.F90 b/test_fms/diag_manager/test_generalized_indicies.F90 index a8af882fd5..668c4521db 100644 --- a/test_fms/diag_manager/test_generalized_indicies.F90 +++ b/test_fms/diag_manager/test_generalized_indicies.F90 @@ -98,10 +98,10 @@ program test_generalized_indices id_var2_swap = register_diag_field('ocn_mod', 'var2_swap', (/axis(p_swap(1)), axis(p_swap(2))/), Time, 'Var2d swap', & 'mullions', missing_value=missing_value) - id_var3_id = register_diag_field('ocn_mod', 'var3_id', (/axis(p_id(1)), axis(p_id(2)), axis(p_id(3))/), Time, & - 'Var3d id', 'mullions', missing_value=missing_value) - id_var3_swap = register_diag_field('ocn_mod', 'var3_swap', (/axis(p_swap(1)), axis(p_swap(2)), axis(p_swap(3))/), Time, & - 'Var3d swap', 'mullions', missing_value=missing_value) + id_var3_id = register_diag_field('ocn_mod', 'var3_id', (/axis(p_id(1)), axis(p_id(2)), axis(p_id(3))/), & + Time, 'Var3d id', 'mullions', missing_value=missing_value) + id_var3_swap = register_diag_field('ocn_mod', 'var3_swap', (/axis(p_swap(1)), axis(p_swap(2)), axis(p_swap(3))/), & + Time, 'Var3d swap', 'mullions', missing_value=missing_value) if (mpp_pe() == mpp_root_pe()) then print *, "Testing generalized indices in default mode (test_normal + no_mask)" From 542014a53471df73e7d81fdd66b9efe6685f56da Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 16 Apr 2026 13:52:38 -0400 Subject: [PATCH 03/19] Remove trailing ws --- test_fms/diag_manager/test_generalized_indicies.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test_fms/diag_manager/test_generalized_indicies.F90 b/test_fms/diag_manager/test_generalized_indicies.F90 index 668c4521db..2303d59deb 100644 --- a/test_fms/diag_manager/test_generalized_indicies.F90 +++ b/test_fms/diag_manager/test_generalized_indicies.F90 @@ -98,7 +98,7 @@ program test_generalized_indices id_var2_swap = register_diag_field('ocn_mod', 'var2_swap', (/axis(p_swap(1)), axis(p_swap(2))/), Time, 'Var2d swap', & 'mullions', missing_value=missing_value) - id_var3_id = register_diag_field('ocn_mod', 'var3_id', (/axis(p_id(1)), axis(p_id(2)), axis(p_id(3))/), & + id_var3_id = register_diag_field('ocn_mod', 'var3_id', (/axis(p_id(1)), axis(p_id(2)), axis(p_id(3))/), & Time, 'Var3d id', 'mullions', missing_value=missing_value) id_var3_swap = register_diag_field('ocn_mod', 'var3_swap', (/axis(p_swap(1)), axis(p_swap(2)), axis(p_swap(3))/), & Time, 'Var3d swap', 'mullions', missing_value=missing_value) From fa77ebe7e17afe183c02f93997986fcd856f6dc1 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 16 Apr 2026 13:58:45 -0400 Subject: [PATCH 04/19] Remove trailing ws? --- test_fms/diag_manager/test_generalized_indicies.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test_fms/diag_manager/test_generalized_indicies.F90 b/test_fms/diag_manager/test_generalized_indicies.F90 index 2303d59deb..e6a15ade0f 100644 --- a/test_fms/diag_manager/test_generalized_indicies.F90 +++ b/test_fms/diag_manager/test_generalized_indicies.F90 @@ -98,7 +98,7 @@ program test_generalized_indices id_var2_swap = register_diag_field('ocn_mod', 'var2_swap', (/axis(p_swap(1)), axis(p_swap(2))/), Time, 'Var2d swap', & 'mullions', missing_value=missing_value) - id_var3_id = register_diag_field('ocn_mod', 'var3_id', (/axis(p_id(1)), axis(p_id(2)), axis(p_id(3))/), & + id_var3_id = register_diag_field('ocn_mod', 'var3_id', (/axis(p_id(1)), axis(p_id(2)), axis(p_id(3))/), & Time, 'Var3d id', 'mullions', missing_value=missing_value) id_var3_swap = register_diag_field('ocn_mod', 'var3_swap', (/axis(p_swap(1)), axis(p_swap(2)), axis(p_swap(3))/), & Time, 'Var3d swap', 'mullions', missing_value=missing_value) From 3b3aec8926043056f020512f547aac750d2eb9e3 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Fri, 24 Apr 2026 09:00:38 -0400 Subject: [PATCH 05/19] Add generalized axis permutation tests for diag_manager --- test_fms/diag_manager/Makefile.am | 4 +- .../check_generalized_indices.F90 | 106 ++++------- ...icies.F90 => test_generalized_indices.F90} | 178 ++++++++++-------- test_fms/diag_manager/test_time_none.sh | 41 ++-- test_fms/diag_manager/testing_utils.F90 | 120 +++++++++++- 5 files changed, 276 insertions(+), 173 deletions(-) rename test_fms/diag_manager/{test_generalized_indicies.F90 => test_generalized_indices.F90} (52%) diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am index 7b68392144..beab0dfec3 100644 --- a/test_fms/diag_manager/Makefile.am +++ b/test_fms/diag_manager/Makefile.am @@ -34,7 +34,7 @@ check_PROGRAMS = test_diag_manager test_diag_manager_time \ check_time_pow check_time_rms check_subregional test_cell_measures test_var_masks \ check_var_masks test_multiple_send_data test_diag_out_yaml test_output_every_freq \ test_dm_weights test_prepend_date test_ens_runs test_diag_multi_file test_diag_attribute_add \ - check_new_file_freq test_zbounds_limits test_multiple_zbounds test_generalized_indicies check_generalized_indices + check_new_file_freq test_zbounds_limits test_multiple_zbounds test_generalized_indices check_generalized_indices # This is the source code for the test. test_output_every_freq_SOURCES = test_output_every_freq.F90 @@ -71,7 +71,7 @@ test_diag_attribute_add_SOURCES = test_diag_attribute_add.F90 check_new_file_freq_SOURCES = check_new_file_freq.F90 test_zbounds_limits_SOURCES = test_zbounds_limits.F90 test_multiple_zbounds_SOURCES = test_multiple_zbounds.F90 -test_generalized_indicies_SOURCES = testing_utils.F90 test_generalized_indicies.F90 +test_generalized_indices_SOURCES = testing_utils.F90 test_generalized_indices.F90 check_generalized_indices_SOURCES = testing_utils.F90 check_generalized_indices.F90 TEST_EXTENSIONS = .sh diff --git a/test_fms/diag_manager/check_generalized_indices.F90 b/test_fms/diag_manager/check_generalized_indices.F90 index 70e935e07e..28d2ddc27f 100644 --- a/test_fms/diag_manager/check_generalized_indices.F90 +++ b/test_fms/diag_manager/check_generalized_indices.F90 @@ -16,15 +16,14 @@ !* governing permissions and limitations under the License. !*********************************************************************** -!> @brief Checker for test_generalized_indicies output. -!! Verifies swapped-axis variables match identity variables under transpose: -!! var2_id(x,y) == var2_swap(y,x) -!! var3_id(x,y,z) == var3_swap(y,x,z) +!> @brief Checker for test_generalized_indices output. +!! Verifies permuted-axis variables match identity variables under axis permutations program check_generalized_indices use fms_mod, only: fms_init, fms_end, string + use testing_utils, only: check_perm use fms2_io_mod, only: FmsNetcdfFile_t, read_data, open_file, close_file, get_global_attribute use mpp_mod, only: mpp_error, FATAL, mpp_pe - use platform_mod, only: r4_kind + use platform_mod, only: r8_kind implicit none @@ -32,10 +31,12 @@ program check_generalized_indices integer :: nx, ny, nz integer :: i - real(kind=r4_kind), allocatable :: var2_id(:,:) ! (x,y) - real(kind=r4_kind), allocatable :: var2_swap(:,:) ! (y,x) - real(kind=r4_kind), allocatable :: var3_id(:,:,:) ! (x,y,z) - real(kind=r4_kind), allocatable :: var3_swap(:,:,:) ! (y,x,z) + real(kind=r8_kind), allocatable :: var2_id(:,:) ! (x,y) + real(kind=r8_kind), allocatable :: var2_yx(:,:) ! (y,x) + real(kind=r8_kind), allocatable :: var3_id(:,:,:) ! (x,y,z) + real(kind=r8_kind), allocatable :: var3_zx(:,:,:) ! (z,y,x) + real(kind=r8_kind), allocatable :: var3_yzx(:,:,:) ! (y,z,x) + real(kind=r8_kind), allocatable :: var3_zxy(:,:,:) ! (z,x,y) call fms_init() @@ -48,25 +49,35 @@ program check_generalized_indices call check_global_attribute(fileobj, "test_generalized_indices") - allocate(var2_id(nx,ny), var2_swap(ny,nx)) - allocate(var3_id(nx,ny,nz), var3_swap(ny,nx,nz)) + allocate(var2_id(nx,ny), var2_yx(ny,nx)) + allocate(var3_id(nx,ny,nz), var3_zx(nz,ny,nx), var3_yzx(ny,nz,nx), var3_zxy(nz,nx,ny)) ! Output every 6 hours over 48 hours => 8 records do i = 1, 8 - var2_id = -999._r4_kind - var2_swap = -999._r4_kind - var3_id = -999._r4_kind - var3_swap = -999._r4_kind - - print *, "Checking var2_swap vs var2_id - time_level:", string(i) - call read_data(fileobj, "var2_id", var2_id, unlim_dim_level=i) - call read_data(fileobj, "var2_swap", var2_swap, unlim_dim_level=i) - call check_var2_relation(var2_id, var2_swap) - - print *, "Checking var3_swap vs var3_id - time_level:", string(i) - call read_data(fileobj, "var3_id", var3_id, unlim_dim_level=i) - call read_data(fileobj, "var3_swap", var3_swap, unlim_dim_level=i) - call check_var3_relation(var3_id, var3_swap) + var2_id = -999._r8_kind + var2_yx = -999._r8_kind + var3_id = -999._r8_kind + var3_zx = -999._r8_kind + var3_yzx = -999._r8_kind + var3_zxy = -999._r8_kind + + print *, "Checking var2_yx vs var2_id - time_level:", i + call read_data(fileobj, "var2_id", var2_id, unlim_dim_level=i) + call read_data(fileobj, "var2_yx", var2_yx, unlim_dim_level=i) + call check_perm(var2_id, var2_yx, [2,1]) + + print *, "Checking var3_zx vs var3_id - time_level:", i + call read_data(fileobj, "var3_id", var3_id, unlim_dim_level=i) + call read_data(fileobj, "var3_zx", var3_zx, unlim_dim_level=i) + call check_perm(var3_id, var3_zx, [3,2,1]) + + print *, "Checking var3_yzx vs var3_id - time_level:", i + call read_data(fileobj, "var3_yzx", var3_yzx, unlim_dim_level=i) + call check_perm(var3_id, var3_yzx, [2,3,1]) + + print *, "Checking var3_zxy vs var3_id - time_level:", i + call read_data(fileobj, "var3_zxy", var3_zxy, unlim_dim_level=i) + call check_perm(var3_id, var3_zxy, [3,1,2]) enddo call close_file(fileobj) @@ -85,49 +96,4 @@ subroutine check_global_attribute(fileobj, expected_title) call mpp_error(FATAL, "Global attribute 'title' not expected value.") endif end subroutine check_global_attribute - - subroutine check_var2_relation(v_id, v_sw) - real(kind=r4_kind), intent(in) :: v_id(:,:) ! (x,y) - real(kind=r4_kind), intent(in) :: v_sw(:,:) ! (y,x) - - integer :: x, y - - if (size(v_id,1) /= size(v_sw,2) .or. size(v_id,2) /= size(v_sw,1)) then - call mpp_error(FATAL, "check_var2_relation: dimension mismatch between var2_id and var2_swap") - endif - - do x = 1, size(v_id,1) - do y = 1, size(v_id,2) - if (abs(v_id(x,y) - v_sw(y,x)) > 0) then - print *, mpp_pe(), "var2 mismatch at (x,y)=", x, y, " id=", v_id(x,y), " swap(y,x)=", v_sw(y,x) - call mpp_error(FATAL, "check_var2_relation: var2_swap != transpose(var2_id)") - endif - enddo - enddo - end subroutine check_var2_relation - - subroutine check_var3_relation(v_id, v_sw) - real(kind=r4_kind), intent(in) :: v_id(:,:,:) ! (x,y,z) - real(kind=r4_kind), intent(in) :: v_sw(:,:,:) ! (y,x,z) - - integer :: x, y, z - - if (size(v_id,1) /= size(v_sw,2) .or. size(v_id,2) /= size(v_sw,1) .or. size(v_id,3) /= size(v_sw,3)) then - call mpp_error(FATAL, "check_var3_relation: dimension mismatch between var3_id and var3_swap") - endif - - do x = 1, size(v_id,1) - do y = 1, size(v_id,2) - do z = 1, size(v_id,3) - if (abs(v_id(x,y,z) - v_sw(y,x,z)) > 0) then - print *, mpp_pe(), "var3 mismatch at (x,y,z)=", x, y, z, & - " id=", v_id(x,y,z), " swap(y,x,z)=", v_sw(y,x,z) - call mpp_error(FATAL, "check_var3_relation: var3_swap != var3_id with x/y swapped") - endif - enddo - enddo - enddo - end subroutine check_var3_relation - end program check_generalized_indices - diff --git a/test_fms/diag_manager/test_generalized_indicies.F90 b/test_fms/diag_manager/test_generalized_indices.F90 similarity index 52% rename from test_fms/diag_manager/test_generalized_indicies.F90 rename to test_fms/diag_manager/test_generalized_indices.F90 index e6a15ade0f..fffb97b10c 100644 --- a/test_fms/diag_manager/test_generalized_indicies.F90 +++ b/test_fms/diag_manager/test_generalized_indices.F90 @@ -16,11 +16,13 @@ !* governing permissions and limitations under the License. !*********************************************************************** -!> @brief Test generalized axis permutations (x/y for now) for send_data +!> @brief Test generalized axis permutations for send_data. +!! Applies predefined permutations to canonical (x,y,z,w) storage +!! and verifies consistency between data layout and axis metadata. !! Assumes default configuration parameters: test_normal + no_mask. program test_generalized_indices use fms_mod, only: fms_init, fms_end - use testing_utils, only: allocate_buffer + use testing_utils, only: allocate_buffer, permute use platform_mod, only: r8_kind use mpp_mod, only: FATAL, mpp_error, mpp_npes, mpp_pe, mpp_root_pe use time_manager_mod, only: time_type, set_calendar_type, set_date, JULIAN, set_time, OPERATOR(+) @@ -47,9 +49,21 @@ program test_generalized_indices real(r8_kind), allocatable :: cdata(:,:,:,:) ! canonical storage: (x,y,z,w) ! Permutation test - integer :: p_id(3), p_swap(3) - integer :: id_var2_id, id_var2_swap - integer :: id_var3_id, id_var3_swap + integer, parameter :: LAYOUT_XY = 1 + integer, parameter :: LAYOUT_YX = 2 + integer, parameter :: LAYOUT_ZX = 3 + integer, parameter :: LAYOUT_YZX = 4 + integer, parameter :: LAYOUT_ZXY = 5 + integer, parameter :: PERM_TABLE(3,5) = reshape([ & + 1,2,3, & ! XY (identity) + 2,1,3, & ! YX + 3,2,1, & ! ZX + 2,3,1, & ! YZX + 3,1,2 & ! ZXY + ], [3,5]) + + integer :: id_var2_id, id_var2_yx + integer :: id_var3_id, id_var3_zx, id_var3_yzx, id_var3_zxy call fms_init call set_calendar_type(JULIAN) @@ -88,29 +102,26 @@ program test_generalized_indices missing_value = -666._r8_kind - ! Define permutations: identity (x,y,z) and swap (y,x,z) - p_id = [1,2,3] - p_swap = [2,1,3] - ! Register permuted diagnostic fields ONCE - id_var2_id = register_diag_field('ocn_mod', 'var2_id', (/axis(p_id(1)), axis(p_id(2))/), Time, 'Var2d id', & - 'mullions', missing_value=missing_value) - id_var2_swap = register_diag_field('ocn_mod', 'var2_swap', (/axis(p_swap(1)), axis(p_swap(2))/), Time, 'Var2d swap', & - 'mullions', missing_value=missing_value) + id_var2_id = register_perm_diag_field('var2_id', 'Var2d id', axis(1:2), LAYOUT_XY) + id_var3_id = register_perm_diag_field('var3_id', 'Var3d id', axis(1:3), LAYOUT_XY) + + id_var2_yx = register_perm_diag_field('var2_yx', 'Var2d yx', axis(1:2), LAYOUT_YX) + id_var3_zx = register_perm_diag_field('var3_zx', 'Var3d zx', axis(1:3), LAYOUT_ZX) - id_var3_id = register_diag_field('ocn_mod', 'var3_id', (/axis(p_id(1)), axis(p_id(2)), axis(p_id(3))/), & - Time, 'Var3d id', 'mullions', missing_value=missing_value) - id_var3_swap = register_diag_field('ocn_mod', 'var3_swap', (/axis(p_swap(1)), axis(p_swap(2)), axis(p_swap(3))/), & - Time, 'Var3d swap', 'mullions', missing_value=missing_value) + id_var3_yzx = register_perm_diag_field('var3_yzx', 'Var3d yzx', axis(1:3), LAYOUT_YZX) + id_var3_zxy = register_perm_diag_field('var3_zxy', 'Var3d zxy', axis(1:3), LAYOUT_ZXY) if (mpp_pe() == mpp_root_pe()) then print *, "Testing generalized indices in default mode (test_normal + no_mask)" print *, " canonical storage is (x,y,z,w)" print *, " sending:" - print *, " var2_id with axes (x,y)" - print *, " var2_swap with axes (y,x)" - print *, " var3_id with axes (x,y,z)" - print *, " var3_swap with axes (y,x,z)" + print *, " var2_id with axes (x,y)" + print *, " var2_yx with axes (y,x)" + print *, " var3_id with axes (x,y,z)" + print *, " var3_zx with axes (z,y,x)" + print *, " var3_yzx with axes (y,z,x)" + print *, " var3_zxy with axes (z,x,y)" end if call diag_manager_set_time_end(set_date(2,1,3,0,0,0)) @@ -120,12 +131,16 @@ program test_generalized_indices call set_buffer(cdata, i) ! Identity: axes (x,y) / (x,y,z) with canonical storage - call send_var2_perm(id_var2_id, cdata, p_id, Time) - call send_var3_perm(id_var3_id, cdata, p_id, Time) + call send_perm_data(id_var2_id, cdata, PERM_TABLE(1:2, LAYOUT_XY), Time) + call send_perm_data(id_var3_id, cdata, PERM_TABLE(1:3, LAYOUT_XY), Time) + + ! Swap: axes (y,x) / (z,y,x) while canonical storage remains (x,y,...) -> pack to temp and send + call send_perm_data(id_var2_yx, cdata, PERM_TABLE(1:2, LAYOUT_YX), Time) + call send_perm_data(id_var3_zx, cdata, PERM_TABLE(1:3, LAYOUT_ZX), Time) - ! Swap: axes (y,x) / (y,x,z) while canonical storage remains (x,y,...) -> pack to temp and send - call send_var2_perm(id_var2_swap, cdata, p_swap, Time) - call send_var3_perm(id_var3_swap, cdata, p_swap, Time) + ! Cyclic: axes (y,z,x) / (z,x,y) while canonical storage remains (x, y, ...) -> pack to temp and send + call send_perm_data(id_var3_yzx, cdata, PERM_TABLE(1:3, LAYOUT_YZX), Time) + call send_perm_data(id_var3_zxy, cdata, PERM_TABLE(1:3, LAYOUT_ZXY), Time) call diag_send_complete(Time_step) call diag_send_complete(Time_step) @@ -136,63 +151,75 @@ program test_generalized_indices contains - subroutine send_var2_perm(id_field, buf, p, Time_in) - integer, intent(in) :: id_field - real(r8_kind), intent(in) :: buf(:,:,:,:) ! canonical (x,y,z,w) - integer, intent(in) :: p(3) - type(time_type), intent(in) :: Time_in - - logical :: used_local - real(r8_kind), allocatable :: tmp2(:,:) - - ! Support only identity (1,2,*) and xy-swap (2,1,*) for 2D - if (p(1)==1 .and. p(2)==2) then - used_local = send_data(id_field, buf(:,:,1,1), Time_in) - else if (p(1)==2 .and. p(2)==1) then - allocate(tmp2(size(buf,2), size(buf,1))) - tmp2 = transpose(buf(:,:,1,1)) - used_local = send_data(id_field, tmp2, Time_in) - deallocate(tmp2) - else - call mpp_error(FATAL, 'send_var2_perm: only p=(1,2,*) or (2,1,*) implemented') - end if - end subroutine send_var2_perm - - - subroutine send_var3_perm(id_field, buf, p, Time_in) + !> @brief Apply a predefined permutation to an axis array. + !> Maps canonical axis ordering to a permuted layout using PERM_TABLE. + !> Supports rank-2 and rank-3 axis subsets. + subroutine permute_axis(axis_in, perm_id, axis_out) + integer, intent(in) :: axis_in(:) + integer, intent(in) :: perm_id + integer, intent(out) :: axis_out(:) + + integer :: order(3) + + order = PERM_TABLE(:, perm_id) + + if (any(order(1:size(axis_out)) > size(axis_in))) then + call mpp_error(FATAL, "permute_axis: invalid permutation for given rank") + endif + + axis_out = axis_in(order(1:size(axis_out))) + end subroutine permute_axis + + !> @brief Register a diagnostic field with permuted axes. + !> Applies axis permutation before calling register_diag_field. + function register_perm_diag_field(var_name, long_name, axis, perm_id) result(id_var) + character(len=*), intent(in) :: var_name, long_name + integer, intent(in) :: axis(:) + integer, intent(in) :: perm_id + + integer :: id_var + integer, allocatable :: axis_perm(:) + + allocate(axis_perm(size(axis))) + call permute_axis(axis, perm_id, axis_perm) + id_var = register_diag_field('ocn_mod', var_name, axis_perm, Time, long_name, & + 'mullions', missing_value=missing_value) + deallocate(axis_perm) + end function register_perm_diag_field + + !> @brief Send data with optional axis permutation. + !> Applies 2D or 3D permutation to canonical (x,y,z,w) buffers before send_data. + !> Skips permutation for identity mappings. + subroutine send_perm_data(id_field, buf, order, Time_in) integer, intent(in) :: id_field real(r8_kind), intent(in) :: buf(:,:,:,:) ! canonical (x,y,z,w) - integer, intent(in) :: p(3) + integer, intent(in) :: order(:) type(time_type), intent(in) :: Time_in logical :: used_local - integer :: nxloc, nyloc, nzloc, k - real(r8_kind), allocatable :: tmp3(:,:,:) - - ! For now, support only keeping z as z - if (p(3) /= 3) call mpp_error(FATAL, 'send_var3_perm: only permutations with p(3)=3 implemented') - - if (p(1)==1 .and. p(2)==2) then - used_local = send_data(id_field, buf(:,:,:,1), Time_in) - - else if (p(1)==2 .and. p(2)==1) then - nxloc = size(buf,1) - nyloc = size(buf,2) - nzloc = size(buf,3) - - allocate(tmp3(nyloc, nxloc, nzloc)) - do k = 1, nzloc - tmp3(:,:,k) = transpose(buf(:,:,k,1)) - end do - - used_local = send_data(id_field, tmp3, Time_in) - deallocate(tmp3) + real(r8_kind), allocatable :: tmp2(:,:), tmp3(:,:,:) + + if (size(order) == 2) then + if (all(order == [1,2])) then + used_local = send_data(id_field, buf(:,:,1,1), Time_in) + else + tmp2 = permute(buf(:,:,1,1), order) + used_local = send_data(id_field, tmp2, Time_in) + endif + + else if (size(order) == 3) then + if (all(order == [1,2,3])) then + used_local = send_data(id_field, buf(:,:,:,1), Time_in) + else + tmp3 = permute(buf(:,:,:,1), order) + used_local = send_data(id_field, tmp3, Time_in) + endif else - call mpp_error(FATAL, 'send_var3_perm: only p=(1,2,3) or (2,1,3) implemented') - end if - end subroutine send_var3_perm + call mpp_error(FATAL, "send_var_perm: unsupported permutation rank") + endif + end subroutine send_perm_data !> @brief initialized the buffer based on the starting/ending indices subroutine init_buffer(buffer, is, ie, js, je, nhalo) @@ -215,7 +242,6 @@ subroutine init_buffer(buffer, is, ie, js, je, nhalo) end do end subroutine init_buffer - !> @brief Set the buffer based on the time_index subroutine set_buffer(buffer, time_index) real(r8_kind), intent(inout) :: buffer(:,:,:,:) diff --git a/test_fms/diag_manager/test_time_none.sh b/test_fms/diag_manager/test_time_none.sh index 4c8484f9cc..23f762f0e8 100755 --- a/test_fms/diag_manager/test_time_none.sh +++ b/test_fms/diag_manager/test_time_none.sh @@ -40,45 +40,38 @@ diag_files: var_name: var2_id output_name: var2_id reduction: none - kind: r4 + kind: r8 - module: ocn_mod - var_name: var2_swap - output_name: var2_swap + var_name: var2_yx + output_name: var2_yx reduction: none - kind: r4 + kind: r8 - module: ocn_mod var_name: var3_id output_name: var3_id reduction: none - kind: r4 + kind: r8 - module: ocn_mod - var_name: var3_swap - output_name: var3_swap + var_name: var3_zx + output_name: var3_zx reduction: none - kind: r4 - -- file_name: test_gen_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: + kind: r8 - module: ocn_mod - var_name: var3_id # or var3_swap, your choice - output_name: var3_id_regional + var_name: var3_yzx + output_name: var3_yzx reduction: none - kind: r4 + kind: r8 + - module: ocn_mod + var_name: var3_zxy + output_name: var3_zxy + reduction: none + kind: r8 _EOF touch 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 "Write and read domain-decomposed data with generalized indices" ' - mpirun -n 6 ../test_generalized_indicies + mpirun -n 6 ../test_generalized_indices ' test_expect_success "Checking answers for the generalized indices" ' mpirun -n 1 ../check_generalized_indices diff --git a/test_fms/diag_manager/testing_utils.F90 b/test_fms/diag_manager/testing_utils.F90 index ba4616fa1f..c8ff2a3fc5 100644 --- a/test_fms/diag_manager/testing_utils.F90 +++ b/test_fms/diag_manager/testing_utils.F90 @@ -19,9 +19,10 @@ !> @brief Utilities used in multiple test module testing_utils use platform_mod, only: r8_kind + use mpp_mod, only: mpp_error, FATAL private - public :: allocate_buffer + public :: allocate_buffer, permute, check_perm public :: test_normal, test_openmp, test_halos public :: no_mask, logical_mask, real_mask @@ -32,6 +33,16 @@ module testing_utils integer, parameter :: logical_mask = 1 !< Using a logical mask integer, parameter :: real_mask = 2 !< Using a real mask + interface permute + module procedure permute_2d + module procedure permute_3d + end interface permute + + interface check_perm + module procedure check_perm_2d + module procedure check_perm_3d + end interface check_perm + contains !> @brief Allocate the output buffer based on the starting/ending indices @@ -49,4 +60,111 @@ function allocate_buffer(is, ie, js, je, k, l) & allocate(buffer(is:ie, js:je, 1:k, 1:l)) buffer = -999_r8_kind end function allocate_buffer + + !> @brief Apply a 2D axis permutation to an array. + !! @return permuted array with axes reordered according to order + function permute_2d(src, order) result(dst) + real(r8_kind), intent(in) :: src(:,:) + integer, intent(in) :: order(2) + real(r8_kind), allocatable :: dst(:,:) + + integer :: i, j + integer :: idx(2) + + allocate(dst(size(src,order(1)), size(src,order(2)))) + + do j = 1, size(src,2) + do i = 1, size(src,1) + idx = [i,j] + dst(idx(order(1)), idx(order(2))) = src(i,j) + end do + end do + end function permute_2d + + !> @brief Apply a 3D axis permutation to an array. + !! @return permuted array with axes reordered according to order + function permute_3d(src, order) result(dst) + real(r8_kind), intent(in) :: src(:,:,:) + integer, intent(in) :: order(3) + real(r8_kind), allocatable :: dst(:,:,:) + + integer :: i, j, k + integer :: idx(3) + + allocate(dst( size(src,order(1)), size(src,order(2)), size(src,order(3)) )) + + do k = 1, size(src,3) + do j = 1, size(src,2) + do i = 1, size(src,1) + idx = [i,j,k] + dst(idx(order(1)), idx(order(2)), idx(order(3))) = src(i,j,k) + enddo + enddo + enddo + end function permute_3d + + !> @brief Verify correctness of a 2D axis permutation. + !! Aborts if shape or values do not match expected permutation. + subroutine check_perm_2d(var, var_perm, order) + real(kind=r8_kind), intent(in) :: var(:,:) ! canonical (x,y) + real(kind=r8_kind), intent(in) :: var_perm(:,:) ! permuted + integer, intent(in) :: order(2) + + integer :: i, j + integer :: idx(2) + + ! Check shape consistency + if ( size(var,order(1)) /= size(var_perm,1) .or. & + size(var,order(2)) /= size(var_perm,2) ) then + call mpp_error(FATAL, "check_perm_2d: dimension mismatch") + endif + + do j = 1, size(var,2) + do i = 1, size(var,1) + idx = [i,j] + + if (abs(var(i,j) - var_perm(idx(order(1)), idx(order(2)))) > 0) then + print *, "perm mismatch at (x,y)=", i, j, "order=", order, & + " var =", var(i,j), & + " perm =", var_perm(idx(order(1)), idx(order(2))) + call mpp_error(FATAL, "check_perm_2d failed") + endif + + end do + end do + end subroutine check_perm_2d + + !> @brief Verify correctness of a 3D axis permutation. + !! Aborts if shape or values do not match expected permutation. + subroutine check_perm_3d(var, var_perm, order) + real(kind=r8_kind), intent(in) :: var(:,:,:) ! canonical (x,y,z) + real(kind=r8_kind), intent(in) :: var_perm(:,:,:) ! permuted + integer, intent(in) :: order(3) + + integer :: i, j, k + integer :: idx(3) + + ! Check shape consistency + if ( size(var,order(1)) /= size(var_perm,1) .or. & + size(var,order(2)) /= size(var_perm,2) .or. & + size(var,order(3)) /= size(var_perm,3) ) then + call mpp_error(FATAL, "check_perm_3d: dimension mismatch") + endif + + do k = 1, size(var,3) + do j = 1, size(var,2) + do i = 1, size(var,1) + idx = [i,j,k] + + if (abs(var(i,j,k) - var_perm( idx(order(1)), idx(order(2)), idx(order(3)) )) > 0) then + + print *, "perm mismatch at (x,y,z)=", i, j, k, "order=", order, & + " var =", var(i,j,k), & + " perm =", var_perm(idx(order(1)), idx(order(2)), idx(order(3))) + call mpp_error(FATAL, "check_perm_3d failed") + endif + enddo + enddo + enddo + end subroutine check_perm_3d end module From 9173b41c5c98a057885fa2044a9526c68495f23b Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 4 Jun 2026 09:05:31 -0400 Subject: [PATCH 06/19] Test removing circular module dependency --- test_fms/diag_manager/testing_utils.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/test_fms/diag_manager/testing_utils.F90 b/test_fms/diag_manager/testing_utils.F90 index c8ff2a3fc5..f7779ca5b3 100644 --- a/test_fms/diag_manager/testing_utils.F90 +++ b/test_fms/diag_manager/testing_utils.F90 @@ -19,7 +19,7 @@ !> @brief Utilities used in multiple test module testing_utils use platform_mod, only: r8_kind - use mpp_mod, only: mpp_error, FATAL + !use mpp_mod, only: mpp_error, FATAL private public :: allocate_buffer, permute, check_perm @@ -116,7 +116,7 @@ subroutine check_perm_2d(var, var_perm, order) ! Check shape consistency if ( size(var,order(1)) /= size(var_perm,1) .or. & size(var,order(2)) /= size(var_perm,2) ) then - call mpp_error(FATAL, "check_perm_2d: dimension mismatch") + !call mpp_error(FATAL, "check_perm_2d: dimension mismatch") endif do j = 1, size(var,2) @@ -127,7 +127,7 @@ subroutine check_perm_2d(var, var_perm, order) print *, "perm mismatch at (x,y)=", i, j, "order=", order, & " var =", var(i,j), & " perm =", var_perm(idx(order(1)), idx(order(2))) - call mpp_error(FATAL, "check_perm_2d failed") + !call mpp_error(FATAL, "check_perm_2d failed") endif end do @@ -148,7 +148,7 @@ subroutine check_perm_3d(var, var_perm, order) if ( size(var,order(1)) /= size(var_perm,1) .or. & size(var,order(2)) /= size(var_perm,2) .or. & size(var,order(3)) /= size(var_perm,3) ) then - call mpp_error(FATAL, "check_perm_3d: dimension mismatch") + !call mpp_error(FATAL, "check_perm_3d: dimension mismatch") endif do k = 1, size(var,3) @@ -161,7 +161,7 @@ subroutine check_perm_3d(var, var_perm, order) print *, "perm mismatch at (x,y,z)=", i, j, k, "order=", order, & " var =", var(i,j,k), & " perm =", var_perm(idx(order(1)), idx(order(2)), idx(order(3))) - call mpp_error(FATAL, "check_perm_3d failed") + !call mpp_error(FATAL, "check_perm_3d failed") endif enddo enddo From 96070f7e8fb0796888620ab802a67ff6cc171e50 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 4 Jun 2026 11:22:43 -0400 Subject: [PATCH 07/19] remove mpp module dependence from testing_utils --- .../check_generalized_indices.F90 | 10 ++++----- .../diag_manager/test_generalized_indices.F90 | 1 + test_fms/diag_manager/testing_utils.F90 | 22 +++++++++++++------ 3 files changed, 21 insertions(+), 12 deletions(-) diff --git a/test_fms/diag_manager/check_generalized_indices.F90 b/test_fms/diag_manager/check_generalized_indices.F90 index 28d2ddc27f..4261d9665a 100644 --- a/test_fms/diag_manager/check_generalized_indices.F90 +++ b/test_fms/diag_manager/check_generalized_indices.F90 @@ -29,7 +29,7 @@ program check_generalized_indices type(FmsNetcdfFile_t) :: fileobj integer :: nx, ny, nz - integer :: i + integer :: i, ierr real(kind=r8_kind), allocatable :: var2_id(:,:) ! (x,y) real(kind=r8_kind), allocatable :: var2_yx(:,:) ! (y,x) @@ -64,20 +64,20 @@ program check_generalized_indices print *, "Checking var2_yx vs var2_id - time_level:", i call read_data(fileobj, "var2_id", var2_id, unlim_dim_level=i) call read_data(fileobj, "var2_yx", var2_yx, unlim_dim_level=i) - call check_perm(var2_id, var2_yx, [2,1]) + call check_perm(var2_id, var2_yx, [2,1], ierr) print *, "Checking var3_zx vs var3_id - time_level:", i call read_data(fileobj, "var3_id", var3_id, unlim_dim_level=i) call read_data(fileobj, "var3_zx", var3_zx, unlim_dim_level=i) - call check_perm(var3_id, var3_zx, [3,2,1]) + call check_perm(var3_id, var3_zx, [3,2,1], ierr) print *, "Checking var3_yzx vs var3_id - time_level:", i call read_data(fileobj, "var3_yzx", var3_yzx, unlim_dim_level=i) - call check_perm(var3_id, var3_yzx, [2,3,1]) + call check_perm(var3_id, var3_yzx, [2,3,1], ierr) print *, "Checking var3_zxy vs var3_id - time_level:", i call read_data(fileobj, "var3_zxy", var3_zxy, unlim_dim_level=i) - call check_perm(var3_id, var3_zxy, [3,1,2]) + call check_perm(var3_id, var3_zxy, [3,1,2], ierr) enddo call close_file(fileobj) diff --git a/test_fms/diag_manager/test_generalized_indices.F90 b/test_fms/diag_manager/test_generalized_indices.F90 index fffb97b10c..9d50a02879 100644 --- a/test_fms/diag_manager/test_generalized_indices.F90 +++ b/test_fms/diag_manager/test_generalized_indices.F90 @@ -40,6 +40,7 @@ program test_generalized_indices integer :: ntimes, i type(time_type) :: Time, Time_step real(r8_kind) :: missing_value + integer :: ierr ! Axes integer :: id_x, id_y, id_z, id_w diff --git a/test_fms/diag_manager/testing_utils.F90 b/test_fms/diag_manager/testing_utils.F90 index f7779ca5b3..5b9ab1330e 100644 --- a/test_fms/diag_manager/testing_utils.F90 +++ b/test_fms/diag_manager/testing_utils.F90 @@ -19,7 +19,7 @@ !> @brief Utilities used in multiple test module testing_utils use platform_mod, only: r8_kind - !use mpp_mod, only: mpp_error, FATAL + private public :: allocate_buffer, permute, check_perm @@ -105,18 +105,22 @@ end function permute_3d !> @brief Verify correctness of a 2D axis permutation. !! Aborts if shape or values do not match expected permutation. - subroutine check_perm_2d(var, var_perm, order) + subroutine check_perm_2d(var, var_perm, order, ierr) real(kind=r8_kind), intent(in) :: var(:,:) ! canonical (x,y) real(kind=r8_kind), intent(in) :: var_perm(:,:) ! permuted integer, intent(in) :: order(2) + integer, intent(out) :: ierr integer :: i, j integer :: idx(2) + ierr = 0 + ! Check shape consistency if ( size(var,order(1)) /= size(var_perm,1) .or. & size(var,order(2)) /= size(var_perm,2) ) then - !call mpp_error(FATAL, "check_perm_2d: dimension mismatch") + print *, "check_perm_2d: dimension mismatch" + ierr = 1 endif do j = 1, size(var,2) @@ -127,7 +131,7 @@ subroutine check_perm_2d(var, var_perm, order) print *, "perm mismatch at (x,y)=", i, j, "order=", order, & " var =", var(i,j), & " perm =", var_perm(idx(order(1)), idx(order(2))) - !call mpp_error(FATAL, "check_perm_2d failed") + ierr = 1 endif end do @@ -136,19 +140,23 @@ end subroutine check_perm_2d !> @brief Verify correctness of a 3D axis permutation. !! Aborts if shape or values do not match expected permutation. - subroutine check_perm_3d(var, var_perm, order) + subroutine check_perm_3d(var, var_perm, order, ierr) real(kind=r8_kind), intent(in) :: var(:,:,:) ! canonical (x,y,z) real(kind=r8_kind), intent(in) :: var_perm(:,:,:) ! permuted integer, intent(in) :: order(3) + integer, intent(out) :: ierr integer :: i, j, k integer :: idx(3) + ierr = 0 + ! Check shape consistency if ( size(var,order(1)) /= size(var_perm,1) .or. & size(var,order(2)) /= size(var_perm,2) .or. & size(var,order(3)) /= size(var_perm,3) ) then - !call mpp_error(FATAL, "check_perm_3d: dimension mismatch") + print *, "check_perm_3d: dimension mismatch" + ierr = 1 endif do k = 1, size(var,3) @@ -161,7 +169,7 @@ subroutine check_perm_3d(var, var_perm, order) print *, "perm mismatch at (x,y,z)=", i, j, k, "order=", order, & " var =", var(i,j,k), & " perm =", var_perm(idx(order(1)), idx(order(2)), idx(order(3))) - !call mpp_error(FATAL, "check_perm_3d failed") + ierr = 1 endif enddo enddo From 0f02818d2ef5289d2278a1cbdf489b43e5396a36 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Thu, 4 Jun 2026 11:50:47 -0400 Subject: [PATCH 08/19] test_fms/diag_manager/testing_utils.F90 --- test_fms/diag_manager/testing_utils.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test_fms/diag_manager/testing_utils.F90 b/test_fms/diag_manager/testing_utils.F90 index 5b9ab1330e..579c2f4596 100644 --- a/test_fms/diag_manager/testing_utils.F90 +++ b/test_fms/diag_manager/testing_utils.F90 @@ -109,7 +109,7 @@ subroutine check_perm_2d(var, var_perm, order, ierr) real(kind=r8_kind), intent(in) :: var(:,:) ! canonical (x,y) real(kind=r8_kind), intent(in) :: var_perm(:,:) ! permuted integer, intent(in) :: order(2) - integer, intent(out) :: ierr + integer, intent(out) :: ierr integer :: i, j integer :: idx(2) From a478bb302805e0078ee8d5aaf09795d9b876e0b7 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Mon, 8 Jun 2026 12:01:46 -0400 Subject: [PATCH 09/19] remove contiguous keyword in diag_send_data --- diag_manager/diag_manager.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index 40617ec19c..07fdc969a6 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -1683,7 +1683,7 @@ END FUNCTION send_data_3d LOGICAL FUNCTION diag_send_data(diag_field_id, field, time, is_in, js_in, ks_in, & & mask, rmask, ie_in, je_in, ke_in, weight, err_msg) INTEGER, INTENT(in) :: diag_field_id - CLASS(*), DIMENSION(:,:,:), INTENT(in),TARGET,CONTIGUOUS :: field + CLASS(*), DIMENSION(:,:,:), INTENT(in),TARGET :: field CLASS(*), INTENT(in), OPTIONAL :: weight TYPE (time_type), INTENT(in), OPTIONAL :: time INTEGER, INTENT(in), OPTIONAL :: is_in, js_in, ks_in,ie_in,je_in, ke_in From 4757961adf61e7c3b58d07f99ab79536de97e2d7 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Mon, 8 Jun 2026 12:10:58 -0400 Subject: [PATCH 10/19] remove all contiguous keyword in diag_send_data --- diag_manager/diag_manager.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/diag_manager/diag_manager.F90 b/diag_manager/diag_manager.F90 index 07fdc969a6..1594cc481e 100644 --- a/diag_manager/diag_manager.F90 +++ b/diag_manager/diag_manager.F90 @@ -1687,8 +1687,8 @@ LOGICAL FUNCTION diag_send_data(diag_field_id, field, time, is_in, js_in, ks_in, CLASS(*), INTENT(in), OPTIONAL :: weight TYPE (time_type), INTENT(in), OPTIONAL :: time INTEGER, INTENT(in), OPTIONAL :: is_in, js_in, ks_in,ie_in,je_in, ke_in - LOGICAL, DIMENSION(:,:,:), INTENT(in), OPTIONAL, contiguous, target :: mask - CLASS(*), DIMENSION(:,:,:), INTENT(in), OPTIONAL, contiguous, target :: rmask + LOGICAL, DIMENSION(:,:,:), INTENT(in), OPTIONAL, target :: mask + CLASS(*), DIMENSION(:,:,:), INTENT(in), OPTIONAL, target :: rmask CHARACTER(len=*), INTENT(out), OPTIONAL :: err_msg REAL :: weight1 From eee2b3c09d0f2d8cff9142539d3eb16a96039d91 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Mon, 8 Jun 2026 16:12:25 -0400 Subject: [PATCH 11/19] rename diag manager generalized indices unit tests --- CMakeLists.txt | 1 + test_fms/diag_manager/Makefile.am | 2 +- ...eneralized_indices.F90 => test_diag_generalized_indices.F90} | 0 3 files changed, 2 insertions(+), 1 deletion(-) rename test_fms/diag_manager/{test_generalized_indices.F90 => test_diag_generalized_indices.F90} (100%) diff --git a/CMakeLists.txt b/CMakeLists.txt index ad7564cc7b..fd345fc1e6 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -663,6 +663,7 @@ if(UNIT_TESTS) test_fms/diag_manager/test_flush_nc_file.F90 test_fms/diag_manager/test_diag_out_yaml.F90 test_fms/diag_manager/test_reduction_methods.F90 + test_fms/diag_manager/test_diag_generalized_indices.F90 test_fms/diag_manager/testing_utils.F90 test_fms/diag_manager/test_diag_diurnal.F90 test_fms/diag_manager/check_time_none.F90 diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am index beab0dfec3..4c196a8c68 100644 --- a/test_fms/diag_manager/Makefile.am +++ b/test_fms/diag_manager/Makefile.am @@ -71,7 +71,7 @@ test_diag_attribute_add_SOURCES = test_diag_attribute_add.F90 check_new_file_freq_SOURCES = check_new_file_freq.F90 test_zbounds_limits_SOURCES = test_zbounds_limits.F90 test_multiple_zbounds_SOURCES = test_multiple_zbounds.F90 -test_generalized_indices_SOURCES = testing_utils.F90 test_generalized_indices.F90 +test_generalized_indices_SOURCES = testing_utils.F90 test_diag_generalized_indices.F90 check_generalized_indices_SOURCES = testing_utils.F90 check_generalized_indices.F90 TEST_EXTENSIONS = .sh diff --git a/test_fms/diag_manager/test_generalized_indices.F90 b/test_fms/diag_manager/test_diag_generalized_indices.F90 similarity index 100% rename from test_fms/diag_manager/test_generalized_indices.F90 rename to test_fms/diag_manager/test_diag_generalized_indices.F90 From defe20b6311416335bf26dc7976f9d9d744ea9ae Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Tue, 9 Jun 2026 13:54:23 -0400 Subject: [PATCH 12/19] change test executable name --- test_fms/diag_manager/Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am index 4c196a8c68..8615762855 100644 --- a/test_fms/diag_manager/Makefile.am +++ b/test_fms/diag_manager/Makefile.am @@ -71,8 +71,8 @@ test_diag_attribute_add_SOURCES = test_diag_attribute_add.F90 check_new_file_freq_SOURCES = check_new_file_freq.F90 test_zbounds_limits_SOURCES = test_zbounds_limits.F90 test_multiple_zbounds_SOURCES = test_multiple_zbounds.F90 -test_generalized_indices_SOURCES = testing_utils.F90 test_diag_generalized_indices.F90 -check_generalized_indices_SOURCES = testing_utils.F90 check_generalized_indices.F90 +test_diag_generalized_indices_SOURCES = testing_utils.F90 test_diag_generalized_indices.F90 +check_diag_generalized_indices_SOURCES = testing_utils.F90 check_diag_generalized_indices.F90 TEST_EXTENSIONS = .sh SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ From aa3d046fcbba4f4eb340f5ac0282faa181441185 Mon Sep 17 00:00:00 2001 From: Andrew Brooks <139358099+abrooks1085@users.noreply.github.com> Date: Wed, 10 Jun 2026 11:00:22 -0400 Subject: [PATCH 13/19] Update test_fms/diag_manager/Makefile.am Co-authored-by: uramirez8707 <49168881+uramirez8707@users.noreply.github.com> --- test_fms/diag_manager/Makefile.am | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am index 8615762855..a0ca6427bc 100644 --- a/test_fms/diag_manager/Makefile.am +++ b/test_fms/diag_manager/Makefile.am @@ -34,7 +34,7 @@ check_PROGRAMS = test_diag_manager test_diag_manager_time \ check_time_pow check_time_rms check_subregional test_cell_measures test_var_masks \ check_var_masks test_multiple_send_data test_diag_out_yaml test_output_every_freq \ test_dm_weights test_prepend_date test_ens_runs test_diag_multi_file test_diag_attribute_add \ - check_new_file_freq test_zbounds_limits test_multiple_zbounds test_generalized_indices check_generalized_indices + check_new_file_freq test_zbounds_limits test_multiple_zbounds test_diag_generalized_indices check_diag_generalized_indices # This is the source code for the test. test_output_every_freq_SOURCES = test_output_every_freq.F90 From c2e7c4b2d9bf4fa8ddfd05ae403251f5951d2ff2 Mon Sep 17 00:00:00 2001 From: Andrew Brooks <139358099+abrooks1085@users.noreply.github.com> Date: Wed, 10 Jun 2026 11:00:42 -0400 Subject: [PATCH 14/19] Update test_fms/diag_manager/test_time_none.sh Co-authored-by: uramirez8707 <49168881+uramirez8707@users.noreply.github.com> --- test_fms/diag_manager/test_time_none.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test_fms/diag_manager/test_time_none.sh b/test_fms/diag_manager/test_time_none.sh index 23f762f0e8..7b75b386da 100755 --- a/test_fms/diag_manager/test_time_none.sh +++ b/test_fms/diag_manager/test_time_none.sh @@ -71,10 +71,10 @@ _EOF touch 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 "Write and read domain-decomposed data with generalized indices" ' - mpirun -n 6 ../test_generalized_indices + mpirun -n 6 ../test_diag_generalized_indices ' test_expect_success "Checking answers for the generalized indices" ' - mpirun -n 1 ../check_generalized_indices + mpirun -n 1 ../check_diag_generalized_indices ' cat <<_EOF > diag_table.yaml From cdda131e9f9cb1f78e21a92a3155c565de663e94 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Wed, 10 Jun 2026 20:14:14 -0400 Subject: [PATCH 15/19] renamed: check_generalized_indices.F90 -> check_diag_generalized_indices.F90 --- ...generalized_indices.F90 => check_diag_generalized_indices.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename test_fms/diag_manager/{check_generalized_indices.F90 => check_diag_generalized_indices.F90} (100%) diff --git a/test_fms/diag_manager/check_generalized_indices.F90 b/test_fms/diag_manager/check_diag_generalized_indices.F90 similarity index 100% rename from test_fms/diag_manager/check_generalized_indices.F90 rename to test_fms/diag_manager/check_diag_generalized_indices.F90 From 57f4866e0b44b786e063a22ec938cce19fd68f86 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Wed, 10 Jun 2026 21:23:36 -0400 Subject: [PATCH 16/19] rename diag test/checker --- test_fms/diag_manager/check_diag_generalized_indices.F90 | 4 ++-- test_fms/diag_manager/test_diag_generalized_indices.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/test_fms/diag_manager/check_diag_generalized_indices.F90 b/test_fms/diag_manager/check_diag_generalized_indices.F90 index 4261d9665a..8fc947ac49 100644 --- a/test_fms/diag_manager/check_diag_generalized_indices.F90 +++ b/test_fms/diag_manager/check_diag_generalized_indices.F90 @@ -18,7 +18,7 @@ !> @brief Checker for test_generalized_indices output. !! Verifies permuted-axis variables match identity variables under axis permutations -program check_generalized_indices +program check_diag_generalized_indices use fms_mod, only: fms_init, fms_end, string use testing_utils, only: check_perm use fms2_io_mod, only: FmsNetcdfFile_t, read_data, open_file, close_file, get_global_attribute @@ -96,4 +96,4 @@ subroutine check_global_attribute(fileobj, expected_title) call mpp_error(FATAL, "Global attribute 'title' not expected value.") endif end subroutine check_global_attribute -end program check_generalized_indices +end program check_diag_generalized_indices diff --git a/test_fms/diag_manager/test_diag_generalized_indices.F90 b/test_fms/diag_manager/test_diag_generalized_indices.F90 index 9d50a02879..91b692ce8c 100644 --- a/test_fms/diag_manager/test_diag_generalized_indices.F90 +++ b/test_fms/diag_manager/test_diag_generalized_indices.F90 @@ -20,7 +20,7 @@ !! Applies predefined permutations to canonical (x,y,z,w) storage !! and verifies consistency between data layout and axis metadata. !! Assumes default configuration parameters: test_normal + no_mask. -program test_generalized_indices +program test_diag_generalized_indices use fms_mod, only: fms_init, fms_end use testing_utils, only: allocate_buffer, permute use platform_mod, only: r8_kind @@ -251,5 +251,5 @@ subroutine set_buffer(buffer, time_index) buffer = nint(buffer) + real(time_index, kind=r8_kind)/100._r8_kind end subroutine set_buffer -end program test_generalized_indices +end program test_diag_generalized_indices From 8bd32865bdae8e29818e50dd8f88607cead32ea2 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Wed, 10 Jun 2026 22:16:12 -0400 Subject: [PATCH 17/19] Add generalized indices checker dependency --- test_fms/diag_manager/Makefile.am | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am index a0ca6427bc..4a80fb09ec 100644 --- a/test_fms/diag_manager/Makefile.am +++ b/test_fms/diag_manager/Makefile.am @@ -74,6 +74,8 @@ test_multiple_zbounds_SOURCES = test_multiple_zbounds.F90 test_diag_generalized_indices_SOURCES = testing_utils.F90 test_diag_generalized_indices.F90 check_diag_generalized_indices_SOURCES = testing_utils.F90 check_diag_generalized_indices.F90 +test_time_none.log: test_diag_generalized_indices check_diag_generalized_indices + TEST_EXTENSIONS = .sh SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ $(abs_top_srcdir)/test_fms/tap-driver.sh From 115ce535563ddb05b5d49e842ca4ecffb5c48f9f Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Wed, 10 Jun 2026 22:30:21 -0400 Subject: [PATCH 18/19] Revert "Add generalized indices checker dependency" This reverts commit 8bd32865bdae8e29818e50dd8f88607cead32ea2. --- test_fms/diag_manager/Makefile.am | 2 -- 1 file changed, 2 deletions(-) diff --git a/test_fms/diag_manager/Makefile.am b/test_fms/diag_manager/Makefile.am index 4a80fb09ec..a0ca6427bc 100644 --- a/test_fms/diag_manager/Makefile.am +++ b/test_fms/diag_manager/Makefile.am @@ -74,8 +74,6 @@ test_multiple_zbounds_SOURCES = test_multiple_zbounds.F90 test_diag_generalized_indices_SOURCES = testing_utils.F90 test_diag_generalized_indices.F90 check_diag_generalized_indices_SOURCES = testing_utils.F90 check_diag_generalized_indices.F90 -test_time_none.log: test_diag_generalized_indices check_diag_generalized_indices - TEST_EXTENSIONS = .sh SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) \ $(abs_top_srcdir)/test_fms/tap-driver.sh From 33a9fd47a527f32c69f29bc8f5a0fa991bea3661 Mon Sep 17 00:00:00 2001 From: Andrew Brooks Date: Wed, 10 Jun 2026 22:31:16 -0400 Subject: [PATCH 19/19] Add generalized indices checker to CMakeLists.txt --- CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index fd345fc1e6..4a880284dd 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -666,6 +666,7 @@ if(UNIT_TESTS) test_fms/diag_manager/test_diag_generalized_indices.F90 test_fms/diag_manager/testing_utils.F90 test_fms/diag_manager/test_diag_diurnal.F90 + test_fms/diag_manager/check_diag_generalized_indices.F90 test_fms/diag_manager/check_time_none.F90 test_fms/diag_manager/check_time_min.F90 test_fms/diag_manager/check_time_max.F90