test_fms/diag_manager/check_subregional.F90

   1 !***********************************************************************
   2 !*                   GNU Lesser General Public License
   3 !*
   4 !* This file is part of the GFDL Flexible Modeling System (FMS).
   5 !*
   6 !* FMS is free software: you can redistribute it and/or modify it under
   7 !* the terms of the GNU Lesser General Public License as published by
   8 !* the Free Software Foundation, either version 3 of the License, or (at
   9 !* your option) any later version.
  10 !*
  11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
  12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 !* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 !* for more details.
  15 !*
  16 !* You should have received a copy of the GNU Lesser General Public
  17 !* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
  18 !***********************************************************************
  19
  20 !> @brief Checks the output file after running test_subregional
  21 program check_subregional
  22   use fms_mod,           only: fms_init, fms_end, string
  23   use fms2_io_mod,       only: FmsNetcdfFile_t, read_data, close_file, open_file, get_dimension_size, file_exists
  24   use mpp_mod,           only: mpp_npes, mpp_error, FATAL, mpp_pe
  25   use platform_mod,      only: r4_kind, r8_kind
  26
  27   implicit none
  28
  29   call fms_init()
  30
  31   call check_zsubaxis_file("test_subZaxis.nc")
  32   ! The files are in the same subregion, one of them is defined using latlon and another one indices
  33   call check_subregional_file("test_subregional.nc")
  34   call check_subregional_file("test_subregional2.nc")
  35   call check_corner_files()
  36
  37   call fms_end()
  38
  39   contains
  40
  41   !> @brief Check dimension data
  42   subroutine check_dims(err_msg, actual_data, expected_data)
  43     character(len=*), intent(in) :: err_msg          !< Error message to append
  44     real,             intent(in) :: actual_data(:)   !< Dimension data from file
  45     real,             intent(in) :: expected_data(:) !< Expected data
  46
  47     integer :: i
  48
  49     do i = 1, size(actual_data)
  50       if (actual_data(i) .ne. expected_data(i)) &
  51         call mpp_error(FATAL, "The data is not expected for "//trim(err_msg))
  52     enddo
  53   end subroutine check_dims
  54
  55   !> @brief Check the data for the Z subaxis
  56   subroutine check_zsubaxis_file(file_name)
  57     character(len=*), intent(in) :: file_name !< Name of the file to check
  58
  59     type(FmsNetcdfFile_t)              :: fileobj            !< FMS2 fileobj
  60     integer                            :: dim_size           !< dim_size as read in from the file
  61     real, allocatable                  :: dims(:)            !< dimension data as read in from the file
  62     real, allocatable                  :: dims_exp(:)        !< dimensions data expected
  63
  64     if (.not. open_file(fileobj, file_name, "read")) &
  65       call mpp_error(FATAL, "unable to open "//trim(file_name))
  66
  67     call get_dimension_size(fileobj, "z_sub01", dim_size)
  68     if (dim_size .ne. 3) call mpp_error(FATAL, "z_sub01 is not the correct size!")
  69     allocate(dims(dim_size), dims_exp(dim_size))
  70     call read_data(fileobj, "z_sub01", dims)
  71     dims_exp = (/3., 4., 5. /)
  72     call check_dims("z_sub01",dims, dims_exp)
  73     deallocate(dims, dims_exp)
  74
  75     call get_dimension_size(fileobj, "z_sub02", dim_size)
  76     if (dim_size .ne. 2) call mpp_error(FATAL, "z_sub02 is not the correct size!")
  77     allocate(dims(dim_size), dims_exp(dim_size))
  78     call read_data(fileobj, "z_sub02", dims)
  79     dims_exp = (/2., 3./)
  80     call check_dims("z_sub01",dims, dims_exp)
  81     deallocate(dims, dims_exp)
  82
  83     call close_file(fileobj)
  84
  85   end subroutine check_zsubaxis_file
  86
  87   !> @brief Check the data for the subregional file
  88   subroutine check_subregional_file(file_name)
  89     character(len=*), intent(in) :: file_name !< Name of the file to check
  90
  91     type(FmsNetcdfFile_t)              :: fileobj            !< FMS2 fileobj
  92     integer                            :: dim_size           !< dim_size as read in from the file
  93     real, allocatable                  :: dims(:)            !< dimension data as read in from the file
  94     real, allocatable                  :: dims_exp(:)        !< dimensions data expected
  95
  96     if (.not. open_file(fileobj, trim(file_name)//".0003", "read")) &
  97       call mpp_error(FATAL, "unable to open "//trim(file_name))
  98
  99     call get_dimension_size(fileobj, "x_sub01", dim_size)
 100     if (dim_size .ne. 6) call mpp_error(FATAL, "x_sub01 is not the correct size!")
 101     allocate(dims(dim_size), dims_exp(dim_size))
 102     call read_data(fileobj, "x_sub01", dims)
 103     dims_exp = (/60., 61., 62., 63., 64., 65. /)
 104     call check_dims("x_sub01",dims, dims_exp)
 105     deallocate(dims, dims_exp)
 106
 107     call get_dimension_size(fileobj, "y_sub01", dim_size)
 108     if (dim_size .ne. 5) call mpp_error(FATAL, "y_sub01 is not the correct size!")
 109     allocate(dims(dim_size), dims_exp(dim_size))
 110     call read_data(fileobj, "y_sub01", dims)
 111     dims_exp = (/60., 61., 62., 63., 64./)
 112     call check_dims("y_sub01",dims, dims_exp)
 113     deallocate(dims, dims_exp)
 114
 115     call close_file(fileobj)
 116
 117     if (.not. open_file(fileobj, trim(file_name)//".0004", "read")) &
 118       call mpp_error(FATAL, "unable to open "//trim(file_name))
 119
 120     call get_dimension_size(fileobj, "x_sub01", dim_size)
 121     if (dim_size .ne. 6) call mpp_error(FATAL, "x_sub01 is not the correct size!")
 122     allocate(dims(dim_size), dims_exp(dim_size))
 123     call read_data(fileobj, "x_sub01", dims)
 124     dims_exp = (/60., 61., 62., 63., 64., 65. /)
 125     call check_dims("x_sub01",dims, dims_exp)
 126     deallocate(dims, dims_exp)
 127
 128     call get_dimension_size(fileobj, "y_sub01", dim_size)
 129     if (dim_size .ne. 1) call mpp_error(FATAL, "y_sub01 is not the correct size!")
 130     allocate(dims(dim_size), dims_exp(dim_size))
 131     call read_data(fileobj, "y_sub01", dims)
 132     dims_exp = (/65./)
 133     call check_dims("y_sub01",dims, dims_exp)
 134     deallocate(dims, dims_exp)
 135
 136     call close_file(fileobj)
 137
 138   end subroutine check_subregional_file
 139
 140   !> @brief Check the data for the corner subregional files
 141   subroutine check_corner_files()
 142     type(FmsNetcdfFile_t)              :: fileobj            !< FMS2 fileobj
 143     integer                            :: dim_size           !< dim_size as read in from the file
 144     real, allocatable                  :: dims(:)            !< dimension data as read in from the file
 145     real, allocatable                  :: dims_exp(:)        !< dimensions data expected
 146
 147     !subregion:
 148     !corner1: 17. 17.
 149     !corner2: 17. 20.
 150     !corner3: 20. 17.
 151     !corner4: 20. 20.
 152     ! In this case, lat 17 is shared between PE 0 and PE 1, but only PE 1 should have data
 153     if (file_exists("test_corner1.nc.0000")) &
 154       call mpp_error(FATAL, "test_corner1.nc.0000 should not exist!")
 155
 156     if (.not. open_file(fileobj, "test_corner1.nc.0001", "read")) &
 157       call mpp_error(FATAL, "unable to open test_corner1.nc.0001")
 158
 159     call get_dimension_size(fileobj, "xc_sub01", dim_size)
 160     if (dim_size .ne. 4) call mpp_error(FATAL, "xc_sub01 is not the correct size!")
 161     call get_dimension_size(fileobj, "yc_sub01", dim_size)
 162     if (dim_size .ne. 4) call mpp_error(FATAL, "yc_sub01 is not the correct size!")
 163     call close_file(fileobj)
 164
 165   !subregion
 166   !corner1: 17. 17.
 167   !corner2: 20. 17.
 168   !corner3: 17. 17.
 169   !corner4: 20. 17.
 170   ! In this case, lat 17 is shared between PE 0 and PE 1, but only PE 1 should have data
 171   if (file_exists("test_corner2.nc.0000")) &
 172     call mpp_error(FATAL, "test_corner2.nc.0000 should not exist!")
 173
 174   if (.not. open_file(fileobj, "test_corner2.nc.0001", "read")) &
 175     call mpp_error(FATAL, "unable to open test_corner2.nc.0001")
 176
 177   call get_dimension_size(fileobj, "xc_sub01", dim_size)
 178   if (dim_size .ne. 4) call mpp_error(FATAL, "xc_sub01 is not the correct size!")
 179   call get_dimension_size(fileobj, "yc_sub01", dim_size)
 180   if (dim_size .ne. 1) call mpp_error(FATAL, "yc_sub01 is not the correct size!")
 181   call close_file(fileobj)
 182
 183   !subregion
 184   ! In this case, lat 17 is shared between PE 0 and PE 1, but only PE 1 should have data
 185   ! lat 33 is shared between PE 1 and PE 2, but only PE 1 should have data
 186   !corner1: 17. 17.
 187   !corner2: 20. 17.
 188   !corner3: 17. 33.
 189   !corner4: 20. 33.
 190   if (file_exists("test_corner3.nc.0000")) &
 191     call mpp_error(FATAL, "test_corner3.nc.0000 should not exist!")
 192     if (file_exists("test_corner3.nc.0003")) &
 193     call mpp_error(FATAL, "test_corner3.nc.0003 should not exist!")
 194
 195   if (.not. open_file(fileobj, "test_corner3.nc.0001", "read")) &
 196     call mpp_error(FATAL, "unable to open test_corner3.nc.0001")
 197
 198   call get_dimension_size(fileobj, "xc_sub01", dim_size)
 199   if (dim_size .ne. 4) call mpp_error(FATAL, "xc_sub01 is not the correct size!")
 200   call get_dimension_size(fileobj, "yc_sub01", dim_size)
 201   if (dim_size .ne. 17) call mpp_error(FATAL, "yc_sub01 is not the correct size!")
 202   call close_file(fileobj)
 203
 204   end subroutine check_corner_files
 205
 206 end program