General Indices: Diag Manager Test

CMakeLists.txt

@@ -663,8 +663,10 @@ 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_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

diag_manager/diag_manager.F90

@@ -1683,12 +1683,12 @@ 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
-    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

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_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
@@ -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_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) \

test_fms/diag_manager/check_diag_generalized_indices.F90

@@ -0,0 +1,99 @@
+!***********************************************************************
+!*                             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_indices output.
+!!        Verifies permuted-axis variables match identity variables under axis permutations
+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
+  use mpp_mod,           only: mpp_error, FATAL, mpp_pe
+  use platform_mod,      only: r8_kind
+
+  implicit none
+
+  type(FmsNetcdfFile_t)           :: fileobj
+  integer                         :: nx, ny, nz
+  integer                         :: i, ierr
+
+  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()
+
+  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_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._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], 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], 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], 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], ierr)
+  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
+end program check_diag_generalized_indices