Skip to content

Commit

Permalink
Fix r4_kind unit tests
Browse files Browse the repository at this point in the history
  • Loading branch information
Jesse Lentz committed Aug 22, 2023
1 parent 2d6bfd6 commit 3ca0798
Show file tree
Hide file tree
Showing 4 changed files with 126 additions and 141 deletions.
106 changes: 54 additions & 52 deletions test_fms/data_override/test_data_override.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -95,31 +95,33 @@ program test

implicit none

integer :: stdoutunit
integer :: num_threads = 1
integer :: isw, iew, jsw, jew
integer, allocatable :: is_win(:), js_win(:)
integer :: nx_dom, ny_dom, nx_win, ny_win
type(domain2d) :: Domain
integer :: nlon, nlat, siz(2)
real(DO_TEST_KIND_), allocatable, dimension(:) :: x, y
real(DO_TEST_KIND_), allocatable, dimension(:,:) :: lon, lat
real(DO_TEST_KIND_), allocatable, dimension(:,:) :: sst, ice
integer :: id_x, id_y, id_lon, id_lat, id_sst, id_ice
integer :: i, j, is, ie, js, je, io, ierr, n
real(DO_TEST_KIND_) :: rad_to_deg
character(len=36) :: message
type(time_type) :: Time
logical :: used
logical, allocatable :: ov_sst(:), ov_ice(:)
integer, dimension(2) :: layout = (/0,0/)
character(len=256) :: solo_mosaic_file, tile_file
character(len=128) :: grid_file = "INPUT/grid_spec.nc"
integer :: window(2) = (/1,1/)
integer :: nthreads=1
integer :: nwindows
integer :: nx_cubic=90, ny_cubic=90, nx_latlon=90, ny_latlon=90
integer :: test_num=1 !* 1 for unstruct cubic grid, 2 for unstruct latlon-grid
integer, parameter :: lkind = DO_TEST_KIND_
integer :: stdoutunit
integer :: num_threads = 1
integer :: isw, iew, jsw, jew
integer, allocatable :: is_win(:), js_win(:)
integer :: nx_dom, ny_dom, nx_win, ny_win
type(domain2d) :: Domain
integer :: nlon, nlat, siz(2)
real(lkind), allocatable, dimension(:) :: x, y
real(lkind), allocatable, dimension(:,:) :: lon, lat
real(lkind), allocatable, dimension(:,:) :: sst, ice
integer :: id_x, id_y, id_lon, id_lat, id_sst, id_ice
integer :: i, j, is, ie, js, je, io, ierr, n
real(lkind) :: rad_to_deg
character(len=36) :: message
type(time_type) :: Time
logical :: used
logical, allocatable :: ov_sst(:), ov_ice(:)
integer, dimension(2) :: layout = (/0,0/)
character(len=256) :: solo_mosaic_file, tile_file
character(len=128) :: grid_file = "INPUT/grid_spec.nc"
integer :: window(2) = (/1,1/)
integer :: nthreads=1
integer :: nwindows
integer :: nx_cubic=90, ny_cubic=90, nx_latlon=90, ny_latlon=90
integer :: test_num=1 !> 1 for unstruct cubic grid, 2 for unstruct
!! latlon-grid

type(FmsNetcdfFile_t) :: fileobj_grid, fileobj_solo_mosaic, fileobj_tile

Expand Down Expand Up @@ -173,8 +175,8 @@ program test

call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, name='test_data_override')
call mpp_define_io_domain(Domain, (/1,1/))
call data_override_init(Ice_domain_in=Domain, Ocean_domain_in=Domain)
call data_override_init(Ice_domain_in=Domain, Ocean_domain_in=Domain)
call data_override_init(Ice_domain_in=Domain, Ocean_domain_in=Domain, mode=lkind)
call data_override_init(Ice_domain_in=Domain, Ocean_domain_in=Domain, mode=lkind)
call mpp_get_compute_domain(Domain, is, ie, js, je)
call get_grid

Expand Down Expand Up @@ -322,10 +324,10 @@ program test

!====================================================================================================================
subroutine get_grid
real(DO_TEST_KIND_), allocatable, dimension(:,:,:) :: lon_vert_glo, lat_vert_glo
real(DO_TEST_KIND_), allocatable, dimension(:,:) :: lon_global, lat_global
integer, dimension(2) :: siz
character(len=128) :: message
real(lkind), allocatable, dimension(:,:,:) :: lon_vert_glo, lat_vert_glo
real(lkind), allocatable, dimension(:,:) :: lon_global, lat_global
integer, dimension(2) :: siz
character(len=128) :: message

type(FmsNetcdfFile_t) :: fileobj_grid, fileobj_solo_mosaic, fileobj_tile

Expand Down Expand Up @@ -419,14 +421,14 @@ subroutine test_unstruct_grid( type, Time )
integer :: isc, iec, jsc, jec, isd, ied, jsd, jed
integer :: ism, iem, jsm, jem, lsg, leg

integer, allocatable, dimension(:) :: pe_start, pe_end, npts_tile, grid_index, ntiles_grid
integer, allocatable, dimension(:,:) :: layout2D, global_indices
real(DO_TEST_KIND_), allocatable, dimension(:,:) :: x1, x2, g1, g2
real(DO_TEST_KIND_), allocatable, dimension(:,:,:) :: a1, a2, gdata
real(DO_TEST_KIND_), allocatable, dimension(:,:) :: rmask
real(DO_TEST_KIND_), allocatable, dimension(:) :: frac_crit
logical, allocatable, dimension(:,:,:) :: lmask,msk
integer, allocatable, dimension(:) :: isl, iel, jsl, jel
integer, allocatable, dimension(:) :: pe_start, pe_end, npts_tile, grid_index, ntiles_grid
integer, allocatable, dimension(:,:) :: layout2D, global_indices
real(lkind), allocatable, dimension(:,:) :: x1, x2, g1, g2
real(lkind), allocatable, dimension(:,:,:) :: a1, a2, gdata
real(lkind), allocatable, dimension(:,:) :: rmask
real(lkind), allocatable, dimension(:) :: frac_crit
logical, allocatable, dimension(:,:,:) :: lmask,msk
integer, allocatable, dimension(:) :: isl, iel, jsl, jel
character(len=3) :: text
integer :: tile
integer :: ntotal_land, istart, iend, pos
Expand Down Expand Up @@ -577,7 +579,7 @@ subroutine test_unstruct_grid( type, Time )
enddo
enddo
!First override the test SG data from file/field
call data_override_init(Land_domain_in=SG_domain)
call data_override_init(Land_domain_in=SG_domain, mode=lkind)
call data_override('LND','sst_obs',a1(:,:,1),Time)

!Create the test UG data
Expand All @@ -594,7 +596,7 @@ subroutine test_unstruct_grid( type, Time )
!--- fill the value of x2

!Now override the test UG data from the same file/field
call data_override_init(Land_domainUG_in=UG_domain)
call data_override_init(Land_domainUG_in=UG_domain, mode=lkind)
call data_override_UG('LND','sst_obs',x2(:,1),Time)

!Ensure you get the same UG data from the SG data
Expand All @@ -621,7 +623,7 @@ subroutine test_unstruct_grid( type, Time )
! enddo

!First override the test SG data from file/field
call data_override_init(Land_domain_in=SG_domain)
call data_override_init(Land_domain_in=SG_domain, mode=lkind)
call data_override('LND','sst_obs',a1,Time)

a2 = -999
Expand Down Expand Up @@ -652,7 +654,7 @@ subroutine test_unstruct_grid( type, Time )
! enddo

!Now override the test UG data from the same file/field
call data_override_init(Land_domainUG_in=UG_domain)
call data_override_init(Land_domainUG_in=UG_domain, mode=lkind)
call data_override_UG('LND','sst_obs',x2,Time)

!Ensure you get the same UG data from the SG data
Expand All @@ -667,10 +669,10 @@ subroutine test_unstruct_grid( type, Time )
end subroutine test_unstruct_grid

subroutine compare_checksums( a, b, string )
real(DO_TEST_KIND_), intent(in), dimension(:,:,:) :: a, b
character(len=*), intent(in) :: string
integer(i8_kind) :: sum1, sum2
integer :: i, j, k,pe
real(lkind), intent(in), dimension(:,:,:) :: a, b
character(len=*), intent(in) :: string
integer(i8_kind) :: sum1, sum2
integer :: i, j, k,pe

! z1l can not call mpp_sync here since there might be different number of tiles on each pe.
! mpp_sync()
Expand Down Expand Up @@ -712,10 +714,10 @@ end subroutine compare_checksums

!###########################################################################
subroutine compare_checksums_2D( a, b, string )
real(DO_TEST_KIND_), intent(in), dimension(:,:) :: a, b
character(len=*), intent(in) :: string
integer(i8_kind) :: sum1, sum2
integer :: i, j,pe
real(lkind), intent(in), dimension(:,:) :: a, b
character(len=*), intent(in) :: string
integer(i8_kind) :: sum1, sum2
integer :: i, j,pe

! z1l can not call mpp_sync here since there might be different number of tiles on each pe.
! mpp_sync()
Expand Down Expand Up @@ -761,7 +763,7 @@ subroutine define_cubic_mosaic(type, domain, ni, nj, global_indices, layout, pe_
integer, dimension(12) :: istart1, iend1, jstart1, jend1, tile1
integer, dimension(12) :: istart2, iend2, jstart2, jend2, tile2
integer :: ntiles, num_contact, msize(2)
integer :: whalo = 2, ehalo = 2, shalo = 2, nhalo = 2
integer :: whalo = 2, ehalo = 2, shalo = 2, nhalo = 2


ntiles = 6
Expand Down
59 changes: 22 additions & 37 deletions test_fms/data_override/test_data_override2.sh
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,9 +24,6 @@
# Set common test settings.
. ../test-lib.sh

# Skip test if input not present
test -z "$test_input_path" && SKIP_TESTS="$SKIP_TESTS $(basename $0 .sh).4"

setup_test_dir () {
local halo_size
test "$#" = 1 && { halo_size=$1; } ||
Expand All @@ -45,9 +42,12 @@ _EOF
mkdir INPUT
}

# Run the ongrid test case with 2 halos in x and y
touch input.nml

for KIND in r4 r8
do

# Run the ongrid test case with 2 halos in x and y
cat <<_EOF > data_table.yaml
data_table:
- gridname : OCN
Expand All @@ -62,29 +62,20 @@ printf '"OCN", "runoff", "runoff", "./INPUT/runoff.daitren.clim.1440x1080.v20180
[ ! -d "INPUT" ] && mkdir -p "INPUT"
setup_test_dir 2

for KIND in r4 r8
do
test_expect_success "data_override on grid with 2 halos in x and y (${KIND})" '
mpirun -n 6 ./test_data_override_ongrid_${KIND}
'
done
test_expect_success "data_override on grid with 2 halos in x and y (${KIND})" '
mpirun -n 6 ./test_data_override_ongrid_${KIND}
'

setup_test_dir 0

for KIND in r4 r8
do
test_expect_success "data_override on grid with no halos (${KIND})" '
mpirun -n 6 ./test_data_override_ongrid_${KIND}
'
done
test_expect_success "data_override on grid with no halos (${KIND})" '
mpirun -n 6 ./test_data_override_ongrid_${KIND}
'

# Run the get_grid_v1 test:
for KIND in r4 r8
do
test_expect_success "data_override get_grid_v1 (${KIND})" '
mpirun -n 1 ./test_get_grid_v1_${KIND}
'
done
test_expect_success "data_override get_grid_v1 (${KIND})" '
mpirun -n 1 ./test_get_grid_v1_${KIND}
'

# Run tests with input if enabled
# skips if built with yaml parser(tests older behavior)
Expand All @@ -101,35 +92,29 @@ test_data_override
"test_data_override_mod", "sst", "sst", "test_data_override", "all", .false., "none", 2
"test_data_override_mod", "ice", "ice", "test_data_override", "all", .false., "none", 2
_EOF

cat <<_EOF > data_table
"ICE", "sst_obs", "SST", "INPUT/sst_ice_clim.nc", .false., 300.0
"ICE", "sic_obs", "SIC", "INPUT/sst_ice_clim.nc", .false., 300.0
"OCN", "sst_obs", "SST", "INPUT/sst_ice_clim.nc", .false., 300.0
"LND", "sst_obs", "SST", "INPUT/sst_ice_clim.nc", .false., 300.0
_EOF

for KIND in r4 r8
do
test_expect_success "data_override on cubic-grid with input (${KIND})" '
mpirun -n 6 ./test_data_override_${KIND}
'
done
test_expect_success "data_override on cubic-grid with input (${KIND})" '
mpirun -n 6 ./test_data_override_${KIND}
'

cat <<_EOF > input.nml
cat <<_EOF > input.nml
&test_data_override_nml
test_num=2
/
_EOF

for KIND in r4 r8
do
test_expect_success "data_override on latlon-grid with input (${KIND})" '
mpirun -n 6 ./test_data_override_${KIND}
'
done

test_expect_success "data_override on latlon-grid with input (${KIND})" '
mpirun -n 6 ./test_data_override_${KIND}
'
rm -rf INPUT *.nc # remove any leftover files to reduce size
fi

done

test_done
61 changes: 30 additions & 31 deletions test_fms/data_override/test_data_override_ongrid.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,26 +36,26 @@ program test_data_override_ongrid

implicit none

integer, parameter :: lkind = DO_TEST_KIND_
integer, dimension(2) :: layout = (/2,3/) !< Domain layout
integer :: nlon !< Number of points in x axis
integer :: nlat !< Number of points in y axis
type(domain2d) :: Domain !< Domain with mask table
real(DO_TEST_KIND_), allocatable, dimension(:,:) :: runoff !< Data to be written
integer :: is !< Starting x index
integer :: ie !< Ending x index
integer :: js !< Starting y index
integer :: je !< Ending y index
type(time_type) :: Time !< Time
integer :: i !< Helper indices
integer :: ncid !< Netcdf file id
integer :: err !< Error Code
integer :: dim1d, dim2d, dim3d, dim4d !< Dimension ids
integer :: varid, varid2, varid3, varid4 !< Variable ids
real(DO_TEST_KIND_), allocatable, dimension(:,:,:) :: runoff_in !< Data to be written to file
real(DO_TEST_KIND_) :: expected_result !< Expected result from data_override
integer :: nhalox=2, nhaloy=2
integer :: io_status
integer, parameter :: lkind = DO_TEST_KIND_
integer, dimension(2) :: layout = (/2,3/) !< Domain layout
integer :: nlon !< Number of points in x axis
integer :: nlat !< Number of points in y axis
type(domain2d) :: Domain !< Domain with mask table
real(lkind), allocatable, dimension(:,:) :: runoff !< Data to be written
integer :: is !< Starting x index
integer :: ie !< Ending x index
integer :: js !< Starting y index
integer :: je !< Ending y index
type(time_type) :: Time !< Time
integer :: i !< Helper indices
integer :: ncid !< Netcdf file id
integer :: err !< Error Code
integer :: dim1d, dim2d, dim3d, dim4d !< Dimension ids
integer :: varid, varid2, varid3, varid4 !< Variable ids
real(lkind), allocatable, dimension(:,:,:) :: runoff_in !< Data to be written to file
real(lkind) :: expected_result !< Expected result from data_override
integer :: nhalox=2, nhaloy=2
integer :: io_status

namelist / test_data_override_ongrid_nml / nhalox, nhaloy

Expand All @@ -69,7 +69,7 @@ program test_data_override_ongrid
if (mpp_pe() .eq. mpp_root_pe()) then
allocate(runoff_in(1440, 1080, 10))
do i = 1, 10
runoff_in(:,:,i) = real(i, DO_TEST_KIND_)
runoff_in(:,:,i) = real(i, lkind)
enddo

err = nf90_create('INPUT/grid_spec.nc', ior(nf90_clobber, nf90_64bit_offset), ncid)
Expand Down Expand Up @@ -148,7 +148,7 @@ program test_data_override_ongrid
runoff = 999.

!< Initiliaze data_override
call data_override_init(Ocean_domain_in=Domain)
call data_override_init(Ocean_domain_in=Domain, mode=lkind)

!< Run it when time=3
Time = set_date(1,1,4,0,0,0)
Expand All @@ -174,15 +174,14 @@ program test_data_override_ongrid
contains

subroutine compare_data(Domain, actual_result, expected_result)
type(domain2d), intent(in) :: Domain !< Domain with mask table
real(DO_TEST_KIND_), intent(in) :: expected_result !< Expected result from data_override
real(DO_TEST_KIND_), dimension(:,:), intent(in) :: actual_result !< Result from data_override

integer :: xsizec, ysizec !< Size of the compute domain
integer :: xsized, ysized !< Size of the data domain
integer :: nx, ny !< Size of acual_result
integer :: nhalox, nhaloy !< Size of the halos
integer :: i, j !< Helper indices
type(domain2d), intent(in) :: Domain !< Domain with mask table
real(lkind), intent(in) :: expected_result !< Expected result from data_override
real(lkind), dimension(:,:), intent(in) :: actual_result !< Result from data_override
integer :: xsizec, ysizec !< Size of the compute domain
integer :: xsized, ysized !< Size of the data domain
integer :: nx, ny !< Size of acual_result
integer :: nhalox, nhaloy !< Size of the halos
integer :: i, j !< Helper indices

!< Data is only expected to be overriden for the compute domain -not at the halos.
call mpp_get_compute_domain(Domain, xsize=xsizec, ysize=ysizec)
Expand Down
Loading

0 comments on commit 3ca0798

Please sign in to comment.