Merge pull request #2538 from GEOS-ESM/feature/wdboggs/#2530-fix-fiel…

…d-utils Fix fields utils, Issue #2530
GEOS-ESM · Jan 19, 2024 · 7baf233 · 7baf233
2 parents b042b6e + 956a233
commit 7baf233
Show file tree

Hide file tree

Showing 4 changed files with 89 additions and 29 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -32,6 +32,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Removed use of `ESMF_HAS_ACHAR_BUG` CMake option and code use in `MAPL_Config.F90`. Testing has shown that with ESMF 8.6 (which is
   now required), NAG no longer needs this workaround.
 - Refactor the CircleCI workflows for more flexibility
+- Fix field utils issue - add npes argument to test subroutine decorators.
 
 ### Fixed
 

diff --git a/field_utils/tests/Test_FieldArithmetic.pf b/field_utils/tests/Test_FieldArithmetic.pf
@@ -13,8 +13,13 @@ module Test_FieldArithmetic
 
    implicit none
 
+   real(kind=ESMF_KIND_R4), parameter :: ADD_R4 = 100.0
+   real(kind=ESMF_KIND_R8), parameter :: ADD_R8 = 100.0
+
 contains
 
+   ! Making the fields should be done in the tests themselves so because
+   ! of the npes argument.
    @Before
    subroutine set_up_data()
       implicit none
@@ -45,16 +50,18 @@ contains
 
    end subroutine set_up_data
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    subroutine test_FieldAddR4()
       type(ESMF_Field) :: x
       type(ESMF_Field) :: y
       real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:), y_ptr(:,:)
       real(kind=ESMF_KIND_R4), allocatable :: result_array(:,:)
       integer :: status, rc
+      real(kind=ESMF_KIND_R4), allocatable :: y4array(:,:)
 
-      x = XR4
-      y = YR4
+      allocate(y4array, source=R4_ARRAY_DEFAULT)
+      x = mk_r4field(R4_ARRAY_DEFAULT, 'XR4', _RC)
+      y = mk_r4field(y4array, 'YR4', _RC)
       call ESMF_FieldGet(x , farrayPtr = x_ptr, _RC)
       call ESMF_FieldGet(y , farrayPtr = y_ptr, _RC)
 
@@ -64,9 +71,13 @@ contains
       result_array = 5.0
       call FieldAdd(y, x, y, _RC)
       @assertEqual(y_ptr, result_array)
+
    end subroutine test_FieldAddR4
 
-   @Test
+   ! 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
       type(ESMF_Field) :: x
       type(ESMF_Field) :: y
@@ -87,16 +98,18 @@ contains
       @assertEqual(y_ptr, result_array)
    end subroutine test_FieldAddR4_missing
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    subroutine test_FieldAddR8()
       type(ESMF_Field) :: x
       type(ESMF_Field) :: y
       real(kind=ESMF_KIND_R8), pointer :: x_ptr(:,:), y_ptr(:,:)
       real(kind=ESMF_KIND_R8), allocatable :: result_array(:,:)
       integer :: status, rc
+      real(kind=ESMF_KIND_R8), allocatable :: y8array(:,:)
 
-      x = XR8
-      y = YR8
+      allocate(y8array, source=R8_ARRAY_DEFAULT)
+      x = mk_r8field(R8_ARRAY_DEFAULT, 'XR8', _RC)
+      y = mk_r8field(y8array, 'YR8', _RC)
       call ESMF_FieldGet(x , farrayPtr = x_ptr, _RC)
       call ESMF_FieldGet(y , farrayPtr = y_ptr, _RC)
 
@@ -108,7 +121,7 @@ contains
       @assertEqual(y_ptr, result_array)
    end subroutine test_FieldAddR8
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    subroutine test_FieldPowR4()
       type(ESMF_Field) :: x
       real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:)
@@ -127,7 +140,7 @@ contains
       @assertEqual(x_ptr, result_array)
    end subroutine test_FieldPowR4
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    subroutine test_FieldPowR8()
       type(ESMF_Field) :: x
       real(kind=ESMF_KIND_R8), pointer :: x_ptr(:,:)
@@ -146,7 +159,7 @@ contains
       @assertEqual(x_ptr, result_array)
    end subroutine test_FieldPowR8
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    subroutine test_FieldSinR4()
       type(ESMF_Field) :: x
       real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:)
@@ -163,7 +176,7 @@ contains
       @assertEqual(x_ptr, result_array)
    end subroutine test_FieldSinR4
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    subroutine test_FieldNegR4()
       type(ESMF_Field) :: x
       real(kind=ESMF_KIND_R4), pointer :: x_ptr(:,:)

diff --git a/field_utils/tests/Test_FieldBLAS.pf b/field_utils/tests/Test_FieldBLAS.pf
@@ -43,7 +43,7 @@ contains
 
    end subroutine set_up_data
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    ! Basic test of FieldCOPY subroutine (REAL32)
    subroutine test_FieldCOPY_R4()
       type(ESMF_Field) :: x
@@ -61,7 +61,7 @@ contains
 
    end subroutine test_FieldCOPY_R4
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    ! Basic test of FieldCOPY subroutine (REAL64)
    subroutine test_FieldCOPY_R8()
       type(ESMF_Field) :: x
@@ -79,7 +79,7 @@ contains
 
    end subroutine test_FieldCOPY_R8
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    ! Basic test of FieldCOPY subroutine (REAL32 -> REAL64)
    subroutine test_FieldCOPY_R4R8()
       type(ESMF_Field) :: x
@@ -97,7 +97,7 @@ contains
 
    end subroutine test_FieldCOPY_R4R8
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    ! Basic test of FieldCOPY subroutine (REAL64 -> REAL32)
    subroutine test_FieldCOPY_R8R4()
       type(ESMF_Field) :: x
@@ -117,7 +117,7 @@ contains
 
    end subroutine test_FieldCOPY_R8R4
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    ! Basic test of FieldSCAL subroutine (REAL32)
    subroutine test_FieldSCAL_R4()
       real(kind=ESMF_KIND_R4), parameter :: a = 2.0
@@ -135,7 +135,7 @@ contains
 
    end subroutine test_FieldSCAL_R4
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    ! Basic test of FieldSCAL subroutine (REAL64)
    subroutine test_FieldSCAL_R8()
       real(kind=ESMF_KIND_R8), parameter :: a = 2.0
@@ -153,7 +153,7 @@ contains
 
    end subroutine test_FieldSCAL_R8
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    !
    subroutine test_FieldAXPY_R4()
       real(kind=ESMF_KIND_R4), parameter :: a = 2.0
@@ -178,7 +178,7 @@ contains
 
    end subroutine test_FieldAXPY_R4
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    !
    subroutine test_FieldAXPY_R8()
       real(kind=ESMF_KIND_R8), parameter :: a = 2.0
@@ -203,7 +203,7 @@ contains
 
    end subroutine test_FieldAXPY_R8
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    subroutine test_FieldGetLocalElementCount()
       type(ESMF_Field) :: x
       integer :: rank
@@ -221,7 +221,7 @@ contains
 
    end subroutine test_FieldGetLocalElementCount
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
     !
    subroutine test_FieldGetLocalSize()
       type(ESMF_Field) :: x
@@ -242,7 +242,7 @@ contains
 
    end subroutine test_FieldGetLocalSize
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    ! 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
@@ -260,7 +260,7 @@ contains
 
    end subroutine test_FieldGetCptr
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    !wdb fixme  Probably should test for non-conformable fields
    subroutine test_FieldsAreConformableR4()
       type(ESMF_Field) :: x, y
@@ -276,7 +276,7 @@ contains
    end subroutine test_FieldsAreConformableR4
 
    !wdb fixme  Probably should test for non-conformable fields
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    subroutine test_FieldsAreConformableR8()
       type(ESMF_Field) :: x, y
       integer :: status, rc
@@ -290,7 +290,7 @@ contains
 
    end subroutine test_FieldsAreConformableR8
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    !
    subroutine test_FieldsAreSameTypeKind()
       type(ESMF_Field) :: x, y
@@ -318,7 +318,7 @@ contains
    end subroutine test_FieldsAreSameTypeKind
 
 !wdb fixme Enable assertEqual
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    subroutine test_FieldConvertPrec_R4R8()
       integer, parameter :: NROWS = 4
       integer, parameter :: NCOLS = NROWS
@@ -344,7 +344,7 @@ contains
 
    end subroutine test_FieldConvertPrec_R4R8
 
-   @Test
+   @Test(npes=product(REG_DECOMP_DEFAULT))
    subroutine test_FieldClone3D()
       type(ESMF_Field) :: x, y
       integer :: status, rc
@@ -406,7 +406,7 @@ contains
    end subroutine test_almost_equal_array
 
 end module Test_FieldBLAS
-!   @Test
+!   @Test(npes=product(REG_DECOMP_DEFAULT))
 !   !
 !   subroutine test_FieldGEMV_R4()
 !      real(kind=ESMF_KIND_R4), parameter :: alpha = 3.0
@@ -446,7 +446,7 @@ end module Test_FieldBLAS
 !
 !   end subroutine test_FieldGEMV_R4
 
-!   @Test
+!   @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
@@ -183,4 +183,50 @@ subroutine initialize_array_R8(x, xmin, xrange)
 
    end subroutine initialize_array_R8
 
+   function mk_r4field(r4array, field_name, rc) result(r4field)
+      type(ESMF_Field) :: r4field
+      real(kind=ESMF_KIND_R4), intent(in) :: r4array(:,:)
+      character(len=*), intent(in) :: field_name
+      integer, optional, intent(out) :: rc
+
+      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)
+
+      _RETURN(_SUCCESS)
+
+   end function mk_r4field
+
+   function mk_r8field(r8array, field_name, rc) result(r8field)
+      type(ESMF_Field) :: r8field
+      real(kind=ESMF_KIND_R8), intent(in) :: r8array(:,:)
+      character(len=*), intent(in) :: field_name
+      integer, optional, intent(out) :: rc
+
+      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)
+
+      _RETURN(_SUCCESS)
+
+   end function mk_r8field
+
+   function mk_r4ungrid_field(field_name, lbound, ubound, rc) result(r4field)
+      type(ESMF_Field) :: r4field
+      character(len=*), intent(in) :: field_name
+      integer, intent(in) :: lbound
+      integer, intent(in) :: ubound
+      integer, optional, intent(out) :: rc
+
+      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)
+
+      _RETURN(_SUCCESS)
+
+   end function mk_r4ungrid_field
+
 end module field_utils_setup