diff --git a/field/FieldPointerUtilities.F90 b/field/FieldPointerUtilities.F90 index 238b8ba24f9b..aad14d9421d5 100644 --- a/field/FieldPointerUtilities.F90 +++ b/field/FieldPointerUtilities.F90 @@ -33,6 +33,8 @@ module MAPL_FieldPointerUtilities module procedure assign_fptr_r8_rank2 module procedure assign_fptr_r4_rank3 module procedure assign_fptr_r8_rank3 + module procedure assign_fptr_i4_rank1 + module procedure assign_fptr_i8_rank1 end interface assign_fptr interface FieldGetCptr @@ -846,44 +848,95 @@ subroutine MAPL_FieldGetLocalElementCount(field,local_count,rc) real(kind=ESMF_KIND_R4), pointer :: r4_1d(:),r4_2d(:,:),r4_3d(:,:,:),r4_4d(:,:,:,:) real(kind=ESMF_KIND_R8), pointer :: r8_1d(:),r8_2d(:,:),r8_3d(:,:,:),r8_4d(:,:,:,:) + integer(kind=ESMF_KIND_I4), pointer :: i4_1d(:),i4_2d(:,:),i4_3d(:,:,:),i4_4d(:,:,:,:) + integer(kind=ESMF_KIND_I8), pointer :: i8_1d(:),i8_2d(:,:),i8_3d(:,:,:),i8_4d(:,:,:,:) call ESMF_FieldGet(field,rank=rank,typekind=tk,_RC) + if (tk == ESMF_TypeKind_R4) then - if (rank==1) then + select case(rank) + case(1) call ESMF_FieldGet(field,0,farrayptr=r4_1d,_RC) local_count = shape(r4_1d) - else if (rank ==2) then + case(2) call ESMF_FieldGet(field,0,farrayptr=r4_2d,_RC) local_count = shape(r4_2d) - else if (rank ==3) then + case(3) call ESMF_FieldGet(field,0,farrayptr=r4_3d,_RC) local_count = shape(r4_3d) - else if (rank ==4) then + case(4) call ESMF_FieldGet(field,0,farrayptr=r4_4d,_RC) local_count = shape(r4_4d) - else + case default _FAIL("Unsupported rank") - end if - else if (tk == ESMF_TypeKind_R8) then - if (rank==1) then + end select + _RETURN(_SUCCESS) + end if + + if (tk == ESMF_TypeKind_R8) then + select case(rank) + case(1) call ESMF_FieldGet(field,0,farrayptr=r8_1d,_RC) local_count = shape(r8_1d) - else if (rank ==2) then + case(2) call ESMF_FieldGet(field,0,farrayptr=r8_2d,_RC) local_count = shape(r8_2d) - else if (rank ==3) then + case(3) call ESMF_FieldGet(field,0,farrayptr=r8_3d,_RC) local_count = shape(r8_3d) - else if (rank ==4) then + case(4) call ESMF_FieldGet(field,0,farrayptr=r8_4d,_RC) local_count = shape(r8_4d) - else + case default _FAIL("Unsupported rank") - end if - else - _FAIL("Unsupported type") + end select + _RETURN(_SUCCESS) + end if + + if (tk == ESMF_TypeKind_I4) then + select case(rank) + case(1) + call ESMF_FieldGet(field,0,farrayptr=i4_1d,_RC) + local_count = shape(i4_1d) + case(2) + call ESMF_FieldGet(field,0,farrayptr=i4_2d,_RC) + local_count = shape(i4_2d) + case(3) + call ESMF_FieldGet(field,0,farrayptr=i4_3d,_RC) + local_count = shape(i4_3d) + case(4) + call ESMF_FieldGet(field,0,farrayptr=i4_4d,_RC) + local_count = shape(i4_4d) + case default + _FAIL("Unsupported rank") + end select + _RETURN(_SUCCESS) end if + + if (tk == ESMF_TypeKind_I8) then + select case(rank) + case(1) + call ESMF_FieldGet(field,0,farrayptr=i8_1d,_RC) + local_count = shape(i8_1d) + case(2) + call ESMF_FieldGet(field,0,farrayptr=i8_2d,_RC) + local_count = shape(i8_2d) + case(3) + call ESMF_FieldGet(field,0,farrayptr=i8_3d,_RC) + local_count = shape(i8_3d) + case(4) + call ESMF_FieldGet(field,0,farrayptr=i8_4d,_RC) + local_count = shape(i8_4d) + case default + _FAIL("Unsupported rank") + end select + end if + + ! If you made it this far, you had an unsupported type. + _FAIL("Unsupported type") + _RETURN(_SUCCESS) + end subroutine MAPL_FieldGetLocalElementCount function FieldsHaveUndef(fields,rc) result(all_have_undef) @@ -990,4 +1043,42 @@ subroutine Destroy(Field,RC) end subroutine Destroy + subroutine assign_fptr_i4_rank1(x, fptr, rc) + type(ESMF_Field), intent(inout) :: x + integer(kind=ESMF_KIND_I4), pointer, intent(out) :: fptr(:) + integer, optional, intent(out) :: rc + + ! local declarations + type(c_ptr) :: cptr + integer(ESMF_KIND_I8), allocatable :: fp_shape(:) + integer(ESMF_KIND_I8) :: local_size + integer :: status + + local_size = FieldGetLocalSize(x, _RC) + fp_shape = [ local_size ] + call FieldGetCptr(x, cptr, _RC) + call c_f_pointer(cptr, fptr, fp_shape) + + _RETURN(_SUCCESS) + end subroutine assign_fptr_i4_rank1 + + subroutine assign_fptr_i8_rank1(x, fptr, rc) + type(ESMF_Field), intent(inout) :: x + integer(kind=ESMF_KIND_I8), pointer, intent(out) :: fptr(:) + integer, optional, intent(out) :: rc + + ! local declarations + type(c_ptr) :: cptr + integer(ESMF_KIND_I8), allocatable :: fp_shape(:) + integer(ESMF_KIND_I8) :: local_size + integer :: status + + local_size = FieldGetLocalSize(x, _RC) + fp_shape = [ local_size ] + call FieldGetCptr(x, cptr, _RC) + call c_f_pointer(cptr, fptr, fp_shape) + + _RETURN(_SUCCESS) + end subroutine assign_fptr_i8_rank1 + end module MAPL_FieldPointerUtilities diff --git a/generic3g/actions/AccumulatorAction.F90 b/generic3g/actions/AccumulatorAction.F90 index 2a939d64c978..eaaf8c10f7c7 100644 --- a/generic3g/actions/AccumulatorAction.F90 +++ b/generic3g/actions/AccumulatorAction.F90 @@ -15,16 +15,19 @@ module mapl3g_AccumulatorAction type(ESMF_Field) :: result_field real(kind=ESMF_KIND_R4) :: CLEAR_VALUE_R4 = 0.0_ESMF_KIND_R4 logical :: update_calculated = .FALSE. + type(ESMF_TypeKind_Flag) :: typekind = ESMF_TYPEKIND_R4 contains ! Implementations of deferred procedures procedure :: invalidate procedure :: initialize procedure :: update ! Helpers - procedure :: accumulate procedure :: initialized - procedure :: clear_accumulator + procedure :: accumulate procedure :: accumulate_R4 + procedure :: clear + procedure :: create_fields + procedure :: update_result end type AccumulatorAction contains @@ -36,22 +39,20 @@ logical function initialized(this) result(lval) end function initialized - subroutine clear_accumulator(this, rc) + subroutine clear(this, rc) class(AccumulatorAction), intent(inout) :: this integer, optional, intent(out) :: rc integer :: status - type(ESMF_TypeKind_Flag) :: tk - call ESMF_FieldGet(this%accumulation_field, typekind=tk, _RC) - if(tk == ESMF_TYPEKIND_R4) then + if(this%typekind == ESMF_TYPEKIND_R4) then call FieldSet(this%accumulation_field, this%CLEAR_VALUE_R4, _RC) else _FAIL('Unsupported typekind') end if _RETURN(_SUCCESS) - end subroutine clear_accumulator + end subroutine clear subroutine initialize(this, importState, exportState, clock, rc) class(AccumulatorAction), intent(inout) :: this @@ -62,10 +63,42 @@ subroutine initialize(this, importState, exportState, clock, rc) integer :: status type(ESMF_Field) :: import_field, export_field - logical :: fields_are_conformable + type(ESMF_TypeKind_Flag) :: typekind + logical :: conformable + logical :: same_typekind + conformable = .FALSE. + same_typekind = .FALSE. + + ! Get fields from state and confirm typekind match and conformable. call get_field(importState, import_field, _RC) + call ESMF_FieldGet(import_field, typekind=typekind, _RC) + ! This check goes away if ESMF_TYPEKIND_R8 is supported. + _ASSERT(typekind==ESMF_TYPEKIND_R4, 'Only ESMF_TYPEKIND_R4 is supported.') + call get_field(exportState, export_field, _RC) + same_typekind = FieldsAreSameTypeKind(import_field, export_field, _RC) + _ASSERT(same_typekind, 'Import and export fields are different typekinds.') + + conformable = FieldsAreConformable(import_field, export_field, _RC) + _ASSERT(conformable, 'Import and export fields are not conformable.') + + this%typekind = typekind + ! Create and initialize field values. + call this%create_fields(import_field, export_field, _RC) + call this%clear(_RC) + _RETURN(_SUCCESS) + _UNUSED_DUMMY(clock) + + end subroutine initialize + + subroutine create_fields(this, import_field, export_field, rc) + class(AccumulatorAction), intent(inout) :: this + type(ESMF_Field), intent(inout) :: import_field + type(ESMF_Field), intent(inout) :: export_field + integer, optional, intent(out) :: rc + + integer :: status if(this%initialized()) then call ESMF_FieldDestroy(this%accumulation_field, _RC) @@ -73,12 +106,9 @@ subroutine initialize(this, importState, exportState, clock, rc) end if this%accumulation_field = ESMF_FieldCreate(import_field, _RC) this%result_field = ESMF_FieldCreate(export_field, _RC) - - call this%clear_accumulator(_RC) _RETURN(_SUCCESS) - _UNUSED_DUMMY(clock) - end subroutine initialize + end subroutine create_fields subroutine update(this, importState, exportState, clock, rc) class(AccumulatorAction), intent(inout) :: this @@ -92,19 +122,30 @@ subroutine update(this, importState, exportState, clock, rc) _ASSERT(this%initialized(), 'Accumulator has not been initialized.') if(.not. this%update_calculated) then - call FieldCopy(this%accumulation_field, this%result_field, _RC) - this%update_calculated = .TRUE. + call this%update_result(_RC) end if call get_field(exportState, export_field, _RC) call FieldCopy(this%result_field, export_field, _RC) - call this%clear_accumulator(_RC) + call this%clear(_RC) + _RETURN(_SUCCESS) _UNUSED_DUMMY(clock) _UNUSED_DUMMY(importState) - _RETURN(_SUCCESS) end subroutine update + subroutine update_result(this, rc) + class(AccumulatorAction), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + + call FieldCopy(this%accumulation_field, this%result_field, _RC) + this%update_calculated = .true. + _RETURN(_SUCCESS) + + end subroutine update_result + subroutine invalidate(this, importState, exportState, clock, rc) class(AccumulatorAction), intent(inout) :: this type(ESMF_State) :: importState @@ -119,9 +160,9 @@ subroutine invalidate(this, importState, exportState, clock, rc) this%update_calculated = .FALSE. call get_field(importState, import_field, _RC) call this%accumulate(import_field, _RC) + _RETURN(_SUCCESS) _UNUSED_DUMMY(clock) _UNUSED_DUMMY(exportState) - _RETURN(_SUCCESS) end subroutine invalidate @@ -151,12 +192,11 @@ subroutine accumulate(this, update_field, rc) integer, optional, intent(out) :: rc integer :: status - type(ESMF_TypeKind_Flag) :: tk, tk_field + type(ESMF_TypeKind_Flag) :: tk_field - call ESMF_FieldGet(this%accumulation_field, typekind=tk, _RC) call ESMF_FieldGet(update_field, typekind=tk_field, _RC) - _ASSERT(tk == tk_field, 'Update field must be the same typekind as the accumulation field.') - if(tk == ESMF_TYPEKIND_R4) then + _ASSERT(this%typekind == tk_field, 'Update field must be the same typekind as the accumulation field.') + if(this%typekind == ESMF_TYPEKIND_R4) then call this%accumulate_R4(update_field, _RC) else _FAIL('Unsupported typekind value') @@ -174,15 +214,16 @@ subroutine accumulate_R4(this, update_field, rc) integer :: status real(kind=ESMF_KIND_R4), pointer :: current(:) real(kind=ESMF_KIND_R4), pointer :: latest(:) - real(kind=ESMF_KIND_R4) :: undef + real(kind=ESMF_KIND_R4), parameter :: UNDEF = MAPL_UNDEFINED_REAL - undef = MAPL_UNDEFINED_REAL + current => null() + latest => null() call assign_fptr(this%accumulation_field, current, _RC) call assign_fptr(update_field, latest, _RC) - where(current /= undef .and. latest /= undef) + where(current /= UNDEF .and. latest /= UNDEF) current = current + latest - elsewhere(latest == undef) - current = undef + elsewhere(latest == UNDEF) + current = UNDEF end where _RETURN(_SUCCESS) diff --git a/generic3g/actions/MeanAction.F90 b/generic3g/actions/MeanAction.F90 index 961e380c868a..d61b4e87e6a0 100644 --- a/generic3g/actions/MeanAction.F90 +++ b/generic3g/actions/MeanAction.F90 @@ -3,65 +3,78 @@ module mapl3g_MeanAction use mapl3g_AccumulatorAction use MAPL_InternalConstantsMod, only: MAPL_UNDEFINED_REAL, MAPL_UNDEFINED_REAL64 use MAPL_ExceptionHandling - use MAPL_FieldPointerUtilities + use MAPL_FieldPointerUtilities, only: assign_fptr + use mapl3g_FieldCreate, only: MAPL_FieldCreate + use mapl3g_FieldGet, only: MAPL_FieldGet + use MAPL_FieldUtilities, only: FieldSet use ESMF implicit none private public :: MeanAction type, extends(AccumulatorAction) :: MeanAction - !private - integer(ESMF_KIND_R8) :: counter_scalar = 0_ESMF_KIND_I8 - logical, allocatable :: valid_mean(:) + type(ESMF_Field) :: counter_field contains - procedure :: invalidate => invalidate_mean_accumulator - procedure :: clear_accumulator => clear_mean_accumulator - procedure :: update => update_mean_accumulator + procedure :: clear => clear_mean + procedure :: create_fields => create_fields_mean + procedure :: update_result => update_result_mean procedure :: calculate_mean procedure :: calculate_mean_R4 - procedure :: clear_valid_mean - procedure :: accumulate_R4 => accumulate_mean_R4 + procedure :: accumulate_R4 end type MeanAction + type(ESMF_TypeKind_Flag), parameter :: COUNTER_TYPEKIND = ESMF_TYPEKIND_I4 + integer, parameter :: COUNTER_KIND = ESMF_KIND_I4 + contains - subroutine clear_mean_accumulator(this, rc) + subroutine create_fields_mean(this, import_field, export_field, rc) class(MeanAction), intent(inout) :: this + type(ESMF_Field), intent(inout) :: import_field + type(ESMF_Field), intent(inout) :: export_field integer, optional, intent(out) :: rc - + integer :: status + type(ESMF_Geom) :: geom + integer, allocatable :: gmap(:) + integer :: ndims - this%counter_scalar = 0_ESMF_KIND_R8 - call this%clear_valid_mean(_RC) - call this%AccumulatorAction%clear_accumulator(_RC) + call this%AccumulatorAction%create_fields(import_field, export_field, _RC) + if(ESMF_FieldIsCreated(this%counter_field)) then + call ESMF_FieldDestroy(this%counter_field, _RC) + end if + associate(f => this%accumulation_field) + call ESMF_FieldGet(f, dimCount=ndims, _RC) + allocate(gmap(ndims)) + call ESMF_FieldGet(f, geom=geom, gridToFieldMap=gmap, _RC) + this%counter_field = MAPL_FieldCreate(geom, typekind=ESMF_TYPEKIND_I4, gridToFieldMap=gmap, _RC) + end associate _RETURN(_SUCCESS) - end subroutine clear_mean_accumulator + end subroutine create_fields_mean - subroutine clear_valid_mean(this, rc) + subroutine clear_mean(this, rc) class(MeanAction), intent(inout) :: this integer, optional, intent(out) :: rc - + integer :: status - integer :: local_size + integer(COUNTER_KIND), pointer :: counter(:) - if(allocated(this%valid_mean)) deallocate(this%valid_mean) - local_size = FieldGetLocalSize(this%accumulation_field, _RC) - allocate(this%valid_mean(local_size), source = .FALSE.) + call this%AccumulatorAction%clear(_RC) + counter => null() + call assign_fptr(this%counter_field, counter, _RC) + counter = 0_COUNTER_KIND _RETURN(_SUCCESS) - end subroutine clear_valid_mean + end subroutine clear_mean subroutine calculate_mean(this, rc) class(MeanAction), intent(inout) :: this integer, optional, intent(out) :: rc integer :: status - type(ESMF_TypeKind_Flag) :: tk - _ASSERT(this%counter_scalar > 0, 'Cannot calculate mean for zero steps') - call ESMF_FieldGet(this%accumulation_field, typekind=tk, _RC) - if(tk == ESMF_TypeKind_R4) then + if(this%typekind == ESMF_TYPEKIND_R4) then call this%calculate_mean_R4(_RC) else _FAIL('Unsupported typekind') @@ -70,50 +83,33 @@ subroutine calculate_mean(this, rc) end subroutine calculate_mean - subroutine update_mean_accumulator(this, importState, exportState, clock, rc) + subroutine update_result_mean(this, rc) class(MeanAction), intent(inout) :: this - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock integer, optional, intent(out) :: rc integer :: status - - _ASSERT(this%initialized(), 'Accumulator has not been initialized.') - if(.not. this%update_calculated) then - call this%calculate_mean(_RC) - end if - call this%AccumulatorAction%update(importState, exportState, clock, _RC) - _RETURN(_SUCCESS) - - end subroutine update_mean_accumulator - - subroutine invalidate_mean_accumulator(this, importState, exportState, clock, rc) - class(MeanAction), intent(inout) :: this - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - type(ESMF_Clock) :: clock - integer, optional, intent(out) :: rc - integer :: status - - call this%AccumulatorAction%invalidate(importState, exportState, clock, _RC) - this%counter_scalar = this%counter_scalar + 1 + call this%calculate_mean(_RC) + call this%AccumulatorAction%update_result(_RC) _RETURN(_SUCCESS) - end subroutine invalidate_mean_accumulator + end subroutine update_result_mean subroutine calculate_mean_R4(this, rc) class(MeanAction), intent(inout) :: this integer, optional, intent(out) :: rc integer :: status - real(kind=ESMF_KIND_R4), pointer :: current_ptr(:) => null() + real(kind=ESMF_KIND_R4), pointer :: current_ptr(:) + integer(kind=COUNTER_KIND), pointer :: counter(:) real(kind=ESMF_KIND_R4), parameter :: UNDEF = MAPL_UNDEFINED_REAL + current_ptr => null() + counter => null() call assign_fptr(this%accumulation_field, current_ptr, _RC) - where(current_ptr /= UNDEF .and. this%valid_mean) - current_ptr = current_ptr / this%counter_scalar + call assign_fptr(this%counter_field, counter, _RC) + where(counter /= 0) + current_ptr = current_ptr / counter elsewhere current_ptr = UNDEF end where @@ -121,7 +117,7 @@ subroutine calculate_mean_R4(this, rc) end subroutine calculate_mean_R4 - subroutine accumulate_mean_R4(this, update_field, rc) + subroutine accumulate_R4(this, update_field, rc) class(MeanAction), intent(inout) :: this type(ESMF_Field), intent(inout) :: update_field integer, optional, intent(out) :: rc @@ -129,19 +125,21 @@ subroutine accumulate_mean_R4(this, update_field, rc) integer :: status real(kind=ESMF_KIND_R4), pointer :: current(:) real(kind=ESMF_KIND_R4), pointer :: latest(:) - real(kind=ESMF_KIND_R4) :: undef + integer(kind=COUNTER_KIND), pointer :: counter(:) + real(kind=ESMF_KIND_R4), parameter :: UNDEF = MAPL_UNDEFINED_REAL - undef = MAPL_UNDEFINED_REAL + current => null() + latest => null() + counter => null() call assign_fptr(this%accumulation_field, current, _RC) call assign_fptr(update_field, latest, _RC) - where(current /= undef .and. latest /= undef) + call assign_fptr(this%counter_field, counter, _RC) + where(latest /= UNDEF) current = current + latest - this%valid_mean = .TRUE. - elsewhere(latest == undef) - current = undef + counter = counter + 1_COUNTER_KIND end where _RETURN(_SUCCESS) - end subroutine accumulate_mean_R4 + end subroutine accumulate_R4 end module mapl3g_MeanAction diff --git a/generic3g/tests/Test_AccumulatorAction.pf b/generic3g/tests/Test_AccumulatorAction.pf index 68384db7d52f..b49c11c309e9 100644 --- a/generic3g/tests/Test_AccumulatorAction.pf +++ b/generic3g/tests/Test_AccumulatorAction.pf @@ -130,7 +130,7 @@ contains end subroutine test_accumulate @Test - subroutine test_clear_accumulator() + subroutine test_clear() type(AccumulatorAction) :: acc type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -141,12 +141,12 @@ contains call initialize_objects(importState, exportState, clock, ESMF_TYPEKIND_R4, _RC) call acc%initialize(importState, exportState, clock, _RC) call FieldSet(acc%accumulation_field, TEST_VALUE, _RC) - call acc%clear_accumulator(_RC) + call acc%clear(_RC) is_expected_value = FieldIsConstant(acc%accumulation_field, acc%CLEAR_VALUE_R4, _RC) @assertTrue(is_expected_value, 'accumulation_field was not cleared.') call destroy_objects(importState, exportState, clock, _RC) - end subroutine test_clear_accumulator + end subroutine test_clear @Test subroutine test_accumulate_R4() diff --git a/generic3g/tests/Test_MeanAction.pf b/generic3g/tests/Test_MeanAction.pf index db44351f6bad..44ced2f22ec2 100644 --- a/generic3g/tests/Test_MeanAction.pf +++ b/generic3g/tests/Test_MeanAction.pf @@ -16,114 +16,60 @@ contains type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer :: status - integer(kind=ESMF_KIND_I8), parameter :: COUNTER = 4 + 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) - acc%counter_scalar = COUNTER + 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 valid_mean .TRUE. - acc%valid_mean = .TRUE. + ! 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') - ! One point is UNDEF + ! 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) - n = size(fptr)-1 - call set_undef(fptr(n)) - allocate(mask(size(fptr))) - mask = .TRUE. - mask(n) = .FALSE. 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') - - ! valid_mean .FALSE. at one point - acc%valid_mean = .TRUE. - call FieldSet(acc%accumulation_field, COUNTER*MEAN, _RC) - acc%valid_mean(n) = .FALSE. - call acc%calculate_mean_R4(_RC) - @assertTrue(all(pack(fptr, acc%valid_mean) == MEAN), 'Some valid points not equal to MEAN') - @assertTrue(undef(fptr(n)), 'mean at point was not UNDEF') - - ! One point is UNDEF; valid_mean .FALSE. at one point - acc%valid_mean = .TRUE. - call FieldSet(acc%accumulation_field, COUNTER*MEAN, _RC) - acc%valid_mean(n) = .FALSE. - call assign_fptr(acc%accumulation_field, fptr, _RC) - call set_undef(fptr(n)) - mask = (.not. undef(fptr)) .and. acc%valid_mean - 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 - subroutine test_calculate_mean() - type(MeanAction) :: acc - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer :: status - integer(kind=ESMF_KIND_I8), parameter :: COUNTER = 4 - real(kind=ESMF_KIND_R4), parameter :: MEAN = 4.0_R4 - logical :: matches_expected - - 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) - acc%counter_scalar = 0_I8 - acc%valid_mean = .TRUE. - call acc%calculate_mean() - @assertExceptionRaised() - acc%counter_scalar = COUNTER - call acc%calculate_mean() - matches_expected = FieldIsConstant(acc%accumulation_field, MEAN, _RC) - @assertTrue(matches_expected, 'accumulation_field not equal to MEAN.') - call destroy_objects(importState, exportState, clock, _RC) - - end subroutine test_calculate_mean - - @Test - subroutine test_clear_accumulator() + subroutine test_clear() 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) - acc%counter_scalar = 4 - call acc%clear_accumulator(_RC) - @assertTrue(acc%counter_scalar == 0_I8, 'counter_scalar is nonzero.') + 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_accumulator - - @Test - subroutine test_clear_valid_mean() - type(MeanAction) :: acc - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer :: status - - call initialize_objects(importState, exportState, clock, ESMF_TYPEKIND_R4, _RC) - call acc%initialize(importState, exportState, clock, _RC) - acc%valid_mean = .TRUE. - call acc%clear_valid_mean(_RC) - @assertTrue(.not. any(acc%valid_mean), 'valid_mean .TRUE. in elements') - call destroy_objects(importState, exportState, clock, _RC) - - end subroutine test_clear_valid_mean + end subroutine test_clear @Test subroutine test_invalidate() @@ -131,19 +77,25 @@ contains type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer :: status - integer(kind=ESMF_KIND_I8), parameter :: N = 4_I8 + 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) - @assertTrue(acc%counter_scalar == 0_I8, 'counter_scalar is nonzero') + 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 - @assertTrue(acc%counter_scalar == N, 'counter_scalar not equal to N') + 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) end subroutine test_invalidate @@ -169,29 +121,13 @@ contains call assign_fptr(update_field, upPtr, _RC) upPtr = UPDATE_VALUE - ! accumulated not undef, update_field not undef + ! update_field not undef call acc%accumulate_R4(update_field, _RC) result_value = result_value + UPDATE_VALUE call assign_fptr(acc%accumulation_field, accPtr, _RC) @assertTrue(all(accPtr == result_value), 'accumulation_field not equal to expected value.') - ! accumulated undef at point, update_field not undef - call assign_fptr(acc%accumulation_field, accPtr, _RC) - n = size(accPtr) - 1 - call set_undef(accPtr(n)) - call acc%accumulate_R4(update_field, _RC) - result_value = result_value + UPDATE_VALUE - @assertTrue(undef(accPtr(n)), 'invalid point is not UNDEF') - @assertTrue(all(pack(accPtr, .not. undef(accPtr)) == result_value), 'valid point not equal to expected value.') - - ! accumulated undef at point, update_field undef at point - n = size(upPtr) - 1 - call set_undef(upPtr(n)) - call acc%accumulate_R4(update_field, _RC) - result_value = result_value + UPDATE_VALUE - @assertTrue(undef(accPtr(n)), 'invalid point is not UNDEF') - - ! accumulated not undef, update_field undef at point + ! update_field undef at point call FieldSet(importField, result_value, _RC) call acc%initialize(importState, exportState, clock, _RC) call acc%accumulate_R4(update_field, _RC) @@ -202,4 +138,67 @@ contains end subroutine test_accumulate_mean_R4 + @Test + subroutine test_initialize() + 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 + subroutine test_accumulate_with_undef_some_steps() + 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, typekind=ESMF_TYPEKIND_R4, _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.') + + end subroutine test_accumulate_with_undef_some_steps + end module Test_MeanAction