Test_MeanAction.pf Source File

#include "MAPL_TestErr.h"
module Test_MeanAction
   use mapl3g_MeanAction
   use accumulator_action_test_common
   use esmf
   use pfunit
   use MAPL_FieldUtils
   use ESMF_TestMethod_mod
   implicit none

contains

   @Test(type=ESMF_TestMethod, npes=[1])
   subroutine test_calculate_mean_R4(this)
      class(ESMF_TestMethod), intent(inout) :: this
      type(MeanAction) :: acc
      type(ESMF_State) :: importState, exportState
      type(ESMF_Clock) :: clock
      integer :: status
      integer(kind=ESMF_KIND_I4), parameter :: COUNTER = 4
      real(kind=ESMF_KIND_R4), parameter :: MEAN = 4.0_R4
      logical :: matches_expected
      real(kind=ESMF_KIND_R4), pointer :: fptr(:)
      integer(kind=ESMF_KIND_I4), pointer :: ifptr(:)
      integer :: n
      logical, allocatable :: mask(:)

      call initialize_objects(importState, exportState, clock, ESMF_TYPEKIND_R4, _RC)
      call acc%initialize(importState, exportState, clock, _RC)
      call FieldSet(acc%accumulation_field, COUNTER*MEAN, _RC)
      call assign_fptr(acc%accumulation_field, fptr, _RC)
      call assign_fptr(acc%counter_field, ifptr, _RC)
      ifptr = COUNTER
      n = size(fptr)-1

      ! All points are not UNDEF and counter > 0
      call acc%calculate_mean_R4(_RC)
      matches_expected = FieldIsConstant(acc%accumulation_field, MEAN, _RC)
      @assertTrue(matches_expected, 'accumulation_field not equal to MEAN')

      ! counter 0 at one point
      call FieldSet(acc%accumulation_field, COUNTER*MEAN, _RC)
      call assign_fptr(acc%counter_field, fptr, _RC)
      fptr(n) = 0
      mask = fptr /= 0
      call assign_fptr(acc%accumulation_field, fptr, _RC)
      call acc%calculate_mean_R4(_RC)
      @assertTrue(all(pack(fptr, mask) == MEAN), 'Some valid points not equal to MEAN')
      @assertTrue(undef(fptr(n)), 'mean at point was not UNDEF')
      call destroy_objects(importState, exportState, clock, _RC)

   end subroutine test_calculate_mean_R4

   @Test(type=ESMF_TestMethod, npes=[1])
   subroutine test_clear(this)
      class(ESMF_TestMethod), intent(inout) :: this
      type(MeanAction) :: acc
      type(ESMF_State) :: importState, exportState
      type(ESMF_Clock) :: clock
      integer :: status
      integer(kind=ESMF_KIND_I4), parameter :: COUNTER = 4
      logical :: cleared = .FALSE.
      integer(kind=ESMF_KIND_I4), pointer :: fptr(:)

      call initialize_objects(importState, exportState, clock, ESMF_TYPEKIND_R4, _RC)
      call acc%initialize(importState, exportState, clock, _RC)
      call assign_fptr(acc%counter_field, fptr, _RC)
      fptr = COUNTER
      call acc%clear(_RC)
      call assign_fptr(acc%counter_field, fptr, _RC)
      cleared = all(fptr == 0)
      @assertTrue(cleared, 'Counter field is nonzero.')
      call destroy_objects(importState, exportState, clock, _RC)

   end subroutine test_clear

   @Test(type=ESMF_TestMethod, npes=[1])
   subroutine test_invalidate(this)
      class(ESMF_TestMethod), intent(inout) :: this
      type(MeanAction) :: acc
      type(ESMF_State) :: importState, exportState
      type(ESMF_Clock) :: clock
      integer :: status
      integer, parameter :: N = 4
      integer :: i
      type(ESMF_Field) :: importField
      logical :: counter_is_set = .FALSE.
      integer(kind=ESMF_KIND_I4), pointer :: fptr(:)

      call initialize_objects(importState, exportState, clock, ESMF_TYPEKIND_R4, _RC)
      call get_field(importState, importField, _RC)
      call FieldSet(importField, 1.0_R4, _RC)
      call acc%initialize(importState, exportState, clock, _RC)
      call assign_fptr(acc%counter_field, fptr, _RC)
      counter_is_set = all(fptr == 0)
      @assertTrue(counter_is_set, 'Counter field is nonzero.')
      do i=1, N
         call acc%invalidate(importState, exportState, clock, _RC)
      end do
      call assign_fptr(acc%counter_field, fptr, _RC)
      counter_is_set = all(fptr == N)
      @assertTrue(counter_is_set, 'counter_scalar not equal to N')
      call destroy_objects(importState, exportState, clock, _RC)
      call ESMF_FieldDestroy(importField)

   end subroutine test_invalidate

   @Test(type=ESMF_TestMethod, npes=[1])
   subroutine test_accumulate_mean_R4(this)
      class(ESMF_TestMethod), intent(inout) :: this
      type(MeanAction) :: acc
      type(ESMF_State) :: importState, exportState
      type(ESMF_Clock) :: clock
      integer :: status
      real(kind=ESMF_KIND_R4), parameter :: UPDATE_VALUE = 3.0_R4
      type(ESMF_Field) :: update_field
      real(kind=ESMF_KIND_R4), pointer :: upPtr(:) => null()
      real(kind=ESMF_KIND_R4), pointer :: accPtr(:) => null()
      integer(kind=I4), pointer :: countPtr(:) => null()
      integer(kind=I4), allocatable :: expected_count(:)
      integer :: n

      call initialize_objects(importState, exportState, clock, ESMF_TYPEKIND_R4, _RC)
      call acc%initialize(importState, exportState, clock, _RC)
      call initialize_field(update_field, acc%accumulation_field, _RC)
      ! set update field
      call FieldSet(update_field, UPDATE_VALUE, _RC)
      call assign_fptr(update_field, upPtr, _RC)
      ! set last element of update field to UNDEF
      n = size(upPtr)
      call set_undef(upPtr(n))
      ! run subroutine to test
      call acc%accumulate_R4(update_field, _RC)
      call assign_fptr(acc%accumulation_field, accPtr, _RC)
      call assign_fptr(acc%counter_field, countPtr, _RC)
      allocate(expected_count(size(countPtr)))
      expected_count = 1_I4
      expected_count(n) = 0_I4
      @assertEqual(expected_count, countPtr, 'Counts do not match.')

      call ESMF_FieldDestroy(update_field)
      call destroy_objects(importState, exportState, clock, _RC)

   end subroutine test_accumulate_mean_R4

   @Test(type=ESMF_TestMethod, npes=[1])
   subroutine test_initialize(this)
      class(ESMF_TestMethod), intent(inout) :: this
      type(MeanAction) :: acc
      type(ESMF_State) :: importState, exportState
      type(ESMF_Clock) :: clock
      integer :: status
      logical :: equals_expected_value 
      integer(kind=ESMF_KIND_I4), pointer :: fptr(:)

      call initialize_objects(importState, exportState, clock, ESMF_TYPEKIND_R4, _RC)
      call acc%initialize(importState, exportState, clock, _RC)
      call assign_fptr(acc%counter_field, fptr, _RC)
      equals_expected_value = all(fptr == 0)
      @assertTrue(equals_expected_value, 'counter_field was not cleared.')
      call destroy_objects(importState, exportState, clock, _RC)

   end subroutine test_initialize

   @Test(type=ESMF_TestMethod, npes=[1])
   subroutine test_accumulate_with_undef_some_steps(this)
      class(ESMF_TestMethod), intent(inout) :: this
      type(MeanAction) :: acc
      type(ESMF_State) :: importState, exportState
      type(ESMF_Clock) :: clock
      integer :: status
      type(ESMF_Field) :: update_field
      integer :: n
      real(kind=ESMF_KIND_R4), parameter :: UPDATE_VALUE = 3.0_R4
      real(kind=ESMF_KIND_R4), pointer :: upPtr(:), accPtr(:)
      integer(kind=ESMF_KIND_I4), pointer :: countPtr(:)
      logical, allocatable :: mask(:)

      call initialize_objects(importState, exportState, clock, ESMF_TYPEKIND_R4, _RC)
      call acc%initialize(importState, exportState, clock, _RC)
      call initialize_field(update_field, acc%accumulation_field, _RC)
      call assign_fptr(update_field, upPtr, _RC)
      upPtr = UPDATE_VALUE
      allocate(mask(size(upPtr)))
      mask = .TRUE.

      call acc%accumulate(update_field, _RC)
      call acc%accumulate(update_field, _RC)

      call assign_fptr(update_field, upPtr, _RC)
      n = size(upPtr) - 1
      call set_undef(upPtr(n)) 
      call acc%accumulate(update_field, _RC)
      mask(n) = .FALSE.

      call assign_fptr(update_field, upPtr, _RC)
      upPtr = UPDATE_VALUE
      call acc%accumulate(update_field, _RC)
      call acc%accumulate(update_field, _RC)

      call assign_fptr(acc%counter_field, countPtr, _RC)
      @assertEqual(4, countPtr(n), 'Missing point counter does not match.')
      @assertTrue(all(pack(countPtr, mask) == 5), 'Other point counters do not match.')

      call assign_fptr(acc%accumulation_field, accPtr, _RC)
      @assertEqual(4*UPDATE_VALUE, accPtr(n), 'Missing point does not match.')
      @assertTrue(all(pack(accPtr, mask) == 5*UPDATE_VALUE), 'Other points do not match.')
      call destroy_objects(importState, exportState, clock, _RC)
      call ESMF_FieldDestroy(update_field)

   end subroutine test_accumulate_with_undef_some_steps

end module Test_MeanAction