diff --git a/test_fms/data_override/test_data_override.F90 b/test_fms/data_override/test_data_override.F90 index b104755b4f..4b4c3650ba 100644 --- a/test_fms/data_override/test_data_override.F90 +++ b/test_fms/data_override/test_data_override.F90 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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() @@ -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() @@ -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 diff --git a/test_fms/data_override/test_data_override2.sh b/test_fms/data_override/test_data_override2.sh index 33a7866f67..35546b41d3 100755 --- a/test_fms/data_override/test_data_override2.sh +++ b/test_fms/data_override/test_data_override2.sh @@ -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; } || @@ -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 @@ -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) @@ -101,7 +92,6 @@ 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 @@ -109,27 +99,22 @@ _EOF "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 diff --git a/test_fms/data_override/test_data_override_ongrid.F90 b/test_fms/data_override/test_data_override_ongrid.F90 index c976382814..3f031547fa 100644 --- a/test_fms/data_override/test_data_override_ongrid.F90 +++ b/test_fms/data_override/test_data_override_ongrid.F90 @@ -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 @@ -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) @@ -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) @@ -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) diff --git a/test_fms/data_override/test_get_grid_v1.F90 b/test_fms/data_override/test_get_grid_v1.F90 index fe4c1127e3..f8466bfd62 100644 --- a/test_fms/data_override/test_get_grid_v1.F90 +++ b/test_fms/data_override/test_get_grid_v1.F90 @@ -35,21 +35,20 @@ program test_get_grid_v1 implicit none -type(domain2d) :: Domain !< 2D domain -integer :: is, ie, js, je !< Starting and ending compute - !! domain indices -integer :: nlon, nlat !< Number of lat, lon in grid -real(DO_TEST_KIND_) :: min_lon, max_lon !< Maximum lat and lon -real(DO_TEST_KIND_), dimension(:,:), allocatable :: lon, lat !< Lat and lon -integer :: ncid, err !< Netcdf integers -integer :: dimid1, dimid2, dimid3, dimid4 !< Dimensions IDs -integer :: varid1, varid2, varid3, varid4, varid5 !< Variable IDs -real(DO_TEST_KIND_) :: lat_in(1), lon_in(1) !< Lat and lon to be written to file -real(DO_TEST_KIND_), dimension(:,:,:), allocatable :: lat_vert_in, lon_vert_in !