diff --git a/horiz_interp/horiz_interp.F90 b/horiz_interp/horiz_interp.F90 index 820e9079b..07df2b7a6 100644 --- a/horiz_interp/horiz_interp.F90 +++ b/horiz_interp/horiz_interp.F90 @@ -49,7 +49,7 @@ module horiz_interp_mod use mpp_mod, only: input_nml_file, WARNING, mpp_pe, mpp_root_pe use constants_mod, only: pi use horiz_interp_type_mod, only: horiz_interp_type, assignment(=) -use horiz_interp_type_mod, only: CONSERVE, BILINEAR, SPHERICA, BICUBIC +use horiz_interp_type_mod, only: CONSERVE, BILINEAR, SPHERICAL, BICUBIC use horiz_interp_conserve_mod, only: horiz_interp_conserve_init, horiz_interp_conserve use horiz_interp_conserve_mod, only: horiz_interp_conserve_new, horiz_interp_conserve_del use horiz_interp_bilinear_mod, only: horiz_interp_bilinear_init, horiz_interp_bilinear @@ -294,7 +294,7 @@ subroutine horiz_interp_del ( Interp ) call horiz_interp_bilinear_del(Interp ) case (BICUBIC) call horiz_interp_bicubic_del(Interp ) - case (SPHERICA) + case (SPHERICAL) call horiz_interp_spherical_del(Interp ) end select diff --git a/horiz_interp/horiz_interp_bicubic.F90 b/horiz_interp/horiz_interp_bicubic.F90 index 25ac5c1a5..b4e8778cd 100644 --- a/horiz_interp/horiz_interp_bicubic.F90 +++ b/horiz_interp/horiz_interp_bicubic.F90 @@ -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 diff --git a/horiz_interp/horiz_interp_bilinear.F90 b/horiz_interp/horiz_interp_bilinear.F90 index 318d2c039..2fe80b989 100644 --- a/horiz_interp/horiz_interp_bilinear.F90 +++ b/horiz_interp/horiz_interp_bilinear.F90 @@ -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 diff --git a/horiz_interp/horiz_interp_conserve.F90 b/horiz_interp/horiz_interp_conserve.F90 index b1b04a1b3..5f345e976 100644 --- a/horiz_interp/horiz_interp_conserve.F90 +++ b/horiz_interp/horiz_interp_conserve.F90 @@ -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 diff --git a/horiz_interp/horiz_interp_spherical.F90 b/horiz_interp/horiz_interp_spherical.F90 index 128b7fd47..28110d343 100644 --- a/horiz_interp/horiz_interp_spherical.F90 +++ b/horiz_interp/horiz_interp_spherical.F90 @@ -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, SPHERICAL implicit none private diff --git a/horiz_interp/horiz_interp_type.F90 b/horiz_interp/horiz_interp_type.F90 index 7f8b300a9..e87870698 100644 --- a/horiz_interp/horiz_interp_type.F90 +++ b/horiz_interp/horiz_interp_type.F90 @@ -38,10 +38,10 @@ module horiz_interp_type_mod ! parameter to determine interpolation method integer, parameter :: CONSERVE = 1 integer, parameter :: BILINEAR = 2 - integer, parameter :: SPHERICA = 3 + integer, parameter :: SPHERICAL = 3 integer, parameter :: BICUBIC = 4 -public :: CONSERVE, BILINEAR, SPHERICA, BICUBIC +public :: CONSERVE, BILINEAR, SPHERICAL, BICUBIC public :: horiz_interp_type, stats, assignment(=) !> @} diff --git a/horiz_interp/include/horiz_interp.inc b/horiz_interp/include/horiz_interp.inc index ec0540b44..036b87a26 100644 --- a/horiz_interp/include/horiz_interp.inc +++ b/horiz_interp/include/horiz_interp.inc @@ -120,7 +120,7 @@ deallocate(lon_src_1d, lat_src_1d, lon_dst_1d, lat_dst_1d) endif case ("spherical") - Interp%interp_method = SPHERICA + Interp%interp_method = SPHERICAL nlon_in = size(lon_in(:)); nlat_in = size(lat_in(:)) nlon_out = size(lon_out(:)); nlat_out = size(lat_out(:)) allocate(lon_src(nlon_in,nlat_in), lat_src(nlon_in,nlat_in)) @@ -246,7 +246,7 @@ deallocate(lon_src_1d,lat_src_1d) endif case ("spherical") - Interp%interp_method = SPHERICA + Interp%interp_method = SPHERICAL nlon_in = size(lon_in(:)); nlat_in = size(lat_in(:)) allocate(lon_src(nlon_in,nlat_in), lat_src(nlon_in,nlat_in)) do i = 1, nlon_in @@ -329,7 +329,7 @@ end if case ("spherical") - Interp%interp_method = SPHERICA + Interp%interp_method = SPHERICAL call horiz_interp_spherical_new ( Interp, lon_in, lat_in, lon_out, lat_out, & num_nbrs, max_dist, src_modulo ) case ("bilinear") @@ -409,7 +409,7 @@ call horiz_interp_bilinear_new ( Interp, lon_in, lat_in, lon_dst, lat_dst, & verbose, src_modulo ) case ("spherical") - Interp%interp_method = SPHERICA + Interp%interp_method = SPHERICAL call horiz_interp_spherical_new ( Interp, lon_in, lat_in, lon_dst, lat_dst, & num_nbrs, max_dist, src_modulo) case default @@ -454,7 +454,7 @@ case(BICUBIC) call horiz_interp_bicubic(Interp,data_in, data_out, verbose, mask_in, mask_out, & missing_value, missing_permit ) - case(SPHERICA) + case(SPHERICAL) call horiz_interp_spherical(Interp,data_in, data_out, verbose, mask_in, mask_out, & missing_value ) case default diff --git a/horiz_interp/include/horiz_interp_bicubic.inc b/horiz_interp/include/horiz_interp_bicubic.inc index 5ff567dbb..e4f180c65 100644 --- a/horiz_interp/include/horiz_interp_bicubic.inc +++ b/horiz_interp/include/horiz_interp_bicubic.inc @@ -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 @@ -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 @@ -427,7 +431,7 @@ enddo enddo return - end subroutine HORIZ_INTERP_BICUBIC_NEW_ + end subroutine HORIZ_INTERP_BICUBIC_ !--------------------------------------------------------------------------- diff --git a/horiz_interp/include/horiz_interp_bicubic_r4.fh b/horiz_interp/include/horiz_interp_bicubic_r4.fh index 1d3b14848..bc9c0037d 100644 --- a/horiz_interp/include/horiz_interp_bicubic_r4.fh +++ b/horiz_interp/include/horiz_interp_bicubic_r4.fh @@ -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 diff --git a/horiz_interp/include/horiz_interp_bicubic_r8.fh b/horiz_interp/include/horiz_interp_bicubic_r8.fh index d26976772..e37a234bf 100644 --- a/horiz_interp/include/horiz_interp_bicubic_r8.fh +++ b/horiz_interp/include/horiz_interp_bicubic_r8.fh @@ -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 diff --git a/horiz_interp/include/horiz_interp_bilinear.inc b/horiz_interp/include/horiz_interp_bilinear.inc index 9e352d9c3..f178ebec1 100644 --- a/horiz_interp/include/horiz_interp_bilinear.inc +++ b/horiz_interp/include/horiz_interp_bilinear.inc @@ -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 @@ -396,6 +398,8 @@ enddo enddo + Interp% HI_KIND_TYPE_ % is_allocated = .true. + Interp% interp_method = BILINEAR end subroutine !####################################################################### diff --git a/horiz_interp/include/horiz_interp_conserve.inc b/horiz_interp/include/horiz_interp_conserve.inc index 0ec17fcac..1d2212dab 100644 --- a/horiz_interp/include/horiz_interp_conserve.inc +++ b/horiz_interp/include/horiz_interp_conserve.inc @@ -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_ !####################################################################### @@ -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_ !####################################################################### @@ -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_ !####################################################################### @@ -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_ !######################################################################## diff --git a/horiz_interp/include/horiz_interp_spherical.inc b/horiz_interp/include/horiz_interp_spherical.inc index cc00a4264..f848622a7 100644 --- a/horiz_interp/include/horiz_interp_spherical.inc +++ b/horiz_interp/include/horiz_interp_spherical.inc @@ -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 = SPHERICAL return diff --git a/libFMS.F90 b/libFMS.F90 index 42879958f..9180be32f 100644 --- a/libFMS.F90 +++ b/libFMS.F90 @@ -414,8 +414,7 @@ module fms fms_horiz_interp_del => horiz_interp_del, fms_horiz_interp_init => horiz_interp_init, & fms_horiz_interp_end => horiz_interp_end use horiz_interp_type_mod, only: FmsHorizInterp_type => horiz_interp_type, & - assignment(=), CONSERVE, BILINEAR, SPHERICA, BICUBIC, & - fms_horiz_interp_type_stats => stats + assignment(=), fms_horiz_interp_type_stats => stats !! used via horiz_interp ! horiz_interp_bicubic_mod, horiz_interp_bilinear_mod ! horiz_interp_conserve_mod, horiz_interp_spherical_mod diff --git a/test_fms/horiz_interp/test_horiz_interp.F90 b/test_fms/horiz_interp/test_horiz_interp.F90 index fd0d077a9..c56cf931f 100644 --- a/test_fms/horiz_interp/test_horiz_interp.F90 +++ b/test_fms/horiz_interp/test_horiz_interp.F90 @@ -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 horiz_interp_type_mod, only: SPHERICAL 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 @@ -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) @@ -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 @@ -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)) @@ -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) @@ -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) @@ -1160,8 +1199,8 @@ 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) @@ -1169,6 +1208,11 @@ 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_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 @@ -1230,7 +1274,7 @@ subroutine check_type_eq(interp_1, interp_2) call mpp_error(FATAL, "Invalid value for copied horiz_interp_type field: mask_in") endif !! only set during spherical - if(interp_1%interp_method .eq. SPHERICA) then + if(interp_1%interp_method .eq. SPHERICAL) then if( interp_2%horizInterpReals4_type%max_src_dist .ne. interp_1%horizInterpReals4_type%max_src_dist) & call mpp_error(FATAL, "Invalid value for copied horiz_interp_type field: max_src_dist") endif @@ -1292,7 +1336,7 @@ subroutine check_type_eq(interp_1, interp_2) endif !! only set during spherical - if(interp_1%interp_method .eq. SPHERICA) then + if(interp_1%interp_method .eq. SPHERICAL) then if( interp_2%horizInterpReals8_type%max_src_dist .ne. interp_1%horizInterpReals8_type%max_src_dist) & call mpp_error(FATAL, "Invalid value for copied horiz_interp_type field: max_src_dist") endif