Skip to content
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

set is_allocated in all horiz_interp_type_new routines #1538

Merged
merged 6 commits into from
Jun 28, 2024
Merged

set is_allocated in all horiz_interp_type_new routines #1538

Show file tree
Hide file tree
Changes from 5 commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
154a541
set is_allocated in interp_type for every variant of the *_new routines
May 29, 2024
5f83a86
add tests
Jun 3, 2024
5d04cfd
rm whitespace and fix missed compile errors in time_interp
Jun 3, 2024
2d94c14
undo time_interp changes, and change bicubic CPP name to be more accu…
Jun 3, 2024
0a6317d
add doxygen comments for variables in assignment/types test
Jun 24, 2024
ebce5ab
rename the SPHERICA constant and remove the other interpolation metho…
Jun 27, 2024
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
2 changes: 1 addition & 1 deletion horiz_interp/horiz_interp_bicubic.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ module horiz_interp_bicubic_mod

use mpp_mod, only: mpp_error, FATAL, stdout, mpp_pe, mpp_root_pe
use fms_mod, only: write_version_number
use horiz_interp_type_mod, only: horiz_interp_type
use horiz_interp_type_mod, only: horiz_interp_type, BICUBIC
use constants_mod, only: PI
use platform_mod, only: r4_kind, r8_kind

Expand Down
2 changes: 1 addition & 1 deletion horiz_interp/horiz_interp_bilinear.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,7 @@ module horiz_interp_bilinear_mod
use mpp_mod, only: mpp_error, FATAL, stdout, mpp_pe, mpp_root_pe
use fms_mod, only: write_version_number
use constants_mod, only: PI
use horiz_interp_type_mod, only: horiz_interp_type, stats
use horiz_interp_type_mod, only: horiz_interp_type, stats, BILINEAR
use platform_mod, only: r4_kind, r8_kind
use axis_utils2_mod, only: nearest_index

Expand Down
2 changes: 1 addition & 1 deletion horiz_interp/horiz_interp_conserve.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ module horiz_interp_conserve_mod
use fms_mod, only: write_version_number
use grid2_mod, only: get_great_circle_algorithm
use constants_mod, only: PI
use horiz_interp_type_mod, only: horiz_interp_type
use horiz_interp_type_mod, only: horiz_interp_type, CONSERVE


implicit none
Expand Down
2 changes: 1 addition & 1 deletion horiz_interp/horiz_interp_spherical.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ module horiz_interp_spherical_mod
use fms_mod, only : write_version_number
use fms_mod, only : check_nml_error
use constants_mod, only : pi
use horiz_interp_type_mod, only : horiz_interp_type, stats
use horiz_interp_type_mod, only : horiz_interp_type, stats, SPHERICA
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is there a reason we do not include the trailing L other than to limit the variable name to 8 characters?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No as far as I can tell that's the only reason it's cut off. I checked if there was anything else used in FMS named spherical but there's not.

Should we update it to add the L?


implicit none
private
Expand Down
8 changes: 6 additions & 2 deletions horiz_interp/include/horiz_interp_bicubic.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -190,6 +190,8 @@
! xf > xcu, no valid boundary point')
enddo
enddo
Interp% HI_KIND_TYPE_ % is_allocated = .true.
Interp%interp_method = BICUBIC
end subroutine HORIZ_INTERP_BICUBIC_NEW_1D_S_

!> @brief Creates a new @ref horiz_interp_type
Expand Down Expand Up @@ -343,11 +345,13 @@
! xcu, no valid boundary point')
enddo
enddo
Interp% HI_KIND_TYPE_ % is_allocated = .true.
Interp%interp_method = BICUBIC

end subroutine HORIZ_INTERP_BICUBIC_NEW_1D_

!> @brief Perform bicubic horizontal interpolation
subroutine HORIZ_INTERP_BICUBIC_NEW_( Interp, data_in, data_out, verbose, mask_in, mask_out, missing_value, &
subroutine HORIZ_INTERP_BICUBIC_( Interp, data_in, data_out, verbose, mask_in, mask_out, missing_value, &
& missing_permit)
type (horiz_interp_type), intent(in) :: Interp
real(FMS_HI_KIND_), intent(in), dimension(:,:) :: data_in
Expand Down Expand Up @@ -427,7 +431,7 @@
enddo
enddo
return
end subroutine HORIZ_INTERP_BICUBIC_NEW_
end subroutine HORIZ_INTERP_BICUBIC_

!---------------------------------------------------------------------------

Expand Down
4 changes: 2 additions & 2 deletions horiz_interp/include/horiz_interp_bicubic_r4.fh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,8 @@
#undef HORIZ_INTERP_BICUBIC_NEW_1D_
#define HORIZ_INTERP_BICUBIC_NEW_1D_ horiz_interp_bicubic_new_1d_r4

#undef HORIZ_INTERP_BICUBIC_NEW_
#define HORIZ_INTERP_BICUBIC_NEW_ horiz_interp_bicubic_r4
#undef HORIZ_INTERP_BICUBIC_
#define HORIZ_INTERP_BICUBIC_ horiz_interp_bicubic_r4

#undef BCUINT_
#define BCUINT_ bcuint_r4
Expand Down
4 changes: 2 additions & 2 deletions horiz_interp/include/horiz_interp_bicubic_r8.fh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,8 @@
#undef HORIZ_INTERP_BICUBIC_NEW_1D_
#define HORIZ_INTERP_BICUBIC_NEW_1D_ horiz_interp_bicubic_new_1d_r8

#undef HORIZ_INTERP_BICUBIC_NEW_
#define HORIZ_INTERP_BICUBIC_NEW_ horiz_interp_bicubic_r8
#undef HORIZ_INTERP_BICUBIC_
#define HORIZ_INTERP_BICUBIC_ horiz_interp_bicubic_r8

#undef BCUINT_
#define BCUINT_ bcuint_r8
Expand Down
4 changes: 4 additions & 0 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 @@ -191,6 +191,8 @@
' data required between latitudes:', glt_min, glt_max, &
' data set is between latitudes:', lat_in(1), lat_in(nlat_in)
endif
Interp% HI_KIND_TYPE_ % is_allocated = .true.
Interp% interp_method = BILINEAR

return

Expand Down Expand Up @@ -396,6 +398,8 @@
enddo
enddo

Interp% HI_KIND_TYPE_ % is_allocated = .true.
Interp% interp_method = BILINEAR
end subroutine

!#######################################################################
Expand Down
12 changes: 12 additions & 0 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 @@ -215,6 +215,9 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l
endif
!-----------------------------------------------------------------------

Interp% HI_KIND_TYPE_ % is_allocated = .true.
Interp% interp_method = CONSERVE

end subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_

!#######################################################################
Expand Down Expand Up @@ -384,6 +387,9 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l

deallocate(i_src, j_src, i_dst, j_dst, xgrid_area, dst_area )

Interp% HI_KIND_TYPE_ % is_allocated = .true.
Interp% interp_method = CONSERVE

end subroutine HORIZ_INTERP_CONSERVE_NEW_1DX2D_

!#######################################################################
Expand Down Expand Up @@ -493,6 +499,9 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l

deallocate(i_src, j_src, i_dst, j_dst, xgrid_area, dst_area)

Interp% HI_KIND_TYPE_ % is_allocated = .true.
Interp% interp_method = CONSERVE

end subroutine HORIZ_INTERP_CONSERVE_NEW_2DX1D_

!#######################################################################
Expand Down Expand Up @@ -600,6 +609,9 @@ subroutine HORIZ_INTERP_CONSERVE_NEW_1DX1D_ ( Interp, lon_in, lat_in, lon_out, l

deallocate(i_src, j_src, i_dst, j_dst, xgrid_area, dst_area )

Interp% HI_KIND_TYPE_ % is_allocated = .true.
Interp% interp_method = CONSERVE

end subroutine HORIZ_INTERP_CONSERVE_NEW_2DX2D_

!########################################################################
Expand Down
2 changes: 2 additions & 0 deletions horiz_interp/include/horiz_interp_spherical.inc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -188,6 +188,8 @@

Interp%nlon_src = map_src_xsize; Interp%nlat_src = map_src_ysize
Interp%nlon_dst = map_dst_xsize; Interp%nlat_dst = map_dst_ysize
Interp% HI_KIND_TYPE_ % is_allocated = .true.
Interp% interp_method = SPHERICA

return

Expand Down
98 changes: 71 additions & 27 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 @@ -38,9 +38,12 @@ program horiz_interp_test
use fms_mod, only : check_nml_error, fms_init
use horiz_interp_mod, only : horiz_interp_init, horiz_interp_new, horiz_interp_del
use horiz_interp_mod, only : horiz_interp, horiz_interp_type
use horiz_interp_spherical_mod, only: horiz_interp_spherical_wght
use horiz_interp_type_mod, only: SPHERICA
use constants_mod, only : constants_init, PI
use horiz_interp_bilinear_mod, only: horiz_interp_bilinear_new
use horiz_interp_spherical_mod, only: horiz_interp_spherical_wght, horiz_interp_spherical_new
use horiz_interp_bicubic_mod, only: horiz_interp_bicubic_new
use horiz_interp_conserve_mod, only: horiz_interp_conserve_new
use platform_mod

implicit none
Expand Down Expand Up @@ -957,28 +960,30 @@ subroutine test_horiz_interp_conserve
!> Tests the assignment overload for horiz_interp_type
!! creates some new instances of the derived type for the different methods
!! and tests equality of fields after initial weiht calculations
!! Also tests creating the types via the method-specific *_new routines to ensure
!! they can be created/deleted without allocation errors.
subroutine test_assignment()
type(horiz_interp_type) :: Interp_new1, Interp_new2, Interp_cp, intp_3
!! grid data points
real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_in_1D, lon_in_1D
real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_in_2D, lon_in_2D
!! output data points
real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_out_1D, lon_out_1D
real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_out_2D, lon_out_2D
real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_out_bil, lon_out_bil
real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_in_bil, lon_in_bil
!! array sizes and number of lat/lon per index
real(HI_TEST_KIND_) :: nlon_in, nlat_in
real(HI_TEST_KIND_) :: nlon_out, nlat_out
real(HI_TEST_KIND_) :: dlon_src, dlat_src, dlon_dst, dlat_dst
!! parameters for lon/lat setup
real(HI_TEST_KIND_) :: lon_src_beg = 0._lkind, lon_src_end = 360._lkind
real(HI_TEST_KIND_) :: lat_src_beg = -90._lkind, lat_src_end = 90._lkind
real(HI_TEST_KIND_) :: lon_dst_beg = 0.0_lkind, lon_dst_end = 360._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_) :: R2D = 180._lkind/real(PI,HI_TEST_KIND_)
real(HI_TEST_KIND_), parameter :: SMALL = 1.0e-10_lkind
real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_in_1D, lon_in_1D !< 1D grid data points
real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_in_2D, lon_in_2D !< 2D grid data points
real(HI_TEST_KIND_), allocatable, dimension(:) :: lat_out_1D, lon_out_1D !< 1D grid output points
real(HI_TEST_KIND_), allocatable, dimension(:,:) :: lat_out_2D, lon_out_2D !< 2D grid output points
integer :: nlon_in, nlat_in !< array sizes for input grids
integer :: nlon_out, nlat_out !< array sizes for output grids
real(HI_TEST_KIND_) :: dlon_src, dlat_src, dlon_dst, dlat_dst !< lon/lat size per data point
real(HI_TEST_KIND_) :: lon_src_beg = 0._lkind, lon_src_end = 360._lkind!< source grid starting/ending
!! longitudes
real(HI_TEST_KIND_) :: lat_src_beg = -90._lkind, lat_src_end = 90._lkind !< source grid starting/ending
!! latitudes
real(HI_TEST_KIND_) :: lon_dst_beg = 0.0_lkind, lon_dst_end = 360._lkind !< destination grid
!! starting/ending longitudes
real(HI_TEST_KIND_) :: lat_dst_beg = -90._lkind, lat_dst_end = 90._lkind !< destination grid
!! starting/ending latitudes
real(HI_TEST_KIND_) :: D2R = real(PI,HI_TEST_KIND_)/180._lkind !< radians per degree
real(HI_TEST_KIND_) :: R2D = 180._lkind/real(PI,HI_TEST_KIND_) !< degrees per radian
real(HI_TEST_KIND_), allocatable :: lon_src_1d(:), lat_src_1d(:) !< src data used for bicubic test
real(HI_TEST_KIND_), allocatable :: lon_dst_1d(:), lat_dst_1d(:) !< destination data used for bicubic test


! 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 @@ -1062,6 +1067,15 @@ subroutine test_assignment()
call horiz_interp_del(Interp_new1)
call horiz_interp_del(Interp_new2)
call horiz_interp_del(Interp_cp)
! test deletion after direct calls
call horiz_interp_conserve_new(Interp_new1, lon_in_1d, lat_in_1d, lon_out_1d, lat_out_1d)
call horiz_interp_del(Interp_new1)
call horiz_interp_conserve_new(Interp_new1, lon_in_1d, lat_in_1d, lon_out_2d, lat_out_2d)
call horiz_interp_del(Interp_new1)
call horiz_interp_conserve_new(Interp_new1, lon_in_2d, lat_in_2d, lon_out_1d, lat_out_1d)
call horiz_interp_del(Interp_new1)
call horiz_interp_conserve_new(Interp_new1, lon_in_2d, lat_in_2d, lon_out_2d, lat_out_2d)
call horiz_interp_del(Interp_new1)

! bicubic only works with 1d src
! 1dx1d
Expand All @@ -1084,6 +1098,28 @@ subroutine test_assignment()
call horiz_interp_del(Interp_new1)
call horiz_interp_del(Interp_new2)
call horiz_interp_del(Interp_cp)
! test deletion after direct calls
! this set up is usually done within horiz_interp_new
nlon_in = size(lon_in_1d(:))-1; nlat_in = size(lat_in_1d(:))-1
nlon_out = size(lon_out_1d(:))-1; nlat_out = size(lat_out_1d(:))-1
allocate(lon_src_1d(nlon_in), lat_src_1d(nlat_in))
allocate(lon_dst_1d(nlon_out), lat_dst_1d(nlat_out))
do i = 1, nlon_in
lon_src_1d(i) = (lon_in_1d(i) + lon_in_1d(i+1)) * 0.5_lkind
enddo
do j = 1, nlat_in
lat_src_1d(j) = (lat_in_1d(j) + lat_in_1d(j+1)) * 0.5_lkind
enddo
do i = 1, nlon_out
lon_dst_1d(i) = (lon_out_1d(i) + lon_out_1d(i+1)) * 0.5_lkind
enddo
do j = 1, nlat_out
lat_dst_1d(j) = (lat_out_1d(j) + lat_out_1d(j+1)) * 0.5_lkind
enddo
call horiz_interp_bicubic_new(Interp_new1, lon_src_1d, lat_src_1d, lon_out_2d, lat_out_2d)
call horiz_interp_del(Interp_new1)
call horiz_interp_bicubic_new(Interp_new1, lon_src_1d, lat_src_1d, lon_dst_1d, lat_dst_1d)
call horiz_interp_del(Interp_new1)

deallocate(lon_out_2D, lat_out_2D, lon_in_2D, lat_in_2D)
allocate(lon_out_2D(ni_dst, nj_dst), lat_out_2D(ni_dst, nj_dst))
Expand Down Expand Up @@ -1117,11 +1153,14 @@ subroutine test_assignment()
call horiz_interp_del(Interp_new1)
call horiz_interp_del(Interp_new2)
call horiz_interp_del(Interp_cp)
! check deletion after direct calls
call horiz_interp_spherical_new(Interp_new1, lon_in_2d, lat_in_2d, lon_out_2d, lat_out_2d)
call horiz_interp_del(Interp_new1)

! bilinear
! 1dx1d
call horiz_interp_new(Interp_new1, lon_in_1D, lat_in_1D, lon_in_1D, lat_in_1D, interp_method="bilinear")
call horiz_interp_new(Interp_new2, lon_in_1D, lat_in_1D, lon_in_1D, lat_in_1D, interp_method="bilinear")
call horiz_interp_new(Interp_new1, lon_in_1D, lat_in_1D, lon_out_1D, lat_out_1D, interp_method="bilinear")
call horiz_interp_new(Interp_new2, lon_in_1D, lat_in_1D, lon_out_1D, lat_out_1D, interp_method="bilinear")
Interp_cp = Interp_new1
call mpp_error(NOTE,"testing horiz_interp_type assignment 1x1d bilinear")
call check_type_eq(Interp_cp, Interp_new2)
Expand All @@ -1130,8 +1169,8 @@ subroutine test_assignment()
call horiz_interp_del(Interp_new2)
call horiz_interp_del(Interp_cp)
! 1dx2d
call horiz_interp_new(Interp_new1, lon_in_1D, lat_in_1D, lon_in_2D, lat_in_2D, interp_method="bilinear")
call horiz_interp_new(Interp_new2, lon_in_1D, lat_in_1D, lon_in_2D, lat_in_2D, interp_method="bilinear")
call horiz_interp_new(Interp_new1, lon_in_1D, lat_in_1D, lon_out_2D, lat_out_2D, interp_method="bilinear")
call horiz_interp_new(Interp_new2, lon_in_1D, lat_in_1D, lon_out_2D, lat_out_2D, interp_method="bilinear")
Interp_cp = Interp_new1
call mpp_error(NOTE,"testing horiz_interp_type assignment 1x2d bilinear")
call check_type_eq(Interp_cp, Interp_new2)
Expand Down Expand Up @@ -1160,15 +1199,20 @@ subroutine test_assignment()
call horiz_interp_del(Interp_new2)
call horiz_interp_del(Interp_cp)
! 2dx2d
call horiz_interp_new(Interp_new1, lon_in_2D, lat_in_2D, lon_in_2D, lat_in_2D, interp_method="bilinear")
call horiz_interp_new(Interp_new2, lon_in_2D, lat_in_2D, lon_in_2D, lat_in_2D, interp_method="bilinear")
call horiz_interp_new(Interp_new1, lon_in_2D, lat_in_2D, lon_out_2D, lat_out_2D, interp_method="bilinear")
call horiz_interp_new(Interp_new2, lon_in_2D, lat_in_2D, lon_out_2D, lat_out_2D, interp_method="bilinear")
Interp_cp = Interp_new1
call mpp_error(NOTE,"testing horiz_interp_type assignment 1x2d bilinear")
call check_type_eq(Interp_cp, Interp_new2)
call check_type_eq(Interp_cp, Interp_new1)
call horiz_interp_del(Interp_new1)
call horiz_interp_del(Interp_new2)
call horiz_interp_del(Interp_cp)
! check deletion after direct calls
call horiz_interp_bilinear_new(Interp_new1, lon_in_1d, lat_in_1d, lon_out_2d, lat_out_2d)
call horiz_interp_del(Interp_new1)
call horiz_interp_bilinear_new(Interp_new1, lon_in_2d, lat_in_2d, lon_out_2d, lat_out_2d)
call horiz_interp_del(Interp_new1)

end subroutine
!> helps assignment test with derived type comparisons
Expand Down
Loading