DynamicMask.F90 Source File


This file depends on

sourcefile~~dynamicmask.f90~~EfferentGraph sourcefile~dynamicmask.f90 DynamicMask.F90 sourcefile~base_base.f90 Base_Base.F90 sourcefile~dynamicmask.f90->sourcefile~base_base.f90 sourcefile~errorhandling.f90 ErrorHandling.F90 sourcefile~dynamicmask.f90->sourcefile~errorhandling.f90 sourcefile~constants.f90 Constants.F90 sourcefile~base_base.f90->sourcefile~constants.f90 sourcefile~keywordenforcer.f90 KeywordEnforcer.F90 sourcefile~base_base.f90->sourcefile~keywordenforcer.f90 sourcefile~mapl_range.f90 MAPL_Range.F90 sourcefile~base_base.f90->sourcefile~mapl_range.f90 sourcefile~maplgrid.f90 MaplGrid.F90 sourcefile~base_base.f90->sourcefile~maplgrid.f90 sourcefile~mapl_throw.f90 MAPL_Throw.F90 sourcefile~errorhandling.f90->sourcefile~mapl_throw.f90 sourcefile~internalconstants.f90 InternalConstants.F90 sourcefile~constants.f90->sourcefile~internalconstants.f90 sourcefile~mathconstants.f90 MathConstants.F90 sourcefile~constants.f90->sourcefile~mathconstants.f90 sourcefile~physicalconstants.f90 PhysicalConstants.F90 sourcefile~constants.f90->sourcefile~physicalconstants.f90 sourcefile~mapl_exceptionhandling.f90 MAPL_ExceptionHandling.F90 sourcefile~mapl_range.f90->sourcefile~mapl_exceptionhandling.f90 sourcefile~maplgrid.f90->sourcefile~errorhandling.f90 sourcefile~maplgrid.f90->sourcefile~constants.f90 sourcefile~maplgrid.f90->sourcefile~keywordenforcer.f90 sourcefile~mapl_sort.f90 MAPL_Sort.F90 sourcefile~maplgrid.f90->sourcefile~mapl_sort.f90 sourcefile~pflogger_stub.f90 pflogger_stub.F90 sourcefile~maplgrid.f90->sourcefile~pflogger_stub.f90 sourcefile~mapl_exceptionhandling.f90->sourcefile~errorhandling.f90 sourcefile~mapl_exceptionhandling.f90->sourcefile~mapl_throw.f90 sourcefile~mapl_sort.f90->sourcefile~mapl_exceptionhandling.f90 sourcefile~pfl_keywordenforcer.f90 PFL_KeywordEnforcer.F90 sourcefile~pflogger_stub.f90->sourcefile~pfl_keywordenforcer.f90 sourcefile~wraparray.f90 WrapArray.F90 sourcefile~pflogger_stub.f90->sourcefile~wraparray.f90 sourcefile~physicalconstants.f90->sourcefile~mathconstants.f90

Files dependent on this one

sourcefile~~dynamicmask.f90~~AfferentGraph sourcefile~dynamicmask.f90 DynamicMask.F90 sourcefile~regridder_mgr.f90 regridder_mgr.F90 sourcefile~regridder_mgr.f90->sourcefile~dynamicmask.f90 sourcefile~regridaction.f90 RegridAction.F90 sourcefile~regridaction.f90->sourcefile~regridder_mgr.f90 sourcefile~test_regriddermanager.pf Test_RegridderManager.pf sourcefile~test_regriddermanager.pf->sourcefile~regridder_mgr.f90 sourcefile~test_routehandlemanager.pf Test_RouteHandleManager.pf sourcefile~test_routehandlemanager.pf->sourcefile~regridder_mgr.f90 sourcefile~timeinterpolateaction.f90 TimeInterpolateAction.F90 sourcefile~timeinterpolateaction.f90->sourcefile~regridder_mgr.f90 sourcefile~fieldspec.f90 FieldSpec.F90 sourcefile~fieldspec.f90->sourcefile~regridaction.f90 sourcefile~test_timeinterpolateaction.pf Test_TimeInterpolateAction.pf sourcefile~test_timeinterpolateaction.pf->sourcefile~timeinterpolateaction.f90 sourcefile~bracketspec.f90 BracketSpec.F90 sourcefile~bracketspec.f90->sourcefile~fieldspec.f90 sourcefile~make_itemspec.f90 make_itemSpec.F90 sourcefile~make_itemspec.f90->sourcefile~fieldspec.f90 sourcefile~modelverticalgrid.f90 ModelVerticalGrid.F90 sourcefile~modelverticalgrid.f90->sourcefile~fieldspec.f90 sourcefile~test_addfieldspec.pf Test_AddFieldSpec.pf sourcefile~test_addfieldspec.pf->sourcefile~fieldspec.f90 sourcefile~test_bracketspec.pf Test_BracketSpec.pf sourcefile~test_bracketspec.pf->sourcefile~fieldspec.f90 sourcefile~test_fieldspec.pf Test_FieldSpec.pf sourcefile~test_fieldspec.pf->sourcefile~fieldspec.f90

Source Code

#include "MAPL_Generic.h"

! This module provides a wrapper for ESMF_DynamicMask
! to enable equality checking between instances.

module mapl3g_DynamicMask
   use esmf
   use mapl_ErrorHandlingMod
   use mapl_Base, only: MAPL_UNDEF
   implicit none
   private


   public :: DynamicMask

   public :: operator(==)
   public :: operator(/=)

   type :: DynamicMaskSpec
      character(:), allocatable :: mask_type
      logical :: handleAllElements = .false.
      real(kind=ESMF_KIND_R4), allocatable :: src_mask_value_r4
      real(kind=ESMF_KIND_R4), allocatable :: dst_mask_value_r4
      real(kind=ESMF_KIND_R8), allocatable :: src_mask_value_r8
      real(kind=ESMF_KIND_R8), allocatable :: dst_mask_value_r8
   end type DynamicMaskSpec


   type DynamicMask
      type(DynamicMaskSpec) :: spec
      type(ESMF_DynamicMask), allocatable :: esmf_mask_r4
      type(ESMF_DynamicMask), allocatable :: esmf_mask_r8
   end type DynamicMask

   interface operator(==)
      procedure :: equal_to
      procedure :: equal_to_spec
   end interface operator(==)

   interface operator(/=)
      procedure :: not_equal_to
      procedure :: not_equal_to_spec
   end interface operator(/=)

   interface match
      procedure match_r4
      procedure match_r8
   end interface match

   interface DynamicMask
      procedure :: new_DynamicMask_r4
      procedure :: new_DynamicMask_r8
      procedure :: new_DynamicMask_r4r8
   end interface DynamicMask

   abstract interface

      subroutine I_r4r8r4(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskValue, rc)
         use esmf
         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
      end subroutine I_r4r8r4

      subroutine I_r8r8r8(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskValue, rc)
         use esmf
         type(ESMF_DynamicMaskElementR8R8R8V), pointer        :: dynamicMaskList(:)
         real(ESMF_KIND_R8),            intent(in), optional :: dynamicSrcMaskValue
         real(ESMF_KIND_R8),            intent(in), optional :: dynamicDstMaskValue
         integer,                       intent(out)  :: rc
      end subroutine I_r8r8r8
   end interface

contains

   function new_DynamicMask_r4(mask_type, src_mask_value, dst_mask_value, handleAllElements, rc) result(mask)
      type(DynamicMask) :: mask
      character(*), intent(in) :: mask_type
      real(kind=ESMF_KIND_R4) :: src_mask_value
      real(kind=ESMF_KIND_R4), optional, intent(in) :: dst_mask_value
      logical, optional :: handleAllElements
      integer, optional, intent(out) :: rc

      integer :: status
      type(DynamicMaskSpec) :: spec

      spec%mask_type = mask_type
      if (present(handleAllElements)) spec%handleAllElements = handleAllElements

      spec%src_mask_value_r4 = src_mask_value
      spec%src_mask_value_r8 = spec%src_mask_value_r4

      ! No default for dst_mask_value.  Usually left unallocated
      if (present(dst_mask_value)) then
         spec%dst_mask_value_r4 = dst_mask_value
         spec%dst_mask_value_r8 = dst_mask_value
      end if

      mask = DynamicMask(spec, _RC)

      _RETURN(_SUCCESS)
   end function new_DynamicMask_r4

   function new_DynamicMask_r8(mask_type, src_mask_value, dst_mask_value, handleAllElements, rc) result(mask)
      type(DynamicMask) :: mask
      character(*), intent(in) :: mask_type
      real(kind=ESMF_KIND_R8), optional, intent(in) :: src_mask_value
      real(kind=ESMF_KIND_R8), optional, intent(in) :: dst_mask_value
      logical, optional :: handleAllElements
      integer, optional, intent(out) :: rc

      integer :: status
      type(DynamicMaskSpec) :: spec

      spec%mask_type = mask_type
      if (present(handleAllElements)) spec%handleAllElements = handleAllElements

      spec%src_mask_value_r8 = src_mask_value
      spec%src_mask_value_r4 = spec%src_mask_value_r8

      ! No default for dst_mask_value.  Usually left unallocated
      if (present(dst_mask_value)) then
         spec%dst_mask_value_r8 = dst_mask_value
         spec%dst_mask_value_r4 = dst_mask_value
      end if

      mask = DynamicMask(spec, _RC)

      _RETURN(_SUCCESS)

   end function new_DynamicMask_r8

   function new_DynamicMask_r4r8(spec, rc) result(mask)
      type(DynamicMask) :: mask
      type(DynamicMaskSpec), intent(in) :: spec
      integer, optional, intent(out) :: rc

      integer :: status

      procedure(I_r4r8r4), pointer :: mask_routine_r4
      procedure(I_r8r8r8), pointer :: mask_routine_r8

      mask%spec = spec

      allocate(mask%esmf_mask_r4)
      mask_routine_r4 => get_mask_routine_r4(spec%mask_type, _RC)
      call ESMF_DynamicMaskSetR4R8R4V(mask%esmf_mask_r4, mask_routine_r4, &
           dynamicSrcMaskValue=spec%src_mask_value_r4, &
           dynamicDstMaskValue=spec%dst_mask_value_r4, &
           handleAllElements=spec%handleAllElements, &
           _RC)

      allocate(mask%esmf_mask_r8)
      mask_routine_r8 => get_mask_routine_r8(spec%mask_type, _RC)
      call ESMF_DynamicMaskSetR8R8R8V(mask%esmf_mask_r8, mask_routine_r8, &
           dynamicSrcMaskValue=spec%src_mask_value_r8, &
           dynamicDstMaskValue=spec%dst_mask_value_r8, &
           handleAllElements=spec%handleAllElements, &
           _RC)

      _RETURN(_SUCCESS)
   end function new_DynamicMask_r4r8

   function get_mask_routine_r4(mask_type, rc) result(mask_routine)
      procedure(I_r4r8r4), pointer :: mask_routine
      character(*), intent(in) :: mask_type
      integer, intent(out), optional :: rc

      integer :: status

      select case (mask_type)
      case ('missing_value')
         mask_routine => missing_r4r8r4v
      case ('monotonic')
         mask_routine => monotonic_r4r8r4v
      case ('vote')
         mask_routine => vote_r4r8r4v
      case ('fraction')
         mask_routine => fraction_r4r8r4v
      case default
         mask_routine => null()
         _FAIL("Unsupported mask type: "//mask_type)
      end select

      _RETURN(_SUCCESS)
   end function get_mask_routine_r4

   function get_mask_routine_r8(mask_type, rc) result(mask_routine)
      procedure(I_r8r8r8), pointer :: mask_routine
      character(*), intent(in) :: mask_type
      integer, intent(out), optional :: rc

      integer :: status

      select case (mask_type)
      case ('missing_value')
         mask_routine => missing_r8r8r8v
      case ('monotonic')
         mask_routine => monotonic_r8r8r8v
      case ('vote')
         mask_routine => vote_r8r8r8v
      case ('fraction')
         mask_routine => fraction_r8r8r8v
      case default
         mask_routine => null()
         _FAIL("Unsupported mask type: "//mask_type)
      end select

      _RETURN(_SUCCESS)
   end function get_mask_routine_r8


   subroutine missing_r8r8r8v(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskValue, rc)
      type(ESMF_DynamicMaskElementR8R8R8V), pointer        :: dynamicMaskList(:)
      real(ESMF_KIND_R8),            intent(in), optional :: dynamicSrcMaskValue
      real(ESMF_KIND_R8),            intent(in), optional :: dynamicDstMaskValue
      integer,                       intent(out)  :: rc

      integer :: i, j, k, n
      real(ESMF_KIND_R8), allocatable  :: renorm(:)

      if (associated(dynamicMaskList)) then
         n = size(dynamicMaskList(1)%srcElement(1)%ptr)
         allocate(renorm(n))

         do i=1, size(dynamicMaskList)
            dynamicMaskList(i)%dstElement = 0.0 ! set to zero

            renorm = 0.d0 ! reset
            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)
                  endif
               end do
            end do
            where (renorm > 0.d0)
               dynamicMaskList(i)%dstElement = dynamicMaskList(i)%dstElement / renorm
            elsewhere
               dynamicMaskList(i)%dstElement = dynamicSrcMaskValue
            end where
         enddo
      endif

      _RETURN(_SUCCESS)
      _UNUSED_DUMMY(dynamicDstMaskValue)
   end subroutine missing_r8r8r8v

   subroutine missing_r4r8r4v(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(:)

      if (associated(dynamicMaskList)) then
         n = size(dynamicMaskList(1)%srcElement(1)%ptr)
         allocate(renorm(n))

         do i=1, size(dynamicMaskList)
            dynamicMaskList(i)%dstElement = 0.0 ! set to zero

            renorm = 0.d0 ! reset
            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)
                  endif
               end do
            end do
            where (renorm > 0.d0)
               dynamicMaskList(i)%dstElement = dynamicMaskList(i)%dstElement / renorm
            elsewhere
               dynamicMaskList(i)%dstElement = dynamicSrcMaskValue
            end where
         enddo
      endif

      _RETURN(_SUCCESS)
      _UNUSED_DUMMY(dynamicDstMaskValue)
   end subroutine missing_r4r8r4v


   subroutine monotonic_r8r8r8V(dynamicMaskList, dynamicSrcMaskValue, &
        dynamicDstMaskValue, rc)
      type(ESMF_DynamicMaskElementR8R8R8V), pointer              :: dynamicMaskList(:)
      real(ESMF_KIND_R8),            intent(in), optional :: dynamicSrcMaskValue
      real(ESMF_KIND_R8),            intent(in), optional :: dynamicDstMaskValue
      integer,                       intent(out)          :: rc
      integer :: i, j, k, n
      real(ESMF_KIND_R8), allocatable  :: renorm(:),max_input(:),min_input(:)


      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
      _UNUSED_DUMMY(dynamicDstMaskValue)
   end subroutine monotonic_r8r8r8V

   subroutine monotonic_r4r8r4V(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(:)

      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
      _UNUSED_DUMMY(dynamicDstMaskValue)

   end subroutine monotonic_r4r8r4V


   subroutine vote_r8r8r8v(dynamicMaskList, dynamicSrcMaskValue, &
        dynamicDstMaskValue, rc)
      type(ESMF_DynamicMaskElementR8R8R8V), pointer       :: dynamicMaskList(:)
      real(ESMF_KIND_R8),            intent(in), optional :: dynamicSrcMaskValue
      real(ESMF_KIND_R8),            intent(in), optional :: dynamicDstMaskValue
      integer,                       intent(out)          :: rc
      integer :: i, j, k, n
      real(ESMF_KIND_R8), allocatable  :: renorm(:)


      if (associated(dynamicMaskList)) then
         n = size(dynamicMaskList(1)%srcElement(1)%ptr)
         allocate(renorm(n))

         do i=1, size(dynamicMaskList)
            dynamicMaskList(i)%dstElement = 0.0 ! set to zero

            renorm = 0.d0 ! reset
            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
                     if (dynamicMaskList(i)%factor(j) > renorm(k)) then
                        renorm(k) = dynamicMaskList(i)%factor(j)
                        dynamicMaskList(i)%dstElement(k) = dynamicMaskList(i)%srcElement(j)%ptr(k)
                     end if
                  endif
               end do
            end do
            where (renorm > 0.d0)
            elsewhere
               dynamicMaskList(i)%dstElement = dynamicSrcMaskValue
            end where
         enddo
      endif
      ! return successfully
      rc = ESMF_SUCCESS
      _UNUSED_DUMMY(dynamicDstMaskValue)
   end subroutine vote_r8r8r8v


   subroutine vote_r4r8r4v(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(:)

      if (associated(dynamicMaskList)) then
         n = size(dynamicMaskList(1)%srcElement(1)%ptr)
         allocate(renorm(n))

         do i=1, size(dynamicMaskList)
            dynamicMaskList(i)%dstElement = 0.0 ! set to zero

            renorm = 0.d0 ! reset
            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
                     if (dynamicMaskList(i)%factor(j) > renorm(k)) then
                        renorm(k) = dynamicMaskList(i)%factor(j)
                        dynamicMaskList(i)%dstElement(k) = dynamicMaskList(i)%srcElement(j)%ptr(k)
                     end if
                  endif
               end do
            end do
            where (renorm > 0.d0)
            elsewhere
               dynamicMaskList(i)%dstElement = dynamicSrcMaskValue
            end where
         enddo
      endif
      ! return successfully
      rc = ESMF_SUCCESS
      _UNUSED_DUMMY(dynamicDstMaskValue)

   end subroutine vote_r4r8r4v

   subroutine fraction_r8r8r8v(dynamicMaskList, dynamicSrcMaskValue, &
        dynamicDstMaskValue, rc)
      type(ESMF_DynamicMaskElementR8R8R8V), pointer              :: dynamicMaskList(:)
      real(ESMF_KIND_R8),            intent(in), optional :: dynamicSrcMaskValue
      real(ESMF_KIND_R8),            intent(in), optional :: dynamicDstMaskValue
      integer,                       intent(out)          :: rc
      integer :: i, j, k, n
      real(ESMF_KIND_R8), allocatable  :: renorm(:)

      if (associated(dynamicMaskList)) then
         n = size(dynamicMaskList(1)%srcElement(1)%ptr)
         allocate(renorm(n))

         do i=1, size(dynamicMaskList)
            dynamicMaskList(i)%dstElement = 0.0 ! set to zero

            renorm = 0.d0 ! reset
            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
                     if (nint(dynamicMaskList(i)%srcElement(j)%ptr(k)) == 0) then
                        dynamicMaskList(i)%dstElement(k) = dynamicMaskList(i)%dstElement(k) + &
                             & dynamicMaskList(i)%factor(j)
                        renorm(k) = renorm(k) + dynamicMaskList(i)%factor(j)
                     end if
                  endif
               end do
            end do
         enddo
      endif
      ! return successfully
      rc = ESMF_SUCCESS
      _UNUSED_DUMMY(dynamicDstMaskValue)

   end subroutine fraction_r8r8r8v

   subroutine fraction_r4r8r4v(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(:)

      if (associated(dynamicMaskList)) then
         n = size(dynamicMaskList(1)%srcElement(1)%ptr)
         allocate(renorm(n))

         do i=1, size(dynamicMaskList)
            dynamicMaskList(i)%dstElement = 0.0 ! set to zero

            renorm = 0.d0 ! reset
            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
                     if (nint(dynamicMaskList(i)%srcElement(j)%ptr(k)) == 0) then
                        dynamicMaskList(i)%dstElement(k) = dynamicMaskList(i)%dstElement(k) + &
                             & dynamicMaskList(i)%factor(j)
                        renorm(k) = renorm(k) + dynamicMaskList(i)%factor(j)
                     end if
                  endif
               end do
            end do
         enddo
      endif
      ! return successfully
      rc = ESMF_SUCCESS
      _UNUSED_DUMMY(dynamicDstMaskValue)

   end subroutine fraction_r4r8r4v


   impure elemental logical function equal_to(a, b)
      type(DynamicMask), intent(in) :: a
      type(DynamicMask), intent(in) :: b

      equal_to = a%spec == b%spec
      if (.not. equal_to) return

   end function equal_to

   impure elemental logical function not_equal_to(a, b)
      type(DynamicMask), intent(in) :: a
      type(DynamicMask), intent(in) :: b

      not_equal_to = .not. (a == b)
   end function not_equal_to


   logical function equal_to_spec(a, b) result(equal_to)
      type(DynamicMaskSpec), intent(in) :: a
      type(DynamicMaskSpec), intent(in) :: b

      equal_to = allocated(a%mask_type) .eqv. allocated(b%mask_type)
      if (.not. equal_to) return

      if (.not. allocated(a%mask_type)) then
         equal_to = .true. ! uninit
         return
      end if

      equal_to = a%mask_type == b%mask_type
      if (.not. equal_to) return

      equal_to = a%src_mask_value_r4 == b%src_mask_value_r4
      if (.not. equal_to) return

      equal_to = allocated(a%dst_mask_value_r4) .eqv. allocated(b%dst_mask_value_r4)
      if (.not. equal_to) return

      if (allocated(a%dst_mask_value_r4)) then
         equal_to = a%dst_mask_value_r4 == b%dst_mask_value_r4
      end if
      if (.not. equal_to) return

      equal_to = a%src_mask_value_r8 == b%src_mask_value_r8
      if (.not. equal_to) return

      equal_to = allocated(a%dst_mask_value_r8) .eqv. allocated(b%dst_mask_value_r8)
      if (.not. equal_to) return

      if (allocated(a%dst_mask_value_r8)) then
         equal_to = a%dst_mask_value_r8 == b%dst_mask_value_r8
      end if

   end function equal_to_spec


   logical function not_equal_to_spec(a, b) result(not_equal_to)
      type(DynamicMaskSpec), intent(in) :: a
      type(DynamicMaskSpec), intent(in) :: b

      not_equal_to = .not. (a == b)
   end function not_equal_to_spec


   logical function match_r4(missing,b)
      real(kind=ESMF_KIND_R4), intent(in) :: missing, b
      match_r4 = (missing==b) 
   end function match_r4

   logical function match_r8(missing,b)
      real(kind=ESMF_KIND_R8), intent(in) :: missing, b
      match_r8 = (missing==b) 
   end function match_r8

end module mapl3g_DynamicMask