fix: set is_allocated in all horiz_interp_type_new routines and renam…

…e SPHERICA constant (NOAA-GFDL#1538)
rem1776 · Jun 28, 2024 · 7d8aa21 · 7d8aa21
1 parent eeedbab
commit 7d8aa21
Show file tree

Hide file tree

Showing 15 changed files with 116 additions and 51 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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