From 444d0408c309e63783b0993e913c5c0654795b1f Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 7 May 2024 11:44:37 -0400 Subject: [PATCH 01/23] Procedure to get output info from fields --- .../HistoryCollectionGridComp_private.F90 | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 index c8a7e6af90e2..0929542a9bb9 100644 --- a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 +++ b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 @@ -178,6 +178,24 @@ function set_start_stop_time(clock, hconfig, rc) result(start_stop_time) _RETURN(_SUCCESS) end function set_start_stop_time + function get_output_bundle_info(bundle, rc) result(info) + type(OutputBundleInfoSet) :: info + type(ESMF_FieldBundle) :: bundle + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Field) :: field_list(:), this_field + integer :: i + type(ESMF_GeomType_Flag) :: geomtype + + call ESMF_FieldBundleGet(bundle, fieldList=field_list, _RC) + do i = 1:size(fieldList) + this_field = fieldList(i) + call ESMF_FieldGet(this_field, geomtype=geomtype, _RC) + + end do + + end function get_output_bundle_info + subroutine parse_item_expression(item, item_name, var_names, rc) type(ESMF_HConfigIter), intent(in) :: item character(len=:), allocatable, intent(out) :: item_name From 57cd1823a5308d1f7e15e1522147c65ace88c18f Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 9 May 2024 11:49:50 -0400 Subject: [PATCH 02/23] Add OutputInfoSet for History Collection output --- .../HistoryCollectionGridComp_private.F90 | 22 ++- gridcomps/History3G/OutputInfo.F90 | 105 +++++++++++ gridcomps/History3G/OutputInfoSet.F90 | 16 ++ gridcomps/History3G/UngriddedInfo.F90 | 173 ++++++++++++++++++ 4 files changed, 310 insertions(+), 6 deletions(-) create mode 100644 gridcomps/History3G/OutputInfo.F90 create mode 100644 gridcomps/History3G/OutputInfoSet.F90 create mode 100644 gridcomps/History3G/UngriddedInfo.F90 diff --git a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 index 0929542a9bb9..f7ba2ed15542 100644 --- a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 +++ b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 @@ -10,6 +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_OutputInfo + use mapl3g_OutputInfoSet implicit none private @@ -19,6 +21,8 @@ module mapl3g_HistoryCollectionGridComp_private public :: create_output_bundle public :: create_output_alarm public :: set_start_stop_time + public :: get_output_bundle_info + ! These are public for testing. public :: parse_item_common public :: replace_delimiter @@ -61,7 +65,10 @@ subroutine register_imports(gridcomp, hconfig, rc) type(StringVector) :: variable_names integer :: status - var_list = ESMF_HConfigCreateAt(hconfig, keystring=VAR_LIST_KEY, _RC) + var_list = ESMF_HConfigCreateAt(hconfig, keystring=VAR_LIST_KEY, rc=status) + if(status==ESMF_RC_NOT_FOUND) _FAIL(VAR_LIST_KEY // ' was not found.') + _VERIFY(status==_SUCCESS) + iter_begin = ESMF_HConfigIterBegin(var_list,_RC) iter_end = ESMF_HConfigIterEnd(var_list,_RC) iter = iter_begin @@ -178,20 +185,23 @@ function set_start_stop_time(clock, hconfig, rc) result(start_stop_time) _RETURN(_SUCCESS) end function set_start_stop_time - function get_output_bundle_info(bundle, rc) result(info) - type(OutputBundleInfoSet) :: info + function get_output_bundle_info(bundle, rc) result(output_info) + type(OutputBundleInfoSet) :: output_info type(ESMF_FieldBundle) :: bundle integer, optional, intent(out) :: rc integer :: status type(ESMF_Field) :: field_list(:), this_field integer :: i - type(ESMF_GeomType_Flag) :: geomtype + type(OutputBundleInfo) :: item + logical :: is_new + type(ESMF_Info) :: info call ESMF_FieldBundleGet(bundle, fieldList=field_list, _RC) do i = 1:size(fieldList) this_field = fieldList(i) - call ESMF_FieldGet(this_field, geomtype=geomtype, _RC) - + call ESMF_InfoGetFromHost(field, info, _RC) + item = OutputBundleInfo(info, _RC) + call output_info%insert(item, is_new=is_new, _RC) end do end function get_output_bundle_info diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 new file mode 100644 index 000000000000..b6d10a50df42 --- /dev/null +++ b/gridcomps/History3G/OutputInfo.F90 @@ -0,0 +1,105 @@ +module mapl3g_OutputInfo + + use mapl3g_ungridded_dim_info + use esmf, only: ESMF_InfoGet + + implicit none + private + + public :: OutputInfo + public :: operator(<) + public :: operator(==) + + type :: OutputInfo + integer :: num_levels + character(len=:), allocatable :: vloc + type(UngriddedDimInfo) :: ungridded_dims(:) + contains + module procedure :: num_ungridded + end type OutputInfo + + interface OutputInfo + module procedure :: construct_object + end interface OutputInfo + + interface operator(<) + module procedure :: less + end interface operator(<) + + interface operator(==) + module procedure :: equal + end interface operator(==) + + interface operator(/=) + module procedure :: not_equal + end interface operator(/=) + + character(len=*), parameter :: PREFIX = 'MAPL/' + +contains + + function construct_object(info_in, rc) result(obj) + type(OutputInfo) :: obj + type(ESMF_Info), intent(in) :: info_in + integer, optional, intent(out) :: rc + integer :: status + integer :: num_levels, num_ungridded + character(len=:), allocatable :: vloc + + call ESMF_InfoGet(info_in, key=PREFIX // 'num_levels', num_levels, _RC) + call ESMF_InfoGet(info_in, key=PREFIX // 'vloc', vloc, _RC) + call ESMF_InfoGet(info_in, key=PREFIX // 'num_ungridded', num_ungridded, _RC) + + obj%num_levels = num_levels + obj%vloc = vloc + obj%ungridded_dims = UngriddedDimsInfo(info_in, _RC) + _ASSERT(size(obj%ungridded_dims) == num_ungridded, 'Size of ungridded_dims does not match num_ungridded info.') + + _RETURN(_SUCCESS) + + end function construct_object + + integer function num_ungridded(this) + class(OutputInfo), intent(in) :: this + + num_ungridded = size(this%ungridded_dims) + + end function num_ungridded + + logical function less(a, b) result(t) + class(OutputInfo), intent(in) :: a, b + integer :: i + logical, allocatable :: lt(:), gt(:) + + t = a%num_levels < b%num_levels + if(t .or. a%num_levels > b%num_levels) return + t = a%vloc < b%vloc + if(t .or. a%vloc > b%vloc) return + t = a%num_ungridded() < b%num_ungridded() + if(t .or. a%num_ungridded() > b%num_ungridded()) return + lt = a%ungridded_dims < b%ungridded_dims + gt = a%ungridded_dims > b%ungridded_dims + do i= 1, a%num_ungridded + t = lt(i) + if(t .or. gt(i)) return + end do + + end function less + + logical function not_equal(a, b) result(t) + class(OutputInfo), intent(in) :: a, b + + t = .not (a == b) + + end function not_equal + + logical function equal(a, b) result(t) + class(OutputInfo), intent(in) :: a, b + + t = .not. (a /= b) + t = a%num_levels == b%num_levels .and. a%vloc == b%vloc .and. & + a%num_ungridded() == b%num_ungridded() .and. all(a%ungridded_dims == b%UngriddedDimInfo) + + end function equal + +end module mapl3g_OutputInfo diff --git a/gridcomps/History3G/OutputInfoSet.F90 b/gridcomps/History3G/OutputInfoSet.F90 new file mode 100644 index 000000000000..41d40ed61555 --- /dev/null +++ b/gridcomps/History3G/OutputInfoSet.F90 @@ -0,0 +1,16 @@ +module mapl3g_OutputInfoSet_mod + use mapl3g_OutputInfo + +#define T OutputInfo +#define T_LT(A, B) (A) < (B) +#define Set OutputInfoSet +#define SetIterator OutputInfoSetIterator + +#include "set/template.inc" + +#undef T +#undef T_LT +#undef Set +#undef SetIterator + +end module mapl3g_OutputInfoSet_mod diff --git a/gridcomps/History3G/UngriddedInfo.F90 b/gridcomps/History3G/UngriddedInfo.F90 new file mode 100644 index 000000000000..1025a836d5a8 --- /dev/null +++ b/gridcomps/History3G/UngriddedInfo.F90 @@ -0,0 +1,173 @@ +module mapl3g_ungridded_dim_info + + use esmf, only: ESMF_InfoGet + + implicit none + private + + public :: UngriddedDimInfo + public :: UngriddedDimsInfo + public :: operator(<) + public :: operator(==) + + type :: UngriddedDimInfo + character(len=:), allocatable :: name + character(len=:), allocatable :: units + real :: coordinates(:) + contains + procedure, private :: name_units + procedure, private :: size + end type UngriddedDimInfo + + interface UngriddedDimInfo + module procedure :: construct + end interface UngriddedDimInfo + + interface UngriddedDimsInfo + module procedure :: get_array + end interface UngriddedDimsInfo + + interface operator(<) + module procedure :: less + end interface operator(<) + + interface operator(==) + module procedure :: equal + end interface operator(==) + + interface operator(.chlt.) + module procedure :: name_units_less + end interface operator(.chlt.) + + interface operator(.cheq.) + module procedure :: name_units_equal + end interface operator(.cheq.) + + interface operator(.rlt.) + module procedure :: coordinates_less + end interface operator(.rlt.) + + interface operator(.req.) + module procedure :: coordinates_equal + end interface operator(.req.) + +contains + + function construct(info_in, unit_prefix, rc) result(obj) + type(UngriddedDimInfo) :: obj + type(ESMF_Info), intent(in) :: info_in + character(len=*), intent(in) :: unit_prefix + integer, optional, intent(out) :: rc + integer :: status + character(len=:), allocatable :: vloc + character(len=:), allocatable :: name + character(len=:), allocatable :: units + real :: coordinates(:) + + call ESMF_InfoGet(info_in, key=unit_prefix//'name', name, _RC) + call ESMF_InfoGet(info_in, key=unit_prefix//'units', units, _RC) + call ESMF_InfoGet(info_in, key=unit_prefix//'coordinates', coordinates, _RC) + obj%name = name + obj%units = units + obj%coordinates = coordinates + + _RETURN(_SUCCESS) + end function construct + + function name_units(this) result(nu) + character(len=:), allocatable :: nu + class(UngriddedDimInfo), intent(in) :: this + + nu = this%name // this%units + + end function name_units + + integer function size(this) + class(UngriddedDimInfo), intent(in) :: this + + size = size(a%coordinates) + + end function size + + function get_array(info_in, rc) result(array) + type(UngriddedDimInfo), allocatable = array(:) + type(ESMF_Info), intent(in) :: info_in + integer, optional, intent(out) :: rc + character(len=*), parameter :: PREFIX = 'MAPL/' + integer :: status + integer :: num_ungridded + integer :: i, ios + character(len=32) :: stri + + call ESMF_InfoGet(info_in, key=PREFIX // 'num_ungridded', num_ungridded, _RC) + _ASSERT(num_ungridded >= 0, 'num_ungridded must be nonnegative.') + allocate(array(num_ungridded)) + if(num_ungridded == 0) then + _RETURN(_SUCCESS) + end if + do i= 1, num_ungridded + write(stri, fmt='(I0)', iostat=ios) i + _ASSERT(ios == 0, 'failed to create ith ungridded dim index string') + array(i) = UngriddedDimInfo(info_in, PREFIX // 'dims_' // trim(adjustl(stri)) // '/') + end do + + _RETURN(_SUCCESS) + + end function get_array + + logical function equal(a, b) result(t) + class(UngriddedDimInfo), intent(in) :: a, b + + t = (a .cheq. b) .and. (a .req. b) + + end function equal + + logical function less(a, b) result(t) + class(UngriddedDimInfo), intent(in) :: a, b + + t = a .chlt. b + if(t .or. (b .chlt. a)) return + t = a .rlt. b + + end function less + + logical function name_units_equal(a, b) result(t) + class(UngriddedDimInfo), intent(in) :: a, b + + t = a%name_units() == b%name_units() + + end function name_units_equal + + logical function name_units_less(a, b) result(t) + class(UngriddedDimInfo), intent(in) :: a, b + + t = a%name_units() < b%name_units() + + end function name_units_less + + logical function coordinates_equal(a, b) result(t) + class(UngriddedDimInfo), intent(in) :: a, b + + t = a%size() == b%size() + if(t) t = all(a%coordinates == b%coordinates) + + end function coordinates_equal + + logical function coordinates_less(a, b) result(t) + class(UngriddedDimInfo), intent(in) :: a, b + logical, allocatable :: lt(:), gt(:) + integer :: i, n + + n = a%size() + t = n < b%size() + if(t .or. n > b%size()) return + lt = a%coordinates < b%coordinates + gt = a%coordinates > b%coordinates + do i=1, n + t = lt(i) + if(t .or. gt(i)) return + end do + + end function coordinates_less + +end module mapl3g_ungridded_dim_info From d38b34b9f5bf4568b29f857e42028cfb60fb57cd Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 14 May 2024 10:19:22 -0400 Subject: [PATCH 03/23] Test_OutputInfo.pf & Test_UngriddedDimInfo.pf pass --- gridcomps/History3G/CMakeLists.txt | 5 +- .../HistoryCollectionGridComp_private.F90 | 34 +-- gridcomps/History3G/OutputInfo.F90 | 74 ++++--- gridcomps/History3G/OutputInfoSet.F90 | 6 +- ...UngriddedInfo.F90 => UngriddedDimInfo.F90} | 89 ++++---- gridcomps/History3G/tests/CMakeLists.txt | 3 +- gridcomps/History3G/tests/Test_OutputInfo.pf | 186 +++++++++++++++++ .../History3G/tests/Test_OutputInfoSet.pf | 10 + .../History3G/tests/Test_UngriddedDimInfo.pf | 197 ++++++++++++++++++ .../tests/history3g_test_utility_procedures.h | 82 ++++++++ .../tests/history3g_test_utility_variables.h | 9 + 11 files changed, 594 insertions(+), 101 deletions(-) rename gridcomps/History3G/{UngriddedInfo.F90 => UngriddedDimInfo.F90} (62%) create mode 100644 gridcomps/History3G/tests/Test_OutputInfo.pf create mode 100644 gridcomps/History3G/tests/Test_OutputInfoSet.pf create mode 100644 gridcomps/History3G/tests/Test_UngriddedDimInfo.pf create mode 100644 gridcomps/History3G/tests/history3g_test_utility_procedures.h create mode 100644 gridcomps/History3G/tests/history3g_test_utility_variables.h diff --git a/gridcomps/History3G/CMakeLists.txt b/gridcomps/History3G/CMakeLists.txt index 7478924c2941..8ee31c825e28 100644 --- a/gridcomps/History3G/CMakeLists.txt +++ b/gridcomps/History3G/CMakeLists.txt @@ -5,7 +5,10 @@ set(srcs HistoryGridComp.F90 HistoryCollectionGridComp.F90 HistoryCollectionGridComp_private.F90 - ) + OutputInfo.F90 + OutputInfoSet.F90 + UngriddedDimInfo.F90 + ) find_package (MPI REQUIRED) diff --git a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 index f7ba2ed15542..c17c537ca523 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_OutputInfo - use mapl3g_OutputInfoSet + use mapl3g_output_info + use mapl3g_output_info_set implicit none private @@ -21,7 +21,7 @@ module mapl3g_HistoryCollectionGridComp_private public :: create_output_bundle public :: create_output_alarm public :: set_start_stop_time - public :: get_output_bundle_info + public :: get_output_info_bundle ! These are public for testing. public :: parse_item_common @@ -66,8 +66,10 @@ subroutine register_imports(gridcomp, hconfig, rc) integer :: status var_list = ESMF_HConfigCreateAt(hconfig, keystring=VAR_LIST_KEY, rc=status) - if(status==ESMF_RC_NOT_FOUND) _FAIL(VAR_LIST_KEY // ' was not found.') - _VERIFY(status==_SUCCESS) + if(status==ESMF_RC_NOT_FOUND) then + _FAIL(VAR_LIST_KEY // ' was not found.') + end if + _VERIFY(status) iter_begin = ESMF_HConfigIterBegin(var_list,_RC) iter_end = ESMF_HConfigIterEnd(var_list,_RC) @@ -185,26 +187,24 @@ function set_start_stop_time(clock, hconfig, rc) result(start_stop_time) _RETURN(_SUCCESS) end function set_start_stop_time - function get_output_bundle_info(bundle, rc) result(output_info) - type(OutputBundleInfoSet) :: output_info + function get_output_info_bundle(bundle, rc) result(out_set) + type(OutputInfoSet) :: out_set type(ESMF_FieldBundle) :: bundle integer, optional, intent(out) :: rc integer :: status - type(ESMF_Field) :: field_list(:), this_field + type(ESMF_Field), allocatable :: fields(:) integer :: i - type(OutputBundleInfo) :: item - logical :: is_new + type(OutputInfo) :: item type(ESMF_Info) :: info - call ESMF_FieldBundleGet(bundle, fieldList=field_list, _RC) - do i = 1:size(fieldList) - this_field = fieldList(i) - call ESMF_InfoGetFromHost(field, info, _RC) - item = OutputBundleInfo(info, _RC) - call output_info%insert(item, is_new=is_new, _RC) + call ESMF_FieldBundleGet(bundle, fieldList=fields, _RC) + do i = 1, size(fields) + call ESMF_InfoGetFromHost(fields(i), info, _RC) + item = OutputInfo(info, _RC) + call out_set%insert(item) end do - end function get_output_bundle_info + end function get_output_info_bundle subroutine parse_item_expression(item, item_name, var_names, rc) type(ESMF_HConfigIter), intent(in) :: item diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index b6d10a50df42..b45b1b4130af 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -1,7 +1,9 @@ -module mapl3g_OutputInfo +#include "MAPL_Generic.h" +module mapl3g_output_info use mapl3g_ungridded_dim_info - use esmf, only: ESMF_InfoGet + use esmf, only: ESMF_Info, ESMF_InfoGet, ESMF_InfoGetCharAlloc + use Mapl_ErrorHandling implicit none private @@ -13,9 +15,9 @@ module mapl3g_OutputInfo type :: OutputInfo integer :: num_levels character(len=:), allocatable :: vloc - type(UngriddedDimInfo) :: ungridded_dims(:) + type(UngriddedDimInfo), allocatable :: ungridded_dims(:) contains - module procedure :: num_ungridded + procedure :: num_ungridded end type OutputInfo interface OutputInfo @@ -24,35 +26,31 @@ module mapl3g_OutputInfo interface operator(<) module procedure :: less - end interface operator(<) + end interface interface operator(==) module procedure :: equal - end interface operator(==) - - interface operator(/=) - module procedure :: not_equal - end interface operator(/=) + end interface character(len=*), parameter :: PREFIX = 'MAPL/' contains - function construct_object(info_in, rc) result(obj) + function construct_object(info, rc) result(obj) type(OutputInfo) :: obj - type(ESMF_Info), intent(in) :: info_in + type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status integer :: num_levels, num_ungridded character(len=:), allocatable :: vloc - call ESMF_InfoGet(info_in, key=PREFIX // 'num_levels', num_levels, _RC) - call ESMF_InfoGet(info_in, key=PREFIX // 'vloc', vloc, _RC) - call ESMF_InfoGet(info_in, key=PREFIX // 'num_ungridded', num_ungridded, _RC) + call ESMF_InfoGet(info, PREFIX // 'num_levels', num_levels, _RC) + call ESMF_InfoGetCharAlloc(info, PREFIX // 'vloc', vloc, _RC) + call ESMF_InfoGet(info, PREFIX // 'num_ungridded', num_ungridded, _RC) obj%num_levels = num_levels obj%vloc = vloc - obj%ungridded_dims = UngriddedDimsInfo(info_in, _RC) + obj%ungridded_dims = UngriddedDimsInfo(info, _RC) _ASSERT(size(obj%ungridded_dims) == num_ungridded, 'Size of ungridded_dims does not match num_ungridded info.') _RETURN(_SUCCESS) @@ -68,38 +66,52 @@ end function num_ungridded logical function less(a, b) result(t) class(OutputInfo), intent(in) :: a, b - integer :: i - logical, allocatable :: lt(:), gt(:) t = a%num_levels < b%num_levels if(t .or. a%num_levels > b%num_levels) return t = a%vloc < b%vloc if(t .or. a%vloc > b%vloc) return - t = a%num_ungridded() < b%num_ungridded() - if(t .or. a%num_ungridded() > b%num_ungridded()) return - lt = a%ungridded_dims < b%ungridded_dims - gt = a%ungridded_dims > b%ungridded_dims - do i= 1, a%num_ungridded - t = lt(i) - if(t .or. gt(i)) return - end do + t = ungridded_dims_less(a, b) end function less logical function not_equal(a, b) result(t) class(OutputInfo), intent(in) :: a, b - t = .not (a == b) + t = .not. (a == b) end function not_equal logical function equal(a, b) result(t) class(OutputInfo), intent(in) :: a, b - t = .not. (a /= b) - t = a%num_levels == b%num_levels .and. a%vloc == b%vloc .and. & - a%num_ungridded() == b%num_ungridded() .and. all(a%ungridded_dims == b%UngriddedDimInfo) + t = a%num_levels == b%num_levels .and. a%vloc == b%vloc .and. ungridded_dims_equal(a, b) end function equal -end module mapl3g_OutputInfo + logical function ungridded_dims_less(a, b) result(t) + class(OutputInfo), intent(in) :: a, b + logical, allocatable :: lt(:), gt(:) + integer :: i, n, nb + + n = a%num_ungridded() + nb = b%num_ungridded() + t = n < nb + if(t .or. (nb < n)) return + lt = a%ungridded_dims < b%ungridded_dims + gt = b%ungridded_dims < a%ungridded_dims + do i=1, n + t = lt(i) + if(t .or. gt(i)) return + end do + + end function ungridded_dims_less + + logical function ungridded_dims_equal(a, b) result(t) + class(OutputInfo), intent(in) :: a, b + + t = (a%num_ungridded() == b%num_ungridded()) .and. all(a%ungridded_dims == b%ungridded_dims) + + end function ungridded_dims_equal + +end module mapl3g_output_info diff --git a/gridcomps/History3G/OutputInfoSet.F90 b/gridcomps/History3G/OutputInfoSet.F90 index 41d40ed61555..f65f6e52add8 100644 --- a/gridcomps/History3G/OutputInfoSet.F90 +++ b/gridcomps/History3G/OutputInfoSet.F90 @@ -1,5 +1,5 @@ -module mapl3g_OutputInfoSet_mod - use mapl3g_OutputInfo +module mapl3g_output_info_set + use mapl3g_output_info #define T OutputInfo #define T_LT(A, B) (A) < (B) @@ -13,4 +13,4 @@ module mapl3g_OutputInfoSet_mod #undef Set #undef SetIterator -end module mapl3g_OutputInfoSet_mod +end module mapl3g_output_info_set diff --git a/gridcomps/History3G/UngriddedInfo.F90 b/gridcomps/History3G/UngriddedDimInfo.F90 similarity index 62% rename from gridcomps/History3G/UngriddedInfo.F90 rename to gridcomps/History3G/UngriddedDimInfo.F90 index 1025a836d5a8..475bc99032b4 100644 --- a/gridcomps/History3G/UngriddedInfo.F90 +++ b/gridcomps/History3G/UngriddedDimInfo.F90 @@ -1,6 +1,8 @@ +#include "MAPL_Generic.h" module mapl3g_ungridded_dim_info - use esmf, only: ESMF_InfoGet + use esmf, only: ESMF_Info, ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoGetAlloc + use Mapl_ErrorHandling implicit none private @@ -13,10 +15,10 @@ module mapl3g_ungridded_dim_info type :: UngriddedDimInfo character(len=:), allocatable :: name character(len=:), allocatable :: units - real :: coordinates(:) + real, allocatable :: coordinates(:) contains - procedure, private :: name_units - procedure, private :: size + procedure :: name_units + procedure :: coordinate_dims end type UngriddedDimInfo interface UngriddedDimInfo @@ -29,27 +31,11 @@ module mapl3g_ungridded_dim_info interface operator(<) module procedure :: less - end interface operator(<) + end interface interface operator(==) module procedure :: equal - end interface operator(==) - - interface operator(.chlt.) - module procedure :: name_units_less - end interface operator(.chlt.) - - interface operator(.cheq.) - module procedure :: name_units_equal - end interface operator(.cheq.) - - interface operator(.rlt.) - module procedure :: coordinates_less - end interface operator(.rlt.) - - interface operator(.req.) - module procedure :: coordinates_equal - end interface operator(.req.) + end interface contains @@ -59,14 +45,13 @@ function construct(info_in, unit_prefix, rc) result(obj) character(len=*), intent(in) :: unit_prefix integer, optional, intent(out) :: rc integer :: status - character(len=:), allocatable :: vloc character(len=:), allocatable :: name character(len=:), allocatable :: units - real :: coordinates(:) + real, allocatable :: coordinates(:) - call ESMF_InfoGet(info_in, key=unit_prefix//'name', name, _RC) - call ESMF_InfoGet(info_in, key=unit_prefix//'units', units, _RC) - call ESMF_InfoGet(info_in, key=unit_prefix//'coordinates', coordinates, _RC) + call ESMF_InfoGetCharAlloc(info_in, key=unit_prefix//'name', value=name, _RC) + call ESMF_InfoGetCharAlloc(info_in, unit_prefix//'units', units, _RC) + call ESMF_InfoGetAlloc(info_in, unit_prefix//'coordinates', coordinates, _RC) obj%name = name obj%units = units obj%coordinates = coordinates @@ -74,7 +59,7 @@ function construct(info_in, unit_prefix, rc) result(obj) _RETURN(_SUCCESS) end function construct - function name_units(this) result(nu) + pure function name_units(this) result(nu) character(len=:), allocatable :: nu class(UngriddedDimInfo), intent(in) :: this @@ -82,15 +67,16 @@ function name_units(this) result(nu) end function name_units - integer function size(this) + pure integer function coordinate_dims(this) class(UngriddedDimInfo), intent(in) :: this + real, allocatable :: coordinates(:) - size = size(a%coordinates) + coordinates = this%coordinates + coordinate_dims = size(coordinates) - end function size + end function coordinate_dims function get_array(info_in, rc) result(array) - type(UngriddedDimInfo), allocatable = array(:) type(ESMF_Info), intent(in) :: info_in integer, optional, intent(out) :: rc character(len=*), parameter :: PREFIX = 'MAPL/' @@ -98,8 +84,9 @@ function get_array(info_in, rc) result(array) integer :: num_ungridded integer :: i, ios character(len=32) :: stri + type(UngriddedDimInfo), allocatable :: array(:) - call ESMF_InfoGet(info_in, key=PREFIX // 'num_ungridded', num_ungridded, _RC) + call ESMF_InfoGet(info_in, PREFIX // 'num_ungridded', num_ungridded, _RC) _ASSERT(num_ungridded >= 0, 'num_ungridded must be nonnegative.') allocate(array(num_ungridded)) if(num_ungridded == 0) then @@ -108,59 +95,65 @@ function get_array(info_in, rc) result(array) do i= 1, num_ungridded write(stri, fmt='(I0)', iostat=ios) i _ASSERT(ios == 0, 'failed to create ith ungridded dim index string') - array(i) = UngriddedDimInfo(info_in, PREFIX // 'dims_' // trim(adjustl(stri)) // '/') + array(i) = UngriddedDimInfo(info_in, PREFIX // 'dim_' // trim(adjustl(stri)) // '/') end do _RETURN(_SUCCESS) end function get_array - logical function equal(a, b) result(t) + elemental function equal(a, b) result(t) + logical :: t class(UngriddedDimInfo), intent(in) :: a, b - t = (a .cheq. b) .and. (a .req. b) + t = name_units_equal(a, b) .and. coordinates_equal(a, b) end function equal - logical function less(a, b) result(t) + elemental function less(a, b) result(t) + logical :: t class(UngriddedDimInfo), intent(in) :: a, b - t = a .chlt. b - if(t .or. (b .chlt. a)) return - t = a .rlt. b + t = name_units_less(a, b) + if(t .or. name_units_less(b, a)) return + t = coordinates_less(a, b) end function less - logical function name_units_equal(a, b) result(t) + elemental function name_units_equal(a, b) result(t) + logical :: t class(UngriddedDimInfo), intent(in) :: a, b t = a%name_units() == b%name_units() end function name_units_equal - logical function name_units_less(a, b) result(t) + elemental function name_units_less(a, b) result(t) + logical :: t class(UngriddedDimInfo), intent(in) :: a, b t = a%name_units() < b%name_units() end function name_units_less - logical function coordinates_equal(a, b) result(t) + elemental function coordinates_equal(a, b) result(t) + logical :: t class(UngriddedDimInfo), intent(in) :: a, b - t = a%size() == b%size() + t = a%coordinate_dims() == b%coordinate_dims() if(t) t = all(a%coordinates == b%coordinates) end function coordinates_equal - logical function coordinates_less(a, b) result(t) + elemental function coordinates_less(a, b) result(t) + logical :: t class(UngriddedDimInfo), intent(in) :: a, b logical, allocatable :: lt(:), gt(:) integer :: i, n - n = a%size() - t = n < b%size() - if(t .or. n > b%size()) return + n = a%coordinate_dims() + t = n < b%coordinate_dims() + if(t .or. n > b%coordinate_dims()) return lt = a%coordinates < b%coordinates gt = a%coordinates > b%coordinates do i=1, n diff --git a/gridcomps/History3G/tests/CMakeLists.txt b/gridcomps/History3G/tests/CMakeLists.txt index 439f98730b52..184496570229 100644 --- a/gridcomps/History3G/tests/CMakeLists.txt +++ b/gridcomps/History3G/tests/CMakeLists.txt @@ -3,9 +3,10 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.history3g.tests") set (test_srcs Test_HistoryGridComp.pf Test_HistoryCollectionGridComp.pf + Test_UngriddedDimInfo.pf + Test_OutputInfo.pf ) - add_pfunit_ctest(MAPL.history3g.tests TEST_SOURCES ${test_srcs} LINK_LIBRARIES MAPL.history3g MAPL.pfunit diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_OutputInfo.pf new file mode 100644 index 000000000000..657f907c2677 --- /dev/null +++ b/gridcomps/History3G/tests/Test_OutputInfo.pf @@ -0,0 +1,186 @@ +#define SET_RC if(present(rc)) rc = status + +#include "MAPL_TestErr.h" +module Test_OutputInfo + use mapl3g_output_info + use mapl3g_ungridded_dim_info + use pfunit + use esmf +! use mapl3g_history3g_test_utilities + + implicit none + +#include "history3g_test_utility_variables.h" +! character(len=*), parameter :: PREFIX = 'MAPL/G1/' +! integer, parameter :: NUM_LEVELS = 3 +! character(len=*), parameter :: VLOC = 'VERTICAL_DIM_CENTER' +! integer, parameter :: NUM_UNGRIDDED = 3 +! character(len=*), parameter :: NAME = 'A1' +! character(len=*), parameter :: UNITS = 'stones' +! real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] + +contains + +#include "history3g_test_utility_procedures.h" + + @Test + subroutine test_construct_object() + type(ESMF_Info) :: info + type(OutputInfo) :: out_info + type(UngriddedDimInfo) :: ungrid_info + character(len=:), allocatable :: stri + integer :: i + integer :: status + + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) + out_info = OutputInfo(info, _RC) + @assertEqual(out_info%num_levels, NUM_LEVELS, 'num_levels does not match.') + @assertEqual(out_info%vloc, VLOC, 'vloc does not match.') + @assertEqual(out_info%num_ungridded(), NUM_UNGRIDDED, 'num_ungridded does not match.') + do i=1, out_info%num_ungridded() + ungrid_info = out_info%ungridded_dims(i) + write(stri, fmt='(I0)', iostat=status) i + @assertEqual(0, status, 'Failed to create stri') + @assertEqual(NAME, ungrid_info%name, 'name does not match, dimesion ' // trim(adjustl(stri))) + @assertEqual(UNITS, ungrid_info%units, 'units does not match, dimension ' // trim(adjustl(stri))) + @assertEqual(COORDINATES, ungrid_info%coordinates, 'coordinates do not match, dimension ' // trim(adjustl(stri))) + end do + + call ESMF_InfoDestroy(info) + + end subroutine test_construct_object + + @Test + subroutine test_less() + type(ESMF_Info) :: info + type(OutputInfo) :: out_info_1, out_info_2 + character(len=:), allocatable :: names(:), units(:) + integer :: status + + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) + out_info_1 = OutputInfo(info, _RC) + call ESMF_InfoDestroy(info) + + names = [character(len=2) :: 'A2', 'A3', 'A4' ] + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, names=names, _RC) + out_info_2 = OutputInfo(info, _RC) + call ESMF_InfoDestroy(info) + + @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 names are smaller than OutputInfo2 names.') + + units = [character(len=8) :: 'tons', 'volts', 'watts'] + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, units_array=units, _RC) + out_info_2 = OutputInfo(info, _RC) + call ESMF_InfoDestroy(info) + + @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 units are smaller than OutputInfo2 units.') + + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, PREFIX, NUM_LEVELS+1, VLOC, NUM_UNGRIDDED, _RC) + out_info_2 = OutputInfo(info, _RC) + call ESMF_InfoDestroy(info) + + @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 num_levels are smaller than OutputInfo2 num_levels.') + + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED+1, _RC) + out_info_2 = OutputInfo(info, _RC) + call ESMF_InfoDestroy(info) + + @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 ungridded are smaller than OutputInfo2 num_ungridded.') + + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, PREFIX, NUM_LEVELS, 'VERTICAL_DIM_EDGE', NUM_UNGRIDDED, _RC) + out_info_2 = OutputInfo(info, _RC) + call ESMF_InfoDestroy(info) + + @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 vloc is smaller than OutputInfo2 num_ungridded vloc.') + + end subroutine test_less + +! subroutine make_esmf_info(info, prefix, num_levels, vloc, num_ungridded, names, units_array, rc) +! type(ESMF_Info), intent(inout) :: info +! character(len=*), intent(in) :: prefix +! integer, intent(in) :: num_levels +! character(len=*), intent(in) :: vloc +! integer, intent(in) :: num_ungridded +! character(len=*), optional, intent(in) :: names(:) +! character(len=*), optional, intent(in) :: units_array(:) +! integer, optional, intent(out) :: rc +! character(len=*), parameter :: NUMLEV_LABEL = 'num_levels' +! character(len=*), parameter :: VLOC_LABEL = 'vloc' +! character, parameter :: NUM_UNGRID_LABEL = 'num_ungridded' +! integer :: status +! +! call ESMF_InfoSet(info, prefix // NUMLEV_LABEL, num_levels, _RC) +! call ESMF_InfoSet(info, prefix // VLOC_LABEL, vloc, _RC) +! call make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, _RC) +! +! SET_RC +! +! end subroutine make_esmf_info +! +! subroutine make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, rc) +! type(ESMF_Info), intent(inout) :: info +! character(len=*), intent(in) :: prefix +! integer, intent(in) :: num_ungridded +! character(len=*), optional, intent(in) :: names(:) +! character(len=*), optional, intent(in) :: units_array(:) +! integer, optional, intent(out) :: rc +! character(len=*), parameter :: NAME_LABEL = 'name' +! character(len=*), parameter :: UNITS_LABEL = 'units' +! character(len=*), parameter :: COORDINATES_LABEL = 'coordinates' +! real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] +! type(ESMF_Info) :: comp_info +! character(len=:), allocatable :: name_, units_ +! integer :: status, i +! +! status = -1 +! +! SET_RC +! +! if(present(names)) then +! if(size(names) /= num_ungridded) return +! end if +! +! if(present(units_array)) then +! if(size(units_array) /= num_ungridded) return +! end if +! +! do i=1, num_ungridded +! name_ = NAME +! if(present(names)) name_ = names(i) +! units_ = UNITS +! if(present(units_array)) units_ = units_array(i) +! comp_info = ESMF_InfoCreate(_RC) +! call ESMF_InfoSet(comp_info, prefix // NAME_LABEL, name_, _RC) +! call ESMF_InfoSet(comp_info, prefix // UNITS_LABEL, units_, _RC) +! call ESMF_InfoSet(comp_info, prefix // COORDINATES_LABEL, COORDINATES, _RC) +! call ESMF_InfoSet(info, prefix // make_component_label(i), comp_info, _RC) +! call ESMF_InfoDestroy(comp_info) +! end do +! +! SET_RC +! +! end subroutine make_esmf_ungridded_info +! +! function make_component_label(n, rc) result(name) +! character(len=:), allocatable :: name +! integer, intent(in) :: n +! integer, optional, intent(out) :: rc +! character(len=*), parameter :: COMP_PREFIX = 'dim_' +! character(len=32) :: strn +! integer :: status +! +! write(strn, fmt='(I0)', iostat=status) n +! if(status == 0) name = COMP_PREFIX // trim(adjustl(strn)) +! +! SET_RC +! +! end function make_component_label + +end module Test_OutputInfo diff --git a/gridcomps/History3G/tests/Test_OutputInfoSet.pf b/gridcomps/History3G/tests/Test_OutputInfoSet.pf new file mode 100644 index 000000000000..00a8c06e3e69 --- /dev/null +++ b/gridcomps/History3G/tests/Test_OutputInfoSet.pf @@ -0,0 +1,10 @@ +#include "MAPL_TestErr.h" +module Test_OutputInfoSet + use mapl3g_output_info + use mapl3g_ungridded_dim_info + use pfunit + use esmf + + implicit none + +end module Test_OutputInfoSet diff --git a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf new file mode 100644 index 000000000000..b4a2635341f1 --- /dev/null +++ b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf @@ -0,0 +1,197 @@ +#include "MAPL_TestErr.h" +module Test_UngriddedDimInfo + + use mapl3g_ungridded_dim_info + use pfunit + use mapl3g_HistoryCollectionGridComp_private + use esmf + + implicit none + + character(len=*), parameter :: NAME_LABEL = 'name' + character(len=*), parameter :: UNITS_LABEL = 'units' + character(len=*), parameter :: COORDINATES_LABEL = 'coordinates' + +contains + + @Test + subroutine test_construct() + integer :: status + type(ESMF_Info) :: info + type(UngriddedDimInfo) :: obj + real, allocatable :: coordinates(:) + character(len=:), allocatable :: name + character(len=:), allocatable :: units + character(len=:), allocatable :: unit_prefix + + name = 'G1' + units = 'stones' + unit_prefix = 'IthComp' + coordinates = [1.0, 2.0, 3.0, 4.0] + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, unit_prefix, name, units, coordinates, _RC) + obj = UngriddedDimInfo(info, unit_prefix, _RC) + @assertEqual(name, obj%name, NAME_LABEL // ' does not match.') + @assertEqual(units, obj%units, UNITS_LABEL // 'units does not match.') + @assertEqual(coordinates, obj%coordinates, COORDINATES_LABEL // ' does not match.') + call ESMF_InfoDestroy(info) + + end subroutine test_construct + + @Test + subroutine test_name_units() + integer :: status + type(ESMF_Info) :: info + type(UngriddedDimInfo) :: obj + real, allocatable :: coordinates(:) + character(len=:), allocatable :: name + character(len=:), allocatable :: units + character(len=:), allocatable :: unit_prefix + character(len=:), allocatable :: NAME_UNITS + + name = 'G1' + units = 'stones' + NAME_UNITS = name // units + unit_prefix = 'IthComp' + coordinates = [1.0, 2.0, 3.0, 4.0] + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, unit_prefix, name, units, coordinates, _RC) + obj = UngriddedDimInfo(info, unit_prefix, _RC) + @assertEqual(NAME_UNITS, obj%name_units(), NAME_UNITS // '() does not match expected ' // NAME_UNITS // '.') + call ESMF_InfoDestroy(info) + + end subroutine test_name_units + + @Test + subroutine test_coordinate_dims() + integer :: status, ios + type(ESMF_Info) :: info + type(UngriddedDimInfo) :: obj + real, allocatable :: coordinates(:) + character(len=:), allocatable :: name + character(len=:), allocatable :: units + character(len=:), allocatable :: unit_prefix + character(len=32) :: dims_string + + name = 'G1' + units = 'stones' + unit_prefix = 'IthComp' + coordinates = [1.0, 2.0, 3.0, 4.0] + write(dims_string, fmt='(I0)', iostat=ios) size(coordinates) + @assertEqual(0, ios, 'write to dims_string failed.') + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, unit_prefix, name, units, coordinates, _RC) + obj = UngriddedDimInfo(info, unit_prefix, _RC) + @assertEqual(size(coordinates), obj%coordinate_dims(), 'coordinate_dims() does not match expected value ' // trim(dims_string) // '.') + call ESMF_InfoDestroy(info) + + end subroutine test_coordinate_dims + + @Test + subroutine test_less() + integer :: status + real, allocatable :: coordinates(:, :) + real, allocatable :: coordinate_vector(:) + type(ESMF_Info) :: info1, info2 + type(UngriddedDimInfo) :: obj1, obj2 + character(len=*), parameter :: UNIT_PREFIX = 'IthComp' + + coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 4.0] + coordinates = reshape(coordinate_vector, [4, 2]) + info1 = ESMF_InfoCreate(_RC) + call make_esmf_info(info1, unit_prefix, 'G1', 'kg', coordinates(:, 1), _RC) + obj1 = UngriddedDimInfo(info1, unit_prefix, _RC) + info2 = ESMF_InfoCreate(_RC) + call make_esmf_info(info2, unit_prefix, 'G1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + + @assertFalse(obj1 < obj2, 'obj1 is not less than obj2.') + @assertFalse(obj2 < obj1, 'obj2 is not less than obj1.') + + call ESMF_InfoDestroy(info2) + info2 = ESMF_InfoCreate(_RC) + coordinate_vector = [1.0, 2.0, 3.0, 4.0, 2.0, 2.0, 3.0, 4.0] + coordinates = reshape(coordinate_vector, [4, 2]) + call make_esmf_info(info2, unit_prefix, 'G1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + + @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') + + call ESMF_InfoDestroy(info2) + info2 = ESMF_InfoCreate(_RC) + coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 3.0, 3.0, 4.0] + coordinates = reshape(coordinate_vector, [4, 2]) + call make_esmf_info(info2, unit_prefix, 'G1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + + @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') + + call ESMF_InfoDestroy(info2) + info2 = ESMF_InfoCreate(_RC) + coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 4.0, 4.0] + coordinates = reshape(coordinate_vector, [4, 2]) + call make_esmf_info(info2, unit_prefix, 'G1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + + @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') + + call ESMF_InfoDestroy(info2) + info2 = ESMF_InfoCreate(_RC) + coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 5.0] + coordinates = reshape(coordinate_vector, [4, 2]) + call make_esmf_info(info2, unit_prefix, 'g1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + + @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') + + call ESMF_InfoDestroy(info2) + info2 = ESMF_InfoCreate(_RC) + coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.1, 2.0, 3.0] + coordinates = reshape(coordinate_vector, [4, 2]) + call make_esmf_info(info2, unit_prefix, 'G1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + + @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') + + call ESMF_InfoDestroy(info2) + info2 = ESMF_InfoCreate(_RC) + coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 4.0] + call make_esmf_info(info2, unit_prefix, 'H1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + + @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') + call ESMF_InfoDestroy(info2) + info2 = ESMF_InfoCreate(_RC) + coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 4.0] + call make_esmf_info(info2, unit_prefix, 'G1', 'stone', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + + @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') + end subroutine test_less + + @Before + subroutine setup() + integer :: status + end subroutine setup + + @After + subroutine teardown() + integer :: status + end subroutine teardown + + subroutine make_esmf_info(info, unit_prefix, name, units, coordinates, rc) + type(ESMF_Info), intent(inout) :: info + character(len=*), intent(in) :: unit_prefix + character(len=*), intent(in) :: name + character(len=*), intent(in) :: units + real, intent(in) :: coordinates(:) + integer, optional, intent(out) :: rc + integer :: status + + call ESMF_InfoSet(info, unit_prefix // NAME_LABEL, name, _RC) + call ESMF_InfoSet(info, unit_prefix // UNITS_LABEL, units, _RC) + call ESMF_InfoSet(info, unit_prefix // COORDINATES_LABEL, coordinates, _RC) + + end subroutine make_esmf_info + +end module Test_UngriddedDimInfo diff --git a/gridcomps/History3G/tests/history3g_test_utility_procedures.h b/gridcomps/History3G/tests/history3g_test_utility_procedures.h new file mode 100644 index 000000000000..18561df1a68c --- /dev/null +++ b/gridcomps/History3G/tests/history3g_test_utility_procedures.h @@ -0,0 +1,82 @@ + + subroutine make_esmf_info(info, prefix, num_levels, vloc, num_ungridded, names, units_array, rc) + type(ESMF_Info), intent(inout) :: info + character(len=*), intent(in) :: prefix + integer, intent(in) :: num_levels + character(len=*), intent(in) :: vloc + integer, intent(in) :: num_ungridded + character(len=*), optional, intent(in) :: names(:) + character(len=*), optional, intent(in) :: units_array(:) + integer, optional, intent(out) :: rc + character(len=*), parameter :: NUMLEV_LABEL = 'num_levels' + character(len=*), parameter :: VLOC_LABEL = 'vloc' + character, parameter :: NUM_UNGRID_LABEL = 'num_ungridded' + integer :: status + + call ESMF_InfoSet(info, prefix // NUMLEV_LABEL, num_levels, _RC) + call ESMF_InfoSet(info, prefix // VLOC_LABEL, vloc, _RC) + call make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, _RC) + + SET_RC + + end subroutine make_esmf_info + + subroutine make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, rc) + type(ESMF_Info), intent(inout) :: info + character(len=*), intent(in) :: prefix + integer, intent(in) :: num_ungridded + character(len=*), optional, intent(in) :: names(:) + character(len=*), optional, intent(in) :: units_array(:) + integer, optional, intent(out) :: rc + character(len=*), parameter :: NAME_LABEL = 'name' + character(len=*), parameter :: UNITS_LABEL = 'units' + character(len=*), parameter :: COORDINATES_LABEL = 'coordinates' + real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] + type(ESMF_Info) :: comp_info + character(len=:), allocatable :: name_, units_ + integer :: status, i + + status = -1 + + SET_RC + + if(present(names)) then + if(size(names) /= num_ungridded) return + end if + + if(present(units_array)) then + if(size(units_array) /= num_ungridded) return + end if + + do i=1, num_ungridded + name_ = NAME + if(present(names)) name_ = names(i) + units_ = UNITS + if(present(units_array)) units_ = units_array(i) + comp_info = ESMF_InfoCreate(_RC) + call ESMF_InfoSet(comp_info, prefix // NAME_LABEL, name_, _RC) + call ESMF_InfoSet(comp_info, prefix // UNITS_LABEL, units_, _RC) + call ESMF_InfoSet(comp_info, prefix // COORDINATES_LABEL, COORDINATES, _RC) + call ESMF_InfoSet(info, prefix // make_component_label(i), comp_info, _RC) + call ESMF_InfoDestroy(comp_info) + end do + + SET_RC + + end subroutine make_esmf_ungridded_info + + function make_component_label(n, rc) result(name) + character(len=:), allocatable :: name + integer, intent(in) :: n + integer, optional, intent(out) :: rc + character(len=*), parameter :: COMP_PREFIX = 'dim_' + character(len=32) :: strn + integer :: status + + write(strn, fmt='(I0)', iostat=status) n + if(status == 0) name = COMP_PREFIX // trim(adjustl(strn)) + + SET_RC + + end function make_component_label + diff --git a/gridcomps/History3G/tests/history3g_test_utility_variables.h b/gridcomps/History3G/tests/history3g_test_utility_variables.h new file mode 100644 index 000000000000..788e2a23b908 --- /dev/null +++ b/gridcomps/History3G/tests/history3g_test_utility_variables.h @@ -0,0 +1,9 @@ + + character(len=*), parameter :: PREFIX = 'MAPL/G1/' + integer, parameter :: NUM_LEVELS = 3 + character(len=*), parameter :: VLOC = 'VERTICAL_DIM_CENTER' + integer, parameter :: NUM_UNGRIDDED = 3 + character(len=*), parameter :: NAME = 'A1' + character(len=*), parameter :: UNITS = 'stones' + real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] + From 579d423d74abb18057cf0db1c625eeaf08a45008 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 14 May 2024 12:46:55 -0400 Subject: [PATCH 04/23] Testing get_output_info_bundle --- .../HistoryCollectionGridComp_private.F90 | 5 +- gridcomps/History3G/OutputInfo.F90 | 4 + gridcomps/History3G/tests/CMakeLists.txt | 1 + .../tests/Test_HistoryCollectionGridComp.pf | 55 +++++++++-- gridcomps/History3G/tests/Test_OutputInfo.pf | 95 +------------------ .../History3G/tests/Test_OutputInfoSet.pf | 40 ++++++++ .../History3G/tests/Test_UngriddedDimInfo.pf | 18 +--- .../tests/history3g_test_utility_procedures.h | 4 +- 8 files changed, 105 insertions(+), 117 deletions(-) diff --git a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 index c17c537ca523..74b81bd808cf 100644 --- a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 +++ b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 @@ -193,17 +193,18 @@ function get_output_info_bundle(bundle, rc) result(out_set) integer, optional, intent(out) :: rc integer :: status type(ESMF_Field), allocatable :: fields(:) - integer :: i + integer :: i, field_count type(OutputInfo) :: item type(ESMF_Info) :: info + call ESMF_FieldBundleGet(bundle, fieldCount=field_count, _RC) + allocate(fields(field_count)) call ESMF_FieldBundleGet(bundle, fieldList=fields, _RC) do i = 1, size(fields) call ESMF_InfoGetFromHost(fields(i), info, _RC) item = OutputInfo(info, _RC) call out_set%insert(item) end do - end function get_output_info_bundle subroutine parse_item_expression(item, item_name, var_names, rc) diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index b45b1b4130af..cd817f707126 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -45,14 +45,18 @@ function construct_object(info, rc) result(obj) character(len=:), allocatable :: vloc call ESMF_InfoGet(info, PREFIX // 'num_levels', num_levels, _RC) + _HERE, 'num_levels = ', num_levels call ESMF_InfoGetCharAlloc(info, PREFIX // 'vloc', vloc, _RC) + _HERE, 'vloc = ', vloc call ESMF_InfoGet(info, PREFIX // 'num_ungridded', num_ungridded, _RC) + _HERE, 'num_ungridded = ', num_ungridded obj%num_levels = num_levels obj%vloc = vloc obj%ungridded_dims = UngriddedDimsInfo(info, _RC) _ASSERT(size(obj%ungridded_dims) == num_ungridded, 'Size of ungridded_dims does not match num_ungridded info.') + _HERE, 'Exiting construct_object' _RETURN(_SUCCESS) end function construct_object diff --git a/gridcomps/History3G/tests/CMakeLists.txt b/gridcomps/History3G/tests/CMakeLists.txt index 184496570229..e771d46b81a1 100644 --- a/gridcomps/History3G/tests/CMakeLists.txt +++ b/gridcomps/History3G/tests/CMakeLists.txt @@ -5,6 +5,7 @@ set (test_srcs Test_HistoryCollectionGridComp.pf Test_UngriddedDimInfo.pf Test_OutputInfo.pf + Test_OutputInfoSet.pf ) add_pfunit_ctest(MAPL.history3g.tests diff --git a/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf b/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf index 1fe898c88388..289cc457916d 100644 --- a/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf +++ b/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf @@ -7,11 +7,12 @@ module Test_HistoryCollectionGridComp use mapl3g_HistoryCollectionGridComp_private use esmf use gFTL2_StringVector + use mapl3g_output_info_set implicit none contains - @Test + !@Test subroutine test_make_geom() type(ESMF_HConfig) :: hconfig type(ESMF_Geom) :: geom @@ -32,7 +33,7 @@ contains end subroutine test_make_geom - @Test + !@Test subroutine test_create_output_bundle() type(ESMF_HConfig) :: hconfig_geom, hconfig_hist type(ESMF_Geom) :: geom @@ -77,10 +78,9 @@ contains call ESMF_GridDestroy(grid, nogarbage=.true., _RC) call ESMF_GeomDestroy(geom, _RC) - end subroutine test_create_output_bundle - @Test + !@Test subroutine test_replace_delimiter() character(len=:), allocatable :: d, r character(len=*), parameter :: A = 'bread' @@ -120,7 +120,7 @@ contains end subroutine test_replace_delimiter - @Test + !@Test subroutine test_get_expression_variables() type(StringVector) :: variables type(StringVectorIterator) :: iter @@ -141,7 +141,7 @@ contains end subroutine test_get_expression_variables - @Test + !@Test subroutine test_parse_item_common() type(ESMF_HConfig) :: hconfig type(ESMF_HConfigIter) :: hc_iter, hc_iter_begin, hc_iter_end @@ -199,7 +199,7 @@ contains end subroutine test_set_start_stop_time - @Test + !@Test subroutine test_create_output_alarm() type(ESMF_HConfig) :: hconfig type(ESMF_Time) :: time,start_stop_time(2) @@ -237,4 +237,45 @@ contains end subroutine test_create_output_alarm + @Test + subroutine test_get_output_info_bundle() + type(ESMF_HConfig) :: hconfig_geom, hconfig_hist + type(ESMF_Geom) :: geom + type(ESMF_Grid) :: grid + integer :: rank,fieldCount + integer :: status + logical :: found + type(ESMF_State) :: state, substate + type(ESMF_FieldBundle) :: bundle + type(ESMF_Field) :: field + type(OutputInfoSet) :: out_set + + !call ESMF_Initialize(_RC) + hconfig_geom = ESMF_HConfigCreate(content= & + "{geom: {class: latlon, im_world: 14, jm_world: 13, pole: PC, " // & + "dateline: DC, nx: 1, ny: 1}}", _RC) + geom = make_geom(hconfig_geom, _RC) + call ESMF_GeomGet(geom, grid=grid, _RC) + + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R4, name="E_1", _RC) + substate = ESMF_StateCreate(fieldList=[field], name= "DYN", _RC) + state = ESMF_Statecreate(nestedStateList=[substate],_RC) + + hconfig_hist = ESMF_HConfigCreate(content= & + "{var_list: {E1: {expr: DYN.E_1}}}", _RC) + + bundle = create_output_bundle(hconfig_hist, state, _RC) + out_set = get_output_info_bundle(bundle, _RC) + !@assertEqual(1, out_set%size(), 'There should be one element.') +! call ESMF_HConfigDestroy(hconfig_hist, _RC) + !call ESMF_FieldBundleDestroy(bundle, nogarbage=.true. ,_RC) + !call ESMF_FieldDestroy(field, nogarbage=.true., _RC) + !call ESMF_StateDestroy(state, nogarbage=.true., _RC) + !call ESMF_GridDestroy(grid, nogarbage=.true., _RC) + !call ESMF_GeomDestroy(geom, _RC) + !call ESMF_HConfigDestroy(hconfig_geom, _RC) + !call ESMF_Finalize() + + end subroutine test_get_output_info_bundle + end module Test_HistoryCollectionGridComp diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_OutputInfo.pf index 657f907c2677..a91c95e62e38 100644 --- a/gridcomps/History3G/tests/Test_OutputInfo.pf +++ b/gridcomps/History3G/tests/Test_OutputInfo.pf @@ -1,29 +1,19 @@ -#define SET_RC if(present(rc)) rc = status - #include "MAPL_TestErr.h" module Test_OutputInfo use mapl3g_output_info use mapl3g_ungridded_dim_info use pfunit use esmf -! use mapl3g_history3g_test_utilities implicit none #include "history3g_test_utility_variables.h" -! character(len=*), parameter :: PREFIX = 'MAPL/G1/' -! integer, parameter :: NUM_LEVELS = 3 -! character(len=*), parameter :: VLOC = 'VERTICAL_DIM_CENTER' -! integer, parameter :: NUM_UNGRIDDED = 3 -! character(len=*), parameter :: NAME = 'A1' -! character(len=*), parameter :: UNITS = 'stones' -! real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] contains #include "history3g_test_utility_procedures.h" - @Test + !@Test subroutine test_construct_object() type(ESMF_Info) :: info type(OutputInfo) :: out_info @@ -51,7 +41,7 @@ contains end subroutine test_construct_object - @Test + !@Test subroutine test_less() type(ESMF_Info) :: info type(OutputInfo) :: out_info_1, out_info_2 @@ -102,85 +92,4 @@ contains end subroutine test_less -! subroutine make_esmf_info(info, prefix, num_levels, vloc, num_ungridded, names, units_array, rc) -! type(ESMF_Info), intent(inout) :: info -! character(len=*), intent(in) :: prefix -! integer, intent(in) :: num_levels -! character(len=*), intent(in) :: vloc -! integer, intent(in) :: num_ungridded -! character(len=*), optional, intent(in) :: names(:) -! character(len=*), optional, intent(in) :: units_array(:) -! integer, optional, intent(out) :: rc -! character(len=*), parameter :: NUMLEV_LABEL = 'num_levels' -! character(len=*), parameter :: VLOC_LABEL = 'vloc' -! character, parameter :: NUM_UNGRID_LABEL = 'num_ungridded' -! integer :: status -! -! call ESMF_InfoSet(info, prefix // NUMLEV_LABEL, num_levels, _RC) -! call ESMF_InfoSet(info, prefix // VLOC_LABEL, vloc, _RC) -! call make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, _RC) -! -! SET_RC -! -! end subroutine make_esmf_info -! -! subroutine make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, rc) -! type(ESMF_Info), intent(inout) :: info -! character(len=*), intent(in) :: prefix -! integer, intent(in) :: num_ungridded -! character(len=*), optional, intent(in) :: names(:) -! character(len=*), optional, intent(in) :: units_array(:) -! integer, optional, intent(out) :: rc -! character(len=*), parameter :: NAME_LABEL = 'name' -! character(len=*), parameter :: UNITS_LABEL = 'units' -! character(len=*), parameter :: COORDINATES_LABEL = 'coordinates' -! real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] -! type(ESMF_Info) :: comp_info -! character(len=:), allocatable :: name_, units_ -! integer :: status, i -! -! status = -1 -! -! SET_RC -! -! if(present(names)) then -! if(size(names) /= num_ungridded) return -! end if -! -! if(present(units_array)) then -! if(size(units_array) /= num_ungridded) return -! end if -! -! do i=1, num_ungridded -! name_ = NAME -! if(present(names)) name_ = names(i) -! units_ = UNITS -! if(present(units_array)) units_ = units_array(i) -! comp_info = ESMF_InfoCreate(_RC) -! call ESMF_InfoSet(comp_info, prefix // NAME_LABEL, name_, _RC) -! call ESMF_InfoSet(comp_info, prefix // UNITS_LABEL, units_, _RC) -! call ESMF_InfoSet(comp_info, prefix // COORDINATES_LABEL, COORDINATES, _RC) -! call ESMF_InfoSet(info, prefix // make_component_label(i), comp_info, _RC) -! call ESMF_InfoDestroy(comp_info) -! end do -! -! SET_RC -! -! end subroutine make_esmf_ungridded_info -! -! function make_component_label(n, rc) result(name) -! character(len=:), allocatable :: name -! integer, intent(in) :: n -! integer, optional, intent(out) :: rc -! character(len=*), parameter :: COMP_PREFIX = 'dim_' -! character(len=32) :: strn -! integer :: status -! -! write(strn, fmt='(I0)', iostat=status) n -! if(status == 0) name = COMP_PREFIX // trim(adjustl(strn)) -! -! SET_RC -! -! end function make_component_label - end module Test_OutputInfo diff --git a/gridcomps/History3G/tests/Test_OutputInfoSet.pf b/gridcomps/History3G/tests/Test_OutputInfoSet.pf index 00a8c06e3e69..eb43d0f7919f 100644 --- a/gridcomps/History3G/tests/Test_OutputInfoSet.pf +++ b/gridcomps/History3G/tests/Test_OutputInfoSet.pf @@ -1,5 +1,6 @@ #include "MAPL_TestErr.h" module Test_OutputInfoSet + use mapl3g_output_info_set use mapl3g_output_info use mapl3g_ungridded_dim_info use pfunit @@ -7,4 +8,43 @@ module Test_OutputInfoSet implicit none +#include "history3g_test_utility_variables.h" + +contains + +#include "history3g_test_utility_procedures.h" + + !@Test + subroutine test_insert() + type(ESMF_Info) :: info + type(OutputInfo) :: outinfo1, outinfo2, outinfo3 + type(OutputInfoSet) :: outinfo_set + integer :: status + + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) + outinfo1 = OutputInfo(info, _RC) + call ESMF_InfoDestroy(info) + outinfo_set = OutputInfoSet() + + call outinfo_set%insert(outinfo1) + + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, PREFIX, NUM_LEVELS+1, VLOC, NUM_UNGRIDDED, _RC) + outinfo2 = OutputInfo(info, _RC) + call ESMF_InfoDestroy(info) + call outinfo_set%insert(outinfo2) + + @assertEqual(2, outinfo_set%size(), 'Size of set should be 2.') + + info = ESMF_InfoCreate(_RC) + call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) + outinfo3 = OutputInfo(info, _RC) + call ESMF_InfoDestroy(info) + call outinfo_set%insert(outinfo3) + + @assertEqual(2, outinfo_set%size(), 'Size of set should still be 2.') + + end subroutine test_insert + end module Test_OutputInfoSet diff --git a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf index b4a2635341f1..bf965db551ff 100644 --- a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf +++ b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf @@ -14,7 +14,7 @@ module Test_UngriddedDimInfo contains - @Test + !@Test subroutine test_construct() integer :: status type(ESMF_Info) :: info @@ -38,7 +38,7 @@ contains end subroutine test_construct - @Test + !@Test subroutine test_name_units() integer :: status type(ESMF_Info) :: info @@ -62,7 +62,7 @@ contains end subroutine test_name_units - @Test + !@Test subroutine test_coordinate_dims() integer :: status, ios type(ESMF_Info) :: info @@ -87,7 +87,7 @@ contains end subroutine test_coordinate_dims - @Test + !@Test subroutine test_less() integer :: status real, allocatable :: coordinates(:, :) @@ -169,16 +169,6 @@ contains @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') end subroutine test_less - @Before - subroutine setup() - integer :: status - end subroutine setup - - @After - subroutine teardown() - integer :: status - end subroutine teardown - subroutine make_esmf_info(info, unit_prefix, name, units, coordinates, rc) type(ESMF_Info), intent(inout) :: info character(len=*), intent(in) :: unit_prefix diff --git a/gridcomps/History3G/tests/history3g_test_utility_procedures.h b/gridcomps/History3G/tests/history3g_test_utility_procedures.h index 18561df1a68c..3bb38dbd0e25 100644 --- a/gridcomps/History3G/tests/history3g_test_utility_procedures.h +++ b/gridcomps/History3G/tests/history3g_test_utility_procedures.h @@ -1,3 +1,4 @@ +#define SET_RC if(present(rc)) rc = status subroutine make_esmf_info(info, prefix, num_levels, vloc, num_ungridded, names, units_array, rc) type(ESMF_Info), intent(inout) :: info @@ -10,7 +11,7 @@ integer, optional, intent(out) :: rc character(len=*), parameter :: NUMLEV_LABEL = 'num_levels' character(len=*), parameter :: VLOC_LABEL = 'vloc' - character, parameter :: NUM_UNGRID_LABEL = 'num_ungridded' + character(len=*), parameter :: NUM_UNGRID_LABEL = 'num_ungridded' integer :: status call ESMF_InfoSet(info, prefix // NUMLEV_LABEL, num_levels, _RC) @@ -80,3 +81,4 @@ end function make_component_label +! vim:ft=fortran From 07de0f940182b64ab761098dc6404418968a552f Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 14 May 2024 13:06:42 -0400 Subject: [PATCH 05/23] Comment out OutputInfo and OutputInfoSet tests --- gridcomps/History3G/tests/CMakeLists.txt | 2 - .../tests/Test_HistoryCollectionGridComp.pf | 90 +++++++++---------- 2 files changed, 45 insertions(+), 47 deletions(-) diff --git a/gridcomps/History3G/tests/CMakeLists.txt b/gridcomps/History3G/tests/CMakeLists.txt index e771d46b81a1..9ac4edd9d8b5 100644 --- a/gridcomps/History3G/tests/CMakeLists.txt +++ b/gridcomps/History3G/tests/CMakeLists.txt @@ -4,8 +4,6 @@ set (test_srcs Test_HistoryGridComp.pf Test_HistoryCollectionGridComp.pf Test_UngriddedDimInfo.pf - Test_OutputInfo.pf - Test_OutputInfoSet.pf ) add_pfunit_ctest(MAPL.history3g.tests diff --git a/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf b/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf index 289cc457916d..11dbc9679899 100644 --- a/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf +++ b/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf @@ -12,7 +12,7 @@ module Test_HistoryCollectionGridComp contains - !@Test + @Test subroutine test_make_geom() type(ESMF_HConfig) :: hconfig type(ESMF_Geom) :: geom @@ -33,7 +33,7 @@ contains end subroutine test_make_geom - !@Test + @Test subroutine test_create_output_bundle() type(ESMF_HConfig) :: hconfig_geom, hconfig_hist type(ESMF_Geom) :: geom @@ -80,7 +80,7 @@ contains end subroutine test_create_output_bundle - !@Test + @Test subroutine test_replace_delimiter() character(len=:), allocatable :: d, r character(len=*), parameter :: A = 'bread' @@ -120,7 +120,7 @@ contains end subroutine test_replace_delimiter - !@Test + @Test subroutine test_get_expression_variables() type(StringVector) :: variables type(StringVectorIterator) :: iter @@ -141,7 +141,7 @@ contains end subroutine test_get_expression_variables - !@Test + @Test subroutine test_parse_item_common() type(ESMF_HConfig) :: hconfig type(ESMF_HConfigIter) :: hc_iter, hc_iter_begin, hc_iter_end @@ -199,7 +199,7 @@ contains end subroutine test_set_start_stop_time - !@Test + @Test subroutine test_create_output_alarm() type(ESMF_HConfig) :: hconfig type(ESMF_Time) :: time,start_stop_time(2) @@ -237,45 +237,45 @@ contains end subroutine test_create_output_alarm - @Test - subroutine test_get_output_info_bundle() - type(ESMF_HConfig) :: hconfig_geom, hconfig_hist - type(ESMF_Geom) :: geom - type(ESMF_Grid) :: grid - integer :: rank,fieldCount - integer :: status - logical :: found - type(ESMF_State) :: state, substate - type(ESMF_FieldBundle) :: bundle - type(ESMF_Field) :: field - type(OutputInfoSet) :: out_set - - !call ESMF_Initialize(_RC) - hconfig_geom = ESMF_HConfigCreate(content= & - "{geom: {class: latlon, im_world: 14, jm_world: 13, pole: PC, " // & - "dateline: DC, nx: 1, ny: 1}}", _RC) - geom = make_geom(hconfig_geom, _RC) - call ESMF_GeomGet(geom, grid=grid, _RC) - - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R4, name="E_1", _RC) - substate = ESMF_StateCreate(fieldList=[field], name= "DYN", _RC) - state = ESMF_Statecreate(nestedStateList=[substate],_RC) - - hconfig_hist = ESMF_HConfigCreate(content= & - "{var_list: {E1: {expr: DYN.E_1}}}", _RC) - - bundle = create_output_bundle(hconfig_hist, state, _RC) - out_set = get_output_info_bundle(bundle, _RC) - !@assertEqual(1, out_set%size(), 'There should be one element.') + !@Test +! subroutine test_get_output_info_bundle() +! type(ESMF_HConfig) :: hconfig_geom, hconfig_hist +! type(ESMF_Geom) :: geom +! type(ESMF_Grid) :: grid +! integer :: rank,fieldCount +! integer :: status +! logical :: found +! type(ESMF_State) :: state, substate +! type(ESMF_FieldBundle) :: bundle +! type(ESMF_Field) :: field +! type(OutputInfoSet) :: out_set +! +! !call ESMF_Initialize(_RC) +! hconfig_geom = ESMF_HConfigCreate(content= & +! "{geom: {class: latlon, im_world: 14, jm_world: 13, pole: PC, " // & +! "dateline: DC, nx: 1, ny: 1}}", _RC) +! geom = make_geom(hconfig_geom, _RC) +! call ESMF_GeomGet(geom, grid=grid, _RC) +! +! field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R4, name="E_1", _RC) +! substate = ESMF_StateCreate(fieldList=[field], name= "DYN", _RC) +! state = ESMF_Statecreate(nestedStateList=[substate],_RC) +! +! hconfig_hist = ESMF_HConfigCreate(content= & +! "{var_list: {E1: {expr: DYN.E_1}}}", _RC) +! +! bundle = create_output_bundle(hconfig_hist, state, _RC) +! out_set = get_output_info_bundle(bundle, _RC) +! !@assertEqual(1, out_set%size(), 'There should be one element.') ! call ESMF_HConfigDestroy(hconfig_hist, _RC) - !call ESMF_FieldBundleDestroy(bundle, nogarbage=.true. ,_RC) - !call ESMF_FieldDestroy(field, nogarbage=.true., _RC) - !call ESMF_StateDestroy(state, nogarbage=.true., _RC) - !call ESMF_GridDestroy(grid, nogarbage=.true., _RC) - !call ESMF_GeomDestroy(geom, _RC) - !call ESMF_HConfigDestroy(hconfig_geom, _RC) - !call ESMF_Finalize() - - end subroutine test_get_output_info_bundle +! !call ESMF_FieldBundleDestroy(bundle, nogarbage=.true. ,_RC) +! !call ESMF_FieldDestroy(field, nogarbage=.true., _RC) +! !call ESMF_StateDestroy(state, nogarbage=.true., _RC) +! !call ESMF_GridDestroy(grid, nogarbage=.true., _RC) +! !call ESMF_GeomDestroy(geom, _RC) +! !call ESMF_HConfigDestroy(hconfig_geom, _RC) +! !call ESMF_Finalize() +! +! end subroutine test_get_output_info_bundle end module Test_HistoryCollectionGridComp From 71a13a0088183ff7ff6e68679f57dcb46e31c1be Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 14 May 2024 17:27:33 -0400 Subject: [PATCH 06/23] All tests pass for output info objects. --- gridcomps/History3G/OutputInfo.F90 | 39 ++++++---- gridcomps/History3G/UngriddedDimInfo.F90 | 39 ++++++---- gridcomps/History3G/tests/CMakeLists.txt | 2 + gridcomps/History3G/tests/Test_OutputInfo.pf | 20 +++--- .../History3G/tests/Test_OutputInfoSet.pf | 8 +-- .../History3G/tests/Test_UngriddedDimInfo.pf | 72 +++++++++---------- .../tests/history3g_test_utility_procedures.h | 63 ++++++++++++---- .../tests/history3g_test_utility_variables.h | 2 +- 8 files changed, 146 insertions(+), 99 deletions(-) diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index cd817f707126..d93b9366518b 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -2,7 +2,7 @@ module mapl3g_output_info use mapl3g_ungridded_dim_info - use esmf, only: ESMF_Info, ESMF_InfoGet, ESMF_InfoGetCharAlloc + use esmf, only: ESMF_Info, ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoCreate, ESMF_InfoDestroy use Mapl_ErrorHandling implicit none @@ -21,7 +21,7 @@ module mapl3g_output_info end type OutputInfo interface OutputInfo - module procedure :: construct_object + module procedure :: construct_output_info end interface OutputInfo interface operator(<) @@ -33,33 +33,42 @@ module mapl3g_output_info end interface character(len=*), parameter :: PREFIX = 'MAPL/' + character(len=*), parameter :: KEY_UNGRID_DIM = 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_VLOC = 'vloc' + character(len=*), parameter :: KEY_NUM_LEVELS = 'num_levels' contains - function construct_object(info, rc) result(obj) + function construct_output_info(info, rc) result(obj) type(OutputInfo) :: obj type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status - integer :: num_levels, num_ungridded + integer :: num_levels character(len=:), allocatable :: vloc + type(ESMF_Info) :: inner_info - call ESMF_InfoGet(info, PREFIX // 'num_levels', num_levels, _RC) - _HERE, 'num_levels = ', num_levels - call ESMF_InfoGetCharAlloc(info, PREFIX // 'vloc', vloc, _RC) - _HERE, 'vloc = ', vloc - call ESMF_InfoGet(info, PREFIX // 'num_ungridded', num_ungridded, _RC) - _HERE, 'num_ungridded = ', num_ungridded + inner_info = ESMF_InfoCreate(info, key=KEY_UNGRID_DIM, _RC) + obj%ungridded_dims = UngriddedDimsInfo(inner_info, _RC) + call ESMF_InfoDestroy(inner_info, _RC) - obj%num_levels = num_levels + inner_info = ESMF_InfoCreate(info, key=KEY_VERT_DIM, _RC) + call ESMF_InfoGetCharAlloc(inner_info, key=KEY_VLOC, value=vloc, _RC) obj%vloc = vloc - obj%ungridded_dims = UngriddedDimsInfo(info, _RC) - _ASSERT(size(obj%ungridded_dims) == num_ungridded, 'Size of ungridded_dims does not match num_ungridded info.') + call ESMF_InfoDestroy(inner_info, _RC) + + inner_info = ESMF_InfoCreate(info, key=KEY_VERT_GEOM, _RC) + call ESMF_InfoGet(inner_info, key=KEY_NUM_LEVELS, value=num_levels, _RC) + obj%num_levels = num_levels + call ESMF_InfoDestroy(inner_info, _RC) - _HERE, 'Exiting construct_object' + _HERE, 'Exiting construct_output_info' _RETURN(_SUCCESS) - end function construct_object + end function construct_output_info integer function num_ungridded(this) class(OutputInfo), intent(in) :: this diff --git a/gridcomps/History3G/UngriddedDimInfo.F90 b/gridcomps/History3G/UngriddedDimInfo.F90 index 475bc99032b4..2a43ee634c1c 100644 --- a/gridcomps/History3G/UngriddedDimInfo.F90 +++ b/gridcomps/History3G/UngriddedDimInfo.F90 @@ -1,7 +1,7 @@ #include "MAPL_Generic.h" module mapl3g_ungridded_dim_info - use esmf, only: ESMF_Info, ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoGetAlloc + use esmf, only: ESMF_Info, ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoCreate, ESMF_InfoDestroy use Mapl_ErrorHandling implicit none @@ -22,7 +22,7 @@ module mapl3g_ungridded_dim_info end type UngriddedDimInfo interface UngriddedDimInfo - module procedure :: construct + module procedure :: construct_ungridded_dim_info end interface UngriddedDimInfo interface UngriddedDimsInfo @@ -37,27 +37,36 @@ module mapl3g_ungridded_dim_info module procedure :: equal end interface + character(len=*), parameter :: KEY_NUM_UNGRID = 'num_ungridded_dimensions' + character(len=*), parameter :: KEYSTUB_DIM = 'dim_' + character(len=*), parameter :: KEY_NAME = 'name' + character(len=*), parameter :: KEY_UNITS = 'units' + character(len=*), parameter :: KEY_COORS = 'coordinates' + contains - function construct(info_in, unit_prefix, rc) result(obj) + function construct_ungridded_dim_info(info_in, rc) result(obj) type(UngriddedDimInfo) :: obj type(ESMF_Info), intent(in) :: info_in - character(len=*), intent(in) :: unit_prefix integer, optional, intent(out) :: rc integer :: status character(len=:), allocatable :: name character(len=:), allocatable :: units real, allocatable :: coordinates(:) + integer :: sz - call ESMF_InfoGetCharAlloc(info_in, key=unit_prefix//'name', value=name, _RC) - call ESMF_InfoGetCharAlloc(info_in, unit_prefix//'units', units, _RC) - call ESMF_InfoGetAlloc(info_in, unit_prefix//'coordinates', coordinates, _RC) + call ESMF_InfoGetCharAlloc(info_in, key='name', value=name, _RC) + call ESMF_InfoGetCharAlloc(info_in, key='units', value=units, _RC) + call ESMF_InfoGet(info_in, key='coordinates', size=sz, _RC) + allocate(coordinates(sz)) + call ESMF_InfoGet(info_in, key='coordinates', values=coordinates, _RC) obj%name = name obj%units = units obj%coordinates = coordinates _RETURN(_SUCCESS) - end function construct + + end function construct_ungridded_dim_info pure function name_units(this) result(nu) character(len=:), allocatable :: nu @@ -76,17 +85,17 @@ pure integer function coordinate_dims(this) end function coordinate_dims - function get_array(info_in, rc) result(array) - type(ESMF_Info), intent(in) :: info_in + function get_array(info, rc) result(array) + type(UngriddedDimInfo), allocatable :: array(:) + type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc - character(len=*), parameter :: PREFIX = 'MAPL/' integer :: status integer :: num_ungridded integer :: i, ios character(len=32) :: stri - type(UngriddedDimInfo), allocatable :: array(:) + type(ESMF_Info) :: info_unit - call ESMF_InfoGet(info_in, PREFIX // 'num_ungridded', num_ungridded, _RC) + call ESMF_InfoGet(info, KEY_NUM_UNGRID, num_ungridded, _RC) _ASSERT(num_ungridded >= 0, 'num_ungridded must be nonnegative.') allocate(array(num_ungridded)) if(num_ungridded == 0) then @@ -95,7 +104,9 @@ function get_array(info_in, rc) result(array) do i= 1, num_ungridded write(stri, fmt='(I0)', iostat=ios) i _ASSERT(ios == 0, 'failed to create ith ungridded dim index string') - array(i) = UngriddedDimInfo(info_in, PREFIX // 'dim_' // trim(adjustl(stri)) // '/') + info_unit = ESMF_InfoCreate(info, key=KEYSTUB_DIM // trim(adjustl(stri)), _RC) + array(i) = UngriddedDimInfo(info_unit, _RC) + call ESMF_InfoDestroy(info_unit, _RC) end do _RETURN(_SUCCESS) diff --git a/gridcomps/History3G/tests/CMakeLists.txt b/gridcomps/History3G/tests/CMakeLists.txt index 9ac4edd9d8b5..e771d46b81a1 100644 --- a/gridcomps/History3G/tests/CMakeLists.txt +++ b/gridcomps/History3G/tests/CMakeLists.txt @@ -4,6 +4,8 @@ set (test_srcs Test_HistoryGridComp.pf Test_HistoryCollectionGridComp.pf Test_UngriddedDimInfo.pf + Test_OutputInfo.pf + Test_OutputInfoSet.pf ) add_pfunit_ctest(MAPL.history3g.tests diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_OutputInfo.pf index a91c95e62e38..f4b0f40a52e2 100644 --- a/gridcomps/History3G/tests/Test_OutputInfo.pf +++ b/gridcomps/History3G/tests/Test_OutputInfo.pf @@ -13,8 +13,8 @@ contains #include "history3g_test_utility_procedures.h" - !@Test - subroutine test_construct_object() + @Test + subroutine test_construct_output_info() type(ESMF_Info) :: info type(OutputInfo) :: out_info type(UngriddedDimInfo) :: ungrid_info @@ -23,7 +23,7 @@ contains integer :: status info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) + call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) out_info = OutputInfo(info, _RC) @assertEqual(out_info%num_levels, NUM_LEVELS, 'num_levels does not match.') @assertEqual(out_info%vloc, VLOC, 'vloc does not match.') @@ -39,7 +39,7 @@ contains call ESMF_InfoDestroy(info) - end subroutine test_construct_object + end subroutine test_construct_output_info !@Test subroutine test_less() @@ -49,13 +49,13 @@ contains integer :: status info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) + call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) out_info_1 = OutputInfo(info, _RC) call ESMF_InfoDestroy(info) names = [character(len=2) :: 'A2', 'A3', 'A4' ] info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, names=names, _RC) + call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, names=names, _RC) out_info_2 = OutputInfo(info, _RC) call ESMF_InfoDestroy(info) @@ -63,28 +63,28 @@ contains units = [character(len=8) :: 'tons', 'volts', 'watts'] info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, units_array=units, _RC) + call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, units_array=units, _RC) out_info_2 = OutputInfo(info, _RC) call ESMF_InfoDestroy(info) @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 units are smaller than OutputInfo2 units.') info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, PREFIX, NUM_LEVELS+1, VLOC, NUM_UNGRIDDED, _RC) + call make_esmf_info(info, NUM_LEVELS+1, VLOC, NUM_UNGRIDDED, _RC) out_info_2 = OutputInfo(info, _RC) call ESMF_InfoDestroy(info) @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 num_levels are smaller than OutputInfo2 num_levels.') info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED+1, _RC) + call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED+1, _RC) out_info_2 = OutputInfo(info, _RC) call ESMF_InfoDestroy(info) @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 ungridded are smaller than OutputInfo2 num_ungridded.') info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, PREFIX, NUM_LEVELS, 'VERTICAL_DIM_EDGE', NUM_UNGRIDDED, _RC) + call make_esmf_info(info, NUM_LEVELS, 'VERTICAL_DIM_EDGE', NUM_UNGRIDDED, _RC) out_info_2 = OutputInfo(info, _RC) call ESMF_InfoDestroy(info) diff --git a/gridcomps/History3G/tests/Test_OutputInfoSet.pf b/gridcomps/History3G/tests/Test_OutputInfoSet.pf index eb43d0f7919f..7ed87f6128d8 100644 --- a/gridcomps/History3G/tests/Test_OutputInfoSet.pf +++ b/gridcomps/History3G/tests/Test_OutputInfoSet.pf @@ -14,7 +14,7 @@ contains #include "history3g_test_utility_procedures.h" - !@Test + @Test subroutine test_insert() type(ESMF_Info) :: info type(OutputInfo) :: outinfo1, outinfo2, outinfo3 @@ -22,7 +22,7 @@ contains integer :: status info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) + call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) outinfo1 = OutputInfo(info, _RC) call ESMF_InfoDestroy(info) outinfo_set = OutputInfoSet() @@ -30,7 +30,7 @@ contains call outinfo_set%insert(outinfo1) info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, PREFIX, NUM_LEVELS+1, VLOC, NUM_UNGRIDDED, _RC) + call make_esmf_info(info, NUM_LEVELS+1, VLOC, NUM_UNGRIDDED, _RC) outinfo2 = OutputInfo(info, _RC) call ESMF_InfoDestroy(info) call outinfo_set%insert(outinfo2) @@ -38,7 +38,7 @@ contains @assertEqual(2, outinfo_set%size(), 'Size of set should be 2.') info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, PREFIX, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) + call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) outinfo3 = OutputInfo(info, _RC) call ESMF_InfoDestroy(info) call outinfo_set%insert(outinfo3) diff --git a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf index bf965db551ff..108ee61af3e1 100644 --- a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf +++ b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf @@ -14,7 +14,7 @@ module Test_UngriddedDimInfo contains - !@Test + @Test subroutine test_construct() integer :: status type(ESMF_Info) :: info @@ -22,15 +22,13 @@ contains real, allocatable :: coordinates(:) character(len=:), allocatable :: name character(len=:), allocatable :: units - character(len=:), allocatable :: unit_prefix name = 'G1' units = 'stones' - unit_prefix = 'IthComp' coordinates = [1.0, 2.0, 3.0, 4.0] info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, unit_prefix, name, units, coordinates, _RC) - obj = UngriddedDimInfo(info, unit_prefix, _RC) + call make_esmf_info(info, name, units, coordinates, _RC) + obj = UngriddedDimInfo(info, _RC) @assertEqual(name, obj%name, NAME_LABEL // ' does not match.') @assertEqual(units, obj%units, UNITS_LABEL // 'units does not match.') @assertEqual(coordinates, obj%coordinates, COORDINATES_LABEL // ' does not match.') @@ -38,7 +36,7 @@ contains end subroutine test_construct - !@Test + @Test subroutine test_name_units() integer :: status type(ESMF_Info) :: info @@ -46,23 +44,21 @@ contains real, allocatable :: coordinates(:) character(len=:), allocatable :: name character(len=:), allocatable :: units - character(len=:), allocatable :: unit_prefix character(len=:), allocatable :: NAME_UNITS name = 'G1' units = 'stones' NAME_UNITS = name // units - unit_prefix = 'IthComp' coordinates = [1.0, 2.0, 3.0, 4.0] info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, unit_prefix, name, units, coordinates, _RC) - obj = UngriddedDimInfo(info, unit_prefix, _RC) + call make_esmf_info(info, name, units, coordinates, _RC) + obj = UngriddedDimInfo(info, _RC) @assertEqual(NAME_UNITS, obj%name_units(), NAME_UNITS // '() does not match expected ' // NAME_UNITS // '.') call ESMF_InfoDestroy(info) end subroutine test_name_units - !@Test + @Test subroutine test_coordinate_dims() integer :: status, ios type(ESMF_Info) :: info @@ -70,40 +66,37 @@ contains real, allocatable :: coordinates(:) character(len=:), allocatable :: name character(len=:), allocatable :: units - character(len=:), allocatable :: unit_prefix character(len=32) :: dims_string name = 'G1' units = 'stones' - unit_prefix = 'IthComp' coordinates = [1.0, 2.0, 3.0, 4.0] write(dims_string, fmt='(I0)', iostat=ios) size(coordinates) @assertEqual(0, ios, 'write to dims_string failed.') info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, unit_prefix, name, units, coordinates, _RC) - obj = UngriddedDimInfo(info, unit_prefix, _RC) + call make_esmf_info(info, name, units, coordinates, _RC) + obj = UngriddedDimInfo(info, _RC) @assertEqual(size(coordinates), obj%coordinate_dims(), 'coordinate_dims() does not match expected value ' // trim(dims_string) // '.') call ESMF_InfoDestroy(info) end subroutine test_coordinate_dims - !@Test + @Test subroutine test_less() integer :: status real, allocatable :: coordinates(:, :) real, allocatable :: coordinate_vector(:) type(ESMF_Info) :: info1, info2 type(UngriddedDimInfo) :: obj1, obj2 - character(len=*), parameter :: UNIT_PREFIX = 'IthComp' coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 4.0] coordinates = reshape(coordinate_vector, [4, 2]) info1 = ESMF_InfoCreate(_RC) - call make_esmf_info(info1, unit_prefix, 'G1', 'kg', coordinates(:, 1), _RC) - obj1 = UngriddedDimInfo(info1, unit_prefix, _RC) + call make_esmf_info(info1, 'G1', 'kg', coordinates(:, 1), _RC) + obj1 = UngriddedDimInfo(info1, _RC) info2 = ESMF_InfoCreate(_RC) - call make_esmf_info(info2, unit_prefix, 'G1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + call make_esmf_info(info2, 'G1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, _RC) @assertFalse(obj1 < obj2, 'obj1 is not less than obj2.') @assertFalse(obj2 < obj1, 'obj2 is not less than obj1.') @@ -112,8 +105,8 @@ contains info2 = ESMF_InfoCreate(_RC) coordinate_vector = [1.0, 2.0, 3.0, 4.0, 2.0, 2.0, 3.0, 4.0] coordinates = reshape(coordinate_vector, [4, 2]) - call make_esmf_info(info2, unit_prefix, 'G1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + call make_esmf_info(info2, 'G1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, _RC) @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') @@ -121,8 +114,8 @@ contains info2 = ESMF_InfoCreate(_RC) coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 3.0, 3.0, 4.0] coordinates = reshape(coordinate_vector, [4, 2]) - call make_esmf_info(info2, unit_prefix, 'G1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + call make_esmf_info(info2, 'G1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, _RC) @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') @@ -130,8 +123,8 @@ contains info2 = ESMF_InfoCreate(_RC) coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 4.0, 4.0] coordinates = reshape(coordinate_vector, [4, 2]) - call make_esmf_info(info2, unit_prefix, 'G1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + call make_esmf_info(info2, 'G1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, _RC) @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') @@ -139,8 +132,8 @@ contains info2 = ESMF_InfoCreate(_RC) coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 5.0] coordinates = reshape(coordinate_vector, [4, 2]) - call make_esmf_info(info2, unit_prefix, 'g1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + call make_esmf_info(info2, 'g1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, _RC) @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') @@ -148,39 +141,38 @@ contains info2 = ESMF_InfoCreate(_RC) coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.1, 2.0, 3.0] coordinates = reshape(coordinate_vector, [4, 2]) - call make_esmf_info(info2, unit_prefix, 'G1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + call make_esmf_info(info2, 'G1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, _RC) @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') call ESMF_InfoDestroy(info2) info2 = ESMF_InfoCreate(_RC) coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 4.0] - call make_esmf_info(info2, unit_prefix, 'H1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + call make_esmf_info(info2, 'H1', 'kg', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, _RC) @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') call ESMF_InfoDestroy(info2) info2 = ESMF_InfoCreate(_RC) coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 4.0] - call make_esmf_info(info2, unit_prefix, 'G1', 'stone', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, unit_prefix, _RC) + call make_esmf_info(info2, 'G1', 'stone', coordinates(:, 2), _RC) + obj2 = UngriddedDimInfo(info2, _RC) @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') end subroutine test_less - subroutine make_esmf_info(info, unit_prefix, name, units, coordinates, rc) + subroutine make_esmf_info(info, name, units, coordinates, rc) type(ESMF_Info), intent(inout) :: info - character(len=*), intent(in) :: unit_prefix character(len=*), intent(in) :: name character(len=*), intent(in) :: units real, intent(in) :: coordinates(:) integer, optional, intent(out) :: rc integer :: status - call ESMF_InfoSet(info, unit_prefix // NAME_LABEL, name, _RC) - call ESMF_InfoSet(info, unit_prefix // UNITS_LABEL, units, _RC) - call ESMF_InfoSet(info, unit_prefix // COORDINATES_LABEL, coordinates, _RC) + call ESMF_InfoSet(info, NAME_LABEL, name, _RC) + call ESMF_InfoSet(info, UNITS_LABEL, units, _RC) + call ESMF_InfoSet(info, COORDINATES_LABEL, coordinates, _RC) end subroutine make_esmf_info diff --git a/gridcomps/History3G/tests/history3g_test_utility_procedures.h b/gridcomps/History3G/tests/history3g_test_utility_procedures.h index 3bb38dbd0e25..894f1557e8f7 100644 --- a/gridcomps/History3G/tests/history3g_test_utility_procedures.h +++ b/gridcomps/History3G/tests/history3g_test_utility_procedures.h @@ -1,41 +1,74 @@ #define SET_RC if(present(rc)) rc = status - subroutine make_esmf_info(info, prefix, num_levels, vloc, num_ungridded, names, units_array, rc) + subroutine make_esmf_info(info, num_levels, vloc, num_ungridded, names, units_array, rc) type(ESMF_Info), intent(inout) :: info - character(len=*), intent(in) :: prefix integer, intent(in) :: num_levels character(len=*), intent(in) :: vloc integer, intent(in) :: num_ungridded character(len=*), optional, intent(in) :: names(:) character(len=*), optional, intent(in) :: units_array(:) integer, optional, intent(out) :: rc + integer :: status character(len=*), parameter :: NUMLEV_LABEL = 'num_levels' character(len=*), parameter :: VLOC_LABEL = 'vloc' character(len=*), parameter :: NUM_UNGRID_LABEL = 'num_ungridded' - integer :: status + type(ESMF_Info) :: inner_info + - call ESMF_InfoSet(info, prefix // NUMLEV_LABEL, num_levels, _RC) - call ESMF_InfoSet(info, prefix // VLOC_LABEL, vloc, _RC) - call make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, _RC) + inner_info = ESMF_InfoCreate(_RC) + call make_vertical_dim(inner_info, VLOC_LABEL, vloc, _RC) + call ESMF_InfoSet(info, PREFIX // 'vertical_dim', value=inner_info, _RC) + call ESMF_InfoDestroy(inner_info, _RC) + + inner_info = ESMF_InfoCreate(_RC) + call make_vertical_geom(inner_info, NUMLEV_LABEL, num_levels, _RC) + call ESMF_InfoSet(info, PREFIX // 'vertical_geom', value=inner_info, _RC) + call ESMF_InfoDestroy(inner_info, _RC) + + inner_info = ESMF_InfoCreate(_RC) + call make_ungridded_dims_info(inner_info, num_ungridded, names, units_array, _RC) + call ESMF_InfoSet(info, PREFIX // 'ungridded_dims', value=inner_info, _RC) + call ESMF_InfoDestroy(inner_info, _RC) SET_RC end subroutine make_esmf_info - subroutine make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, rc) + subroutine make_vertical_dim(info, label, value, rc) + type(ESMF_Info), intent(inout) :: info + character(len=*), intent(in) :: label + character(len=*), intent(in) :: value + integer, optional, intent(out) :: rc + integer :: status + + call ESMF_InfoSet(info, label, value, _RC) + + end subroutine make_vertical_dim + + subroutine make_vertical_geom(info, label, value, rc) + type(ESMF_Info), intent(inout) :: info + character(len=*), intent(in) :: label + integer, intent(in) :: value + integer, optional, intent(out) :: rc + integer :: status + + call ESMF_InfoSet(info, label, value, _RC) + + end subroutine make_vertical_geom + + subroutine make_ungridded_dims_info(info, num_ungridded, names, units_array, rc) type(ESMF_Info), intent(inout) :: info - character(len=*), intent(in) :: prefix integer, intent(in) :: num_ungridded character(len=*), optional, intent(in) :: names(:) character(len=*), optional, intent(in) :: units_array(:) integer, optional, intent(out) :: rc + integer :: status, i character(len=*), parameter :: NAME_LABEL = 'name' character(len=*), parameter :: UNITS_LABEL = 'units' character(len=*), parameter :: COORDINATES_LABEL = 'coordinates' real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] type(ESMF_Info) :: comp_info character(len=:), allocatable :: name_, units_ - integer :: status, i status = -1 @@ -55,24 +88,24 @@ units_ = UNITS if(present(units_array)) units_ = units_array(i) comp_info = ESMF_InfoCreate(_RC) - call ESMF_InfoSet(comp_info, prefix // NAME_LABEL, name_, _RC) - call ESMF_InfoSet(comp_info, prefix // UNITS_LABEL, units_, _RC) - call ESMF_InfoSet(comp_info, prefix // COORDINATES_LABEL, COORDINATES, _RC) - call ESMF_InfoSet(info, prefix // make_component_label(i), comp_info, _RC) + call ESMF_InfoSet(comp_info, NAME_LABEL, name_, _RC) + call ESMF_InfoSet(comp_info, UNITS_LABEL, units_, _RC) + call ESMF_InfoSet(comp_info, COORDINATES_LABEL, COORDINATES, _RC) + call ESMF_InfoSet(info, make_component_label(i), comp_info, _RC) call ESMF_InfoDestroy(comp_info) end do SET_RC - end subroutine make_esmf_ungridded_info + end subroutine make_ungridded_dims_info function make_component_label(n, rc) result(name) character(len=:), allocatable :: name integer, intent(in) :: n integer, optional, intent(out) :: rc + integer :: status character(len=*), parameter :: COMP_PREFIX = 'dim_' character(len=32) :: strn - integer :: status write(strn, fmt='(I0)', iostat=status) n if(status == 0) name = COMP_PREFIX // trim(adjustl(strn)) diff --git a/gridcomps/History3G/tests/history3g_test_utility_variables.h b/gridcomps/History3G/tests/history3g_test_utility_variables.h index 788e2a23b908..4379551461d0 100644 --- a/gridcomps/History3G/tests/history3g_test_utility_variables.h +++ b/gridcomps/History3G/tests/history3g_test_utility_variables.h @@ -1,5 +1,5 @@ - character(len=*), parameter :: PREFIX = 'MAPL/G1/' + character(len=*), parameter :: PREFIX = 'MAPL/' integer, parameter :: NUM_LEVELS = 3 character(len=*), parameter :: VLOC = 'VERTICAL_DIM_CENTER' integer, parameter :: NUM_UNGRIDDED = 3 From 264154cc29176b7e73b306e41d5f6888cf4096ce Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 15 May 2024 18:26:04 -0400 Subject: [PATCH 07/23] Begin refactor --- gridcomps/History3G/CMakeLists.txt | 3 +- .../HistoryCollectionGridComp_private.F90 | 40 ++-- gridcomps/History3G/OutputInfo.F90 | 221 +++++++++++------- gridcomps/History3G/UngriddedDimInfo.F90 | 54 +---- gridcomps/History3G/UngriddedDimInfoSet.F90 | 16 ++ gridcomps/History3G/UngriddedDimsInfo.F90 | 57 +++++ gridcomps/History3G/tests/Test_OutputInfo.pf | 82 ++----- .../History3G/tests/Test_UngriddedDimInfo.pf | 4 +- .../tests/history3g_test_utilities.F90 | 103 ++++++++ .../tests/history3g_test_utility_procedures.h | 24 +- .../tests/history3g_test_utility_variables.h | 12 +- 11 files changed, 398 insertions(+), 218 deletions(-) create mode 100644 gridcomps/History3G/UngriddedDimInfoSet.F90 create mode 100644 gridcomps/History3G/UngriddedDimsInfo.F90 create mode 100644 gridcomps/History3G/tests/history3g_test_utilities.F90 diff --git a/gridcomps/History3G/CMakeLists.txt b/gridcomps/History3G/CMakeLists.txt index 8ee31c825e28..6f7171357596 100644 --- a/gridcomps/History3G/CMakeLists.txt +++ b/gridcomps/History3G/CMakeLists.txt @@ -6,8 +6,9 @@ set(srcs HistoryCollectionGridComp.F90 HistoryCollectionGridComp_private.F90 OutputInfo.F90 - OutputInfoSet.F90 UngriddedDimInfo.F90 + UngriddedDimInfoSet.F90 + UngriddedDimsInfo.F90 ) find_package (MPI REQUIRED) diff --git a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 index 9ed01fa5328e..45dd3b6e8871 100644 --- a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 +++ b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 @@ -11,7 +11,7 @@ module mapl3g_HistoryCollectionGridComp_private use MAPL_TimeStringConversion use MAPL_BaseMod, only: MAPL_UnpackTime use mapl3g_output_info - use mapl3g_output_info_set + use gFTL2_StringSet implicit none private @@ -188,25 +188,31 @@ function set_start_stop_time(clock, hconfig, rc) result(start_stop_time) _RETURN(_SUCCESS) end function set_start_stop_time - function get_output_info_bundle(bundle, rc) result(out_set) - type(OutputInfoSet) :: out_set + subroutine get_output_info_bundle(bundle, num_levels, vertical_dim_spec_names, ungridded_dims_info, rc) result(out_set) type(ESMF_FieldBundle) :: bundle + integer, optional, intent(out) :: num_levels + type(StringSet), optional, intent(out) :: vertical_dim_spec_names + type(UngriddedDimInfoSet), optional, intent(out) :: ungridded_dims_info integer, optional, intent(out) :: rc integer :: status - type(ESMF_Field), allocatable :: fields(:) - integer :: i, field_count - type(OutputInfo) :: item - type(ESMF_Info) :: info - - call ESMF_FieldBundleGet(bundle, fieldCount=field_count, _RC) - allocate(fields(field_count)) - call ESMF_FieldBundleGet(bundle, fieldList=fields, _RC) - do i = 1, size(fields) - call ESMF_InfoGetFromHost(fields(i), info, _RC) - item = OutputInfo(info, _RC) - call out_set%insert(item) - end do - end function get_output_info_bundle + + output_present = present(num_levels) .or. present(vertical_dim_spec_names) .or. present(ungridded_dims_info) + _ASSERT(, ERROR_MSG) + + if(present(num_levels)) then + num_levels = get_num_levels(bundle, _RC) + _RETURN_UNLESS(present(vertical_dim_spec_names) .or. present(ungridded_dims_info)) + end if + + if(present(vertical_dim_spec_names)) then + vertical_dim_spec_names = get_vertical_dim_spec_names(bundle, _RC) + _RETURN_UNLESS(present(ungridded_dims_info)) + endif + + ungridded_dims_info = get_ungridded_dims_info(bundle, _RC) + _RETURN(_SUCCESS) + + end subroutine get_output_info_bundle subroutine parse_item_expression(item, item_name, var_names, rc) type(ESMF_HConfigIter), intent(in) :: item diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index d93b9366518b..d4d910d02508 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -1,36 +1,29 @@ #include "MAPL_Generic.h" module mapl3g_output_info - use mapl3g_ungridded_dim_info - use esmf, only: ESMF_Info, ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoCreate, ESMF_InfoDestroy + use mapl3g_ungridded_dims_info + use esmf, only: ESMF_Field, ESMF_FieldBundle, ESMF_Info, ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoCreate, ESMF_InfoDestroy use Mapl_ErrorHandling implicit none private - public :: OutputInfo - public :: operator(<) - public :: operator(==) + public :: get_num_levels + public :: get_vertical_dim_spec_names + public :: get_ungridded_dims_info + public :: UngriddedDimInfoSet - type :: OutputInfo - integer :: num_levels - character(len=:), allocatable :: vloc - type(UngriddedDimInfo), allocatable :: ungridded_dims(:) - contains - procedure :: num_ungridded - end type OutputInfo + interface get_num_levels + module procedure :: get_num_levels_bundle + end interface get_num_levels - interface OutputInfo - module procedure :: construct_output_info - end interface OutputInfo + interface get_vertical_dim_spec_names + module procedure :: get_vertical_dim_spec_names_bundle + end interface get_vertical_dim_spec_names - interface operator(<) - module procedure :: less - end interface - - interface operator(==) - module procedure :: equal - end interface + interface get_ungridded_dims_info + module procedure ::get_ungridded_dims_info_bundle + end interface get_ungridded_dims_info character(len=*), parameter :: PREFIX = 'MAPL/' character(len=*), parameter :: KEY_UNGRID_DIM = PREFIX // 'ungridded_dims' @@ -42,89 +35,161 @@ module mapl3g_output_info contains - function construct_output_info(info, rc) result(obj) - type(OutputInfo) :: obj + integer function get_num_levels_bundle(bundle, rc) result(num) + integer :: num + type(ESMF_FieldBundle), intent(in) :: bundle + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Field), allocatable :: fields(:) + integer :: nums(:) + integer :: sz + + fields = get_bundle_fields(bundle, _RC) + sz = size(fields) + _ASSERT(sz > 0, 'Empty ESMF_FieldBundle') + num = get_num_levels_field(fields(1), _RC) + _RETURN_IF(sz == 1) + nums = get_num_levels_field(fields(2:sz), _RC) + _ASSERT(all(nums == num), 'All fields must have the same number of vertical levels.') + + end function get_num_levels_bundle + + elemental integer function get_num_levels_field(field, rc) result(n) + type(ESMF_Field), intent(in) :: field + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info) :: info + + call ESMF_InfoGetFromHost(field, info, _RC) + n = get_num_levels_info(info, _RC) + call ESMF_InfoDestroy(info, _RC) + _RETURN(_SUCCESS) + + end function get_num_levels_field + + elemental integer function get_num_levels_info(info, rc) result(n) type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status - integer :: num_levels - character(len=:), allocatable :: vloc type(ESMF_Info) :: inner_info - inner_info = ESMF_InfoCreate(info, key=KEY_UNGRID_DIM, _RC) - obj%ungridded_dims = UngriddedDimsInfo(inner_info, _RC) + inner_info = ESMF_InfoCreate(info, key=KEY_VERT_GEOM, _RC) + call ESMF_InfoGet(inner_info, key=KEY_NUM_LEVELS, value=n, _RC) call ESMF_InfoDestroy(inner_info, _RC) + _RETURN(_SUCCESS) + + end function get_num_levels_info - inner_info = ESMF_InfoCreate(info, key=KEY_VERT_DIM, _RC) - call ESMF_InfoGetCharAlloc(inner_info, key=KEY_VLOC, value=vloc, _RC) - obj%vloc = vloc - call ESMF_InfoDestroy(inner_info, _RC) + function get_vertical_dim_spec_names_bundle(bundle, rc) result(names) + type(StringSet) :: names + type(ESMF_FieldBundle), intent(in) :: bundle + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Field), allocatable :: fields(:) + integer :: sz, i + character(len=:), allocatable :: name + + fields = get_bundle_fields(bundle, _RC) + sz = size(fields) + _ASSERT(sz > 0, 'Empty ESMF_FieldBundle') + + names = StringSet() + do i=1, sz + name = get_vertical_dim_spec_name_field(field, _RC) + call names%insert(name) + end do - inner_info = ESMF_InfoCreate(info, key=KEY_VERT_GEOM, _RC) - call ESMF_InfoGet(inner_info, key=KEY_NUM_LEVELS, value=num_levels, _RC) - obj%num_levels = num_levels - call ESMF_InfoDestroy(inner_info, _RC) + end function get_vertical_dim_spec_names_bundle - _HERE, 'Exiting construct_output_info' + elemental function get_vertical_dim_spec_name_field(field, rc) result(spec_name) + character(len=:), allocatable :: spec_name + type(ESMF_Field), intent(inout) :: field + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info) :: info + + call ESMF_InfoGetFromHost(field, info, _RC) + spec_name = get_vertical_dim_spec_name_info(info, _RC) + call ESMF_InfoDestroy(info, _RC) _RETURN(_SUCCESS) - end function construct_output_info + end function get_vertical_dim_spec_name_field - integer function num_ungridded(this) - class(OutputInfo), intent(in) :: this + elemental function get_vertical_dim_spec_name_info(info, rc) result(spec_name) + character(len=:), allocatable :: spec_name + type(ESMF_Info), intent(in) :: info + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info) :: inner_info - num_ungridded = size(this%ungridded_dims) + inner_info = ESMF_InfoCreate(info, key=KEY_VERT_DIM, _RC) + call ESMF_InfoGetCharAlloc(inner_info, key=KEY_VLOC, value=spec_name, _RC) + call ESMF_InfoDestroy(inner_info, _RC) + _RETURN(_SUCCESS) - end function num_ungridded + end function get_vertical_dim_spec_name_info - logical function less(a, b) result(t) - class(OutputInfo), intent(in) :: a, b - - t = a%num_levels < b%num_levels - if(t .or. a%num_levels > b%num_levels) return - t = a%vloc < b%vloc - if(t .or. a%vloc > b%vloc) return - t = ungridded_dims_less(a, b) + function get_ungridded_dims_info_bundle(bundle, rc) result(dim_info_set) + type(UngriddedDimInfoSet) :: dim_info_set + type(ESMF_FieldBundle), intent(in) :: bundle + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Field), allocatable :: fields(:) + type(UngriddedDimsInfo), allocatable :: dims_info(:) + integer :: i - end function less + fields = get_bundle_fields(bundle, _RC) + _ASSERT(size(fields) > 0, 'Empty ESMF_FieldBundle') - logical function not_equal(a, b) result(t) - class(OutputInfo), intent(in) :: a, b + dims_info = get_ungridded_dims_info_field(fields, _RC) + do i=1, size(fields) + call dim_info_set%merge(dims_info(i)%as_set()) + end do + _RETURN(_SUCCESS) - t = .not. (a == b) + end function get_ungridded_dims_info_bundle - end function not_equal + elemental function get_ungridded_dims_info_field(field, rc) result(ungridded) + type(UngriddedDimsInfo) :: ungridded + type(ESMF_Field), intent(inout) :: field + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info) :: info - logical function equal(a, b) result(t) - class(OutputInfo), intent(in) :: a, b + call ESMF_InfoGetFromHost(field, info, _RC) + ungridded = get_ungridded_dims_info_info(info, _RC) + call ESMF_InfoDestroy(info, _RC) + _RETURN(_SUCCESS) - t = a%num_levels == b%num_levels .and. a%vloc == b%vloc .and. ungridded_dims_equal(a, b) + end function get_ungridded_dims_info_field - end function equal + elemental function get_ungridded_dims_info_info(info, rc) result(ungridded) + type(UngriddedDimsInfo) :: ungridded + type(ESMF_Info), intent(in) :: info + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info) :: inner_info - logical function ungridded_dims_less(a, b) result(t) - class(OutputInfo), intent(in) :: a, b - logical, allocatable :: lt(:), gt(:) - integer :: i, n, nb + inner_info = ESMF_InfoCreate(info, key=KEY_UNGRID_DIM, _rc) + ungridded = get_ungridded_dims_info(inner_info, _rc) + call ESMF_InfoDestroy(inner_info, _rc) + _RETURN(_SUCCESS) - n = a%num_ungridded() - nb = b%num_ungridded() - t = n < nb - if(t .or. (nb < n)) return - lt = a%ungridded_dims < b%ungridded_dims - gt = b%ungridded_dims < a%ungridded_dims - do i=1, n - t = lt(i) - if(t .or. gt(i)) return - end do + end function get_ungridded_dims_info_info - end function ungridded_dims_less + function get_bundle_fields(bundle, rc) result(fields) + type(ESMF_Field), allocatable :: fields(:) + type(ESMF_FieldBundle), intent(in) :: bundle + integer, optional, intent(out) :: rc + integer :: status + integer :: field_count - logical function ungridded_dims_equal(a, b) result(t) - class(OutputInfo), intent(in) :: a, b + call ESMF_FieldBundleGet(bundle, fieldCount=field_count, _RC) + allocate(fields(field_count)) + call ESMF_FieldBundleGet(bundle, fieldList=fields, _RC) - t = (a%num_ungridded() == b%num_ungridded()) .and. all(a%ungridded_dims == b%ungridded_dims) + _RETURN(_SUCCESS) - end function ungridded_dims_equal + end function get_bundle_fields end module mapl3g_output_info diff --git a/gridcomps/History3G/UngriddedDimInfo.F90 b/gridcomps/History3G/UngriddedDimInfo.F90 index 2a43ee634c1c..b0a47329da82 100644 --- a/gridcomps/History3G/UngriddedDimInfo.F90 +++ b/gridcomps/History3G/UngriddedDimInfo.F90 @@ -5,10 +5,8 @@ module mapl3g_ungridded_dim_info use Mapl_ErrorHandling implicit none - private public :: UngriddedDimInfo - public :: UngriddedDimsInfo public :: operator(<) public :: operator(==) @@ -25,10 +23,6 @@ module mapl3g_ungridded_dim_info module procedure :: construct_ungridded_dim_info end interface UngriddedDimInfo - interface UngriddedDimsInfo - module procedure :: get_array - end interface UngriddedDimsInfo - interface operator(<) module procedure :: less end interface @@ -45,9 +39,9 @@ module mapl3g_ungridded_dim_info contains - function construct_ungridded_dim_info(info_in, rc) result(obj) - type(UngriddedDimInfo) :: obj - type(ESMF_Info), intent(in) :: info_in + function construct_ungridded_dim_info(info, rc) result(ud_info) + type(UngriddedDimInfo) :: ud_info + type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status character(len=:), allocatable :: name @@ -55,14 +49,14 @@ function construct_ungridded_dim_info(info_in, rc) result(obj) real, allocatable :: coordinates(:) integer :: sz - call ESMF_InfoGetCharAlloc(info_in, key='name', value=name, _RC) - call ESMF_InfoGetCharAlloc(info_in, key='units', value=units, _RC) - call ESMF_InfoGet(info_in, key='coordinates', size=sz, _RC) + call ESMF_InfoGetCharAlloc(info, key='name', value=name, _RC) + call ESMF_InfoGetCharAlloc(info, key='units', value=units, _RC) + call ESMF_InfoGet(info, key='coordinates', size=sz, _RC) allocate(coordinates(sz)) - call ESMF_InfoGet(info_in, key='coordinates', values=coordinates, _RC) - obj%name = name - obj%units = units - obj%coordinates = coordinates + call ESMF_InfoGet(info, key='coordinates', values=coordinates, _RC) + ud_info%name = name + ud_info%units = units + ud_info%coordinates = coordinates _RETURN(_SUCCESS) @@ -85,34 +79,6 @@ pure integer function coordinate_dims(this) end function coordinate_dims - function get_array(info, rc) result(array) - type(UngriddedDimInfo), allocatable :: array(:) - type(ESMF_Info), intent(in) :: info - integer, optional, intent(out) :: rc - integer :: status - integer :: num_ungridded - integer :: i, ios - character(len=32) :: stri - type(ESMF_Info) :: info_unit - - call ESMF_InfoGet(info, KEY_NUM_UNGRID, num_ungridded, _RC) - _ASSERT(num_ungridded >= 0, 'num_ungridded must be nonnegative.') - allocate(array(num_ungridded)) - if(num_ungridded == 0) then - _RETURN(_SUCCESS) - end if - do i= 1, num_ungridded - write(stri, fmt='(I0)', iostat=ios) i - _ASSERT(ios == 0, 'failed to create ith ungridded dim index string') - info_unit = ESMF_InfoCreate(info, key=KEYSTUB_DIM // trim(adjustl(stri)), _RC) - array(i) = UngriddedDimInfo(info_unit, _RC) - call ESMF_InfoDestroy(info_unit, _RC) - end do - - _RETURN(_SUCCESS) - - end function get_array - elemental function equal(a, b) result(t) logical :: t class(UngriddedDimInfo), intent(in) :: a, b diff --git a/gridcomps/History3G/UngriddedDimInfoSet.F90 b/gridcomps/History3G/UngriddedDimInfoSet.F90 new file mode 100644 index 000000000000..4f1aab331c3b --- /dev/null +++ b/gridcomps/History3G/UngriddedDimInfoSet.F90 @@ -0,0 +1,16 @@ +module mapl3g_ungridded_dim_set + use mapl3g_ungridded_dim_info + +#define T UngriddedDimInfo +#define T_LT(A, B) (A) < (B) +#define Set UngriddedDimInfoSet +#define SetIterator UngriddedDimInfoSetIterator + +#include "set/template.inc" + +#undef T +#undef T_LT +#undef Set +#undef SetIterator + +end module mapl3g_ungridded_dim_set diff --git a/gridcomps/History3G/UngriddedDimsInfo.F90 b/gridcomps/History3G/UngriddedDimsInfo.F90 new file mode 100644 index 000000000000..089d973ba8c3 --- /dev/null +++ b/gridcomps/History3G/UngriddedDimsInfo.F90 @@ -0,0 +1,57 @@ +#include "MAPL_Generic.h" +module mapl3g_ungridded_dims_info + + use mapl3g_ungridded_dim_info + use mapl3g_ungridded_dim_set + use esmf, only: ESMF_Info + use Mapl_ErrorHandling + + implicit none + + public :: UngriddedDimsInfo + public :: UngriddedDimInfo + public :: UngriddedDimInfoSet + + private + + type :: UngriddedDimsInfo + private + type(UngriddedDimInfo), allocatable :: array(:) + contains + procedure :: as_set => ungridded_dims_info_as_set + procedure :: as_array => ungridded_dims_info_as_array + end type UngriddedDimsInfo + + interface UngriddedDimsInfo + module procedure :: construct_ungridded_dims_info + end interface UngriddedDimsInfo + +contains + + function construct_ungridded_dims_info(info) result(self) + type(UngriddedDimsInfo) :: self + type(ESMF_Info), intent(in) :: info + type(UngriddedDimInfo) :: array(:) + + + self%array = array + + end function construct_ungridded_dims_info + + function ungridded_dims_info_as_set(this) result(as_set) + type(UngriddedDimSet) :: as_set + class(UngriddedDimsInfo), intent(in) :: this + + as_set = UngriddedDimSet(this%as_array()) + + end function ungridded_dims_info_as_set + + function ungridded_dims_info_as_array(this) result(as_array) + type(UngriddedDim) :: as_array(:) + class(UngriddedDimsInfo), intent(in) :: this + + as_array = this%array + + end function ungridded_dims_info_as_array + +end module mapl3g_ungridded_dims_info diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_OutputInfo.pf index f4b0f40a52e2..81ccba2d0222 100644 --- a/gridcomps/History3G/tests/Test_OutputInfo.pf +++ b/gridcomps/History3G/tests/Test_OutputInfo.pf @@ -1,7 +1,6 @@ #include "MAPL_TestErr.h" module Test_OutputInfo use mapl3g_output_info - use mapl3g_ungridded_dim_info use pfunit use esmf @@ -13,83 +12,42 @@ contains #include "history3g_test_utility_procedures.h" - @Test - subroutine test_construct_output_info() + subroutine test_get_num_levels_info() type(ESMF_Info) :: info - type(OutputInfo) :: out_info - type(UngriddedDimInfo) :: ungrid_info - character(len=:), allocatable :: stri - integer :: i integer :: status - + integer, parameter :: EXPECTED_NUM_LEVELS = 3 + integer :: num_levels + info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) - out_info = OutputInfo(info, _RC) - @assertEqual(out_info%num_levels, NUM_LEVELS, 'num_levels does not match.') - @assertEqual(out_info%vloc, VLOC, 'vloc does not match.') - @assertEqual(out_info%num_ungridded(), NUM_UNGRIDDED, 'num_ungridded does not match.') - do i=1, out_info%num_ungridded() - ungrid_info = out_info%ungridded_dims(i) - write(stri, fmt='(I0)', iostat=status) i - @assertEqual(0, status, 'Failed to create stri') - @assertEqual(NAME, ungrid_info%name, 'name does not match, dimesion ' // trim(adjustl(stri))) - @assertEqual(UNITS, ungrid_info%units, 'units does not match, dimension ' // trim(adjustl(stri))) - @assertEqual(COORDINATES, ungrid_info%coordinates, 'coordinates do not match, dimension ' // trim(adjustl(stri))) - end do - + call make_esmf_info(info, num_levels=EXPECTED_NUM_LEVELS, _RC) + num_levels = get_num_levels_info(info, _RC) + @assertEqual(EXPECTED_NUM_LEVELS, num_levels, 'num_levels does not match.') call ESMF_InfoDestroy(info) - end subroutine test_construct_output_info + end subroutine test_get_num_levels - !@Test - subroutine test_less() + subroutine test_get_vertical_dim_spec_name_info() type(ESMF_Info) :: info - type(OutputInfo) :: out_info_1, out_info_2 - character(len=:), allocatable :: names(:), units(:) integer :: status + character(len=*), parameter :: EXPECTED_NAME = 'VERTICAL_DIM_CENTER' + character(len=:), allocatable :: name info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) - out_info_1 = OutputInfo(info, _RC) - call ESMF_InfoDestroy(info) - - names = [character(len=2) :: 'A2', 'A3', 'A4' ] - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, names=names, _RC) - out_info_2 = OutputInfo(info, _RC) - call ESMF_InfoDestroy(info) - - @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 names are smaller than OutputInfo2 names.') - - units = [character(len=8) :: 'tons', 'volts', 'watts'] - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, units_array=units, _RC) - out_info_2 = OutputInfo(info, _RC) + call make_esmf_info(info, vloc=EXPECTED_NAME, _RC) + name = get_vertical_dim_spec_name_info(info, _RC) + @assertEqual(EXPECTED_NAME, name, 'vertical_dim_spec_name does not match.') call ESMF_InfoDestroy(info) - @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 units are smaller than OutputInfo2 units.') + end subroutine test_get_vertical_dim_spec_name_info - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, NUM_LEVELS+1, VLOC, NUM_UNGRIDDED, _RC) - out_info_2 = OutputInfo(info, _RC) - call ESMF_InfoDestroy(info) - - @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 num_levels are smaller than OutputInfo2 num_levels.') - - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED+1, _RC) - out_info_2 = OutputInfo(info, _RC) - call ESMF_InfoDestroy(info) - - @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 ungridded are smaller than OutputInfo2 num_ungridded.') + subroutine test_get_ungridded_dims_info_info() + type(ESMF_Info) :: info + integer :: status + type(UngriddedDimsInfo), parameter :: info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, NUM_LEVELS, 'VERTICAL_DIM_EDGE', NUM_UNGRIDDED, _RC) - out_info_2 = OutputInfo(info, _RC) call ESMF_InfoDestroy(info) - @assertTrue(out_info_1 < out_info_2, 'OutputInfo 1 vloc is smaller than OutputInfo2 num_ungridded vloc.') - - end subroutine test_less + end subroutine test_get_ungridded_dims_info_info end module Test_OutputInfo diff --git a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf index 108ee61af3e1..5f86deafcf21 100644 --- a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf +++ b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf @@ -15,7 +15,7 @@ module Test_UngriddedDimInfo contains @Test - subroutine test_construct() + subroutine test_construct_ungridded_dim_info() integer :: status type(ESMF_Info) :: info type(UngriddedDimInfo) :: obj @@ -34,7 +34,7 @@ contains @assertEqual(coordinates, obj%coordinates, COORDINATES_LABEL // ' does not match.') call ESMF_InfoDestroy(info) - end subroutine test_construct + end subroutine test_construct_ungridded_dim_info @Test subroutine test_name_units() diff --git a/gridcomps/History3G/tests/history3g_test_utilities.F90 b/gridcomps/History3G/tests/history3g_test_utilities.F90 new file mode 100644 index 000000000000..0a2955aee96c --- /dev/null +++ b/gridcomps/History3G/tests/history3g_test_utilities.F90 @@ -0,0 +1,103 @@ +#define SET_RC if(present(rc)) rc = status +#include "MAPL_TestErr.h" +module mapl3g_history3g_test_utilities + + use esmf + + implicit none + + public :: make_esmf_info + + character(len=*), parameter :: PREFIX = 'MAPL/G1/' + integer, parameter :: NUM_LEVELS = 3 + character(len=*), parameter :: VLOC = 'VERTICAL_DIM_CENTER' + integer, parameter :: NUM_UNGRIDDED = 3 + character(len=*), parameter :: NAME = 'A1' + character(len=*), parameter :: UNITS = 'stones' + real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] + + private +contains + + subroutine make_esmf_info(info, prefix, num_levels, vloc, num_ungridded, names, units_array, rc) + type(ESMF_Info), intent(inout) :: info + character(len=*), intent(in) :: prefix + integer, intent(in) :: num_levels + character(len=*), intent(in) :: vloc + integer, intent(in) :: num_ungridded + character(len=*), optional, intent(in) :: names(:) + character(len=*), optional, intent(in) :: units_array(:) + integer, optional, intent(out) :: rc + character(len=*), parameter :: NUMLEV_LABEL = 'num_levels' + character(len=*), parameter :: VLOC_LABEL = 'vloc' + character, parameter :: NUM_UNGRID_LABEL = 'num_ungridded' + integer :: status + + call ESMF_InfoSet(info, prefix // NUMLEV_LABEL, num_levels, _RC) + call ESMF_InfoSet(info, prefix // VLOC_LABEL, vloc, _RC) + call make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, _RC) + + SET_RC + + end subroutine make_esmf_info + + subroutine make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, rc) + type(ESMF_Info), intent(inout) :: info + character(len=*), intent(in) :: prefix + integer, intent(in) :: num_ungridded + character(len=*), optional, intent(in) :: names(:) + character(len=*), optional, intent(in) :: units_array(:) + integer, optional, intent(out) :: rc + character(len=*), parameter :: NAME_LABEL = 'name' + character(len=*), parameter :: UNITS_LABEL = 'units' + character(len=*), parameter :: COORDINATES_LABEL = 'coordinates' + real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] + type(ESMF_Info) :: comp_info + character(len=:), allocatable :: name_, units_ + integer :: status, i + + status = -1 + + SET_RC + + if(present(names)) then + if(size(names) /= num_ungridded) return + end if + + if(present(units_array)) then + if(size(units_array) /= num_ungridded) return + end if + + do i=1, num_ungridded + name_ = NAME + if(present(names)) name_ = names(i) + units_ = UNITS + if(present(units_array)) units_ = units_array(i) + comp_info = ESMF_InfoCreate(_RC) + call ESMF_InfoSet(comp_info, prefix // NAME_LABEL, name_, _RC) + call ESMF_InfoSet(comp_info, prefix // UNITS_LABEL, units_, _RC) + call ESMF_InfoSet(comp_info, prefix // COORDINATES_LABEL, COORDINATES, _RC) + call ESMF_InfoSet(info, prefix // make_component_label(i), comp_info, _RC) + call ESMF_InfoDestroy(comp_info) + end do + + SET_RC + + end subroutine make_esmf_ungridded_info + + function make_component_label(n, rc) result(name) + character(len=:), allocatable :: name + integer, intent(in) :: n + integer, optional, intent(out) :: rc + character(len=*), parameter :: COMP_PREFIX = 'dim_' + character(len=32) :: strn + integer :: status + + write(strn, fmt='(I0)', iostat=status) n + if(status == 0) name = COMP_PREFIX // trim(adjustl(strn)) + + SET_RC + + end function make_component_label + +end module mapl3g_history3g_test_utilities diff --git a/gridcomps/History3G/tests/history3g_test_utility_procedures.h b/gridcomps/History3G/tests/history3g_test_utility_procedures.h index 894f1557e8f7..518282e9eff1 100644 --- a/gridcomps/History3G/tests/history3g_test_utility_procedures.h +++ b/gridcomps/History3G/tests/history3g_test_utility_procedures.h @@ -2,9 +2,9 @@ subroutine make_esmf_info(info, num_levels, vloc, num_ungridded, names, units_array, rc) type(ESMF_Info), intent(inout) :: info - integer, intent(in) :: num_levels - character(len=*), intent(in) :: vloc - integer, intent(in) :: num_ungridded + integer, optional, intent(in) :: num_levels + character(len=*), optional, intent(in) :: vloc + integer, optional, intent(in) :: num_ungridded character(len=*), optional, intent(in) :: names(:) character(len=*), optional, intent(in) :: units_array(:) integer, optional, intent(out) :: rc @@ -13,20 +13,28 @@ character(len=*), parameter :: VLOC_LABEL = 'vloc' character(len=*), parameter :: NUM_UNGRID_LABEL = 'num_ungridded' type(ESMF_Info) :: inner_info + integer :: num_levels_ + character(len=:), allocatable :: vloc_ + num_levels_ = NUM_LEVELS_DEFAULT + if(present(num_levels)) num_levels_ = num_levels + vloc_ = VLOC_DEFAULT + if(present(vloc)) vloc_ = vloc + num_ungridded_ = NUM_UNGRIDDED_DEFAULT + if(present(num_ungridded)) num_ungridded_ = num_ungridded inner_info = ESMF_InfoCreate(_RC) - call make_vertical_dim(inner_info, VLOC_LABEL, vloc, _RC) + call make_vertical_dim(inner_info, VLOC_LABEL, vloc_, _RC) call ESMF_InfoSet(info, PREFIX // 'vertical_dim', value=inner_info, _RC) call ESMF_InfoDestroy(inner_info, _RC) inner_info = ESMF_InfoCreate(_RC) - call make_vertical_geom(inner_info, NUMLEV_LABEL, num_levels, _RC) + call make_vertical_geom(inner_info, NUMLEV_LABEL, num_levels_, _RC) call ESMF_InfoSet(info, PREFIX // 'vertical_geom', value=inner_info, _RC) call ESMF_InfoDestroy(inner_info, _RC) inner_info = ESMF_InfoCreate(_RC) - call make_ungridded_dims_info(inner_info, num_ungridded, names, units_array, _RC) + call make_ungridded_dims_info(inner_info, num_ungridded_, names, units_array, _RC) call ESMF_InfoSet(info, PREFIX // 'ungridded_dims', value=inner_info, _RC) call ESMF_InfoDestroy(inner_info, _RC) @@ -83,9 +91,9 @@ end if do i=1, num_ungridded - name_ = NAME + name_ = NAME_DEFAULT if(present(names)) name_ = names(i) - units_ = UNITS + units_ = UNITS_DEFAULT if(present(units_array)) units_ = units_array(i) comp_info = ESMF_InfoCreate(_RC) call ESMF_InfoSet(comp_info, NAME_LABEL, name_, _RC) diff --git a/gridcomps/History3G/tests/history3g_test_utility_variables.h b/gridcomps/History3G/tests/history3g_test_utility_variables.h index 4379551461d0..922e6166a037 100644 --- a/gridcomps/History3G/tests/history3g_test_utility_variables.h +++ b/gridcomps/History3G/tests/history3g_test_utility_variables.h @@ -1,9 +1,9 @@ character(len=*), parameter :: PREFIX = 'MAPL/' - integer, parameter :: NUM_LEVELS = 3 - character(len=*), parameter :: VLOC = 'VERTICAL_DIM_CENTER' - integer, parameter :: NUM_UNGRIDDED = 3 - character(len=*), parameter :: NAME = 'A1' - character(len=*), parameter :: UNITS = 'stones' - real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] + 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] From d2be5a45554c1e69b6fd6deb036f5c39137c9d24 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 20 May 2024 12:06:29 -0400 Subject: [PATCH 08/23] Latest changes --- generic3g/specs/UngriddedDim.F90 | 11 +- gridcomps/History3G/CMakeLists.txt | 3 + .../HistoryCollectionGridComp_private.F90 | 3 - gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 | 61 +++++ gridcomps/History3G/OutputInfo.F90 | 225 ++++++++++++------ gridcomps/History3G/OutputInfo_new.F90 | 211 ++++++++++++++++ gridcomps/History3G/OutputInfo_old.F90 | 143 +++++++++++ gridcomps/History3G/StringUngriddedDimMap.F90 | 17 ++ gridcomps/History3G/UngriddedDimInfo.F90 | 3 - gridcomps/History3G/UngriddedDimInfoArray.F90 | 26 ++ gridcomps/History3G/UngriddedDimSet.F90 | 23 ++ gridcomps/History3G/UngriddedDimsInfo.F90 | 39 ++- gridcomps/History3G/tests/CMakeLists.txt | 1 - .../History3G/tests/Test_UngriddedDimInfo.pf | 1 - .../tests/Test_UngriddedDimInfoSet.pf | 12 + .../History3G/tests/Test_UngriddedDimsInfo.pf | 43 ++++ .../tests/history3g_test_utility_variables.h | 1 - 17 files changed, 724 insertions(+), 99 deletions(-) create mode 100644 gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 create mode 100644 gridcomps/History3G/OutputInfo_new.F90 create mode 100644 gridcomps/History3G/OutputInfo_old.F90 create mode 100644 gridcomps/History3G/StringUngriddedDimMap.F90 create mode 100644 gridcomps/History3G/UngriddedDimInfoArray.F90 create mode 100644 gridcomps/History3G/UngriddedDimSet.F90 create mode 100644 gridcomps/History3G/tests/Test_UngriddedDimInfoSet.pf create mode 100644 gridcomps/History3G/tests/Test_UngriddedDimsInfo.pf diff --git a/generic3g/specs/UngriddedDim.F90 b/generic3g/specs/UngriddedDim.F90 index e74713fc3773..0dc5b9c85fcd 100644 --- a/generic3g/specs/UngriddedDim.F90 +++ b/generic3g/specs/UngriddedDim.F90 @@ -27,7 +27,7 @@ module mapl3g_UngriddedDim end type UngriddedDim interface UngriddedDim - module procedure new_UngriddedDim_extent + module procedure new_UngriddedDim_name_and_extent module procedure new_UngriddedDim_name_and_coords module procedure new_UngriddedDim_name_units_and_coords end interface UngriddedDim @@ -40,9 +40,7 @@ module mapl3g_UngriddedDim module procedure not_equal_to end interface operator(/=) - character(*), parameter :: UNKNOWN_DIM_NAME = 'NONE' character(*), parameter :: UNKNOWN_DIM_UNITS = 'NONE' - contains @@ -66,11 +64,12 @@ pure function new_UngriddedDim_name_and_coords(name, coordinates) result(spec) end function new_UngriddedDim_name_and_coords - pure function new_UngriddedDim_extent(extent) result(spec) + pure function new_UngriddedDim_name_and_extent(name, extent) result(spec) + character(*), intent(in) :: name integer, intent(in) :: extent type(UngriddedDim) :: spec - spec = UngriddedDim(UNKNOWN_DIM_NAME, default_coords(extent)) - end function new_UngriddedDim_extent + spec = UngriddedDim(name, default_coords(extent)) + end function new_UngriddedDim_name_and_extent pure function default_coords(extent, lbound) result(coords) diff --git a/gridcomps/History3G/CMakeLists.txt b/gridcomps/History3G/CMakeLists.txt index 6f7171357596..5f53a7a33f64 100644 --- a/gridcomps/History3G/CMakeLists.txt +++ b/gridcomps/History3G/CMakeLists.txt @@ -9,6 +9,9 @@ set(srcs UngriddedDimInfo.F90 UngriddedDimInfoSet.F90 UngriddedDimsInfo.F90 + StringUngriddedDimMap.F90 + UngriddedDimSet.F90 + MAPL3G_ESMF_Info_Keys.F90 ) find_package (MPI REQUIRED) diff --git a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 index 45dd3b6e8871..d5c12f6ae016 100644 --- a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 +++ b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 @@ -196,9 +196,6 @@ subroutine get_output_info_bundle(bundle, num_levels, vertical_dim_spec_names, u integer, optional, intent(out) :: rc integer :: status - output_present = present(num_levels) .or. present(vertical_dim_spec_names) .or. present(ungridded_dims_info) - _ASSERT(, ERROR_MSG) - if(present(num_levels)) then num_levels = get_num_levels(bundle, _RC) _RETURN_UNLESS(present(vertical_dim_spec_names) .or. present(ungridded_dims_info)) diff --git a/gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 b/gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 new file mode 100644 index 000000000000..314525aa025b --- /dev/null +++ b/gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 @@ -0,0 +1,61 @@ +module mapl3g_esmf_info_keys + + implicit none + + public + + private :: PREFIX + + ! FieldSpec info keys + character(len=*), parameter :: PREFIX = 'MAPL/' ! Move to central location (same below) + character(len=*), parameter :: KEY_UNGRID_DIM = 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_DIM // 'num_ungridded_dimensions' + character(len=*), parameter :: KEYSTUB_DIM = KEY_UNGRIDDED_DIM // 'dim_' + + ! UngriddedDim info keys + character(len=*), parameter :: KEY_NAME = 'name' + character(len=*), parameter :: KEY_UNITS = 'units' + character(len=*), parameter :: KEY_COORD = 'coordinates' + + private + + integer, parameter :: SUCCCESS = 0 + integer, parameter :: FAILURE = SUCCESS - 1 + character(len=*), parameter :: EMPTY_STRING = '' + +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=*), parameter :: FMT_ = '(I0)' + character(len=20) :: raw + + if(n < 0) then + key = EMPTY_STRING + if(present(rc)) rc = FAILURE + return + end if + + write(raw, fmt=FMT_, iostat=status) n + key = KEYSTUB_DIM // trim(adjustl(raw)) // '/' + if(present(rc)) rc = status + + end function make_dim_key + +end module mapl3g_esmf_info_keys diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index d4d910d02508..f7109ecce324 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -1,37 +1,41 @@ #include "MAPL_Generic.h" module mapl3g_output_info - use mapl3g_ungridded_dims_info - use esmf, only: ESMF_Field, ESMF_FieldBundle, ESMF_Info, ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoCreate, ESMF_InfoDestroy + use mapl3g_ESMF_Info_Keys + use mapl3g_UngriddedDims + use mapl3g_UngriddedDim + use gFTL2_StringVector + use esmf, only: ESMF_Field, ESMF_FieldBundle + use esmf, only: ESMF_Info, ESMF_InfoCreate, ESMF_InfoDestroy + use esmf, only: ESMF_InfoGet, ESMF_InfoGetCharAlloc use Mapl_ErrorHandling implicit none + private public :: get_num_levels public :: get_vertical_dim_spec_names - public :: get_ungridded_dims_info - public :: UngriddedDimInfoSet + public :: get_vertical_dim_spec_name + public :: get_ungridded_dims interface get_num_levels module procedure :: get_num_levels_bundle + module procedure :: get_num_levels_field end interface get_num_levels interface get_vertical_dim_spec_names module procedure :: get_vertical_dim_spec_names_bundle end interface get_vertical_dim_spec_names - interface get_ungridded_dims_info - module procedure ::get_ungridded_dims_info_bundle - end interface get_ungridded_dims_info + interface get_ungridded_dims + module procedure :: get_ungridded_dim_bundle + module procedure :: get_ungridded_dims_field + end interface get_ungridded_dims - character(len=*), parameter :: PREFIX = 'MAPL/' - character(len=*), parameter :: KEY_UNGRID_DIM = 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_VLOC = 'vloc' - character(len=*), parameter :: KEY_NUM_LEVELS = 'num_levels' + interface get_vertical_dim_spec_name + module procedure :: get_vertical_dim_spec_name_field + end interface get_vertical_dim_spec_name contains @@ -40,68 +44,69 @@ integer function get_num_levels_bundle(bundle, rc) result(num) type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc integer :: status - type(ESMF_Field), allocatable :: fields(:) - integer :: nums(:) - integer :: sz - - fields = get_bundle_fields(bundle, _RC) - sz = size(fields) - _ASSERT(sz > 0, 'Empty ESMF_FieldBundle') - num = get_num_levels_field(fields(1), _RC) - _RETURN_IF(sz == 1) - nums = get_num_levels_field(fields(2:sz), _RC) - _ASSERT(all(nums == num), 'All fields must have the same number of vertical levels.') + integer :: i, n + type(ESMF_Info), allocatable :: info(:) + + info = get_bundle_info(bundle, _RC) + num = get_num_levels_info(info(1), _RC) + do i=2, size(info) + n = get_num_levels_info(info(i), _RC) + _ASSERT(n == num, 'All fields must have the same number of vertical levels.') + end do + call destroy_info(info, _RC) + _RETURN(_SUCCESS) end function get_num_levels_bundle - elemental integer function get_num_levels_field(field, rc) result(n) + integer function get_num_levels_field(field, rc) result(num) type(ESMF_Field), intent(in) :: field integer, optional, intent(out) :: rc integer :: status type(ESMF_Info) :: info call ESMF_InfoGetFromHost(field, info, _RC) - n = get_num_levels_info(info, _RC) + num = get_num_levels_info(info, _RC) call ESMF_InfoDestroy(info, _RC) _RETURN(_SUCCESS) end function get_num_levels_field - elemental integer function get_num_levels_info(info, rc) result(n) + integer function get_num_levels_info(info, rc) result(num) type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status - type(ESMF_Info) :: inner_info + logical :: key_present - inner_info = ESMF_InfoCreate(info, key=KEY_VERT_GEOM, _RC) - call ESMF_InfoGet(inner_info, key=KEY_NUM_LEVELS, value=n, _RC) - call ESMF_InfoDestroy(inner_info, _RC) + num = 0 + key_present = ESMF_InfoIsPresent(info, key=KEY_NUM_LEVELS, _RC) + if(key_present) then + call ESMF_InfoGet(info, key=KEY_NUM_LEVELS, value=num, _RC) + end if _RETURN(_SUCCESS) end function get_num_levels_info function get_vertical_dim_spec_names_bundle(bundle, rc) result(names) - type(StringSet) :: names + type(StringVector) :: names type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc integer :: status - type(ESMF_Field), allocatable :: fields(:) - integer :: sz, i + integer :: i character(len=:), allocatable :: name + type(ESMF_Info), allocatable :: info(:) - fields = get_bundle_fields(bundle, _RC) - sz = size(fields) - _ASSERT(sz > 0, 'Empty ESMF_FieldBundle') - - names = StringSet() - do i=1, sz - name = get_vertical_dim_spec_name_field(field, _RC) - call names%insert(name) + info = get_bundle_info(bundle, _RC) + names = StringVector() + do i=1, size(info) + name = get_vertical_dim_spec_info(info(i), _RC) + if(names%get_index(name)==0) names%push_back(name) end do + call destroy_bundle_info(info, _RC) + _RETURN(_SUCCESS) end function get_vertical_dim_spec_names_bundle - elemental function get_vertical_dim_spec_name_field(field, rc) result(spec_name) + function get_vertical_dim_spec_name_field(field, rc) result(spec_name) character(len=:), allocatable :: spec_name type(ESMF_Field), intent(inout) :: field integer, optional, intent(out) :: rc @@ -109,87 +114,149 @@ elemental function get_vertical_dim_spec_name_field(field, rc) result(spec_name) type(ESMF_Info) :: info call ESMF_InfoGetFromHost(field, info, _RC) - spec_name = get_vertical_dim_spec_name_info(info, _RC) + spec_name = get_vertical_dim_spec_info(info, _RC) call ESMF_InfoDestroy(info, _RC) _RETURN(_SUCCESS) end function get_vertical_dim_spec_name_field - elemental function get_vertical_dim_spec_name_info(info, rc) result(spec_name) + function get_vertical_dim_spec_info(info, rc) result(spec_name) character(len=:), allocatable :: spec_name type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc integer :: status - type(ESMF_Info) :: inner_info + integer :: n - inner_info = ESMF_InfoCreate(info, key=KEY_VERT_DIM, _RC) - call ESMF_InfoGetCharAlloc(inner_info, key=KEY_VLOC, value=spec_name, _RC) - call ESMF_InfoDestroy(inner_info, _RC) + spec_name = '' + n = get_num_levels_info(info, _RC) + _RETURN_UNLESS(n > 0) + call ESMF_InfoGetCharAlloc(info, key=KEY_VLOC, value=spec_name, _RC) _RETURN(_SUCCESS) - end function get_vertical_dim_spec_name_info + end function get_vertical_dim_spec_info - function get_ungridded_dims_info_bundle(bundle, rc) result(dim_info_set) - type(UngriddedDimInfoSet) :: dim_info_set + function get_ungridded_dim_bundle(bundle, rc) result(dims) + type(UngriddedDims) :: dims type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc integer :: status - type(ESMF_Field), allocatable :: fields(:) - type(UngriddedDimsInfo), allocatable :: dims_info(:) integer :: i + type(ESMF_Info), allocatable :: info(:) + type(UngriddedDimVector) :: vec - fields = get_bundle_fields(bundle, _RC) - _ASSERT(size(fields) > 0, 'Empty ESMF_FieldBundle') - - dims_info = get_ungridded_dims_info_field(fields, _RC) - do i=1, size(fields) - call dim_info_set%merge(dims_info(i)%as_set()) + info = get_bundle_info(bundle, _RC) + vec = UngriddedDimVector() + do i=1, size(info) + call push_ungridded_dim_info(vec, info(i), _RC) end do + dims = UngriddedDims(vec) + call destroy_bundle_info(info, _RC) _RETURN(_SUCCESS) - end function get_ungridded_dims_info_bundle + end function get_ungridded_dim_bundle - elemental function get_ungridded_dims_info_field(field, rc) result(ungridded) - type(UngriddedDimsInfo) :: ungridded + function get_ungridded_dims_field(field, rc) result(ungridded) + type(UngriddedDims) :: ungridded type(ESMF_Field), intent(inout) :: field integer, optional, intent(out) :: rc integer :: status type(ESMF_Info) :: info + type(UngriddedDimVector) :: vec call ESMF_InfoGetFromHost(field, info, _RC) - ungridded = get_ungridded_dims_info_info(info, _RC) + call push_ungridded_info(vec, info, _RC) + ungridded = UngriddedDims(vec) call ESMF_InfoDestroy(info, _RC) _RETURN(_SUCCESS) - end function get_ungridded_dims_info_field + end function get_ungridded_dims_field - elemental function get_ungridded_dims_info_info(info, rc) result(ungridded) - type(UngriddedDimsInfo) :: ungridded + subroutine push_ungridded_dim_info(vec, info, rc) + type(UngriddedDimVector), intent(inout) :: vec type(ESMF_Info), intent(in) :: info - integer, optional, intent(out) :: rc + integer, optional, intent(out) :: rc integer :: status - type(ESMF_Info) :: inner_info - - inner_info = ESMF_InfoCreate(info, key=KEY_UNGRID_DIM, _rc) - ungridded = get_ungridded_dims_info(inner_info, _rc) - call ESMF_InfoDestroy(inner_info, _rc) + type(UngriddedDim) :: next + integer :: num_dims, i, vi + logical :: has_dims + integer :: num_coord + character(len=:), allocatable :: name + character(len=:), allocatable :: units + character(len=:), allocatable :: dim_key + real, allocatable :: coordinates(:) + + num_dims = 0 + has_dims = ESMF_InfoIsPresent(info, key=KEY_NUM_UNGRID_DIMS, _RC) + if(has_dims) then + num_dims = ESMF_InfoGet(info, key=KEY_NUM_UNGRID_DIMS, _RC) + end if + do i=1, num_dims + dim_key = make_dim_key(i, _RC) + call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_NAME, value=name, _RC) + call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNITS, value=units, _RC) + call ESMF_InfoGet(info, key=dim_key // KEY_COORD, size=num_coord, _RC) + allocate(coordinates(num_coord)) + call ESMF_InfoGet(info, key=dim_key // KEY_COORD, values=coordinates, _RC) + next = UngriddedDim(name, units, coordinates) + vi = get_index_by_name(vec, name) + if(vi > 0) then + _ASSERT(UngriddedDim(name, units, coordinates) == vec%at(vi), 'UngriddedDim mismatch.') + end if + call vec%push_back(UngriddedDim(name, units, coordinates)) + end do _RETURN(_SUCCESS) - end function get_ungridded_dims_info_info + end subroutine push_ungridded_dim_info + + integer function get_index_by_name(vec, name) result(n) + integer :: n + type(UngriddedDimVector), intent(in) :: vec + character(len=*), intent(in) :: name + type(UngriddedDimVectorIterator) :: iter + + n = 1 + iter = vec%begin() + do while(iter <= vec%end()) + if(iter%of()%get_name() == name) return + n = n + 1 + call iter%next() + end do + if(n > vec%size()) n = 0 - function get_bundle_fields(bundle, rc) result(fields) - type(ESMF_Field), allocatable :: fields(:) + end function get_index_by_name + + function get_bundle_info(bundle, rc) result(bundle_info) + type(ESMF_Info), allocatable :: bundle_info(:) type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc integer :: status integer :: field_count + type(ESMF_Field), allocatable :: fields(:) + type(ESMF_Info) :: info call ESMF_FieldBundleGet(bundle, fieldCount=field_count, _RC) + _ASSERT(field_count > 0, 'Empty bundle') allocate(fields(field_count)) call ESMF_FieldBundleGet(bundle, fieldList=fields, _RC) - + allocate(bundle_info(field_count)) + do i=1, field_count + call ESMF_InfoGetFromHost(field, info, _RC) + bundle_info(i) = info + end do _RETURN(_SUCCESS) - end function get_bundle_fields + end function get_bundle_info + + subroutine destroy_bundle_info(bundle_info, rc) + type(ESMF_Info), intent(inout) :: bundle_info(:) + integer, optional, intent(out) :: rc + integer :: status, i + + do i=1, size(bundle_info) + call ESMF_InfoDestroy(bundle_info(i), _RC) + end do + _RETURN(_SUCCESS) + end subroutine destroy_bundle_info + end module mapl3g_output_info diff --git a/gridcomps/History3G/OutputInfo_new.F90 b/gridcomps/History3G/OutputInfo_new.F90 new file mode 100644 index 000000000000..5e88c8dd8ff6 --- /dev/null +++ b/gridcomps/History3G/OutputInfo_new.F90 @@ -0,0 +1,211 @@ +module mapl3g_OutputInfo + + use esmf, only: ESMF_InfoGet + + implicit none + private + + public :: OutputInfo +! public :: operator(==) +! public :: operator(/=) + public :: operator(<) + + type :: OutputInfo + integer :: num_levels + character(len=:), allocatable :: vloc + type(UngriddedDimInfo) :: ungridded_dims(:) + end type OutputInfo + + interface OutputInfo + module procedure :: construct_output_info + end interface OutputInfo + +! interface operator(==) +! module procedure :: equal_to_output_info +! module procedure :: equal_to_ungridded_dim_info +! end interface operator(==) +! +! interface operator(/=) +! module procedure :: not_equal_to_output_info +! module procedure :: not_equal_to_ungridded_dim_info +! end interface operator(/=) + + interface operator(<) + module procedure :: less_than_output_info + module procedure :: less_than_ungridded_dim_info + end interface operator(<) + + type :: UngriddedDimInfo + character(len=:), allocatable :: name + character(len=:), allocatable :: units + real :: coordinates(:) + end type UngriddedDimInfo + +! type, abstract :: InfoKey +! character(len=:), allocatable :: string_key +! end type InfoKey +! +! type, extends(InfoKey) :: OutputInfoKey +! integer :: num_levels +! type(UngriddedInfoKey), allocatable :: ungridded_dims_info(:) +! end type OutputInfoKey + + character(len=*), parameter :: PREFIX = 'MAPL/' + character(len=*), parameter :: NUM_LEVELS_KEY = PREFIX // 'num_levels' + character(len=*), parameter :: VLOC_KEY = PREFIX // 'vloc' + character(len=*), parameter :: UNGRIDDED_DIM_KEY = PREFIX // "dim_" + character(len=*), parameter :: NAME_KEY = 'name' + character(len=*), parameter :: UNITS_KEY = 'units' + character(len=*), parameter :: COORDINATES_KEY = 'coordinates' + +contains + +! function get_key_output_info(this) result(key) +! type(OutputInfoKey) :: key +! type(OutputInfo), intent(in) :: this +! +! key%integer_key = [this%num_levels] +! key% + function construct_output_info(info_in, rc) result(output_info) + type(OutputInfo) :: output_info + type(ESMF_Info), intent(in) :: info_in + integer, optional, intent(out) :: rc + integer :: status + character(len=:), allocatable :: num_levels + character(len=:), allocatable :: vloc + character(len=:), allocatable :: name + character(len=:), allocatable :: units + real :: coordinates(:) + + call ESMF_InfoGet(info_in, key=NUM_LEVELS_KEY, num_levels, _RC) + call ESMF_InfoGet(info_in, key=VLOC_KEY, vloc, _RC) + call ESMF_InfoGet(info_in, key=UNGRIDDED_KEY, ungridded, _RC) + + output_info%num_levels = num_levels + output_info%vloc = vloc + output_info%ungridded_dims = get_ungridded_dims_info(info_in, _RC) + + _RETURN(_SUCCESS) + end function construct_output_info + + function construct_ungridded_dim_info(info_in, prefix, rc) result(info_out) + type(UngriddedDimInfo) :: info_out + type(ESMF_Info), intent(in) :: info_in + character(len=*), intent(in) :: prefix + integer, optional, intent(out) :: rc + integer :: status + character(len=:), allocatable :: vloc + character(len=:), allocatable :: name + character(len=:), allocatable :: units + real :: coordinates(:) + + call ESMF_InfoGet(info_in, key=prefix//NAME_KEY, name, _RC) + call ESMF_InfoGet(info_in, key=prefix//UNITS_KEY, units, _RC) + call ESMF_InfoGet(info_in, key=prefix//COORDINATES_KEY, coordinates, _RC) + info_out%name = name + info_out%units = units + info_out%coordinates = coordinates + + _RETURN(_SUCCESS) + end function construct_ungridded_dim_info + + function get_ungridded_dims_info(info_in, rc) result(info_out) + type(UngriddedDimInfo), allocatable = info_out(:) + type(ESMF_Info), intent(in) :: info_in + integer, optional, intent(out) :: rc + integer :: status + integer :: num_ungridded + integer :: i, ios + character(len=32) :: stri + character(len=:), allocatable :: prefix + + call ESMF_InfoGet(info_in, key=NUM_UNGRIDDED_KEY, num_ungridded, _RC) + _ASSERT(num_ungridded >= 0, 'num_ungridded must be nonnegative.') + allocate(info_out(num_ungridded)) + if(num_ungridded == 0) then + _RETURN(_SUCCESS) + end if + do i= 1, num_ungridded + write(stri, fmt='(I0)', iostat=ios) i + _ASSERT(ios == 0, 'failed to create ith ungridded dim index string') + prefix = UNGRIDDED_DIM_KEY // trim(adjustl(stri)) // '/' + info_out(i) = UngriddedDimInfo(info_in, prefix) + end do + + _RETURN(_SUCCESS) + + end function get_ungridded_dims_info + +! logical function equal_to_output_info(a, b) result(equal) +! class(OutputInfo), intent(in) :: a, b +! +! integer :: num_levels +! character(len=:), allocatable :: vloc +! type(UngriddedDimInfo) :: ungridded_dims(:) +! equal = a%num_levels == b%num_levels .and. a%vloc == b%vloc .and. & +! all(a%ungridded_dims == b%ungridded_dims) +! +! end function equal_to_output_info +! +! logical function not_equal_to_output_info(a, b) result(not_equal) +! class(OutputInfo), intent(in) :: a, b +! +! not_equal = .not. (a == b) +! +! end function not_equal_to_output_info +! +! logical function equal_to_ungridded_dim_info(a, b) result(equal) +! class(UngriddedDimInfo), intent(in) :: a, b +! +! equal = a%name == b%name .and. a%units == b%units .and. & +! all(a%coordinates == b%coordinates) +! +! end function equal_to_ungridded_dim_info +! +! logical function not_equal_to_ungridded_dim_info(a, b) result(not_equal) +! class(UngriddedDimInfo), intent(in) :: a, b +! +! not_equal = .not. (a == b) +! +! end function not_equal_to_ungridded_dim_info + + logical function less_than_output_info(a, b) result(tval) + type(OutputInfo), intent(in) :: a, b + integer :: i + + tval = a%num_levels < b%num_levels + if(tval .or. a%num_levels > b%num_levels) return + tval = a%vloc < b%vloc + if(tval .or. a%vloc > b%vloc) return + tval = size(a%ungridded_dims) < size(b%ungridded_dims) + if(tval .or. size(a%ungridded_dims) > size(b%ungridded_dims)) return + do i= 1, size(a%ungridded_dims) + tval = a%ungridded_dims(i) < b%ungridded_dims(i) + if(tval .or. a%ungridded_dims(i) > b%ungridded_dims(i)) return + end do + + end function less_than_output_info + + logical function less_than_ungridded_dim_info(a, b) result(eval) + type(UngriddedDimInfo), intent(in) :: a, b + integer :: i, asz, bsz + real :: acoor, bcoor + + tval = a%name < b%name + if(tval .or. a%name > b%name) return + tval = a%units < b%units + if(tval .or. a%units > b%units) return + asz = size(a%coordinates) + bsz = size(b%coordinates) + tval = asz < bsz + if(tval .or. asz > bsz) return + do i=1, asz + acoor = a%coordinates(i) + bcoor = b%coordinates(i) + tval = acoor < bcoor + if(tval .or. acoor > bcoor) return + end do + + end function less_than_ungridded_dim_info + +end module mapl3g_OutputInfo diff --git a/gridcomps/History3G/OutputInfo_old.F90 b/gridcomps/History3G/OutputInfo_old.F90 new file mode 100644 index 000000000000..e6f964cf6130 --- /dev/null +++ b/gridcomps/History3G/OutputInfo_old.F90 @@ -0,0 +1,143 @@ +module mapl3g_OutputInfo + + use mapl3g_VerticalGeom, only: VerticalGeom + use mapl3g_VerticalDimSpec, only: VerticalDimSpec + use mapl3g_UngriddedDims, only: UngriddedDims + use esmf, only: ESMF_InfoGet + + implicit none + private + + public :: OutputInfo + public :: operator(==) + public :: operator(/=) + + type :: OutputInfo + type(VerticalGeomInfo) :: vertical_geom_info + type(VerticalDimSpec) :: vertical_dim_spec_info + type(UngriddedDimsInfo) :: ungridded_dims_info + end type OutputInfo + + interface OutputInfo + module procedure :: construct_output_info + end interface OutputInfo + + interface operator(==) + module procedure :: equal_to_output_info + module procedure :: equal_to_vertical_geom_info + module procedure :: equal_to_vertical_dims_spec_info + module procedure :: equal_to_ungridded_dim_info + module procedure :: equal_to_ungridded_dims_info + end interface operator(==) + + interface operator(/=) + module procedure :: not_equal_to_output_info + end interface operator(/=) + + type :: VerticalGeomInfo + integer :: num_levels + end type VerticalGeomInfo + + type :: VerticalDimSpecInfo + character(len=:), allocatable :: vloc + end type VerticalDimSpecInfo + + type :: UngriddedDimInfo + character(len=:), allocatable :: name + character(len=:), allocatable :: units + real :: coordinates(:) + end type UngriddedDimInfo + + type :: UngriddedDimsInfo + type(UngriddedDimInfo) :: dim_specs(:) + end type UngriddedDimsInfo + +contains + + function construct_output_info(esmfinfo) result(output_info) + type(OutputInfo) :: output_info + type(ESMF_Info), intent(in) :: esmfinfo + + call ESMF_InfoGet(esmfinfo, key=VERT_GEOM_KEY, vert_geom, _RC) + output_info%vert_geom => vert_geom + call ESMF_InfoGet(esmfinfo, key=VERT_SPEC_KEY, vert_spec, _RC) + output_info%vert_spec => vert_spec + call ESMF_InfoGet(esmfinfo, key=UNGRIDDED_KEY, ungridded, _RC) + output_info%ungridded => ungridded + + end function construct_output_info + + logical function equal_to_output_info(a, b) result(equal) + class(OutputInfo), intent(in) :: a, b + + equal = a%vertical_geom_info == b%vertical_geom_info .and. & + a%vertical_dim_spec_info == b%vertical_dim_spec_info .and. & + a%vertical_ungridded_dims_info == b%vertical_ungridded_dims_info + + end function equal_to_output_info + + logical function not_equal_to_output_info(a, b) result(not_equal) + class(OutputInfo), intent(in) :: a, b + + not_equal = .not. (a == b) + + end function not_equal_to_output_info + + logical function equal_to_vertical_geom_info(a, b) result(equal) + class(VerticalGeomInfo), intent(in) :: a, b + + equal = a%num_levels == b%num_levels + + end function equal_to_vertical_geom_info + + logical function not_equal_to_vertical_geom_info(a, b) result(not_equal) + class(VerticalGeomInfo), intent(in) :: a, b + + not_equal = .not. (a == b) + + end function not_equal_to_vertical_geom_info + + logical function equal_to_vertical_dim_spec_info(a, b) result(equal) + class(VerticalDimSpecInfo), intent(in) :: a, b + + equal = a%vloc == b%vloc + + end function equal_to_vertical_dim_spec_info + + logical function not_equal_to_vertical_dim_spec_info(a, b) result(not_equal) + class(VerticalDimSpecInfo), intent(in) :: a, b + + not_equal = .not. (a == b) + + end function not_equal_to_vertical_dim_spec_info + + logical function equal_to_ungridded_dim_info(a, b) result(equal) + class(UngriddedDimInfo), intent(in) :: a, b + + equal = a%name == b%name .and. a%units == b%units .and. & + all(a%coordinates == b%coordinates) + + end function equal_to_ungridded_dim_info + + logical function not_equal_to_ungridded_dim_info(a, b) result(not_equal) + class(UngriddedDimInfo), intent(in) :: a, b + + not_equal = .not. (a == b) + + end function not_equal_to_ungridded_dim_info + + logical function equal_to_ungridded_dims_info(a, b) result(equal) + class(UngriddedDimsInfo), intent(in) :: a, b + + equal = all(a == b) + + end function equal_to_ungridded_dims_info + + logical function not_equal_to_ungridded_dims_info(a, b) result(not_equal) + class(UngriddedDimsInfo), intent(in) :: a, b + + not_equal = .not. (a == b) + + end function not_equal_to_ungridded_dims_info + +end module mapl3g_OutputInfo diff --git a/gridcomps/History3G/StringUngriddedDimMap.F90 b/gridcomps/History3G/StringUngriddedDimMap.F90 new file mode 100644 index 000000000000..2576f835aeba --- /dev/null +++ b/gridcomps/History3G/StringUngriddedDimMap.F90 @@ -0,0 +1,17 @@ +module mapl3g_string_ungridded_dim_map + use mapl3g_UngriddedDim + +#include "types/key_deferredLengthString.inc" +#define _value type(UngriddedDim) + +#define _map StringUngriddedDimMap +#define _iterator StringUngriddedDimMapIterator +#define _alt +#include "templates/map.inc" + +#undef _alt +#undef _iterator +#undef _map +#undef _value + +end module mapl3g_string_ungridded_dim_map diff --git a/gridcomps/History3G/UngriddedDimInfo.F90 b/gridcomps/History3G/UngriddedDimInfo.F90 index b0a47329da82..8e17ebd53702 100644 --- a/gridcomps/History3G/UngriddedDimInfo.F90 +++ b/gridcomps/History3G/UngriddedDimInfo.F90 @@ -49,9 +49,6 @@ function construct_ungridded_dim_info(info, rc) result(ud_info) real, allocatable :: coordinates(:) integer :: sz - call ESMF_InfoGetCharAlloc(info, key='name', value=name, _RC) - call ESMF_InfoGetCharAlloc(info, key='units', value=units, _RC) - call ESMF_InfoGet(info, key='coordinates', size=sz, _RC) allocate(coordinates(sz)) call ESMF_InfoGet(info, key='coordinates', values=coordinates, _RC) ud_info%name = name diff --git a/gridcomps/History3G/UngriddedDimInfoArray.F90 b/gridcomps/History3G/UngriddedDimInfoArray.F90 new file mode 100644 index 000000000000..13b8e2a9e7a7 --- /dev/null +++ b/gridcomps/History3G/UngriddedDimInfoArray.F90 @@ -0,0 +1,26 @@ + + function get_array(info_in, rc) result(array) + type(ESMF_Info), intent(in) :: info_in + integer, optional, intent(out) :: rc + character(len=*), parameter :: PREFIX = 'MAPL/' + integer :: status + integer :: num_ungridded + integer :: i, ios + character(len=32) :: stri + type(UngriddedDimInfo), allocatable :: array(:) + + call ESMF_InfoGet(info_in, PREFIX // 'num_ungridded', num_ungridded, _RC) + _ASSERT(num_ungridded >= 0, 'num_ungridded must be nonnegative.') + allocate(array(num_ungridded)) + if(num_ungridded == 0) then + _RETURN(_SUCCESS) + end if + do i= 1, num_ungridded + write(stri, fmt='(I0)', iostat=ios) i + _ASSERT(ios == 0, 'failed to create ith ungridded dim index string') + array(i) = UngriddedDimInfo(info_in, PREFIX // 'dim_' // trim(adjustl(stri)) // '/') + end do + + _RETURN(_SUCCESS) + + end function get_array diff --git a/gridcomps/History3G/UngriddedDimSet.F90 b/gridcomps/History3G/UngriddedDimSet.F90 new file mode 100644 index 000000000000..2ac498f64f83 --- /dev/null +++ b/gridcomps/History3G/UngriddedDimSet.F90 @@ -0,0 +1,23 @@ +module mapl3g_ungridded_dim_set + use mapl3g_UngriddedDim + +#define T UngriddedDim +#define T_LT(A, B) less_than(A, B) +#define Set UngriddedDimSet +#define SetIterator UngriddedDimSetIterator + +#include "set/template.inc" + + logical function less_than(a, b) + type(T), intent(in) :: a, b + + less_than = (a%name < b%name) + + end function less_than + +#undef T +#undef T_LT +#undef Set +#undef SetIterator + +end module mapl3g_ungridded_dim_set diff --git a/gridcomps/History3G/UngriddedDimsInfo.F90 b/gridcomps/History3G/UngriddedDimsInfo.F90 index 089d973ba8c3..58dce4744887 100644 --- a/gridcomps/History3G/UngriddedDimsInfo.F90 +++ b/gridcomps/History3G/UngriddedDimsInfo.F90 @@ -11,7 +11,6 @@ module mapl3g_ungridded_dims_info public :: UngriddedDimsInfo public :: UngriddedDimInfo public :: UngriddedDimInfoSet - private type :: UngriddedDimsInfo @@ -26,15 +25,18 @@ module mapl3g_ungridded_dims_info module procedure :: construct_ungridded_dims_info end interface UngriddedDimsInfo + character(len=*), parameter :: KEY_NUM_UNGRID_DIMS = 'num_ungridded_dimensions' + character(len=*), parameter :: KEYSTUB_DIM = 'dim_' + contains - function construct_ungridded_dims_info(info) result(self) + function construct_ungridded_dims_info(info, rc) result(self) type(UngriddedDimsInfo) :: self type(ESMF_Info), intent(in) :: info - type(UngriddedDimInfo) :: array(:) + integer, optional, intent(out) :: rc + integer :: status - - self%array = array + self%array = get_array(info, _RC) end function construct_ungridded_dims_info @@ -54,4 +56,31 @@ function ungridded_dims_info_as_array(this) result(as_array) end function ungridded_dims_info_as_array + function get_array(info, rc) result(array) + type(UngriddedDimInfo), allocatable :: array(:) + type(ESMF_Info), intent(in) :: info + integer, optional, intent(out) :: rc + integer :: status + + integer :: num_ungridded + integer :: i, ios + character(len=32) :: stri + type(UngriddedDimInfo), allocatable :: array(:) + + call ESMF_InfoGet(info, KEY_NUM_UNGRID_DIMS, num_ungridded, _RC) + _ASSERT(num_ungridded >= 0, 'num_ungridded must be nonnegative.') + allocate(array(num_ungridded)) + if(num_ungridded == 0) then + _RETURN(_SUCCESS) + end if + do i= 1, num_ungridded + write(stri, fmt='(I0)', iostat=ios) i + _ASSERT(ios == 0, 'failed to create ith ungridded dim index string') + array(i) = UngriddedDimInfo(info, KEYSTUB_DIM // trim(adjustl(stri)) // '/') + end do + + _RETURN(_SUCCESS) + + end function get_array + end module mapl3g_ungridded_dims_info diff --git a/gridcomps/History3G/tests/CMakeLists.txt b/gridcomps/History3G/tests/CMakeLists.txt index e771d46b81a1..184496570229 100644 --- a/gridcomps/History3G/tests/CMakeLists.txt +++ b/gridcomps/History3G/tests/CMakeLists.txt @@ -5,7 +5,6 @@ set (test_srcs Test_HistoryCollectionGridComp.pf Test_UngriddedDimInfo.pf Test_OutputInfo.pf - Test_OutputInfoSet.pf ) add_pfunit_ctest(MAPL.history3g.tests diff --git a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf index 5f86deafcf21..467683feb5ab 100644 --- a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf +++ b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf @@ -3,7 +3,6 @@ module Test_UngriddedDimInfo use mapl3g_ungridded_dim_info use pfunit - use mapl3g_HistoryCollectionGridComp_private use esmf implicit none diff --git a/gridcomps/History3G/tests/Test_UngriddedDimInfoSet.pf b/gridcomps/History3G/tests/Test_UngriddedDimInfoSet.pf new file mode 100644 index 000000000000..4c03f1466150 --- /dev/null +++ b/gridcomps/History3G/tests/Test_UngriddedDimInfoSet.pf @@ -0,0 +1,12 @@ +#include "MAPL_TestErr.h" +module Test_UngriddedDimInfoSet + + use mapl3g_ungridded_dim_info_set + use pfunit + use esmf + + implicit none + +contains + +end module Test_UngriddedDimInfoSet diff --git a/gridcomps/History3G/tests/Test_UngriddedDimsInfo.pf b/gridcomps/History3G/tests/Test_UngriddedDimsInfo.pf new file mode 100644 index 000000000000..7b07d50d4792 --- /dev/null +++ b/gridcomps/History3G/tests/Test_UngriddedDimsInfo.pf @@ -0,0 +1,43 @@ +#include "MAPL_TestErr.h" +module Test_UngriddedDimsInfo + + use mapl3g_ungridded_dims_info + use pfunit + use esmf + + implicit none + +#include "history3g_test_utility_variables" + + type(ESMF_Info) :: info + +contains + + @Test + subroutine test_construct_ungridded_dims_info() + type(UngriddedDimsInfo) :: ungridded + + ungridded = UngriddedDimsInfo(info, _RC) + + end subroutine test_construct_ungridded_dims_info + + @Before + subroutine setup() + integer :: status + + info = ESMF_InfoCreate(_RC) + + end subroutine setup + + @After + subroutine shutdown() + integer :: status + character(len=*), parameter :: NAMES = + + call ESMF_InfoDestroy(info, _RC) + + end subroutine shutdown + +#include "history3g_test_utility_procedures" + +end module Test_UngriddedDimInfo diff --git a/gridcomps/History3G/tests/history3g_test_utility_variables.h b/gridcomps/History3G/tests/history3g_test_utility_variables.h index 922e6166a037..15bdd44aa261 100644 --- a/gridcomps/History3G/tests/history3g_test_utility_variables.h +++ b/gridcomps/History3G/tests/history3g_test_utility_variables.h @@ -1,5 +1,4 @@ - character(len=*), parameter :: PREFIX = 'MAPL/' integer, parameter :: NUM_LEVELS_DEFAULT = 3 character(len=*), parameter :: VLOC_DEFAULT = 'VERTICAL_DIM_CENTER' integer, parameter :: NUM_UNGRIDDED_DEFAULT = 3 From 83868cc0a68c8edf543ea187dc35954bfc3524d7 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 20 May 2024 12:55:51 -0400 Subject: [PATCH 09/23] Remove unused modules and procedures --- generic3g/specs/UngriddedDim.F90 | 7 + gridcomps/History3G/CMakeLists.txt | 5 - gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 | 14 +- gridcomps/History3G/OutputInfo.F90 | 8 +- gridcomps/History3G/OutputInfoSet.F90 | 16 -- gridcomps/History3G/OutputInfo_new.F90 | 211 ------------------ gridcomps/History3G/OutputInfo_old.F90 | 143 ------------ gridcomps/History3G/StringUngriddedDimMap.F90 | 17 -- gridcomps/History3G/UngriddedDimInfo.F90 | 140 ------------ gridcomps/History3G/UngriddedDimInfoArray.F90 | 26 --- gridcomps/History3G/UngriddedDimInfoSet.F90 | 16 -- gridcomps/History3G/UngriddedDimSet.F90 | 23 -- gridcomps/History3G/UngriddedDimsInfo.F90 | 86 ------- .../tests/Test_HistoryCollectionGridComp.pf | 37 --- .../History3G/tests/Test_OutputInfoSet.pf | 50 ----- .../History3G/tests/Test_UngriddedDimInfo.pf | 178 --------------- .../tests/Test_UngriddedDimInfoSet.pf | 12 - .../History3G/tests/Test_UngriddedDimsInfo.pf | 43 ---- .../tests/history3g_test_utilities.F90 | 103 --------- 19 files changed, 16 insertions(+), 1119 deletions(-) delete mode 100644 gridcomps/History3G/OutputInfoSet.F90 delete mode 100644 gridcomps/History3G/OutputInfo_new.F90 delete mode 100644 gridcomps/History3G/OutputInfo_old.F90 delete mode 100644 gridcomps/History3G/StringUngriddedDimMap.F90 delete mode 100644 gridcomps/History3G/UngriddedDimInfo.F90 delete mode 100644 gridcomps/History3G/UngriddedDimInfoArray.F90 delete mode 100644 gridcomps/History3G/UngriddedDimInfoSet.F90 delete mode 100644 gridcomps/History3G/UngriddedDimSet.F90 delete mode 100644 gridcomps/History3G/UngriddedDimsInfo.F90 delete mode 100644 gridcomps/History3G/tests/Test_OutputInfoSet.pf delete mode 100644 gridcomps/History3G/tests/Test_UngriddedDimInfo.pf delete mode 100644 gridcomps/History3G/tests/Test_UngriddedDimInfoSet.pf delete mode 100644 gridcomps/History3G/tests/Test_UngriddedDimsInfo.pf delete mode 100644 gridcomps/History3G/tests/history3g_test_utilities.F90 diff --git a/generic3g/specs/UngriddedDim.F90 b/generic3g/specs/UngriddedDim.F90 index 0dc5b9c85fcd..4fdf1442f5fd 100644 --- a/generic3g/specs/UngriddedDim.F90 +++ b/generic3g/specs/UngriddedDim.F90 @@ -27,6 +27,7 @@ module mapl3g_UngriddedDim end type UngriddedDim interface UngriddedDim + module procedure new_UngriddedDim_extent module procedure new_UngriddedDim_name_and_extent module procedure new_UngriddedDim_name_and_coords module procedure new_UngriddedDim_name_units_and_coords @@ -40,6 +41,7 @@ module mapl3g_UngriddedDim module procedure not_equal_to end interface operator(/=) + character(*), parameter :: UNKNOWN_DIM_NAME = 'NONE' character(*), parameter :: UNKNOWN_DIM_UNITS = 'NONE' contains @@ -71,6 +73,11 @@ pure function new_UngriddedDim_name_and_extent(name, extent) result(spec) spec = UngriddedDim(name, default_coords(extent)) end function new_UngriddedDim_name_and_extent + pure function new_UngriddedDim_extent(extent) result(spec) + integer, intent(in) :: extent + type(UngriddedDim) :: spec + spec = UngriddedDim(UNKNOWN_DIM_NAME, default_coords(extent)) + end function new_UngriddedDim_extent pure function default_coords(extent, lbound) result(coords) real, allocatable :: coords(:) diff --git a/gridcomps/History3G/CMakeLists.txt b/gridcomps/History3G/CMakeLists.txt index 5863f67b3a78..c15988dffb0b 100644 --- a/gridcomps/History3G/CMakeLists.txt +++ b/gridcomps/History3G/CMakeLists.txt @@ -6,11 +6,6 @@ set(srcs HistoryCollectionGridComp.F90 HistoryCollectionGridComp_private.F90 OutputInfo.F90 - UngriddedDimInfo.F90 - UngriddedDimInfoSet.F90 - UngriddedDimsInfo.F90 - StringUngriddedDimMap.F90 - UngriddedDimSet.F90 MAPL3G_ESMF_Info_Keys.F90 ) diff --git a/gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 b/gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 index 314525aa025b..08f34c39f8cd 100644 --- a/gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 +++ b/gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 @@ -2,13 +2,9 @@ module mapl3g_esmf_info_keys implicit none - public - - private :: PREFIX - ! FieldSpec info keys character(len=*), parameter :: PREFIX = 'MAPL/' ! Move to central location (same below) - character(len=*), parameter :: KEY_UNGRID_DIM = PREFIX // 'ungridded_dims/' + character(len=*), parameter :: KEY_UNGRIDDED_DIM = 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' @@ -26,13 +22,13 @@ module mapl3g_esmf_info_keys character(len=*), parameter :: KEYSTUB_DIM = KEY_UNGRIDDED_DIM // 'dim_' ! UngriddedDim info keys - character(len=*), parameter :: KEY_NAME = 'name' - character(len=*), parameter :: KEY_UNITS = 'units' - character(len=*), parameter :: KEY_COORD = 'coordinates' + character(len=*), parameter :: KEY_UNGRIDDED_NAME = 'name' + character(len=*), parameter :: KEY_UNGRIDDED_UNITS = 'units' + character(len=*), parameter :: KEY_UNGRIDDED_COORD = 'coordinates' private - integer, parameter :: SUCCCESS = 0 + integer, parameter :: SUCCESS = 0 integer, parameter :: FAILURE = SUCCESS - 1 character(len=*), parameter :: EMPTY_STRING = '' diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index f7109ecce324..0679d0bed4b9 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -192,11 +192,11 @@ subroutine push_ungridded_dim_info(vec, info, rc) end if do i=1, num_dims dim_key = make_dim_key(i, _RC) - call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_NAME, value=name, _RC) - call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNITS, value=units, _RC) - call ESMF_InfoGet(info, key=dim_key // KEY_COORD, size=num_coord, _RC) + call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNGRIDDED_NAME, value=name, _RC) + call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNGRIDDED_UNITS, value=units, _RC) + call ESMF_InfoGet(info, key=dim_key // KEY_UNGRIDDED_COORD, size=num_coord, _RC) allocate(coordinates(num_coord)) - call ESMF_InfoGet(info, key=dim_key // KEY_COORD, values=coordinates, _RC) + call ESMF_InfoGet(info, key=dim_key // KEY_UNGRIDDED_COORD, values=coordinates, _RC) next = UngriddedDim(name, units, coordinates) vi = get_index_by_name(vec, name) if(vi > 0) then diff --git a/gridcomps/History3G/OutputInfoSet.F90 b/gridcomps/History3G/OutputInfoSet.F90 deleted file mode 100644 index f65f6e52add8..000000000000 --- a/gridcomps/History3G/OutputInfoSet.F90 +++ /dev/null @@ -1,16 +0,0 @@ -module mapl3g_output_info_set - use mapl3g_output_info - -#define T OutputInfo -#define T_LT(A, B) (A) < (B) -#define Set OutputInfoSet -#define SetIterator OutputInfoSetIterator - -#include "set/template.inc" - -#undef T -#undef T_LT -#undef Set -#undef SetIterator - -end module mapl3g_output_info_set diff --git a/gridcomps/History3G/OutputInfo_new.F90 b/gridcomps/History3G/OutputInfo_new.F90 deleted file mode 100644 index 5e88c8dd8ff6..000000000000 --- a/gridcomps/History3G/OutputInfo_new.F90 +++ /dev/null @@ -1,211 +0,0 @@ -module mapl3g_OutputInfo - - use esmf, only: ESMF_InfoGet - - implicit none - private - - public :: OutputInfo -! public :: operator(==) -! public :: operator(/=) - public :: operator(<) - - type :: OutputInfo - integer :: num_levels - character(len=:), allocatable :: vloc - type(UngriddedDimInfo) :: ungridded_dims(:) - end type OutputInfo - - interface OutputInfo - module procedure :: construct_output_info - end interface OutputInfo - -! interface operator(==) -! module procedure :: equal_to_output_info -! module procedure :: equal_to_ungridded_dim_info -! end interface operator(==) -! -! interface operator(/=) -! module procedure :: not_equal_to_output_info -! module procedure :: not_equal_to_ungridded_dim_info -! end interface operator(/=) - - interface operator(<) - module procedure :: less_than_output_info - module procedure :: less_than_ungridded_dim_info - end interface operator(<) - - type :: UngriddedDimInfo - character(len=:), allocatable :: name - character(len=:), allocatable :: units - real :: coordinates(:) - end type UngriddedDimInfo - -! type, abstract :: InfoKey -! character(len=:), allocatable :: string_key -! end type InfoKey -! -! type, extends(InfoKey) :: OutputInfoKey -! integer :: num_levels -! type(UngriddedInfoKey), allocatable :: ungridded_dims_info(:) -! end type OutputInfoKey - - character(len=*), parameter :: PREFIX = 'MAPL/' - character(len=*), parameter :: NUM_LEVELS_KEY = PREFIX // 'num_levels' - character(len=*), parameter :: VLOC_KEY = PREFIX // 'vloc' - character(len=*), parameter :: UNGRIDDED_DIM_KEY = PREFIX // "dim_" - character(len=*), parameter :: NAME_KEY = 'name' - character(len=*), parameter :: UNITS_KEY = 'units' - character(len=*), parameter :: COORDINATES_KEY = 'coordinates' - -contains - -! function get_key_output_info(this) result(key) -! type(OutputInfoKey) :: key -! type(OutputInfo), intent(in) :: this -! -! key%integer_key = [this%num_levels] -! key% - function construct_output_info(info_in, rc) result(output_info) - type(OutputInfo) :: output_info - type(ESMF_Info), intent(in) :: info_in - integer, optional, intent(out) :: rc - integer :: status - character(len=:), allocatable :: num_levels - character(len=:), allocatable :: vloc - character(len=:), allocatable :: name - character(len=:), allocatable :: units - real :: coordinates(:) - - call ESMF_InfoGet(info_in, key=NUM_LEVELS_KEY, num_levels, _RC) - call ESMF_InfoGet(info_in, key=VLOC_KEY, vloc, _RC) - call ESMF_InfoGet(info_in, key=UNGRIDDED_KEY, ungridded, _RC) - - output_info%num_levels = num_levels - output_info%vloc = vloc - output_info%ungridded_dims = get_ungridded_dims_info(info_in, _RC) - - _RETURN(_SUCCESS) - end function construct_output_info - - function construct_ungridded_dim_info(info_in, prefix, rc) result(info_out) - type(UngriddedDimInfo) :: info_out - type(ESMF_Info), intent(in) :: info_in - character(len=*), intent(in) :: prefix - integer, optional, intent(out) :: rc - integer :: status - character(len=:), allocatable :: vloc - character(len=:), allocatable :: name - character(len=:), allocatable :: units - real :: coordinates(:) - - call ESMF_InfoGet(info_in, key=prefix//NAME_KEY, name, _RC) - call ESMF_InfoGet(info_in, key=prefix//UNITS_KEY, units, _RC) - call ESMF_InfoGet(info_in, key=prefix//COORDINATES_KEY, coordinates, _RC) - info_out%name = name - info_out%units = units - info_out%coordinates = coordinates - - _RETURN(_SUCCESS) - end function construct_ungridded_dim_info - - function get_ungridded_dims_info(info_in, rc) result(info_out) - type(UngriddedDimInfo), allocatable = info_out(:) - type(ESMF_Info), intent(in) :: info_in - integer, optional, intent(out) :: rc - integer :: status - integer :: num_ungridded - integer :: i, ios - character(len=32) :: stri - character(len=:), allocatable :: prefix - - call ESMF_InfoGet(info_in, key=NUM_UNGRIDDED_KEY, num_ungridded, _RC) - _ASSERT(num_ungridded >= 0, 'num_ungridded must be nonnegative.') - allocate(info_out(num_ungridded)) - if(num_ungridded == 0) then - _RETURN(_SUCCESS) - end if - do i= 1, num_ungridded - write(stri, fmt='(I0)', iostat=ios) i - _ASSERT(ios == 0, 'failed to create ith ungridded dim index string') - prefix = UNGRIDDED_DIM_KEY // trim(adjustl(stri)) // '/' - info_out(i) = UngriddedDimInfo(info_in, prefix) - end do - - _RETURN(_SUCCESS) - - end function get_ungridded_dims_info - -! logical function equal_to_output_info(a, b) result(equal) -! class(OutputInfo), intent(in) :: a, b -! -! integer :: num_levels -! character(len=:), allocatable :: vloc -! type(UngriddedDimInfo) :: ungridded_dims(:) -! equal = a%num_levels == b%num_levels .and. a%vloc == b%vloc .and. & -! all(a%ungridded_dims == b%ungridded_dims) -! -! end function equal_to_output_info -! -! logical function not_equal_to_output_info(a, b) result(not_equal) -! class(OutputInfo), intent(in) :: a, b -! -! not_equal = .not. (a == b) -! -! end function not_equal_to_output_info -! -! logical function equal_to_ungridded_dim_info(a, b) result(equal) -! class(UngriddedDimInfo), intent(in) :: a, b -! -! equal = a%name == b%name .and. a%units == b%units .and. & -! all(a%coordinates == b%coordinates) -! -! end function equal_to_ungridded_dim_info -! -! logical function not_equal_to_ungridded_dim_info(a, b) result(not_equal) -! class(UngriddedDimInfo), intent(in) :: a, b -! -! not_equal = .not. (a == b) -! -! end function not_equal_to_ungridded_dim_info - - logical function less_than_output_info(a, b) result(tval) - type(OutputInfo), intent(in) :: a, b - integer :: i - - tval = a%num_levels < b%num_levels - if(tval .or. a%num_levels > b%num_levels) return - tval = a%vloc < b%vloc - if(tval .or. a%vloc > b%vloc) return - tval = size(a%ungridded_dims) < size(b%ungridded_dims) - if(tval .or. size(a%ungridded_dims) > size(b%ungridded_dims)) return - do i= 1, size(a%ungridded_dims) - tval = a%ungridded_dims(i) < b%ungridded_dims(i) - if(tval .or. a%ungridded_dims(i) > b%ungridded_dims(i)) return - end do - - end function less_than_output_info - - logical function less_than_ungridded_dim_info(a, b) result(eval) - type(UngriddedDimInfo), intent(in) :: a, b - integer :: i, asz, bsz - real :: acoor, bcoor - - tval = a%name < b%name - if(tval .or. a%name > b%name) return - tval = a%units < b%units - if(tval .or. a%units > b%units) return - asz = size(a%coordinates) - bsz = size(b%coordinates) - tval = asz < bsz - if(tval .or. asz > bsz) return - do i=1, asz - acoor = a%coordinates(i) - bcoor = b%coordinates(i) - tval = acoor < bcoor - if(tval .or. acoor > bcoor) return - end do - - end function less_than_ungridded_dim_info - -end module mapl3g_OutputInfo diff --git a/gridcomps/History3G/OutputInfo_old.F90 b/gridcomps/History3G/OutputInfo_old.F90 deleted file mode 100644 index e6f964cf6130..000000000000 --- a/gridcomps/History3G/OutputInfo_old.F90 +++ /dev/null @@ -1,143 +0,0 @@ -module mapl3g_OutputInfo - - use mapl3g_VerticalGeom, only: VerticalGeom - use mapl3g_VerticalDimSpec, only: VerticalDimSpec - use mapl3g_UngriddedDims, only: UngriddedDims - use esmf, only: ESMF_InfoGet - - implicit none - private - - public :: OutputInfo - public :: operator(==) - public :: operator(/=) - - type :: OutputInfo - type(VerticalGeomInfo) :: vertical_geom_info - type(VerticalDimSpec) :: vertical_dim_spec_info - type(UngriddedDimsInfo) :: ungridded_dims_info - end type OutputInfo - - interface OutputInfo - module procedure :: construct_output_info - end interface OutputInfo - - interface operator(==) - module procedure :: equal_to_output_info - module procedure :: equal_to_vertical_geom_info - module procedure :: equal_to_vertical_dims_spec_info - module procedure :: equal_to_ungridded_dim_info - module procedure :: equal_to_ungridded_dims_info - end interface operator(==) - - interface operator(/=) - module procedure :: not_equal_to_output_info - end interface operator(/=) - - type :: VerticalGeomInfo - integer :: num_levels - end type VerticalGeomInfo - - type :: VerticalDimSpecInfo - character(len=:), allocatable :: vloc - end type VerticalDimSpecInfo - - type :: UngriddedDimInfo - character(len=:), allocatable :: name - character(len=:), allocatable :: units - real :: coordinates(:) - end type UngriddedDimInfo - - type :: UngriddedDimsInfo - type(UngriddedDimInfo) :: dim_specs(:) - end type UngriddedDimsInfo - -contains - - function construct_output_info(esmfinfo) result(output_info) - type(OutputInfo) :: output_info - type(ESMF_Info), intent(in) :: esmfinfo - - call ESMF_InfoGet(esmfinfo, key=VERT_GEOM_KEY, vert_geom, _RC) - output_info%vert_geom => vert_geom - call ESMF_InfoGet(esmfinfo, key=VERT_SPEC_KEY, vert_spec, _RC) - output_info%vert_spec => vert_spec - call ESMF_InfoGet(esmfinfo, key=UNGRIDDED_KEY, ungridded, _RC) - output_info%ungridded => ungridded - - end function construct_output_info - - logical function equal_to_output_info(a, b) result(equal) - class(OutputInfo), intent(in) :: a, b - - equal = a%vertical_geom_info == b%vertical_geom_info .and. & - a%vertical_dim_spec_info == b%vertical_dim_spec_info .and. & - a%vertical_ungridded_dims_info == b%vertical_ungridded_dims_info - - end function equal_to_output_info - - logical function not_equal_to_output_info(a, b) result(not_equal) - class(OutputInfo), intent(in) :: a, b - - not_equal = .not. (a == b) - - end function not_equal_to_output_info - - logical function equal_to_vertical_geom_info(a, b) result(equal) - class(VerticalGeomInfo), intent(in) :: a, b - - equal = a%num_levels == b%num_levels - - end function equal_to_vertical_geom_info - - logical function not_equal_to_vertical_geom_info(a, b) result(not_equal) - class(VerticalGeomInfo), intent(in) :: a, b - - not_equal = .not. (a == b) - - end function not_equal_to_vertical_geom_info - - logical function equal_to_vertical_dim_spec_info(a, b) result(equal) - class(VerticalDimSpecInfo), intent(in) :: a, b - - equal = a%vloc == b%vloc - - end function equal_to_vertical_dim_spec_info - - logical function not_equal_to_vertical_dim_spec_info(a, b) result(not_equal) - class(VerticalDimSpecInfo), intent(in) :: a, b - - not_equal = .not. (a == b) - - end function not_equal_to_vertical_dim_spec_info - - logical function equal_to_ungridded_dim_info(a, b) result(equal) - class(UngriddedDimInfo), intent(in) :: a, b - - equal = a%name == b%name .and. a%units == b%units .and. & - all(a%coordinates == b%coordinates) - - end function equal_to_ungridded_dim_info - - logical function not_equal_to_ungridded_dim_info(a, b) result(not_equal) - class(UngriddedDimInfo), intent(in) :: a, b - - not_equal = .not. (a == b) - - end function not_equal_to_ungridded_dim_info - - logical function equal_to_ungridded_dims_info(a, b) result(equal) - class(UngriddedDimsInfo), intent(in) :: a, b - - equal = all(a == b) - - end function equal_to_ungridded_dims_info - - logical function not_equal_to_ungridded_dims_info(a, b) result(not_equal) - class(UngriddedDimsInfo), intent(in) :: a, b - - not_equal = .not. (a == b) - - end function not_equal_to_ungridded_dims_info - -end module mapl3g_OutputInfo diff --git a/gridcomps/History3G/StringUngriddedDimMap.F90 b/gridcomps/History3G/StringUngriddedDimMap.F90 deleted file mode 100644 index 2576f835aeba..000000000000 --- a/gridcomps/History3G/StringUngriddedDimMap.F90 +++ /dev/null @@ -1,17 +0,0 @@ -module mapl3g_string_ungridded_dim_map - use mapl3g_UngriddedDim - -#include "types/key_deferredLengthString.inc" -#define _value type(UngriddedDim) - -#define _map StringUngriddedDimMap -#define _iterator StringUngriddedDimMapIterator -#define _alt -#include "templates/map.inc" - -#undef _alt -#undef _iterator -#undef _map -#undef _value - -end module mapl3g_string_ungridded_dim_map diff --git a/gridcomps/History3G/UngriddedDimInfo.F90 b/gridcomps/History3G/UngriddedDimInfo.F90 deleted file mode 100644 index 8e17ebd53702..000000000000 --- a/gridcomps/History3G/UngriddedDimInfo.F90 +++ /dev/null @@ -1,140 +0,0 @@ -#include "MAPL_Generic.h" -module mapl3g_ungridded_dim_info - - use esmf, only: ESMF_Info, ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoCreate, ESMF_InfoDestroy - use Mapl_ErrorHandling - - implicit none - - public :: UngriddedDimInfo - public :: operator(<) - public :: operator(==) - - type :: UngriddedDimInfo - character(len=:), allocatable :: name - character(len=:), allocatable :: units - real, allocatable :: coordinates(:) - contains - procedure :: name_units - procedure :: coordinate_dims - end type UngriddedDimInfo - - interface UngriddedDimInfo - module procedure :: construct_ungridded_dim_info - end interface UngriddedDimInfo - - interface operator(<) - module procedure :: less - end interface - - interface operator(==) - module procedure :: equal - end interface - - character(len=*), parameter :: KEY_NUM_UNGRID = 'num_ungridded_dimensions' - character(len=*), parameter :: KEYSTUB_DIM = 'dim_' - character(len=*), parameter :: KEY_NAME = 'name' - character(len=*), parameter :: KEY_UNITS = 'units' - character(len=*), parameter :: KEY_COORS = 'coordinates' - -contains - - function construct_ungridded_dim_info(info, rc) result(ud_info) - type(UngriddedDimInfo) :: ud_info - type(ESMF_Info), intent(in) :: info - integer, optional, intent(out) :: rc - integer :: status - character(len=:), allocatable :: name - character(len=:), allocatable :: units - real, allocatable :: coordinates(:) - integer :: sz - - allocate(coordinates(sz)) - call ESMF_InfoGet(info, key='coordinates', values=coordinates, _RC) - ud_info%name = name - ud_info%units = units - ud_info%coordinates = coordinates - - _RETURN(_SUCCESS) - - end function construct_ungridded_dim_info - - pure function name_units(this) result(nu) - character(len=:), allocatable :: nu - class(UngriddedDimInfo), intent(in) :: this - - nu = this%name // this%units - - end function name_units - - pure integer function coordinate_dims(this) - class(UngriddedDimInfo), intent(in) :: this - real, allocatable :: coordinates(:) - - coordinates = this%coordinates - coordinate_dims = size(coordinates) - - end function coordinate_dims - - elemental function equal(a, b) result(t) - logical :: t - class(UngriddedDimInfo), intent(in) :: a, b - - t = name_units_equal(a, b) .and. coordinates_equal(a, b) - - end function equal - - elemental function less(a, b) result(t) - logical :: t - class(UngriddedDimInfo), intent(in) :: a, b - - t = name_units_less(a, b) - if(t .or. name_units_less(b, a)) return - t = coordinates_less(a, b) - - end function less - - elemental function name_units_equal(a, b) result(t) - logical :: t - class(UngriddedDimInfo), intent(in) :: a, b - - t = a%name_units() == b%name_units() - - end function name_units_equal - - elemental function name_units_less(a, b) result(t) - logical :: t - class(UngriddedDimInfo), intent(in) :: a, b - - t = a%name_units() < b%name_units() - - end function name_units_less - - elemental function coordinates_equal(a, b) result(t) - logical :: t - class(UngriddedDimInfo), intent(in) :: a, b - - t = a%coordinate_dims() == b%coordinate_dims() - if(t) t = all(a%coordinates == b%coordinates) - - end function coordinates_equal - - elemental function coordinates_less(a, b) result(t) - logical :: t - class(UngriddedDimInfo), intent(in) :: a, b - logical, allocatable :: lt(:), gt(:) - integer :: i, n - - n = a%coordinate_dims() - t = n < b%coordinate_dims() - if(t .or. n > b%coordinate_dims()) return - lt = a%coordinates < b%coordinates - gt = a%coordinates > b%coordinates - do i=1, n - t = lt(i) - if(t .or. gt(i)) return - end do - - end function coordinates_less - -end module mapl3g_ungridded_dim_info diff --git a/gridcomps/History3G/UngriddedDimInfoArray.F90 b/gridcomps/History3G/UngriddedDimInfoArray.F90 deleted file mode 100644 index 13b8e2a9e7a7..000000000000 --- a/gridcomps/History3G/UngriddedDimInfoArray.F90 +++ /dev/null @@ -1,26 +0,0 @@ - - function get_array(info_in, rc) result(array) - type(ESMF_Info), intent(in) :: info_in - integer, optional, intent(out) :: rc - character(len=*), parameter :: PREFIX = 'MAPL/' - integer :: status - integer :: num_ungridded - integer :: i, ios - character(len=32) :: stri - type(UngriddedDimInfo), allocatable :: array(:) - - call ESMF_InfoGet(info_in, PREFIX // 'num_ungridded', num_ungridded, _RC) - _ASSERT(num_ungridded >= 0, 'num_ungridded must be nonnegative.') - allocate(array(num_ungridded)) - if(num_ungridded == 0) then - _RETURN(_SUCCESS) - end if - do i= 1, num_ungridded - write(stri, fmt='(I0)', iostat=ios) i - _ASSERT(ios == 0, 'failed to create ith ungridded dim index string') - array(i) = UngriddedDimInfo(info_in, PREFIX // 'dim_' // trim(adjustl(stri)) // '/') - end do - - _RETURN(_SUCCESS) - - end function get_array diff --git a/gridcomps/History3G/UngriddedDimInfoSet.F90 b/gridcomps/History3G/UngriddedDimInfoSet.F90 deleted file mode 100644 index 4f1aab331c3b..000000000000 --- a/gridcomps/History3G/UngriddedDimInfoSet.F90 +++ /dev/null @@ -1,16 +0,0 @@ -module mapl3g_ungridded_dim_set - use mapl3g_ungridded_dim_info - -#define T UngriddedDimInfo -#define T_LT(A, B) (A) < (B) -#define Set UngriddedDimInfoSet -#define SetIterator UngriddedDimInfoSetIterator - -#include "set/template.inc" - -#undef T -#undef T_LT -#undef Set -#undef SetIterator - -end module mapl3g_ungridded_dim_set diff --git a/gridcomps/History3G/UngriddedDimSet.F90 b/gridcomps/History3G/UngriddedDimSet.F90 deleted file mode 100644 index 2ac498f64f83..000000000000 --- a/gridcomps/History3G/UngriddedDimSet.F90 +++ /dev/null @@ -1,23 +0,0 @@ -module mapl3g_ungridded_dim_set - use mapl3g_UngriddedDim - -#define T UngriddedDim -#define T_LT(A, B) less_than(A, B) -#define Set UngriddedDimSet -#define SetIterator UngriddedDimSetIterator - -#include "set/template.inc" - - logical function less_than(a, b) - type(T), intent(in) :: a, b - - less_than = (a%name < b%name) - - end function less_than - -#undef T -#undef T_LT -#undef Set -#undef SetIterator - -end module mapl3g_ungridded_dim_set diff --git a/gridcomps/History3G/UngriddedDimsInfo.F90 b/gridcomps/History3G/UngriddedDimsInfo.F90 deleted file mode 100644 index 58dce4744887..000000000000 --- a/gridcomps/History3G/UngriddedDimsInfo.F90 +++ /dev/null @@ -1,86 +0,0 @@ -#include "MAPL_Generic.h" -module mapl3g_ungridded_dims_info - - use mapl3g_ungridded_dim_info - use mapl3g_ungridded_dim_set - use esmf, only: ESMF_Info - use Mapl_ErrorHandling - - implicit none - - public :: UngriddedDimsInfo - public :: UngriddedDimInfo - public :: UngriddedDimInfoSet - private - - type :: UngriddedDimsInfo - private - type(UngriddedDimInfo), allocatable :: array(:) - contains - procedure :: as_set => ungridded_dims_info_as_set - procedure :: as_array => ungridded_dims_info_as_array - end type UngriddedDimsInfo - - interface UngriddedDimsInfo - module procedure :: construct_ungridded_dims_info - end interface UngriddedDimsInfo - - character(len=*), parameter :: KEY_NUM_UNGRID_DIMS = 'num_ungridded_dimensions' - character(len=*), parameter :: KEYSTUB_DIM = 'dim_' - -contains - - function construct_ungridded_dims_info(info, rc) result(self) - type(UngriddedDimsInfo) :: self - type(ESMF_Info), intent(in) :: info - integer, optional, intent(out) :: rc - integer :: status - - self%array = get_array(info, _RC) - - end function construct_ungridded_dims_info - - function ungridded_dims_info_as_set(this) result(as_set) - type(UngriddedDimSet) :: as_set - class(UngriddedDimsInfo), intent(in) :: this - - as_set = UngriddedDimSet(this%as_array()) - - end function ungridded_dims_info_as_set - - function ungridded_dims_info_as_array(this) result(as_array) - type(UngriddedDim) :: as_array(:) - class(UngriddedDimsInfo), intent(in) :: this - - as_array = this%array - - end function ungridded_dims_info_as_array - - function get_array(info, rc) result(array) - type(UngriddedDimInfo), allocatable :: array(:) - type(ESMF_Info), intent(in) :: info - integer, optional, intent(out) :: rc - integer :: status - - integer :: num_ungridded - integer :: i, ios - character(len=32) :: stri - type(UngriddedDimInfo), allocatable :: array(:) - - call ESMF_InfoGet(info, KEY_NUM_UNGRID_DIMS, num_ungridded, _RC) - _ASSERT(num_ungridded >= 0, 'num_ungridded must be nonnegative.') - allocate(array(num_ungridded)) - if(num_ungridded == 0) then - _RETURN(_SUCCESS) - end if - do i= 1, num_ungridded - write(stri, fmt='(I0)', iostat=ios) i - _ASSERT(ios == 0, 'failed to create ith ungridded dim index string') - array(i) = UngriddedDimInfo(info, KEYSTUB_DIM // trim(adjustl(stri)) // '/') - end do - - _RETURN(_SUCCESS) - - end function get_array - -end module mapl3g_ungridded_dims_info diff --git a/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf b/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf index 11dbc9679899..d7806fc839b5 100644 --- a/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf +++ b/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf @@ -239,43 +239,6 @@ contains !@Test ! subroutine test_get_output_info_bundle() -! type(ESMF_HConfig) :: hconfig_geom, hconfig_hist -! type(ESMF_Geom) :: geom -! type(ESMF_Grid) :: grid -! integer :: rank,fieldCount -! integer :: status -! logical :: found -! type(ESMF_State) :: state, substate -! type(ESMF_FieldBundle) :: bundle -! type(ESMF_Field) :: field -! type(OutputInfoSet) :: out_set -! -! !call ESMF_Initialize(_RC) -! hconfig_geom = ESMF_HConfigCreate(content= & -! "{geom: {class: latlon, im_world: 14, jm_world: 13, pole: PC, " // & -! "dateline: DC, nx: 1, ny: 1}}", _RC) -! geom = make_geom(hconfig_geom, _RC) -! call ESMF_GeomGet(geom, grid=grid, _RC) -! -! field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R4, name="E_1", _RC) -! substate = ESMF_StateCreate(fieldList=[field], name= "DYN", _RC) -! state = ESMF_Statecreate(nestedStateList=[substate],_RC) -! -! hconfig_hist = ESMF_HConfigCreate(content= & -! "{var_list: {E1: {expr: DYN.E_1}}}", _RC) -! -! bundle = create_output_bundle(hconfig_hist, state, _RC) -! out_set = get_output_info_bundle(bundle, _RC) -! !@assertEqual(1, out_set%size(), 'There should be one element.') -! call ESMF_HConfigDestroy(hconfig_hist, _RC) -! !call ESMF_FieldBundleDestroy(bundle, nogarbage=.true. ,_RC) -! !call ESMF_FieldDestroy(field, nogarbage=.true., _RC) -! !call ESMF_StateDestroy(state, nogarbage=.true., _RC) -! !call ESMF_GridDestroy(grid, nogarbage=.true., _RC) -! !call ESMF_GeomDestroy(geom, _RC) -! !call ESMF_HConfigDestroy(hconfig_geom, _RC) -! !call ESMF_Finalize() -! ! end subroutine test_get_output_info_bundle end module Test_HistoryCollectionGridComp diff --git a/gridcomps/History3G/tests/Test_OutputInfoSet.pf b/gridcomps/History3G/tests/Test_OutputInfoSet.pf deleted file mode 100644 index 7ed87f6128d8..000000000000 --- a/gridcomps/History3G/tests/Test_OutputInfoSet.pf +++ /dev/null @@ -1,50 +0,0 @@ -#include "MAPL_TestErr.h" -module Test_OutputInfoSet - use mapl3g_output_info_set - use mapl3g_output_info - use mapl3g_ungridded_dim_info - use pfunit - use esmf - - implicit none - -#include "history3g_test_utility_variables.h" - -contains - -#include "history3g_test_utility_procedures.h" - - @Test - subroutine test_insert() - type(ESMF_Info) :: info - type(OutputInfo) :: outinfo1, outinfo2, outinfo3 - type(OutputInfoSet) :: outinfo_set - integer :: status - - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) - outinfo1 = OutputInfo(info, _RC) - call ESMF_InfoDestroy(info) - outinfo_set = OutputInfoSet() - - call outinfo_set%insert(outinfo1) - - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, NUM_LEVELS+1, VLOC, NUM_UNGRIDDED, _RC) - outinfo2 = OutputInfo(info, _RC) - call ESMF_InfoDestroy(info) - call outinfo_set%insert(outinfo2) - - @assertEqual(2, outinfo_set%size(), 'Size of set should be 2.') - - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, NUM_LEVELS, VLOC, NUM_UNGRIDDED, _RC) - outinfo3 = OutputInfo(info, _RC) - call ESMF_InfoDestroy(info) - call outinfo_set%insert(outinfo3) - - @assertEqual(2, outinfo_set%size(), 'Size of set should still be 2.') - - end subroutine test_insert - -end module Test_OutputInfoSet diff --git a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf b/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf deleted file mode 100644 index 467683feb5ab..000000000000 --- a/gridcomps/History3G/tests/Test_UngriddedDimInfo.pf +++ /dev/null @@ -1,178 +0,0 @@ -#include "MAPL_TestErr.h" -module Test_UngriddedDimInfo - - use mapl3g_ungridded_dim_info - use pfunit - use esmf - - implicit none - - character(len=*), parameter :: NAME_LABEL = 'name' - character(len=*), parameter :: UNITS_LABEL = 'units' - character(len=*), parameter :: COORDINATES_LABEL = 'coordinates' - -contains - - @Test - subroutine test_construct_ungridded_dim_info() - integer :: status - type(ESMF_Info) :: info - type(UngriddedDimInfo) :: obj - real, allocatable :: coordinates(:) - character(len=:), allocatable :: name - character(len=:), allocatable :: units - - name = 'G1' - units = 'stones' - coordinates = [1.0, 2.0, 3.0, 4.0] - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, name, units, coordinates, _RC) - obj = UngriddedDimInfo(info, _RC) - @assertEqual(name, obj%name, NAME_LABEL // ' does not match.') - @assertEqual(units, obj%units, UNITS_LABEL // 'units does not match.') - @assertEqual(coordinates, obj%coordinates, COORDINATES_LABEL // ' does not match.') - call ESMF_InfoDestroy(info) - - end subroutine test_construct_ungridded_dim_info - - @Test - subroutine test_name_units() - integer :: status - type(ESMF_Info) :: info - type(UngriddedDimInfo) :: obj - real, allocatable :: coordinates(:) - character(len=:), allocatable :: name - character(len=:), allocatable :: units - character(len=:), allocatable :: NAME_UNITS - - name = 'G1' - units = 'stones' - NAME_UNITS = name // units - coordinates = [1.0, 2.0, 3.0, 4.0] - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, name, units, coordinates, _RC) - obj = UngriddedDimInfo(info, _RC) - @assertEqual(NAME_UNITS, obj%name_units(), NAME_UNITS // '() does not match expected ' // NAME_UNITS // '.') - call ESMF_InfoDestroy(info) - - end subroutine test_name_units - - @Test - subroutine test_coordinate_dims() - integer :: status, ios - type(ESMF_Info) :: info - type(UngriddedDimInfo) :: obj - real, allocatable :: coordinates(:) - character(len=:), allocatable :: name - character(len=:), allocatable :: units - character(len=32) :: dims_string - - name = 'G1' - units = 'stones' - coordinates = [1.0, 2.0, 3.0, 4.0] - write(dims_string, fmt='(I0)', iostat=ios) size(coordinates) - @assertEqual(0, ios, 'write to dims_string failed.') - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, name, units, coordinates, _RC) - obj = UngriddedDimInfo(info, _RC) - @assertEqual(size(coordinates), obj%coordinate_dims(), 'coordinate_dims() does not match expected value ' // trim(dims_string) // '.') - call ESMF_InfoDestroy(info) - - end subroutine test_coordinate_dims - - @Test - subroutine test_less() - integer :: status - real, allocatable :: coordinates(:, :) - real, allocatable :: coordinate_vector(:) - type(ESMF_Info) :: info1, info2 - type(UngriddedDimInfo) :: obj1, obj2 - - coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 4.0] - coordinates = reshape(coordinate_vector, [4, 2]) - info1 = ESMF_InfoCreate(_RC) - call make_esmf_info(info1, 'G1', 'kg', coordinates(:, 1), _RC) - obj1 = UngriddedDimInfo(info1, _RC) - info2 = ESMF_InfoCreate(_RC) - call make_esmf_info(info2, 'G1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, _RC) - - @assertFalse(obj1 < obj2, 'obj1 is not less than obj2.') - @assertFalse(obj2 < obj1, 'obj2 is not less than obj1.') - - call ESMF_InfoDestroy(info2) - info2 = ESMF_InfoCreate(_RC) - coordinate_vector = [1.0, 2.0, 3.0, 4.0, 2.0, 2.0, 3.0, 4.0] - coordinates = reshape(coordinate_vector, [4, 2]) - call make_esmf_info(info2, 'G1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, _RC) - - @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') - - call ESMF_InfoDestroy(info2) - info2 = ESMF_InfoCreate(_RC) - coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 3.0, 3.0, 4.0] - coordinates = reshape(coordinate_vector, [4, 2]) - call make_esmf_info(info2, 'G1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, _RC) - - @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') - - call ESMF_InfoDestroy(info2) - info2 = ESMF_InfoCreate(_RC) - coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 4.0, 4.0] - coordinates = reshape(coordinate_vector, [4, 2]) - call make_esmf_info(info2, 'G1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, _RC) - - @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') - - call ESMF_InfoDestroy(info2) - info2 = ESMF_InfoCreate(_RC) - coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 5.0] - coordinates = reshape(coordinate_vector, [4, 2]) - call make_esmf_info(info2, 'g1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, _RC) - - @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') - - call ESMF_InfoDestroy(info2) - info2 = ESMF_InfoCreate(_RC) - coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.1, 2.0, 3.0] - coordinates = reshape(coordinate_vector, [4, 2]) - call make_esmf_info(info2, 'G1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, _RC) - - @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') - - call ESMF_InfoDestroy(info2) - info2 = ESMF_InfoCreate(_RC) - coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 4.0] - call make_esmf_info(info2, 'H1', 'kg', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, _RC) - - @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') - call ESMF_InfoDestroy(info2) - info2 = ESMF_InfoCreate(_RC) - coordinate_vector = [1.0, 2.0, 3.0, 4.0, 1.0, 2.0, 3.0, 4.0] - call make_esmf_info(info2, 'G1', 'stone', coordinates(:, 2), _RC) - obj2 = UngriddedDimInfo(info2, _RC) - - @assertTrue(obj1 < obj2, 'obj1 is less than obj2.') - end subroutine test_less - - subroutine make_esmf_info(info, name, units, coordinates, rc) - type(ESMF_Info), intent(inout) :: info - character(len=*), intent(in) :: name - character(len=*), intent(in) :: units - real, intent(in) :: coordinates(:) - integer, optional, intent(out) :: rc - integer :: status - - call ESMF_InfoSet(info, NAME_LABEL, name, _RC) - call ESMF_InfoSet(info, UNITS_LABEL, units, _RC) - call ESMF_InfoSet(info, COORDINATES_LABEL, coordinates, _RC) - - end subroutine make_esmf_info - -end module Test_UngriddedDimInfo diff --git a/gridcomps/History3G/tests/Test_UngriddedDimInfoSet.pf b/gridcomps/History3G/tests/Test_UngriddedDimInfoSet.pf deleted file mode 100644 index 4c03f1466150..000000000000 --- a/gridcomps/History3G/tests/Test_UngriddedDimInfoSet.pf +++ /dev/null @@ -1,12 +0,0 @@ -#include "MAPL_TestErr.h" -module Test_UngriddedDimInfoSet - - use mapl3g_ungridded_dim_info_set - use pfunit - use esmf - - implicit none - -contains - -end module Test_UngriddedDimInfoSet diff --git a/gridcomps/History3G/tests/Test_UngriddedDimsInfo.pf b/gridcomps/History3G/tests/Test_UngriddedDimsInfo.pf deleted file mode 100644 index 7b07d50d4792..000000000000 --- a/gridcomps/History3G/tests/Test_UngriddedDimsInfo.pf +++ /dev/null @@ -1,43 +0,0 @@ -#include "MAPL_TestErr.h" -module Test_UngriddedDimsInfo - - use mapl3g_ungridded_dims_info - use pfunit - use esmf - - implicit none - -#include "history3g_test_utility_variables" - - type(ESMF_Info) :: info - -contains - - @Test - subroutine test_construct_ungridded_dims_info() - type(UngriddedDimsInfo) :: ungridded - - ungridded = UngriddedDimsInfo(info, _RC) - - end subroutine test_construct_ungridded_dims_info - - @Before - subroutine setup() - integer :: status - - info = ESMF_InfoCreate(_RC) - - end subroutine setup - - @After - subroutine shutdown() - integer :: status - character(len=*), parameter :: NAMES = - - call ESMF_InfoDestroy(info, _RC) - - end subroutine shutdown - -#include "history3g_test_utility_procedures" - -end module Test_UngriddedDimInfo diff --git a/gridcomps/History3G/tests/history3g_test_utilities.F90 b/gridcomps/History3G/tests/history3g_test_utilities.F90 deleted file mode 100644 index 0a2955aee96c..000000000000 --- a/gridcomps/History3G/tests/history3g_test_utilities.F90 +++ /dev/null @@ -1,103 +0,0 @@ -#define SET_RC if(present(rc)) rc = status -#include "MAPL_TestErr.h" -module mapl3g_history3g_test_utilities - - use esmf - - implicit none - - public :: make_esmf_info - - character(len=*), parameter :: PREFIX = 'MAPL/G1/' - integer, parameter :: NUM_LEVELS = 3 - character(len=*), parameter :: VLOC = 'VERTICAL_DIM_CENTER' - integer, parameter :: NUM_UNGRIDDED = 3 - character(len=*), parameter :: NAME = 'A1' - character(len=*), parameter :: UNITS = 'stones' - real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] - - private -contains - - subroutine make_esmf_info(info, prefix, num_levels, vloc, num_ungridded, names, units_array, rc) - type(ESMF_Info), intent(inout) :: info - character(len=*), intent(in) :: prefix - integer, intent(in) :: num_levels - character(len=*), intent(in) :: vloc - integer, intent(in) :: num_ungridded - character(len=*), optional, intent(in) :: names(:) - character(len=*), optional, intent(in) :: units_array(:) - integer, optional, intent(out) :: rc - character(len=*), parameter :: NUMLEV_LABEL = 'num_levels' - character(len=*), parameter :: VLOC_LABEL = 'vloc' - character, parameter :: NUM_UNGRID_LABEL = 'num_ungridded' - integer :: status - - call ESMF_InfoSet(info, prefix // NUMLEV_LABEL, num_levels, _RC) - call ESMF_InfoSet(info, prefix // VLOC_LABEL, vloc, _RC) - call make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, _RC) - - SET_RC - - end subroutine make_esmf_info - - subroutine make_esmf_ungridded_info(info, prefix, num_ungridded, names, units_array, rc) - type(ESMF_Info), intent(inout) :: info - character(len=*), intent(in) :: prefix - integer, intent(in) :: num_ungridded - character(len=*), optional, intent(in) :: names(:) - character(len=*), optional, intent(in) :: units_array(:) - integer, optional, intent(out) :: rc - character(len=*), parameter :: NAME_LABEL = 'name' - character(len=*), parameter :: UNITS_LABEL = 'units' - character(len=*), parameter :: COORDINATES_LABEL = 'coordinates' - real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] - type(ESMF_Info) :: comp_info - character(len=:), allocatable :: name_, units_ - integer :: status, i - - status = -1 - - SET_RC - - if(present(names)) then - if(size(names) /= num_ungridded) return - end if - - if(present(units_array)) then - if(size(units_array) /= num_ungridded) return - end if - - do i=1, num_ungridded - name_ = NAME - if(present(names)) name_ = names(i) - units_ = UNITS - if(present(units_array)) units_ = units_array(i) - comp_info = ESMF_InfoCreate(_RC) - call ESMF_InfoSet(comp_info, prefix // NAME_LABEL, name_, _RC) - call ESMF_InfoSet(comp_info, prefix // UNITS_LABEL, units_, _RC) - call ESMF_InfoSet(comp_info, prefix // COORDINATES_LABEL, COORDINATES, _RC) - call ESMF_InfoSet(info, prefix // make_component_label(i), comp_info, _RC) - call ESMF_InfoDestroy(comp_info) - end do - - SET_RC - - end subroutine make_esmf_ungridded_info - - function make_component_label(n, rc) result(name) - character(len=:), allocatable :: name - integer, intent(in) :: n - integer, optional, intent(out) :: rc - character(len=*), parameter :: COMP_PREFIX = 'dim_' - character(len=32) :: strn - integer :: status - - write(strn, fmt='(I0)', iostat=status) n - if(status == 0) name = COMP_PREFIX // trim(adjustl(strn)) - - SET_RC - - end function make_component_label - -end module mapl3g_history3g_test_utilities From cb1dd8d3841b5af8b6aae7a4d2ff2cbd0c600c23 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Wed, 22 May 2024 11:37:53 -0400 Subject: [PATCH 10/23] All tests passing for OutputInfo. --- CHANGELOG.md | 2 + base/CMakeLists.txt | 1 + .../MAPL_ESMF_InfoKeys.F90 | 4 +- gridcomps/History3G/CMakeLists.txt | 1 - .../HistoryCollectionGridComp_private.F90 | 27 +- gridcomps/History3G/OutputInfo.F90 | 145 +++++++--- gridcomps/History3G/tests/CMakeLists.txt | 1 - .../tests/Test_HistoryCollectionGridComp.pf | 6 +- gridcomps/History3G/tests/Test_OutputInfo.pf | 264 ++++++++++++++++-- .../tests/history3g_test_utility_procedures.h | 122 -------- .../tests/history3g_test_utility_variables.h | 6 - 11 files changed, 357 insertions(+), 222 deletions(-) rename gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 => base/MAPL_ESMF_InfoKeys.F90 (94%) diff --git a/CHANGELOG.md b/CHANGELOG.md index 87ffde80d6a7..e28bae2ecbb9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -35,6 +35,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added GitHub Action to generate MAPL3 Ford Docs - Added capability for HistoryCollectionGridComp to extract field names from expressions - Added ability for HistoryCollectionGridComp to extract multiple field names from expressions +- Added procedures to get information about an ESMF_FieldBundle in History3G +- Added module for keys to ESMF_Info metadata used in MAPL3G ### Changed diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index 43061d3ce143..b0c18e85c7ff 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -56,6 +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 # Orphaned program: should not be in this library. # tstqsat.F90 ) diff --git a/gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 b/base/MAPL_ESMF_InfoKeys.F90 similarity index 94% rename from gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 rename to base/MAPL_ESMF_InfoKeys.F90 index 08f34c39f8cd..d17007400c45 100644 --- a/gridcomps/History3G/MAPL3G_ESMF_Info_Keys.F90 +++ b/base/MAPL_ESMF_InfoKeys.F90 @@ -3,7 +3,7 @@ module mapl3g_esmf_info_keys implicit none ! FieldSpec info keys - character(len=*), parameter :: PREFIX = 'MAPL/' ! Move to central location (same below) + character(len=*), parameter :: PREFIX = 'MAPL/' character(len=*), parameter :: KEY_UNGRIDDED_DIM = PREFIX // 'ungridded_dims/' character(len=*), parameter :: KEY_VERT_DIM = PREFIX // 'vertical_dim/' character(len=*), parameter :: KEY_VERT_GEOM = PREFIX // 'vertical_geom/' @@ -26,7 +26,7 @@ module mapl3g_esmf_info_keys character(len=*), parameter :: KEY_UNGRIDDED_UNITS = 'units' character(len=*), parameter :: KEY_UNGRIDDED_COORD = 'coordinates' - private + private :: SUCCESS, FAILURE, EMPTY_STRING integer, parameter :: SUCCESS = 0 integer, parameter :: FAILURE = SUCCESS - 1 diff --git a/gridcomps/History3G/CMakeLists.txt b/gridcomps/History3G/CMakeLists.txt index c15988dffb0b..8e9a2e70a79a 100644 --- a/gridcomps/History3G/CMakeLists.txt +++ b/gridcomps/History3G/CMakeLists.txt @@ -6,7 +6,6 @@ set(srcs HistoryCollectionGridComp.F90 HistoryCollectionGridComp_private.F90 OutputInfo.F90 - MAPL3G_ESMF_Info_Keys.F90 ) find_package (MPI REQUIRED) diff --git a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 index b4b20614ac20..b2459de21485 100644 --- a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 +++ b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 @@ -10,7 +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 + 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 gFTL2_StringSet implicit none @@ -21,7 +22,6 @@ module mapl3g_HistoryCollectionGridComp_private public :: create_output_bundle public :: create_output_alarm public :: set_start_stop_time - public :: get_output_info_bundle public :: get_current_time_index ! These are public for testing. public :: parse_item_common @@ -188,29 +188,6 @@ function set_start_stop_time(clock, hconfig, rc) result(start_stop_time) _RETURN(_SUCCESS) end function set_start_stop_time - subroutine get_output_info_bundle(bundle, num_levels, vertical_dim_spec_names, ungridded_dims_info, rc) result(out_set) - type(ESMF_FieldBundle) :: bundle - integer, optional, intent(out) :: num_levels - type(StringSet), optional, intent(out) :: vertical_dim_spec_names - type(UngriddedDimInfoSet), optional, intent(out) :: ungridded_dims_info - integer, optional, intent(out) :: rc - integer :: status - - if(present(num_levels)) then - num_levels = get_num_levels(bundle, _RC) - _RETURN_UNLESS(present(vertical_dim_spec_names) .or. present(ungridded_dims_info)) - end if - - if(present(vertical_dim_spec_names)) then - vertical_dim_spec_names = get_vertical_dim_spec_names(bundle, _RC) - _RETURN_UNLESS(present(ungridded_dims_info)) - endif - - ungridded_dims_info = get_ungridded_dims_info(bundle, _RC) - _RETURN(_SUCCESS) - - end subroutine get_output_info_bundle - subroutine parse_item_expression(item, item_name, var_names, rc) type(ESMF_HConfigIter), intent(in) :: item character(len=:), allocatable, intent(out) :: item_name diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index 0679d0bed4b9..6a4524993c36 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -1,13 +1,25 @@ #include "MAPL_Generic.h" + +#if defined(SAFE_DEALLOC) +# undef SAFE_DEALLOC +#endif +#define SAFE_DEALLOC(A) if(allocated(A)) deallocate(A) + +#if defined(SAFE_ALLOC1) +# undef SAFE_ALLOC1 +#endif +#define SAFE_ALLOC1(A, S) SAFE_DEALLOC(A); allocate(A(S)) + module mapl3g_output_info - use mapl3g_ESMF_Info_Keys - use mapl3g_UngriddedDims use mapl3g_UngriddedDim + use mapl3g_UngriddedDimVector + use mapl3g_UngriddedDims + use mapl3g_ESMF_Info_Keys use gFTL2_StringVector - use esmf, only: ESMF_Field, ESMF_FieldBundle - use esmf, only: ESMF_Info, ESMF_InfoCreate, ESMF_InfoDestroy - use esmf, only: ESMF_InfoGet, ESMF_InfoGetCharAlloc + use esmf, only: ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + use esmf, only: ESMF_Info, ESMF_InfoDestroy, ESMF_InfoIsPresent + use esmf, only: ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoGetFromHost use Mapl_ErrorHandling implicit none @@ -18,6 +30,9 @@ module mapl3g_output_info public :: get_vertical_dim_spec_names public :: get_vertical_dim_spec_name public :: get_ungridded_dims + public :: get_num_levels_bundle_info + public :: get_vertical_dim_spec_names_bundle_info + public :: get_ungridded_dims_bundle_info interface get_num_levels module procedure :: get_num_levels_bundle @@ -28,19 +43,18 @@ module mapl3g_output_info module procedure :: get_vertical_dim_spec_names_bundle end interface get_vertical_dim_spec_names - interface get_ungridded_dims - module procedure :: get_ungridded_dim_bundle - module procedure :: get_ungridded_dims_field - end interface get_ungridded_dims - interface get_vertical_dim_spec_name module procedure :: get_vertical_dim_spec_name_field end interface get_vertical_dim_spec_name + interface get_ungridded_dims + module procedure :: get_ungridded_dims_bundle + module procedure :: get_ungridded_dims_field + end interface get_ungridded_dims + contains integer function get_num_levels_bundle(bundle, rc) result(num) - integer :: num type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc integer :: status @@ -48,15 +62,26 @@ integer function get_num_levels_bundle(bundle, rc) result(num) type(ESMF_Info), allocatable :: info(:) info = get_bundle_info(bundle, _RC) + num = get_num_levels_bundle_info(info, _RC) + call destroy_bundle_info(info, _RC) + _RETURN(_SUCCESS) + + end function get_num_levels_bundle + + integer function get_num_levels_bundle_info(info, rc) result(num) + type(ESMF_Info), intent(in) :: info(:) + integer, optional, intent(out) :: rc + integer :: status + integer :: i, n + num = get_num_levels_info(info(1), _RC) do i=2, size(info) n = get_num_levels_info(info(i), _RC) _ASSERT(n == num, 'All fields must have the same number of vertical levels.') end do - call destroy_info(info, _RC) _RETURN(_SUCCESS) - end function get_num_levels_bundle + end function get_num_levels_bundle_info integer function get_num_levels_field(field, rc) result(num) type(ESMF_Field), intent(in) :: field @@ -96,15 +121,28 @@ function get_vertical_dim_spec_names_bundle(bundle, rc) result(names) type(ESMF_Info), allocatable :: info(:) info = get_bundle_info(bundle, _RC) + names = get_vertical_dim_spec_names_bundle_info(info, _RC) + call destroy_bundle_info(info, _RC) + _RETURN(_SUCCESS) + + end function get_vertical_dim_spec_names_bundle + + function get_vertical_dim_spec_names_bundle_info(info, rc) result(names) + type(StringVector) :: names + type(ESMF_Info), intent(in) :: info(:) + integer, optional, intent(out) :: rc + integer :: status + integer :: i + character(len=:), allocatable :: name + names = StringVector() do i=1, size(info) name = get_vertical_dim_spec_info(info(i), _RC) - if(names%get_index(name)==0) names%push_back(name) + if(find_index(names, name) == 0) call names%push_back(name) end do - call destroy_bundle_info(info, _RC) _RETURN(_SUCCESS) - end function get_vertical_dim_spec_names_bundle + 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 @@ -135,7 +173,7 @@ function get_vertical_dim_spec_info(info, rc) result(spec_name) end function get_vertical_dim_spec_info - function get_ungridded_dim_bundle(bundle, rc) result(dims) + function get_ungridded_dims_bundle(bundle, rc) result(dims) type(UngriddedDims) :: dims type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc @@ -145,15 +183,27 @@ function get_ungridded_dim_bundle(bundle, rc) result(dims) type(UngriddedDimVector) :: vec info = get_bundle_info(bundle, _RC) + vec = get_ungridded_dims_bundle_info(info, _RC) + dims = UngriddedDims(vec) + call destroy_bundle_info(info, _RC) + _RETURN(_SUCCESS) + + end function get_ungridded_dims_bundle + + function get_ungridded_dims_bundle_info(info, rc) result(vec) + type(UngriddedDimVector) :: vec + type(ESMF_Info), intent(in) :: info(:) + integer, optional, intent(out) :: rc + integer :: status + integer :: i + vec = UngriddedDimVector() do i=1, size(info) - call push_ungridded_dim_info(vec, info(i), _RC) + call push_ungridded_dim(vec, info(i), _RC) end do - dims = UngriddedDims(vec) - call destroy_bundle_info(info, _RC) _RETURN(_SUCCESS) - end function get_ungridded_dim_bundle + end function get_ungridded_dims_bundle_info function get_ungridded_dims_field(field, rc) result(ungridded) type(UngriddedDims) :: ungridded @@ -164,14 +214,14 @@ function get_ungridded_dims_field(field, rc) result(ungridded) type(UngriddedDimVector) :: vec call ESMF_InfoGetFromHost(field, info, _RC) - call push_ungridded_info(vec, info, _RC) + call push_ungridded_dim(vec, info, _RC) ungridded = UngriddedDims(vec) call ESMF_InfoDestroy(info, _RC) _RETURN(_SUCCESS) end function get_ungridded_dims_field - subroutine push_ungridded_dim_info(vec, info, rc) + subroutine push_ungridded_dim(vec, info, rc) type(UngriddedDimVector), intent(inout) :: vec type(ESMF_Info), intent(in) :: info integer, optional, intent(out) :: rc @@ -188,40 +238,42 @@ subroutine push_ungridded_dim_info(vec, info, rc) num_dims = 0 has_dims = ESMF_InfoIsPresent(info, key=KEY_NUM_UNGRID_DIMS, _RC) if(has_dims) then - num_dims = ESMF_InfoGet(info, key=KEY_NUM_UNGRID_DIMS, _RC) + call ESMF_InfoGet(info, key=KEY_NUM_UNGRID_DIMS, value=num_dims, _RC) end if do i=1, num_dims dim_key = make_dim_key(i, _RC) call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNGRIDDED_NAME, value=name, _RC) call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNGRIDDED_UNITS, value=units, _RC) call ESMF_InfoGet(info, key=dim_key // KEY_UNGRIDDED_COORD, size=num_coord, _RC) - allocate(coordinates(num_coord)) + SAFE_ALLOC1(coordinates, num_coord) call ESMF_InfoGet(info, key=dim_key // KEY_UNGRIDDED_COORD, values=coordinates, _RC) next = UngriddedDim(name, units, coordinates) vi = get_index_by_name(vec, name) if(vi > 0) then - _ASSERT(UngriddedDim(name, units, coordinates) == vec%at(vi), 'UngriddedDim mismatch.') + _ASSERT(next == vec%at(vi), 'UngriddedDim mismatch.') + cycle end if - call vec%push_back(UngriddedDim(name, units, coordinates)) + call vec%push_back(next) end do _RETURN(_SUCCESS) - end subroutine push_ungridded_dim_info + end subroutine push_ungridded_dim - integer function get_index_by_name(vec, name) result(n) - integer :: n + integer function get_index_by_name(vec, name) result(i) type(UngriddedDimVector), intent(in) :: vec character(len=*), intent(in) :: name + type(UngriddedDim) :: ud type(UngriddedDimVectorIterator) :: iter - n = 1 + i = 0 iter = vec%begin() - do while(iter <= vec%end()) - if(iter%of()%get_name() == name) return - n = n + 1 + do while(iter < vec%end()) + i = i + 1 + ud = iter%of() + if(ud%get_name() == name) return call iter%next() end do - if(n > vec%size()) n = 0 + i = 0 end function get_index_by_name @@ -230,15 +282,16 @@ function get_bundle_info(bundle, rc) result(bundle_info) type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc integer :: status - integer :: field_count + integer :: field_count, i + type(ESMF_Field) :: field type(ESMF_Field), allocatable :: fields(:) type(ESMF_Info) :: info call ESMF_FieldBundleGet(bundle, fieldCount=field_count, _RC) _ASSERT(field_count > 0, 'Empty bundle') - allocate(fields(field_count)) + SAFE_ALLOC1(fields, field_count) call ESMF_FieldBundleGet(bundle, fieldList=fields, _RC) - allocate(bundle_info(field_count)) + SAFE_ALLOC1(bundle_info, field_count) do i=1, field_count call ESMF_InfoGetFromHost(field, info, _RC) bundle_info(i) = info @@ -259,4 +312,20 @@ subroutine destroy_bundle_info(bundle_info, rc) end subroutine destroy_bundle_info + integer function find_index(v, name) result(i) + class(StringVector), intent(in) :: v + character(len=*), intent(in) :: name + type(StringVectorIterator) :: iter + + i = 0 + iter = v%begin() + do while (iter /= v%end()) + i = i+1 + if(iter%of() == name) return + call iter%next() + end do + i = 0 + + end function find_index + end module mapl3g_output_info diff --git a/gridcomps/History3G/tests/CMakeLists.txt b/gridcomps/History3G/tests/CMakeLists.txt index 184496570229..431cdc92d582 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_UngriddedDimInfo.pf Test_OutputInfo.pf ) diff --git a/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf b/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf index d7806fc839b5..225ca92fa402 100644 --- a/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf +++ b/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf @@ -7,7 +7,7 @@ module Test_HistoryCollectionGridComp use mapl3g_HistoryCollectionGridComp_private use esmf use gFTL2_StringVector - use mapl3g_output_info_set + implicit none contains @@ -237,8 +237,4 @@ contains end subroutine test_create_output_alarm - !@Test -! subroutine test_get_output_info_bundle() -! end subroutine test_get_output_info_bundle - end module Test_HistoryCollectionGridComp diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_OutputInfo.pf index 81ccba2d0222..05aef96d10d1 100644 --- a/gridcomps/History3G/tests/Test_OutputInfo.pf +++ b/gridcomps/History3G/tests/Test_OutputInfo.pf @@ -1,53 +1,273 @@ #include "MAPL_TestErr.h" + +#if defined(SUCCESS) +# undef SUCCESS +#endif +#define SUCCESS 0 + +#if defined(FAILURE) +# undef FAILURE +#endif +#define FAILURE SUCCESS - 1 + +#if defined(SET_RC) +# undef SET_RC +#endif +#define SET_RC(A) if(present(rc)) rc = A + +#if defined(SET_RC_) +# undef SET_RC_ +#endif +#define SET_RC_ SET_RC(status) + +#if defined(_SET_RC_) +# undef _SET_RC_ +#endif +#define _SET_RC_ status=SUCCESS; SET_RC(status) + module Test_OutputInfo use mapl3g_output_info + use mapl3g_esmf_info_keys + use mapl3g_UngriddedDim + use mapl3g_UngriddedDimVector use pfunit use esmf + use gFTL2_StringVector implicit none -#include "history3g_test_utility_variables.h" + 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] -contains + type(ESMF_Info), allocatable :: bundle_info(:) -#include "history3g_test_utility_procedures.h" +contains - subroutine test_get_num_levels_info() - type(ESMF_Info) :: info + @Test + subroutine test_get_num_levels() integer :: status integer, parameter :: EXPECTED_NUM_LEVELS = 3 integer :: num_levels + integer :: i - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, num_levels=EXPECTED_NUM_LEVELS, _RC) - num_levels = get_num_levels_info(info, _RC) + call safe_dealloc(bundle_info) + allocate(bundle_info(2)) + do i=1, size(bundle_info) + bundle_info(i) = make_esmf_info(num_levels=EXPECTED_NUM_LEVELS, _RC) + end do + num_levels = get_num_levels_bundle_info(bundle_info, _RC) @assertEqual(EXPECTED_NUM_LEVELS, num_levels, 'num_levels does not match.') - call ESMF_InfoDestroy(info) + + call safe_dealloc(bundle_info) end subroutine test_get_num_levels - subroutine test_get_vertical_dim_spec_name_info() - type(ESMF_Info) :: info + @Test + subroutine test_get_vertical_dim_spec_names() + integer :: status + character(len=*), parameter :: EXPECTED_NAME_1 = 'VERTICAL_DIM_CENTER' + character(len=*), parameter :: EXPECTED_NAME_2 = 'VERTICAL_DIM_EDGE' + type(StringVector), allocatable :: names + integer :: sz + + call safe_dealloc(bundle_info) + allocate(bundle_info(3)) + bundle_info(1) = make_esmf_info(vloc=EXPECTED_NAME_1, _RC) + bundle_info(2) = make_esmf_info(vloc=EXPECTED_NAME_2, _RC) + bundle_info(3) = make_esmf_info(vloc=EXPECTED_NAME_1, _RC) + names = get_vertical_dim_spec_names_bundle_info(bundle_info, _RC) + sz = names%size() + @assertEqual(2, sz, 'There should only be two unique vertical_dim_spec names.') + @assertEqual(EXPECTED_NAME_1, names%at(1), 'vertical_dim_spec_name 1 does not match.') + @assertEqual(EXPECTED_NAME_2, names%at(2), 'vertical_dim_spec_name 2 does not match.') + call safe_dealloc(bundle_info) + + end subroutine test_get_vertical_dim_spec_names + + @Test + subroutine test_get_ungridded_dims() integer :: status - character(len=*), parameter :: EXPECTED_NAME = 'VERTICAL_DIM_CENTER' + integer :: i + integer, parameter :: N = 2 + integer, parameter :: D = 3 + character(len=*), parameter :: EXPECTED_NAMES(N) = ['color', 'phase'] + character(len=*), parameter :: EXPECTED_UNITS(N) = ['K ', 'rad'] + real, parameter :: REAL_ARRAY(D) = [1.0, 2.0, 3.0] + real :: EXPECTED_COORDINATES(N, D) character(len=:), allocatable :: name + character(len=:), allocatable :: units + real, allocatable :: coordinates(:) + type(UngriddedDimVector) :: vec + type(UngriddedDim) :: undim - info = ESMF_InfoCreate(_RC) - call make_esmf_info(info, vloc=EXPECTED_NAME, _RC) - name = get_vertical_dim_spec_name_info(info, _RC) - @assertEqual(EXPECTED_NAME, name, 'vertical_dim_spec_name does not match.') - call ESMF_InfoDestroy(info) + call safe_dealloc(bundle_info) - end subroutine test_get_vertical_dim_spec_name_info + do i=1, N + EXPECTED_COORDINATES(i,:) = REAL_ARRAY + end do - subroutine test_get_ungridded_dims_info_info() + allocate(bundle_info(N)) + do i=1, N + bundle_info(i) = make_esmf_info(names=EXPECTED_NAMES, units_array=EXPECTED_UNITS, coordinates=EXPECTED_COORDINATES, _RC) + end do + vec = get_ungridded_dims_bundle_info(bundle_info, _RC) + do i=1, N + undim = vec%at(i) + name = undim%get_name() + @assertEqual(EXPECTED_NAMES(i), name, 'ungridded dimension name does not match.') + units = undim%get_units() + @assertEqual(EXPECTED_UNITS(i), units, 'ungridded dimension units does not match.') + coordinates = undim%get_coordinates() + @assertEqual(EXPECTED_COORDINATES(i, :), coordinates, 0.01, 'ungridded dimensions coordinates does not match.') + end do + call safe_dealloc(bundle_info) + + end subroutine test_get_ungridded_dims + + function make_esmf_info(num_levels, vloc, num_ungridded, names, units_array, coordinates, rc) & + result(info) type(ESMF_Info) :: info + integer, optional, intent(in) :: num_levels + character(len=*), optional, intent(in) :: vloc + integer, optional, intent(in) :: num_ungridded + character(len=*), optional, intent(in) :: names(:) + character(len=*), optional, intent(in) :: units_array(:) + real, optional, intent(in) :: coordinates(:, :) + integer, optional, intent(out) :: rc integer :: status - type(UngriddedDimsInfo), parameter :: + integer :: num_levels_, num_ungridded_ + character(len=:), allocatable :: vloc_ + num_ungridded_ = -1 + num_levels_ = NUM_LEVELS_DEFAULT + if(present(num_levels)) num_levels_ = num_levels + vloc_ = VLOC_DEFAULT + if(present(vloc)) vloc_ = vloc info = ESMF_InfoCreate(_RC) - call ESMF_InfoDestroy(info) + call make_vertical_dim(info, vloc_, _RC) + call make_vertical_geom(info, num_levels_, _RC) + SET_RC(FAILURE) + if(present(names) .and. present(units_array)) then + if(size(names) /= size(units_array)) return + num_ungridded_ = size(names) + end if + if(present(num_ungridded)) then + if((num_ungridded_ >= 0) .and. (num_ungridded /= num_ungridded)) return + num_ungridded_ = num_ungridded + end if + call make_ungridded_dims_info(info, num_ungridded_, names, units_array, coordinates, _RC) + _SET_RC_ + + end function make_esmf_info + + subroutine make_vertical_dim(info, vloc, rc) + type(ESMF_Info), intent(inout) :: info + character(len=*), intent(in) :: vloc + integer, optional, intent(out) :: rc + integer :: status + + call ESMF_InfoSet(info, KEY_VLOC, vloc, _RC) + _SET_RC_ + + end subroutine make_vertical_dim + + subroutine make_vertical_geom(info, num_levels, rc) + type(ESMF_Info), intent(inout) :: info + integer, intent(in) :: num_levels + integer, optional, intent(out) :: rc + integer :: status + + call ESMF_InfoSet(info, KEY_NUM_LEVELS, num_levels, _RC) + _SET_RC_ + + end subroutine make_vertical_geom + + subroutine make_ungridded_dims_info(info, num_ungridded, names, units_array, coordinates, rc) + type(ESMF_Info), intent(inout) :: info + integer, intent(in) :: num_ungridded + character(len=*), optional, intent(in) :: names(:) + character(len=*), optional, intent(in) :: units_array(:) + real, optional, intent(in) :: coordinates(:, :) + integer, optional, intent(out) :: rc + integer :: status, i + character(len=:), allocatable :: names_(:), units_(:) + real, allocatable :: coordinates_(:, :) + character(len=:), allocatable :: dim_key + character(len=:), allocatable :: name, units + real, allocatable :: coord(:) + + status = -1 + + SET_RC(status) + + allocate(character(len=len(NAME_DEFAULT)) :: names_(num_ungridded)) + names_ = NAME_DEFAULT + if(present(names)) then + if(size(names) /= num_ungridded) return + names_ = names + end if + + allocate(character(len=len(UNITS_DEFAULT)) :: units_(num_ungridded)) + units_ = UNITS_DEFAULT + if(present(units_array)) then + if(size(units_array) /= num_ungridded) return + units_ = units_array + end if + + allocate(coordinates_(num_ungridded, size(COORDINATES_DEFAULT))) + do i=1, num_ungridded + coordinates_(i, :) = COORDINATES_DEFAULT + end do + + SET_RC(FAILURE) + if(present(coordinates)) then + if(size(coordinates, 1) /= num_ungridded) return + if(allocated(coordinates_)) deallocate(coordinates_) + coordinates_ = coordinates + end if + + call ESMF_InfoSet(info, KEY_NUM_UNGRID_DIMS, num_ungridded, _RC) + + do i=1, num_ungridded + dim_key = make_dim_key(i, _RC) + name = names_(i) + units = units_(i) + coord = coordinates_(i, :) + call ESMF_InfoSet(info, dim_key // KEY_UNGRIDDED_NAME, name, _RC) + call ESMF_InfoSet(info, dim_key // KEY_UNGRIDDED_UNITS, units, _RC) + call ESMF_InfoSet(info, dim_key // KEY_UNGRIDDED_COORD, coord, _RC) + end do + + _SET_RC_ + end subroutine make_ungridded_dims_info + + subroutine destroy_all(info) + type(ESMF_Info), allocatable, intent(inout) :: info(:) + integer :: i + + do i = 1, size(info) + call ESMF_InfoDestroy(info(i)) + end do + + end subroutine destroy_all + + subroutine deallocate_destroy(info) + type(ESMF_Info), allocatable, intent(inout) :: info(:) + integer :: i + + call destroy_all(info) + deallocate(info) + + end subroutine deallocate_destroy - end subroutine test_get_ungridded_dims_info_info + subroutine safe_dealloc(info) + type(ESMF_Info), allocatable, intent(inout) :: info(:) + if(allocated(info)) call deallocate_destroy(info) + end subroutine safe_dealloc end module Test_OutputInfo diff --git a/gridcomps/History3G/tests/history3g_test_utility_procedures.h b/gridcomps/History3G/tests/history3g_test_utility_procedures.h index 518282e9eff1..c48376d548c0 100644 --- a/gridcomps/History3G/tests/history3g_test_utility_procedures.h +++ b/gridcomps/History3G/tests/history3g_test_utility_procedures.h @@ -1,125 +1,3 @@ -#define SET_RC if(present(rc)) rc = status - subroutine make_esmf_info(info, num_levels, vloc, num_ungridded, names, units_array, rc) - type(ESMF_Info), intent(inout) :: info - integer, optional, intent(in) :: num_levels - character(len=*), optional, intent(in) :: vloc - integer, optional, intent(in) :: num_ungridded - character(len=*), optional, intent(in) :: names(:) - character(len=*), optional, intent(in) :: units_array(:) - integer, optional, intent(out) :: rc - integer :: status - character(len=*), parameter :: NUMLEV_LABEL = 'num_levels' - character(len=*), parameter :: VLOC_LABEL = 'vloc' - character(len=*), parameter :: NUM_UNGRID_LABEL = 'num_ungridded' - type(ESMF_Info) :: inner_info - integer :: num_levels_ - character(len=:), allocatable :: vloc_ - - num_levels_ = NUM_LEVELS_DEFAULT - if(present(num_levels)) num_levels_ = num_levels - vloc_ = VLOC_DEFAULT - if(present(vloc)) vloc_ = vloc - num_ungridded_ = NUM_UNGRIDDED_DEFAULT - if(present(num_ungridded)) num_ungridded_ = num_ungridded - - inner_info = ESMF_InfoCreate(_RC) - call make_vertical_dim(inner_info, VLOC_LABEL, vloc_, _RC) - call ESMF_InfoSet(info, PREFIX // 'vertical_dim', value=inner_info, _RC) - call ESMF_InfoDestroy(inner_info, _RC) - - inner_info = ESMF_InfoCreate(_RC) - call make_vertical_geom(inner_info, NUMLEV_LABEL, num_levels_, _RC) - call ESMF_InfoSet(info, PREFIX // 'vertical_geom', value=inner_info, _RC) - call ESMF_InfoDestroy(inner_info, _RC) - - inner_info = ESMF_InfoCreate(_RC) - call make_ungridded_dims_info(inner_info, num_ungridded_, names, units_array, _RC) - call ESMF_InfoSet(info, PREFIX // 'ungridded_dims', value=inner_info, _RC) - call ESMF_InfoDestroy(inner_info, _RC) - - SET_RC - - end subroutine make_esmf_info - - subroutine make_vertical_dim(info, label, value, rc) - type(ESMF_Info), intent(inout) :: info - character(len=*), intent(in) :: label - character(len=*), intent(in) :: value - integer, optional, intent(out) :: rc - integer :: status - - call ESMF_InfoSet(info, label, value, _RC) - - end subroutine make_vertical_dim - - subroutine make_vertical_geom(info, label, value, rc) - type(ESMF_Info), intent(inout) :: info - character(len=*), intent(in) :: label - integer, intent(in) :: value - integer, optional, intent(out) :: rc - integer :: status - - call ESMF_InfoSet(info, label, value, _RC) - - end subroutine make_vertical_geom - - subroutine make_ungridded_dims_info(info, num_ungridded, names, units_array, rc) - type(ESMF_Info), intent(inout) :: info - integer, intent(in) :: num_ungridded - character(len=*), optional, intent(in) :: names(:) - character(len=*), optional, intent(in) :: units_array(:) - integer, optional, intent(out) :: rc - integer :: status, i - character(len=*), parameter :: NAME_LABEL = 'name' - character(len=*), parameter :: UNITS_LABEL = 'units' - character(len=*), parameter :: COORDINATES_LABEL = 'coordinates' - real, parameter :: COORDINATES(3) = [2.0, 2.4, 2.5] - type(ESMF_Info) :: comp_info - character(len=:), allocatable :: name_, units_ - - status = -1 - - SET_RC - - if(present(names)) then - if(size(names) /= num_ungridded) return - end if - - if(present(units_array)) then - if(size(units_array) /= num_ungridded) return - end if - - do i=1, num_ungridded - name_ = NAME_DEFAULT - if(present(names)) name_ = names(i) - units_ = UNITS_DEFAULT - if(present(units_array)) units_ = units_array(i) - comp_info = ESMF_InfoCreate(_RC) - call ESMF_InfoSet(comp_info, NAME_LABEL, name_, _RC) - call ESMF_InfoSet(comp_info, UNITS_LABEL, units_, _RC) - call ESMF_InfoSet(comp_info, COORDINATES_LABEL, COORDINATES, _RC) - call ESMF_InfoSet(info, make_component_label(i), comp_info, _RC) - call ESMF_InfoDestroy(comp_info) - end do - - SET_RC - - end subroutine make_ungridded_dims_info - function make_component_label(n, rc) result(name) - character(len=:), allocatable :: name - integer, intent(in) :: n - integer, optional, intent(out) :: rc - integer :: status - character(len=*), parameter :: COMP_PREFIX = 'dim_' - character(len=32) :: strn - - write(strn, fmt='(I0)', iostat=status) n - if(status == 0) name = COMP_PREFIX // trim(adjustl(strn)) - - SET_RC - - end function make_component_label - ! vim:ft=fortran diff --git a/gridcomps/History3G/tests/history3g_test_utility_variables.h b/gridcomps/History3G/tests/history3g_test_utility_variables.h index 15bdd44aa261..139597f9cb07 100644 --- a/gridcomps/History3G/tests/history3g_test_utility_variables.h +++ b/gridcomps/History3G/tests/history3g_test_utility_variables.h @@ -1,8 +1,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] From ad8c501d099cc8472ed2b7031dd7455d3c712fb0 Mon Sep 17 00:00:00 2001 From: Darian Boggs <61847056+darianboggs@users.noreply.github.com> Date: Wed, 22 May 2024 13:15:38 -0400 Subject: [PATCH 11/23] Update CHANGELOG.md Done Co-authored-by: Tom Clune --- CHANGELOG.md | 2 -- 1 file changed, 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f29972272f3a..25f2c4c12bbc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -35,8 +35,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added GitHub Action to generate MAPL3 Ford Docs - Added capability for HistoryCollectionGridComp to extract field names from expressions - Added ability for HistoryCollectionGridComp to extract multiple field names from expressions -- Added procedures to get information about an ESMF_FieldBundle in History3G -- Added module for keys to ESMF_Info metadata used in MAPL3G ### Changed From 9627ac84a112af17f895ef6ae7bc37590245ec34 Mon Sep 17 00:00:00 2001 From: Darian Boggs <61847056+darianboggs@users.noreply.github.com> Date: Wed, 22 May 2024 13:36:55 -0400 Subject: [PATCH 12/23] Update base/MAPL_ESMF_InfoKeys.F90 done Co-authored-by: Tom Clune --- base/MAPL_ESMF_InfoKeys.F90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/base/MAPL_ESMF_InfoKeys.F90 b/base/MAPL_ESMF_InfoKeys.F90 index d17007400c45..df9f1f4d5c8c 100644 --- a/base/MAPL_ESMF_InfoKeys.F90 +++ b/base/MAPL_ESMF_InfoKeys.F90 @@ -42,11 +42,8 @@ function make_dim_key(n, rc) result(key) character(len=*), parameter :: FMT_ = '(I0)' character(len=20) :: raw - if(n < 0) then - key = EMPTY_STRING - if(present(rc)) rc = FAILURE - return - end if + key = EMPTY_STRING + _ASSERT(n >=0, "n must be positive") write(raw, fmt=FMT_, iostat=status) n key = KEYSTUB_DIM // trim(adjustl(raw)) // '/' From 01e6c34b08e0e04d6f37a99726e51f06431ab8cf Mon Sep 17 00:00:00 2001 From: Darian Boggs <61847056+darianboggs@users.noreply.github.com> Date: Wed, 22 May 2024 14:36:40 -0400 Subject: [PATCH 13/23] Update gridcomps/History3G/OutputInfo.F90 done Co-authored-by: Tom Clune --- gridcomps/History3G/OutputInfo.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index 6a4524993c36..969fa33d3c49 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -58,7 +58,6 @@ integer function get_num_levels_bundle(bundle, rc) result(num) type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc integer :: status - integer :: i, n type(ESMF_Info), allocatable :: info(:) info = get_bundle_info(bundle, _RC) From 75a0804601a00203f85d78a201357a93314603f0 Mon Sep 17 00:00:00 2001 From: Darian Boggs <61847056+darianboggs@users.noreply.github.com> Date: Wed, 22 May 2024 14:37:26 -0400 Subject: [PATCH 14/23] Update gridcomps/History3G/OutputInfo.F90 done Co-authored-by: Tom Clune --- gridcomps/History3G/OutputInfo.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index 969fa33d3c49..4ed0133c9896 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -177,7 +177,6 @@ function get_ungridded_dims_bundle(bundle, rc) result(dims) type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc integer :: status - integer :: i type(ESMF_Info), allocatable :: info(:) type(UngriddedDimVector) :: vec From d69a50d6c8edaf56d99213131a36d98fcb10003d Mon Sep 17 00:00:00 2001 From: Darian Boggs <61847056+darianboggs@users.noreply.github.com> Date: Wed, 22 May 2024 14:37:47 -0400 Subject: [PATCH 15/23] Update base/MAPL_ESMF_InfoKeys.F90 done Co-authored-by: Tom Clune --- base/MAPL_ESMF_InfoKeys.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/MAPL_ESMF_InfoKeys.F90 b/base/MAPL_ESMF_InfoKeys.F90 index df9f1f4d5c8c..ba3e6164166b 100644 --- a/base/MAPL_ESMF_InfoKeys.F90 +++ b/base/MAPL_ESMF_InfoKeys.F90 @@ -45,7 +45,7 @@ function make_dim_key(n, rc) result(key) key = EMPTY_STRING _ASSERT(n >=0, "n must be positive") - write(raw, fmt=FMT_, iostat=status) n + write(raw, fmt='(I0)', iostat=status) n key = KEYSTUB_DIM // trim(adjustl(raw)) // '/' if(present(rc)) rc = status From 375a4acf139f46073139126212d21235bc71fc01 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 23 May 2024 00:48:15 -0400 Subject: [PATCH 16/23] Refactoring per reviews --- base/MAPL_ESMF_InfoKeys.F90 | 14 ++--- gridcomps/History3G/OutputInfo.F90 | 90 +++++++++++++++++------------- 2 files changed, 55 insertions(+), 49 deletions(-) diff --git a/base/MAPL_ESMF_InfoKeys.F90 b/base/MAPL_ESMF_InfoKeys.F90 index ba3e6164166b..a17c01f08e35 100644 --- a/base/MAPL_ESMF_InfoKeys.F90 +++ b/base/MAPL_ESMF_InfoKeys.F90 @@ -1,5 +1,8 @@ +#include "include/MAPL_Exceptions.h" module mapl3g_esmf_info_keys + use MAPL_ErrorHandling + implicit none ! FieldSpec info keys @@ -26,12 +29,6 @@ module mapl3g_esmf_info_keys character(len=*), parameter :: KEY_UNGRIDDED_UNITS = 'units' character(len=*), parameter :: KEY_UNGRIDDED_COORD = 'coordinates' - private :: SUCCESS, FAILURE, EMPTY_STRING - - integer, parameter :: SUCCESS = 0 - integer, parameter :: FAILURE = SUCCESS - 1 - character(len=*), parameter :: EMPTY_STRING = '' - contains function make_dim_key(n, rc) result(key) @@ -39,15 +36,14 @@ function make_dim_key(n, rc) result(key) integer, intent(in) :: n integer, optional, intent(out) :: rc integer :: status - character(len=*), parameter :: FMT_ = '(I0)' + character(len=*), parameter :: EMPTY_STRING = '' character(len=20) :: raw key = EMPTY_STRING _ASSERT(n >=0, "n must be positive") - write(raw, fmt='(I0)', iostat=status) n key = KEYSTUB_DIM // trim(adjustl(raw)) // '/' - if(present(rc)) rc = status + _RETURN(status) end function make_dim_key diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index 4ed0133c9896..f7853312b20e 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -1,15 +1,4 @@ #include "MAPL_Generic.h" - -#if defined(SAFE_DEALLOC) -# undef SAFE_DEALLOC -#endif -#define SAFE_DEALLOC(A) if(allocated(A)) deallocate(A) - -#if defined(SAFE_ALLOC1) -# undef SAFE_ALLOC1 -#endif -#define SAFE_ALLOC1(A, S) SAFE_DEALLOC(A); allocate(A(S)) - module mapl3g_output_info use mapl3g_UngriddedDim @@ -20,6 +9,7 @@ module mapl3g_output_info use esmf, only: ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet use esmf, only: ESMF_Info, ESMF_InfoDestroy, ESMF_InfoIsPresent use esmf, only: ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoGetFromHost + use esmf, only: ESMF_InfoGetAlloc use Mapl_ErrorHandling implicit none @@ -60,7 +50,7 @@ integer function get_num_levels_bundle(bundle, rc) result(num) integer :: status type(ESMF_Info), allocatable :: info(:) - info = get_bundle_info(bundle, _RC) + info = create_bundle_info(bundle, _RC) num = get_num_levels_bundle_info(info, _RC) call destroy_bundle_info(info, _RC) _RETURN(_SUCCESS) @@ -119,7 +109,7 @@ function get_vertical_dim_spec_names_bundle(bundle, rc) result(names) character(len=:), allocatable :: name type(ESMF_Info), allocatable :: info(:) - info = get_bundle_info(bundle, _RC) + info = create_bundle_info(bundle, _RC) names = get_vertical_dim_spec_names_bundle_info(info, _RC) call destroy_bundle_info(info, _RC) _RETURN(_SUCCESS) @@ -180,7 +170,7 @@ function get_ungridded_dims_bundle(bundle, rc) result(dims) type(ESMF_Info), allocatable :: info(:) type(UngriddedDimVector) :: vec - info = get_bundle_info(bundle, _RC) + info = create_bundle_info(bundle, _RC) vec = get_ungridded_dims_bundle_info(info, _RC) dims = UngriddedDims(vec) call destroy_bundle_info(info, _RC) @@ -242,40 +232,60 @@ subroutine push_ungridded_dim(vec, info, rc) dim_key = make_dim_key(i, _RC) call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNGRIDDED_NAME, value=name, _RC) call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNGRIDDED_UNITS, value=units, _RC) - call ESMF_InfoGet(info, key=dim_key // KEY_UNGRIDDED_COORD, size=num_coord, _RC) - SAFE_ALLOC1(coordinates, num_coord) - call ESMF_InfoGet(info, key=dim_key // KEY_UNGRIDDED_COORD, values=coordinates, _RC) - next = UngriddedDim(name, units, coordinates) - vi = get_index_by_name(vec, name) - if(vi > 0) then - _ASSERT(next == vec%at(vi), 'UngriddedDim mismatch.') - cycle - end if - call vec%push_back(next) + call ESMF_InfoGetAlloc(info, key=dim_key // KEY_UNGRIDDED_COORD, values=coordinates, _RC) + call push_next(name, units, coordinates, vec, _RC) end do _RETURN(_SUCCESS) end subroutine push_ungridded_dim - integer function get_index_by_name(vec, name) result(i) - type(UngriddedDimVector), intent(in) :: vec + subroutine push_next(name, units, coordinates, vec, tol, rc) result(next) + type(UngriddedDim) :: next character(len=*), intent(in) :: name - type(UngriddedDim) :: ud + character(len=*), intent(in) :: units + real, intent(in) :: coordinates(:) + type(UngriddedDimVector), intent(inout) :: vec + real, optional, intent(in) :: tol + integer, optional, intent(out) :: rc + integer :: status type(UngriddedDimVectorIterator) :: iter - - i = 0 - iter = vec%begin() - do while(iter < vec%end()) - i = i + 1 - ud = iter%of() - if(ud%get_name() == name) return + real :: tol_ = 1.0E-8 + logical :: below + + if(present(tol)) tol_ = tol + _ASSERT(tol_ >= 0, 'A negative relative tolerance is not valid.') + iter = vec%ftn_begin() + do while(iter < vec%ftn_end()) call iter%next() + ud = iter%of() + if(ud%get_name() /= name) cycle + _ASSERT(ud%get_units() == units, 'units does not match.') + _ASSERT(size(ud%get_coordinates()) == size(coordinates), 'coordinates has a different size.') + below = check_difference(ud%get_coordinates(), coordinates, tol_, _RC) + _ASSERT(below, 'coordinates differ by more than the relative tolerance.') end do - i = 0 + call vec%push_back(UngriddedDim(name, units, coordinates)) + _RETURN(_SUCCESS) + + end subroutine push_next + + logical function check_difference(a, b, tol, rc) result(below) + real, intent(in) :: a(:) + real, intent(in) :: b(:) + real, intent(in) :: tol + integer, optional, intent(out) :: rc + integer :: status + real :: distance, mean + + _ASSERT(size(a) == size(b), 'arrays have different length.') + _ASSERT(tol >= 0, 'tol must not be negative.') + mean = 0.5 * (norm2(a) + norm2(b)) + distance = norm2(a - b) + below = (distance <= tol * mean) - end function get_index_by_name + end function check_difference - function get_bundle_info(bundle, rc) result(bundle_info) + function create_bundle_info(bundle, rc) result(bundle_info) type(ESMF_Info), allocatable :: bundle_info(:) type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc @@ -287,16 +297,16 @@ function get_bundle_info(bundle, rc) result(bundle_info) call ESMF_FieldBundleGet(bundle, fieldCount=field_count, _RC) _ASSERT(field_count > 0, 'Empty bundle') - SAFE_ALLOC1(fields, field_count) + allocate(fields(field_count)) call ESMF_FieldBundleGet(bundle, fieldList=fields, _RC) - SAFE_ALLOC1(bundle_info, field_count) + allocate(bundle_info(field_count)) do i=1, field_count call ESMF_InfoGetFromHost(field, info, _RC) bundle_info(i) = info end do _RETURN(_SUCCESS) - end function get_bundle_info + end function create_bundle_info subroutine destroy_bundle_info(bundle_info, rc) type(ESMF_Info), intent(inout) :: bundle_info(:) From ae7fe6ec12e336c6c99b757b8db2febd94920325 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 23 May 2024 10:01:53 -0400 Subject: [PATCH 17/23] Correct include statement --- base/MAPL_ESMF_InfoKeys.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/MAPL_ESMF_InfoKeys.F90 b/base/MAPL_ESMF_InfoKeys.F90 index a17c01f08e35..c385c9aff8e7 100644 --- a/base/MAPL_ESMF_InfoKeys.F90 +++ b/base/MAPL_ESMF_InfoKeys.F90 @@ -1,4 +1,4 @@ -#include "include/MAPL_Exceptions.h" +#include "MAPL_Exceptions.h" module mapl3g_esmf_info_keys use MAPL_ErrorHandling From e4a0aa80151c84cf313d92b931897b9a857db431 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 23 May 2024 14:00:14 -0400 Subject: [PATCH 18/23] Fix for failing tests for intel & gcc --- gridcomps/History3G/OutputInfo.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index f7853312b20e..d020176e0dba 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -239,8 +239,7 @@ subroutine push_ungridded_dim(vec, info, rc) end subroutine push_ungridded_dim - subroutine push_next(name, units, coordinates, vec, tol, rc) result(next) - type(UngriddedDim) :: next + subroutine push_next(name, units, coordinates, vec, tol, rc) character(len=*), intent(in) :: name character(len=*), intent(in) :: units real, intent(in) :: coordinates(:) @@ -251,6 +250,7 @@ subroutine push_next(name, units, coordinates, vec, tol, rc) result(next) type(UngriddedDimVectorIterator) :: iter real :: tol_ = 1.0E-8 logical :: below + type(UngriddedDim) :: ud if(present(tol)) tol_ = tol _ASSERT(tol_ >= 0, 'A negative relative tolerance is not valid.') @@ -262,7 +262,7 @@ subroutine push_next(name, units, coordinates, vec, tol, rc) result(next) _ASSERT(ud%get_units() == units, 'units does not match.') _ASSERT(size(ud%get_coordinates()) == size(coordinates), 'coordinates has a different size.') below = check_difference(ud%get_coordinates(), coordinates, tol_, _RC) - _ASSERT(below, 'coordinates differ by more than the relative tolerance.') + _ASSERT(below, 'coordinates differs by more than the relative tolerance.') end do call vec%push_back(UngriddedDim(name, units, coordinates)) _RETURN(_SUCCESS) @@ -282,6 +282,7 @@ logical function check_difference(a, b, tol, rc) result(below) mean = 0.5 * (norm2(a) + norm2(b)) distance = norm2(a - b) below = (distance <= tol * mean) + _RETURN(_SUCCESS) end function check_difference From 23329dff12596fe5636c995658400974ef04652d Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 23 May 2024 16:31:24 -0400 Subject: [PATCH 19/23] Remove history3g_test_utility_*.h & macros --- gridcomps/History3G/tests/Test_OutputInfo.pf | 53 ++++++------------- .../tests/history3g_test_utility_procedures.h | 3 -- .../tests/history3g_test_utility_variables.h | 2 - 3 files changed, 16 insertions(+), 42 deletions(-) delete mode 100644 gridcomps/History3G/tests/history3g_test_utility_procedures.h delete mode 100644 gridcomps/History3G/tests/history3g_test_utility_variables.h diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_OutputInfo.pf index 05aef96d10d1..750993455091 100644 --- a/gridcomps/History3G/tests/Test_OutputInfo.pf +++ b/gridcomps/History3G/tests/Test_OutputInfo.pf @@ -1,30 +1,8 @@ -#include "MAPL_TestErr.h" - -#if defined(SUCCESS) -# undef SUCCESS -#endif -#define SUCCESS 0 - -#if defined(FAILURE) -# undef FAILURE -#endif -#define FAILURE SUCCESS - 1 - -#if defined(SET_RC) +#if defined SET_RC # undef SET_RC #endif #define SET_RC(A) if(present(rc)) rc = A - -#if defined(SET_RC_) -# undef SET_RC_ -#endif -#define SET_RC_ SET_RC(status) - -#if defined(_SET_RC_) -# undef _SET_RC_ -#endif -#define _SET_RC_ status=SUCCESS; SET_RC(status) - +#include "MAPL_TestErr.h" module Test_OutputInfo use mapl3g_output_info use mapl3g_esmf_info_keys @@ -54,7 +32,7 @@ contains integer, parameter :: EXPECTED_NUM_LEVELS = 3 integer :: num_levels integer :: i - + call safe_dealloc(bundle_info) allocate(bundle_info(2)) do i=1, size(bundle_info) @@ -151,17 +129,19 @@ contains info = ESMF_InfoCreate(_RC) call make_vertical_dim(info, vloc_, _RC) call make_vertical_geom(info, num_levels_, _RC) - SET_RC(FAILURE) + + SET_RC(status) + if(present(names) .and. present(units_array)) then if(size(names) /= size(units_array)) return num_ungridded_ = size(names) - end if + end if if(present(num_ungridded)) then if((num_ungridded_ >= 0) .and. (num_ungridded /= num_ungridded)) return num_ungridded_ = num_ungridded end if call make_ungridded_dims_info(info, num_ungridded_, names, units_array, coordinates, _RC) - _SET_RC_ + SET_RC(status) end function make_esmf_info @@ -172,7 +152,7 @@ contains integer :: status call ESMF_InfoSet(info, KEY_VLOC, vloc, _RC) - _SET_RC_ + SET_RC(status) end subroutine make_vertical_dim @@ -183,7 +163,7 @@ contains integer :: status call ESMF_InfoSet(info, KEY_NUM_LEVELS, num_levels, _RC) - _SET_RC_ + SET_RC(status) end subroutine make_vertical_geom @@ -201,15 +181,13 @@ contains character(len=:), allocatable :: name, units real, allocatable :: coord(:) - status = -1 - - SET_RC(status) + if(present(rc)) rc = -1 allocate(character(len=len(NAME_DEFAULT)) :: names_(num_ungridded)) names_ = NAME_DEFAULT if(present(names)) then if(size(names) /= num_ungridded) return - names_ = names + names_ = names end if allocate(character(len=len(UNITS_DEFAULT)) :: units_(num_ungridded)) @@ -224,7 +202,7 @@ contains coordinates_(i, :) = COORDINATES_DEFAULT end do - SET_RC(FAILURE) + if(present(rc)) rc = -1 if(present(coordinates)) then if(size(coordinates, 1) /= num_ungridded) return if(allocated(coordinates_)) deallocate(coordinates_) @@ -243,7 +221,8 @@ contains call ESMF_InfoSet(info, dim_key // KEY_UNGRIDDED_COORD, coord, _RC) end do - _SET_RC_ + SET_RC(status) + end subroutine make_ungridded_dims_info subroutine destroy_all(info) @@ -259,7 +238,7 @@ contains subroutine deallocate_destroy(info) type(ESMF_Info), allocatable, intent(inout) :: info(:) integer :: i - + call destroy_all(info) deallocate(info) diff --git a/gridcomps/History3G/tests/history3g_test_utility_procedures.h b/gridcomps/History3G/tests/history3g_test_utility_procedures.h deleted file mode 100644 index c48376d548c0..000000000000 --- a/gridcomps/History3G/tests/history3g_test_utility_procedures.h +++ /dev/null @@ -1,3 +0,0 @@ - - -! vim:ft=fortran diff --git a/gridcomps/History3G/tests/history3g_test_utility_variables.h b/gridcomps/History3G/tests/history3g_test_utility_variables.h deleted file mode 100644 index 139597f9cb07..000000000000 --- a/gridcomps/History3G/tests/history3g_test_utility_variables.h +++ /dev/null @@ -1,2 +0,0 @@ - - From cd0774671b35d1604e5c1a9ec30cc1ae8ec52d02 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 23 May 2024 17:13:08 -0400 Subject: [PATCH 20/23] Make relative tolerance optional argument --- gridcomps/History3G/OutputInfo.F90 | 39 ++++++++++++-------- gridcomps/History3G/tests/Test_OutputInfo.pf | 3 +- 2 files changed, 26 insertions(+), 16 deletions(-) diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index d020176e0dba..b81fe8625e7c 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -38,7 +38,7 @@ module mapl3g_output_info end interface get_vertical_dim_spec_name interface get_ungridded_dims - module procedure :: get_ungridded_dims_bundle + module procedure :: get_ungridded_dims_bundle module procedure :: get_ungridded_dims_field end interface get_ungridded_dims @@ -162,56 +162,67 @@ function get_vertical_dim_spec_info(info, rc) result(spec_name) end function get_vertical_dim_spec_info - function get_ungridded_dims_bundle(bundle, rc) result(dims) + function get_ungridded_dims_bundle(bundle, tol, rc) result(dims) type(UngriddedDims) :: dims type(ESMF_FieldBundle), intent(in) :: bundle + real, optional, intent(in) :: tol integer, optional, intent(out) :: rc integer :: status type(ESMF_Info), allocatable :: info(:) type(UngriddedDimVector) :: vec + real :: tol_ + tol_ = 1E-8 + if(present(tol)) tol_ = tol info = create_bundle_info(bundle, _RC) - vec = get_ungridded_dims_bundle_info(info, _RC) + vec = get_ungridded_dims_bundle_info(info, tol_, _RC) dims = UngriddedDims(vec) call destroy_bundle_info(info, _RC) _RETURN(_SUCCESS) end function get_ungridded_dims_bundle - function get_ungridded_dims_bundle_info(info, rc) result(vec) + function get_ungridded_dims_bundle_info(info, tol, rc) result(vec) type(UngriddedDimVector) :: vec type(ESMF_Info), intent(in) :: info(:) + real, intent(in) :: tol integer, optional, intent(out) :: rc integer :: status integer :: i vec = UngriddedDimVector() do i=1, size(info) - call push_ungridded_dim(vec, info(i), _RC) + call push_ungridded_dim(vec, info(i), tol, _RC) end do _RETURN(_SUCCESS) end function get_ungridded_dims_bundle_info - function get_ungridded_dims_field(field, rc) result(ungridded) + function get_ungridded_dims_field(field, tol, rc) result(ungridded) type(UngriddedDims) :: ungridded type(ESMF_Field), intent(inout) :: field + real, optional, intent(in) :: tol integer, optional, intent(out) :: rc integer :: status type(ESMF_Info) :: info type(UngriddedDimVector) :: vec + real :: tol_ + + tol_ = 1E-8 + if(present(tol)) tol_ = tol call ESMF_InfoGetFromHost(field, info, _RC) - call push_ungridded_dim(vec, info, _RC) + call push_ungridded_dim(vec, info, tol_, _RC) ungridded = UngriddedDims(vec) call ESMF_InfoDestroy(info, _RC) _RETURN(_SUCCESS) end function get_ungridded_dims_field - subroutine push_ungridded_dim(vec, info, rc) + subroutine push_ungridded_dim(vec, info, tol, rc) type(UngriddedDimVector), intent(inout) :: vec type(ESMF_Info), intent(in) :: info + real, intent(in) :: tol integer, optional, intent(out) :: rc integer :: status type(UngriddedDim) :: next @@ -233,27 +244,25 @@ subroutine push_ungridded_dim(vec, info, rc) call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNGRIDDED_NAME, value=name, _RC) call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNGRIDDED_UNITS, value=units, _RC) call ESMF_InfoGetAlloc(info, key=dim_key // KEY_UNGRIDDED_COORD, values=coordinates, _RC) - call push_next(name, units, coordinates, vec, _RC) + call push_next(name, units, coordinates, tol, vec, _RC) end do _RETURN(_SUCCESS) end subroutine push_ungridded_dim - subroutine push_next(name, units, coordinates, vec, tol, rc) + subroutine push_next(name, units, coordinates, tol, vec,rc) character(len=*), intent(in) :: name character(len=*), intent(in) :: units real, intent(in) :: coordinates(:) + real, intent(in) :: tol type(UngriddedDimVector), intent(inout) :: vec - real, optional, intent(in) :: tol integer, optional, intent(out) :: rc integer :: status type(UngriddedDimVectorIterator) :: iter - real :: tol_ = 1.0E-8 logical :: below type(UngriddedDim) :: ud - if(present(tol)) tol_ = tol - _ASSERT(tol_ >= 0, 'A negative relative tolerance is not valid.') + _ASSERT(tol >= 0, 'A negative relative tolerance is not valid.') iter = vec%ftn_begin() do while(iter < vec%ftn_end()) call iter%next() @@ -261,7 +270,7 @@ subroutine push_next(name, units, coordinates, vec, tol, rc) if(ud%get_name() /= name) cycle _ASSERT(ud%get_units() == units, 'units does not match.') _ASSERT(size(ud%get_coordinates()) == size(coordinates), 'coordinates has a different size.') - below = check_difference(ud%get_coordinates(), coordinates, tol_, _RC) + below = check_difference(ud%get_coordinates(), coordinates, tol, _RC) _ASSERT(below, 'coordinates differs by more than the relative tolerance.') end do call vec%push_back(UngriddedDim(name, units, coordinates)) diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_OutputInfo.pf index 750993455091..13b8fdf120e7 100644 --- a/gridcomps/History3G/tests/Test_OutputInfo.pf +++ b/gridcomps/History3G/tests/Test_OutputInfo.pf @@ -82,6 +82,7 @@ contains real, allocatable :: coordinates(:) type(UngriddedDimVector) :: vec type(UngriddedDim) :: undim + real :: tol = 1E-8 call safe_dealloc(bundle_info) @@ -93,7 +94,7 @@ contains do i=1, N bundle_info(i) = make_esmf_info(names=EXPECTED_NAMES, units_array=EXPECTED_UNITS, coordinates=EXPECTED_COORDINATES, _RC) end do - vec = get_ungridded_dims_bundle_info(bundle_info, _RC) + vec = get_ungridded_dims_bundle_info(bundle_info, tol, _RC) do i=1, N undim = vec%at(i) name = undim%get_name() From 27118becf3eff2dc25c8285dd4142419c93fab71 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Mon, 3 Jun 2024 13:28:18 -0400 Subject: [PATCH 21/23] Implement PR review suggestions --- gridcomps/History3G/OutputInfo.F90 | 166 +++++++++++++---------------- 1 file changed, 77 insertions(+), 89 deletions(-) diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index b81fe8625e7c..227372736121 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -162,138 +162,142 @@ function get_vertical_dim_spec_info(info, rc) result(spec_name) end function get_vertical_dim_spec_info - function get_ungridded_dims_bundle(bundle, tol, rc) result(dims) + function get_ungridded_dims_bundle(bundle, rc) result(dims) type(UngriddedDims) :: dims type(ESMF_FieldBundle), intent(in) :: bundle - real, optional, intent(in) :: tol integer, optional, intent(out) :: rc integer :: status type(ESMF_Info), allocatable :: info(:) type(UngriddedDimVector) :: vec - real :: tol_ - tol_ = 1E-8 - if(present(tol)) tol_ = tol info = create_bundle_info(bundle, _RC) - vec = get_ungridded_dims_bundle_info(info, tol_, _RC) + vec = get_ungridded_dims_bundle_info(info, _RC) dims = UngriddedDims(vec) call destroy_bundle_info(info, _RC) _RETURN(_SUCCESS) end function get_ungridded_dims_bundle - function get_ungridded_dims_bundle_info(info, tol, rc) result(vec) + function get_ungridded_dims_bundle_info(info, rc) result(vec) type(UngriddedDimVector) :: vec type(ESMF_Info), intent(in) :: info(:) - real, intent(in) :: tol integer, optional, intent(out) :: rc integer :: status integer :: i + type(UngriddedDims) :: dims - vec = UngriddedDimVector() do i=1, size(info) - call push_ungridded_dim(vec, info(i), tol, _RC) + dims = make_ungridded_dims(info, _RC) + call push_ungridded_dims(vec, dims, rc) end do _RETURN(_SUCCESS) end function get_ungridded_dims_bundle_info - function get_ungridded_dims_field(field, tol, rc) result(ungridded) + function get_ungridded_dims_field(field, rc) result(ungridded) type(UngriddedDims) :: ungridded type(ESMF_Field), intent(inout) :: field - real, optional, intent(in) :: tol integer, optional, intent(out) :: rc integer :: status type(ESMF_Info) :: info - type(UngriddedDimVector) :: vec - real :: tol_ - - tol_ = 1E-8 - if(present(tol)) tol_ = tol call ESMF_InfoGetFromHost(field, info, _RC) - call push_ungridded_dim(vec, info, tol_, _RC) - ungridded = UngriddedDims(vec) - call ESMF_InfoDestroy(info, _RC) + ungridded = make_ungridded_dims(info, _RC) _RETURN(_SUCCESS) end function get_ungridded_dims_field - subroutine push_ungridded_dim(vec, info, tol, rc) - type(UngriddedDimVector), intent(inout) :: vec + function make_ungridded_dims(info, rc) result(dims) + type(UngriddedDims) :: dims type(ESMF_Info), intent(in) :: info - real, intent(in) :: tol integer, optional, intent(out) :: rc integer :: status - type(UngriddedDim) :: next - integer :: num_dims, i, vi - logical :: has_dims - integer :: num_coord - character(len=:), allocatable :: name - character(len=:), allocatable :: units + integer :: num_dims, i + type(UngriddedDim) :: ungridded character(len=:), allocatable :: dim_key - real, allocatable :: coordinates(:) - num_dims = 0 - has_dims = ESMF_InfoIsPresent(info, key=KEY_NUM_UNGRID_DIMS, _RC) - if(has_dims) then - call ESMF_InfoGet(info, key=KEY_NUM_UNGRID_DIMS, value=num_dims, _RC) - end if + call ESMF_InfoGet(info, key=KEY_NUM_UNGRID_DIMS, value=num_dims, _RC) do i=1, num_dims dim_key = make_dim_key(i, _RC) - call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNGRIDDED_NAME, value=name, _RC) - call ESMF_InfoGetCharAlloc(info, key=dim_key // KEY_UNGRIDDED_UNITS, value=units, _RC) - call ESMF_InfoGetAlloc(info, key=dim_key // KEY_UNGRIDDED_COORD, values=coordinates, _RC) - call push_next(name, units, coordinates, tol, vec, _RC) + ungridded = make_ungridded_dim(info, dim_key, _RC) + call dims%add_dim(ungridded, _RC) end do _RETURN(_SUCCESS) - end subroutine push_ungridded_dim - - subroutine push_next(name, units, coordinates, tol, vec,rc) + end function make_ungridded_dims + + function make_ungridded_dim(info, key, rc) + type(UngriddedDim) :: make_ungridded_dim + type(ESMF_Info), intent(in) :: info + character(len=*), intent(in) :: key + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info) :: dim_info + character(len=:), allocatable :: name + character(len=:), allocatable :: units + real, allocatable :: coordinates(:) + + dim_info = ESMF_InfoCreate(info, key=key, _RC) + call ESMF_InfoGetCharAlloc(info, key=KEY_UNGRIDDED_NAME, value=name, _RC) + call ESMF_InfoGetCharAlloc(info, key=KEY_UNGRIDDED_UNITS, value=units, _RC) + call ESMF_InfoGetAlloc(info, key=KEY_UNGRIDDED_COORD, values=coordinates, _RC) + make_ungridded_dim = UngriddedDim(name, units, coordinates) + call ESMF_InfoDestroy(dim_info, _RC) + + end function make_ungridded_dim + + subroutine push_ungridded_dims(vec, dims, rc) + class(UngriddedDimVector), intent(inout) :: vec + class(UngriddedDims), intent(in) :: dims + integer, optional, intent(out) :: rc + integer :: status + integer :: i + + do i = 1, dims%get_num_ungridded() + associate (udim => dims%get_ith_dim_spec(i)) + call check_duplicate(vec, udim, _RC) + call vec%push_back(udim, _RC) + end associate + end do + _RETURN(_SUCCESS) + + end subroutine push_ungridded_dims + + integer function find_index(v, name) result(i) + class(StringVector), intent(in) :: v character(len=*), intent(in) :: name - character(len=*), intent(in) :: units - real, intent(in) :: coordinates(:) - real, intent(in) :: tol - type(UngriddedDimVector), intent(inout) :: vec + type(StringVectorIterator) :: iter + + i = 0 + iter = v%begin() + do while (iter /= v%end()) + i = i+1 + if(iter%of() == name) return + call iter%next() + end do + i = 0 + + end function find_index + + 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 - logical :: below - type(UngriddedDim) :: ud + type(UngriddedDim) :: vdim - _ASSERT(tol >= 0, 'A negative relative tolerance is not valid.') iter = vec%ftn_begin() do while(iter < vec%ftn_end()) call iter%next() - ud = iter%of() - if(ud%get_name() /= name) cycle - _ASSERT(ud%get_units() == units, 'units does not match.') - _ASSERT(size(ud%get_coordinates()) == size(coordinates), 'coordinates has a different size.') - below = check_difference(ud%get_coordinates(), coordinates, tol, _RC) - _ASSERT(below, 'coordinates differs by more than the relative tolerance.') + vdim = iter%of() + if(udim%get_name() /= vdim%get_name()) cycle + _ASSERT(udim == vdim) end do - call vec%push_back(UngriddedDim(name, units, coordinates)) - _RETURN(_SUCCESS) - - end subroutine push_next - - logical function check_difference(a, b, tol, rc) result(below) - real, intent(in) :: a(:) - real, intent(in) :: b(:) - real, intent(in) :: tol - integer, optional, intent(out) :: rc - integer :: status - real :: distance, mean - _ASSERT(size(a) == size(b), 'arrays have different length.') - _ASSERT(tol >= 0, 'tol must not be negative.') - mean = 0.5 * (norm2(a) + norm2(b)) - distance = norm2(a - b) - below = (distance <= tol * mean) _RETURN(_SUCCESS) - end function check_difference + end subroutine check_duplicate function create_bundle_info(bundle, rc) result(bundle_info) type(ESMF_Info), allocatable :: bundle_info(:) @@ -329,21 +333,5 @@ subroutine destroy_bundle_info(bundle_info, rc) _RETURN(_SUCCESS) end subroutine destroy_bundle_info - - integer function find_index(v, name) result(i) - class(StringVector), intent(in) :: v - character(len=*), intent(in) :: name - type(StringVectorIterator) :: iter - - i = 0 - iter = v%begin() - do while (iter /= v%end()) - i = i+1 - if(iter%of() == name) return - call iter%next() - end do - i = 0 - - end function find_index end module mapl3g_output_info From bd5451636e9531f2d060becc957229138de219e9 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Tue, 4 Jun 2024 15:28:33 -0400 Subject: [PATCH 22/23] Resolve final issues from PR review --- base/MAPL_ESMF_InfoKeys.F90 | 36 ++++++++++----- gridcomps/History3G/OutputInfo.F90 | 47 +++++++++++--------- gridcomps/History3G/tests/Test_OutputInfo.pf | 16 +++---- 3 files changed, 59 insertions(+), 40 deletions(-) diff --git a/base/MAPL_ESMF_InfoKeys.F90 b/base/MAPL_ESMF_InfoKeys.F90 index c385c9aff8e7..525309ac5255 100644 --- a/base/MAPL_ESMF_InfoKeys.F90 +++ b/base/MAPL_ESMF_InfoKeys.F90 @@ -5,9 +5,11 @@ module mapl3g_esmf_info_keys implicit none + public :: make_dim_key + ! FieldSpec info keys character(len=*), parameter :: PREFIX = 'MAPL/' - character(len=*), parameter :: KEY_UNGRIDDED_DIM = PREFIX // 'ungridded_dims/' + 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' @@ -21,30 +23,40 @@ module mapl3g_esmf_info_keys character(len=*), parameter :: KEY_VLOC = KEY_VERT_DIM // 'vloc' ! UngriddedDims info keys - character(len=*), parameter :: KEY_NUM_UNGRID_DIMS = KEY_UNGRIDDED_DIM // 'num_ungridded_dimensions' - character(len=*), parameter :: KEYSTUB_DIM = KEY_UNGRIDDED_DIM // 'dim_' + 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'] + private + contains function make_dim_key(n, rc) result(key) character(len=:), allocatable :: key integer, intent(in) :: n - integer, optional, intent(out) :: rc + integer, optional, intent(out) :: rc integer :: status - character(len=*), parameter :: EMPTY_STRING = '' - character(len=20) :: raw - - key = EMPTY_STRING - _ASSERT(n >=0, "n must be positive") + 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 - key = KEYSTUB_DIM // trim(adjustl(raw)) // '/' - _RETURN(status) - + _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/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index 227372736121..0da3c16f87a3 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -7,9 +7,11 @@ module mapl3g_output_info use mapl3g_ESMF_Info_Keys use gFTL2_StringVector use esmf, only: ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet - use esmf, only: ESMF_Info, ESMF_InfoDestroy, ESMF_InfoIsPresent - use esmf, only: ESMF_InfoGet, ESMF_InfoGetCharAlloc, ESMF_InfoGetFromHost - use esmf, only: ESMF_InfoGetAlloc + 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 use Mapl_ErrorHandling implicit none @@ -105,8 +107,6 @@ function get_vertical_dim_spec_names_bundle(bundle, rc) result(names) type(ESMF_FieldBundle), intent(in) :: bundle integer, optional, intent(out) :: rc integer :: status - integer :: i - character(len=:), allocatable :: name type(ESMF_Info), allocatable :: info(:) info = create_bundle_info(bundle, _RC) @@ -187,7 +187,7 @@ function get_ungridded_dims_bundle_info(info, rc) result(vec) type(UngriddedDims) :: dims do i=1, size(info) - dims = make_ungridded_dims(info, _RC) + dims = make_ungridded_dims(info(i), _RC) call push_ungridded_dims(vec, dims, rc) end do _RETURN(_SUCCESS) @@ -214,35 +214,43 @@ function make_ungridded_dims(info, rc) result(dims) integer :: status integer :: num_dims, i type(UngriddedDim) :: ungridded - character(len=:), allocatable :: dim_key call ESMF_InfoGet(info, key=KEY_NUM_UNGRID_DIMS, value=num_dims, _RC) do i=1, num_dims - dim_key = make_dim_key(i, _RC) - ungridded = make_ungridded_dim(info, dim_key, _RC) + ungridded = make_ungridded_dim(info, i, _RC) call dims%add_dim(ungridded, _RC) end do _RETURN(_SUCCESS) end function make_ungridded_dims - function make_ungridded_dim(info, key, rc) + function make_ungridded_dim(info, n, rc) type(UngriddedDim) :: make_ungridded_dim + integer, intent(in) :: n type(ESMF_Info), intent(in) :: info - character(len=*), intent(in) :: key integer, optional, intent(out) :: rc integer :: status + character(len=:), allocatable :: key type(ESMF_Info) :: dim_info 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) + if(.not. is_present) then + call ESMF_InfoPrint(info, unit=json_repr, _RC) + end if + _ASSERT(is_present, 'Key ' // key // ' not found in ' // trim(json_repr)) dim_info = ESMF_InfoCreate(info, key=key, _RC) - call ESMF_InfoGetCharAlloc(info, key=KEY_UNGRIDDED_NAME, value=name, _RC) - call ESMF_InfoGetCharAlloc(info, key=KEY_UNGRIDDED_UNITS, value=units, _RC) - call ESMF_InfoGetAlloc(info, key=KEY_UNGRIDDED_COORD, values=coordinates, _RC) - make_ungridded_dim = UngriddedDim(name, units, coordinates) + 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_InfoGetAlloc(dim_info, key=KEY_UNGRIDDED_COORD, values=coordinates, _RC) call ESMF_InfoDestroy(dim_info, _RC) + make_ungridded_dim = UngriddedDim(name, units, coordinates) + _RETURN(_SUCCESS) end function make_ungridded_dim @@ -254,10 +262,8 @@ subroutine push_ungridded_dims(vec, dims, rc) integer :: i do i = 1, dims%get_num_ungridded() - associate (udim => dims%get_ith_dim_spec(i)) - call check_duplicate(vec, udim, _RC) - call vec%push_back(udim, _RC) - end associate + call check_duplicate(vec, dims%get_ith_dim_spec(i), _RC) + call vec%push_back(dims%get_ith_dim_spec(i), _RC) end do _RETURN(_SUCCESS) @@ -292,7 +298,7 @@ subroutine check_duplicate(vec, udim, rc) call iter%next() vdim = iter%of() if(udim%get_name() /= vdim%get_name()) cycle - _ASSERT(udim == vdim) + _ASSERT(udim == vdim, 'UngriddedDim mismatch.') end do _RETURN(_SUCCESS) @@ -309,6 +315,7 @@ function create_bundle_info(bundle, rc) result(bundle_info) type(ESMF_Field), allocatable :: fields(:) type(ESMF_Info) :: info + status = 0 call ESMF_FieldBundleGet(bundle, fieldCount=field_count, _RC) _ASSERT(field_count > 0, 'Empty bundle') allocate(fields(field_count)) diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_OutputInfo.pf index 13b8fdf120e7..3e8ca30b8fcc 100644 --- a/gridcomps/History3G/tests/Test_OutputInfo.pf +++ b/gridcomps/History3G/tests/Test_OutputInfo.pf @@ -2,6 +2,8 @@ # undef SET_RC #endif #define SET_RC(A) if(present(rc)) rc = A +#define _SUCCESS 0 +#define _FAILURE _SUCCESS-1 #include "MAPL_TestErr.h" module Test_OutputInfo use mapl3g_output_info @@ -82,7 +84,6 @@ contains real, allocatable :: coordinates(:) type(UngriddedDimVector) :: vec type(UngriddedDim) :: undim - real :: tol = 1E-8 call safe_dealloc(bundle_info) @@ -94,7 +95,7 @@ contains do i=1, N bundle_info(i) = make_esmf_info(names=EXPECTED_NAMES, units_array=EXPECTED_UNITS, coordinates=EXPECTED_COORDINATES, _RC) end do - vec = get_ungridded_dims_bundle_info(bundle_info, tol, _RC) + vec = get_ungridded_dims_bundle_info(bundle_info, _RC) do i=1, N undim = vec%at(i) name = undim%get_name() @@ -178,7 +179,7 @@ contains integer :: status, i character(len=:), allocatable :: names_(:), units_(:) real, allocatable :: coordinates_(:, :) - character(len=:), allocatable :: dim_key + character(len=:), allocatable :: key character(len=:), allocatable :: name, units real, allocatable :: coord(:) @@ -213,13 +214,13 @@ contains call ESMF_InfoSet(info, KEY_NUM_UNGRID_DIMS, num_ungridded, _RC) do i=1, num_ungridded - dim_key = make_dim_key(i, _RC) + key = make_dim_key(i, _RC) name = names_(i) units = units_(i) coord = coordinates_(i, :) - call ESMF_InfoSet(info, dim_key // KEY_UNGRIDDED_NAME, name, _RC) - call ESMF_InfoSet(info, dim_key // KEY_UNGRIDDED_UNITS, units, _RC) - call ESMF_InfoSet(info, dim_key // KEY_UNGRIDDED_COORD, coord, _RC) + call ESMF_InfoSet(info, key // '/' // KEY_UNGRIDDED_NAME, name, _RC) + call ESMF_InfoSet(info, key // '/' // KEY_UNGRIDDED_UNITS, units, _RC) + call ESMF_InfoSet(info, key // '/' // KEY_UNGRIDDED_COORD, coord, _RC) end do SET_RC(status) @@ -238,7 +239,6 @@ contains subroutine deallocate_destroy(info) type(ESMF_Info), allocatable, intent(inout) :: info(:) - integer :: i call destroy_all(info) deallocate(info) From db05ef109dac8ed18acc75a5dba689921e4a8866 Mon Sep 17 00:00:00 2001 From: Darian Boggs Date: Thu, 6 Jun 2024 15:27:57 -0400 Subject: [PATCH 23/23] Fixed access problem with intel & gfortran --- base/MAPL_ESMF_InfoKeys.F90 | 20 +++++++++++++++++--- gridcomps/History3G/OutputInfo.F90 | 2 +- 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/base/MAPL_ESMF_InfoKeys.F90 b/base/MAPL_ESMF_InfoKeys.F90 index 525309ac5255..38b798916373 100644 --- a/base/MAPL_ESMF_InfoKeys.F90 +++ b/base/MAPL_ESMF_InfoKeys.F90 @@ -5,7 +5,22 @@ module mapl3g_esmf_info_keys 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/' @@ -18,7 +33,7 @@ module mapl3g_esmf_info_keys ! 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' @@ -35,14 +50,13 @@ module mapl3g_esmf_info_keys 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'] - private contains function make_dim_key(n, rc) result(key) character(len=:), allocatable :: key integer, intent(in) :: n - integer, optional, intent(out) :: rc + integer, optional, intent(out) :: rc integer :: status character(len=32) :: raw diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 index 0da3c16f87a3..cf83feb162f0 100644 --- a/gridcomps/History3G/OutputInfo.F90 +++ b/gridcomps/History3G/OutputInfo.F90 @@ -4,7 +4,7 @@ module mapl3g_output_info use mapl3g_UngriddedDim use mapl3g_UngriddedDimVector use mapl3g_UngriddedDims - use mapl3g_ESMF_Info_Keys + use mapl3g_esmf_info_keys use gFTL2_StringVector use esmf, only: ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet use esmf, only: ESMF_Info, ESMF_InfoIsPresent