Skip to content

horiz_interp fixes for r4 tests #1736

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
vithikashah001 merged 5 commits into from
Jul 29, 2025
Merged

horiz_interp fixes for r4 tests #1736

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
2e71b5e
fix issues with horiz_interp r4 code and unit tests
Jul 16, 2025
153e227
adjust tolerances for bicubic test
Jul 16, 2025
fa397b1
set tolerance based on kind size for spherical
Jul 16, 2025
134df59
fix line lengths
Jul 16, 2025
c223906
fix kind name in constant
Jul 16, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions horiz_interp/horiz_interp_bilinear.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -71,6 +71,7 @@ module horiz_interp_bilinear_mod
!> @{

real(r8_kind), parameter :: epsln=1.e-10_r8_kind
real(r4_kind), parameter :: epsln_r4=1.e-4_r4_kind
integer, parameter :: DUMMY = -999

!! Private helper routines, interfaces for mixed real precision support
Expand Down
19 changes: 16 additions & 3 deletions horiz_interp/include/horiz_interp_bilinear.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -270,7 +270,11 @@
epsln2 = real(epsln,FMS_HI_KIND_)* 1.0e5_kindl
call FIND_NEIGHBOR_NEW_(Interp, lon_in, lat_in, lon_out, lat_out, src_is_modulo, no_crash)
else
epsln2 = real(epsln,FMS_HI_KIND_)
if(kindl == r8_kind) then
epsln2 = epsln
else
epsln2 = epsln_r4
endif
call FIND_NEIGHBOR_(Interp, lon_in, lat_in, lon_out, lat_out, src_is_modulo)
endif

Expand Down Expand Up @@ -389,8 +393,17 @@
if (x > 1.0_kindl) x = 1.0_kindl
if (y > 1.0_kindl) y = 1.0_kindl
endif
if( x>1.0_kindl .or. x<0.0_kindl .or. y>1.0_kindl .or. y < 0.0_kindl) &
call mpp_error(FATAL, "horiz_interp_bilinear_mod: weight should be between 0 and 1")
!! if using 4 byte reals, allow a bit more tolerance (1e-4) on weight values
if( kindl == r8_kind ) then
if( x>1.0_kindl .or. x<0.0_kindl .or. y>1.0_kindl .or. y < 0.0_kindl) &
call mpp_error(FATAL, "horiz_interp_bilinear_mod: weight should be between 0 and 1, x=" &
//string(x)//" y="//string(y))
else
if( x>1.0_kindl + epsln2 .or. x<0.0_kindl - epsln2 .or. &
y>1.0_kindl + epsln2 .or. y < 0.0_kindl - epsln2) &
call mpp_error(FATAL, "horiz_interp_bilinear_mod: weight should be between 0 and 1, x=" &
//string(x)//" y="//string(y))
endif
Interp % HI_KIND_TYPE_ % wti(m,n,1)=1.0_kindl-x
Interp % HI_KIND_TYPE_ % wti(m,n,2)=x
Interp % HI_KIND_TYPE_ % wtj(m,n,1)=1.0_kindl-y
Expand Down
15 changes: 0 additions & 15 deletions horiz_interp/include/horiz_interp_conserve.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -246,17 +246,12 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l

integer :: nincrease, ndecrease
logical :: flip_lat
integer :: wordsz
integer(kind=1) :: one_byte(8)
integer, parameter :: kindl = FMS_HI_KIND_ !< compiled kind size

if(.not. module_is_initialized) call mpp_error(FATAL, &
'HORIZ_INTERP_CONSERVE_NEW_1DX2D_: horiz_interp_conserve_init is not called')

wordsz=size(transfer(lon_in(1), one_byte))
if(wordsz .NE. 4 .AND. wordsz .NE. 8) call mpp_error(FATAL, &
'HORIZ_INTERP_CONSERVE_NEW_1DX2D_: wordsz should be 4 or 8')

if( (size(lon_out,1) .NE. size(lat_out,1)) .OR. (size(lon_out,2) .NE. size(lat_out,2)) ) &
call mpp_error(FATAL, 'horiz_interp_conserve_mod: size mismatch between lon_out and lat_out')
nlon_in = size(lon_in(:)) - 1; nlat_in = size(lat_in(:)) - 1
Expand Down Expand Up @@ -413,17 +408,12 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l
real(r8_kind), allocatable, dimension(:) :: lon_out_r8, lat_out_r8
real(r8_kind), allocatable, dimension(:,:) :: lon_in_r8, lat_in_r8
real(r8_kind), allocatable, dimension(:,:) :: lon_dst, lat_dst
integer :: wordsz
integer(kind=1) :: one_byte(8)
integer, parameter :: kindl = FMS_HI_KIND_ !< compiled kind size

if(.not. module_is_initialized) call mpp_error(FATAL, &
'HORIZ_INTERP_CONSERVE_NEW_2DX1D_: horiz_interp_conserve_init is not called')

wordsz=size(transfer(lon_in(1,1), one_byte))
if(wordsz .NE. 8) call mpp_error(FATAL, &
'HORIZ_INTERP_CONSERVE_NEW_2DX1D_: currently only support 64-bit real(FMS_HI_KIND_), contact developer')

if( (size(lon_in,1) .NE. size(lat_in,1)) .OR. (size(lon_in,2) .NE. size(lat_in,2)) ) &
call mpp_error(FATAL, 'horiz_interp_conserve_mod: size mismatch between lon_in and lat_in')
nlon_in = size(lon_in,1) - 1; nlat_in = size(lon_in,2) - 1
Expand Down Expand Up @@ -524,17 +514,12 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l
real(r8_kind), allocatable, dimension(:,:) :: dst_area
real(r8_kind), allocatable, dimension(:,:) :: lon_in_r8, lat_in_r8
real(r8_kind), allocatable, dimension(:,:) :: lon_out_r8, lat_out_r8
integer :: wordsz
integer(kind=1) :: one_byte(8)
integer, parameter :: kindl = FMS_HI_KIND_ !< compiled kind size

if(.not. module_is_initialized) call mpp_error(FATAL, &
'HORIZ_INTERP_CONSERVE_NEW_2DX2D_: horiz_interp_conserve_init is not called')

wordsz=size(transfer(lon_in(1,1), one_byte))
if(wordsz .NE. 4 .AND. wordsz .NE. 8) call mpp_error(FATAL, &
'HORIZ_INTERP_CONSERVE_NEW_2DX2D_: wordsz should be 4 or 8')

if( (size(lon_in,1) .NE. size(lat_in,1)) .OR. (size(lon_in,2) .NE. size(lat_in,2)) ) &
call mpp_error(FATAL, 'horiz_interp_conserve_mod: size mismatch between lon_in and lat_in')
if( (size(lon_out,1) .NE. size(lat_out,1)) .OR. (size(lon_out,2) .NE. size(lat_out,2)) ) &
Expand Down
4 changes: 2 additions & 2 deletions test_fms/horiz_interp/Makefile.am
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,8 +36,8 @@ test_horiz_interp_r4_SOURCES = test_horiz_interp.F90
test_horiz_interp_r8_SOURCES = test_horiz_interp.F90
test_create_xgrid_order2_r8_SOURCES = test_create_xgrid_order2.F90

test_horiz_interp_r4_CPPFLAGS=-DHI_TEST_KIND=4 -I$(MODDIR)
test_horiz_interp_r8_CPPFLAGS=-DHI_TEST_KIND=8 -I$(MODDIR)
test_horiz_interp_r4_CPPFLAGS=-DHI_TEST_KIND_=4 -I$(MODDIR)
test_horiz_interp_r8_CPPFLAGS=-DHI_TEST_KIND_=8 -I$(MODDIR)
test_create_xgrid_order2_r8_CPPFLAGS=-DHI_TEST_KIND_=8 -I$(MODDIR)

TEST_EXTENSIONS = .sh
Expand Down
32 changes: 21 additions & 11 deletions test_fms/horiz_interp/test_horiz_interp.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,11 +22,6 @@
!! Assignment test checks that the override is copying the data type properly
!! TODO some larger tests with different data sets

!! defaults to 8 real kind, make check will compile with both 4 and 8
#ifndef HI_TEST_KIND_
#define HI_TEST_KIND_ 8
#endif

program horiz_interp_test

use mpp_mod, only : mpp_init, mpp_exit, mpp_error, FATAL, stdout, mpp_npes, WARNING
Expand Down Expand Up @@ -125,7 +120,13 @@ subroutine test_horiz_interp_spherical
real(HI_TEST_KIND_) :: lon_dst_beg = -280._lkind, lon_dst_end = 80._lkind
real(HI_TEST_KIND_) :: lat_dst_beg = -90._lkind, lat_dst_end = 90._lkind
real(HI_TEST_KIND_) :: D2R = real(PI,HI_TEST_KIND_)/180._lkind
real(HI_TEST_KIND_), parameter :: SMALL = 1.0e-10_lkind
real(HI_TEST_KIND_) :: tolerance

if(HI_TEST_KIND_ == r8_kind) then
tolerance = 1.0e-10_lkind
else
tolerance = 1.0e-5_lkind
endif

! set up longitude and latitude of source/destination grid.
dlon_src = (lon_src_end-lon_src_beg)/real(ni_src, HI_TEST_KIND_)
Expand Down Expand Up @@ -176,7 +177,7 @@ subroutine test_horiz_interp_spherical
call mpp_clock_end(id1)
do i=1, ni_dst-1
do j=1, nj_dst-1
if(data_dst(i,j) - 1.0_lkind .gt. SMALL) then
if(data_dst(i,j) - 1.0_lkind .gt. tolerance) then
print *, 'data_dst(i=', i, ', j=', j, ')=', data_dst(i,j), ' Expected value: 1.0'
call mpp_error(FATAL, "test_horiz_interp_spherical: "// &
"invalid output data after interpolation")
Expand Down Expand Up @@ -649,7 +650,14 @@ subroutine test_horiz_interp_bicubic
real(HI_TEST_KIND_) :: lon_dst_beg = -280._lkind, lon_dst_end = 80._lkind
real(HI_TEST_KIND_) :: lat_dst_beg = -90._lkind, lat_dst_end = 90._lkind
real(HI_TEST_KIND_) :: D2R = real(PI,HI_TEST_KIND_)/180._lkind
real(HI_TEST_KIND_), parameter :: SMALL = 1.0e-10_lkind
real(HI_TEST_KIND_) :: SMALL

! adjust tolerance used in checks based on kind size
if(HI_TEST_KIND_ == r8_kind) then
small = 1.0e-10_lkind
else
small = 1.0e-3_lkind
end if

! set up longitude and latitude of source/destination grid.
dlon_src = (lon_src_end-lon_src_beg)/real(ni_src, lkind)
Expand Down Expand Up @@ -716,13 +724,14 @@ subroutine test_horiz_interp_bicubic
if( interp_t%horizInterpReals4_type%is_allocated) then
if( interp_t%horizInterpReals4_type%wti(i,j,1) * interp_t%horizInterpReals4_type%wti(i,j,2) &
- interp_t%horizInterpReals4_type%wti(i,j,3) .gt. SMALL .or. &
interp_t%horizInterpReals4_type%wti(i,j,3) - (57.2958_lkind * 57.2958_lkind) .gt. SMALL) then
interp_t%horizInterpReals4_type%wti(i,j,3) - (57.2958_lkind * 57.2958_lkind) &
.gt. 1.0e-1_lkind) then
print *, i, j, interp_t%horizInterpReals4_type%wti(i,j,:)
call mpp_error(FATAL, "test_horiz_interp: bicubic test failed 1Dx1D weight calculation")
endif
else
if( interp_t%horizInterpReals8_type%wti(i,j,1) * interp_t%horizInterpReals8_type%wti(i,j,2) &
- interp_t%horizInterpReals8_type%wti(i,j,3) .gt. SMALL .and. &
- interp_t%horizInterpReals8_type%wti(i,j,3) .gt. SMALL .or. &
interp_t%horizInterpReals8_type%wti(i,j,3) - (57.2958_lkind * 57.2958_lkind) .gt. SMALL) then
print *, i, j, interp_t%horizInterpReals8_type%wti(i,j,:)
call mpp_error(FATAL, "test_horiz_interp: bicubic test failed 1Dx1D weight calculation")
Expand Down Expand Up @@ -762,7 +771,8 @@ subroutine test_horiz_interp_bicubic
if( interp_t%horizInterpReals4_type%is_allocated) then
if( interp_t%horizInterpReals4_type%wti(i,j,1) * interp_t%horizInterpReals4_type%wti(i,j,2) &
- interp_t%horizInterpReals4_type%wti(i,j,3) .gt. SMALL .or. &
interp_t%horizInterpReals4_type%wti(i,j,3) - (57.2958_lkind * 57.2958_lkind) .gt. SMALL) then
interp_t%horizInterpReals4_type%wti(i,j,3) - (57.2958_lkind * 57.2958_lkind) .gt. 1.0e-1_lkind)&
then
print *, i, j, interp_t%horizInterpReals4_type%wti(i,j,:)
call mpp_error(FATAL, "test_horiz_interp: bicubic test failed 1Dx1D weight calculation")
endif
Expand Down
Loading