test_accumulate_R4 Subroutine

public subroutine test_accumulate_R4(this)

Arguments

Type IntentOptional Attributes Name
class(ESMF_TestMethod), intent(inout) :: this

Calls

proc~~test_accumulate_r4~~CallsGraph proc~test_accumulate_r4 test_accumulate_R4 anyexceptions anyexceptions proc~test_accumulate_r4->anyexceptions assert_that assert_that proc~test_accumulate_r4->assert_that asserttrue asserttrue proc~test_accumulate_r4->asserttrue esmf_fielddestroy esmf_fielddestroy proc~test_accumulate_r4->esmf_fielddestroy interface~assign_fptr assign_fptr proc~test_accumulate_r4->interface~assign_fptr interface~fieldisconstant FieldIsConstant proc~test_accumulate_r4->interface~fieldisconstant interface~fieldset FieldSet proc~test_accumulate_r4->interface~fieldset interface~initialize_field initialize_field proc~test_accumulate_r4->interface~initialize_field none~accumulate_r4~3 AccumulatorAction%accumulate_R4 proc~test_accumulate_r4->none~accumulate_r4~3 none~initialize~30 AccumulatorAction%initialize proc~test_accumulate_r4->none~initialize~30 proc~destroy_objects destroy_objects proc~test_accumulate_r4->proc~destroy_objects proc~initialize_objects initialize_objects proc~test_accumulate_r4->proc~initialize_objects proc~set_undef set_undef proc~test_accumulate_r4->proc~set_undef proc~undef undef proc~test_accumulate_r4->proc~undef sourcelocation sourcelocation proc~test_accumulate_r4->sourcelocation

Source Code

   subroutine test_accumulate_R4(this)
      class(ESMF_TestMethod), intent(inout) :: this
      type(AccumulatorAction) :: acc
      type(ESMF_State) :: importState, exportState
      type(ESMF_Clock) :: clock
      integer :: status
      real(kind=R4), parameter :: INITIAL_VALUE = 2.0_R4
      real(kind=R4), parameter :: UPDATE_VALUE = 3.0_R4
      real(kind=R4) :: expected_value
      real(kind=R4), pointer :: upPtr(:), accPtr(:)
      type(ESMF_Field) :: update_field
      logical :: field_is_expected_value
      integer :: n

      ! first accumulate
      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 FieldSet(update_field, UPDATE_VALUE, _RC)
      call FieldSet(acc%accumulation_field, INITIAL_VALUE, _RC)
      call acc%accumulate_R4(update_field, _RC)
      expected_value = INITIAL_VALUE + UPDATE_VALUE
      field_is_expected_value = FieldIsConstant(acc%accumulation_field, expected_value, _RC)
      @assertTrue(field_is_expected_value, 'accumulation_field not equal to expected_value. (first test)')
      ! second accumulate
      call acc%accumulate_R4(update_field, _RC)
      expected_value = expected_value + UPDATE_VALUE
      field_is_expected_value = FieldIsConstant(acc%accumulation_field, expected_value, _RC)
      @assertTrue(field_is_expected_value, 'accumulation_field not equal to expected_value. (second test)')

      ! one update point to undef
      expected_value = UPDATE_VALUE
      call acc%initialize(importState, exportState, clock, _RC)
      call assign_fptr(update_field, upPtr, _RC)
      call assign_fptr(acc%accumulation_field, accPtr, _RC)
      n = size(upPtr)
      call set_undef(upPtr(n))
      call acc%accumulate_R4(update_field, _RC)
      @assertTrue(undef(accPtr(n)), 'invalid point is not UNDEF.')
      @assertTrue(all(pack(accPtr, .not. undef(accPtr)) == expected_value), 'valid point not equal to expected value. (update undef)')

      ! one accumulation point to undef
      call acc%initialize(importState, exportState, clock, _RC)
      call assign_fptr(update_field, upPtr, _RC)
      upPtr = UPDATE_VALUE
      call assign_fptr(acc%accumulation_field, accPtr, _RC)
      accPtr = INITIAL_VALUE
      n = size(accPtr)
      call set_undef(accPtr(n))
      call acc%accumulate_R4(update_field, _RC)
      expected_value = INITIAL_VALUE + UPDATE_VALUE
      @assertTrue(undef(accPtr(n)), 'invalid point is not UNDEF.')
      @assertTrue(all(pack(accPtr, .not. undef(accPtr)) == expected_value), 'valid point not equal to expected value. (accumulation undef)')

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

   end subroutine test_accumulate_R4