Monotonic regridding

CHANGELOG.md

@@ -17,6 +17,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Add debug loggers for start/stop during stages in MAPL_Generic
 - Handling for double precision input when retrieving single precision attributes
 - Enable GCM run test in CircleCI (1-hour, no ExtData)
+- Added monotonic regridding option
+- Make availalbe to History and ExtData2G all supported regridding methods
 
 ### Changed
 

base/MAPL_EsmfRegridder.F90

@@ -83,8 +83,10 @@ logical function supports(spec, unusable, rc)
       supports = any(spec%regrid_method  == &
            [ &
            REGRID_METHOD_BILINEAR, &
+           REGRID_METHOD_BILINEAR_MONOTONIC, &
            REGRID_METHOD_BILINEAR_ROTATE, &
            REGRID_METHOD_CONSERVE, &
+           REGRID_METHOD_CONSERVE_MONOTONIC, &
            REGRID_METHOD_VOTE, &
            REGRID_METHOD_FRACTION, &
            REGRID_METHOD_CONSERVE_2ND, &
@@ -1172,7 +1174,56 @@ subroutine simpleDynMaskProcV(dynamicMaskList, dynamicSrcMaskValue, &
       rc = ESMF_SUCCESS
    end subroutine simpleDynMaskProcV
 
+   subroutine monotonicDynMaskProcV(dynamicMaskList, dynamicSrcMaskValue, &
+        dynamicDstMaskValue, rc)
+      type(ESMF_DynamicMaskElementR4R8R4V), pointer              :: dynamicMaskList(:)
+      real(ESMF_KIND_R4),            intent(in), optional :: dynamicSrcMaskValue
+      real(ESMF_KIND_R4),            intent(in), optional :: dynamicDstMaskValue
+      integer,                       intent(out)          :: rc
+      integer :: i, j, k, n
+      real(ESMF_KIND_R4), allocatable  :: renorm(:),max_input(:),min_input(:)
 
+      _UNUSED_DUMMY(dynamicDstMaskValue)
+
+      if (associated(dynamicMaskList)) then
+         n = size(dynamicMaskList(1)%srcElement(1)%ptr)
+         allocate(renorm(n),max_input(n),min_input(n))
+
+         do i=1, size(dynamicMaskList)
+            dynamicMaskList(i)%dstElement = 0.0 ! set to zero
+
+            renorm = 0.d0 ! reset
+            max_input = -huge(0.0)
+            min_input = huge(0.0)
+            do j=1, size(dynamicMaskList(i)%factor)
+               do k = 1, size(dynamicMaskList(i)%srcElement(j)%ptr)
+                  if (.not. &
+                       match(dynamicSrcMaskValue,dynamicMaskList(i)%srcElement(j)%ptr(k))) then
+                     dynamicMaskList(i)%dstElement(k) = dynamicMaskList(i)%dstElement(k) &
+                          + dynamicMaskList(i)%factor(j) &
+                          * dynamicMaskList(i)%srcElement(j)%ptr(k)
+                     renorm(k) = renorm(k) + dynamicMaskList(i)%factor(j)
+                     if (dynamicMaskList(i)%srcElement(j)%ptr(k) > max_input(k)) max_input(k) = dynamicMaskList(i)%srcElement(j)%ptr(k)
+                     if (dynamicMaskList(i)%srcElement(j)%ptr(k) < min_input(k)) min_input(k) = dynamicMaskList(i)%srcElement(j)%ptr(k)
+                  endif
+               end do
+            end do
+            where (renorm > 0.d0)
+               dynamicMaskList(i)%dstElement = dynamicMaskList(i)%dstElement / renorm
+            elsewhere
+               dynamicMaskList(i)%dstElement = dynamicSrcMaskValue
+            end where
+            where (renorm > 0.d0 .and. dynamicMaskList(i)%dstElement > max_input)
+               dynamicMaskList(i)%dstElement = max_input
+            end where
+            where (renorm > 0.d0 .and. dynamicMaskList(i)%dstElement < min_input)
+               dynamicMaskList(i)%dstElement = min_input
+            end where
+         enddo
+      endif
+      ! return successfully
+      rc = ESMF_SUCCESS
+   end subroutine monotonicDynMaskProcV
 
 
    logical function match(missing,b)
@@ -1337,6 +1388,13 @@ subroutine initialize_subclass(this, unusable, rc)
              & dynamicMaskRoutine=simpleDynMaskProcV, &
              & rc=rc)
         _VERIFY(rc)
+     case (REGRID_METHOD_BILINEAR_MONOTONIC, REGRID_METHOD_CONSERVE_MONOTONIC)
+        call ESMF_DynamicMaskSetR4R8R4V(this%dynamic_mask, &
+             & dynamicSrcMaskValue=MAPL_undef, &
+             & dynamicMaskRoutine=monotonicDynMaskProcV, &
+             & handleAllElements=.true., &
+             & rc=rc)
+        _VERIFY(rc)
      case (REGRID_METHOD_VOTE)
         call ESMF_DynamicMaskSetR4R8R4V(this%dynamic_mask, &
              & dynamicSrcMaskValue=MAPL_undef, &
@@ -1435,7 +1493,7 @@ subroutine create_route_handle(this, kind, rc)
            if (.not.global) unmappedaction=ESMF_UNMAPPEDACTION_IGNORE
         end if
         select case (spec%regrid_method)
-        case (REGRID_METHOD_BILINEAR)
+        case (REGRID_METHOD_BILINEAR, REGRID_METHOD_BILINEAR_MONOTONIC)
 
            call ESMF_FieldRegridStore(src_field, dst_field, &
                 & regridmethod=ESMF_REGRIDMETHOD_BILINEAR, &
@@ -1462,7 +1520,7 @@ subroutine create_route_handle(this, kind, rc)
                 & factorList=factorList, factorIndexList=factorIndexList, &
                 & routehandle=route_handle, unmappedaction=unmappedaction, rc=status)
            _VERIFY(status)
-        case (REGRID_METHOD_CONSERVE, REGRID_METHOD_VOTE, REGRID_METHOD_FRACTION)
+        case (REGRID_METHOD_CONSERVE, REGRID_METHOD_CONSERVE_MONOTONIC, REGRID_METHOD_VOTE, REGRID_METHOD_FRACTION)
            call ESMF_FieldRegridStore(src_field, dst_field, &
                 & regridmethod=ESMF_REGRIDMETHOD_CONSERVE, &
                 & srcTermProcessing = srcTermProcessing, &

base/RegridMethods.F90

@@ -1,12 +1,15 @@
 module mapl_RegridMethods
+   use ESMF
    implicit none
    private
 
    public :: REGRID_HINT_LOCAL
    public :: REGRID_METHOD_IDENTITY
    public :: REGRID_METHOD_BILINEAR
+   public :: REGRID_METHOD_BILINEAR_MONOTONIC
    public :: REGRID_METHOD_BILINEAR_ROTATE
    public :: REGRID_METHOD_CONSERVE
+   public :: REGRID_METHOD_CONSERVE_MONOTONIC
    public :: REGRID_METHOD_VOTE
    public :: REGRID_METHOD_FRACTION
    public :: REGRID_METHOD_CONSERVE_2ND
@@ -15,6 +18,7 @@ module mapl_RegridMethods
    public :: REGRID_METHOD_CONSERVE_HFLUX
    public :: UNSPECIFIED_REGRID_METHOD
    public :: TILING_METHODS
+   public :: get_regrid_method
 
    enum, bind(c)
       enumerator :: REGRID_METHOD_IDENTITY
@@ -27,10 +31,48 @@ module mapl_RegridMethods
       enumerator :: REGRID_METHOD_PATCH
       enumerator :: REGRID_METHOD_NEAREST_STOD
       enumerator :: REGRID_METHOD_CONSERVE_HFLUX
+      enumerator :: REGRID_METHOD_BILINEAR_MONOTONIC
+      enumerator :: REGRID_METHOD_CONSERVE_MONOTONIC
       enumerator :: UNSPECIFIED_REGRID_METHOD = -1
    end enum
    integer, parameter :: TILING_METHODS(3) = [REGRID_METHOD_CONSERVE,REGRID_METHOD_VOTE,REGRID_METHOD_FRACTION]
    integer, parameter :: REGRID_HINT_LOCAL = 1
 
+   contains
+
+   function get_regrid_method(string_regrid_method) result(int_regrid_method)
+      integer :: int_regrid_method
+      character(len=*), intent(in) :: string_regrid_method
+
+      character(len=:), allocatable :: temp_str
+      temp_str = ESMF_UtilStringUpperCase(trim(string_regrid_method))
+
+      select case (temp_str)
+      case ("IDENTITY")
+         int_regrid_method = REGRID_METHOD_IDENTITY
+      case ("BILINEAR")
+         int_regrid_method = REGRID_METHOD_BILINEAR
+      case ("BILINEAR_ROTATE")
+         int_regrid_method = REGRID_METHOD_BILINEAR_ROTATE
+      case ("CONSERVE")
+         int_regrid_method = REGRID_METHOD_CONSERVE
+      case ("VOTE")
+         int_regrid_method = REGRID_METHOD_VOTE
+      case ("FRACTION")
+         int_regrid_method = REGRID_METHOD_FRACTION   
+      case ("CONSERVE_2ND")
+         int_regrid_method = REGRID_METHOD_CONSERVE_2ND
+      case ("PATCH")
+         int_regrid_method = REGRID_METHOD_PATCH
+      case ("CONSERVE_HFLUX")
+         int_regrid_method = REGRID_METHOD_CONSERVE_HFLUX
+      case ("CONSERVE_MONOTONIC")
+         int_regrid_method = REGRID_METHOD_CONSERVE_MONOTONIC
+      case ("BILINEAR_MONOTONIC")
+         int_regrid_method = REGRID_METHOD_BILINEAR_MONOTONIC
+      case default
+         int_regrid_method = UNSPECIFIED_REGRID_METHOD
+      end select
+   end function
 
 end module mapl_RegridMethods

gridcomps/ExtData2G/ExtDataConfig.F90

@@ -344,14 +344,14 @@ subroutine add_new_rule(this,key,export_rule,multi_rule,rc)
          uname = key(1:semi_pos-1)
          vname = key(semi_pos+1:len_trim(key))
          temp_rule => this%rule_map%at(trim(uname))
-         _ASSERT(.not.associated(temp_rule),"duplicated export entry key")
+         _ASSERT(.not.associated(temp_rule),"duplicated export entry key: "//trim(key))
          call this%rule_map%insert(trim(uname),ucomp)
          temp_rule => this%rule_map%at(trim(vname))
-         _ASSERT(.not.associated(temp_rule),"duplicated export entry key")
+         _ASSERT(.not.associated(temp_rule),"duplicated export entry key: "//trim(key))
          call this%rule_map%insert(trim(vname),vcomp)
       else
          temp_rule => this%rule_map%at(trim(key))
-         _ASSERT(.not.associated(temp_rule),"duplicated export entry key")
+         _ASSERT(.not.associated(temp_rule),"duplicated export entry key: "//trim(key))
          call this%rule_map%insert(trim(key),rule)
       end if
       _RETURN(_SUCCESS)

gridcomps/ExtData2G/ExtDataOldTypesCreator.F90

@@ -108,19 +108,14 @@ subroutine fillin_primary(this,item_name,base_name,primary_item,time,clock,unusa
       end if
 
       ! regrid method
-      if (trim(rule%regrid_method) == "BILINEAR") then
-         primary_item%trans = REGRID_METHOD_BILINEAR
-      else if (trim(rule%regrid_method) == "CONSERVE") then
-         primary_item%trans = REGRID_METHOD_CONSERVE
-      else if (trim(rule%regrid_method) == "VOTE") then
-         primary_item%trans = REGRID_METHOD_VOTE
-      else if (index(rule%regrid_method,"FRACTION;")>0) then
+      if (index(rule%regrid_method,"FRACTION;")>0) then
          semi_pos = index(rule%regrid_method,";")
          read(rule%regrid_method(semi_pos+1:),*) primary_item%fracVal
          primary_item%trans = REGRID_METHOD_FRACTION
-      else 
-         _FAIL("Invalid regridding method")
+      else
+         primary_item%trans = get_regrid_method(rule%regrid_method)
       end if
+      _ASSERT(primary_item%trans/=UNSPECIFIED_REGRID_METHOD,"improper regrid method chosen")
 
       if (trim(time_sample%extrap_outside) =="clim") then
          primary_item%cycling=.true.

gridcomps/History/MAPL_HistoryCollection.F90

@@ -70,7 +70,7 @@ module MAPL_HistoryCollectionMod
      real                               :: vscale
      character(len=ESMF_MAXSTR)         :: vunit
      character(len=ESMF_MAXSTR)         :: vvars(2)
-     integer                            :: conservative
+     integer                            :: regrid_method
      integer                            :: voting
      integer                            :: nbits
      integer                            :: deflate

gridcomps/History/MAPL_HistoryGridComp.F90

@@ -425,7 +425,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc )
     type(ESMF_Field), allocatable :: fldList(:)
     character(len=ESMF_MAXSTR), allocatable :: regexList(:)
     type(StringStringMap) :: global_attributes
-    character(len=ESMF_MAXSTR) :: name
+    character(len=ESMF_MAXSTR) :: name,regrid_method
+    logical :: has_conservative_keyword, has_regrid_keyword
 
 ! Begin
 !------
@@ -880,13 +881,27 @@ subroutine Initialize ( gc, import, dumexport, clock, rc )
        call ESMF_ConfigGetAttribute ( cfg, list(n)%tm, default=tm_default, &
                                       label=trim(string) // 'tm:', rc=status )
        _VERIFY(STATUS)
-       call ESMF_ConfigGetAttribute ( cfg, list(n)%conservative, default=0, &
-                                      label=trim(string) // 'conservative:'  ,rc=status )
-       _VERIFY(STATUS)
-       if (list(n)%conservative==0) then
-          list(n)%conservative=REGRID_METHOD_BILINEAR
-       else if (list(n)%conservative==1) then
-          list(n)%conservative=REGRID_METHOD_CONSERVE
+
+       call ESMF_ConfigFindLabel ( cfg, label=trim(string) // 'conservative:',isPresent=has_conservative_keyword,_RC)
+       call ESMF_ConfigFindLabel ( cfg, label=trim(string) // 'regrid_method:',isPresent=has_regrid_keyword,_RC)
+       _ASSERT(.not.(has_conservative_keyword .and. has_regrid_keyword),trim(string)//" specified both conservative and regrid_method")
+
+       list(n)%regrid_method = REGRID_METHOD_BILINEAR
+       if (has_conservative_keyword) then
+          call ESMF_ConfigGetAttribute ( cfg, list(n)%regrid_method, default=0, &
+                                         label=trim(string) // 'conservative:'  ,rc=status )
+          _VERIFY(STATUS)
+          if (list(n)%regrid_method==0) then
+             list(n)%regrid_method=REGRID_METHOD_BILINEAR
+          else if (list(n)%regrid_method==1) then
+             list(n)%regrid_method=REGRID_METHOD_CONSERVE
+          end if
+       end if
+       if (has_regrid_keyword) then
+          call ESMF_ConfigGetAttribute ( cfg, regrid_method, default="REGRID_METHOD_BILINEAR", &
+                                         label=trim(string) // 'regrid_method:'  ,rc=status )
+          _VERIFY(STATUS)
+           list(n)%regrid_method = get_regrid_method(trim(regrid_method))
        end if
 
 ! Get an optional file containing a 1-D track for the output
@@ -2482,7 +2497,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc )
           _VERIFY(status)
           call list(n)%mGriddedIO%set_param(nbits=list(n)%nbits,rc=status)
           _VERIFY(status)
-          call list(n)%mGriddedIO%set_param(regrid_method=list(n)%conservative,rc=status)
+          call list(n)%mGriddedIO%set_param(regrid_method=list(n)%regrid_method,rc=status)
           _VERIFY(status)
           call list(n)%mGriddedIO%set_param(itemOrder=intState%fileOrderAlphabetical,rc=status)
           _VERIFY(status)

griddedio/Regrid_Util.F90

@@ -182,23 +182,8 @@ subroutine process_command_line(this,rc)
       end select
     enddo
 
-    if (trim(regridMth) .ne. 'bilinear' .and. trim(regridMth ) .ne. 'conservative' .and. trim(regridMth ) .ne. 'conservative2' .and. &
-         trim(regridMth).ne.'patch') then
-       if (MAPL_AM_I_Root()) write(*,*)'invalid regrid method choose bilinear or conservative'
-       _FAIL('needs informative message')
-    end if
-    if (trim(regridMth) == 'bilinear') then
-       this%regridMethod = REGRID_METHOD_BILINEAR
-    end if
-    if (trim(regridMth) == 'patch') then
-       this%regridMethod = REGRID_METHOD_PATCH
-    end if
-    if (trim(regridMth) == 'conservative') then
-       this%regridMethod = REGRID_METHOD_CONSERVE
-    end if
-    if (trim(regridMth) == 'conservative2') then
-       this%regridMethod = REGRID_METHOD_CONSERVE_2ND
-    end if
+    this%regridMethod = get_regrid_method(regridMth)
+    _ASSERT(this%regridMethod/=UNSPECIFIED_REGRID_METHOD,"improper regrid method chosen")
 
     this%filenames = split_string(cfilenames,',')
     this%outputfiles = split_string(coutputfiles,',')