From 4c5f5d254ded7e0e82ed882347e540202367db91 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 12 Sep 2024 11:33:16 -0400 Subject: [PATCH 01/27] Data structure for dimension data with tests --- field_utils/FieldCondensedArrayDims.F90 | 135 ++++++++++++++++++ field_utils/tests/Test_FieldCondensedArray.pf | 111 ++++++++++++++ 2 files changed, 246 insertions(+) create mode 100644 field_utils/FieldCondensedArrayDims.F90 create mode 100644 field_utils/tests/Test_FieldCondensedArray.pf diff --git a/field_utils/FieldCondensedArrayDims.F90 b/field_utils/FieldCondensedArrayDims.F90 new file mode 100644 index 000000000000..8cb0195bae86 --- /dev/null +++ b/field_utils/FieldCondensedArrayDims.F90 @@ -0,0 +1,135 @@ +module mapl3g_FieldCondensedArrayDims + + implicit none + private + public :: FieldCondensedArrayDims + + type :: FieldCondensedArrayDims + private + integer :: horz_(2) + integer :: vert_ + integer, allocatable :: ungridded_(:) + integer :: dims_(3) + contains + procedure :: horizontal + procedure :: vertical + procedure :: ungridded + procedure :: dims + procedure :: arguments + end type FieldCondensedArrayDims + + interface FieldCondensedArrayDims + module procedure :: construct + module procedure :: construct_dimcount0 + module procedure :: construct_vert + module procedure :: construct_1h + end interface FieldCondensedArrayDims + +contains + + function construct_dimcount0(w) result(cadims) + type(FieldCondensedArrayDims) :: cadims + integer, intent(in) :: w(:) + + cadims = FieldCondensedArrayDims(0, 0, 0, w) + + end function construct_dimcount0 + + function construct_vert(k, w) result(cadims) + type(FieldCondensedArrayDims) :: cadims + integer, intent(in) :: k + integer, optional, intent(in) w(:) + + cadims = FieldCondensedArrayDims(0, 0, k, w) + + end function construct_vert + + function construct_1h(u, z, nox, w) + type(FieldCondensedArrayDims) :: cadims + integer, intent(in) :: u, z + logical, intent(in) :: nox + integer, optional, intent(in) :: w(:) + integer :: x, y + + x = 1 + y = 0 + if(nox) then + x = 0 + y = 1 + end if + + cadims = FieldCondensedArrayDims(x, y, z, w) + + end function construct_1h + + function construct(x, y, z, w) result(cadims) + type(FieldCondensedArrayDims) :: cadims + integer, intent(in) :: x, y + integer, optional, intent(in) :: z + integer, optional, intent(in) :: w(:) + integer, allocatable :: w_(:) + integer :: i, j, k, n + + w_ = [integer :: ] + if(present(w)) w_ = w + k = 0 + if(present(z)) k = z + cadims%horz_ = [x, y] + cadims%vert_ = k + cadims%ungridded_ = w_ + + i = max(x, 1) + j = max(y, 1) + k = max(k, 1) + n = 1 + if(size(w_) > 0) n = product(max(w, 1)) + + cadims%dims_ = [i*j, k, n] + + end function construct + + function horizontal(this) result(val) + integer :: val + class(FieldCondensedArrayDims), intent(in) :: this + + val = this%dims_[1] + + end function horizontal + + function vertical(this) result(val) + integer :: val + class(FieldCondensedArrayDims), intent(in) :: this + + val = this%dims_[2] + + end function vertical + + function ungridded(this) result(val) + integer :: val + class(FieldCondensedArrayDims), intent(in) :: this + + val = this%dims_[3] + + end function ungridded + + function dims(this) result(val) + integer :: val(3) + class(FieldCondensedArrayDims), intent(in) :: this + + val = this%dims_ + + end function dims + + function arguments(this) result(val) + integer, allocatable :: val(:) + class(FieldCondensedArrayDims), intent(in) :: this + integer :: size_ungridded + + size_ungridded = size(this%ungridded_) + allocate(val(3+size_ungridded)) + val(1:3) = [this%horz_(1), this%horz_(2), this%vert] + if(size_ungridded > 0) val(4:size(val)) = this%ungridded_ + + end function arguments + +end module mapl3g_FieldCondensedArrayDims diff --git a/field_utils/tests/Test_FieldCondensedArray.pf b/field_utils/tests/Test_FieldCondensedArray.pf new file mode 100644 index 000000000000..219bdf9592d6 --- /dev/null +++ b/field_utils/tests/Test_FieldCondensedArray.pf @@ -0,0 +1,111 @@ +#include "MAPL_Generic.h" +#define CONSTRUCT_ f = FieldCondensedArrayDims +#define TEST_ARGS_(E, M) @assertEqual(E, f%arguments(), 'f%arguments() does not match ' // M // '.') +#define EXPECT_(A) [X, Y, Z, A] +#define EXPECT3_ EXPECT_([integer::]) +#define EXPECT2A_(A) [X, Y, A] +#define EXPECT2_ [X, Y] +module Test_FieldCondensedArray + + use mapl3g_FieldCondensedArrayDims + use pfunit + + implicit none + + integer, parameter :: X = 1 + integer, parameter :: Y = X+1 + integer, parameter :: Z = Y+1 + integer, parameter :: W(2) = [Z+1, Z+2] + integer, parameter :: W1(1) = [W(1)] + type(FieldCondensedArrayDims) :: f + +contains + + @Test + subroutine test_construct() + + CONSTRUCT_(X, Y, Z, W) + TEST_ARGS_(EXPECT_(W), 'expected(5)') + + CONSTRUCT_(X, Y, Z, W1) + TEST_ARGS_(EXPECT(W1), 'expected(4)') + + end subroutine test_construct + + @Test + subroutine test_construct_noungridded() + + CONSTRUCT_(X, Y, Z) + TEST_ARGS_(EXPECT3_, 'expected(3)') + + end subroutine test_construct_noungridded + + @Test + subroutine test_construct_noz() + + CONSTRUCT_(X, Y, W) + TEST_ARGS_(EXPECT2A_, 'expected') + + end subroutine test_construct_noz + + @Test + subroutine test_construct_noz_noungridded() + + CONSTRUCT_(X, Y, W) + TEST_ARGS_(EXPECT2_, 'expected') + + end subroutine test_construct_noz_noungridded + + @Test + subroutine test_construct_1hx() + end subroutine test_construct_1hx + + @Test + subroutine test_construct_1hy() + end subroutine test_construct_1hy + + @Test + subroutine test_construct_1hx_noungridded() + end subroutine test_construct_1hx_noungridded + + @Test + subroutine test_construct_1hy_noungridded() + end subroutine test_construct_1hy_noungridded + + @Test + subroutine test_construct_dimcount0() + end subroutine test_construct_dimcount0 + + @Test + subroutine test_construct_vert() + end subroutine test_construct_vert + + @Test + subroutine test_construct_vert_noungridded() + end subroutine test_construct_vert_noungridded + + @Test + subroutine test_horizontal() + end subroutine test_horizontal + + @Test + subroutine test_vertical() + end subroutine test_vertical + + @Test + subroutine test_ungridded() + end subroutine test_ungridded + + @Test + subroutine test_dims() + end subroutine test_dims + + @Before + subroutine setup() + end subroutine set_up_data + + @after + subroutine teardown() + end subroutine teardown + +end module Test_FieldCondensedArray From ada9b216286ff92de27e5dd45554f061c8077995 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 12 Sep 2024 17:28:42 -0400 Subject: [PATCH 02/27] Add tests --- field_utils/CMakeLists.txt | 1 + field_utils/FieldCondensedArrayDims.F90 | 17 +++++++++++++++++ field_utils/tests/CMakeLists.txt | 1 + field_utils/tests/Test_FieldCondensedArray.pf | 6 ++++-- 4 files changed, 23 insertions(+), 2 deletions(-) diff --git a/field_utils/CMakeLists.txt b/field_utils/CMakeLists.txt index 7fec50a25cf0..adfd98034733 100644 --- a/field_utils/CMakeLists.txt +++ b/field_utils/CMakeLists.txt @@ -8,6 +8,7 @@ set(srcs FieldUnaryFunctions.F90 FieldBinaryOperations.F90 FieldUnits.F90 + FieldCondensedArrayDims.F90 ) # To use extended udunits2 procedures, udunits2.c must be built and linked. diff --git a/field_utils/FieldCondensedArrayDims.F90 b/field_utils/FieldCondensedArrayDims.F90 index 8cb0195bae86..199da76317e8 100644 --- a/field_utils/FieldCondensedArrayDims.F90 +++ b/field_utils/FieldCondensedArrayDims.F90 @@ -131,5 +131,22 @@ function arguments(this) result(val) if(size_ungridded > 0) val(4:size(val)) = this%ungridded_ end function arguments + + subroutine initialize(this) + class(FieldCondensedArrayDims) :: this + + this%horz_(2) = -1 + this%vert_ = -1 + this%dims_ = -1 + if(allocated(this%ungridded_)) deallocate(this%ungridded_) + + end subroutine initialize + + subroutine reset(this) + class(FieldCondensedArrayDims) :: this + + call this%initialize() + + end subroutine reset end module mapl3g_FieldCondensedArrayDims diff --git a/field_utils/tests/CMakeLists.txt b/field_utils/tests/CMakeLists.txt index 8ff68dd04668..26784120a4c0 100644 --- a/field_utils/tests/CMakeLists.txt +++ b/field_utils/tests/CMakeLists.txt @@ -4,6 +4,7 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.field_utils.tests") set (test_srcs Test_FieldBLAS.pf Test_FieldArithmetic.pf + Test_FieldCondensedArrayDims.pf ) diff --git a/field_utils/tests/Test_FieldCondensedArray.pf b/field_utils/tests/Test_FieldCondensedArray.pf index 219bdf9592d6..d73cbca21cf6 100644 --- a/field_utils/tests/Test_FieldCondensedArray.pf +++ b/field_utils/tests/Test_FieldCondensedArray.pf @@ -1,10 +1,10 @@ -#include "MAPL_Generic.h" #define CONSTRUCT_ f = FieldCondensedArrayDims #define TEST_ARGS_(E, M) @assertEqual(E, f%arguments(), 'f%arguments() does not match ' // M // '.') #define EXPECT_(A) [X, Y, Z, A] #define EXPECT3_ EXPECT_([integer::]) #define EXPECT2A_(A) [X, Y, A] #define EXPECT2_ [X, Y] + module Test_FieldCondensedArray use mapl3g_FieldCondensedArrayDims @@ -102,10 +102,12 @@ contains @Before subroutine setup() + call f%initialize() end subroutine set_up_data - @after + @After subroutine teardown() + call f%reset() end subroutine teardown end module Test_FieldCondensedArray From cdd4dd8ff7691991bc9ee277a9343303e1567dc0 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Fri, 13 Sep 2024 17:09:06 -0400 Subject: [PATCH 03/27] Testing --- field_utils/FieldCondensedArrayDims.F90 | 92 ++++--------- field_utils/tests/Test_FieldCondensedArray.pf | 113 ---------------- .../tests/Test_FieldCondensedArrayDims.pf | 121 ++++++++++++++++++ 3 files changed, 148 insertions(+), 178 deletions(-) delete mode 100644 field_utils/tests/Test_FieldCondensedArray.pf create mode 100644 field_utils/tests/Test_FieldCondensedArrayDims.pf diff --git a/field_utils/FieldCondensedArrayDims.F90 b/field_utils/FieldCondensedArrayDims.F90 index 199da76317e8..a70606f05723 100644 --- a/field_utils/FieldCondensedArrayDims.F90 +++ b/field_utils/FieldCondensedArrayDims.F90 @@ -5,24 +5,24 @@ module mapl3g_FieldCondensedArrayDims public :: FieldCondensedArrayDims type :: FieldCondensedArrayDims - private integer :: horz_(2) integer :: vert_ integer, allocatable :: ungridded_(:) integer :: dims_(3) + integer :: horizontal + integer :: vertical + integer :: ungridded contains - procedure :: horizontal - procedure :: vertical - procedure :: ungridded - procedure :: dims procedure :: arguments + procedure :: initialize + procedure :: reset end type FieldCondensedArrayDims interface FieldCondensedArrayDims module procedure :: construct module procedure :: construct_dimcount0 module procedure :: construct_vert - module procedure :: construct_1h + module procedure :: construct_surface end interface FieldCondensedArrayDims contains @@ -38,88 +38,50 @@ end function construct_dimcount0 function construct_vert(k, w) result(cadims) type(FieldCondensedArrayDims) :: cadims integer, intent(in) :: k - integer, optional, intent(in) w(:) + integer, optional, intent(in) :: w(:) cadims = FieldCondensedArrayDims(0, 0, k, w) end function construct_vert - function construct_1h(u, z, nox, w) + function construct_surface(x, y, w) result(cadims) type(FieldCondensedArrayDims) :: cadims - integer, intent(in) :: u, z - logical, intent(in) :: nox + integer, intent(in) :: x, y integer, optional, intent(in) :: w(:) - integer :: x, y - - x = 1 - y = 0 - if(nox) then - x = 0 - y = 1 - end if - cadims = FieldCondensedArrayDims(x, y, z, w) + cadims = FieldCondensedArrayDims(x, y, 0, w) - end function construct_1h + end function construct_surface function construct(x, y, z, w) result(cadims) type(FieldCondensedArrayDims) :: cadims integer, intent(in) :: x, y - integer, optional, intent(in) :: z + integer, intent(in) :: z integer, optional, intent(in) :: w(:) - integer, allocatable :: w_(:) + integer :: dims_(3) integer :: i, j, k, n - w_ = [integer :: ] - if(present(w)) w_ = w - k = 0 - if(present(z)) k = z cadims%horz_ = [x, y] - cadims%vert_ = k - cadims%ungridded_ = w_ - + cadims%vert_ = z + cadims%ungridded_ = [integer::] i = max(x, 1) j = max(y, 1) - k = max(k, 1) + k = max(z, 1) + n = 1 - if(size(w_) > 0) n = product(max(w, 1)) + if(present(w)) then + cadims%ungridded_ = w + n = product(max(w, 1)) + end if - cadims%dims_ = [i*j, k, n] + dims_ = [i*j, k, n] + cadims%dims_ = dims_ + cadims%horizontal = dims_(1) + cadims%horizontal = dims_(2) + cadims%ungridded = dims_(3) end function construct - function horizontal(this) result(val) - integer :: val - class(FieldCondensedArrayDims), intent(in) :: this - - val = this%dims_[1] - - end function horizontal - - function vertical(this) result(val) - integer :: val - class(FieldCondensedArrayDims), intent(in) :: this - - val = this%dims_[2] - - end function vertical - - function ungridded(this) result(val) - integer :: val - class(FieldCondensedArrayDims), intent(in) :: this - - val = this%dims_[3] - - end function ungridded - - function dims(this) result(val) - integer :: val(3) - class(FieldCondensedArrayDims), intent(in) :: this - - val = this%dims_ - - end function dims - function arguments(this) result(val) integer, allocatable :: val(:) class(FieldCondensedArrayDims), intent(in) :: this @@ -127,7 +89,7 @@ function arguments(this) result(val) size_ungridded = size(this%ungridded_) allocate(val(3+size_ungridded)) - val(1:3) = [this%horz_(1), this%horz_(2), this%vert] + val(1:3) = [this%horz_(1), this%horz_(2), this%vert_] if(size_ungridded > 0) val(4:size(val)) = this%ungridded_ end function arguments diff --git a/field_utils/tests/Test_FieldCondensedArray.pf b/field_utils/tests/Test_FieldCondensedArray.pf deleted file mode 100644 index d73cbca21cf6..000000000000 --- a/field_utils/tests/Test_FieldCondensedArray.pf +++ /dev/null @@ -1,113 +0,0 @@ -#define CONSTRUCT_ f = FieldCondensedArrayDims -#define TEST_ARGS_(E, M) @assertEqual(E, f%arguments(), 'f%arguments() does not match ' // M // '.') -#define EXPECT_(A) [X, Y, Z, A] -#define EXPECT3_ EXPECT_([integer::]) -#define EXPECT2A_(A) [X, Y, A] -#define EXPECT2_ [X, Y] - -module Test_FieldCondensedArray - - use mapl3g_FieldCondensedArrayDims - use pfunit - - implicit none - - integer, parameter :: X = 1 - integer, parameter :: Y = X+1 - integer, parameter :: Z = Y+1 - integer, parameter :: W(2) = [Z+1, Z+2] - integer, parameter :: W1(1) = [W(1)] - type(FieldCondensedArrayDims) :: f - -contains - - @Test - subroutine test_construct() - - CONSTRUCT_(X, Y, Z, W) - TEST_ARGS_(EXPECT_(W), 'expected(5)') - - CONSTRUCT_(X, Y, Z, W1) - TEST_ARGS_(EXPECT(W1), 'expected(4)') - - end subroutine test_construct - - @Test - subroutine test_construct_noungridded() - - CONSTRUCT_(X, Y, Z) - TEST_ARGS_(EXPECT3_, 'expected(3)') - - end subroutine test_construct_noungridded - - @Test - subroutine test_construct_noz() - - CONSTRUCT_(X, Y, W) - TEST_ARGS_(EXPECT2A_, 'expected') - - end subroutine test_construct_noz - - @Test - subroutine test_construct_noz_noungridded() - - CONSTRUCT_(X, Y, W) - TEST_ARGS_(EXPECT2_, 'expected') - - end subroutine test_construct_noz_noungridded - - @Test - subroutine test_construct_1hx() - end subroutine test_construct_1hx - - @Test - subroutine test_construct_1hy() - end subroutine test_construct_1hy - - @Test - subroutine test_construct_1hx_noungridded() - end subroutine test_construct_1hx_noungridded - - @Test - subroutine test_construct_1hy_noungridded() - end subroutine test_construct_1hy_noungridded - - @Test - subroutine test_construct_dimcount0() - end subroutine test_construct_dimcount0 - - @Test - subroutine test_construct_vert() - end subroutine test_construct_vert - - @Test - subroutine test_construct_vert_noungridded() - end subroutine test_construct_vert_noungridded - - @Test - subroutine test_horizontal() - end subroutine test_horizontal - - @Test - subroutine test_vertical() - end subroutine test_vertical - - @Test - subroutine test_ungridded() - end subroutine test_ungridded - - @Test - subroutine test_dims() - end subroutine test_dims - - @Before - subroutine setup() - call f%initialize() - end subroutine set_up_data - - @After - subroutine teardown() - call f%reset() - end subroutine teardown - -end module Test_FieldCondensedArray diff --git a/field_utils/tests/Test_FieldCondensedArrayDims.pf b/field_utils/tests/Test_FieldCondensedArrayDims.pf new file mode 100644 index 000000000000..baf18c5cfc4c --- /dev/null +++ b/field_utils/tests/Test_FieldCondensedArrayDims.pf @@ -0,0 +1,121 @@ +!define f = constructor f = FieldCondensedArrayDims +#define TEST_ARGS_(E, M) @assertEqual(E, f%arguments(), 'f%arguments() does not match ' // M // '.') +#define EXPECT_(A) [X, Y, Z, A] +#define EXPECT3_ EXPECT_([integer::]) +#define EXPECT2A_(A) [X, Y, A] +#define EXPECT2_ [X, Y] + +module Test_FieldCondensedArrayDims + + use mapl3g_FieldCondensedArrayDims + use pfunit + + implicit none + + integer, parameter :: X = 1 + integer, parameter :: Y = X+1 + integer, parameter :: Z = Y+1 + integer, parameter :: W(2) = [Z+1, Z+2] + integer, parameter :: W1(1) = [W(1)] + type(FieldCondensedArrayDims) :: f + integer, allocatable :: expected_args(:) + character(len=*), parameter :: ERROR_CONSTRUCTOR = 'f%arguments() does not match ' + +contains + + @Test + subroutine test_construct() + + f = FieldCondensedArrayDims(X, Y, Z, W) + expected_args = [X, Y, Z, W] + @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected(5)') + + f = FieldCondensedArrayDims(X, Y, Z, W1) + expected_args = [X, Y, Z, W1] + @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected(4)') + + end subroutine test_construct + + @Test + subroutine test_construct_noungridded() + + f = FieldCondensedArrayDims(X, Y, Z) + expected_args = [X, Y, Z] + @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') + + end subroutine test_construct_noungridded + + @Test + subroutine test_construct_noz() + + f = FieldCondensedArrayDims(X, Y, W) + expected_args = [X, Y, 0, W] + @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') + + end subroutine test_construct_noz + + @Test + subroutine test_construct_noz_noungridded() + + f = FieldCondensedArrayDims(X, Y) + expected_args = [X, Y, 0] + @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') + + end subroutine test_construct_noz_noungridded + + @Test + subroutine test_construct_dimcount0() + + f = FieldCondensedArrayDims(W) + expected_args = W + @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') + + end subroutine test_construct_dimcount0 + + @Test + subroutine test_construct_vert() + + f = FieldCondensedArrayDims(Z, W) + expected_args = [Z, W] + @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') + + end subroutine test_construct_vert + + @Test + subroutine test_construct_vert_noungridded() + + f = FieldCondensedArrayDims(Z) + expected_args = [Z] + @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') + + end subroutine test_construct_vert_noungridded + + @Test + subroutine test_horizontal() + end subroutine test_horizontal + + @Test + subroutine test_vertical() + end subroutine test_vertical + + @Test + subroutine test_ungridded() + end subroutine test_ungridded + + @Test + subroutine test_dims() + end subroutine test_dims + + @Before + subroutine setup() + if(allocated(expected_args)) deallocate(expected_args) + call f%initialize() + end subroutine setup + + @After + subroutine teardown() + if(allocated(expected_args)) deallocate(expected_args) + call f%reset() + end subroutine teardown + +end module Test_FieldCondensedArrayDims From a29f4b7e3d681e4270cd3e18a361f5dcf27c9293 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 16 Sep 2024 12:19:04 -0400 Subject: [PATCH 04/27] Add FieldCondensedArray --- field_utils/CMakeLists.txt | 1 + field_utils/FieldCondensedArray.F90 | 42 +++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+) create mode 100644 field_utils/FieldCondensedArray.F90 diff --git a/field_utils/CMakeLists.txt b/field_utils/CMakeLists.txt index adfd98034733..212c30e85d2b 100644 --- a/field_utils/CMakeLists.txt +++ b/field_utils/CMakeLists.txt @@ -9,6 +9,7 @@ set(srcs FieldBinaryOperations.F90 FieldUnits.F90 FieldCondensedArrayDims.F90 + FieldCondensedArray.F90 ) # To use extended udunits2 procedures, udunits2.c must be built and linked. diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 new file mode 100644 index 000000000000..76f7a459d82c --- /dev/null +++ b/field_utils/FieldCondensedArray.F90 @@ -0,0 +1,42 @@ +module mapl3g_FieldCondensedArray + + implicit none + +! public :: ! public procedures, variables, types, etc. + private + + +contains + + function get_array_shape(field_in) + integer :: array_shape(3) + type(ESMF_Field), intent(in) :: field_in + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: grid_dims(:) + integer, allocatable :: vert_dims(:) + integer, allocatable :: all_dims(:) + integer, allocatable :: ungridded_dims(:) + integer :: horz_size, vert_size, ungridded_size + + call ESMF_FieldGet(field_in, gridToFieldMap=gridToFieldMap, _RC) + grid_dims = pack(gridToFieldMap, gridToFieldMap /= 0) + _ASSERT(all(grid_dims <= size(grid_dims)), 'MAPL expects geom dims before ungridded') + + vert_dims = [integer:: ] ! empty + if (<>) then + vert_dims = [<>] + end if + + all_dims = [(i,i=1,rank)] + ungridded_dims = pack(all_dims, [(all([vert_dims,grid_dims] /= i),i=1,rank)]) + + horz_size = product([localElementCount(grid_dims(i)), i=1, size(grid_dims) ] ) + vert_size = product([localElementCount(vert_dims(i)), i=1, size(vert_dims)]) + ungridded_size = product([localElementCount(vert_dims(i)), i=1, size(ungridded_dims)]) + + array_shape = [horz_size, vert_size, ungridded_size] + + end function get_array_shape + +end module mapl3g_FieldCondensedArray + From c67f2a767137f2b26a7ca919e91ce6cc8c856cb8 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 16 Sep 2024 14:28:30 -0400 Subject: [PATCH 05/27] Split off _private --- field_utils/FieldCondensedArray.F90 | 27 +----- field_utils/FieldCondensedArray_private.F90 | 41 ++++++++ field_utils/tests/Test_FieldCondensedArray.pf | 96 +++++++++++++++++++ 3 files changed, 141 insertions(+), 23 deletions(-) create mode 100644 field_utils/FieldCondensedArray_private.F90 create mode 100644 field_utils/tests/Test_FieldCondensedArray.pf diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 index 76f7a459d82c..d8ec98356562 100644 --- a/field_utils/FieldCondensedArray.F90 +++ b/field_utils/FieldCondensedArray.F90 @@ -1,5 +1,6 @@ module mapl3g_FieldCondensedArray + use mapl3g_FieldCondensedArray_private implicit none ! public :: ! public procedures, variables, types, etc. @@ -8,35 +9,15 @@ module mapl3g_FieldCondensedArray contains - function get_array_shape(field_in) + function public_get_array_shape(field_in) integer :: array_shape(3) type(ESMF_Field), intent(in) :: field_in integer, allocatable :: gridToFieldMap(:) - integer, allocatable :: grid_dims(:) - integer, allocatable :: vert_dims(:) - integer, allocatable :: all_dims(:) - integer, allocatable :: ungridded_dims(:) - integer :: horz_size, vert_size, ungridded_size call ESMF_FieldGet(field_in, gridToFieldMap=gridToFieldMap, _RC) - grid_dims = pack(gridToFieldMap, gridToFieldMap /= 0) - _ASSERT(all(grid_dims <= size(grid_dims)), 'MAPL expects geom dims before ungridded') + array_shape = get_array_shape(gridToFieldMap) - vert_dims = [integer:: ] ! empty - if (<>) then - vert_dims = [<>] - end if - - all_dims = [(i,i=1,rank)] - ungridded_dims = pack(all_dims, [(all([vert_dims,grid_dims] /= i),i=1,rank)]) - - horz_size = product([localElementCount(grid_dims(i)), i=1, size(grid_dims) ] ) - vert_size = product([localElementCount(vert_dims(i)), i=1, size(vert_dims)]) - ungridded_size = product([localElementCount(vert_dims(i)), i=1, size(ungridded_dims)]) - - array_shape = [horz_size, vert_size, ungridded_size] - - end function get_array_shape + end function public_get_array_shape end module mapl3g_FieldCondensedArray diff --git a/field_utils/FieldCondensedArray_private.F90 b/field_utils/FieldCondensedArray_private.F90 new file mode 100644 index 000000000000..849b6f259932 --- /dev/null +++ b/field_utils/FieldCondensedArray_private.F90 @@ -0,0 +1,41 @@ +module mapl3g_FieldCondensedArray_private + + use esmf + implicit none + +! public :: ! public procedures, variables, types, etc. + private + public :: get_array_shape + +contains + + function get_array_shape(gridToFieldMap, vert_dims) + integer :: array_shape(3) + integer, intent(in) :: gridToFieldMap(:) + integer, optional, intent(in) :: vert_dims(:) + integer, allocatable :: grid_dims(:) + integer, allocatable :: vert_dims_(:) + integer, allocatable :: all_dims(:) + integer, allocatable :: ungridded_dims(:) + integer :: horz_size, vert_size, ungridded_size + + grid_dims = pack(gridToFieldMap, gridToFieldMap /= 0) + _ASSERT(all(grid_dims <= size(grid_dims)), 'MAPL expects geom dims before ungridded') + + vert_dims_ = [integer:: ] ! empty + if (present(vert_dims)) + if(size(vert_dims) > 0) vert_dims_ = vert_dims + end if + + all_dims = [(i,i=1,rank)] + ungridded_dims = pack(all_dims, [(all([vert_dims,grid_dims] /= i),i=1,rank)]) + + horz_size = product([localElementCount(grid_dims(i)), i=1, size(grid_dims) ] ) + vert_size = product([localElementCount(vert_dims(i)), i=1, size(vert_dims)]) + ungridded_size = product([localElementCount(vert_dims(i)), i=1, size(ungridded_dims)]) + + array_shape = [horz_size, vert_size, ungridded_size] + + end function get_array_shape + +end module mapl3g_FieldCondensedArray diff --git a/field_utils/tests/Test_FieldCondensedArray.pf b/field_utils/tests/Test_FieldCondensedArray.pf new file mode 100644 index 000000000000..f4129f9567d4 --- /dev/null +++ b/field_utils/tests/Test_FieldCondensedArray.pf @@ -0,0 +1,96 @@ +#if defined(TRIMALL) +# undef TRIMALL +#end if +#define TRIMALL(A) trim(adjustl(A)) + +module Test_FieldCondensedArray + + use pfunit + use FieldCondensedArray + implicit none + +contains + + @Test + subroutine test_get_array_shape_3D() + integer, allocatable :: gridToFieldMap(:) + integer :: expected(3), actual(3) + integer, allocatable :: vertical_dims(:) + character(len=:), allocatable :: error_message + + gridToFieldMap = [1, 2] + vertical_dims = [3] + expected = [product(gridToFieldMap), product(vertical_dims), 1] + actual = get_array_shape(gridToFieldMap, vertical_dims) + error_message = make_error_message('Actual ', actual, ' does not match expected ', expected, '.') + @assertEqual(actual, expected, error_message) + + end subroutine test_get_array_shape_3D + + @Test + subroutine test_get_array_shape() + integer, allocatable :: gridToFieldMap(:) + integer :: expected(3), actual(3) + integer, allocatable :: vertical_dims(:) + + gridToFieldMap = [1, 2] + vertical_dims = [3] + expected = [product(gridToFieldMap), 1, 1] + actual = get_array_shape(gridToFieldMap) + error_message = make_error_message('Actual ', actual, ' does not match expected ', expected, '.') + @assertEqual(actual, expected, error_message) + + end subroutine test_get_array_shape + + @Before + subroutine set_up() + end subroutine set_up + + @After + subroutine take_down() + end subroutine take_down() + + function make_error_message(prelude, actual, interlude, expected, postlude) result(string) + character(len=*) :: string + character(len=*), intent(in) :: prelude, interlude, postlude + integer, intent(in) :: actual(:), expected(:) + character(len=:), allocatable :: raw + + raw = make_array_string(actual) + if(size(raw) == 0) raw = 'NO ACTUAL' + string = trim(raw) // interlude + raw = make_array_string(expected) + if(size(raw) == 0) raw = 'NO EXPECTED' + string = trim(prelude) // string // trim(raw) // trim(postlude) + + end function make_error_message + + function make_array_string(arr) + character(len=:), allocatable :: string + integer, intent(in) :: arr(:) + character, parameter :: HFMT = '(I0)' + character, parameter :: TFMT = '(1X, I0)' + character(len=:), allocatable :: raw + integer :: i, iostat + + if(size(arr) == 0) then + string = '[]' + return + end if + string = '' + write(raw, fmt=HFMT, iostat=iostat, advance = 'NO') arr(1) + if(iostat /= 0) return + string = '[ ' // TRIMALL(raw) + do i=2, size(arr) + write(raw, fmt=TMFT, iostat=iostat, advance='NO') arr(i) + if(iostat /= 0) then + string = '' + end if + string = string // TRIMALL(raw) + end do + string = string // ']' + + end function make_array + +end module Test_FieldCondensedArray + From 0ccef2aa60168c632b49fbc89e7b87e0a66dc5a3 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 17 Sep 2024 09:16:35 -0400 Subject: [PATCH 06/27] Update tests --- field_utils/CMakeLists.txt | 3 +- field_utils/FieldCondensedArray.F90 | 23 +++- field_utils/FieldCondensedArray_private.F90 | 69 +++++++--- field_utils/tests/CMakeLists.txt | 1 + field_utils/tests/Test_FieldCondensedArray.pf | 126 ++++++++---------- 5 files changed, 132 insertions(+), 90 deletions(-) diff --git a/field_utils/CMakeLists.txt b/field_utils/CMakeLists.txt index 212c30e85d2b..69a0fe1085b9 100644 --- a/field_utils/CMakeLists.txt +++ b/field_utils/CMakeLists.txt @@ -8,8 +8,8 @@ set(srcs FieldUnaryFunctions.F90 FieldBinaryOperations.F90 FieldUnits.F90 - FieldCondensedArrayDims.F90 FieldCondensedArray.F90 + FieldCondensedArray_private.F90 ) # To use extended udunits2 procedures, udunits2.c must be built and linked. @@ -29,6 +29,7 @@ esma_add_library(${this} DEPENDENCIES MAPL.shared PFLOGGER::pflogger udunits2f TYPE SHARED ) + #DEPENDENCIES MAPL.shared MAPL.esmf_utils PFLOGGER::pflogger udunits2f #add_subdirectory(specs) #add_subdirectory(registry) diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 index d8ec98356562..6dec125a1a9a 100644 --- a/field_utils/FieldCondensedArray.F90 +++ b/field_utils/FieldCondensedArray.F90 @@ -1,6 +1,10 @@ +#include "MAPL_Generic.h" module mapl3g_FieldCondensedArray - use mapl3g_FieldCondensedArray_private + !use mapl3g_output_info, only: get_num_levels + use mapl3g_FieldCondensedArray_private, only: get_array_shape_private => get_array_shape + use MAPL_ExceptionHandling + use esmf, only: ESMF_Field, ESMF_FieldGet implicit none ! public :: ! public procedures, variables, types, etc. @@ -9,15 +13,24 @@ module mapl3g_FieldCondensedArray contains - function public_get_array_shape(field_in) + function get_array_shape(field_in, rc) result(array_shape) integer :: array_shape(3) type(ESMF_Field), intent(in) :: field_in + integer, optional, intent(out) :: rc + integer :: status integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) + integer, allocatable :: vertical_dimensions(:) + integer :: num_levels + num_levels = 0 + vertical_dimensions = [integer::] call ESMF_FieldGet(field_in, gridToFieldMap=gridToFieldMap, _RC) - array_shape = get_array_shape(gridToFieldMap) + call ESMF_FieldGet(field_in, localElementCount=localElementCount, _RC) +! num_levels = get_num_levels(field_in, _RC) + if(num_levels > 0) vertical_dimensions = [num_levels] + array_shape = get_array_shape_private(gridToFieldMap, localElementCount, vertical_dimensions, _RC) - end function public_get_array_shape + end function get_array_shape end module mapl3g_FieldCondensedArray - diff --git a/field_utils/FieldCondensedArray_private.F90 b/field_utils/FieldCondensedArray_private.F90 index 849b6f259932..40a63a3a8355 100644 --- a/field_utils/FieldCondensedArray_private.F90 +++ b/field_utils/FieldCondensedArray_private.F90 @@ -1,41 +1,76 @@ +#include "MAPL_Generic.h" module mapl3g_FieldCondensedArray_private - use esmf + use MAPL_ExceptionHandling implicit none -! public :: ! public procedures, variables, types, etc. private public :: get_array_shape contains - function get_array_shape(gridToFieldMap, vert_dims) + function get_array_shape(gridToFieldMap, localElementCount, vert_dims, rc) & + &result(array_shape) integer :: array_shape(3) integer, intent(in) :: gridToFieldMap(:) + integer, intent(in) :: localElementCount(:) integer, optional, intent(in) :: vert_dims(:) + integer, optional, intent(out) :: rc + integer :: status, rank, i integer, allocatable :: grid_dims(:) integer, allocatable :: vert_dims_(:) - integer, allocatable :: all_dims(:) integer, allocatable :: ungridded_dims(:) integer :: horz_size, vert_size, ungridded_size - + + rank = size(localElementCount) grid_dims = pack(gridToFieldMap, gridToFieldMap /= 0) _ASSERT(all(grid_dims <= size(grid_dims)), 'MAPL expects geom dims before ungridded') - - vert_dims_ = [integer:: ] ! empty - if (present(vert_dims)) + vert_dims_ = [integer::] + if (present(vert_dims)) then if(size(vert_dims) > 0) vert_dims_ = vert_dims end if - - all_dims = [(i,i=1,rank)] - ungridded_dims = pack(all_dims, [(all([vert_dims,grid_dims] /= i),i=1,rank)]) - - horz_size = product([localElementCount(grid_dims(i)), i=1, size(grid_dims) ] ) - vert_size = product([localElementCount(vert_dims(i)), i=1, size(vert_dims)]) - ungridded_size = product([localElementCount(vert_dims(i)), i=1, size(ungridded_dims)]) - + ungridded_dims = pack([(i,i=1,rank)], [(all([vert_dims_, grid_dims] /= i), i=1, rank)]) + horz_size = product([(localElementCount(grid_dims(i)), i=1, size(grid_dims))]) + vert_size = product([(localElementCount(vert_dims_(i)), i=1, size(vert_dims_))]) + ungridded_size = product([(localElementCount(ungridded_dims(i)), i=1, size(ungridded_dims))]) array_shape = [horz_size, vert_size, ungridded_size] + _RETURN(_SUCCESS) end function get_array_shape +! function get_array_shape(gridToFieldMap, localElementCount, rank, vert_dims, rc) & +! &result(array_shape) +! integer :: array_shape(3) +! integer, intent(in) :: gridToFieldMap(:) +! integer, intent(in) :: localElementCount(:) +! integer, intent(in) :: rank +! integer, optional, intent(in) :: vert_dims(:) +! integer, optional, intent(out) :: rc +! integer, allocatable :: grid_dims(:) +! integer, allocatable :: vert_dims_(:) +! integer, allocatable :: all_dims(:) +! integer, allocatable :: ungridded_dims(:) +! integer, allocatable :: temp_array(:) +! integer :: horz_size, vert_size, ungridded_size +! integer :: i, j +! integer :: status +! +! grid_dims = pack(gridToFieldMap, gridToFieldMap /= 0) +! _ASSERT(all(grid_dims <= total_size(grid_dims)), 'MAPL expects geom dims before ungridded') +! +! vert_dims_ = [integer:: ] ! empty +! if (present(vert_dims)) then +! if(total_size(vert_dims) > 0) vert_dims_ = vert_dims +! end if +! +! all_dims = [(i,i=1,rank)] +! ungridded_dims = pack(all_dims, [(all([vert_dims, grid_dims] /= i), i=1, rank)]) +! !ungridded_dims = pack(all_dims, [(not_in(i, [grid_dims, vert_dims])), i=1, rank]) +! horz_size = product(grid_dims) +! vert_size = product([localElementCount(vert_dims(i)), i=1, total_size(vert_dims)]) +! ungridded_size = product([localElementCount(vert_dims(i)), i=1, total_size(ungridded_dims)]) +! +! array_shape = [horz_size, vert_size, ungridded_size] +! +! end function get_array_shape -end module mapl3g_FieldCondensedArray +end module mapl3g_FieldCondensedArray_private diff --git a/field_utils/tests/CMakeLists.txt b/field_utils/tests/CMakeLists.txt index 26784120a4c0..57dea89bf063 100644 --- a/field_utils/tests/CMakeLists.txt +++ b/field_utils/tests/CMakeLists.txt @@ -5,6 +5,7 @@ set (test_srcs Test_FieldBLAS.pf Test_FieldArithmetic.pf Test_FieldCondensedArrayDims.pf + Test_FieldCondensedArray.pf ) diff --git a/field_utils/tests/Test_FieldCondensedArray.pf b/field_utils/tests/Test_FieldCondensedArray.pf index f4129f9567d4..c5712b26756e 100644 --- a/field_utils/tests/Test_FieldCondensedArray.pf +++ b/field_utils/tests/Test_FieldCondensedArray.pf @@ -1,96 +1,88 @@ #if defined(TRIMALL) # undef TRIMALL -#end if +#endif #define TRIMALL(A) trim(adjustl(A)) module Test_FieldCondensedArray use pfunit - use FieldCondensedArray + use mapl3g_FieldCondensedArray_private implicit none contains @Test subroutine test_get_array_shape_3D() - integer, allocatable :: gridToFieldMap(:) integer :: expected(3), actual(3) + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) integer, allocatable :: vertical_dims(:) - character(len=:), allocatable :: error_message gridToFieldMap = [1, 2] + localElementCount = [4, 5, 3] vertical_dims = [3] - expected = [product(gridToFieldMap), product(vertical_dims), 1] - actual = get_array_shape(gridToFieldMap, vertical_dims) - error_message = make_error_message('Actual ', actual, ' does not match expected ', expected, '.') - @assertEqual(actual, expected, error_message) + expected = [product(localElementCount(1:2)), localElementCount(3), 1] + actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) + @assertEqual(actual, expected, 'actual does not match expected.') end subroutine test_get_array_shape_3D @Test - subroutine test_get_array_shape() - integer, allocatable :: gridToFieldMap(:) + subroutine test_get_array_shape_2D() integer :: expected(3), actual(3) + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) integer, allocatable :: vertical_dims(:) gridToFieldMap = [1, 2] - vertical_dims = [3] - expected = [product(gridToFieldMap), 1, 1] - actual = get_array_shape(gridToFieldMap) - error_message = make_error_message('Actual ', actual, ' does not match expected ', expected, '.') - @assertEqual(actual, expected, error_message) - - end subroutine test_get_array_shape - - @Before - subroutine set_up() - end subroutine set_up - - @After - subroutine take_down() - end subroutine take_down() - - function make_error_message(prelude, actual, interlude, expected, postlude) result(string) - character(len=*) :: string - character(len=*), intent(in) :: prelude, interlude, postlude - integer, intent(in) :: actual(:), expected(:) - character(len=:), allocatable :: raw - - raw = make_array_string(actual) - if(size(raw) == 0) raw = 'NO ACTUAL' - string = trim(raw) // interlude - raw = make_array_string(expected) - if(size(raw) == 0) raw = 'NO EXPECTED' - string = trim(prelude) // string // trim(raw) // trim(postlude) - - end function make_error_message - - function make_array_string(arr) - character(len=:), allocatable :: string - integer, intent(in) :: arr(:) - character, parameter :: HFMT = '(I0)' - character, parameter :: TFMT = '(1X, I0)' - character(len=:), allocatable :: raw - integer :: i, iostat - - if(size(arr) == 0) then - string = '[]' - return - end if - string = '' - write(raw, fmt=HFMT, iostat=iostat, advance = 'NO') arr(1) - if(iostat /= 0) return - string = '[ ' // TRIMALL(raw) - do i=2, size(arr) - write(raw, fmt=TMFT, iostat=iostat, advance='NO') arr(i) - if(iostat /= 0) then - string = '' - end if - string = string // TRIMALL(raw) - end do - string = string // ']' - - end function make_array + localElementCount = [4, 5] + expected = [product(localElementCount), 1, 1] + actual = get_array_shape(gridToFieldMap, localElementCount) + @assertEqual(actual, expected, 'actual does not match expected.') + + end subroutine test_get_array_shape_2D + +! function make_error_message(prelude, actual, interlude, expected, postlude) result(string) +! character(len=:), allocatable :: string +! character(len=*), intent(in) :: prelude, interlude, postlude +! integer, intent(in) :: actual(:), expected(:) +! character(len=:), allocatable :: raw +! +! raw = make_array_string(actual) +! if(size(raw) == 0) raw = 'NO ACTUAL' +! string = trim(raw) // interlude +! raw = make_array_string(expected) +! if(size(raw) == 0) raw = 'NO EXPECTED' +! string = trim(prelude) // string // trim(raw) // trim(postlude) +! +! end function make_error_message +! +! function make_array_string(arr) result(string) +! character(len=:), allocatable :: string +! integer, intent(in) :: arr(:) +! character, parameter :: HFMT = '(I0)' +! character, parameter :: TFMT = '(1X, I0)' +! character(len=:), allocatable :: raw +! integer :: i, iostat +! +! if(size(arr) == 0) then +! string = '[]' +! return +! end if +! string = '' +! write(raw, fmt=HFMT, iostat=iostat, advance = 'NO') arr(1) +! if(iostat /= 0) return +! string = '[ ' // TRIMALL(raw) +! do i=2, size(arr) +! write(raw, fmt=TFMT, iostat=iostat, advance='NO') arr(i) +! if(iostat /= 0) then +! string = '' +! end if +! string = string // TRIMALL(raw) +! end do +! string = string // ']' +! +! end function make_array_string end module Test_FieldCondensedArray From f23f631dd16c377892fdb8d84e3033e06242dd9c Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 17 Sep 2024 09:18:19 -0400 Subject: [PATCH 07/27] rm Test_FieldCondensedArrayDims.pf, CMakeLists.txt --- field_utils/tests/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/field_utils/tests/CMakeLists.txt b/field_utils/tests/CMakeLists.txt index 57dea89bf063..fd2b5fe750c6 100644 --- a/field_utils/tests/CMakeLists.txt +++ b/field_utils/tests/CMakeLists.txt @@ -4,7 +4,6 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.field_utils.tests") set (test_srcs Test_FieldBLAS.pf Test_FieldArithmetic.pf - Test_FieldCondensedArrayDims.pf Test_FieldCondensedArray.pf ) From b59333b066551d3cd393ecd77b64679d29507551 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 17 Sep 2024 14:24:09 -0400 Subject: [PATCH 08/27] get_array_shape test pass; preliminary assign_fptr --- base/CMakeLists.txt | 2 +- esmf_utils/CMakeLists.txt | 3 +- field_utils/CMakeLists.txt | 4 +- field_utils/FieldCondensedArray.F90 | 4 +- field_utils/FieldCondensedArrayDims.F90 | 114 ----------------- field_utils/FieldCondensedArray_private.F90 | 35 ----- field_utils/FieldPointerUtilities.F90 | 71 ++++++---- field_utils/tests/Test_FieldCondensedArray.pf | 114 ++++++++++++++++- .../tests/Test_FieldCondensedArrayDims.pf | 121 ------------------ shared/CMakeLists.txt | 1 + shared/MAPL_ESMF_InfoKeys.F90 | 76 +++++++++++ 11 files changed, 242 insertions(+), 303 deletions(-) delete mode 100644 field_utils/FieldCondensedArrayDims.F90 delete mode 100644 field_utils/tests/Test_FieldCondensedArrayDims.pf create mode 100644 shared/MAPL_ESMF_InfoKeys.F90 diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index 4a8120b9ced3..a947db4d3ec8 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -56,7 +56,7 @@ set (srcs MAPL_XYGridFactory.F90 MAPL_NetCDF.F90 Plain_netCDF_Time.F90 MAPL_DateTime_Parsing_ESMF.F90 MAPL_ObsUtil.F90 - MAPL_ESMF_InfoKeys.F90 + #MAPL_ESMF_InfoKeys.F90 # Orphaned program: should not be in this library. # tstqsat.F90 ) diff --git a/esmf_utils/CMakeLists.txt b/esmf_utils/CMakeLists.txt index 362155ea897f..7f30cb8500fb 100644 --- a/esmf_utils/CMakeLists.txt +++ b/esmf_utils/CMakeLists.txt @@ -10,9 +10,10 @@ set(srcs esma_add_library(${this} SRCS ${srcs} - DEPENDENCIES MAPL.shared MAPL.base + DEPENDENCIES MAPL.shared TYPE SHARED ) + # DEPENDENCIES MAPL.shared MAPL.base target_include_directories (${this} PUBLIC $) diff --git a/field_utils/CMakeLists.txt b/field_utils/CMakeLists.txt index 69a0fe1085b9..fec2a17ccc3e 100644 --- a/field_utils/CMakeLists.txt +++ b/field_utils/CMakeLists.txt @@ -26,10 +26,10 @@ endif () esma_add_library(${this} SRCS ${srcs} - DEPENDENCIES MAPL.shared PFLOGGER::pflogger udunits2f + DEPENDENCIES MAPL.shared MAPL.esmf_utils PFLOGGER::pflogger udunits2f TYPE SHARED ) - #DEPENDENCIES MAPL.shared MAPL.esmf_utils PFLOGGER::pflogger udunits2f + #DEPENDENCIES MAPL.shared PFLOGGER::pflogger udunits2f #add_subdirectory(specs) #add_subdirectory(registry) diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 index 6dec125a1a9a..6e9492939530 100644 --- a/field_utils/FieldCondensedArray.F90 +++ b/field_utils/FieldCondensedArray.F90 @@ -1,7 +1,7 @@ #include "MAPL_Generic.h" module mapl3g_FieldCondensedArray - !use mapl3g_output_info, only: get_num_levels + use mapl3g_output_info, only: get_num_levels use mapl3g_FieldCondensedArray_private, only: get_array_shape_private => get_array_shape use MAPL_ExceptionHandling use esmf, only: ESMF_Field, ESMF_FieldGet @@ -27,7 +27,7 @@ function get_array_shape(field_in, rc) result(array_shape) vertical_dimensions = [integer::] call ESMF_FieldGet(field_in, gridToFieldMap=gridToFieldMap, _RC) call ESMF_FieldGet(field_in, localElementCount=localElementCount, _RC) -! num_levels = get_num_levels(field_in, _RC) + num_levels = get_num_levels(field_in, _RC) if(num_levels > 0) vertical_dimensions = [num_levels] array_shape = get_array_shape_private(gridToFieldMap, localElementCount, vertical_dimensions, _RC) diff --git a/field_utils/FieldCondensedArrayDims.F90 b/field_utils/FieldCondensedArrayDims.F90 deleted file mode 100644 index a70606f05723..000000000000 --- a/field_utils/FieldCondensedArrayDims.F90 +++ /dev/null @@ -1,114 +0,0 @@ -module mapl3g_FieldCondensedArrayDims - - implicit none - private - public :: FieldCondensedArrayDims - - type :: FieldCondensedArrayDims - integer :: horz_(2) - integer :: vert_ - integer, allocatable :: ungridded_(:) - integer :: dims_(3) - integer :: horizontal - integer :: vertical - integer :: ungridded - contains - procedure :: arguments - procedure :: initialize - procedure :: reset - end type FieldCondensedArrayDims - - interface FieldCondensedArrayDims - module procedure :: construct - module procedure :: construct_dimcount0 - module procedure :: construct_vert - module procedure :: construct_surface - end interface FieldCondensedArrayDims - -contains - - function construct_dimcount0(w) result(cadims) - type(FieldCondensedArrayDims) :: cadims - integer, intent(in) :: w(:) - - cadims = FieldCondensedArrayDims(0, 0, 0, w) - - end function construct_dimcount0 - - function construct_vert(k, w) result(cadims) - type(FieldCondensedArrayDims) :: cadims - integer, intent(in) :: k - integer, optional, intent(in) :: w(:) - - cadims = FieldCondensedArrayDims(0, 0, k, w) - - end function construct_vert - - function construct_surface(x, y, w) result(cadims) - type(FieldCondensedArrayDims) :: cadims - integer, intent(in) :: x, y - integer, optional, intent(in) :: w(:) - - cadims = FieldCondensedArrayDims(x, y, 0, w) - - end function construct_surface - - function construct(x, y, z, w) result(cadims) - type(FieldCondensedArrayDims) :: cadims - integer, intent(in) :: x, y - integer, intent(in) :: z - integer, optional, intent(in) :: w(:) - integer :: dims_(3) - integer :: i, j, k, n - - cadims%horz_ = [x, y] - cadims%vert_ = z - cadims%ungridded_ = [integer::] - i = max(x, 1) - j = max(y, 1) - k = max(z, 1) - - n = 1 - if(present(w)) then - cadims%ungridded_ = w - n = product(max(w, 1)) - end if - - dims_ = [i*j, k, n] - cadims%dims_ = dims_ - cadims%horizontal = dims_(1) - cadims%horizontal = dims_(2) - cadims%ungridded = dims_(3) - - end function construct - - function arguments(this) result(val) - integer, allocatable :: val(:) - class(FieldCondensedArrayDims), intent(in) :: this - integer :: size_ungridded - - size_ungridded = size(this%ungridded_) - allocate(val(3+size_ungridded)) - val(1:3) = [this%horz_(1), this%horz_(2), this%vert_] - if(size_ungridded > 0) val(4:size(val)) = this%ungridded_ - - end function arguments - - subroutine initialize(this) - class(FieldCondensedArrayDims) :: this - - this%horz_(2) = -1 - this%vert_ = -1 - this%dims_ = -1 - if(allocated(this%ungridded_)) deallocate(this%ungridded_) - - end subroutine initialize - - subroutine reset(this) - class(FieldCondensedArrayDims) :: this - - call this%initialize() - - end subroutine reset - -end module mapl3g_FieldCondensedArrayDims diff --git a/field_utils/FieldCondensedArray_private.F90 b/field_utils/FieldCondensedArray_private.F90 index 40a63a3a8355..650ef49998ec 100644 --- a/field_utils/FieldCondensedArray_private.F90 +++ b/field_utils/FieldCondensedArray_private.F90 @@ -37,40 +37,5 @@ function get_array_shape(gridToFieldMap, localElementCount, vert_dims, rc) & _RETURN(_SUCCESS) end function get_array_shape -! function get_array_shape(gridToFieldMap, localElementCount, rank, vert_dims, rc) & -! &result(array_shape) -! integer :: array_shape(3) -! integer, intent(in) :: gridToFieldMap(:) -! integer, intent(in) :: localElementCount(:) -! integer, intent(in) :: rank -! integer, optional, intent(in) :: vert_dims(:) -! integer, optional, intent(out) :: rc -! integer, allocatable :: grid_dims(:) -! integer, allocatable :: vert_dims_(:) -! integer, allocatable :: all_dims(:) -! integer, allocatable :: ungridded_dims(:) -! integer, allocatable :: temp_array(:) -! integer :: horz_size, vert_size, ungridded_size -! integer :: i, j -! integer :: status -! -! grid_dims = pack(gridToFieldMap, gridToFieldMap /= 0) -! _ASSERT(all(grid_dims <= total_size(grid_dims)), 'MAPL expects geom dims before ungridded') -! -! vert_dims_ = [integer:: ] ! empty -! if (present(vert_dims)) then -! if(total_size(vert_dims) > 0) vert_dims_ = vert_dims -! end if -! -! all_dims = [(i,i=1,rank)] -! ungridded_dims = pack(all_dims, [(all([vert_dims, grid_dims] /= i), i=1, rank)]) -! !ungridded_dims = pack(all_dims, [(not_in(i, [grid_dims, vert_dims])), i=1, rank]) -! horz_size = product(grid_dims) -! vert_size = product([localElementCount(vert_dims(i)), i=1, total_size(vert_dims)]) -! ungridded_size = product([localElementCount(vert_dims(i)), i=1, total_size(ungridded_dims)]) -! -! array_shape = [horz_size, vert_size, ungridded_size] -! -! end function get_array_shape end module mapl3g_FieldCondensedArray_private diff --git a/field_utils/FieldPointerUtilities.F90 b/field_utils/FieldPointerUtilities.F90 index 52a0f75e5eff..1a34eae22e87 100644 --- a/field_utils/FieldPointerUtilities.F90 +++ b/field_utils/FieldPointerUtilities.F90 @@ -1,6 +1,8 @@ #include "MAPL_Generic.h" module MAPL_FieldPointerUtilities + use mapl3g_output_info, only: get_num_levels + use mapl3g_FieldCondensedArray_private, only: get_array_shape_private => get_array_shape use ESMF use MAPL_ExceptionHandling use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer, c_loc @@ -80,7 +82,6 @@ module MAPL_FieldPointerUtilities end interface contains - subroutine assign_fptr_r4_rank1(x, fptr, rc) type(ESMF_Field), intent(inout) :: x real(kind=ESMF_KIND_R4), pointer, intent(out) :: fptr(:) @@ -92,8 +93,9 @@ subroutine assign_fptr_r4_rank1(x, fptr, rc) integer(ESMF_KIND_I8) :: local_size integer :: status - local_size = FieldGetLocalSize(x, _RC) - fp_shape = [ local_size ] +! local_size = FieldGetLocalSize(x, _RC) +! fp_shape = [ local_size ] + fp_shape = get_array_shape(x, _RC) call FieldGetCptr(x, cptr, _RC) call c_f_pointer(cptr, fptr, fp_shape) @@ -111,8 +113,9 @@ subroutine assign_fptr_r8_rank1(x, fptr, rc) integer(ESMF_KIND_I8) :: local_size integer :: status - local_size = FieldGetLocalSize(x, _RC) - fp_shape = [ local_size ] + !local_size = FieldGetLocalSize(x, _RC) + !fp_shape = [ local_size ] + fp_shape = get_array_shape(x, _RC) call FieldGetCptr(x, cptr, _RC) call c_f_pointer(cptr, fptr, fp_shape) @@ -904,20 +907,20 @@ subroutine GetFieldsUndef_r8(fields,undef_values,rc) _RETURN(_SUCCESS) end subroutine GetFieldsUndef_r8 -subroutine Destroy(Field,RC) - type(ESMF_Field), intent(INOUT) :: Field - integer, optional, intent(OUT ) :: RC + subroutine Destroy(Field,RC) + type(ESMF_Field), intent(INOUT) :: Field + integer, optional, intent(OUT ) :: RC - integer :: STATUS + integer :: STATUS - real(kind=ESMF_KIND_R4), pointer :: VR4_1D(:), VR4_2D(:,:), VR4_3D(:,:,:), VR4_4D(:,:,:,:) - real(kind=ESMF_KIND_R8), pointer :: VR8_1D(:), VR8_2D(:,:), VR8_3D(:,:,:), VR8_4D(:,:,:,:) - integer :: rank - type(ESMF_TypeKind_Flag) :: tk - logical :: esmf_allocated + real(kind=ESMF_KIND_R4), pointer :: VR4_1D(:), VR4_2D(:,:), VR4_3D(:,:,:), VR4_4D(:,:,:,:) + real(kind=ESMF_KIND_R8), pointer :: VR8_1D(:), VR8_2D(:,:), VR8_3D(:,:,:), VR8_4D(:,:,:,:) + integer :: rank + type(ESMF_TypeKind_Flag) :: tk + logical :: esmf_allocated - call ESMF_FieldGet(Field,typekind=tk,dimCount=rank,isESMFAllocated=esmf_allocated,_RC) - if (.not. esmf_allocated) then + call ESMF_FieldGet(Field,typekind=tk,dimCount=rank,isESMFAllocated=esmf_allocated,_RC) + if (.not. esmf_allocated) then if (tk == ESMF_TYPEKIND_R4 .and. rank == 1) then call ESMF_FieldGet(Field,0,VR4_1d,_RC) deallocate(VR4_1d,_STAT) @@ -945,10 +948,34 @@ subroutine Destroy(Field,RC) else _FAIL( 'unsupported typekind+rank') end if - end if - call ESMF_FieldDestroy(Field,noGarbage = .true., rc=status) - _VERIFY(STATUS) - _RETURN(ESMF_SUCCESS) + end if + call ESMF_FieldDestroy(Field,noGarbage = .true., rc=status) + _VERIFY(STATUS) + _RETURN(ESMF_SUCCESS) - end subroutine Destroy -end module + end subroutine Destroy + + function get_array_shape(f, rc) result(array_shape) + integer :: array_shape(3) + type(ESMF_Field), intent(inout) :: f + integer, optional, intent(out) :: rc + integer :: status + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) + integer, allocatable :: vertical_dimensions(:) + integer :: num_levels + + num_levels = 0 + vertical_dimensions = [integer::] + call ESMF_FieldGet(f, gridToFieldMap=gridToFieldMap, _RC) +! call ESMF_FieldGet(f, localElementCount=localElementCount, _RC) +! Due to an ESMF bug, getting the localElementCount must use the module function. +! See FieldGetLocalElementCount (specific function) comments. + localElementCount = FieldGetLocalElementCount(f, _RC) + num_levels = get_num_levels(f, _RC) + if(num_levels > 0) vertical_dimensions = [num_levels] + array_shape = get_array_shape_private(gridToFieldMap, localElementCount, vertical_dimensions, _RC) + + end function get_array_shape + +end module MAPL_FieldPointerUtilities diff --git a/field_utils/tests/Test_FieldCondensedArray.pf b/field_utils/tests/Test_FieldCondensedArray.pf index c5712b26756e..651ce28ca5b5 100644 --- a/field_utils/tests/Test_FieldCondensedArray.pf +++ b/field_utils/tests/Test_FieldCondensedArray.pf @@ -9,6 +9,8 @@ module Test_FieldCondensedArray use mapl3g_FieldCondensedArray_private implicit none + character, parameter :: GENERIC_MESSAGE = 'actual does not match expected.' + contains @Test @@ -19,11 +21,11 @@ contains integer, allocatable :: vertical_dims(:) gridToFieldMap = [1, 2] - localElementCount = [4, 5, 3] + localElementCount = [3, 5, 7] vertical_dims = [3] expected = [product(localElementCount(1:2)), localElementCount(3), 1] actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) - @assertEqual(actual, expected, 'actual does not match expected.') + @assertEqual(actual, expected, GENERIC_MESSAGE) end subroutine test_get_array_shape_3D @@ -32,16 +34,118 @@ contains integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) - integer, allocatable :: vertical_dims(:) gridToFieldMap = [1, 2] - localElementCount = [4, 5] + localElementCount = [3, 5] expected = [product(localElementCount), 1, 1] actual = get_array_shape(gridToFieldMap, localElementCount) - @assertEqual(actual, expected, 'actual does not match expected.') + @assertEqual(actual, expected, GENERIC_MESSAGE) end subroutine test_get_array_shape_2D + @Test + subroutine test_get_array_shape_general() + integer :: expected(3), actual(3) + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) + integer, allocatable :: vertical_dims(:) + + gridToFieldMap = [1, 2] + vertical_dims = [3] + localElementCount = [2, 3, 5, 7, 11] + expected = [product(localElementCount(1:2)), localElementCount(3), product(localElementCount(4:))] + actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) + @assertEqual(actual, expected, GENERIC_MESSAGE) + + end subroutine test_get_array_shape_general + + @Test + subroutine test_get_array_shape_noz() + integer :: expected(3), actual(3) + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) + + gridToFieldMap = [1, 2] + localElementCount = [2, 3, 5, 7] + expected = [product(localElementCount(1:2)), 1, product(localElementCount(3:))] + actual = get_array_shape(gridToFieldMap, localElementCount) + @assertEqual(actual, expected, GENERIC_MESSAGE) + + end subroutine test_get_array_shape_noz + + @Test + subroutine test_get_array_shape_0D() + integer :: expected(3), actual(3) + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) + + gridToFieldMap = [0, 0] + localElementCount = [5, 7, 11] + expected = [1, 1, product(localElementCount)] + actual = get_array_shape(gridToFieldMap, localElementCount) + @assertEqual(actual, expected, GENERIC_MESSAGE) + + end subroutine test_get_array_shape_0D + + subroutine test_get_array_shape_vert_only() + integer :: expected(3), actual(3) + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) + integer, allocatable :: vertical_dims(:) + + gridToFieldMap = [0, 0] + vertical_dims = [3] + localElementCount = vertical_dims + expected = [1, localElementCount(1), 1] + actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) + @assertEqual(actual, expected, GENERIC_MESSAGE) + + end subroutine test_get_array_shape_vert_only + + subroutine test_get_array_shape_vert_ungrid() + integer :: expected(3), actual(3) + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) + integer, allocatable :: vertical_dims(:) + + gridToFieldMap = [0, 0] + vertical_dims = [3] + localElementCount = [vertical_dims, 5, 7] + expected = [1, localElementCount(1), product(localElementCount(2:))] + actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) + @assertEqual(actual, expected, GENERIC_MESSAGE) + + end subroutine test_get_array_shape_vert_ungrid + + @Test + subroutine test_get_array_shape_2D_ungrid() + integer :: expected(3), actual(3) + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) + + gridToFieldMap = [1, 2] + localElementCount = [3, 5, 7, 11] + expected = [product(localElementCount(1:2)), 1, product(localElementCount(3:))] + actual = get_array_shape(gridToFieldMap, localElementCount) + @assertEqual(actual, expected, GENERIC_MESSAGE) + + end subroutine test_get_array_shape_2D_ungrid + + @Test + subroutine test_get_array_shape_wrong_order() + integer :: expected(3), actual(3) + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) + integer, allocatable :: vertical_dims(:) + integer :: status + + gridToFieldMap = [4, 5] + vertical_dims = [3] + localElementCount = [2, 3, 5, 7, 11] + actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims, rc=status) + @assertExceptionRaised() + + end subroutine test_get_array_shape_wrong_order ! function make_error_message(prelude, actual, interlude, expected, postlude) result(string) ! character(len=:), allocatable :: string ! character(len=*), intent(in) :: prelude, interlude, postlude diff --git a/field_utils/tests/Test_FieldCondensedArrayDims.pf b/field_utils/tests/Test_FieldCondensedArrayDims.pf deleted file mode 100644 index baf18c5cfc4c..000000000000 --- a/field_utils/tests/Test_FieldCondensedArrayDims.pf +++ /dev/null @@ -1,121 +0,0 @@ -!define f = constructor f = FieldCondensedArrayDims -#define TEST_ARGS_(E, M) @assertEqual(E, f%arguments(), 'f%arguments() does not match ' // M // '.') -#define EXPECT_(A) [X, Y, Z, A] -#define EXPECT3_ EXPECT_([integer::]) -#define EXPECT2A_(A) [X, Y, A] -#define EXPECT2_ [X, Y] - -module Test_FieldCondensedArrayDims - - use mapl3g_FieldCondensedArrayDims - use pfunit - - implicit none - - integer, parameter :: X = 1 - integer, parameter :: Y = X+1 - integer, parameter :: Z = Y+1 - integer, parameter :: W(2) = [Z+1, Z+2] - integer, parameter :: W1(1) = [W(1)] - type(FieldCondensedArrayDims) :: f - integer, allocatable :: expected_args(:) - character(len=*), parameter :: ERROR_CONSTRUCTOR = 'f%arguments() does not match ' - -contains - - @Test - subroutine test_construct() - - f = FieldCondensedArrayDims(X, Y, Z, W) - expected_args = [X, Y, Z, W] - @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected(5)') - - f = FieldCondensedArrayDims(X, Y, Z, W1) - expected_args = [X, Y, Z, W1] - @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected(4)') - - end subroutine test_construct - - @Test - subroutine test_construct_noungridded() - - f = FieldCondensedArrayDims(X, Y, Z) - expected_args = [X, Y, Z] - @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') - - end subroutine test_construct_noungridded - - @Test - subroutine test_construct_noz() - - f = FieldCondensedArrayDims(X, Y, W) - expected_args = [X, Y, 0, W] - @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') - - end subroutine test_construct_noz - - @Test - subroutine test_construct_noz_noungridded() - - f = FieldCondensedArrayDims(X, Y) - expected_args = [X, Y, 0] - @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') - - end subroutine test_construct_noz_noungridded - - @Test - subroutine test_construct_dimcount0() - - f = FieldCondensedArrayDims(W) - expected_args = W - @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') - - end subroutine test_construct_dimcount0 - - @Test - subroutine test_construct_vert() - - f = FieldCondensedArrayDims(Z, W) - expected_args = [Z, W] - @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') - - end subroutine test_construct_vert - - @Test - subroutine test_construct_vert_noungridded() - - f = FieldCondensedArrayDims(Z) - expected_args = [Z] - @assertEqual(expected_args, f%arguments(), ERROR_CONSTRUCTOR // 'expected') - - end subroutine test_construct_vert_noungridded - - @Test - subroutine test_horizontal() - end subroutine test_horizontal - - @Test - subroutine test_vertical() - end subroutine test_vertical - - @Test - subroutine test_ungridded() - end subroutine test_ungridded - - @Test - subroutine test_dims() - end subroutine test_dims - - @Before - subroutine setup() - if(allocated(expected_args)) deallocate(expected_args) - call f%initialize() - end subroutine setup - - @After - subroutine teardown() - if(allocated(expected_args)) deallocate(expected_args) - call f%reset() - end subroutine teardown - -end module Test_FieldCondensedArrayDims diff --git a/shared/CMakeLists.txt b/shared/CMakeLists.txt index 3668b6d60808..34baf28f4e11 100644 --- a/shared/CMakeLists.txt +++ b/shared/CMakeLists.txt @@ -29,6 +29,7 @@ set (srcs ShaveMantissa.c MAPL_Sleep.F90 MAPL_CF_Time.F90 + MAPL_ESMF_InfoKeys.F90 # Fortran submodules Interp/Interp.F90 Interp/Interp_implementation.F90 Shmem/Shmem.F90 Shmem/Shmem_implementation.F90 diff --git a/shared/MAPL_ESMF_InfoKeys.F90 b/shared/MAPL_ESMF_InfoKeys.F90 new file mode 100644 index 000000000000..38b798916373 --- /dev/null +++ b/shared/MAPL_ESMF_InfoKeys.F90 @@ -0,0 +1,76 @@ +#include "MAPL_Exceptions.h" +module mapl3g_esmf_info_keys + + use MAPL_ErrorHandling + + implicit none + + public :: KEY_UNGRIDDED_DIMS + public :: KEY_VERT_DIM + public :: KEY_VERT_GEOM + public :: KEY_UNITS + public :: KEY_LONG_NAME + public :: KEY_STANDARD_NAME + public :: KEY_NUM_LEVELS + public :: KEY_VLOC + public :: KEY_NUM_UNGRID_DIMS + public :: KEYSTUB_DIM + public :: KEY_UNGRIDDED_NAME + public :: KEY_UNGRIDDED_UNITS + public :: KEY_UNGRIDDED_COORD + public :: KEY_DIM_STRINGS + public :: make_dim_key + private + + ! FieldSpec info keys + character(len=*), parameter :: PREFIX = 'MAPL/' + character(len=*), parameter :: KEY_UNGRIDDED_DIMS = PREFIX // 'ungridded_dims/' + character(len=*), parameter :: KEY_VERT_DIM = PREFIX // 'vertical_dim/' + character(len=*), parameter :: KEY_VERT_GEOM = PREFIX // 'vertical_geom/' + character(len=*), parameter :: KEY_UNITS = PREFIX // 'units' + character(len=*), parameter :: KEY_LONG_NAME = PREFIX // 'long_name' + character(len=*), parameter :: KEY_STANDARD_NAME = PREFIX // 'standard_name' + + ! VerticalGeom info keys + character(len=*), parameter :: KEY_NUM_LEVELS = KEY_VERT_GEOM // 'num_levels' + + ! VerticalDimSpec info keys + character(len=*), parameter :: KEY_VLOC = KEY_VERT_DIM // 'vloc' + + ! UngriddedDims info keys + character(len=*), parameter :: KEY_NUM_UNGRID_DIMS = KEY_UNGRIDDED_DIMS // 'num_ungridded_dimensions' + character(len=*), parameter :: KEYSTUB_DIM = KEY_UNGRIDDED_DIMS // 'dim_' + + ! UngriddedDim info keys + character(len=*), parameter :: KEY_UNGRIDDED_NAME = 'name' + character(len=*), parameter :: KEY_UNGRIDDED_UNITS = 'units' + character(len=*), parameter :: KEY_UNGRIDDED_COORD = 'coordinates' + + character(len=*), parameter :: KEY_DIM_STRINGS(9) = [ & + KEYSTUB_DIM // '1', KEYSTUB_DIM // '2', KEYSTUB_DIM // '3', & + KEYSTUB_DIM // '4', KEYSTUB_DIM // '5', KEYSTUB_DIM // '6', & + KEYSTUB_DIM // '7', KEYSTUB_DIM // '8', KEYSTUB_DIM // '9'] + +contains + + function make_dim_key(n, rc) result(key) + character(len=:), allocatable :: key + integer, intent(in) :: n + integer, optional, intent(out) :: rc + integer :: status + character(len=32) :: raw + + key = '' + _ASSERT(n > 0, 'Index must be positive.') + if(n <= size(KEY_DIM_STRINGS)) then + key = KEY_DIM_STRINGS(n) + _RETURN(_SUCCESS) + end if + write(raw, fmt='(I0)', iostat=status) n + _ASSERT(status == 0, 'Write failed') + key = KEYSTUB_DIM // trim(raw) + _RETURN(_SUCCESS) + + end function make_dim_key + +end module mapl3g_esmf_info_keys From 31c8e9e2b12c9d66ca38359deabf433ff5c3eedf Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 19 Sep 2024 11:22:15 -0400 Subject: [PATCH 09/27] Fix num_levels bug --- base/MAPL_ESMF_InfoKeys.F90 | 76 --------------------------- esmf_utils/OutputInfo.F90 | 33 +++++++++--- field_utils/FieldCondensedArray.F90 | 9 +++- field_utils/FieldPointerUtilities.F90 | 56 +++++++++++++++++--- 4 files changed, 82 insertions(+), 92 deletions(-) delete mode 100644 base/MAPL_ESMF_InfoKeys.F90 diff --git a/base/MAPL_ESMF_InfoKeys.F90 b/base/MAPL_ESMF_InfoKeys.F90 deleted file mode 100644 index 38b798916373..000000000000 --- a/base/MAPL_ESMF_InfoKeys.F90 +++ /dev/null @@ -1,76 +0,0 @@ -#include "MAPL_Exceptions.h" -module mapl3g_esmf_info_keys - - use MAPL_ErrorHandling - - implicit none - - public :: KEY_UNGRIDDED_DIMS - public :: KEY_VERT_DIM - public :: KEY_VERT_GEOM - public :: KEY_UNITS - public :: KEY_LONG_NAME - public :: KEY_STANDARD_NAME - public :: KEY_NUM_LEVELS - public :: KEY_VLOC - public :: KEY_NUM_UNGRID_DIMS - public :: KEYSTUB_DIM - public :: KEY_UNGRIDDED_NAME - public :: KEY_UNGRIDDED_UNITS - public :: KEY_UNGRIDDED_COORD - public :: KEY_DIM_STRINGS - public :: make_dim_key - private - - ! FieldSpec info keys - character(len=*), parameter :: PREFIX = 'MAPL/' - character(len=*), parameter :: KEY_UNGRIDDED_DIMS = PREFIX // 'ungridded_dims/' - character(len=*), parameter :: KEY_VERT_DIM = PREFIX // 'vertical_dim/' - character(len=*), parameter :: KEY_VERT_GEOM = PREFIX // 'vertical_geom/' - character(len=*), parameter :: KEY_UNITS = PREFIX // 'units' - character(len=*), parameter :: KEY_LONG_NAME = PREFIX // 'long_name' - character(len=*), parameter :: KEY_STANDARD_NAME = PREFIX // 'standard_name' - - ! VerticalGeom info keys - character(len=*), parameter :: KEY_NUM_LEVELS = KEY_VERT_GEOM // 'num_levels' - - ! VerticalDimSpec info keys - character(len=*), parameter :: KEY_VLOC = KEY_VERT_DIM // 'vloc' - - ! UngriddedDims info keys - character(len=*), parameter :: KEY_NUM_UNGRID_DIMS = KEY_UNGRIDDED_DIMS // 'num_ungridded_dimensions' - character(len=*), parameter :: KEYSTUB_DIM = KEY_UNGRIDDED_DIMS // 'dim_' - - ! UngriddedDim info keys - character(len=*), parameter :: KEY_UNGRIDDED_NAME = 'name' - character(len=*), parameter :: KEY_UNGRIDDED_UNITS = 'units' - character(len=*), parameter :: KEY_UNGRIDDED_COORD = 'coordinates' - - character(len=*), parameter :: KEY_DIM_STRINGS(9) = [ & - KEYSTUB_DIM // '1', KEYSTUB_DIM // '2', KEYSTUB_DIM // '3', & - KEYSTUB_DIM // '4', KEYSTUB_DIM // '5', KEYSTUB_DIM // '6', & - KEYSTUB_DIM // '7', KEYSTUB_DIM // '8', KEYSTUB_DIM // '9'] - -contains - - function make_dim_key(n, rc) result(key) - character(len=:), allocatable :: key - integer, intent(in) :: n - integer, optional, intent(out) :: rc - integer :: status - character(len=32) :: raw - - key = '' - _ASSERT(n > 0, 'Index must be positive.') - if(n <= size(KEY_DIM_STRINGS)) then - key = KEY_DIM_STRINGS(n) - _RETURN(_SUCCESS) - end if - write(raw, fmt='(I0)', iostat=status) n - _ASSERT(status == 0, 'Write failed') - key = KEYSTUB_DIM // trim(raw) - _RETURN(_SUCCESS) - - end function make_dim_key - -end module mapl3g_esmf_info_keys diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/OutputInfo.F90 index 43248e648204..adf1c6d0dfab 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/OutputInfo.F90 @@ -11,7 +11,7 @@ module mapl3g_output_info use esmf, only: ESMF_InfoDestroy, ESMF_InfoCreate use esmf, only: ESMF_InfoGet, ESMF_InfoGetFromHost use esmf, only: ESMF_InfoGetAlloc, ESMF_InfoGetCharAlloc - use esmf, only: ESMF_InfoPrint + use esmf, only: ESMF_InfoPrint, ESMF_MAXSTR, ESMF_SUCCESS use Mapl_ErrorHandling implicit none @@ -45,6 +45,7 @@ module mapl3g_output_info end interface get_ungridded_dims character(len=*), parameter :: VERT_DIM_NONE = 'VERTICAL_DIM_NONE' + character(len=0), parameter :: EMPTY_STRING = '' contains @@ -94,10 +95,16 @@ integer function get_num_levels_info(info, rc) result(num) integer, optional, intent(out) :: rc integer :: status logical :: is_none + character(len=:), allocatable :: spec_name + spec_name = EMPTY_STRING num = 0 - is_none = VERT_DIM_NONE == get_vertical_dim_spec_info(info, _RC) - _RETURN_IF(is_none) + spec_name = get_vertical_dim_spec_info(info, _RC) + is_none = .TRUE. + if(spec_name /= EMPTY_STRING) is_none = (VERT_DIM_NONE == spec_name) + if(is_none) then + _RETURN(_SUCCESS) + end if call ESMF_InfoGet(info, key=KEY_NUM_LEVELS, value=num, _RC) _RETURN(_SUCCESS) @@ -123,12 +130,14 @@ function get_vertical_dim_spec_names_bundle_info(info, rc) result(names) integer, optional, intent(out) :: rc integer :: status integer :: i - character(len=:), allocatable :: name + character(len=:), allocatable :: spec_name + spec_name = EMPTY_STRING names = StringVector() do i=1, size(info) - name = get_vertical_dim_spec_info(info(i), _RC) - if(find_index(names, name) == 0) call names%push_back(name) + spec_name = get_vertical_dim_spec_info(info(i), _RC) + _ASSERT(spec_name /= EMPTY_STRING, 'No vertical dim spec found.') + if(find_index(names, spec_name) == 0) call names%push_back(spec_name) end do _RETURN(_SUCCESS) @@ -141,6 +150,7 @@ function get_vertical_dim_spec_name_field(field, rc) result(spec_name) integer :: status type(ESMF_Info) :: info + spec_name = EMPTY_STRING call ESMF_InfoGetFromHost(field, info, _RC) spec_name = get_vertical_dim_spec_info(info, _RC) _RETURN(_SUCCESS) @@ -152,8 +162,15 @@ function get_vertical_dim_spec_info(info, rc) result(spec_name) type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status - - call ESMF_InfoGetCharAlloc(info, key=KEY_VLOC, value=spec_name, _RC) + logical :: isPresent + character(len=ESMF_MAXSTR) :: raw + + spec_name = EMPTY_STRING + isPresent = ESMF_InfoIsPresent(info, key=KEY_VLOC, _RC) + _RETURN_UNLESS(isPresent) + call ESMF_InfoGet(info, key=KEY_VLOC, value=raw, rc=status) + _ASSERT(status==ESMF_SUCCESS, 'Failed to get vertical dimspec name.') + spec_name = trim(adjustl(raw)) _RETURN(_SUCCESS) end function get_vertical_dim_spec_info diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 index 6e9492939530..842c6e464f84 100644 --- a/field_utils/FieldCondensedArray.F90 +++ b/field_utils/FieldCondensedArray.F90 @@ -7,9 +7,9 @@ module mapl3g_FieldCondensedArray use esmf, only: ESMF_Field, ESMF_FieldGet implicit none -! public :: ! public procedures, variables, types, etc. private + public :: get_array_shape contains @@ -22,11 +22,18 @@ function get_array_shape(field_in, rc) result(array_shape) integer, allocatable :: localElementCount(:) integer, allocatable :: vertical_dimensions(:) integer :: num_levels + integer :: rank num_levels = 0 vertical_dimensions = [integer::] call ESMF_FieldGet(field_in, gridToFieldMap=gridToFieldMap, _RC) + call ESMF_FieldGet(field_in, rank=rank, _RC) + allocate(localElementCount(rank)) +! Due to an ESMF bug, getting the localElementCount should use the module function. +! For now, use this because of dependency issues. call ESMF_FieldGet(field_in, localElementCount=localElementCount, _RC) +! See FieldGetLocalElementCount (specific function) comments in FieldPointerUtilities. + !localElementCount = FieldGetLocalElementCount(f, _RC) num_levels = get_num_levels(field_in, _RC) if(num_levels > 0) vertical_dimensions = [num_levels] array_shape = get_array_shape_private(gridToFieldMap, localElementCount, vertical_dimensions, _RC) diff --git a/field_utils/FieldPointerUtilities.F90 b/field_utils/FieldPointerUtilities.F90 index 1a34eae22e87..35bd96ee51fc 100644 --- a/field_utils/FieldPointerUtilities.F90 +++ b/field_utils/FieldPointerUtilities.F90 @@ -12,6 +12,7 @@ module MAPL_FieldPointerUtilities public :: FieldsHaveUndef public :: GetFieldsUndef public :: assign_fptr + public :: assign_fptr_rank3 public :: FieldGetLocalElementCount public :: FieldGetLocalSize public :: FieldGetCptr @@ -35,6 +36,11 @@ module MAPL_FieldPointerUtilities module procedure assign_fptr_r8_rank2 end interface assign_fptr + interface assign_fptr_rank3 + module procedure :: assign_fptr_r4_rank3 + module procedure :: assign_fptr_r8_rank3 + end interface assign_fptr_rank3 + interface FieldGetCptr procedure get_cptr end interface @@ -93,9 +99,8 @@ subroutine assign_fptr_r4_rank1(x, fptr, rc) integer(ESMF_KIND_I8) :: local_size integer :: status -! local_size = FieldGetLocalSize(x, _RC) -! fp_shape = [ local_size ] - fp_shape = get_array_shape(x, _RC) + local_size = FieldGetLocalSize(x, _RC) + fp_shape = [ local_size ] call FieldGetCptr(x, cptr, _RC) call c_f_pointer(cptr, fptr, fp_shape) @@ -113,9 +118,8 @@ subroutine assign_fptr_r8_rank1(x, fptr, rc) integer(ESMF_KIND_I8) :: local_size integer :: status - !local_size = FieldGetLocalSize(x, _RC) - !fp_shape = [ local_size ] - fp_shape = get_array_shape(x, _RC) + local_size = FieldGetLocalSize(x, _RC) + fp_shape = [ local_size ] call FieldGetCptr(x, cptr, _RC) call c_f_pointer(cptr, fptr, fp_shape) @@ -154,6 +158,42 @@ subroutine assign_fptr_r8_rank2(x, fp_shape, fptr, rc) _RETURN(_SUCCESS) end subroutine assign_fptr_r8_rank2 + subroutine assign_fptr_r4_rank3(x, fptr, rc) + type(ESMF_Field), intent(inout) :: x + real(kind=ESMF_KIND_R4), 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 + + fp_shape = get_array_shape(x, _RC) + call FieldGetCptr(x, cptr, _RC) + call c_f_pointer(cptr, fptr, fp_shape) + + _RETURN(_SUCCESS) + end subroutine assign_fptr_r4_rank3 + + subroutine assign_fptr_r8_rank3(x, fptr, rc) + type(ESMF_Field), intent(inout) :: x + real(kind=ESMF_KIND_R8), 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 + + fp_shape = get_array_shape(x, _RC) + call FieldGetCptr(x, cptr, _RC) + call c_f_pointer(cptr, fptr, fp_shape) + + _RETURN(_SUCCESS) + end subroutine assign_fptr_r8_rank3 + subroutine get_cptr(x, cptr, rc) type(ESMF_Field), intent(inout) :: x type(c_ptr), intent(out) :: cptr @@ -964,11 +1004,13 @@ function get_array_shape(f, rc) result(array_shape) integer, allocatable :: localElementCount(:) integer, allocatable :: vertical_dimensions(:) integer :: num_levels + integer :: rank num_levels = 0 vertical_dimensions = [integer::] call ESMF_FieldGet(f, gridToFieldMap=gridToFieldMap, _RC) -! call ESMF_FieldGet(f, localElementCount=localElementCount, _RC) + call ESMF_FieldGet(f, rank=rank, _RC) + allocate(localElementCount(rank)) ! Due to an ESMF bug, getting the localElementCount must use the module function. ! See FieldGetLocalElementCount (specific function) comments. localElementCount = FieldGetLocalElementCount(f, _RC) From 655b6ac8610a87997917724fb349dc88b8995238 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 19 Sep 2024 12:05:28 -0400 Subject: [PATCH 10/27] Remove _HERE, comments, and unused variables --- esmf_utils/OutputInfo.F90 | 2 - field_utils/CMakeLists.txt | 1 - field_utils/FieldCondensedArray.F90 | 43 --------------- field_utils/FieldCondensedArray_private.F90 | 3 +- field_utils/FieldPointerUtilities.F90 | 2 - field_utils/tests/CMakeLists.txt | 2 +- ...pf => Test_FieldCondensedArray_private.pf} | 53 ++----------------- 7 files changed, 7 insertions(+), 99 deletions(-) delete mode 100644 field_utils/FieldCondensedArray.F90 rename field_utils/tests/{Test_FieldCondensedArray.pf => Test_FieldCondensedArray_private.pf} (75%) diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/OutputInfo.F90 index adf1c6d0dfab..27e45b4d5477 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/OutputInfo.F90 @@ -301,7 +301,6 @@ subroutine check_duplicate(vec, udim, rc) class(UngriddedDimVector), intent(in) :: vec class(UngriddedDim), intent(in) :: udim integer, optional, intent(out) :: rc - integer :: status type(UngriddedDimVectorIterator) :: iter type(UngriddedDim) :: vdim @@ -330,7 +329,6 @@ function create_bundle_info(bundle, rc) result(bundle_info) integer, optional, intent(out) :: rc integer :: status integer :: field_count, i - type(ESMF_Field) :: field type(ESMF_Field), allocatable :: fields(:) type(ESMF_Info) :: info diff --git a/field_utils/CMakeLists.txt b/field_utils/CMakeLists.txt index fec2a17ccc3e..2edfc20b9fd3 100644 --- a/field_utils/CMakeLists.txt +++ b/field_utils/CMakeLists.txt @@ -8,7 +8,6 @@ set(srcs FieldUnaryFunctions.F90 FieldBinaryOperations.F90 FieldUnits.F90 - FieldCondensedArray.F90 FieldCondensedArray_private.F90 ) diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 deleted file mode 100644 index 842c6e464f84..000000000000 --- a/field_utils/FieldCondensedArray.F90 +++ /dev/null @@ -1,43 +0,0 @@ -#include "MAPL_Generic.h" -module mapl3g_FieldCondensedArray - - use mapl3g_output_info, only: get_num_levels - use mapl3g_FieldCondensedArray_private, only: get_array_shape_private => get_array_shape - use MAPL_ExceptionHandling - use esmf, only: ESMF_Field, ESMF_FieldGet - implicit none - - private - - public :: get_array_shape - -contains - - function get_array_shape(field_in, rc) result(array_shape) - integer :: array_shape(3) - type(ESMF_Field), intent(in) :: field_in - integer, optional, intent(out) :: rc - integer :: status - integer, allocatable :: gridToFieldMap(:) - integer, allocatable :: localElementCount(:) - integer, allocatable :: vertical_dimensions(:) - integer :: num_levels - integer :: rank - - num_levels = 0 - vertical_dimensions = [integer::] - call ESMF_FieldGet(field_in, gridToFieldMap=gridToFieldMap, _RC) - call ESMF_FieldGet(field_in, rank=rank, _RC) - allocate(localElementCount(rank)) -! Due to an ESMF bug, getting the localElementCount should use the module function. -! For now, use this because of dependency issues. - call ESMF_FieldGet(field_in, localElementCount=localElementCount, _RC) -! See FieldGetLocalElementCount (specific function) comments in FieldPointerUtilities. - !localElementCount = FieldGetLocalElementCount(f, _RC) - num_levels = get_num_levels(field_in, _RC) - if(num_levels > 0) vertical_dimensions = [num_levels] - array_shape = get_array_shape_private(gridToFieldMap, localElementCount, vertical_dimensions, _RC) - - end function get_array_shape - -end module mapl3g_FieldCondensedArray diff --git a/field_utils/FieldCondensedArray_private.F90 b/field_utils/FieldCondensedArray_private.F90 index 650ef49998ec..ff0ffe213ff0 100644 --- a/field_utils/FieldCondensedArray_private.F90 +++ b/field_utils/FieldCondensedArray_private.F90 @@ -1,6 +1,7 @@ #include "MAPL_Generic.h" module mapl3g_FieldCondensedArray_private +#include "MAPL_Generic.h" use MAPL_ExceptionHandling implicit none @@ -16,7 +17,7 @@ function get_array_shape(gridToFieldMap, localElementCount, vert_dims, rc) & integer, intent(in) :: localElementCount(:) integer, optional, intent(in) :: vert_dims(:) integer, optional, intent(out) :: rc - integer :: status, rank, i + integer :: rank, i integer, allocatable :: grid_dims(:) integer, allocatable :: vert_dims_(:) integer, allocatable :: ungridded_dims(:) diff --git a/field_utils/FieldPointerUtilities.F90 b/field_utils/FieldPointerUtilities.F90 index 35bd96ee51fc..36b64b37090b 100644 --- a/field_utils/FieldPointerUtilities.F90 +++ b/field_utils/FieldPointerUtilities.F90 @@ -166,7 +166,6 @@ subroutine assign_fptr_r4_rank3(x, fptr, rc) ! local declarations type(c_ptr) :: cptr integer(ESMF_KIND_I8), allocatable :: fp_shape(:) - integer(ESMF_KIND_I8) :: local_size integer :: status fp_shape = get_array_shape(x, _RC) @@ -184,7 +183,6 @@ subroutine assign_fptr_r8_rank3(x, fptr, rc) ! local declarations type(c_ptr) :: cptr integer(ESMF_KIND_I8), allocatable :: fp_shape(:) - integer(ESMF_KIND_I8) :: local_size integer :: status fp_shape = get_array_shape(x, _RC) diff --git a/field_utils/tests/CMakeLists.txt b/field_utils/tests/CMakeLists.txt index fd2b5fe750c6..880af840fc07 100644 --- a/field_utils/tests/CMakeLists.txt +++ b/field_utils/tests/CMakeLists.txt @@ -4,7 +4,7 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.field_utils.tests") set (test_srcs Test_FieldBLAS.pf Test_FieldArithmetic.pf - Test_FieldCondensedArray.pf + Test_FieldCondensedArray_private.pf ) diff --git a/field_utils/tests/Test_FieldCondensedArray.pf b/field_utils/tests/Test_FieldCondensedArray_private.pf similarity index 75% rename from field_utils/tests/Test_FieldCondensedArray.pf rename to field_utils/tests/Test_FieldCondensedArray_private.pf index 651ce28ca5b5..e733b85e23ea 100644 --- a/field_utils/tests/Test_FieldCondensedArray.pf +++ b/field_utils/tests/Test_FieldCondensedArray_private.pf @@ -1,10 +1,7 @@ -#if defined(TRIMALL) -# undef TRIMALL -#endif -#define TRIMALL(A) trim(adjustl(A)) - -module Test_FieldCondensedArray +#include "MAPL_TestErr.h" +module Test_FieldCondensedArray_private + use MAPL_ExceptionHandling use pfunit use mapl3g_FieldCondensedArray_private implicit none @@ -146,47 +143,5 @@ contains @assertExceptionRaised() end subroutine test_get_array_shape_wrong_order -! function make_error_message(prelude, actual, interlude, expected, postlude) result(string) -! character(len=:), allocatable :: string -! character(len=*), intent(in) :: prelude, interlude, postlude -! integer, intent(in) :: actual(:), expected(:) -! character(len=:), allocatable :: raw -! -! raw = make_array_string(actual) -! if(size(raw) == 0) raw = 'NO ACTUAL' -! string = trim(raw) // interlude -! raw = make_array_string(expected) -! if(size(raw) == 0) raw = 'NO EXPECTED' -! string = trim(prelude) // string // trim(raw) // trim(postlude) -! -! end function make_error_message -! -! function make_array_string(arr) result(string) -! character(len=:), allocatable :: string -! integer, intent(in) :: arr(:) -! character, parameter :: HFMT = '(I0)' -! character, parameter :: TFMT = '(1X, I0)' -! character(len=:), allocatable :: raw -! integer :: i, iostat -! -! if(size(arr) == 0) then -! string = '[]' -! return -! end if -! string = '' -! write(raw, fmt=HFMT, iostat=iostat, advance = 'NO') arr(1) -! if(iostat /= 0) return -! string = '[ ' // TRIMALL(raw) -! do i=2, size(arr) -! write(raw, fmt=TFMT, iostat=iostat, advance='NO') arr(i) -! if(iostat /= 0) then -! string = '' -! end if -! string = string // TRIMALL(raw) -! end do -! string = string // ']' -! -! end function make_array_string - -end module Test_FieldCondensedArray +end module Test_FieldCondensedArray_private From 9f74978f3a406437c453095cf366b2500996b780 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 19 Sep 2024 12:27:44 -0400 Subject: [PATCH 11/27] Rm allocatable strings from vertical dim spec --- esmf_utils/OutputInfo.F90 | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/OutputInfo.F90 index 27e45b4d5477..3c93f7a2e590 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/OutputInfo.F90 @@ -95,7 +95,7 @@ integer function get_num_levels_info(info, rc) result(num) integer, optional, intent(out) :: rc integer :: status logical :: is_none - character(len=:), allocatable :: spec_name + character(len=ESMF_MAXSTR) :: spec_name spec_name = EMPTY_STRING num = 0 @@ -130,21 +130,21 @@ function get_vertical_dim_spec_names_bundle_info(info, rc) result(names) integer, optional, intent(out) :: rc integer :: status integer :: i - character(len=:), allocatable :: spec_name + character(len=ESMF_MAXSTR) :: spec_name spec_name = EMPTY_STRING names = StringVector() do i=1, size(info) spec_name = get_vertical_dim_spec_info(info(i), _RC) _ASSERT(spec_name /= EMPTY_STRING, 'No vertical dim spec found.') - if(find_index(names, spec_name) == 0) call names%push_back(spec_name) + if(find_index(names, spec_name) == 0) call names%push_back(trim(spec_name)) end do _RETURN(_SUCCESS) end function get_vertical_dim_spec_names_bundle_info function get_vertical_dim_spec_name_field(field, rc) result(spec_name) - character(len=:), allocatable :: spec_name + character(len=ESMF_MAXSTR) :: spec_name type(ESMF_Field), intent(in) :: field integer, optional, intent(out) :: rc integer :: status @@ -158,19 +158,19 @@ function get_vertical_dim_spec_name_field(field, rc) result(spec_name) end function get_vertical_dim_spec_name_field function get_vertical_dim_spec_info(info, rc) result(spec_name) - character(len=:), allocatable :: spec_name + character(len=ESMF_MAXSTR) :: spec_name type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status logical :: isPresent character(len=ESMF_MAXSTR) :: raw + character, parameter :: error_message = 'Failed to get vertical dim spec name.' spec_name = EMPTY_STRING isPresent = ESMF_InfoIsPresent(info, key=KEY_VLOC, _RC) - _RETURN_UNLESS(isPresent) - call ESMF_InfoGet(info, key=KEY_VLOC, value=raw, rc=status) - _ASSERT(status==ESMF_SUCCESS, 'Failed to get vertical dimspec name.') - spec_name = trim(adjustl(raw)) + _ASSERT(isPresent, error_message) + call ESMF_InfoGet(info, key=KEY_VLOC, value=spec_name, rc=status) + _ASSERT(status==ESMF_SUCCESS, error_message) _RETURN(_SUCCESS) end function get_vertical_dim_spec_info @@ -316,12 +316,12 @@ subroutine check_duplicate(vec, udim, rc) end subroutine check_duplicate - logical function is_vertical_dim_none(s) - character(len=*), intent(in) :: s - - is_vertical_dim_none = s == 'VERTICAL_DIM_NONE' - - end function is_vertical_dim_none +! logical function is_vertical_dim_none(s) !wdb fixme deleteme +! character(len=*), intent(in) :: s +! +! is_vertical_dim_none = s == 'VERTICAL_DIM_NONE' +! +! end function is_vertical_dim_none function create_bundle_info(bundle, rc) result(bundle_info) type(ESMF_Info), allocatable :: bundle_info(:) From 2cc717d19d037d1dc2ccb6630d521a164e323f62 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 19 Sep 2024 12:33:41 -0400 Subject: [PATCH 12/27] Remove ESMF_InfoGetCharAlloc calls --- esmf_utils/OutputInfo.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/OutputInfo.F90 index 3c93f7a2e590..8e7c075cb0e1 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/OutputInfo.F90 @@ -10,8 +10,8 @@ module mapl3g_output_info use esmf, only: ESMF_Info, ESMF_InfoIsPresent use esmf, only: ESMF_InfoDestroy, ESMF_InfoCreate use esmf, only: ESMF_InfoGet, ESMF_InfoGetFromHost - use esmf, only: ESMF_InfoGetAlloc, ESMF_InfoGetCharAlloc - use esmf, only: ESMF_InfoPrint, ESMF_MAXSTR, ESMF_SUCCESS + use esmf, only: ESMF_InfoGetAlloc, ESMF_InfoPrint + use esmf, only: ESMF_MAXSTR, ESMF_SUCCESS use Mapl_ErrorHandling implicit none @@ -242,10 +242,10 @@ function make_ungridded_dim(info, n, rc) result(ungridded_dim) type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status - character(len=:), allocatable :: key type(ESMF_Info) :: dim_info - character(len=:), allocatable :: name - character(len=:), allocatable :: units + character(len=ESMF_MAXSTR) :: key + character(len=ESMF_MAXSTR) :: name + character(len=ESMF_MAXSTR) :: units real, allocatable :: coordinates(:) logical :: is_present character(len=1024) :: json_repr @@ -257,11 +257,11 @@ function make_ungridded_dim(info, n, rc) result(ungridded_dim) end if _ASSERT(is_present, 'Key ' // key // ' not found in ' // trim(json_repr)) dim_info = ESMF_InfoCreate(info, key=key, _RC) - call ESMF_InfoGetCharAlloc(dim_info, key=KEY_UNGRIDDED_NAME, value=name, _RC) - call ESMF_InfoGetCharAlloc(dim_info, key=KEY_UNGRIDDED_UNITS, value=units, _RC) + call ESMF_InfoGet(dim_info, key=KEY_UNGRIDDED_NAME, value=name, _RC) + call ESMF_InfoGet(dim_info, key=KEY_UNGRIDDED_UNITS, value=units, _RC) call ESMF_InfoGetAlloc(dim_info, key=KEY_UNGRIDDED_COORD, values=coordinates, _RC) call ESMF_InfoDestroy(dim_info, _RC) - ungridded_dim = UngriddedDim(coordinates, name=name, units=units) + ungridded_dim = UngriddedDim(coordinates, name=trim(name), units=trim(units)) _RETURN(_SUCCESS) end function make_ungridded_dim From 8f2b8979f9107121368092f54669fb208f7ca7cf Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 19 Sep 2024 13:18:52 -0400 Subject: [PATCH 13/27] Fix indents --- esmf_utils/OutputInfo.F90 | 7 - field_utils/FieldPointerUtilities.F90 | 276 +++++++++++++------------- 2 files changed, 138 insertions(+), 145 deletions(-) diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/OutputInfo.F90 index 8e7c075cb0e1..1f7b2f2caa4c 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/OutputInfo.F90 @@ -316,13 +316,6 @@ subroutine check_duplicate(vec, udim, rc) end subroutine check_duplicate -! logical function is_vertical_dim_none(s) !wdb fixme deleteme -! character(len=*), intent(in) :: s -! -! is_vertical_dim_none = s == 'VERTICAL_DIM_NONE' -! -! end function is_vertical_dim_none - function create_bundle_info(bundle, rc) result(bundle_info) type(ESMF_Info), allocatable :: bundle_info(:) type(ESMF_FieldBundle), intent(in) :: bundle diff --git a/field_utils/FieldPointerUtilities.F90 b/field_utils/FieldPointerUtilities.F90 index 36b64b37090b..695eaf47fc24 100644 --- a/field_utils/FieldPointerUtilities.F90 +++ b/field_utils/FieldPointerUtilities.F90 @@ -566,7 +566,7 @@ logical function are_same_type_kind(x, y, rc) result(same_tk) _RETURN(_SUCCESS) end function are_same_type_kind - subroutine verify_typekind_scalar(x, expected_tk, rc) + subroutine verify_typekind_scalar(x, expected_tk, rc) type(ESMF_Field), intent(inout) :: x type(ESMF_TypeKind_Flag), intent(in) :: expected_tk integer, optional, intent(out) :: rc @@ -761,7 +761,7 @@ subroutine copy(x, y, rc) call FieldGetCptr(y, cptr_y, _RC) call ESMF_FieldGet(y, typekind = tk_y, _RC) - !wdb fixme convert between precisions ? get rid of extra cases + !wdb fixme convert between precisions ? get rid of extra cases y_is_double = (tk_y == ESMF_TYPEKIND_R8) _ASSERT(y_is_double .or. (tk_y == ESMF_TYPEKIND_R4), UNSUPPORTED_TK//'y.') @@ -837,113 +837,113 @@ subroutine copy_r8_r8(cptr_x, cptr_y, n) y_ptr=x_ptr end subroutine copy_r8_r8 -! this procedure must go away as soon as ESMF Fixes their bug - - subroutine MAPL_FieldGetLocalElementCount(field,local_count,rc) - type(ESMF_Field), intent(inout) :: field - integer, allocatable, intent(out) :: local_count(:) - integer, optional, intent(out) :: rc - - integer :: status, rank - type(ESMF_TypeKind_Flag) :: tk - - 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(:,:,:,:) - - call ESMF_FieldGet(field,rank=rank,typekind=tk,_RC) - if (tk == ESMF_TypeKind_R4) then - if (rank==1) then - call ESMF_FieldGet(field,0,farrayptr=r4_1d,_RC) - local_count = shape(r4_1d) - else if (rank ==2) then - call ESMF_FieldGet(field,0,farrayptr=r4_2d,_RC) - local_count = shape(r4_2d) - else if (rank ==3) then - call ESMF_FieldGet(field,0,farrayptr=r4_3d,_RC) - local_count = shape(r4_3d) - else if (rank ==4) then - call ESMF_FieldGet(field,0,farrayptr=r4_4d,_RC) - local_count = shape(r4_4d) - else - _FAIL("Unsupported rank") - end if - else if (tk == ESMF_TypeKind_R8) then - if (rank==1) then - call ESMF_FieldGet(field,0,farrayptr=r8_1d,_RC) - local_count = shape(r8_1d) - else if (rank ==2) then - call ESMF_FieldGet(field,0,farrayptr=r8_2d,_RC) - local_count = shape(r8_2d) - else if (rank ==3) then - call ESMF_FieldGet(field,0,farrayptr=r8_3d,_RC) - local_count = shape(r8_3d) - else if (rank ==4) then - call ESMF_FieldGet(field,0,farrayptr=r8_4d,_RC) - local_count = shape(r8_4d) - else - _FAIL("Unsupported rank") - end if - else - _FAIL("Unsupported type") - end if - _RETURN(_SUCCESS) - end subroutine MAPL_FieldGetLocalElementCount - - function FieldsHaveUndef(fields,rc) result(all_have_undef) - logical :: all_have_undef - type(ESMF_Field), intent(inout) :: fields(:) - integer, optional, intent(out) :: rc - - integer :: status, i - logical :: isPresent - type(ESMF_Info) :: infoh - - all_have_undef = .true. - do i =1,size(fields) - call ESMF_InfoGetFromHost(fields(i),infoh,_RC) - isPresent = ESMF_InfoIsPresent(infoh,"missing_value",_RC) - all_have_undef = (all_have_undef .and. isPresent) - enddo - _RETURN(_SUCCESS) - end function - - subroutine GetFieldsUndef_r4(fields,undef_values,rc) - type(ESMF_Field), intent(inout) :: fields(:) - real(kind=ESMF_KIND_R4), allocatable,intent(inout) :: undef_values(:) - integer, optional, intent(out) :: rc - - integer :: status, i - logical :: isPresent - type(ESMF_Info) :: infoh - - allocate(undef_values(size(fields))) - do i =1,size(fields) - call ESMF_InfoGetFromHost(fields(i),infoh,_RC) - isPresent = ESMF_InfoIsPresent(infoh,"missing_value",_RC) - _ASSERT(isPresent,"missing undef value") - call ESMF_InfoGet(infoh,value=undef_values(i),key="missing_value",_RC) - enddo - _RETURN(_SUCCESS) - end subroutine GetFieldsUndef_r4 - - subroutine GetFieldsUndef_r8(fields,undef_values,rc) - type(ESMF_Field), intent(inout) :: fields(:) - real(kind=ESMF_KIND_R8), allocatable,intent(inout) :: undef_values(:) - integer, optional, intent(out) :: rc - - integer :: status, i - logical :: isPresent - type(ESMF_Info) :: infoh - - allocate(undef_values(size(fields))) - do i =1,size(fields) - call ESMF_InfoGetFromHost(fields(i),infoh,_RC) - isPresent = ESMF_InfoIsPresent(infoh,"missing_value",_RC) - _ASSERT(isPresent,"missing undef value") - call ESMF_InfoGet(infoh,value=undef_values(i),key="missing_value",_RC) - enddo - _RETURN(_SUCCESS) - end subroutine GetFieldsUndef_r8 + ! this procedure must go away as soon as ESMF Fixes their bug + + subroutine MAPL_FieldGetLocalElementCount(field,local_count,rc) + type(ESMF_Field), intent(inout) :: field + integer, allocatable, intent(out) :: local_count(:) + integer, optional, intent(out) :: rc + + integer :: status, rank + type(ESMF_TypeKind_Flag) :: tk + + 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(:,:,:,:) + + call ESMF_FieldGet(field,rank=rank,typekind=tk,_RC) + if (tk == ESMF_TypeKind_R4) then + if (rank==1) then + call ESMF_FieldGet(field,0,farrayptr=r4_1d,_RC) + local_count = shape(r4_1d) + else if (rank ==2) then + call ESMF_FieldGet(field,0,farrayptr=r4_2d,_RC) + local_count = shape(r4_2d) + else if (rank ==3) then + call ESMF_FieldGet(field,0,farrayptr=r4_3d,_RC) + local_count = shape(r4_3d) + else if (rank ==4) then + call ESMF_FieldGet(field,0,farrayptr=r4_4d,_RC) + local_count = shape(r4_4d) + else + _FAIL("Unsupported rank") + end if + else if (tk == ESMF_TypeKind_R8) then + if (rank==1) then + call ESMF_FieldGet(field,0,farrayptr=r8_1d,_RC) + local_count = shape(r8_1d) + else if (rank ==2) then + call ESMF_FieldGet(field,0,farrayptr=r8_2d,_RC) + local_count = shape(r8_2d) + else if (rank ==3) then + call ESMF_FieldGet(field,0,farrayptr=r8_3d,_RC) + local_count = shape(r8_3d) + else if (rank ==4) then + call ESMF_FieldGet(field,0,farrayptr=r8_4d,_RC) + local_count = shape(r8_4d) + else + _FAIL("Unsupported rank") + end if + else + _FAIL("Unsupported type") + end if + _RETURN(_SUCCESS) + end subroutine MAPL_FieldGetLocalElementCount + + function FieldsHaveUndef(fields,rc) result(all_have_undef) + logical :: all_have_undef + type(ESMF_Field), intent(inout) :: fields(:) + integer, optional, intent(out) :: rc + + integer :: status, i + logical :: isPresent + type(ESMF_Info) :: infoh + + all_have_undef = .true. + do i =1,size(fields) + call ESMF_InfoGetFromHost(fields(i),infoh,_RC) + isPresent = ESMF_InfoIsPresent(infoh,"missing_value",_RC) + all_have_undef = (all_have_undef .and. isPresent) + enddo + _RETURN(_SUCCESS) + end function + + subroutine GetFieldsUndef_r4(fields,undef_values,rc) + type(ESMF_Field), intent(inout) :: fields(:) + real(kind=ESMF_KIND_R4), allocatable,intent(inout) :: undef_values(:) + integer, optional, intent(out) :: rc + + integer :: status, i + logical :: isPresent + type(ESMF_Info) :: infoh + + allocate(undef_values(size(fields))) + do i =1,size(fields) + call ESMF_InfoGetFromHost(fields(i),infoh,_RC) + isPresent = ESMF_InfoIsPresent(infoh,"missing_value",_RC) + _ASSERT(isPresent,"missing undef value") + call ESMF_InfoGet(infoh,value=undef_values(i),key="missing_value",_RC) + enddo + _RETURN(_SUCCESS) + end subroutine GetFieldsUndef_r4 + + subroutine GetFieldsUndef_r8(fields,undef_values,rc) + type(ESMF_Field), intent(inout) :: fields(:) + real(kind=ESMF_KIND_R8), allocatable,intent(inout) :: undef_values(:) + integer, optional, intent(out) :: rc + + integer :: status, i + logical :: isPresent + type(ESMF_Info) :: infoh + + allocate(undef_values(size(fields))) + do i =1,size(fields) + call ESMF_InfoGetFromHost(fields(i),infoh,_RC) + isPresent = ESMF_InfoIsPresent(infoh,"missing_value",_RC) + _ASSERT(isPresent,"missing undef value") + call ESMF_InfoGet(infoh,value=undef_values(i),key="missing_value",_RC) + enddo + _RETURN(_SUCCESS) + end subroutine GetFieldsUndef_r8 subroutine Destroy(Field,RC) type(ESMF_Field), intent(INOUT) :: Field @@ -959,33 +959,33 @@ subroutine Destroy(Field,RC) call ESMF_FieldGet(Field,typekind=tk,dimCount=rank,isESMFAllocated=esmf_allocated,_RC) if (.not. esmf_allocated) then - if (tk == ESMF_TYPEKIND_R4 .and. rank == 1) then - call ESMF_FieldGet(Field,0,VR4_1d,_RC) - deallocate(VR4_1d,_STAT) - else if (tk == ESMF_TYPEKIND_R8 .and. rank == 1) then - call ESMF_FieldGet(Field,0,VR8_1d,_RC) - deallocate(VR8_1d,_STAT) - else if (tk == ESMF_TYPEKIND_R4 .and. rank == 2) then - call ESMF_FieldGet(Field,0,VR4_2d,_RC) - deallocate(VR4_2d,_STAT) - else if (tk == ESMF_TYPEKIND_R8 .and. rank == 2) then - call ESMF_FieldGet(Field,0,VR8_2d,_RC) - deallocate(VR8_2d,_STAT) - else if (tk == ESMF_TYPEKIND_R4 .and. rank == 3) then - call ESMF_FieldGet(Field,0,VR4_3D,_RC) - deallocate(VR4_3d,_STAT) - else if (tk == ESMF_TYPEKIND_R8 .and. rank == 3) then - call ESMF_FieldGet(Field,0,VR8_3D,_RC) - deallocate(VR8_3d,_STAT) - else if (tk == ESMF_TYPEKIND_R4 .and. rank == 4) then - call ESMF_FieldGet(Field,0,VR4_4D,_RC) - deallocate(VR4_3d,_STAT) - else if (tk == ESMF_TYPEKIND_R8 .and. rank == 4) then - call ESMF_FieldGet(Field,0,VR8_4D,_RC) - deallocate(VR8_3d,_STAT) - else - _FAIL( 'unsupported typekind+rank') - end if + if (tk == ESMF_TYPEKIND_R4 .and. rank == 1) then + call ESMF_FieldGet(Field,0,VR4_1d,_RC) + deallocate(VR4_1d,_STAT) + else if (tk == ESMF_TYPEKIND_R8 .and. rank == 1) then + call ESMF_FieldGet(Field,0,VR8_1d,_RC) + deallocate(VR8_1d,_STAT) + else if (tk == ESMF_TYPEKIND_R4 .and. rank == 2) then + call ESMF_FieldGet(Field,0,VR4_2d,_RC) + deallocate(VR4_2d,_STAT) + else if (tk == ESMF_TYPEKIND_R8 .and. rank == 2) then + call ESMF_FieldGet(Field,0,VR8_2d,_RC) + deallocate(VR8_2d,_STAT) + else if (tk == ESMF_TYPEKIND_R4 .and. rank == 3) then + call ESMF_FieldGet(Field,0,VR4_3D,_RC) + deallocate(VR4_3d,_STAT) + else if (tk == ESMF_TYPEKIND_R8 .and. rank == 3) then + call ESMF_FieldGet(Field,0,VR8_3D,_RC) + deallocate(VR8_3d,_STAT) + else if (tk == ESMF_TYPEKIND_R4 .and. rank == 4) then + call ESMF_FieldGet(Field,0,VR4_4D,_RC) + deallocate(VR4_3d,_STAT) + else if (tk == ESMF_TYPEKIND_R8 .and. rank == 4) then + call ESMF_FieldGet(Field,0,VR8_4D,_RC) + deallocate(VR8_3d,_STAT) + else + _FAIL( 'unsupported typekind+rank') + end if end if call ESMF_FieldDestroy(Field,noGarbage = .true., rc=status) _VERIFY(STATUS) @@ -1009,8 +1009,8 @@ function get_array_shape(f, rc) result(array_shape) call ESMF_FieldGet(f, gridToFieldMap=gridToFieldMap, _RC) call ESMF_FieldGet(f, rank=rank, _RC) allocate(localElementCount(rank)) -! Due to an ESMF bug, getting the localElementCount must use the module function. -! See FieldGetLocalElementCount (specific function) comments. + ! Due to an ESMF bug, getting the localElementCount must use the module function. + ! See FieldGetLocalElementCount (specific function) comments. localElementCount = FieldGetLocalElementCount(f, _RC) num_levels = get_num_levels(f, _RC) if(num_levels > 0) vertical_dimensions = [num_levels] From 1a94115609d394edb466700a25a81bbbb69a4e9b Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 19 Sep 2024 15:29:15 -0400 Subject: [PATCH 14/27] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 07fc37024d97..e2c6aa538886 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -36,6 +36,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added capability for HistoryCollectionGridComp to extract field names from expressions - Added ability for HistoryCollectionGridComp to extract multiple field names from expressions - Added vertical and ungridded dimensions to output for History3G +- Create rank-agnostic representation of `ESMF_Field` objects as rank-3 array pointers. ### Changed From 41dbdc8698959ef0f151fcc856ecc3edc2747ee5 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Fri, 20 Sep 2024 12:34:20 -0400 Subject: [PATCH 15/27] Changes for PR --- esmf_utils/OutputInfo.F90 | 63 +++++++++++-------- field_utils/FieldCondensedArray_private.F90 | 10 +-- .../tests/Test_FieldCondensedArray_private.pf | 20 +++--- 3 files changed, 53 insertions(+), 40 deletions(-) diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/OutputInfo.F90 index 1f7b2f2caa4c..91b9855f8f2a 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/OutputInfo.F90 @@ -45,7 +45,6 @@ module mapl3g_output_info end interface get_ungridded_dims character(len=*), parameter :: VERT_DIM_NONE = 'VERTICAL_DIM_NONE' - character(len=0), parameter :: EMPTY_STRING = '' contains @@ -95,13 +94,11 @@ integer function get_num_levels_info(info, rc) result(num) integer, optional, intent(out) :: rc integer :: status logical :: is_none - character(len=ESMF_MAXSTR) :: spec_name + character(len=:), allocatable :: spec_name - spec_name = EMPTY_STRING num = 0 spec_name = get_vertical_dim_spec_info(info, _RC) - is_none = .TRUE. - if(spec_name /= EMPTY_STRING) is_none = (VERT_DIM_NONE == spec_name) + is_none = (VERT_DIM_NONE == spec_name) if(is_none) then _RETURN(_SUCCESS) end if @@ -130,27 +127,24 @@ function get_vertical_dim_spec_names_bundle_info(info, rc) result(names) integer, optional, intent(out) :: rc integer :: status integer :: i - character(len=ESMF_MAXSTR) :: spec_name + character(len=:), allocatable :: spec_name - spec_name = EMPTY_STRING names = StringVector() do i=1, size(info) spec_name = get_vertical_dim_spec_info(info(i), _RC) - _ASSERT(spec_name /= EMPTY_STRING, 'No vertical dim spec found.') - if(find_index(names, spec_name) == 0) call names%push_back(trim(spec_name)) + if(find_index(names, spec_name) == 0) call names%push_back(spec_name) end do _RETURN(_SUCCESS) end function get_vertical_dim_spec_names_bundle_info function get_vertical_dim_spec_name_field(field, rc) result(spec_name) - character(len=ESMF_MAXSTR) :: spec_name + character(len=:), allocatable :: spec_name type(ESMF_Field), intent(in) :: field integer, optional, intent(out) :: rc integer :: status type(ESMF_Info) :: info - spec_name = EMPTY_STRING call ESMF_InfoGetFromHost(field, info, _RC) spec_name = get_vertical_dim_spec_info(info, _RC) _RETURN(_SUCCESS) @@ -158,23 +152,37 @@ function get_vertical_dim_spec_name_field(field, rc) result(spec_name) end function get_vertical_dim_spec_name_field function get_vertical_dim_spec_info(info, rc) result(spec_name) - character(len=ESMF_MAXSTR) :: spec_name + character(len=:), allocatable :: spec_name type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status logical :: isPresent character(len=ESMF_MAXSTR) :: raw - character, parameter :: error_message = 'Failed to get vertical dim spec name.' - spec_name = EMPTY_STRING isPresent = ESMF_InfoIsPresent(info, key=KEY_VLOC, _RC) - _ASSERT(isPresent, error_message) - call ESMF_InfoGet(info, key=KEY_VLOC, value=spec_name, rc=status) - _ASSERT(status==ESMF_SUCCESS, error_message) + _ASSERT(isPresent, 'Failed to get vertical dim spec name.') + call ESMF_InfoGet(info, key=KEY_VLOC, value=raw, _RC) + spec_name = trim(adjustl(tmp_name)) + _RETURN(_SUCCESS) end function get_vertical_dim_spec_info +! function get_vertical_dim_spec_info(info, rc) result(spec_name) +! character(len=ESMF_MAXSTR) :: spec_name +! type(ESMF_Info), intent(in) :: info +! integer, optional, intent(out) :: rc +! integer :: status +! logical :: isPresent +! character, parameter :: error_message = 'Failed to get vertical dim spec name.' +! +! isPresent = ESMF_InfoIsPresent(info, key=KEY_VLOC, _RC) +! _ASSERT(isPresent, error_message) +! call ESMF_InfoGet(info, key=KEY_VLOC, value=spec_name, _RC) +! _RETURN(_SUCCESS) +! +! end function get_vertical_dim_spec_info + function get_ungridded_dims_bundle(bundle, rc) result(dims) type(UngriddedDims) :: dims type(ESMF_FieldBundle), intent(in) :: bundle @@ -243,25 +251,28 @@ function make_ungridded_dim(info, n, rc) result(ungridded_dim) integer, optional, intent(out) :: rc integer :: status type(ESMF_Info) :: dim_info - character(len=ESMF_MAXSTR) :: key - character(len=ESMF_MAXSTR) :: name - character(len=ESMF_MAXSTR) :: units + character(len=ESMF_MAXSTR) :: raw + character(len=:), allocatable :: key + character(len=:), allocatable :: name + character(len=:), allocatable :: units real, allocatable :: coordinates(:) logical :: is_present character(len=1024) :: json_repr key = make_dim_key(n, _RC) - call ESMF_InfoGet(info, key=key, isPresent=is_present, _RC) + call ESMF_InfoGet(info, key=raw, isPresent=is_present, _RC) if(.not. is_present) then call ESMF_InfoPrint(info, unit=json_repr, _RC) + _FAIL('Key ' // trim(key) // ' not found in ' // trim(json_repr)) end if - _ASSERT(is_present, 'Key ' // key // ' not found in ' // trim(json_repr)) - dim_info = ESMF_InfoCreate(info, key=key, _RC) - call ESMF_InfoGet(dim_info, key=KEY_UNGRIDDED_NAME, value=name, _RC) - call ESMF_InfoGet(dim_info, key=KEY_UNGRIDDED_UNITS, value=units, _RC) + dim_info = ESMF_InfoCreate(info, key=trim(adjust(raw)), _RC) + call ESMF_InfoGet(dim_info, key=KEY_UNGRIDDED_NAME, value=raw, _RC) + name = trim(adjustl(raw)) + call ESMF_InfoGet(dim_info, key=KEY_UNGRIDDED_UNITS, value=raw, _RC) + units = trim(adjustl(raw)) call ESMF_InfoGetAlloc(dim_info, key=KEY_UNGRIDDED_COORD, values=coordinates, _RC) call ESMF_InfoDestroy(dim_info, _RC) - ungridded_dim = UngriddedDim(coordinates, name=trim(name), units=trim(units)) + ungridded_dim = UngriddedDim(coordinates, name=name, units=units) _RETURN(_SUCCESS) end function make_ungridded_dim diff --git a/field_utils/FieldCondensedArray_private.F90 b/field_utils/FieldCondensedArray_private.F90 index ff0ffe213ff0..9d483cee0450 100644 --- a/field_utils/FieldCondensedArray_private.F90 +++ b/field_utils/FieldCondensedArray_private.F90 @@ -10,9 +10,9 @@ module mapl3g_FieldCondensedArray_private contains - function get_array_shape(gridToFieldMap, localElementCount, vert_dims, rc) & - &result(array_shape) - integer :: array_shape(3) + function get_fptr_shape(gridToFieldMap, localElementCount, vert_dims, rc) & + &result(fptr_shape) + integer :: fptr_shape(3) integer, intent(in) :: gridToFieldMap(:) integer, intent(in) :: localElementCount(:) integer, optional, intent(in) :: vert_dims(:) @@ -34,9 +34,9 @@ function get_array_shape(gridToFieldMap, localElementCount, vert_dims, rc) & horz_size = product([(localElementCount(grid_dims(i)), i=1, size(grid_dims))]) vert_size = product([(localElementCount(vert_dims_(i)), i=1, size(vert_dims_))]) ungridded_size = product([(localElementCount(ungridded_dims(i)), i=1, size(ungridded_dims))]) - array_shape = [horz_size, vert_size, ungridded_size] + fptr_shape = [horz_size, vert_size, ungridded_size] _RETURN(_SUCCESS) - end function get_array_shape + end function get_fptr_shape end module mapl3g_FieldCondensedArray_private diff --git a/field_utils/tests/Test_FieldCondensedArray_private.pf b/field_utils/tests/Test_FieldCondensedArray_private.pf index e733b85e23ea..aa5b0f3d9738 100644 --- a/field_utils/tests/Test_FieldCondensedArray_private.pf +++ b/field_utils/tests/Test_FieldCondensedArray_private.pf @@ -22,7 +22,7 @@ contains vertical_dims = [3] expected = [product(localElementCount(1:2)), localElementCount(3), 1] actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) - @assertEqual(actual, expected, GENERIC_MESSAGE) + @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) end subroutine test_get_array_shape_3D @@ -36,7 +36,7 @@ contains localElementCount = [3, 5] expected = [product(localElementCount), 1, 1] actual = get_array_shape(gridToFieldMap, localElementCount) - @assertEqual(actual, expected, GENERIC_MESSAGE) + @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) end subroutine test_get_array_shape_2D @@ -52,7 +52,7 @@ contains localElementCount = [2, 3, 5, 7, 11] expected = [product(localElementCount(1:2)), localElementCount(3), product(localElementCount(4:))] actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) - @assertEqual(actual, expected, GENERIC_MESSAGE) + @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) end subroutine test_get_array_shape_general @@ -66,7 +66,7 @@ contains localElementCount = [2, 3, 5, 7] expected = [product(localElementCount(1:2)), 1, product(localElementCount(3:))] actual = get_array_shape(gridToFieldMap, localElementCount) - @assertEqual(actual, expected, GENERIC_MESSAGE) + @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) end subroutine test_get_array_shape_noz @@ -80,10 +80,11 @@ contains localElementCount = [5, 7, 11] expected = [1, 1, product(localElementCount)] actual = get_array_shape(gridToFieldMap, localElementCount) - @assertEqual(actual, expected, GENERIC_MESSAGE) + @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) end subroutine test_get_array_shape_0D + @Test subroutine test_get_array_shape_vert_only() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) @@ -95,10 +96,11 @@ contains localElementCount = vertical_dims expected = [1, localElementCount(1), 1] actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) - @assertEqual(actual, expected, GENERIC_MESSAGE) + @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) end subroutine test_get_array_shape_vert_only + @Test subroutine test_get_array_shape_vert_ungrid() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) @@ -110,7 +112,7 @@ contains localElementCount = [vertical_dims, 5, 7] expected = [1, localElementCount(1), product(localElementCount(2:))] actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) - @assertEqual(actual, expected, GENERIC_MESSAGE) + @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) end subroutine test_get_array_shape_vert_ungrid @@ -124,7 +126,7 @@ contains localElementCount = [3, 5, 7, 11] expected = [product(localElementCount(1:2)), 1, product(localElementCount(3:))] actual = get_array_shape(gridToFieldMap, localElementCount) - @assertEqual(actual, expected, GENERIC_MESSAGE) + @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) end subroutine test_get_array_shape_2D_ungrid @@ -140,7 +142,7 @@ contains vertical_dims = [3] localElementCount = [2, 3, 5, 7, 11] actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims, rc=status) - @assertExceptionRaised() + @assert_that('An exception should be raised.', status, is(equal_to(0))) end subroutine test_get_array_shape_wrong_order From 47e9f4507c3315b09dfc88866ffa79f32bae73e5 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 23 Sep 2024 10:17:59 -0400 Subject: [PATCH 16/27] Additional changes for PR --- esmf_utils/OutputInfo.F90 | 4 +- field_utils/FieldCondensedArray_private.F90 | 38 +++++--- field_utils/FieldPointerUtilities.F90 | 33 ++++--- .../tests/Test_FieldCondensedArray_private.pf | 92 +++++++++++-------- 4 files changed, 98 insertions(+), 69 deletions(-) diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/OutputInfo.F90 index 91b9855f8f2a..a89c5f332e36 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/OutputInfo.F90 @@ -162,7 +162,7 @@ function get_vertical_dim_spec_info(info, rc) result(spec_name) isPresent = ESMF_InfoIsPresent(info, key=KEY_VLOC, _RC) _ASSERT(isPresent, 'Failed to get vertical dim spec name.') call ESMF_InfoGet(info, key=KEY_VLOC, value=raw, _RC) - spec_name = trim(adjustl(tmp_name)) + spec_name = trim(adjustl(raw)) _RETURN(_SUCCESS) @@ -265,7 +265,7 @@ function make_ungridded_dim(info, n, rc) result(ungridded_dim) call ESMF_InfoPrint(info, unit=json_repr, _RC) _FAIL('Key ' // trim(key) // ' not found in ' // trim(json_repr)) end if - dim_info = ESMF_InfoCreate(info, key=trim(adjust(raw)), _RC) + dim_info = ESMF_InfoCreate(info, key=trim(adjustl(raw)), _RC) call ESMF_InfoGet(dim_info, key=KEY_UNGRIDDED_NAME, value=raw, _RC) name = trim(adjustl(raw)) call ESMF_InfoGet(dim_info, key=KEY_UNGRIDDED_UNITS, value=raw, _RC) diff --git a/field_utils/FieldCondensedArray_private.F90 b/field_utils/FieldCondensedArray_private.F90 index 9d483cee0450..a195c8cf589b 100644 --- a/field_utils/FieldCondensedArray_private.F90 +++ b/field_utils/FieldCondensedArray_private.F90 @@ -1,40 +1,54 @@ #include "MAPL_Generic.h" module mapl3g_FieldCondensedArray_private -#include "MAPL_Generic.h" use MAPL_ExceptionHandling implicit none private - public :: get_array_shape + public :: get_fptr_shape contains - function get_fptr_shape(gridToFieldMap, localElementCount, vert_dims, rc) & + function get_fptr_shape(gridToFieldMap, localElementCount, has_vertical, rc) & &result(fptr_shape) integer :: fptr_shape(3) integer, intent(in) :: gridToFieldMap(:) integer, intent(in) :: localElementCount(:) - integer, optional, intent(in) :: vert_dims(:) + logical, intent(in) :: has_vertical integer, optional, intent(out) :: rc integer :: rank, i integer, allocatable :: grid_dims(:) - integer, allocatable :: vert_dims_(:) integer, allocatable :: ungridded_dims(:) integer :: horz_size, vert_size, ungridded_size + integer :: vert_dim + vert_dim = 0 + vert_size = 1 + _HERE, 'gridToFieldMap: ', gridToFieldMap + _HERE, 'localElementCount: ', localElementCount + _HERE, 'has_vertical: ', has_vertical rank = size(localElementCount) + _HERE, 'rank: ', rank grid_dims = pack(gridToFieldMap, gridToFieldMap /= 0) - _ASSERT(all(grid_dims <= size(grid_dims)), 'MAPL expects geom dims before ungridded') - vert_dims_ = [integer::] - if (present(vert_dims)) then - if(size(vert_dims) > 0) vert_dims_ = vert_dims - end if - ungridded_dims = pack([(i,i=1,rank)], [(all([vert_dims_, grid_dims] /= i), i=1, rank)]) + _HERE, 'grid_dims: ', grid_dims + _HERE, 'size(grid_dims): ', size(grid_dims) + _HERE, 'grid_dims <= size(grid_dims): ', (grid_dims <= size(grid_dims)) + _HERE, 'all(grid_dims <= size(grid_dims)): ', all(grid_dims <= size(grid_dims)) + _ASSERT(all(grid_dims <= size(grid_dims)), 'MAPL expects geom dims before ungridded.') + _HERE + if(has_vertical) vert_dim = 1 + if(size(grid_dims) > 0) vert_dim = maxval(grid_dims) + vert_dim + ungridded_dims = pack([(i,i=1,rank)], [(all([vert_dim, grid_dims] /= i), i=1, rank)]) + _HERE, 'ungridded_dims: ', ungridded_dims horz_size = product([(localElementCount(grid_dims(i)), i=1, size(grid_dims))]) - vert_size = product([(localElementCount(vert_dims_(i)), i=1, size(vert_dims_))]) + _HERE, 'horz_size: ', horz_size + if(has_vertical) vert_size = localElementCount(vert_dim) +! vert_size = product([(localElementCount(vert_dims(i)), i=1, size(vert_dims))]) + _HERE, 'vert_size: ', vert_size ungridded_size = product([(localElementCount(ungridded_dims(i)), i=1, size(ungridded_dims))]) + _HERE, 'ungridded_size: ', ungridded_size fptr_shape = [horz_size, vert_size, ungridded_size] + _HERE, 'fptr_shape: ', fptr_shape _RETURN(_SUCCESS) end function get_fptr_shape diff --git a/field_utils/FieldPointerUtilities.F90 b/field_utils/FieldPointerUtilities.F90 index 695eaf47fc24..258a603db060 100644 --- a/field_utils/FieldPointerUtilities.F90 +++ b/field_utils/FieldPointerUtilities.F90 @@ -1,8 +1,8 @@ #include "MAPL_Generic.h" module MAPL_FieldPointerUtilities - use mapl3g_output_info, only: get_num_levels - use mapl3g_FieldCondensedArray_private, only: get_array_shape_private => get_array_shape + use mapl3g_output_info, only: get_vertical_dim_spec_name + use mapl3g_FieldCondensedArray_private, only: get_fptr_shape_private => get_fptr_shape use ESMF use MAPL_ExceptionHandling use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer, c_loc @@ -168,7 +168,7 @@ subroutine assign_fptr_r4_rank3(x, fptr, rc) integer(ESMF_KIND_I8), allocatable :: fp_shape(:) integer :: status - fp_shape = get_array_shape(x, _RC) + fp_shape = get_fptr_shape(x, _RC) call FieldGetCptr(x, cptr, _RC) call c_f_pointer(cptr, fptr, fp_shape) @@ -185,7 +185,7 @@ subroutine assign_fptr_r8_rank3(x, fptr, rc) integer(ESMF_KIND_I8), allocatable :: fp_shape(:) integer :: status - fp_shape = get_array_shape(x, _RC) + fp_shape = get_fptr_shape(x, _RC) call FieldGetCptr(x, cptr, _RC) call c_f_pointer(cptr, fptr, fp_shape) @@ -993,29 +993,32 @@ subroutine Destroy(Field,RC) end subroutine Destroy - function get_array_shape(f, rc) result(array_shape) - integer :: array_shape(3) + function get_fptr_shape(f, rc) result(fptr_shape) + integer :: fptr_shape(3) type(ESMF_Field), intent(inout) :: f integer, optional, intent(out) :: rc integer :: status + integer :: rank integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) - integer, allocatable :: vertical_dimensions(:) - integer :: num_levels - integer :: rank + logical :: has_vertical + character(len=:), allocatable :: spec_name + character(len=*), parameter :: VERTICAL_DIM_NONE_NAME = 'VERTICAL_DIM_NONE' + !wdb fixme deleteme This seems fragile. We should probably make a utility function + !that selects the type(VerticalDimSpec) parameter based on a string. Perhaps a + !logical function in VerticalDimSpec.F90 that recogizes a VerticalDimSpec based on + !the string from the ESMF_Info. - num_levels = 0 - vertical_dimensions = [integer::] call ESMF_FieldGet(f, gridToFieldMap=gridToFieldMap, _RC) call ESMF_FieldGet(f, rank=rank, _RC) allocate(localElementCount(rank)) ! Due to an ESMF bug, getting the localElementCount must use the module function. ! See FieldGetLocalElementCount (specific function) comments. localElementCount = FieldGetLocalElementCount(f, _RC) - num_levels = get_num_levels(f, _RC) - if(num_levels > 0) vertical_dimensions = [num_levels] - array_shape = get_array_shape_private(gridToFieldMap, localElementCount, vertical_dimensions, _RC) + spec_name = get_vertical_dim_spec_name(f, _RC) + has_vertical = spec_name /= VERTICAL_DIM_NONE_NAME + fptr_shape = get_fptr_shape_private(gridToFieldMap, localElementCount, has_vertical, _RC) - end function get_array_shape + end function get_fptr_shape end module MAPL_FieldPointerUtilities diff --git a/field_utils/tests/Test_FieldCondensedArray_private.pf b/field_utils/tests/Test_FieldCondensedArray_private.pf index aa5b0f3d9738..25a6eac2b60c 100644 --- a/field_utils/tests/Test_FieldCondensedArray_private.pf +++ b/field_utils/tests/Test_FieldCondensedArray_private.pf @@ -11,139 +11,151 @@ module Test_FieldCondensedArray_private contains @Test - subroutine test_get_array_shape_3D() + subroutine test_get_fptr_shape_3D() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) - integer, allocatable :: vertical_dims(:) + logical :: has_vertical + has_vertical = .TRUE. gridToFieldMap = [1, 2] localElementCount = [3, 5, 7] - vertical_dims = [3] expected = [product(localElementCount(1:2)), localElementCount(3), 1] - actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) + actual = get_fptr_shape(gridToFieldMap, localElementCount, has_vertical) @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) - end subroutine test_get_array_shape_3D + end subroutine test_get_fptr_shape_3D @Test - subroutine test_get_array_shape_2D() + subroutine test_get_fptr_shape_2D() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) + logical :: has_vertical + has_vertical = .FALSE. gridToFieldMap = [1, 2] localElementCount = [3, 5] expected = [product(localElementCount), 1, 1] - actual = get_array_shape(gridToFieldMap, localElementCount) + actual = get_fptr_shape(gridToFieldMap, localElementCount, has_vertical) @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) - end subroutine test_get_array_shape_2D + end subroutine test_get_fptr_shape_2D @Test - subroutine test_get_array_shape_general() + subroutine test_get_fptr_shape_general() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) - integer, allocatable :: vertical_dims(:) + logical :: has_vertical + has_vertical = .TRUE. gridToFieldMap = [1, 2] - vertical_dims = [3] localElementCount = [2, 3, 5, 7, 11] expected = [product(localElementCount(1:2)), localElementCount(3), product(localElementCount(4:))] - actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) + actual = get_fptr_shape(gridToFieldMap, localElementCount, has_vertical) @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) - end subroutine test_get_array_shape_general + end subroutine test_get_fptr_shape_general @Test - subroutine test_get_array_shape_noz() + subroutine test_get_fptr_shape_noz() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) + logical :: has_vertical + + has_vertical = .FALSE. gridToFieldMap = [1, 2] localElementCount = [2, 3, 5, 7] expected = [product(localElementCount(1:2)), 1, product(localElementCount(3:))] - actual = get_array_shape(gridToFieldMap, localElementCount) + actual = get_fptr_shape(gridToFieldMap, localElementCount, has_vertical) @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) - end subroutine test_get_array_shape_noz + end subroutine test_get_fptr_shape_noz @Test - subroutine test_get_array_shape_0D() + subroutine test_get_fptr_shape_0D() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) + logical :: has_vertical + has_vertical = .FALSE. gridToFieldMap = [0, 0] localElementCount = [5, 7, 11] expected = [1, 1, product(localElementCount)] - actual = get_array_shape(gridToFieldMap, localElementCount) + actual = get_fptr_shape(gridToFieldMap, localElementCount, has_vertical) @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) - end subroutine test_get_array_shape_0D + end subroutine test_get_fptr_shape_0D @Test - subroutine test_get_array_shape_vert_only() + subroutine test_get_fptr_shape_vert_only() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) - integer, allocatable :: vertical_dims(:) + logical :: has_vertical + has_vertical = .TRUE. gridToFieldMap = [0, 0] - vertical_dims = [3] - localElementCount = vertical_dims + localElementCount = [3] expected = [1, localElementCount(1), 1] - actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) + actual = get_fptr_shape(gridToFieldMap, localElementCount, has_vertical) @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) - end subroutine test_get_array_shape_vert_only + end subroutine test_get_fptr_shape_vert_only @Test - subroutine test_get_array_shape_vert_ungrid() + subroutine test_get_fptr_shape_vert_ungrid() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) - integer, allocatable :: vertical_dims(:) + logical :: has_vertical gridToFieldMap = [0, 0] - vertical_dims = [3] - localElementCount = [vertical_dims, 5, 7] + has_vertical = .TRUE. + localElementCount = [3, 5, 7] expected = [1, localElementCount(1), product(localElementCount(2:))] - actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims) + actual = get_fptr_shape(gridToFieldMap, localElementCount, has_vertical) @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) - end subroutine test_get_array_shape_vert_ungrid + end subroutine test_get_fptr_shape_vert_ungrid @Test - subroutine test_get_array_shape_2D_ungrid() + subroutine test_get_fptr_shape_2D_ungrid() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) + logical :: has_vertical + has_vertical = .FALSE. gridToFieldMap = [1, 2] localElementCount = [3, 5, 7, 11] expected = [product(localElementCount(1:2)), 1, product(localElementCount(3:))] - actual = get_array_shape(gridToFieldMap, localElementCount) + actual = get_fptr_shape(gridToFieldMap, localElementCount, has_vertical) @assert_that(GENERIC_MESSAGE, actual, is(equal_to(expected))) - end subroutine test_get_array_shape_2D_ungrid + end subroutine test_get_fptr_shape_2D_ungrid @Test - subroutine test_get_array_shape_wrong_order() + subroutine test_get_fptr_shape_wrong_order() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) - integer, allocatable :: vertical_dims(:) + logical :: has_vertical integer :: status gridToFieldMap = [4, 5] - vertical_dims = [3] + has_vertical = .TRUE. localElementCount = [2, 3, 5, 7, 11] - actual = get_array_shape(gridToFieldMap, localElementCount, vertical_dims, rc=status) - @assert_that('An exception should be raised.', status, is(equal_to(0))) + expected = [product(localElementCount(4:5)), localElementCount(3), product(localElementCount(1:2))] + ! This tests throws an Exception for improper input arguments. + ! In other words, the improper input arguments ARE the point. + actual = get_fptr_shape(gridToFieldMap, localElementCount, has_vertical, rc=status) + @assertFalse(status == 0, 'An exception should be raised.') - end subroutine test_get_array_shape_wrong_order + end subroutine test_get_fptr_shape_wrong_order end module Test_FieldCondensedArray_private From 3c0a4a7b2414f6a712a524a799b811184b53c243 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 23 Sep 2024 11:48:44 -0400 Subject: [PATCH 17/27] Rm comments and _HERE lines. Move assign_fptr. --- field_utils/CMakeLists.txt | 1 + field_utils/FieldCondensedArray.F90 | 82 ++++++++++++ field_utils/FieldCondensedArray_private.F90 | 18 +-- field_utils/FieldPointerUtilities.F90 | 131 ++++++++++---------- 4 files changed, 150 insertions(+), 82 deletions(-) create mode 100644 field_utils/FieldCondensedArray.F90 diff --git a/field_utils/CMakeLists.txt b/field_utils/CMakeLists.txt index 2edfc20b9fd3..fec2a17ccc3e 100644 --- a/field_utils/CMakeLists.txt +++ b/field_utils/CMakeLists.txt @@ -8,6 +8,7 @@ set(srcs FieldUnaryFunctions.F90 FieldBinaryOperations.F90 FieldUnits.F90 + FieldCondensedArray.F90 FieldCondensedArray_private.F90 ) diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 new file mode 100644 index 000000000000..e9722da20fe2 --- /dev/null +++ b/field_utils/FieldCondensedArray.F90 @@ -0,0 +1,82 @@ +#include "MAPL_Generic.h" +module mapl3g_FieldCondensedArray + use mapl3g_FieldCondensedArray_private, only: get_fptr_private => get_fptr_shape + use mapl3g_output_info, only: get_vertical_dim_spec_name + use MAPL_FieldPointerUtilities, only: FieldGetLocalElementCount, FieldGetCptr + use MAPL_ExceptionHandling + use ESMF, only: ESMF_Field, ESMF_KIND_R4, ESMF_KIND_R8 + + implicit none + private + public :: assign_fptr_rank3 + + interface assign_fptr_rank3 + module procedure :: assign_fptr_r4_rank3 + module procedure :: assign_fptr_r8_rank3 + end interface assign_fptr_rank3 + +contains + + subroutine assign_fptr_r4_rank3(x, fptr, rc) + type(ESMF_Field), intent(inout) :: x + real(kind=ESMF_KIND_R4), pointer, intent(out) :: fptr(:,:,:) + integer, optional, intent(out) :: rc + + ! local declarations + type(c_ptr) :: cptr + integer(ESMF_KIND_I8), allocatable :: fp_shape(:,:,:) + integer :: status + + fp_shape = get_fptr_shape(x, _RC) + call FieldGetCptr(x, cptr, _RC) + call c_f_pointer(cptr, fptr, fp_shape) + + _RETURN(_SUCCESS) + end subroutine assign_fptr_r4_rank3 + + subroutine assign_fptr_r8_rank3(x, fptr, rc) + type(ESMF_Field), intent(inout) :: x + real(kind=ESMF_KIND_R8), pointer, intent(out) :: fptr(:,:,:) + integer, optional, intent(out) :: rc + + ! local declarations + type(c_ptr) :: cptr + integer(ESMF_KIND_I8), allocatable :: fp_shape(:,:,:) + integer :: status + + fp_shape = get_fptr_shape(x, _RC) + call FieldGetCptr(x, cptr, _RC) + call c_f_pointer(cptr, fptr, fp_shape) + + _RETURN(_SUCCESS) + end subroutine assign_fptr_r8_rank3 + + function get_fptr_shape(f, rc) result(fptr_shape) + integer :: fptr_shape(3) + type(ESMF_Field), intent(inout) :: f + integer, optional, intent(out) :: rc + integer :: status + integer :: rank + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: localElementCount(:) + logical :: has_vertical + character(len=:), allocatable :: spec_name + character(len=*), parameter :: VERTICAL_DIM_NONE_NAME = 'VERTICAL_DIM_NONE' + !wdb fixme deleteme This seems fragile. We should probably make a utility function + !that selects the type(VerticalDimSpec) parameter based on a string. Perhaps a + !logical function in VerticalDimSpec.F90 that recogizes a VerticalDimSpec based on + !the string from the ESMF_Info. + + call ESMF_FieldGet(f, gridToFieldMap=gridToFieldMap, _RC) + call ESMF_FieldGet(f, rank=rank, _RC) + allocate(localElementCount(rank)) + ! Due to an ESMF bug, getting the localElementCount must use the module function. + ! See FieldGetLocalElementCount (specific function) comments. + localElementCount = FieldGetLocalElementCount(f, _RC) + spec_name = get_vertical_dim_spec_name(f, _RC) + has_vertical = spec_name /= VERTICAL_DIM_NONE_NAME + fptr_shape = get_fptr_shape_private(gridToFieldMap, localElementCount, has_vertical, _RC) + + end function get_fptr_shape + +end module mapl3g_FieldCondensedArray diff --git a/field_utils/FieldCondensedArray_private.F90 b/field_utils/FieldCondensedArray_private.F90 index a195c8cf589b..7d5c2ddf85cb 100644 --- a/field_utils/FieldCondensedArray_private.F90 +++ b/field_utils/FieldCondensedArray_private.F90 @@ -5,7 +5,7 @@ module mapl3g_FieldCondensedArray_private implicit none private - public :: get_fptr_shape + public :: get_fptr_shape, only: FieldGetLocalElementCount contains @@ -24,31 +24,17 @@ function get_fptr_shape(gridToFieldMap, localElementCount, has_vertical, rc) & vert_dim = 0 vert_size = 1 - _HERE, 'gridToFieldMap: ', gridToFieldMap - _HERE, 'localElementCount: ', localElementCount - _HERE, 'has_vertical: ', has_vertical + rank = size(localElementCount) - _HERE, 'rank: ', rank grid_dims = pack(gridToFieldMap, gridToFieldMap /= 0) - _HERE, 'grid_dims: ', grid_dims - _HERE, 'size(grid_dims): ', size(grid_dims) - _HERE, 'grid_dims <= size(grid_dims): ', (grid_dims <= size(grid_dims)) - _HERE, 'all(grid_dims <= size(grid_dims)): ', all(grid_dims <= size(grid_dims)) _ASSERT(all(grid_dims <= size(grid_dims)), 'MAPL expects geom dims before ungridded.') - _HERE if(has_vertical) vert_dim = 1 if(size(grid_dims) > 0) vert_dim = maxval(grid_dims) + vert_dim ungridded_dims = pack([(i,i=1,rank)], [(all([vert_dim, grid_dims] /= i), i=1, rank)]) - _HERE, 'ungridded_dims: ', ungridded_dims horz_size = product([(localElementCount(grid_dims(i)), i=1, size(grid_dims))]) - _HERE, 'horz_size: ', horz_size if(has_vertical) vert_size = localElementCount(vert_dim) -! vert_size = product([(localElementCount(vert_dims(i)), i=1, size(vert_dims))]) - _HERE, 'vert_size: ', vert_size ungridded_size = product([(localElementCount(ungridded_dims(i)), i=1, size(ungridded_dims))]) - _HERE, 'ungridded_size: ', ungridded_size fptr_shape = [horz_size, vert_size, ungridded_size] - _HERE, 'fptr_shape: ', fptr_shape _RETURN(_SUCCESS) end function get_fptr_shape diff --git a/field_utils/FieldPointerUtilities.F90 b/field_utils/FieldPointerUtilities.F90 index 258a603db060..c04d52f6142e 100644 --- a/field_utils/FieldPointerUtilities.F90 +++ b/field_utils/FieldPointerUtilities.F90 @@ -1,8 +1,7 @@ #include "MAPL_Generic.h" module MAPL_FieldPointerUtilities - use mapl3g_output_info, only: get_vertical_dim_spec_name - use mapl3g_FieldCondensedArray_private, only: get_fptr_shape_private => get_fptr_shape +! use mapl3g_output_info, only: get_vertical_dim_spec_name use ESMF use MAPL_ExceptionHandling use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer, c_loc @@ -36,10 +35,10 @@ module MAPL_FieldPointerUtilities module procedure assign_fptr_r8_rank2 end interface assign_fptr - interface assign_fptr_rank3 - module procedure :: assign_fptr_r4_rank3 - module procedure :: assign_fptr_r8_rank3 - end interface assign_fptr_rank3 +! interface assign_fptr_rank3 +! module procedure :: assign_fptr_r4_rank3 +! module procedure :: assign_fptr_r8_rank3 +! end interface assign_fptr_rank3 interface FieldGetCptr procedure get_cptr @@ -158,39 +157,39 @@ subroutine assign_fptr_r8_rank2(x, fp_shape, fptr, rc) _RETURN(_SUCCESS) end subroutine assign_fptr_r8_rank2 - subroutine assign_fptr_r4_rank3(x, fptr, rc) - type(ESMF_Field), intent(inout) :: x - real(kind=ESMF_KIND_R4), pointer, intent(out) :: fptr(:) - integer, optional, intent(out) :: rc - - ! local declarations - type(c_ptr) :: cptr - integer(ESMF_KIND_I8), allocatable :: fp_shape(:) - integer :: status - - fp_shape = get_fptr_shape(x, _RC) - call FieldGetCptr(x, cptr, _RC) - call c_f_pointer(cptr, fptr, fp_shape) - - _RETURN(_SUCCESS) - end subroutine assign_fptr_r4_rank3 - - subroutine assign_fptr_r8_rank3(x, fptr, rc) - type(ESMF_Field), intent(inout) :: x - real(kind=ESMF_KIND_R8), pointer, intent(out) :: fptr(:) - integer, optional, intent(out) :: rc - - ! local declarations - type(c_ptr) :: cptr - integer(ESMF_KIND_I8), allocatable :: fp_shape(:) - integer :: status - - fp_shape = get_fptr_shape(x, _RC) - call FieldGetCptr(x, cptr, _RC) - call c_f_pointer(cptr, fptr, fp_shape) - - _RETURN(_SUCCESS) - end subroutine assign_fptr_r8_rank3 +! subroutine assign_fptr_r4_rank3(x, fptr, rc) +! type(ESMF_Field), intent(inout) :: x +! real(kind=ESMF_KIND_R4), pointer, intent(out) :: fptr(:) +! integer, optional, intent(out) :: rc +! +! ! local declarations +! type(c_ptr) :: cptr +! integer(ESMF_KIND_I8), allocatable :: fp_shape(:) +! integer :: status +! +! fp_shape = get_fptr_shape(x, _RC) +! call FieldGetCptr(x, cptr, _RC) +! call c_f_pointer(cptr, fptr, fp_shape) +! +! _RETURN(_SUCCESS) +! end subroutine assign_fptr_r4_rank3 +! +! subroutine assign_fptr_r8_rank3(x, fptr, rc) +! type(ESMF_Field), intent(inout) :: x +! real(kind=ESMF_KIND_R8), pointer, intent(out) :: fptr(:) +! integer, optional, intent(out) :: rc +! +! ! local declarations +! type(c_ptr) :: cptr +! integer(ESMF_KIND_I8), allocatable :: fp_shape(:) +! integer :: status +! +! fp_shape = get_fptr_shape(x, _RC) +! call FieldGetCptr(x, cptr, _RC) +! call c_f_pointer(cptr, fptr, fp_shape) +! +! _RETURN(_SUCCESS) +! end subroutine assign_fptr_r8_rank3 subroutine get_cptr(x, cptr, rc) type(ESMF_Field), intent(inout) :: x @@ -993,32 +992,32 @@ subroutine Destroy(Field,RC) end subroutine Destroy - function get_fptr_shape(f, rc) result(fptr_shape) - integer :: fptr_shape(3) - type(ESMF_Field), intent(inout) :: f - integer, optional, intent(out) :: rc - integer :: status - integer :: rank - integer, allocatable :: gridToFieldMap(:) - integer, allocatable :: localElementCount(:) - logical :: has_vertical - character(len=:), allocatable :: spec_name - character(len=*), parameter :: VERTICAL_DIM_NONE_NAME = 'VERTICAL_DIM_NONE' - !wdb fixme deleteme This seems fragile. We should probably make a utility function - !that selects the type(VerticalDimSpec) parameter based on a string. Perhaps a - !logical function in VerticalDimSpec.F90 that recogizes a VerticalDimSpec based on - !the string from the ESMF_Info. - - call ESMF_FieldGet(f, gridToFieldMap=gridToFieldMap, _RC) - call ESMF_FieldGet(f, rank=rank, _RC) - allocate(localElementCount(rank)) - ! Due to an ESMF bug, getting the localElementCount must use the module function. - ! See FieldGetLocalElementCount (specific function) comments. - localElementCount = FieldGetLocalElementCount(f, _RC) - spec_name = get_vertical_dim_spec_name(f, _RC) - has_vertical = spec_name /= VERTICAL_DIM_NONE_NAME - fptr_shape = get_fptr_shape_private(gridToFieldMap, localElementCount, has_vertical, _RC) - - end function get_fptr_shape +! function get_fptr_shape(f, rc) result(fptr_shape) +! integer :: fptr_shape(3) +! type(ESMF_Field), intent(inout) :: f +! integer, optional, intent(out) :: rc +! integer :: status +! integer :: rank +! integer, allocatable :: gridToFieldMap(:) +! integer, allocatable :: localElementCount(:) +! logical :: has_vertical +! character(len=:), allocatable :: spec_name +! character(len=*), parameter :: VERTICAL_DIM_NONE_NAME = 'VERTICAL_DIM_NONE' +! !wdb fixme deleteme This seems fragile. We should probably make a utility function +! !that selects the type(VerticalDimSpec) parameter based on a string. Perhaps a +! !logical function in VerticalDimSpec.F90 that recogizes a VerticalDimSpec based on +! !the string from the ESMF_Info. +! +! call ESMF_FieldGet(f, gridToFieldMap=gridToFieldMap, _RC) +! call ESMF_FieldGet(f, rank=rank, _RC) +! allocate(localElementCount(rank)) +! ! Due to an ESMF bug, getting the localElementCount must use the module function. +! ! See FieldGetLocalElementCount (specific function) comments. +! localElementCount = FieldGetLocalElementCount(f, _RC) +! spec_name = get_vertical_dim_spec_name(f, _RC) +! has_vertical = spec_name /= VERTICAL_DIM_NONE_NAME +! fptr_shape = get_fptr_shape_private(gridToFieldMap, localElementCount, has_vertical, _RC) +! +! end function get_fptr_shape end module MAPL_FieldPointerUtilities From 5d1e3ebf55933076841e35719c021be317e3c46f Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 23 Sep 2024 12:32:31 -0400 Subject: [PATCH 18/27] Latest changes. All existing tests pass. --- esmf_utils/OutputInfo.F90 | 15 ---- field_utils/FieldCondensedArray.F90 | 38 +++++------ field_utils/FieldCondensedArray_private.F90 | 2 +- field_utils/FieldPointerUtilities.F90 | 68 ------------------- .../tests/Test_FieldCondensedArray_private.pf | 6 +- 5 files changed, 22 insertions(+), 107 deletions(-) diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/OutputInfo.F90 index a89c5f332e36..821d407be60b 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/OutputInfo.F90 @@ -168,21 +168,6 @@ function get_vertical_dim_spec_info(info, rc) result(spec_name) end function get_vertical_dim_spec_info -! function get_vertical_dim_spec_info(info, rc) result(spec_name) -! character(len=ESMF_MAXSTR) :: spec_name -! type(ESMF_Info), intent(in) :: info -! integer, optional, intent(out) :: rc -! integer :: status -! logical :: isPresent -! character, parameter :: error_message = 'Failed to get vertical dim spec name.' -! -! isPresent = ESMF_InfoIsPresent(info, key=KEY_VLOC, _RC) -! _ASSERT(isPresent, error_message) -! call ESMF_InfoGet(info, key=KEY_VLOC, value=spec_name, _RC) -! _RETURN(_SUCCESS) -! -! end function get_vertical_dim_spec_info - function get_ungridded_dims_bundle(bundle, rc) result(dims) type(UngriddedDims) :: dims type(ESMF_FieldBundle), intent(in) :: bundle diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 index e9722da20fe2..4929fac6ddc7 100644 --- a/field_utils/FieldCondensedArray.F90 +++ b/field_utils/FieldCondensedArray.F90 @@ -1,55 +1,53 @@ #include "MAPL_Generic.h" module mapl3g_FieldCondensedArray - use mapl3g_FieldCondensedArray_private, only: get_fptr_private => get_fptr_shape + use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer + use mapl3g_FieldCondensedArray_private, only: get_shape => get_fptr_shape use mapl3g_output_info, only: get_vertical_dim_spec_name use MAPL_FieldPointerUtilities, only: FieldGetLocalElementCount, FieldGetCptr use MAPL_ExceptionHandling - use ESMF, only: ESMF_Field, ESMF_KIND_R4, ESMF_KIND_R8 + use ESMF, only: ESMF_Field, ESMF_FieldGet + use ESMF, only: ESMF_KIND_R4, ESMF_KIND_R8, ESMF_KIND_I8 implicit none private - public :: assign_fptr_rank3 + public :: assign_fptr_condensed_array - interface assign_fptr_rank3 - module procedure :: assign_fptr_r4_rank3 - module procedure :: assign_fptr_r8_rank3 - end interface assign_fptr_rank3 + interface assign_fptr_condensed_array + module procedure :: assign_fptr_condensed_array_r4 + module procedure :: assign_fptr_condensed_array_r8 + end interface assign_fptr_condensed_array contains - subroutine assign_fptr_r4_rank3(x, fptr, rc) + subroutine assign_fptr_condensed_array_r4(x, fptr, rc) type(ESMF_Field), intent(inout) :: x real(kind=ESMF_KIND_R4), 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) :: fp_shape(3) integer :: status fp_shape = get_fptr_shape(x, _RC) call FieldGetCptr(x, cptr, _RC) call c_f_pointer(cptr, fptr, fp_shape) - _RETURN(_SUCCESS) - end subroutine assign_fptr_r4_rank3 - subroutine assign_fptr_r8_rank3(x, fptr, rc) + end subroutine assign_fptr_condensed_array_r4 + + subroutine assign_fptr_condensed_array_r8(x, fptr, rc) type(ESMF_Field), intent(inout) :: x real(kind=ESMF_KIND_R8), 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) :: fp_shape(3) integer :: status fp_shape = get_fptr_shape(x, _RC) call FieldGetCptr(x, cptr, _RC) call c_f_pointer(cptr, fptr, fp_shape) - _RETURN(_SUCCESS) - end subroutine assign_fptr_r8_rank3 + + end subroutine assign_fptr_condensed_array_r8 function get_fptr_shape(f, rc) result(fptr_shape) integer :: fptr_shape(3) @@ -75,7 +73,7 @@ function get_fptr_shape(f, rc) result(fptr_shape) localElementCount = FieldGetLocalElementCount(f, _RC) spec_name = get_vertical_dim_spec_name(f, _RC) has_vertical = spec_name /= VERTICAL_DIM_NONE_NAME - fptr_shape = get_fptr_shape_private(gridToFieldMap, localElementCount, has_vertical, _RC) + fptr_shape = get_shape(gridToFieldMap, localElementCount, has_vertical, _RC) end function get_fptr_shape diff --git a/field_utils/FieldCondensedArray_private.F90 b/field_utils/FieldCondensedArray_private.F90 index 7d5c2ddf85cb..b7634578ab1f 100644 --- a/field_utils/FieldCondensedArray_private.F90 +++ b/field_utils/FieldCondensedArray_private.F90 @@ -5,7 +5,7 @@ module mapl3g_FieldCondensedArray_private implicit none private - public :: get_fptr_shape, only: FieldGetLocalElementCount + public :: get_fptr_shape contains diff --git a/field_utils/FieldPointerUtilities.F90 b/field_utils/FieldPointerUtilities.F90 index c04d52f6142e..88d22aaab252 100644 --- a/field_utils/FieldPointerUtilities.F90 +++ b/field_utils/FieldPointerUtilities.F90 @@ -11,7 +11,6 @@ module MAPL_FieldPointerUtilities public :: FieldsHaveUndef public :: GetFieldsUndef public :: assign_fptr - public :: assign_fptr_rank3 public :: FieldGetLocalElementCount public :: FieldGetLocalSize public :: FieldGetCptr @@ -35,11 +34,6 @@ module MAPL_FieldPointerUtilities module procedure assign_fptr_r8_rank2 end interface assign_fptr -! interface assign_fptr_rank3 -! module procedure :: assign_fptr_r4_rank3 -! module procedure :: assign_fptr_r8_rank3 -! end interface assign_fptr_rank3 - interface FieldGetCptr procedure get_cptr end interface @@ -157,40 +151,6 @@ subroutine assign_fptr_r8_rank2(x, fp_shape, fptr, rc) _RETURN(_SUCCESS) end subroutine assign_fptr_r8_rank2 -! subroutine assign_fptr_r4_rank3(x, fptr, rc) -! type(ESMF_Field), intent(inout) :: x -! real(kind=ESMF_KIND_R4), pointer, intent(out) :: fptr(:) -! integer, optional, intent(out) :: rc -! -! ! local declarations -! type(c_ptr) :: cptr -! integer(ESMF_KIND_I8), allocatable :: fp_shape(:) -! integer :: status -! -! fp_shape = get_fptr_shape(x, _RC) -! call FieldGetCptr(x, cptr, _RC) -! call c_f_pointer(cptr, fptr, fp_shape) -! -! _RETURN(_SUCCESS) -! end subroutine assign_fptr_r4_rank3 -! -! subroutine assign_fptr_r8_rank3(x, fptr, rc) -! type(ESMF_Field), intent(inout) :: x -! real(kind=ESMF_KIND_R8), pointer, intent(out) :: fptr(:) -! integer, optional, intent(out) :: rc -! -! ! local declarations -! type(c_ptr) :: cptr -! integer(ESMF_KIND_I8), allocatable :: fp_shape(:) -! integer :: status -! -! fp_shape = get_fptr_shape(x, _RC) -! call FieldGetCptr(x, cptr, _RC) -! call c_f_pointer(cptr, fptr, fp_shape) -! -! _RETURN(_SUCCESS) -! end subroutine assign_fptr_r8_rank3 - subroutine get_cptr(x, cptr, rc) type(ESMF_Field), intent(inout) :: x type(c_ptr), intent(out) :: cptr @@ -992,32 +952,4 @@ subroutine Destroy(Field,RC) end subroutine Destroy -! function get_fptr_shape(f, rc) result(fptr_shape) -! integer :: fptr_shape(3) -! type(ESMF_Field), intent(inout) :: f -! integer, optional, intent(out) :: rc -! integer :: status -! integer :: rank -! integer, allocatable :: gridToFieldMap(:) -! integer, allocatable :: localElementCount(:) -! logical :: has_vertical -! character(len=:), allocatable :: spec_name -! character(len=*), parameter :: VERTICAL_DIM_NONE_NAME = 'VERTICAL_DIM_NONE' -! !wdb fixme deleteme This seems fragile. We should probably make a utility function -! !that selects the type(VerticalDimSpec) parameter based on a string. Perhaps a -! !logical function in VerticalDimSpec.F90 that recogizes a VerticalDimSpec based on -! !the string from the ESMF_Info. -! -! call ESMF_FieldGet(f, gridToFieldMap=gridToFieldMap, _RC) -! call ESMF_FieldGet(f, rank=rank, _RC) -! allocate(localElementCount(rank)) -! ! Due to an ESMF bug, getting the localElementCount must use the module function. -! ! See FieldGetLocalElementCount (specific function) comments. -! localElementCount = FieldGetLocalElementCount(f, _RC) -! spec_name = get_vertical_dim_spec_name(f, _RC) -! has_vertical = spec_name /= VERTICAL_DIM_NONE_NAME -! fptr_shape = get_fptr_shape_private(gridToFieldMap, localElementCount, has_vertical, _RC) -! -! end function get_fptr_shape - end module MAPL_FieldPointerUtilities diff --git a/field_utils/tests/Test_FieldCondensedArray_private.pf b/field_utils/tests/Test_FieldCondensedArray_private.pf index 25a6eac2b60c..bc1d1336a4ee 100644 --- a/field_utils/tests/Test_FieldCondensedArray_private.pf +++ b/field_utils/tests/Test_FieldCondensedArray_private.pf @@ -140,7 +140,7 @@ contains end subroutine test_get_fptr_shape_2D_ungrid @Test - subroutine test_get_fptr_shape_wrong_order() + subroutine test_get_fptr_shape_wrong_order_raise_exception() integer :: expected(3), actual(3) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) @@ -154,8 +154,8 @@ contains ! This tests throws an Exception for improper input arguments. ! In other words, the improper input arguments ARE the point. actual = get_fptr_shape(gridToFieldMap, localElementCount, has_vertical, rc=status) - @assertFalse(status == 0, 'An exception should be raised.') + @assertExceptionRaised() - end subroutine test_get_fptr_shape_wrong_order + end subroutine test_get_fptr_shape_wrong_order_raise_exception end module Test_FieldCondensedArray_private From dc1d7370a7f47af210f5b4b606aedaa009a4d896 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 23 Sep 2024 12:50:24 -0400 Subject: [PATCH 19/27] Use integer parameter for condensed array rank. --- field_utils/FieldCondensedArray.F90 | 8 ++++---- field_utils/FieldCondensedArray_private.F90 | 6 ++++-- .../tests/Test_FieldCondensedArray_private.pf | 18 +++++++++--------- 3 files changed, 17 insertions(+), 15 deletions(-) diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 index 4929fac6ddc7..f5320e07004f 100644 --- a/field_utils/FieldCondensedArray.F90 +++ b/field_utils/FieldCondensedArray.F90 @@ -1,7 +1,7 @@ #include "MAPL_Generic.h" module mapl3g_FieldCondensedArray use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer - use mapl3g_FieldCondensedArray_private, only: get_shape => get_fptr_shape + use mapl3g_FieldCondensedArray_private, only: ARRAY_RANK, get_shape => get_fptr_shape use mapl3g_output_info, only: get_vertical_dim_spec_name use MAPL_FieldPointerUtilities, only: FieldGetLocalElementCount, FieldGetCptr use MAPL_ExceptionHandling @@ -24,7 +24,7 @@ subroutine assign_fptr_condensed_array_r4(x, fptr, rc) real(kind=ESMF_KIND_R4), pointer, intent(out) :: fptr(:,:,:) integer, optional, intent(out) :: rc type(c_ptr) :: cptr - integer(ESMF_KIND_I8) :: fp_shape(3) + integer(ESMF_KIND_I8) :: fp_shape(ARRAY_RANK) integer :: status fp_shape = get_fptr_shape(x, _RC) @@ -39,7 +39,7 @@ subroutine assign_fptr_condensed_array_r8(x, fptr, rc) real(kind=ESMF_KIND_R8), pointer, intent(out) :: fptr(:,:,:) integer, optional, intent(out) :: rc type(c_ptr) :: cptr - integer(ESMF_KIND_I8) :: fp_shape(3) + integer(ESMF_KIND_I8) :: fp_shape(ARRAY_RANK) integer :: status fp_shape = get_fptr_shape(x, _RC) @@ -50,7 +50,7 @@ subroutine assign_fptr_condensed_array_r8(x, fptr, rc) end subroutine assign_fptr_condensed_array_r8 function get_fptr_shape(f, rc) result(fptr_shape) - integer :: fptr_shape(3) + integer :: fptr_shape(ARRAY_RANK) type(ESMF_Field), intent(inout) :: f integer, optional, intent(out) :: rc integer :: status diff --git a/field_utils/FieldCondensedArray_private.F90 b/field_utils/FieldCondensedArray_private.F90 index b7634578ab1f..acc6db269038 100644 --- a/field_utils/FieldCondensedArray_private.F90 +++ b/field_utils/FieldCondensedArray_private.F90 @@ -5,13 +5,15 @@ module mapl3g_FieldCondensedArray_private implicit none private - public :: get_fptr_shape + public :: get_fptr_shape, ARRAY_RANK + + integer, parameter :: ARRAY_RANK = 3 contains function get_fptr_shape(gridToFieldMap, localElementCount, has_vertical, rc) & &result(fptr_shape) - integer :: fptr_shape(3) + integer :: fptr_shape(ARRAY_RANK) integer, intent(in) :: gridToFieldMap(:) integer, intent(in) :: localElementCount(:) logical, intent(in) :: has_vertical diff --git a/field_utils/tests/Test_FieldCondensedArray_private.pf b/field_utils/tests/Test_FieldCondensedArray_private.pf index bc1d1336a4ee..76078952d61f 100644 --- a/field_utils/tests/Test_FieldCondensedArray_private.pf +++ b/field_utils/tests/Test_FieldCondensedArray_private.pf @@ -12,7 +12,7 @@ contains @Test subroutine test_get_fptr_shape_3D() - integer :: expected(3), actual(3) + integer :: expected(ARRAY_RANK), actual(ARRAY_RANK) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) logical :: has_vertical @@ -28,7 +28,7 @@ contains @Test subroutine test_get_fptr_shape_2D() - integer :: expected(3), actual(3) + integer :: expected(ARRAY_RANK), actual(ARRAY_RANK) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) logical :: has_vertical @@ -44,7 +44,7 @@ contains @Test subroutine test_get_fptr_shape_general() - integer :: expected(3), actual(3) + integer :: expected(ARRAY_RANK), actual(ARRAY_RANK) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) logical :: has_vertical @@ -60,7 +60,7 @@ contains @Test subroutine test_get_fptr_shape_noz() - integer :: expected(3), actual(3) + integer :: expected(ARRAY_RANK), actual(ARRAY_RANK) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) logical :: has_vertical @@ -77,7 +77,7 @@ contains @Test subroutine test_get_fptr_shape_0D() - integer :: expected(3), actual(3) + integer :: expected(ARRAY_RANK), actual(ARRAY_RANK) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) logical :: has_vertical @@ -93,7 +93,7 @@ contains @Test subroutine test_get_fptr_shape_vert_only() - integer :: expected(3), actual(3) + integer :: expected(ARRAY_RANK), actual(ARRAY_RANK) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) logical :: has_vertical @@ -109,7 +109,7 @@ contains @Test subroutine test_get_fptr_shape_vert_ungrid() - integer :: expected(3), actual(3) + integer :: expected(ARRAY_RANK), actual(ARRAY_RANK) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) logical :: has_vertical @@ -125,7 +125,7 @@ contains @Test subroutine test_get_fptr_shape_2D_ungrid() - integer :: expected(3), actual(3) + integer :: expected(ARRAY_RANK), actual(ARRAY_RANK) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) logical :: has_vertical @@ -141,7 +141,7 @@ contains @Test subroutine test_get_fptr_shape_wrong_order_raise_exception() - integer :: expected(3), actual(3) + integer :: expected(ARRAY_RANK), actual(ARRAY_RANK) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) logical :: has_vertical From 16d1c074978c0a0b1ed5e28da6fa57d7d133a8ea Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 23 Sep 2024 13:16:44 -0400 Subject: [PATCH 20/27] Eliminate unnecessary local variable, is_none. --- esmf_utils/OutputInfo.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/OutputInfo.F90 index 821d407be60b..efef06485286 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/OutputInfo.F90 @@ -93,13 +93,11 @@ integer function get_num_levels_info(info, rc) result(num) type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status - logical :: is_none character(len=:), allocatable :: spec_name num = 0 spec_name = get_vertical_dim_spec_info(info, _RC) - is_none = (VERT_DIM_NONE == spec_name) - if(is_none) then + if(spec_name==VERT_DIM_NONE) then _RETURN(_SUCCESS) end if From 55e73c137478b06c2545440dd3ea25567bd839f9 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 23 Sep 2024 13:26:03 -0400 Subject: [PATCH 21/27] Simplify value check. --- esmf_utils/OutputInfo.F90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/OutputInfo.F90 index efef06485286..752a63979d06 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/OutputInfo.F90 @@ -97,10 +97,7 @@ integer function get_num_levels_info(info, rc) result(num) num = 0 spec_name = get_vertical_dim_spec_info(info, _RC) - if(spec_name==VERT_DIM_NONE) then - _RETURN(_SUCCESS) - end if - + _RETURN_IF(spec_name == VERT_DIM_NONE) call ESMF_InfoGet(info, key=KEY_NUM_LEVELS, value=num, _RC) _RETURN(_SUCCESS) From 5eac8a29192c4c322c2130b92dce6fcb56df30cc Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 23 Sep 2024 18:23:19 -0400 Subject: [PATCH 22/27] Refactor CondensedArrya; rename OutputInfo --- GeomIO/SharedIO.F90 | 2 +- esmf_utils/CMakeLists.txt | 2 +- ...{OutputInfo.F90 => FieldDimensionInfo.F90} | 4 +- field_utils/FieldCondensedArray.F90 | 9 ++--- field_utils/FieldPointerUtilities.F90 | 38 ++++++++++++++++++- generic3g/Generic3g.F90 | 2 +- .../HistoryCollectionGridComp_private.F90 | 4 +- gridcomps/History3G/tests/Test_OutputInfo.pf | 2 +- 8 files changed, 48 insertions(+), 15 deletions(-) rename esmf_utils/{OutputInfo.F90 => FieldDimensionInfo.F90} (99%) diff --git a/GeomIO/SharedIO.F90 b/GeomIO/SharedIO.F90 index e2d75441a8d1..77c1774d93f0 100644 --- a/GeomIO/SharedIO.F90 +++ b/GeomIO/SharedIO.F90 @@ -8,7 +8,7 @@ module mapl3g_SharedIO use MAPL_BaseMod use mapl3g_UngriddedDims use mapl3g_UngriddedDim - use mapl3g_output_info + use mapl3g_FieldDimensionInfo implicit none diff --git a/esmf_utils/CMakeLists.txt b/esmf_utils/CMakeLists.txt index 7f30cb8500fb..f686fdcd5e0d 100644 --- a/esmf_utils/CMakeLists.txt +++ b/esmf_utils/CMakeLists.txt @@ -1,7 +1,7 @@ esma_set_this (OVERRIDE MAPL.esmf_utils) set(srcs - OutputInfo.F90 + FieldDimensionInfo.F90 UngriddedDim.F90 UngriddedDims.F90 UngriddedDimVector.F90 diff --git a/esmf_utils/OutputInfo.F90 b/esmf_utils/FieldDimensionInfo.F90 similarity index 99% rename from esmf_utils/OutputInfo.F90 rename to esmf_utils/FieldDimensionInfo.F90 index 752a63979d06..7b775fbf9f63 100644 --- a/esmf_utils/OutputInfo.F90 +++ b/esmf_utils/FieldDimensionInfo.F90 @@ -1,5 +1,5 @@ #include "MAPL_Generic.h" -module mapl3g_output_info +module mapl3g_FieldDimensionInfo use mapl3g_UngriddedDim use mapl3g_UngriddedDimVector @@ -342,4 +342,4 @@ subroutine destroy_bundle_info(bundle_info, rc) end subroutine destroy_bundle_info -end module mapl3g_output_info +end module mapl3g_FieldDimensionInfo diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 index f5320e07004f..a90a8e4cf8c3 100644 --- a/field_utils/FieldCondensedArray.F90 +++ b/field_utils/FieldCondensedArray.F90 @@ -2,7 +2,7 @@ module mapl3g_FieldCondensedArray use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer use mapl3g_FieldCondensedArray_private, only: ARRAY_RANK, get_shape => get_fptr_shape - use mapl3g_output_info, only: get_vertical_dim_spec_name + use mapl3g_FieldDimensionInfo, only: get_vertical_dim_spec_name use MAPL_FieldPointerUtilities, only: FieldGetLocalElementCount, FieldGetCptr use MAPL_ExceptionHandling use ESMF, only: ESMF_Field, ESMF_FieldGet @@ -23,13 +23,11 @@ subroutine assign_fptr_condensed_array_r4(x, fptr, rc) type(ESMF_Field), intent(inout) :: x real(kind=ESMF_KIND_R4), pointer, intent(out) :: fptr(:,:,:) integer, optional, intent(out) :: rc - type(c_ptr) :: cptr integer(ESMF_KIND_I8) :: fp_shape(ARRAY_RANK) integer :: status fp_shape = get_fptr_shape(x, _RC) - call FieldGetCptr(x, cptr, _RC) - call c_f_pointer(cptr, fptr, fp_shape) + call assign_fptr(x, fp_shape, fptr, _RC) _RETURN(_SUCCESS) end subroutine assign_fptr_condensed_array_r4 @@ -43,8 +41,7 @@ subroutine assign_fptr_condensed_array_r8(x, fptr, rc) integer :: status fp_shape = get_fptr_shape(x, _RC) - call FieldGetCptr(x, cptr, _RC) - call c_f_pointer(cptr, fptr, fp_shape) + call assign_fptr(x, fp_shape, fptr, _RC) _RETURN(_SUCCESS) end subroutine assign_fptr_condensed_array_r8 diff --git a/field_utils/FieldPointerUtilities.F90 b/field_utils/FieldPointerUtilities.F90 index 88d22aaab252..43ef278a0b33 100644 --- a/field_utils/FieldPointerUtilities.F90 +++ b/field_utils/FieldPointerUtilities.F90 @@ -1,7 +1,6 @@ #include "MAPL_Generic.h" module MAPL_FieldPointerUtilities -! use mapl3g_output_info, only: get_vertical_dim_spec_name use ESMF use MAPL_ExceptionHandling use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer, c_loc @@ -79,6 +78,7 @@ module MAPL_FieldPointerUtilities interface MAPL_FieldDestroy procedure destroy end interface + contains subroutine assign_fptr_r4_rank1(x, fptr, rc) @@ -129,6 +129,7 @@ subroutine assign_fptr_r4_rank2(x, fp_shape, fptr, rc) type(c_ptr) :: cptr integer :: status + _ASSERT(size(fp_shape) == rank(fptr), 'Shape size must match pointer rank.') call FieldGetCptr(x, cptr, _RC) call c_f_pointer(cptr, fptr, fp_shape) @@ -145,12 +146,47 @@ subroutine assign_fptr_r8_rank2(x, fp_shape, fptr, rc) type(c_ptr) :: cptr integer :: status + _ASSERT(size(fp_shape) == rank(fptr), 'Shape size must match pointer rank.') call FieldGetCptr(x, cptr, _RC) call c_f_pointer(cptr, fptr, fp_shape) _RETURN(_SUCCESS) end subroutine assign_fptr_r8_rank2 + subroutine assign_fptr_r4_rank3(x, fp_shape, fptr, rc) + type(ESMF_Field), intent(inout) :: x + integer(ESMF_KIND_I8), intent(in) :: fp_shape(:) + real(kind=ESMF_KIND_R4), pointer, intent(out) :: fptr(:,:,:) + integer, optional, intent(out) :: rc + + ! local declarations + type(c_ptr) :: cptr + integer :: status + + _ASSERT(size(fp_shape) == rank(fptr), 'Shape size must match pointer rank.') + call FieldGetCptr(x, cptr, _RC) + call c_f_pointer(cptr, fptr, fp_shape) + + _RETURN(_SUCCESS) + end subroutine assign_fptr_r4_rank3 + + subroutine assign_fptr_r8_rank3(x, fp_shape, fptr, rc) + type(ESMF_Field), intent(inout) :: x + integer(ESMF_KIND_I8), intent(in) :: fp_shape(:) + real(kind=ESMF_KIND_R8), pointer, intent(out) :: fptr(:,:,:) + integer, optional, intent(out) :: rc + + ! local declarations + type(c_ptr) :: cptr + integer :: status + + _ASSERT(size(fp_shape) == rank(fptr), 'Shape size must match pointer rank.') + call FieldGetCptr(x, cptr, _RC) + call c_f_pointer(cptr, fptr, fp_shape) + + _RETURN(_SUCCESS) + end subroutine assign_fptr_r8_rank3 + subroutine get_cptr(x, cptr, rc) type(ESMF_Field), intent(inout) :: x type(c_ptr), intent(out) :: cptr diff --git a/generic3g/Generic3g.F90 b/generic3g/Generic3g.F90 index 46fa1f9f5482..79527a2934ef 100644 --- a/generic3g/Generic3g.F90 +++ b/generic3g/Generic3g.F90 @@ -10,5 +10,5 @@ module Generic3g use mapl3g_GriddedComponentDriver use mapl3g_UserSetServices use mapl3g_ESMF_HConfigUtilities, only: MAPL_HConfigMatch - use mapl3g_output_info + use mapl3g_FieldDimensionInfo end module Generic3g diff --git a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 index 25d89ff53079..90177190e2b5 100644 --- a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 +++ b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 @@ -10,8 +10,8 @@ module mapl3g_HistoryCollectionGridComp_private use MAPL_NewArthParserMod, only: parser_variables_in_expression use MAPL_TimeStringConversion use MAPL_BaseMod, only: MAPL_UnpackTime - use mapl3g_output_info, only: get_num_levels, get_vertical_dim_spec_names - use mapl3g_output_info, only: get_vertical_dim_spec_name, get_ungridded_dims + use mapl3g_FieldDimensionInfo, only: get_num_levels, get_vertical_dim_spec_names + use mapl3g_FieldDimensionInfo, only: get_vertical_dim_spec_name, get_ungridded_dims use mapl3g_UngriddedDims use gFTL2_StringSet diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_OutputInfo.pf index 3e8ca30b8fcc..a68de77feff2 100644 --- a/gridcomps/History3G/tests/Test_OutputInfo.pf +++ b/gridcomps/History3G/tests/Test_OutputInfo.pf @@ -6,7 +6,7 @@ #define _FAILURE _SUCCESS-1 #include "MAPL_TestErr.h" module Test_OutputInfo - use mapl3g_output_info + use mapl3g_FieldDimensionInfo use mapl3g_esmf_info_keys use mapl3g_UngriddedDim use mapl3g_UngriddedDimVector From d14cabb28c222164730f4a416380e2b735fd27ba Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 23 Sep 2024 23:16:59 -0400 Subject: [PATCH 23/27] Fix Test_FieldDimensionInfo bug introduced with allocatable string --- esmf_utils/FieldDimensionInfo.F90 | 4 ++-- field_utils/FieldCondensedArray.F90 | 3 +-- field_utils/FieldPointerUtilities.F90 | 2 ++ gridcomps/History3G/tests/CMakeLists.txt | 2 +- .../tests/{Test_OutputInfo.pf => Test_FieldDimensionInfo.pf} | 4 ++-- 5 files changed, 8 insertions(+), 7 deletions(-) rename gridcomps/History3G/tests/{Test_OutputInfo.pf => Test_FieldDimensionInfo.pf} (99%) diff --git a/esmf_utils/FieldDimensionInfo.F90 b/esmf_utils/FieldDimensionInfo.F90 index 7b775fbf9f63..941005341b34 100644 --- a/esmf_utils/FieldDimensionInfo.F90 +++ b/esmf_utils/FieldDimensionInfo.F90 @@ -240,12 +240,12 @@ function make_ungridded_dim(info, n, rc) result(ungridded_dim) character(len=1024) :: json_repr key = make_dim_key(n, _RC) - call ESMF_InfoGet(info, key=raw, isPresent=is_present, _RC) + call ESMF_InfoGet(info, key=key, isPresent=is_present, _RC) if(.not. is_present) then call ESMF_InfoPrint(info, unit=json_repr, _RC) _FAIL('Key ' // trim(key) // ' not found in ' // trim(json_repr)) end if - dim_info = ESMF_InfoCreate(info, key=trim(adjustl(raw)), _RC) + dim_info = ESMF_InfoCreate(info, key=key, _RC) call ESMF_InfoGet(dim_info, key=KEY_UNGRIDDED_NAME, value=raw, _RC) name = trim(adjustl(raw)) call ESMF_InfoGet(dim_info, key=KEY_UNGRIDDED_UNITS, value=raw, _RC) diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 index a90a8e4cf8c3..7bedabe4185a 100644 --- a/field_utils/FieldCondensedArray.F90 +++ b/field_utils/FieldCondensedArray.F90 @@ -3,7 +3,7 @@ module mapl3g_FieldCondensedArray use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer use mapl3g_FieldCondensedArray_private, only: ARRAY_RANK, get_shape => get_fptr_shape use mapl3g_FieldDimensionInfo, only: get_vertical_dim_spec_name - use MAPL_FieldPointerUtilities, only: FieldGetLocalElementCount, FieldGetCptr + use MAPL_FieldPointerUtilities, only: FieldGetLocalElementCount, assign_fptr use MAPL_ExceptionHandling use ESMF, only: ESMF_Field, ESMF_FieldGet use ESMF, only: ESMF_KIND_R4, ESMF_KIND_R8, ESMF_KIND_I8 @@ -36,7 +36,6 @@ subroutine assign_fptr_condensed_array_r8(x, fptr, rc) type(ESMF_Field), intent(inout) :: x real(kind=ESMF_KIND_R8), pointer, intent(out) :: fptr(:,:,:) integer, optional, intent(out) :: rc - type(c_ptr) :: cptr integer(ESMF_KIND_I8) :: fp_shape(ARRAY_RANK) integer :: status diff --git a/field_utils/FieldPointerUtilities.F90 b/field_utils/FieldPointerUtilities.F90 index 43ef278a0b33..238b8ba24f9b 100644 --- a/field_utils/FieldPointerUtilities.F90 +++ b/field_utils/FieldPointerUtilities.F90 @@ -31,6 +31,8 @@ module MAPL_FieldPointerUtilities module procedure assign_fptr_r8_rank1 module procedure assign_fptr_r4_rank2 module procedure assign_fptr_r8_rank2 + module procedure assign_fptr_r4_rank3 + module procedure assign_fptr_r8_rank3 end interface assign_fptr interface FieldGetCptr diff --git a/gridcomps/History3G/tests/CMakeLists.txt b/gridcomps/History3G/tests/CMakeLists.txt index 431cdc92d582..4e566e711bde 100644 --- a/gridcomps/History3G/tests/CMakeLists.txt +++ b/gridcomps/History3G/tests/CMakeLists.txt @@ -3,7 +3,7 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.history3g.tests") set (test_srcs Test_HistoryGridComp.pf Test_HistoryCollectionGridComp.pf - Test_OutputInfo.pf + Test_FieldDimensionInfo.pf ) add_pfunit_ctest(MAPL.history3g.tests diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_FieldDimensionInfo.pf similarity index 99% rename from gridcomps/History3G/tests/Test_OutputInfo.pf rename to gridcomps/History3G/tests/Test_FieldDimensionInfo.pf index a68de77feff2..64e43b569e47 100644 --- a/gridcomps/History3G/tests/Test_OutputInfo.pf +++ b/gridcomps/History3G/tests/Test_FieldDimensionInfo.pf @@ -5,7 +5,7 @@ #define _SUCCESS 0 #define _FAILURE _SUCCESS-1 #include "MAPL_TestErr.h" -module Test_OutputInfo +module Test_FieldDimensionInfo use mapl3g_FieldDimensionInfo use mapl3g_esmf_info_keys use mapl3g_UngriddedDim @@ -250,4 +250,4 @@ contains if(allocated(info)) call deallocate_destroy(info) end subroutine safe_dealloc -end module Test_OutputInfo +end module Test_FieldDimensionInfo From 7380305f0030038bbc2261231290db926a4c7069 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 24 Sep 2024 11:02:01 -0400 Subject: [PATCH 24/27] All tests pass. --- esmf_utils/CMakeLists.txt | 3 +++ esmf_utils/tests/CMakeLists.txt | 25 +++++++++++++++++++ .../tests/Test_FieldDimensionInfo.pf | 2 -- gridcomps/History3G/tests/CMakeLists.txt | 1 - 4 files changed, 28 insertions(+), 3 deletions(-) create mode 100644 esmf_utils/tests/CMakeLists.txt rename {gridcomps/History3G => esmf_utils}/tests/Test_FieldDimensionInfo.pf (98%) diff --git a/esmf_utils/CMakeLists.txt b/esmf_utils/CMakeLists.txt index f686fdcd5e0d..cac517d58aed 100644 --- a/esmf_utils/CMakeLists.txt +++ b/esmf_utils/CMakeLists.txt @@ -19,3 +19,6 @@ target_include_directories (${this} PUBLIC $) target_link_libraries (${this} PUBLIC ESMF::ESMF) +if (PFUNIT_FOUND) + add_subdirectory(tests) +endif () diff --git a/esmf_utils/tests/CMakeLists.txt b/esmf_utils/tests/CMakeLists.txt new file mode 100644 index 000000000000..4dbe5299ae66 --- /dev/null +++ b/esmf_utils/tests/CMakeLists.txt @@ -0,0 +1,25 @@ +set(MODULE_DIRECTORY "${esma_include}/MAPL.esmf_utils.tests") + +set (test_srcs + Test_FieldDimensionInfo.pf + ) + +add_pfunit_ctest(MAPL.esmf_utils.tests + TEST_SOURCES ${test_srcs} + LINK_LIBRARIES MAPL.esmf_utils MAPL.pfunit + EXTRA_INITIALIZE Initialize + EXTRA_USE MAPL_pFUnit_Initialize + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + MAX_PES 1 + ) +set_target_properties(MAPL.esmf_utils.tests PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) +set_tests_properties(MAPL.esmf_utils.tests PROPERTIES LABELS "ESSENTIAL") + +if (APPLE) + set(LD_PATH "DYLD_LIBRARY_PATH") +else() + set(LD_PATH "LD_LIBRARY_PATH") +endif () +set_property(TEST MAPL.esmf_utils.tests PROPERTY ENVIRONMENT "${LD_PATH}=${CMAKE_CURRENT_BINARY_DIR}/esmf_utils:$ENV{${LD_PATH}}") + +add_dependencies(build-tests MAPL.esmf_utils.tests) diff --git a/gridcomps/History3G/tests/Test_FieldDimensionInfo.pf b/esmf_utils/tests/Test_FieldDimensionInfo.pf similarity index 98% rename from gridcomps/History3G/tests/Test_FieldDimensionInfo.pf rename to esmf_utils/tests/Test_FieldDimensionInfo.pf index 64e43b569e47..54110565fac2 100644 --- a/gridcomps/History3G/tests/Test_FieldDimensionInfo.pf +++ b/esmf_utils/tests/Test_FieldDimensionInfo.pf @@ -16,10 +16,8 @@ module Test_FieldDimensionInfo implicit none - integer, parameter :: NUM_FIELDS_DEFAULT = 2 integer, parameter :: NUM_LEVELS_DEFAULT = 3 character(len=*), parameter :: VLOC_DEFAULT = 'VERTICAL_DIM_CENTER' - integer, parameter :: NUM_UNGRIDDED_DEFAULT = 3 character(len=*), parameter :: NAME_DEFAULT = 'A1' character(len=*), parameter :: UNITS_DEFAULT = 'stones' real, parameter :: COORDINATES_DEFAULT(*) = [2.0, 2.4, 2.5] diff --git a/gridcomps/History3G/tests/CMakeLists.txt b/gridcomps/History3G/tests/CMakeLists.txt index 4e566e711bde..1a298effd79c 100644 --- a/gridcomps/History3G/tests/CMakeLists.txt +++ b/gridcomps/History3G/tests/CMakeLists.txt @@ -3,7 +3,6 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.history3g.tests") set (test_srcs Test_HistoryGridComp.pf Test_HistoryCollectionGridComp.pf - Test_FieldDimensionInfo.pf ) add_pfunit_ctest(MAPL.history3g.tests From 62d20586208928718abc9687cd4d4497109961bd Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 24 Sep 2024 11:06:38 -0400 Subject: [PATCH 25/27] Rm commented out line. --- esmf_utils/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/esmf_utils/CMakeLists.txt b/esmf_utils/CMakeLists.txt index cac517d58aed..fdb11f971418 100644 --- a/esmf_utils/CMakeLists.txt +++ b/esmf_utils/CMakeLists.txt @@ -13,7 +13,6 @@ esma_add_library(${this} DEPENDENCIES MAPL.shared TYPE SHARED ) - # DEPENDENCIES MAPL.shared MAPL.base target_include_directories (${this} PUBLIC $) From 5b1cc70596a73d07229aba93ded78c8eb655e910 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 24 Sep 2024 11:08:03 -0400 Subject: [PATCH 26/27] Rm commented out line. --- base/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index a947db4d3ec8..8da90b1e4cb4 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -56,7 +56,6 @@ set (srcs MAPL_XYGridFactory.F90 MAPL_NetCDF.F90 Plain_netCDF_Time.F90 MAPL_DateTime_Parsing_ESMF.F90 MAPL_ObsUtil.F90 - #MAPL_ESMF_InfoKeys.F90 # Orphaned program: should not be in this library. # tstqsat.F90 ) From b0cea01e9ca06ad09b8c6b47a063ac412fbe79a8 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 24 Sep 2024 12:29:48 -0400 Subject: [PATCH 27/27] Rm comment. --- field_utils/FieldCondensedArray.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/field_utils/FieldCondensedArray.F90 b/field_utils/FieldCondensedArray.F90 index 7bedabe4185a..7d59ab717017 100644 --- a/field_utils/FieldCondensedArray.F90 +++ b/field_utils/FieldCondensedArray.F90 @@ -56,10 +56,6 @@ function get_fptr_shape(f, rc) result(fptr_shape) logical :: has_vertical character(len=:), allocatable :: spec_name character(len=*), parameter :: VERTICAL_DIM_NONE_NAME = 'VERTICAL_DIM_NONE' - !wdb fixme deleteme This seems fragile. We should probably make a utility function - !that selects the type(VerticalDimSpec) parameter based on a string. Perhaps a - !logical function in VerticalDimSpec.F90 that recogizes a VerticalDimSpec based on - !the string from the ESMF_Info. call ESMF_FieldGet(f, gridToFieldMap=gridToFieldMap, _RC) call ESMF_FieldGet(f, rank=rank, _RC)