From 2a79d2f6428422b5a3cc173f9cd9510f79792102 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 7 Feb 2024 09:15:30 -0500 Subject: [PATCH 1/4] Integrate test changes from `release/MAPL-v3 --- field_utils/tests/Test_FieldArithmetic.pf | 2 +- field_utils/tests/Test_FieldBLAS.pf | 115 +++++++++++++--------- field_utils/tests/field_utils_setup.F90 | 16 +-- 3 files changed, 78 insertions(+), 55 deletions(-) diff --git a/field_utils/tests/Test_FieldArithmetic.pf b/field_utils/tests/Test_FieldArithmetic.pf index cb21eda11296..57bb1e20c10a 100644 --- a/field_utils/tests/Test_FieldArithmetic.pf +++ b/field_utils/tests/Test_FieldArithmetic.pf @@ -66,7 +66,7 @@ contains call ESMF_FieldGet(y , farrayPtr = y_ptr, _RC) x_ptr = 2.0 - y_ptr = 3.0 + y_ptr = 3.0 result_array = x_ptr result_array = 5.0 call FieldAdd(y, x, y, _RC) diff --git a/field_utils/tests/Test_FieldBLAS.pf b/field_utils/tests/Test_FieldBLAS.pf index f7359eb07d7a..9c467810d30b 100644 --- a/field_utils/tests/Test_FieldBLAS.pf +++ b/field_utils/tests/Test_FieldBLAS.pf @@ -6,7 +6,7 @@ module Test_FieldBLAS use field_utils_setup use MAPL_FieldPointerUtilities use ESMF - use funit + use pfunit use MAPL_ExceptionHandling implicit none @@ -14,8 +14,8 @@ module Test_FieldBLAS contains @Before - subroutine set_up_data() - implicit none + subroutine set_up_data(this) + class(MpiTestMethod), intent(inout) :: this integer :: status, rc @@ -43,9 +43,15 @@ contains end subroutine set_up_data - @Test(npes=product(REG_DECOMP_DEFAULT)) + @after + subroutine teardown(this) + class(MpiTestMethod), intent(inout) :: this + end subroutine teardown + + @Test(npes=[4]) ! Basic test of FieldCOPY subroutine (REAL32) - subroutine test_FieldCOPY_R4() + subroutine test_FieldCOPY_R4(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x type(ESMF_Field) :: y real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: x_ptr @@ -61,9 +67,10 @@ contains end subroutine test_FieldCOPY_R4 - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) ! Basic test of FieldCOPY subroutine (REAL64) - subroutine test_FieldCOPY_R8() + subroutine test_FieldCOPY_R8(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x type(ESMF_Field) :: y real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: x_ptr @@ -79,9 +86,10 @@ contains end subroutine test_FieldCOPY_R8 - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) ! Basic test of FieldCOPY subroutine (REAL32 -> REAL64) - subroutine test_FieldCOPY_R4R8() + subroutine test_FieldCOPY_R4R8(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x type(ESMF_Field) :: y real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: x_ptr @@ -97,9 +105,10 @@ contains end subroutine test_FieldCOPY_R4R8 - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) ! Basic test of FieldCOPY subroutine (REAL64 -> REAL32) - subroutine test_FieldCOPY_R8R4() + subroutine test_FieldCOPY_R8R4(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x type(ESMF_Field) :: y real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: x_ptr @@ -117,9 +126,10 @@ contains end subroutine test_FieldCOPY_R8R4 - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) ! Basic test of FieldSCAL subroutine (REAL32) - subroutine test_FieldSCAL_R4() + subroutine test_FieldSCAL_R4(this) + class(MpiTestMethod), intent(inout) :: this real(kind=ESMF_KIND_R4), parameter :: a = 2.0 type(ESMF_Field) :: x real(kind=ESMF_KIND_R4), dimension(:,:), allocatable :: x_array @@ -135,10 +145,11 @@ contains end subroutine test_FieldSCAL_R4 - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) ! Basic test of FieldSCAL subroutine (REAL64) - subroutine test_FieldSCAL_R8() - real(kind=ESMF_KIND_R8), parameter :: a = 2.0 + subroutine test_FieldSCAL_R8(this) + class(MpiTestMethod), intent(inout) :: this + real(kind=ESMF_KIND_R8), parameter :: a = 2.0 type(ESMF_Field) :: x real(kind=ESMF_KIND_R8), dimension(:,:), allocatable :: x_array real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: x_ptr @@ -153,9 +164,10 @@ contains end subroutine test_FieldSCAL_R8 - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) ! - subroutine test_FieldAXPY_R4() + subroutine test_FieldAXPY_R4(this) + class(MpiTestMethod), intent(inout) :: this real(kind=ESMF_KIND_R4), parameter :: a = 2.0 type(ESMF_Field) :: x type(ESMF_Field) :: y @@ -178,10 +190,11 @@ contains end subroutine test_FieldAXPY_R4 - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) ! - subroutine test_FieldAXPY_R8() - real(kind=ESMF_KIND_R8), parameter :: a = 2.0 + subroutine test_FieldAXPY_R8(this) + class(MpiTestMethod), intent(inout) :: this + real(kind=ESMF_KIND_R8), parameter :: a = 2.0 type(ESMF_Field) :: x type(ESMF_Field) :: y real(kind=ESMF_KIND_R8), dimension(:,:), allocatable :: x_array @@ -203,8 +216,9 @@ contains end subroutine test_FieldAXPY_R8 - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldGetLocalElementCount() + @Test(npes=[4]) + subroutine test_FieldGetLocalElementCount(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x integer :: rank integer, allocatable :: expected_count(:) @@ -217,13 +231,13 @@ contains call ESMF_FieldGet(x, localElementCount=expected_count, _RC) actual_count = FieldGetLocalElementCount(x, _RC) @assertEqual(actual_count, expected_count) - if(allocated(expected_count)) deallocate(expected_count) end subroutine test_FieldGetLocalElementCount - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) ! - subroutine test_FieldGetLocalSize() + subroutine test_FieldGetLocalSize(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x integer :: status, rc integer :: rank @@ -242,14 +256,14 @@ contains end subroutine test_FieldGetLocalSize - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) ! Test getting the c_ptr for a field !wdb fixme Should test more extensively for different ranks !wdb fixme Should test for ESMF_KIND_I4 and ESMF_KIND_I8 !wdb fixme Should check c_cptr from tested method against independent test - - subroutine test_FieldGetCptr() - type(ESMF_Field) :: x + subroutine test_FieldGetCptr(this) + class(MpiTestMethod), intent(inout) :: this + type(ESMF_Field) :: x type(c_ptr) :: cptr integer :: status, rc @@ -260,9 +274,10 @@ contains end subroutine test_FieldGetCptr - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) !wdb fixme Probably should test for non-conformable fields - subroutine test_FieldsAreConformableR4() + subroutine test_FieldsAreConformableR4(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x, y integer :: status, rc logical :: are_conformable @@ -276,9 +291,10 @@ contains end subroutine test_FieldsAreConformableR4 !wdb fixme Probably should test for non-conformable fields - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldsAreConformableR8() - type(ESMF_Field) :: x, y + @Test(npes=[4]) + subroutine test_FieldsAreConformableR8(this) + class(MpiTestMethod), intent(inout) :: this + type(ESMF_Field) :: x, y integer :: status, rc logical :: are_conformable @@ -290,9 +306,10 @@ contains end subroutine test_FieldsAreConformableR8 - @Test(npes=product(REG_DECOMP_DEFAULT)) + @Test(npes=[4]) ! - subroutine test_FieldsAreSameTypeKind() + subroutine test_FieldsAreSameTypeKind(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x, y integer :: status, rc logical :: are_same_typekind @@ -318,9 +335,10 @@ contains end subroutine test_FieldsAreSameTypeKind !wdb fixme Enable assertEqual - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldConvertPrec_R4R8() - integer, parameter :: NROWS = 4 + @Test(npes=[4]) + subroutine test_FieldConvertPrec_R4R8(this) + class(MpiTestMethod), intent(inout) :: this + integer, parameter :: NROWS = 2 integer, parameter :: NCOLS = NROWS type(ESMF_Field) :: r4_field, r8_field real(kind=ESMF_KIND_R4) :: r4_data(NROWS,NCOLS) @@ -340,12 +358,13 @@ contains name = 'YR8', _RC) call FieldConvertPrec(r4_field, r8_field, _RC) call ESMF_FieldGet(r8_field, farrayPtr = r8_pointer, _RC) -! @assertEqual(r8_converted, r8_pointer) !wdb fixme temporarily disabled + @assertEqual(r8_converted, r8_pointer) end subroutine test_FieldConvertPrec_R4R8 - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldClone3D() + @Test(npes=[4]) + subroutine test_FieldClone3D(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x, y integer :: status, rc @@ -380,8 +399,9 @@ contains end subroutine test_FieldClone3D - @Test - subroutine test_almost_equal_scalar() + @Test(npes=[4]) + subroutine test_almost_equal_scalar(this) + class(MpiTestMethod), intent(inout) :: this character(len=*), parameter :: MSG = 'Difference exceeds threshold' real(kind=ESMF_KIND_R8), parameter :: X = 1.0 / 3.0 real(kind=ESMF_KIND_R4) :: y @@ -391,8 +411,9 @@ contains end subroutine test_almost_equal_scalar - @Test - subroutine test_almost_equal_array() + @Test(npes=[4]) + subroutine test_almost_equal_array(this) + class(MpiTestMethod), intent(inout) :: this integer, parameter :: N = 3 character(len=*), parameter :: MSG = 'Difference exceeds threshold' real(kind=ESMF_KIND_R8), parameter :: DENOMS(N) = [3.0, 5.0, 7.0] diff --git a/field_utils/tests/field_utils_setup.F90 b/field_utils/tests/field_utils_setup.F90 index 437a3d107631..76cd290e4ee2 100644 --- a/field_utils/tests/field_utils_setup.F90 +++ b/field_utils/tests/field_utils_setup.F90 @@ -21,7 +21,7 @@ module field_utils_setup integer :: i type(ESMF_Index_Flag), parameter :: INDEX_FLAG_DEFAULT = ESMF_INDEX_DELOCAL integer, parameter :: REG_DECOMP_DEFAULT(*) = [2, 2] - integer, parameter :: MAX_INDEX_DEFAULT(*) = [4, 4] + integer, parameter :: MAX_INDEX_DEFAULT(*) = [2, 2] integer, parameter :: MIN_INDEX_DEFAULT(*) = [1, 1] integer, parameter :: DIMR4_DEFAULT(*) = [4, 4] integer, parameter :: DIMR8_DEFAULT(*) = [4, 4] @@ -29,8 +29,8 @@ module field_utils_setup integer, parameter :: SIZE_R8 = 16 real, parameter :: undef = 42.0 - real(kind=ESMF_KIND_R4), parameter :: R4_ARRAY_DEFAULT(*,*) = reshape([(i, i = 1, SIZE_R4)], DIMR4_DEFAULT) - real(kind=ESMF_KIND_R8), parameter :: R8_ARRAY_DEFAULT(*,*) = reshape([(i, i = 1, SIZE_R8)], DIMR8_DEFAULT) + real(kind=ESMF_KIND_R4), parameter :: R4_ARRAY_DEFAULT(*,*) = reshape([(i, i = 1, 4)], [2,2]) + real(kind=ESMF_KIND_R8), parameter :: R8_ARRAY_DEFAULT(*,*) = reshape([(i, i = 1, 4)], [2,2]) type(ESMF_Field) :: XR4 type(ESMF_Field) :: XR8 @@ -56,7 +56,7 @@ function mk_grid(regDecomp, minIndex, maxIndex, indexflag, grid_name, rc) result integer :: status - grid = ESMF_GridCreateNoPeriDim(regDecomp = regDecomp, maxIndex = maxIndex, minIndex = minIndex, indexflag = indexflag, name = grid_name, _RC) + grid = ESMF_GridCreateNoPeriDim(countsPerDeDim1=[2,2], countsPerDeDim2=[2,2], indexflag = indexflag, name = grid_name, _RC) _RETURN(_SUCCESS) end function mk_grid @@ -96,7 +96,8 @@ function mk_field_r4_2d(farray, regDecomp, minIndex, maxIndex, indexflag, name, field = mk_field_common(tk = ESMF_TYPEKIND_R4, regDecomp=regDecomp, minIndex=minIndex, maxIndex=maxIndex, indexflag = indexflag, name = name, _RC) call ESMF_FieldGet(field, farrayPtr = ptr, _RC) - ptr => farray + + ptr = farray _RETURN(_SUCCESS) end function mk_field_r4_2d @@ -117,7 +118,7 @@ function mk_field_r8_2d(farray, regDecomp, minIndex, maxIndex, indexflag, name, field = mk_field_common(tk = ESMF_TYPEKIND_R8, regDecomp=regDecomp, minIndex=minIndex, maxIndex=maxIndex, indexflag = indexflag, name = name, _RC) call ESMF_FieldGet(field, farrayPtr = ptr, _RC) - ptr => farray + ptr = farray _RETURN(_SUCCESS) end function mk_field_r8_2d @@ -138,7 +139,8 @@ function mk_field_common(tk, regDecomp, minIndex, maxIndex, indexflag, name, ung type(ESMF_Field) :: field type(ESMF_Grid) :: grid integer :: status - + real, pointer :: fptr(:,:) + grid = mk_grid(regDecomp=regDecomp, minIndex=minIndex, maxIndex=maxIndex, indexflag = indexflag, grid_name = name // GRID_SUFFIX, _RC) field = ESMF_FieldCreate(grid, typekind = tk, name = name // FIELD_SUFFIX, ungriddedLBound = ungriddedLBound, ungriddedUBound = ungriddedUBound, _RC) From 631f4a71804f7cf5a012b81e04029d0a0e22ded2 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 7 Feb 2024 09:47:40 -0500 Subject: [PATCH 2/4] Eliminate unused variables. --- field_utils/tests/Test_FieldArithmetic.pf | 12 ++-- field_utils/tests/Test_FieldBLAS.pf | 72 +++-------------------- field_utils/tests/field_utils_setup.F90 | 46 ++++----------- 3 files changed, 24 insertions(+), 106 deletions(-) diff --git a/field_utils/tests/Test_FieldArithmetic.pf b/field_utils/tests/Test_FieldArithmetic.pf index 57bb1e20c10a..7f02be3fed01 100644 --- a/field_utils/tests/Test_FieldArithmetic.pf +++ b/field_utils/tests/Test_FieldArithmetic.pf @@ -35,14 +35,10 @@ contains allocate(y8array, source=R8_ARRAY_DEFAULT) y4array = y4array + ADD_R4 y8array = y8array + ADD_R8 - XR4 = mk_field(R4_ARRAY_DEFAULT, regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = 'XR4', _RC) - YR4 = mk_field(y4array, regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = 'YR4', _RC) - XR8 = mk_field(R8_ARRAY_DEFAULT, regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = 'XR8', _RC) - YR8 = mk_field(y8array, regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = 'YR8', _RC) + XR4 = mk_field(R4_ARRAY_DEFAULT, name = 'XR4', _RC) + YR4 = mk_field(y4array, name = 'YR4', _RC) + XR8 = mk_field(R8_ARRAY_DEFAULT, name = 'XR8', _RC) + YR8 = mk_field(y8array, name = 'YR8', _RC) call ESMF_AttributeSet(xr4,name="missing_value",value=undef,_RC) call ESMF_AttributeSet(xr8,name="missing_value",value=undef,_RC) call ESMF_AttributeSet(yr4,name="missing_value",value=undef,_RC) diff --git a/field_utils/tests/Test_FieldBLAS.pf b/field_utils/tests/Test_FieldBLAS.pf index 9c467810d30b..f17f0c9b330c 100644 --- a/field_utils/tests/Test_FieldBLAS.pf +++ b/field_utils/tests/Test_FieldBLAS.pf @@ -28,18 +28,12 @@ contains allocate(y8array, source=R8_ARRAY_DEFAULT) y4array = y4array + ADD_R4 y8array = y8array + ADD_R8 - XR4 = mk_field(R4_ARRAY_DEFAULT, regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = 'XR4', _RC) - YR4 = mk_field(y4array, regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = 'YR4', _RC) - XR8 = mk_field(R8_ARRAY_DEFAULT, regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = 'XR8', _RC) - YR8 = mk_field(y8array, regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = 'YR8', _RC) - XR4_3D = mk_field_r4_ungrid(regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = 'XR4_3D', ungriddedLBound=[1],ungriddedUBound=[3],_RC) - YR4_3D = mk_field_r4_ungrid(regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = 'YR4_3D',ungriddedLBound=[1],ungriddedUBound=[3], _RC) + XR4 = mk_field(R4_ARRAY_DEFAULT, name = 'XR4', _RC) + YR4 = mk_field(y4array, name = 'YR4', _RC) + XR8 = mk_field(R8_ARRAY_DEFAULT, name = 'XR8', _RC) + YR8 = mk_field(y8array, name = 'YR8', _RC) + XR4_3D = mk_field_r4_ungrid(name = 'XR4_3D', ungriddedLBound=[1],ungriddedUBound=[3],_RC) + YR4_3D = mk_field_r4_ungrid(name = 'YR4_3D',ungriddedLBound=[1],ungriddedUBound=[3], _RC) end subroutine set_up_data @@ -212,7 +206,6 @@ contains call FieldAXPY(a, x, y, _RC) call ESMF_FieldGet(x, farrayPtr = x_ptr, _RC) call ESMF_FieldGet(y, farrayPtr = y_ptr, _RC) -! @assertEqual(y_ptr, a*x_array+y_array) !wdb fixme Temporarily disabled end subroutine test_FieldAXPY_R8 @@ -334,7 +327,6 @@ contains end subroutine test_FieldsAreSameTypeKind -!wdb fixme Enable assertEqual @Test(npes=[4]) subroutine test_FieldConvertPrec_R4R8(this) class(MpiTestMethod), intent(inout) :: this @@ -350,12 +342,8 @@ contains call initialize_array(r4_data, 0.0, 1.0) r8_data = 0.0 r8_converted = r4_data - r4_field = mk_field(r4_data, regDecomp = REG_DECOMP_DEFAULT, minIndex = [1, 1], & - maxIndex = [NROWS, NCOLS], indexflag = INDEX_FLAG_DEFAULT, & - name = 'XR4', _RC) - r8_field = mk_field(r8_data, regDecomp = REG_DECOMP_DEFAULT, minIndex = [1, 1], & - maxIndex = [NROWS, NCOLS], indexflag = INDEX_FLAG_DEFAULT, & - name = 'YR8', _RC) + r4_field = mk_field(r4_data, name = 'XR4', _RC) + r8_field = mk_field(r8_data, name = 'YR8', _RC) call FieldConvertPrec(r4_field, r8_field, _RC) call ESMF_FieldGet(r8_field, farrayPtr = r8_pointer, _RC) @assertEqual(r8_converted, r8_pointer) @@ -427,47 +415,3 @@ contains end subroutine test_almost_equal_array end module Test_FieldBLAS -! @Test(npes=product(REG_DECOMP_DEFAULT)) -! ! -! subroutine test_FieldGEMV_R4() -! real(kind=ESMF_KIND_R4), parameter :: alpha = 3.0 -! real(kind=ESMF_KIND_R4), parameter :: A(*,*,*) -! type(ESMF_Field) :: x -! real(kind=ESMF_KIND_R4), parameter :: beta = 2.0 -! type(ESMF_Field) :: y -! real(kind=ESMF_KIND_R8), dimension(:,:), allocatable :: x_array -! real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: x_ptr -! real(kind=ESMF_KIND_R8), dimension(:,:), allocatable :: y_array -! real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: y_ptr -! integer :: status, rc - -! allocate(x_array, source = R4_ARRAY_DEFAULT) -! allocate(y_array, source = R4_ARRAY_DEFAULT) -! y_array = y_array + 100 - -! do while(.TRUE.) -! x = mk_field(x_array, _RC) -! if(status /= ESMF_SUCCESS) exit - -! y = mk_field(y_array, _RC) -! if(status /= ESMF_SUCCESS) exit - -! call FieldAXPY(a, x, y, _RC) -! if(status /= ESMF_SUCCESS) exit -! -! call ESMF_FieldGet(x, farrayPtr = x_ptr, _RC) -! if(status /= ESMF_SUCCESS) exit - -! call ESMF_FieldGet(y, farrayPtr = y_ptr, _RC) -! if(status /= ESMF_SUCCESS) exit - -! @assertEqual(y_ptr, a*x_array+y_array) -! exit -! end do -! -! end subroutine test_FieldGEMV_R4 - -! @Test(npes=product(REG_DECOMP_DEFAULT)) -! ! -! subroutine test_FieldSpread() -! end subroutine test_FieldSpread diff --git a/field_utils/tests/field_utils_setup.F90 b/field_utils/tests/field_utils_setup.F90 index 76cd290e4ee2..2afcabf73a96 100644 --- a/field_utils/tests/field_utils_setup.F90 +++ b/field_utils/tests/field_utils_setup.F90 @@ -44,11 +44,7 @@ module field_utils_setup contains ! MAKE GRID FOR FIELDS - function mk_grid(regDecomp, minIndex, maxIndex, indexflag, grid_name, rc) result(grid) - integer, dimension(:), intent(in) :: regDecomp - integer, dimension(:), intent(in) :: minIndex - integer, dimension(:), intent(in) :: maxIndex - type(ESMF_Index_Flag), intent(in) :: indexflag + function mk_grid(grid_name, rc) result(grid) character(len=*), intent(in) :: grid_name integer, optional, intent(out) :: rc @@ -56,16 +52,12 @@ function mk_grid(regDecomp, minIndex, maxIndex, indexflag, grid_name, rc) result integer :: status - grid = ESMF_GridCreateNoPeriDim(countsPerDeDim1=[2,2], countsPerDeDim2=[2,2], indexflag = indexflag, name = grid_name, _RC) + grid = ESMF_GridCreateNoPeriDim(countsPerDeDim1=[2,2], countsPerDeDim2=[2,2], indexflag=INDEX_FLAG_DEFAULT, name = grid_name, _RC) _RETURN(_SUCCESS) end function mk_grid - function mk_field_r4_ungrid(regDecomp, minIndex, maxIndex, indexflag, name, ungriddedLBound, ungriddedUBound, rc) result(field) - integer, dimension(:), intent(in) :: regDecomp - integer, dimension(:), intent(in) :: minIndex - integer, dimension(:), intent(in) :: maxIndex - type(ESMF_Index_Flag), intent(in) :: indexflag + function mk_field_r4_ungrid(name, ungriddedLBound, ungriddedUBound, rc) result(field) character(len=*), intent(in) :: name integer, optional, intent(in) :: ungriddedLBound(:) integer, optional, intent(in) :: ungriddedUBound(:) @@ -75,17 +67,13 @@ function mk_field_r4_ungrid(regDecomp, minIndex, maxIndex, indexflag, name, ungr integer :: status - field = mk_field_common(tk = ESMF_TYPEKIND_R4, regDecomp=regDecomp, minIndex=minIndex, maxIndex=maxIndex, indexflag = indexflag, name = name, ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, _RC) + field = mk_field_common(tk = ESMF_TYPEKIND_R4, name = name, ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, _RC) _RETURN(_SUCCESS) end function mk_field_r4_ungrid - function mk_field_r4_2d(farray, regDecomp, minIndex, maxIndex, indexflag, name, rc) result(field) + function mk_field_r4_2d(farray, name, rc) result(field) real(kind=ESMF_KIND_R4), dimension(:,:), target, intent(in) :: farray - integer, dimension(:), intent(in) :: regDecomp - integer, dimension(:), intent(in) :: minIndex - integer, dimension(:), intent(in) :: maxIndex - type(ESMF_Index_Flag), intent(in) :: indexflag character(len=*), intent(in) :: name integer, optional, intent(out) :: rc @@ -94,7 +82,7 @@ function mk_field_r4_2d(farray, regDecomp, minIndex, maxIndex, indexflag, name, integer :: status - field = mk_field_common(tk = ESMF_TYPEKIND_R4, regDecomp=regDecomp, minIndex=minIndex, maxIndex=maxIndex, indexflag = indexflag, name = name, _RC) + field = mk_field_common(tk = ESMF_TYPEKIND_R4, name = name, _RC) call ESMF_FieldGet(field, farrayPtr = ptr, _RC) ptr = farray @@ -102,12 +90,8 @@ function mk_field_r4_2d(farray, regDecomp, minIndex, maxIndex, indexflag, name, _RETURN(_SUCCESS) end function mk_field_r4_2d - function mk_field_r8_2d(farray, regDecomp, minIndex, maxIndex, indexflag, name, rc) result(field) + function mk_field_r8_2d(farray, name, rc) result(field) real(kind=ESMF_KIND_R8), dimension(:,:), target, intent(in) :: farray - integer, dimension(:), intent(in) :: regDecomp - integer, dimension(:), intent(in) :: minIndex - integer, dimension(:), intent(in) :: maxIndex - type(ESMF_Index_Flag), intent(in) :: indexflag character(len=*), intent(in) :: name integer, optional, intent(out) :: rc @@ -116,19 +100,15 @@ function mk_field_r8_2d(farray, regDecomp, minIndex, maxIndex, indexflag, name, integer :: status - field = mk_field_common(tk = ESMF_TYPEKIND_R8, regDecomp=regDecomp, minIndex=minIndex, maxIndex=maxIndex, indexflag = indexflag, name = name, _RC) + field = mk_field_common(tk = ESMF_TYPEKIND_R8, name = name, _RC) call ESMF_FieldGet(field, farrayPtr = ptr, _RC) ptr = farray _RETURN(_SUCCESS) end function mk_field_r8_2d - function mk_field_common(tk, regDecomp, minIndex, maxIndex, indexflag, name, ungriddedLBound, ungriddedUBound, rc) result(field) + function mk_field_common(tk, name, ungriddedLBound, ungriddedUBound, rc) result(field) type(ESMF_TypeKind_Flag), intent(in) :: tk - integer, dimension(:), intent(in) :: regDecomp - integer, dimension(:), intent(in) :: minIndex - integer, dimension(:), intent(in) :: maxIndex - type(ESMF_Index_Flag), intent(in) :: indexflag character(len=*), intent(in) :: name integer, optional, intent(in) :: ungriddedLBound(:) integer, optional, intent(in) :: ungriddedUBound(:) @@ -141,7 +121,7 @@ function mk_field_common(tk, regDecomp, minIndex, maxIndex, indexflag, name, ung integer :: status real, pointer :: fptr(:,:) - grid = mk_grid(regDecomp=regDecomp, minIndex=minIndex, maxIndex=maxIndex, indexflag = indexflag, grid_name = name // GRID_SUFFIX, _RC) + grid = mk_grid(grid_name = name // GRID_SUFFIX, _RC) field = ESMF_FieldCreate(grid, typekind = tk, name = name // FIELD_SUFFIX, ungriddedLBound = ungriddedLBound, ungriddedUBound = ungriddedUBound, _RC) _RETURN(_SUCCESS) @@ -193,8 +173,7 @@ function mk_r4field(r4array, field_name, rc) result(r4field) integer :: status - r4field = mk_field(r4array, regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, & - maxIndex=MAX_INDEX_DEFAULT, indexflag=INDEX_FLAG_DEFAULT, name = field_name, _RC) + r4field = mk_field(r4array, name = field_name, _RC) _RETURN(_SUCCESS) @@ -208,8 +187,7 @@ function mk_r8field(r8array, field_name, rc) result(r8field) integer :: status - r8field = mk_field(r8array, regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, & - maxIndex=MAX_INDEX_DEFAULT, indexflag=INDEX_FLAG_DEFAULT, name = field_name, _RC) + r8field = mk_field(r8array, name = field_name, _RC) _RETURN(_SUCCESS) From 5a7bdd6de7de40aab61bcba29e9b478ce91f4889 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 7 Feb 2024 11:43:48 -0500 Subject: [PATCH 3/4] Fix npes args ; funit=>pfunit; remove unused vars --- field_utils/tests/Test_FieldArithmetic.pf | 49 ++++++++++++++--------- field_utils/tests/field_utils_setup.F90 | 18 ++++----- 2 files changed, 37 insertions(+), 30 deletions(-) diff --git a/field_utils/tests/Test_FieldArithmetic.pf b/field_utils/tests/Test_FieldArithmetic.pf index 7f02be3fed01..b3302c0401ce 100644 --- a/field_utils/tests/Test_FieldArithmetic.pf +++ b/field_utils/tests/Test_FieldArithmetic.pf @@ -8,7 +8,7 @@ module Test_FieldArithmetic use MAPL_FieldUtilities use MAPL_FieldPointerUtilities use ESMF - use funit + use pfunit use MAPL_ExceptionHandling implicit none @@ -21,8 +21,8 @@ contains ! Making the fields should be done in the tests themselves so because ! of the npes argument. @Before - subroutine set_up_data() - implicit none + subroutine set_up_data(this) + class(MpiTestMethod), intent(inout) :: this integer :: status, rc @@ -46,8 +46,14 @@ contains end subroutine set_up_data - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldAddR4() + @after + subroutine teardown(this) + class(MpiTestMethod), intent(inout) :: this + end subroutine teardown + + @Test(npes=[4]) + subroutine test_FieldAddR4(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x type(ESMF_Field) :: y real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:), y_ptr(:,:) @@ -70,11 +76,9 @@ contains end subroutine test_FieldAddR4 - ! Rather than use the fields created in setup, make the fields - ! in this subroutine to make sure that the npes match the - ! regDecomp. - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldAddR4_missing + @Test(npes=[4]) + subroutine test_FieldAddR4_missing(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x type(ESMF_Field) :: y real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:), y_ptr(:,:) @@ -94,8 +98,9 @@ contains @assertEqual(y_ptr, result_array) end subroutine test_FieldAddR4_missing - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldAddR8() + @Test(npes=[4]) + subroutine test_FieldAddR8(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x type(ESMF_Field) :: y real(kind=ESMF_KIND_R8), pointer :: x_ptr(:,:), y_ptr(:,:) @@ -117,8 +122,9 @@ contains @assertEqual(y_ptr, result_array) end subroutine test_FieldAddR8 - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldPowR4() + @Test(npes=[4]) + subroutine test_FieldPowR4(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:) real(kind=ESMF_KIND_R4), allocatable :: result_array(:,:) @@ -136,8 +142,9 @@ contains @assertEqual(x_ptr, result_array) end subroutine test_FieldPowR4 - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldPowR8() + @Test(npes=[4]) + subroutine test_FieldPowR8(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x real(kind=ESMF_KIND_R8), pointer :: x_ptr(:,:) real(kind=ESMF_KIND_R8), allocatable :: result_array(:,:) @@ -155,8 +162,9 @@ contains @assertEqual(x_ptr, result_array) end subroutine test_FieldPowR8 - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldSinR4() + @Test(npes=[4]) + subroutine test_FieldSinR4(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:) real(kind=ESMF_KIND_R4), allocatable :: result_array(:,:) @@ -172,8 +180,9 @@ contains @assertEqual(x_ptr, result_array) end subroutine test_FieldSinR4 - @Test(npes=product(REG_DECOMP_DEFAULT)) - subroutine test_FieldNegR4() + @Test(npes=[4]) + subroutine test_FieldNegR4(this) + class(MpiTestMethod), intent(inout) :: this type(ESMF_Field) :: x real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:) real(kind=ESMF_KIND_R4), allocatable :: result_array(:,:) diff --git a/field_utils/tests/field_utils_setup.F90 b/field_utils/tests/field_utils_setup.F90 index 2afcabf73a96..967753e98c3c 100644 --- a/field_utils/tests/field_utils_setup.F90 +++ b/field_utils/tests/field_utils_setup.F90 @@ -20,13 +20,13 @@ module field_utils_setup integer :: i type(ESMF_Index_Flag), parameter :: INDEX_FLAG_DEFAULT = ESMF_INDEX_DELOCAL - integer, parameter :: REG_DECOMP_DEFAULT(*) = [2, 2] - integer, parameter :: MAX_INDEX_DEFAULT(*) = [2, 2] - integer, parameter :: MIN_INDEX_DEFAULT(*) = [1, 1] - integer, parameter :: DIMR4_DEFAULT(*) = [4, 4] - integer, parameter :: DIMR8_DEFAULT(*) = [4, 4] - integer, parameter :: SIZE_R4 = 16 - integer, parameter :: SIZE_R8 = 16 +! integer, parameter :: REG_DECOMP_DEFAULT(*) = [2, 2] !wdb delete +! integer, parameter :: MAX_INDEX_DEFAULT(*) = [2, 2] !wdb delete +! integer, parameter :: MIN_INDEX_DEFAULT(*) = [1, 1] !wdb delete +! integer, parameter :: DIMR4_DEFAULT(*) = [4, 4] !wdb delete +! integer, parameter :: DIMR8_DEFAULT(*) = [4, 4] !wdb delete +! integer, parameter :: SIZE_R4 = 16 !wdb delete +! integer, parameter :: SIZE_R8 = 16 !wdb delete real, parameter :: undef = 42.0 real(kind=ESMF_KIND_R4), parameter :: R4_ARRAY_DEFAULT(*,*) = reshape([(i, i = 1, 4)], [2,2]) @@ -119,7 +119,6 @@ function mk_field_common(tk, name, ungriddedLBound, ungriddedUBound, rc) result( type(ESMF_Field) :: field type(ESMF_Grid) :: grid integer :: status - real, pointer :: fptr(:,:) grid = mk_grid(grid_name = name // GRID_SUFFIX, _RC) field = ESMF_FieldCreate(grid, typekind = tk, name = name // FIELD_SUFFIX, ungriddedLBound = ungriddedLBound, ungriddedUBound = ungriddedUBound, _RC) @@ -202,8 +201,7 @@ function mk_r4ungrid_field(field_name, lbound, ubound, rc) result(r4field) integer :: status - r4field = mk_field_r4_ungrid(regDecomp=REG_DECOMP_DEFAULT, minIndex=MIN_INDEX_DEFAULT, maxIndex=MAX_INDEX_DEFAULT, & - indexflag=INDEX_FLAG_DEFAULT, name = field_name, ungriddedLBound=[lbound],ungriddedUBound=[ubound],_RC) + r4field = mk_field_r4_ungrid(name = field_name, ungriddedLBound=[lbound],ungriddedUBound=[ubound],_RC) _RETURN(_SUCCESS) From cefa47c1030004915e0e957c791a399579e5791e Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 7 Feb 2024 12:08:27 -0500 Subject: [PATCH 4/4] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 11126a66ac4d..3242edfe9694 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -49,6 +49,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 we anticipate this here - Add explicit `Fortran_MODULE_DIRECTORY` to `CMakeLists.txt` in benchmarks to avoid race condition in Ninja builds - Add check to make sure ESMF was not built as `mpiuni` +- Fixed failing tests for `field_utils`. ### Removed