diff --git a/CHANGELOG.md b/CHANGELOG.md index 65ec9c1b931..402956807b8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -68,6 +68,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Implemented workarounds to avoid needing `-dusty` for NAG. (Related PR in ESMA_CMake.) - Added constructor for DSO_SetServicesWrapper - Change macro in field/undo_function_overload.macro +- Fixed bug with AccumulatorAction and subtypes ## [Unreleased] diff --git a/generic3g/tests/Test_AccumulatorAction.pf b/generic3g/tests/Test_AccumulatorAction.pf index 42fe674466b..9ac9b4cb3c0 100644 --- a/generic3g/tests/Test_AccumulatorAction.pf +++ b/generic3g/tests/Test_AccumulatorAction.pf @@ -1,17 +1,18 @@ #include "MAPL_TestErr.h" -#include "unused_dummy.H" module Test_AccumulatorAction use mapl3g_AccumulatorAction use accumulator_action_test_common use esmf - use funit use MAPL_FieldUtils + use pfunit + use ESMF_TestMethod_mod implicit none contains - @Test - subroutine test_construct_AccumulatorAction() + @Test(type=ESMF_TestMethod, npes=[1]) + subroutine test_construct_AccumulatorAction(this) + class(ESMF_TestMethod), intent(inout) :: this type(AccumulatorAction) :: acc @assertFalse(acc%update_calculated, 'updated_calculated .TRUE.') @@ -19,8 +20,9 @@ contains end subroutine test_construct_AccumulatorAction - @Test - subroutine test_initialize() + @Test(type=ESMF_TestMethod, npes=[1]) + subroutine test_initialize(this) + class(ESMF_TestMethod), intent(inout) :: this type(AccumulatorAction) :: acc type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -36,8 +38,9 @@ contains end subroutine test_initialize - @Test - subroutine test_invalidate() + @Test(type=ESMF_TestMethod, npes=[1]) + subroutine test_invalidate(this) + class(ESMF_TestMethod), intent(inout) :: this type(AccumulatorAction) :: acc type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -62,8 +65,9 @@ contains end subroutine test_invalidate - @Test - subroutine test_update() + @Test(type=ESMF_TestMethod, npes=[1]) + subroutine test_update(this) + class(ESMF_TestMethod), intent(inout) :: this type(AccumulatorAction) :: acc type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -105,8 +109,9 @@ contains end subroutine test_update - @Test - subroutine test_accumulate() + @Test(type=ESMF_TestMethod, npes=[1]) + subroutine test_accumulate(this) + class(ESMF_TestMethod), intent(inout) :: this type(AccumulatorAction) :: acc type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -119,7 +124,7 @@ contains typekind = ESMF_TYPEKIND_R4 call initialize_objects(importState, exportState, clock, typekind, _RC) call acc%initialize(importState, exportState, clock, _RC) - call initialize_field(update_field, typekind=typekind, _RC) + call initialize_field(update_field, acc%accumulation_field, _RC) call FieldSet(update_field, value_r4, _RC) call acc%accumulate(update_field, _RC) matches_expected = FieldIsConstant(acc%accumulation_field, value_r4, _RC) @@ -129,8 +134,9 @@ contains end subroutine test_accumulate - @Test - subroutine test_clear() + @Test(type=ESMF_TestMethod, npes=[1]) + subroutine test_clear(this) + class(ESMF_TestMethod), intent(inout) :: this type(AccumulatorAction) :: acc type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -148,31 +154,61 @@ contains end subroutine test_clear - @Test - subroutine test_accumulate_R4() + @Test(type=ESMF_TestMethod, npes=[1]) + 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) :: update_value = 3.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, typekind=typekind, _RC) - call FieldSet(update_field, update_value, _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 + 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.') + @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 + 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.') + @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) diff --git a/generic3g/tests/Test_MaxAction.pf b/generic3g/tests/Test_MaxAction.pf index 37049a92482..b3995e7643b 100644 --- a/generic3g/tests/Test_MaxAction.pf +++ b/generic3g/tests/Test_MaxAction.pf @@ -3,14 +3,16 @@ module Test_MaxAction use mapl3g_MaxAction use accumulator_action_test_common use esmf - use funit use MAPL_FieldUtils + use pfunit + use ESMF_TestMethod_mod implicit none contains - @Test - subroutine test_max_accumulate_R4() + @Test(type=ESMF_TestMethod, npes=[1]) + subroutine test_max_accumulate_R4(this) + class(ESMF_TestMethod), intent(inout) :: this type(MaxAction) :: acc type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -27,7 +29,7 @@ contains call set_undef(undef_value) call initialize_objects(importState, exportState, clock, tk, _RC) call acc%initialize(importState, exportState, clock, _RC) - call initialize_field(update_field, typekind=tk, _RC) + call initialize_field(update_field, acc%accumulation_field, _RC) call assign_fptr(acc%accumulation_field, accPtr, _RC) call assign_fptr(update_field, upPtr, _RC) n = size(upPtr) @@ -36,7 +38,7 @@ contains upPtr(i:n) = [UPDATE_VALUE, undef_value, UPDATE_VALUE, UPDATE_VALUE+ACCUMULATED_VALUE] expected = [UPDATE_VALUE, ACCUMULATED_VALUE, ACCUMULATED_VALUE, UPDATE_VALUE+ACCUMULATED_VALUE] call acc%accumulate_R4(update_field, _RC) - @assertEqual(expected, accPtr, 'accumulated_field not equal to expected values') + @assertEqual(expected, accPtr(i:n), 'accumulation_field not equal to expected values') call ESMF_FieldDestroy(update_field, _RC) call destroy_objects(importState, exportState, clock, _RC) diff --git a/generic3g/tests/Test_MeanAction.pf b/generic3g/tests/Test_MeanAction.pf index 44ced2f22ec..7ddc76a6b72 100644 --- a/generic3g/tests/Test_MeanAction.pf +++ b/generic3g/tests/Test_MeanAction.pf @@ -1,17 +1,18 @@ #include "MAPL_TestErr.h" module Test_MeanAction - use mapl3g_MeanAction use accumulator_action_test_common use esmf - use funit + use pfunit use MAPL_FieldUtils + use ESMF_TestMethod_mod implicit none contains - @Test - subroutine test_calculate_mean_R4() + @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 @@ -46,11 +47,13 @@ contains 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_clear() + @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 @@ -71,8 +74,9 @@ contains end subroutine test_clear - @Test - subroutine test_invalidate() + @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 @@ -97,49 +101,51 @@ contains 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 - subroutine test_accumulate_mean_R4() + @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 - type(ESMF_Field) :: update_field - real(kind=ESMF_KIND_R4), pointer :: upPtr(:), accPtr(:) - real(kind=ESMF_KIND_R4), parameter :: IMPORT_VALUE = 2.0_R4 real(kind=ESMF_KIND_R4), parameter :: UPDATE_VALUE = 3.0_R4 - real(kind=ESMF_KIND_R4) :: result_value = IMPORT_VALUE + 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 - type(ESMF_Field) :: importField call initialize_objects(importState, exportState, clock, ESMF_TYPEKIND_R4, _RC) - call get_field(importState, importField, _RC) - call FieldSet(importField, IMPORT_VALUE, _RC) call acc%initialize(importState, exportState, clock, _RC) - call initialize_field(update_field, typekind=ESMF_TYPEKIND_R4, _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) - upPtr = UPDATE_VALUE - - ! update_field not undef + ! 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) - 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.') + 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.') - ! 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) - result_value = result_value + UPDATE_VALUE - @assertTrue(undef(accPtr(n)), 'invalid point is not UNDEF') - @assertTrue(all(pack(accPtr, .not. undef(upPtr)) == result_value), 'valid point not equal to expected value.') + call ESMF_FieldDestroy(update_field) call destroy_objects(importState, exportState, clock, _RC) end subroutine test_accumulate_mean_R4 - @Test - subroutine test_initialize() + @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 @@ -156,8 +162,9 @@ contains end subroutine test_initialize - @Test - subroutine test_accumulate_with_undef_some_steps() + @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 @@ -171,7 +178,7 @@ contains 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 initialize_field(update_field, acc%accumulation_field, _RC) call assign_fptr(update_field, upPtr, _RC) upPtr = UPDATE_VALUE allocate(mask(size(upPtr))) @@ -198,6 +205,8 @@ contains 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 diff --git a/generic3g/tests/Test_MinAction.pf b/generic3g/tests/Test_MinAction.pf index 0f9a3d15120..de3b3589728 100644 --- a/generic3g/tests/Test_MinAction.pf +++ b/generic3g/tests/Test_MinAction.pf @@ -3,14 +3,16 @@ module Test_MinAction use mapl3g_MinAction use accumulator_action_test_common use esmf - use funit use MAPL_FieldUtils + use pfunit + use ESMF_TestMethod_mod implicit none contains - @Test - subroutine test_min_accumulate_R4() + @Test(type=ESMF_TestMethod, npes=[1]) + subroutine test_min_accumulate_R4(this) + class(ESMF_TestMethod), intent(inout) :: this type(MinAction) :: acc type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -27,7 +29,7 @@ contains call set_undef(undef_value) call initialize_objects(importState, exportState, clock, tk, _RC) call acc%initialize(importState, exportState, clock, _RC) - call initialize_field(update_field, typekind=tk, _RC) + call initialize_field(update_field, acc%accumulation_field, _RC) call assign_fptr(acc%accumulation_field, accPtr, _RC) call assign_fptr(update_field, upPtr, _RC) n = size(upPtr) @@ -36,7 +38,7 @@ contains upPtr(i:n) = [UPDATE_VALUE, undef_value, UPDATE_VALUE, UPDATE_VALUE+ACCUMULATED_VALUE] expected = [UPDATE_VALUE, ACCUMULATED_VALUE, UPDATE_VALUE, ACCUMULATED_VALUE] call acc%accumulate_R4(update_field, _RC) - @assertEqual(expected, accPtr, 'accumulated_field not equal to expected values') + @assertEqual(expected, accPtr(i:n), 'accumulation_field not equal to expected values') call ESMF_FieldDestroy(update_field, _RC) call destroy_objects(importState, exportState, clock, _RC) diff --git a/generic3g/tests/accumulator_action_test_common.F90 b/generic3g/tests/accumulator_action_test_common.F90 index 36b15c1ba1e..273cfb87eb2 100644 --- a/generic3g/tests/accumulator_action_test_common.F90 +++ b/generic3g/tests/accumulator_action_test_common.F90 @@ -1,6 +1,7 @@ #define _RETURN_(R, S) if(present(R)) R = S; return #define _RETURN(S) _RETURN_(rc, S) #define _SUCCESS 0 +#define _FAILURE _SUCCESS-1 #include "MAPL_TestErr.h" module accumulator_action_test_common use esmf @@ -10,13 +11,18 @@ module accumulator_action_test_common integer, parameter :: R4 = ESMF_KIND_R4 integer, parameter :: R8 = ESMF_KIND_R8 + integer, parameter :: I4 = ESMF_KIND_I4 integer, parameter :: I8 = ESMF_KIND_I8 integer(kind=ESMF_KIND_I4), parameter :: TIME_STEP = 1 integer(kind=ESMF_KIND_I4), parameter :: START_TIME = 3000 integer, parameter :: MAX_INDEX(2) = [4, 4] - real(kind=ESMF_KIND_R8), parameter :: MIN_CORNER_COORD(2) = [0.0_R8, 0.0_R8] - real(kind=ESMF_KIND_R8), parameter :: MAX_CORNER_COORD(2) = [4.0_R8, 4.0_R8] - type(ESMF_TypeKind_Flag), parameter :: typekind = ESMF_TYPEKIND_R4 + integer, parameter :: REG_DECOMP(2) = [1, 1] + type(ESMF_TypeKind_Flag), parameter :: TYPEKIND = ESMF_TYPEKIND_R4 + + interface initialize_field + module procedure :: initialize_field_new + module procedure :: initialize_field_source + end interface initialize_field contains @@ -45,33 +51,48 @@ elemental subroutine set_undef(t) end subroutine set_undef - subroutine initialize_field(field, typekind, grid, rc) + subroutine create_grid(grid, rc) + type(ESMF_Grid), optional, intent(inout) :: grid + integer, optional, intent(out) :: rc + integer :: status + + grid = ESMF_GridCreate(regDecomp=REG_DECOMP, maxIndex=MAX_INDEX, _RC) + _RETURN(_SUCCESS) + + end subroutine create_grid + + subroutine initialize_field_new(field, typekind, grid, rc) type(ESMF_Field), intent(inout) :: field type(ESMF_TypeKind_Flag), intent(in) :: typekind - type(ESMF_Grid), optional, intent(inout) :: grid + type(ESMF_Grid), optional, intent(out) :: grid integer, optional, intent(out) :: rc - type(ESMF_Grid) :: grid_ - logical :: grid_created + type(ESMF_Grid) :: grid_ integer :: status - grid_created = .FALSE. - if(present(grid)) then - grid_created = ESMF_GridIsCreated(grid, _RC) - if(grid_created) grid_ = grid - end if + call create_grid(grid_, _RC) + field = ESMF_FieldCreate(grid=grid_, typekind=typekind, _RC) + if(present(grid)) grid=grid_ + _RETURN(_SUCCESS) - if(.not. grid_created) then - grid_ = ESMF_GridCreateNoPeriDimUfrm(maxIndex=MAX_INDEX, & - & minCornerCoord=MIN_CORNER_COORD, maxCornerCoord=MAX_CORNER_COORD, _RC) - end if + end subroutine initialize_field_new - field = ESMF_FieldCreate(grid=grid_, typekind=typekind, _RC) + subroutine initialize_field_source(field, source, grid, rc) + type(ESMF_Field), intent(inout) :: field + type(ESMF_Field), intent(inout) :: source + type(ESMF_Grid), optional, intent(out) :: grid + integer, optional, intent(out) :: rc + + type(ESMF_TypeKind_Flag) :: typekind + type(ESMF_Grid) :: grid_ + integer :: status - if(present(grid)) grid = grid_ + call ESMF_FieldGet(source, grid=grid_, typekind=typekind, _RC) + field = ESMF_FieldCreate(grid=grid_, typekind=typekind, _RC) + if(present(grid)) grid=grid_ _RETURN(_SUCCESS) - end subroutine initialize_field + end subroutine initialize_field_source subroutine initialize_objects(importState, exportState, clock, typekind, rc) type(ESMF_State), intent(inout) :: importState, exportState @@ -88,7 +109,7 @@ subroutine initialize_objects(importState, exportState, clock, typekind, rc) call ESMF_TimeIntervalSet(timeStep, s=TIME_STEP, _RC) call ESMF_TimeSet(startTime, yy=START_TIME, _RC) clock = ESMF_ClockCreate(timeStep=timeStep, startTime=startTime, _RC) - grid = ESMF_GridCreateNoPeriDimUfrm(maxIndex=MAX_INDEX, minCornerCoord=MIN_CORNER_COORD, maxCornerCoord=MAX_CORNER_COORD, _RC) + call create_grid(grid, _RC) importField = ESMF_FieldCreate(grid=grid, typekind=typekind, _RC) exportField = ESMF_FieldCreate(grid=grid, typekind=typekind, _RC) importState = ESMF_StateCreate(stateIntent=ESMF_STATEINTENT_IMPORT, fieldList=[importField], name='import', _RC)