From bc32d03f26140ad19edf5ff8f05fc74007111857 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Sat, 2 Nov 2024 09:25:59 -0400 Subject: [PATCH 1/7] Fixes #3144 - refactor-fieldspec This is the first of 2-3 commits to refactor code to sue the new FieldCreate machinery in ./field. Lots of work involved changing how info objects are managed, and more remains to be done. --- esmf_utils/CMakeLists.txt | 3 +- esmf_utils/UngriddedDims.F90 | 2 +- field/FieldCreate.F90 | 2 +- field/FieldGet.F90 | 40 +++++--- field/FieldInfo.F90 | 65 +++++++++++-- field/VerticalStaggerLoc.F90 | 76 +++++++-------- field_utils/CMakeLists.txt | 2 +- field_utils/FieldBundleDelta.F90 | 37 ++++---- field_utils/FieldDelta.F90 | 36 ++++---- field_utils/FieldUtilities.F90 | 18 +--- field_utils/tests/Test_FieldBundleDelta.pf | 83 ++++++++--------- field_utils/tests/Test_FieldDelta.pf | 69 ++++++-------- generic3g/CMakeLists.txt | 3 +- generic3g/specs/DimSpec.F90 | 46 ---------- generic3g/specs/DimsSpec.F90 | 61 ------------ generic3g/specs/FieldSpec.F90 | 95 +++++++------------ generic3g/tests/CMakeLists.txt | 1 - generic3g/tests/Test_AddFieldSpec.pf | 1 + generic3g/tests/Test_FieldInfo.pf | 102 --------------------- 19 files changed, 267 insertions(+), 475 deletions(-) delete mode 100644 generic3g/specs/DimSpec.F90 delete mode 100644 generic3g/specs/DimsSpec.F90 delete mode 100644 generic3g/tests/Test_FieldInfo.pf diff --git a/esmf_utils/CMakeLists.txt b/esmf_utils/CMakeLists.txt index 51cd270ce4ee..81ca3467a395 100644 --- a/esmf_utils/CMakeLists.txt +++ b/esmf_utils/CMakeLists.txt @@ -11,13 +11,12 @@ set(srcs esma_add_library(${this} SRCS ${srcs} - DEPENDENCIES MAPL.shared + DEPENDENCIES MAPL.shared ESMF::ESMF TYPE SHARED ) target_include_directories (${this} PUBLIC $) -target_link_libraries (${this} PUBLIC ESMF::ESMF) if (PFUNIT_FOUND) add_subdirectory(tests) diff --git a/esmf_utils/UngriddedDims.F90 b/esmf_utils/UngriddedDims.F90 index 1441d9675eb5..fd9643c9a3dd 100644 --- a/esmf_utils/UngriddedDims.F90 +++ b/esmf_utils/UngriddedDims.F90 @@ -185,7 +185,7 @@ function make_info(this, rc) result(info) character(:), allocatable :: dim_key info = ESMF_InfoCreate(_RC) - call MAPL_InfoSet(info, key='num_ungridded_dimensions', value=this%get_num_ungridded(), _RC) + call MAPL_InfoSet(info, key='/num_ungridded_dimensions', value=this%get_num_ungridded(), _RC) do i = 1, this%get_num_ungridded() dim_spec => this%get_ith_dim_spec(i, _RC) diff --git a/field/FieldCreate.F90 b/field/FieldCreate.F90 index 30948b586a67..56998ea6b05e 100644 --- a/field/FieldCreate.F90 +++ b/field/FieldCreate.F90 @@ -89,7 +89,7 @@ subroutine field_empty_complete( field, & bounds = make_bounds(num_levels=num_levels, ungridded_dims=ungridded_dims) call ESMF_FieldEmptyComplete(field, typekind=typekind, & - gridToFieldMap=gridToFieldMap, & +!# gridToFieldMap=gridToFieldMap, & ungriddedLBound=bounds%lower, ungriddedUBound=bounds%upper, _RC) call MAPL_FieldInfoSetInternal(field, & diff --git a/field/FieldGet.F90 b/field/FieldGet.F90 index 214da6a2d585..a4b495ccc81c 100644 --- a/field/FieldGet.F90 +++ b/field/FieldGet.F90 @@ -1,9 +1,11 @@ #include "MAPL_Generic.h" module mapl3g_FieldGet + use mapl3g_VerticalStaggerLoc use mapl3g_FieldInfo use mapl_KeywordEnforcer use mapl_ErrorHandling + use mapl3g_UngriddedDims use esmf implicit none (type, external) private @@ -16,31 +18,41 @@ module mapl3g_FieldGet contains -!# subroutine field_get (field, unusable, & -!# ! pass thru to ESMF -!# status, geomtype, geom, typekind, rank, dimCount, staggerloc, name, vm, & -!# ! allocatable in MAPL -!# minIndex, maxIndex, elementCount, & -!# localMinIndex, localMaxIndex, & -!# ! MAPL specific -!# units, standard_name, long_name, & -!# rc) -!# -!# end subroutine field_get - subroutine field_get(field, unusable, & + num_levels, vert_staggerloc, num_vgrid_levels, & + ungridded_dims, & units, & rc) type(ESMF_Field), intent(in) :: field class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: num_levels + type(VerticalStaggerLoc), optional, intent(out) :: vert_staggerloc + integer, optional, intent(out) :: num_vgrid_levels + type(UngriddedDims), optional, intent(out) :: ungridded_dims character(len=:), optional, allocatable, intent(out) :: units + integer, optional, intent(out) :: rc integer :: status + type(ESMF_Info) :: info + logical :: need_info + character(:), allocatable :: vert_staggerloc_str + + need_info = any([ & + present(num_levels), present(vert_staggerloc), present(num_vgrid_levels), & + present(ungridded_dims), & + present(units) & + ]) - if (present(units)) then - call MAPL_FieldInfoGetInternal(field, units=units, _RC) + if (need_info) then + call ESMF_InfoGetFromHost(field, info, _RC) + call MAPL_FieldInfoGetInternal(field, & + num_levels=num_levels, & + vert_staggerloc=vert_staggerloc, & + num_vgrid_levels=num_vgrid_levels, & + ungridded_dims=ungridded_dims, & + units=units, _RC) end if _RETURN(_SUCCESS) diff --git a/field/FieldInfo.F90 b/field/FieldInfo.F90 index 9691ac76ae26..ad50d9caf56a 100644 --- a/field/FieldInfo.F90 +++ b/field/FieldInfo.F90 @@ -15,6 +15,7 @@ module mapl3g_FieldInfo public :: MAPL_FieldInfoSetInternal public :: MAPL_FieldInfoGetInternal + public :: KEY_TYPEKIND public :: KEY_UNITS public :: KEY_LONG_NAME public :: KEY_STANDARD_NAME @@ -34,6 +35,7 @@ module mapl3g_FieldInfo module procedure field_info_get_internal end interface + character(*), parameter :: KEY_TYPEKIND = "/typekind" character(*), parameter :: KEY_UNITS = "/units" character(*), parameter :: KEY_LONG_NAME = "/long_name" character(*), parameter :: KEY_STANDARD_NAME = "/standard_name" @@ -88,8 +90,27 @@ subroutine field_info_set_internal(field, unusable, num_levels, & call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // KEY_NUM_LEVELS, num_levels, _RC) end if + if (present(vert_staggerloc)) then call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // KEY_VERT_STAGGERLOC, vert_staggerloc%to_string(), _RC) + + ! Delete later - needed for transition + + if (present(num_levels) .and. present(vert_staggerloc)) then + if (vert_staggerLoc == VERTICAL_STAGGER_NONE) then + call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // "/vertical_dim/vloc", "VERTICAL_DIM_NONE", _RC) + call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // "/vertical_grid/num_levels", 0, _RC) + else if (vert_staggerLoc == VERTICAL_STAGGER_EDGE) then + call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // "/vertical_dim/vloc", "VERTICAL_DIM_EDGE", _RC) + call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // "/vertical_grid/num_levels", num_levels+1, _RC) + else if (vert_staggerLoc == VERTICAL_STAGGER_CENTER) then + call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // "/vertical_dim/vloc", "VERTICAL_DIM_CENTER", _RC) + call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // "/vertical_grid/num_levels", num_levels, _RC) + else + _FAIL('unsupported vertical stagger') + end if + end if + end if _RETURN(_SUCCESS) @@ -97,13 +118,15 @@ subroutine field_info_set_internal(field, unusable, num_levels, & end subroutine field_info_set_internal subroutine field_info_get_internal(field, unusable, & - num_levels, vert_staggerloc, units, long_name, standard_name, & + num_levels, vert_staggerloc, num_vgrid_levels, & + units, long_name, standard_name, & ungridded_dims, rc) type(ESMF_Field), intent(in) :: field class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: num_levels - integer, optional, intent(out) :: vert_staggerloc + type(VerticalStaggerLoc), optional, intent(out) :: vert_staggerloc + integer, optional, intent(out) :: num_vgrid_levels character(:), optional, allocatable, intent(out) :: units character(:), optional, allocatable, intent(out) :: long_name character(:), optional, allocatable, intent(out) :: standard_name @@ -111,7 +134,10 @@ subroutine field_info_get_internal(field, unusable, & integer, optional, intent(out) :: rc integer :: status + integer :: num_levels_ type(ESMF_Info) :: ungridded_info, field_info + character(:), allocatable :: vert_staggerloc_str + type(VerticalStaggerLoc) :: vert_staggerloc_ call ESMF_InfoGetFromHost(field, field_info, _RC) @@ -120,6 +146,33 @@ subroutine field_info_get_internal(field, unusable, & ungridded_dims = make_UngriddedDims(ungridded_info, _RC) end if + if (present(num_levels) .or. present(num_vgrid_levels)) then + call MAPL_InfoGet(field_info, INFO_INTERNAL_NAMESPACE // KEY_NUM_LEVELS, num_levels_, _RC) + if (present(num_levels)) then + num_levels = num_levels_ + end if + end if + + if (present(vert_staggerloc) .or. present(num_vgrid_levels)) then + call MAPL_InfoGet(field_info, INFO_INTERNAL_NAMESPACE // KEY_VERT_STAGGERLOC, vert_staggerloc_str, _RC) + vert_staggerloc_ = VerticalStaggerLoc(vert_staggerloc_str) + if (present(vert_staggerloc)) then + vert_staggerloc = vert_staggerloc_ + end if + end if + + if (present(num_vgrid_levels)) then + if (vert_staggerloc_ == VERTICAL_STAGGER_NONE) then + num_vgrid_levels = 0 + else if (vert_staggerloc_ == VERTICAL_STAGGER_EDGE) then + num_vgrid_levels = num_levels_ + 1 + else if (vert_staggerloc_ == VERTICAL_STAGGER_CENTER) then + num_vgrid_levels = num_levels_ + else + _FAIL('unsupported vertical stagger') + end if + end if + if (present(units)) then call MAPL_InfoGet(field_info, INFO_INTERNAL_NAMESPACE // KEY_UNITS, units, _RC) end if @@ -132,14 +185,6 @@ subroutine field_info_get_internal(field, unusable, & call MAPL_InfoGet(field_info, INFO_INTERNAL_NAMESPACE // KEY_STANDARD_NAME, standard_name, _RC) end if - if (present(num_levels)) then - call MAPL_InfoGet(field_info, INFO_INTERNAL_NAMESPACE // KEY_NUM_LEVELS, num_levels, _RC) - end if - - if (present(vert_staggerloc)) then - call MAPL_InfoGet(field_info, INFO_INTERNAL_NAMESPACE // KEY_VERT_STAGGERLOC, vert_staggerloc, _RC) - end if - _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end subroutine field_info_get_internal diff --git a/field/VerticalStaggerLoc.F90 b/field/VerticalStaggerLoc.F90 index aebe955bc566..747074c3c7bb 100644 --- a/field/VerticalStaggerLoc.F90 +++ b/field/VerticalStaggerLoc.F90 @@ -11,16 +11,23 @@ module mapl3g_VerticalStaggerLoc public :: operator(==) public :: operator(/=) - public :: make_VerticalStaggerLoc - + ! The type below has an "extraneous" component ID. The purpose of + ! this is to allow the default structure constructor to be usable + ! in constant expressions (parameter statements), while still allowing + ! private components which require a non-default constructor for external + ! modules. Subtle. type :: VerticalStaggerLoc private - integer :: id + integer :: id = -1 + character(24) :: name = "VERTICAL_STAGGER_INVALID" contains - ! TODO: Convert to DTIO once compilers support allocatable internal files procedure :: to_string end type VerticalStaggerLoc + interface VerticalStaggerLoc + procedure :: new_VerticalStaggerLoc + end interface VerticalStaggerLoc + interface operator(==) procedure are_equal end interface operator(==) @@ -29,61 +36,42 @@ module mapl3g_VerticalStaggerLoc procedure are_not_equal end interface operator(/=) - type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_NONE = VerticalStaggerLoc(1) - type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_EDGE = VerticalStaggerLoc(2) - type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_CENTER = VerticalStaggerLoc(3) - type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_INVALID = VerticalStaggerLoc(4) - - character(*), parameter :: VERTICAL_STAGGER_NONE_NAME = "VERTICAL_STAGGER_NONE" - character(*), parameter :: VERTICAL_STAGGER_EDGE_NAME = "VERTICAL_STAGGER_EDGE" - character(*), parameter :: VERTICAL_STAGGER_CENTER_NAME = "VERTICAL_STAGGER_CENTER" + type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_NONE = VerticalStaggerLoc(0, "VERTICAL_STAGGER_NONE") + type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_EDGE = VerticalStaggerLoc(1, "VERTICAL_STAGGER_EDGE") + type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_CENTER = VerticalStaggerLoc(2, "VERTICAL_STAGGER_CENTER") + type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_INVALID = VerticalStaggerLoc(3, "VERTICAL_STAGGER_INVALID") contains - function make_VerticalStaggerLoc(string) result(vert_staggerLoc) - type(VerticalStaggerLoc) :: vert_staggerLoc - character(*), intent(in) :: string - - select case (string) - case (VERTICAL_STAGGER_NONE_NAME) - vert_staggerLoc = VERTICAL_STAGGER_NONE - case (VERTICAL_STAGGER_EDGE_NAME) - vert_staggerLoc = VERTICAL_STAGGER_EDGE - case (VERTICAL_STAGGER_CENTER_NAME) - vert_staggerLoc = VERTICAL_STAGGER_CENTER + ! Restrict values to just the 4 defined options. + function new_VerticalStaggerLoc(name) result(staggerloc) + type(VerticalStaggerLoc) :: staggerloc + character(*), intent(in) :: name + + select case (name) + case (VERTICAL_STAGGER_NONE%name) + staggerloc = VERTICAL_STAGGER_NONE + case (VERTICAL_STAGGER_EDGE%name) + staggerloc = VERTICAL_STAGGER_EDGE + case (VERTICAL_STAGGER_CENTER%name) + staggerloc = VERTICAL_STAGGER_CENTER case default - vert_staggerLoc = VERTICAL_STAGGER_INVALID + staggerloc = VERTICAL_STAGGER_INVALID end select - - end function make_VerticalStaggerLoc - - + end function new_VerticalStaggerLoc + function to_string(this) result(s) character(:), allocatable :: s class(VerticalStaggerLoc), intent(in) :: this - if (this == VERTICAL_STAGGER_NONE) then - s = VERTICAL_STAGGER_NONE_NAME - return - end if - - if (this == VERTICAL_STAGGER_EDGE) then - s = VERTICAL_STAGGER_EDGE_NAME - return - end if - - if (this == VERTICAL_STAGGER_CENTER) then - s = VERTICAL_STAGGER_CENTER_NAME - return - end if + s = trim(this%name) - s = "VERTICAL_STAGGER_INVALID" end function to_string elemental logical function are_equal(this, that) type(VerticalStaggerLoc), intent(in) :: this type(VerticalStaggerLoc), intent(in) :: that - are_equal = this%id == that%id + are_equal = this%name == that%name end function are_equal elemental logical function are_not_equal(this, that) diff --git a/field_utils/CMakeLists.txt b/field_utils/CMakeLists.txt index 645099bb52da..e8627b2604e1 100644 --- a/field_utils/CMakeLists.txt +++ b/field_utils/CMakeLists.txt @@ -29,7 +29,7 @@ endif () esma_add_library(${this} SRCS ${srcs} - DEPENDENCIES MAPL.shared MAPL.esmf_utils PFLOGGER::pflogger udunits2f + DEPENDENCIES MAPL.field MAPL.shared MAPL.esmf_utils PFLOGGER::pflogger udunits2f TYPE SHARED ) #DEPENDENCIES MAPL.shared PFLOGGER::pflogger udunits2f diff --git a/field_utils/FieldBundleDelta.F90 b/field_utils/FieldBundleDelta.F90 index 1b19c638edfb..69e4ad76621d 100644 --- a/field_utils/FieldBundleDelta.F90 +++ b/field_utils/FieldBundleDelta.F90 @@ -7,9 +7,14 @@ module mapl3g_FieldBundleDelta use mapl3g_LU_Bound use mapl3g_FieldDelta use mapl3g_InfoUtilities + use mapl3g_VerticalStaggerLoc + use mapl3g_FieldCreate + use mapl3g_FieldGet + use mapl3g_FieldInfo use mapl_FieldUtilities + use mapl3g_UngriddedDims use mapl_FieldPointerUtilities - use mapl3g_esmf_info_keys + use mapl3g_esmf_info_keys, only: KEY_INTERPOLATION_WEIGHTS use mapl_ErrorHandling use mapl_KeywordEnforcer use esmf @@ -205,11 +210,12 @@ subroutine reallocate_bundle(this, bundle, ignore, unusable, rc) type(ESMF_TypeKind_Flag) :: typekind integer, allocatable :: ungriddedLbound(:), ungriddedUbound(:) type(ESMF_Info) :: ungridded_info - type(ESMF_Info) :: vertical_info integer :: old_field_count, new_field_count - integer :: num_levels - character(:), allocatable :: units, vloc + integer, allocatable :: num_levels + character(:), allocatable :: units, vert_staggerloc_str + type(VerticalStaggerLoc) :: vert_staggerloc character(ESMF_MAXSTR), allocatable :: fieldNameList(:) + type(UngriddedDims) :: ungridded_dims ! Easy case 1: field count unchanged call MAPL_FieldBundleGet(bundle, fieldList=fieldList, _RC) @@ -233,28 +239,27 @@ subroutine reallocate_bundle(this, bundle, ignore, unusable, rc) ! Need geom, typekind, and bounds to allocate fields before call MAPL_FieldBundleGet(bundle, geom=bundle_geom, _RC) - call MAPL_FieldBundleGet(bundle, typekind=typekind, ungriddedUBound=ungriddedUbound, _RC) - ungriddedLBound = [(1, i = 1, size(ungriddedUBound))] + call MAPL_FieldBundleGet(bundle, typekind=typekind, _RC) ungridded_info = MAPL_InfoCreateFromInternal(bundle, key=KEY_UNGRIDDED_DIMS, _RC) + ungridded_dims = make_UngriddedDims(ungridded_info, _RC) call MAPL_InfoGetInternal(bundle, KEY_UNITS, value=units, _RC) - call MAPL_InfoGetInternal(bundle, KEY_VLOC, value=vloc, _RC) - if (vloc /= "VERTICAL_DIM_NONE") then + call MAPL_InfoGetInternal(bundle, KEY_VERT_STAGGERLOC, value=vert_staggerloc_str, _RC) + vert_staggerloc = VerticalStaggerLoc(vert_staggerloc_str) + _ASSERT(vert_staggerloc /= VERTICAL_STAGGER_INVALID, 'Vert stagger is INVALID.') + if (vert_staggerloc /= VERTICAL_STAGGER_NONE) then + allocate(num_levels) call MAPL_InfoGetInternal(bundle, KEY_NUM_LEVELS, value=num_levels, _RC) end if do i = 1, new_field_count fieldList(i) = ESMF_FieldEmptyCreate(_RC) call ESMF_FieldEmptySet(fieldList(i), geom=bundle_geom, _RC) - call ESMF_FieldEmptyComplete(fieldList(i), typekind=typekind, & - ungriddedLbound=ungriddedLBound, ungriddedUbound=ungriddedUBound, _RC) - call MAPL_InfoSetInternal(fieldList(i), KEY_UNGRIDDED_DIMS, value=ungridded_info, _RC) - call MAPL_InfoSetInternal(fieldList(i), KEY_VLOC, value=vloc, _RC) - if (vloc /= "VERTICAL_DIM_NONE") then - call MAPL_InfoSetInternal(fieldList(i), KEY_NUM_LEVELS, value=num_levels, _RC) - end if - call MAPL_InfoSetInternal(fieldList(i), KEY_UNITS, value=units, _RC) + call MAPL_FieldEmptyComplete(fieldList(i), typekind=typekind, & + ungridded_dims=ungridded_dims, & + num_levels=num_levels, vert_staggerLoc=vert_staggerLoc, & + units=units, _RC) end do call ESMF_InfoDestroy(ungridded_info, _RC) diff --git a/field_utils/FieldDelta.F90 b/field_utils/FieldDelta.F90 index 3cfabb903226..a622ede99062 100644 --- a/field_utils/FieldDelta.F90 +++ b/field_utils/FieldDelta.F90 @@ -4,9 +4,11 @@ #include "MAPL_Exceptions.h" module mapl3g_FieldDelta + use mapl3g_FieldInfo + use mapl3g_FieldGet + use mapl3g_VerticalStaggerLoc use mapl3g_InfoUtilities use mapl_FieldPointerUtilities - use mapl3g_esmf_info_keys use mapl_ErrorHandling use mapl_KeywordEnforcer use esmf @@ -152,8 +154,8 @@ subroutine compute_num_levels_delta(num_levels, f_a, f_b, rc) integer :: status integer :: num_levels_a, num_levels_b - call MAPL_InfoGetInternal(f_a, key=KEY_NUM_LEVELS, value=num_levels_a, _RC) - call MAPL_InfoGetInternal(f_b, key=KEY_NUM_LEVELS, value=num_levels_b, _RC) + call MAPL_FieldGet(f_a, num_levels=num_levels_a, _RC) + call MAPL_FieldGet(f_b, num_levels=num_levels_b, _RC) if (num_levels_a /= num_levels_b) then num_levels = num_levels_b @@ -172,8 +174,8 @@ subroutine compute_units_delta(units, f_a, f_b, rc) integer :: status character(len=:), allocatable :: units_a, units_b - call MAPL_InfoGetInternal(f_a, KEY_UNITS, value=units_a, _RC) - call MAPL_InfoGetInternal(f_b, KEY_UNITS, value=units_b, _RC) + call MAPL_FieldGet(f_a, units=units_a, _RC) + call MAPL_FieldGet(f_b, units=units_b, _RC) if (units_a /= units_b) then allocate(character(len_trim(units_b)) :: units) @@ -200,8 +202,7 @@ subroutine initialize_field_delta_degenerate(this, f, rc) call ESMF_FieldGet(f, geom=this%geom, typekind=typekind, _RC) allocate(this%num_levels) - call MAPL_InfoGetInternal(f, KEY_NUM_LEVELS, value=this%num_levels, _RC) - call MAPL_InfoGetInternal(f, KEY_UNITS, value=this%units, _RC) + call MAPL_FieldGet(f, num_levels=this%num_levels, units=this%units, _RC) _RETURN(_SUCCESS) end subroutine initialize_field_delta_degenerate @@ -372,7 +373,7 @@ subroutine select_ungriddedUbound(ungriddedUbound, field, new_num_levels, ignore integer, optional, intent(inout) :: rc integer :: status - character(:), allocatable :: vloc + type(VerticalStaggerLoc) :: vert_staggerloc integer :: ungriddedDimCount integer :: rank integer :: current_num_levels @@ -389,22 +390,17 @@ subroutine select_ungriddedUbound(ungriddedUbound, field, new_num_levels, ignore if (ignore == 'num_levels') return if (.not. present(new_num_levels)) return - call MAPL_InfoGetInternal(field, KEY_NUM_LEVELS, value=current_num_levels, _RC) - call MAPL_InfoGetInternal(field, KEY_VLOC, value=vloc, _RC) + call MAPL_FieldGet(field, vert_staggerloc=vert_staggerloc, _RC) ! Surface fields are not impacted by change in vertical grid - _RETURN_IF(vloc == 'VERTICAL_DIM_NONE') + _RETURN_IF(vert_staggerloc == VERTICAL_STAGGER_NONE) - new_array = new_array .or. (this%num_levels /= current_num_levels) - select case (vloc) - case ('VERTICAL_DIM_CENTER') - ungriddedUBound(1) = this%num_levels - case ('VERTICAL_DIM_EDGE') - ungriddedUBound(1) = this%num_levels + 1 - case default - _FAIL('unsupported vertical location: '//vloc) - end select + call MAPL_FieldGet(field, num_levels=current_num_levels, _RC) + _ASSERT(count(vert_staggerloc == [VERTICAL_STAGGER_CENTER, VERTICAL_STAGGER_EDGE]) == 1, 'unsupported vertical stagger') + ungriddedUBound(1) = this%num_levels + + new_array = new_array .or. (this%num_levels /= current_num_levels) _RETURN(_SUCCESS) end subroutine select_ungriddedUbound diff --git a/field_utils/FieldUtilities.F90 b/field_utils/FieldUtilities.F90 index d66a96209f3c..3221474055cf 100644 --- a/field_utils/FieldUtilities.F90 +++ b/field_utils/FieldUtilities.F90 @@ -1,10 +1,10 @@ #include "MAPL_Generic.h" module MAPL_FieldUtilities + use mapl3g_FieldInfo use mapl3g_FieldDimensionInfo use MAPL_ErrorHandlingMod use MAPL_FieldPointerUtilities - use mapl3g_esmf_info_keys use mapl3g_InfoUtilities use mapl3g_UngriddedDims use mapl3g_LU_Bound @@ -223,7 +223,7 @@ subroutine MAPL_FieldBundleGet(fieldBundle, unusable, fieldList, geom, typekind, type(UngriddedDims) :: ungridded_dims type(LU_Bound), allocatable :: bounds(:) integer :: num_levels - character(:), allocatable :: vloc + character(:), allocatable :: vert_staggerloc if (present(fieldList)) then call ESMF_FieldBundleGet(fieldBundle, fieldCount=fieldCount, _RC) @@ -258,19 +258,11 @@ subroutine MAPL_FieldBundleGet(fieldBundle, unusable, fieldList, geom, typekind, ungridded_dims = make_ungriddedDims(ungridded_info, KEY_UNGRIDDED_DIMS, _RC) bounds = ungridded_dims%get_bounds() - call MAPL_InfoGetInternal(fieldBundle, key=KEY_VLOC, value=vloc, _RC) - if (vloc /= 'VERTICAL_DIM_NONE') then + call MAPL_InfoGetInternal(fieldBundle, key=KEY_VERT_STAGGERLOC, value=vert_staggerloc, _RC) + if (vert_staggerloc /= 'VERTICAL_STAGGER_NONE') then call MAPL_InfoGetInternal(fieldBundle, key=KEY_NUM_LEVELS, value=num_levels, _RC) - select case (vloc) - case ('VERTICAL_DIM_CENTER') - bounds = [LU_Bound(1, num_levels), bounds] - case ('VERTICAL_DIM_EDGE') - bounds = [LU_Bound(1, num_levels+1), bounds] - case default - _FAIL('unsupported vertical location') - end select + bounds = [LU_Bound(1, num_levels), bounds] end if - ungriddedUbound = bounds%upper end if diff --git a/field_utils/tests/Test_FieldBundleDelta.pf b/field_utils/tests/Test_FieldBundleDelta.pf index ef9e974d4b0d..90a6c6f8a738 100644 --- a/field_utils/tests/Test_FieldBundleDelta.pf +++ b/field_utils/tests/Test_FieldBundleDelta.pf @@ -3,7 +3,11 @@ module Test_FieldBundleDelta use mapl3g_FieldBundleDelta use mapl3g_FieldDelta - use mapl3g_ESMF_Info_Keys + use mapl3g_FieldGet + use mapl3g_FieldCreate + use mapl3g_FieldInfo + use mapl3g_esmf_info_keys, only: KEY_INTERPOLATION_WEIGHTS + use mapl3g_VerticalStaggerLoc use mapl3g_InfoUtilities use mapl_FieldUtilities use mapl3g_UngriddedDims @@ -17,7 +21,7 @@ module Test_FieldBundleDelta real, parameter :: FILL_VALUE = 99. real, parameter :: DEFAULT_WEIGHTS(*) = [0.0, 0.5, 0.5] integer, parameter :: FIELD_COUNT = 2 - integer, parameter :: NUM_LEVELS = 3 + integer, parameter :: NUM_LEVELS_VGRID = 3 integer, parameter :: NUM_RADII = 5 contains @@ -52,31 +56,27 @@ contains logical, optional, intent(in) :: with_ungridded type(UngriddedDims) :: ungridded_dims - type(ESMF_Info) :: ungridded_info type(LU_Bound), allocatable :: bounds(:) + type(VerticalStaggerLoc) :: vert_staggerloc + integer, allocatable :: num_levels - field = ESMF_FieldEmptyCreate() - call ESMF_FieldEmptySet(field, geom=geom) - - call MAPL_InfoSetInternal(field, KEY_UNITS, units) - - call MAPL_InfoSetInternal(field, KEY_VLOC, "VERTICAL_DIM_NONE") - ungridded_dims = UngriddedDims() bounds = ungridded_dims%get_bounds() + + vert_staggerloc = VERTICAL_STAGGER_NONE if (present(with_ungridded)) then if (with_ungridded) then - call MAPL_InfoSetInternal(field, KEY_VLOC, "VERTICAL_DIM_CENTER") - call MAPL_InfoSetInternal(field, KEY_NUM_LEVELS, NUM_LEVELS) + vert_staggerloc = VERTICAL_STAGGER_CENTER + num_levels = NUM_LEVELS_VGRID call ungridded_dims%add_dim(UngriddedDim(NUM_RADII, "radius", 'nm')) - bounds = [LU_Bound(1, NUM_LEVELS), ungridded_dims%get_bounds()] end if end if - - ungridded_info = ungridded_dims%make_info() - call MAPL_InfoSetInternal(field, KEY_UNGRIDDED_DIMS, value=ungridded_info) - - call ESMF_FieldEmptyComplete(field, typekind=typekind, ungriddedLBound=bounds%lower, ungriddedUBound=bounds%upper) + field = ESMF_FieldEmptyCreate() + call ESMF_FieldEmptySet(field, geom=geom) + call MAPL_FieldEmptyComplete(field, typekind=typekind, & + num_levels=num_levels, vert_staggerloc=vert_staggerloc, & + ungridded_dims=ungridded_dims, & + units=units) call FieldSet(field, FILL_VALUE) end subroutine setup_field @@ -101,6 +101,7 @@ contains integer :: fieldCount type(UngriddedDims) :: ungridded_dims type(ESMF_Info) :: ungridded_info + type(VerticalStaggerLoc) :: vert_staggerloc bundle = ESMF_FieldBundleCreate() call MAPL_FieldBundleSet(bundle, geom=geom) @@ -110,10 +111,6 @@ contains call ESMF_FieldBundleAdd(bundle, [f], multiflag=.true.) end do - ungridded_dims = UngriddedDims() - ungridded_info = ungridded_dims%make_info() - call MAPL_InfoSetInternal(bundle, KEY_UNGRIDDED_DIMS, value=ungridded_info) - call MAPL_InfoSetInternal(bundle, KEY_INTERPOLATION_WEIGHTS, weights) if (typekind == ESMF_TYPEKIND_R4) then call MAPL_InfoSetInternal(bundle, KEY_TYPEKIND, "R4") @@ -122,16 +119,16 @@ contains end if call MAPL_InfoSetInternal(bundle, KEY_UNITS, units) - call MAPL_InfoSetInternal(bundle, KEY_VLOC, "VERTICAL_DIM_NONE") + vert_staggerloc = VERTICAL_STAGGER_NONE ungridded_dims = UngriddedDims() - if (present(with_ungridded)) then if (with_ungridded) then - call MAPL_InfoSetInternal(bundle, KEY_VLOC, "VERTICAL_DIM_CENTER") - call MAPL_InfoSetInternal(bundle, KEY_NUM_LEVELS, NUM_LEVELS) + vert_staggerloc = VERTICAL_STAGGER_CENTER + call MAPL_InfoSetInternal(bundle, KEY_NUM_LEVELS, NUM_LEVELS_VGRID) call ungridded_dims%add_dim(UngriddedDim(NUM_RADII, "radius", 'nm')) end if end if + call MAPL_InfoSetInternal(bundle, KEY_VERT_STAGGERLOC, vert_staggerloc%to_string()) ungridded_info = ungridded_dims%make_info() call MAPL_InfoSetInternal(bundle, KEY_UNGRIDDED_DIMS, value=ungridded_info) @@ -319,19 +316,18 @@ contains real(kind=ESMF_KIND_R4), pointer :: x_r4(:,:) character(:), allocatable :: new_units real(kind=ESMF_KIND_R4), allocatable :: weights(:) - real(kind=ESMF_KIND_R4), parameter :: new_weights(*) = [0.,0.25,0.75] + real(kind=ESMF_KIND_R4), parameter :: NEW_WEIGHTS(*) = [0.,0.25,0.75] call setup_geom(geom, 4) call setup_bundle(bundle, weights=DEFAULT_WEIGHTS, geom=geom, typekind=ESMF_TYPEKIND_R4, units='km') - - delta = FieldBundleDelta(interpolation_weights=new_weights) + delta = FieldBundleDelta(interpolation_weights=NEW_WEIGHTS) call delta%update_bundle(bundle, _RC) ! should not reallocate fields call MAPL_FieldBundleGet(bundle, fieldList=fieldList, _RC) @assert_that(size(fieldList), is(FIELD_COUNT)) - do i = 1, FIELD_COUNT + do i = 1, FIELD_COUNT call ESMF_FieldGet(fieldList(i), fArrayPtr=x_r4, _RC) @assert_that(shape(x_r4), is(equal_to([4,4]))) @assert_that(x_r4, every_item(is(FILL_VALUE))) @@ -367,6 +363,7 @@ contains real(kind=ESMF_KIND_R4), allocatable :: weights(:) real(kind=ESMF_KIND_R4), parameter :: new_weights(*) = [0.,0.25,0.75] integer :: ndims, nlevels, rank + type(UngriddedDims) :: ungridded_dims call setup_geom(geom, 4) call setup_bundle(bundle, weights=DEFAULT_WEIGHTS, geom=geom, typekind=ESMF_TYPEKIND_R4, units='km', with_ungridded=.true.) @@ -380,9 +377,8 @@ contains do i = 1, FIELD_COUNT call ESMF_FieldGet(fieldList(i), rank=rank, _RC) - call ESMF_FieldGet(fieldList(i), fArrayPtr=x_r4, _RC) - @assert_that(shape(x_r4), is(equal_to([4,4,NUM_LEVELS,NUM_RADII]))) + @assert_that(shape(x_r4), is(equal_to([4,4,NUM_LEVELS_VGRID,NUM_RADII]))) @assert_that(all(x_r4 == FILL_VALUE), is(true())) call MAPL_InfoGetInternal(fieldList(i), KEY_UNITS, value=new_units, _RC) @@ -391,22 +387,22 @@ contains call ESMF_FieldGet(fieldList(i), geom=tmp_geom, _RC) @assert_that(tmp_geom == geom, is(true())) - call MAPL_InfoGetInternal(fieldList(i), KEY_UNGRIDDED_DIMS//KEY_NUM_UNGRIDDED_DIMS, value=ndims, _RC) - @assert_that(ndims, is(1)) + call MAPL_FieldGet(fieldList(i), ungridded_dims=ungridded_dims, _RC) + @assert_that(ungridded_dims%get_num_ungridded(), is(1)) call MAPL_InfoGetInternal(fieldList(i), KEY_NUM_LEVELS, value=nlevels, _RC) - @assert_that(nlevels, is(NUM_LEVELS)) + @assert_that(nlevels, is(NUM_LEVELS_VGRID)) end do call MAPL_InfoGetInternal(bundle, KEY_INTERPOLATION_WEIGHTS, values=weights, _RC) @assert_that(weights, is(equal_to(new_weights))) - call MAPL_InfoGetInternal(bundle, KEY_UNGRIDDED_DIMS//KEY_NUM_UNGRIDDED_DIMS, value=ndims, _RC) + call MAPL_InfoGetInternal(bundle, KEY_UNGRIDDED_DIMS//'/num_ungridded_dimensions', value=ndims, _RC) @assert_that(ndims, is(1)) call MAPL_InfoGetInternal(bundle, KEY_NUM_LEVELS, value=nlevels, _RC) - @assert_that(nlevels, is(NUM_LEVELS)) + @assert_that(nlevels, is(NUM_LEVELS_VGRID)) call teardown_bundle(bundle) call teardown_geom(geom) @@ -483,6 +479,7 @@ contains real(kind=ESMF_KIND_R4), allocatable :: weights(:) real(kind=ESMF_KIND_R4), parameter :: new_weights(*) = [0.,0.25,0.75] integer :: ndims, nlevels + type(UngriddedDims) :: ungridded_dims call setup_geom(geom, 4) call setup_bundle(bundle, weights=[5.], geom=geom, typekind=ESMF_TYPEKIND_R4, units='km', & @@ -496,7 +493,7 @@ contains do i = 1, FIELD_COUNT call ESMF_FieldGet(fieldList(i), fArrayPtr=x_r4, _RC) - @assert_that(shape(x_r4), is(equal_to([4,4,NUM_LEVELS,NUM_RADII]))) + @assert_that(shape(x_r4), is(equal_to([4,4,NUM_LEVELS_VGRID,NUM_RADII]))) call MAPL_InfoGetInternal(fieldList(i), KEY_UNITS, value=new_units, _RC) @assertEqual('km', new_units) @@ -504,21 +501,21 @@ contains call ESMF_FieldGet(fieldList(i), geom=tmp_geom, _RC) @assert_that(tmp_geom == geom, is(true())) - call MAPL_InfoGetInternal(fieldList(i), KEY_UNGRIDDED_DIMS//KEY_NUM_UNGRIDDED_DIMS, value=ndims, _RC) - @assert_that(ndims, is(1)) + call MAPL_FieldGet(fieldList(i), ungridded_dims=ungridded_dims, _RC) + @assert_that(ungridded_dims%get_num_ungridded(), is(1)) call MAPL_InfoGetInternal(fieldList(i), KEY_NUM_LEVELS, value=nlevels, _RC) - @assert_that(nlevels, is(NUM_LEVELS)) + @assert_that(nlevels, is(NUM_LEVELS_VGRID)) end do call MAPL_InfoGetInternal(bundle, KEY_INTERPOLATION_WEIGHTS, values=weights, _RC) @assert_that(weights, is(equal_to(new_weights))) - call MAPL_InfoGetInternal(bundle, KEY_UNGRIDDED_DIMS//KEY_NUM_UNGRIDDED_DIMS, value=ndims, _RC) + call MAPL_InfoGetInternal(bundle, KEY_UNGRIDDED_DIMS // '/num_ungridded_dimensions', value=ndims, _RC) @assert_that(ndims, is(1)) call MAPL_InfoGetInternal(bundle, KEY_NUM_LEVELS, value=nlevels, _RC) - @assert_that(nlevels, is(NUM_LEVELS)) + @assert_that(nlevels, is(NUM_LEVELS_VGRID)) call teardown_bundle(bundle) call teardown_geom(geom) diff --git a/field_utils/tests/Test_FieldDelta.pf b/field_utils/tests/Test_FieldDelta.pf index 9a58684634a6..ee2588e22e55 100644 --- a/field_utils/tests/Test_FieldDelta.pf +++ b/field_utils/tests/Test_FieldDelta.pf @@ -2,14 +2,19 @@ #include "unused_dummy.H" module Test_FieldDelta use mapl3g_FieldDelta - use mapl3g_ESMF_Info_Keys + use mapl3g_FieldCreate + use mapl3g_FieldInfo + use mapl3g_UngriddedDims + use mapl3g_UngriddedDim use mapl3g_InfoUtilities + use mapl3g_VerticalStaggerLoc + use mapl3g_FieldInfo use esmf use ESMF_TestMethod_mod use funit implicit none (type, external) - integer, parameter :: ORIGINAL_NUM_LEVELS = 5 + integer, parameter :: ORIG_VGRID_LEVELS = 5 real, parameter :: FILL_VALUE = 99. character(*), parameter :: ORIGINAL_UNITS = 'm' character(*), parameter :: REFERENCE_UNITS = 'km' @@ -32,8 +37,7 @@ contains geom = ESMF_GeomCreate(grid, _RC) f = ESMF_FieldCreate(geom, typekind=ESMF_TYPEKIND_R4, name='in', _RC) - call MAPL_InfoSetInternal(f, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS, _RC) - call MAPL_InfoSetInternal(f, key=KEY_VLOC, value='VERTICAL_DIM_EDGE', _RC) + call MAPL_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) delta = FieldDelta(typekind=ESMF_TYPEKIND_R8) call delta%reallocate_field(f, _RC) @@ -65,8 +69,7 @@ contains grid = ESMF_GridCreateNoPeriDim(maxIndex=[4,4], name='I_AM_GROOT', _RC) geom = ESMF_GeomCreate(grid, _RC) f = ESMF_FieldCreate(geom, typekind=ESMF_TYPEKIND_R4, name='in', _RC) - call MAPL_InfoSetInternal(f, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS, _RC) - call MAPL_InfoSetInternal(f, key=KEY_VLOC, value='VERTICAL_DIM_EDGE', _RC) + call MAPL_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) call ESMF_FieldGet(f, fArrayPtr=x, _RC) x = FILL_VALUE @@ -105,8 +108,7 @@ contains grid1 = ESMF_GridCreateNoPeriDim(maxIndex=[4,4], name='I_AM_GROOT', _RC) geom1 = ESMF_GeomCreate(grid1, _RC) f = ESMF_FieldCreate(geom1, typekind=ESMF_TYPEKIND_R4, name='in', _RC) - call MAPL_InfoSetInternal(f, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS, _RC) - call MAPL_InfoSetInternal(f, key=KEY_VLOC, value='VERTICAL_DIM_EDGE', _RC) + call MAPL_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) grid2 = ESMF_GridCreateNoPeriDim(maxIndex=[3,5], name='I_AM_GROOT', _RC) geom2 = ESMF_GeomCreate(grid2, _RC) @@ -145,16 +147,8 @@ contains grid1 = ESMF_GridCreateNoPeriDim(maxIndex=[4,4], name='I_AM_GROOT', _RC) geom1 = ESMF_GeomCreate(grid1, _RC) f = ESMF_FieldCreate(geom1, typekind=ESMF_TYPEKIND_R4, name='in', _RC) - call MAPL_InfoSetInternal(f, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS, _RC) - call MAPL_InfoSetInternal(f, key=KEY_VLOC, value='VERTICAL_DIM_EDGE', _RC) - - call MAPL_InfoSetInternal(f, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS, _RC) - call MAPL_InfoSetInternal(f, key=KEY_VLOC, value='VERTICAL_DIM_EDGE', _RC) - - + call MAPL_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) call ESMF_FieldGet(f, fArrayPtr=x, _RC) - call MAPL_InfoSetInternal(f, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS, _RC) - call MAPL_InfoSetInternal(f, key=KEY_VLOC, value='VERTICAL_DIM_EDGE', _RC) x = FILL_VALUE geom2 = geom1 @@ -190,16 +184,16 @@ contains type(ESMF_TypeKind_Flag) :: typekind real(ESMF_KIND_R4), pointer :: x(:,:,:,:) type(FieldDelta) :: delta + integer, parameter :: NEW_NUM_LEVELS = 7 grid = ESMF_GridCreateNoPeriDim(maxIndex=[4,4], name='I_AM_GROOT', _RC) geom = ESMF_GeomCreate(grid, _RC) f = ESMF_FieldCreate(geom, typekind=ESMF_TYPEKIND_R4, name='in', & - ungriddedLbound=[1,1], ungriddedUbound=[ORIGINAL_NUM_LEVELS+1,3], _RC) - call MAPL_InfoSetInternal(f, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS, _RC) - call MAPL_InfoSetInternal(f, key=KEY_VLOC, value='VERTICAL_DIM_EDGE', _RC) + ungriddedLbound=[1,1], ungriddedUbound=[ORIG_VGRID_LEVELS+1,3], _RC) + call MAPL_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) - delta = FieldDelta(num_levels=4) + delta = FieldDelta(num_levels=NEW_NUM_LEVELS+1) ! edge call delta%reallocate_field(f, _RC) call ESMF_FieldGet(f, status=field_status, typekind=typekind, _RC) @@ -207,7 +201,7 @@ contains @assert_that(typekind == ESMF_TYPEKIND_R4, is(true())) call ESMF_FieldGet(f, fArrayPtr=x, _RC) - @assert_that(shape(x), is(equal_to([4,4,4+1,3]))) + @assert_that(shape(x), is(equal_to([4,4,NEW_NUM_LEVELS+1,3]))) call ESMF_FieldDestroy(f, _RC) call ESMF_GridDestroy(grid, _RC) @@ -237,8 +231,7 @@ contains ! Surface field f = ESMF_FieldCreate(geom, typekind=ESMF_TYPEKIND_R4, name='in', & ungriddedLbound=[1,1], ungriddedUbound=[2,3], _RC) - call MAPL_InfoSetInternal(f, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS, _RC) - call MAPL_InfoSetInternal(f, key=KEY_VLOC, value='VERTICAL_DIM_NONE', _RC) + call MAPL_FieldInfoSetInternal(f, num_levels=0, vert_staggerloc=VERTICAL_STAGGER_NONE, _RC) call ESMF_FieldGet(f, fArrayPtr=x, _RC) x = FILL_VALUE @@ -274,19 +267,19 @@ contains real(ESMF_KIND_R4), pointer :: x(:,:,:,:) type(ESMF_TypeKind_Flag) :: typekind type(FieldDelta) :: delta + type(UngriddedDims) :: ungridded_dims grid = ESMF_GridCreateNoPeriDim(maxIndex=[4,4], name='I_AM_GROOT', _RC) geom = ESMF_GeomCreate(grid, _RC) - f = ESMF_FieldCreate(geom, typekind=ESMF_TYPEKIND_R4, name='in', & - ungriddedLbound=[1,1], ungriddedUbound=[ORIGINAL_NUM_LEVELS+1,3], _RC) - call MAPL_InfoSetInternal(f, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS, _RC) - call MAPL_InfoSetInternal(f, key=KEY_VLOC, value='VERTICAL_DIM_EDGE', _RC) - + call ungridded_dims%add_dim(UngriddedDim(3)) + f = MAPL_FieldCreate(geom=geom, typekind=ESMF_TYPEKIND_R4, & + num_levels=ORIG_VGRID_LEVELS, ungridded_dims=ungridded_dims, & + vert_staggerloc=VERTICAL_STAGGER_CENTER, _RC) call ESMF_FieldGet(f, fArrayPtr=x, _RC) x = FILL_VALUE - delta = FieldDelta(num_levels=ORIGINAL_NUM_LEVELS) + delta = FieldDelta(num_levels=ORIG_VGRID_LEVELS) call delta%reallocate_field(f, _RC) call ESMF_FieldGet(f, status=field_status, typekind=typekind, geom=other_geom, _RC) @@ -327,18 +320,16 @@ contains geom_ref = ESMF_GeomCreate(grid_ref, _RC) f = ESMF_FieldCreate(geom, typekind=ESMF_TYPEKIND_R4, name='in', & - ungriddedLbound=[1,1], ungriddedUbound=[ORIGINAL_NUM_LEVELS,3], _RC) + ungriddedLbound=[1,1], ungriddedUbound=[ORIG_VGRID_LEVELS,3], _RC) f_ref = ESMF_FieldCreate(geom_ref, typekind=ESMF_TYPEKIND_R8, name='in', & - ungriddedLbound=[1,1], ungriddedUbound=[ORIGINAL_NUM_LEVELS-1,3], _RC) + ungriddedLbound=[1,1], ungriddedUbound=[ORIG_VGRID_LEVELS-1,3], _RC) - call MAPL_InfoSetInternal(f, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS, _RC) - call MAPL_InfoSetInternal(f, key=KEY_VLOC, value='VERTICAL_DIM_CENTER', _RC) - call MAPL_InfoSetInternal(f, key=KEY_UNITS, value=ORIGINAL_UNITS) + call MAPL_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS, vert_staggerloc=VERTICAL_STAGGER_CENTER, & + units=ORIGINAL_UNITS, _RC) + call MAPL_FieldInfoSetInternal(f_ref, num_levels=ORIG_VGRID_LEVELS, vert_staggerloc=VERTICAL_STAGGER_CENTER, & + units=REFERENCE_UNITS, _RC) - call MAPL_InfoSetInternal(f_ref, key=KEY_NUM_LEVELS, value=ORIGINAL_NUM_LEVELS-1, _RC) - call MAPL_InfoSetInternal(f_ref, key=KEY_VLOC, value='VERTICAL_DIM_CENTER', _RC) - call MAPL_InfoSetInternal(f_ref, key=KEY_UNITS, value=REFERENCE_UNITS) call delta%initialize(f, f_ref, _RC) call delta%update_field(f, ignore='geom', _RC) @@ -353,7 +344,7 @@ contains ! check that field shape is changed due to new num levels call ESMF_FieldGet(f, fArrayPtr=x8, _RC) - @assert_that(shape(x8),is(equal_to([4,4,ORIGINAL_NUM_LEVELS-1,3]))) + @assert_that(shape(x8),is(equal_to([4,4,ORIG_VGRID_LEVELS,3]))) call ESMF_FieldDestroy(f, _RC) call ESMF_GridDestroy(grid, _RC) diff --git a/generic3g/CMakeLists.txt b/generic3g/CMakeLists.txt index af401886f6fe..c24e88233649 100644 --- a/generic3g/CMakeLists.txt +++ b/generic3g/CMakeLists.txt @@ -55,7 +55,8 @@ endif () esma_add_library(${this} SRCS ${srcs} - DEPENDENCIES MAPL.regridder_mgr MAPL.geom_mgr MAPL.GeomIO MAPL.esmf_utils MAPL.shared MAPL.profiler MAPL.base MAPL.hconfig_utils YAFYAML::yafyaml PFLOGGER::pflogger GFTL_SHARED::gftl-shared-v2 GFTL::gftl-v2 + DEPENDENCIES MAPL.regridder_mgr MAPL.geom_mgr MAPL.GeomIO MAPL.esmf_utils MAPL.field MAPL.shared MAPL.profiler MAPL.base MAPL.hconfig_utils + PFLOGGER::pflogger GFTL_SHARED::gftl-shared-v2 GFTL::gftl-v2 TYPE SHARED ) diff --git a/generic3g/specs/DimSpec.F90 b/generic3g/specs/DimSpec.F90 deleted file mode 100644 index 3a922c2c5652..000000000000 --- a/generic3g/specs/DimSpec.F90 +++ /dev/null @@ -1,46 +0,0 @@ -module mapl3g_DimsSpec - use mapl3g_VerticalStaggerLoc - implicit none - - private - - public :: DimsSpec - type :: DimsSpec - type(VerticalStaggerLoc) :: vert_stagger_loc - integer :: halo_width - end type DimsSpec - - interface DimsSpec - module procedure new_DimsSpec_vert - module procedure new_DimsSpec_w_halo - end interface DimsSpec - -contains - - - pure function new_DimsSpec_vert(vert_stagger_loc) result(spec) - type(DimsSpec) :: spec - type(VerticalStaggerLoc) , intent(in) :: vert_stagger_loc - spec = DimsSpec(vert_stagger_loc, halo_width=0) - end function new_DimsSpec_vert - - - pure function new_DimsSpec_simple(vert_stagger_loc) result(spec) - type(DimsSpec) :: spec - type(VerticalStaggerLoc) , intent(in) :: vert_stagger_loc - spec = DimsSpec(vert_stagger_loc, halo_width=0) - end function new_DimsSpec_simple - - - pure function new_DimsSpec_w_halo(vert_stagger_loc, halo_width) result(spec) - type(DimsSpec) :: spec - type(VerticalStaggerLoc) , intent(in) :: vert_stagger_loc - integer, intent(in) :: halo_width - - spec%vert_stagger_loc = vert_stagger_loc - spec%halo_width = halo_width - - end function new_DimsSpec_w_halo - -end module mapl3g_DimsSpec - diff --git a/generic3g/specs/DimsSpec.F90 b/generic3g/specs/DimsSpec.F90 deleted file mode 100644 index a0821c532008..000000000000 --- a/generic3g/specs/DimsSpec.F90 +++ /dev/null @@ -1,61 +0,0 @@ -module mapl3g_DimsSpec - use mapl3g_UngriddedDimSpec - use mapl3g_VerticalStaggerLoc - implicit none - - private - - public :: DimsSpec - type :: DimsSpec - type(VerticalStaggerLoc) :: vert_stagger_loc - type(UngriddedDimSpec), allocatable :: ungridded_dim_specs(:) - integer :: halo_width - end type DimsSpec - - interface DimsSpec - module procedure new_DimsSpec_vert - module procedure new_DimsSpec_w_ungridded - module procedure new_DimsSpec_w_halo - end interface DimsSpec - -contains - - - pure function new_DimsSpec_vert(vert_stagger_loc) result(spec) - type(DimsSpec) :: spec - type(VerticalStaggerLoc) , intent(in) :: vert_stagger_loc - type(UngriddedDimSpec) :: no_ungridded(0) - spec = DimsSpec(vert_stagger_loc, ungridded_dim_specs=no_ungridded, halo_width=0) - end function new_DimsSpec_vert - - - pure function new_DimsSpec_simple(vert_stagger_loc) result(spec) - type(DimsSpec) :: spec - type(VerticalStaggerLoc) , intent(in) :: vert_stagger_loc - type(UngriddedDimSpec) :: no_ungridded(0) - spec = DimsSpec(vert_stagger_loc, ungridded_dim_specs=no_ungridded, halo_width=0) - end function new_DimsSpec_simple - - - pure function new_DimsSpec_w_ungridded(vert_stagger_loc, ungridded_dim_specs) result(spec) - type(DimsSpec) :: spec - type(VerticalStaggerLoc) , intent(in) :: vert_stagger_loc - type(UngriddedDimSpec), intent(in) :: ungridded_dim_specs(:) - spec = DimsSpec(vert_stagger_loc, ungridded_dim_specs, halo_width=0) - end function new_DimsSpec_w_ungridded - - - pure function new_DimsSpec_w_halo(vert_stagger_loc, ungridded_dim_specs, halo_width) result(spec) - type(DimsSpec) :: spec - type(VerticalStaggerLoc) , intent(in) :: vert_stagger_loc - type(UngriddedDimSpec), intent(in) :: ungridded_dim_specs(:) - integer, intent(in) :: halo_width - - spec%vert_stagger_loc = vert_stagger_loc - spec%ungridded_dim_specs = ungridded_dim_specs - spec%halo_width = halo_width - - end function new_DimsSpec_w_halo - -end module mapl3g_DimsSpec - diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index b07a59524ed5..db3db672466a 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -12,6 +12,7 @@ module mapl3g_FieldSpec + use mapl3g_VerticalStaggerLoc use mapl3g_StateItemSpec use mapl3g_WildcardSpec use mapl3g_UngriddedDims @@ -23,7 +24,7 @@ module mapl3g_FieldSpec use mapl3g_ActualConnectionPt use mapl_ErrorHandling use mapl_KeywordEnforcer - use mapl3g_esmf_info_keys +!# use mapl3g_esmf_info_keys use mapl3g_InfoUtilities use mapl3g_ExtensionAction use mapl3g_VerticalGrid @@ -48,6 +49,7 @@ module mapl3g_FieldSpec use gftl2_StringVector use esmf use nuopc + use mapl3g_Field_API implicit none private @@ -111,7 +113,7 @@ module mapl3g_FieldSpec procedure :: make_adapters - procedure :: set_info +!# procedure :: set_info procedure :: set_geometry end type FieldSpec @@ -256,18 +258,6 @@ subroutine set_geometry(this, geom, vertical_grid, rc) if (present(geom)) this%geom = geom if (present(vertical_grid)) this%vertical_grid = vertical_grid -!# _SET_FIELD(this, variable_spec, vertical_dim_spec) -!# _SET_FIELD(this, variable_spec, typekind) -!# _SET_FIELD(this, variable_spec, ungridded_dims) -!# _SET_FIELD(this, variable_spec, attributes) -!# _SET_ALLOCATED_FIELD(this, variable_spec, standard_name) -!# _SET_ALLOCATED_FIELD(this, variable_spec, units) -!# _SET_ALLOCATED_FIELD(this, variable_spec, default_value) -!# -!# this%regrid_param = EsmfRegridderParam() ! use default regrid method -!# regrid_method = get_regrid_method_(this%standard_name) -!# this%regrid_param = EsmfRegridderParam(regridmethod=regrid_method) - _RETURN(_SUCCESS) end subroutine set_geometry @@ -304,6 +294,10 @@ subroutine allocate(this, rc) type(ESMF_FieldStatus_Flag) :: fstatus type(LU_Bound), allocatable :: bounds(:) + integer, allocatable :: num_levels_grid + integer, allocatable :: num_levels + type(VerticalStaggerLoc) :: vert_staggerloc + _RETURN_UNLESS(this%is_active()) call ESMF_FieldGet(this%payload, status=fstatus, _RC) @@ -311,21 +305,41 @@ subroutine allocate(this, rc) call ESMF_FieldEmptySet(this%payload, this%geom, _RC) - bounds = get_ungridded_bounds(this, _RC) - call ESMF_FieldEmptyComplete(this%payload, this%typekind, & - ungriddedLBound=bounds%lower, & - ungriddedUBound=bounds%upper, & + if (allocated(this%vertical_grid)) then + num_levels_grid = this%vertical_grid%get_num_levels() + end if + + if (this%vertical_dim_spec == VERTICAL_DIM_NONE) then + vert_staggerloc = VERTICAL_STAGGER_NONE + else if (this%vertical_dim_spec == VERTICAL_DIM_EDGE) then + vert_staggerloc = VERTICAL_STAGGER_EDGE + num_levels = num_levels_grid + 1 + else if (this%vertical_dim_spec == VERTICAL_DIM_CENTER) then + vert_staggerloc = VERTICAL_STAGGER_CENTER + num_levels = num_levels_grid + else + _FAIL('unknown stagger') + end if + + call MAPL_FieldEmptyComplete(this%payload, & + typekind=this%typekind, & + ungridded_dims=this%ungridded_dims, & + num_levels=num_levels, & + vert_staggerLoc=vert_staggerLoc, & + units=this%units, & + standard_name=this%standard_name, & + long_name=this%long_name, & _RC) - call ESMF_FieldGet(this%payload, status=fstatus, _RC) + + bounds = get_ungridded_bounds(this, _RC) call ESMF_FieldGet(this%payload, status=fstatus, _RC) _ASSERT(fstatus == ESMF_FIELDSTATUS_COMPLETE, 'ESMF field status problem.') + if (allocated(this%default_value)) then call FieldSet(this%payload, this%default_value, _RC) end if - call this%set_info(this%payload, _RC) - _RETURN(ESMF_SUCCESS) end subroutine allocate @@ -737,45 +751,6 @@ function get_payload(this) result(payload) payload = this%payload end function get_payload - subroutine set_info(this, field, rc) - class(FieldSpec), intent(in) :: this - type(ESMF_Field), intent(inout) :: field - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: ungridded_dims_info - type(ESMF_Info) :: vertical_dim_info - type(ESMF_Info) :: vertical_grid_info - - type(ESMF_Info) :: field_info - - call ESMF_InfoGetFromHost(field, field_info, _RC) - - ungridded_dims_info = this%ungridded_dims%make_info(_RC) - call ESMF_InfoSet(field_info, key=INFO_INTERNAL_NAMESPACE//KEY_UNGRIDDED_DIMS, value=ungridded_dims_info, _RC) - call ESMF_InfoDestroy(ungridded_dims_info, _RC) - - vertical_dim_info = this%vertical_dim_spec%make_info(_RC) - call ESMF_InfoSet(field_info, key=INFO_INTERNAL_NAMESPACE//KEY_VERT_DIM, value=vertical_dim_info, _RC) - call ESMF_InfoDestroy(vertical_dim_info, _RC) - - vertical_grid_info = this%vertical_grid%make_info(_RC) - call ESMF_InfoSet(field_info, key=INFO_INTERNAL_NAMESPACE//KEY_VERT_GRID, value=vertical_grid_info, _RC) - call ESMF_InfoDestroy(vertical_grid_info, _RC) - - if (allocated(this%units)) then - call MAPL_InfoSetInternal(field,key='/units', value= this%units, _RC) - end if - if (allocated(this%long_name)) then - call MAPL_InfoSetInternal(field,key='/long_name', value=this%long_name, _RC) - end if - if (allocated(this%standard_name)) then - call MAPL_InfoSetInternal(field,key='/standard_name', value=this%standard_name, _RC) - end if - - _RETURN(_SUCCESS) - end subroutine set_info - function new_GeomAdapter(geom, regrid_param) result(geom_adapter) type(GeomAdapter) :: geom_adapter type(ESMF_Geom), optional, intent(in) :: geom diff --git a/generic3g/tests/CMakeLists.txt b/generic3g/tests/CMakeLists.txt index d3f2a6712d92..30f5543285bd 100644 --- a/generic3g/tests/CMakeLists.txt +++ b/generic3g/tests/CMakeLists.txt @@ -27,7 +27,6 @@ set (test_srcs Test_WriteYaml.pf Test_HConfigMatch.pf - Test_FieldInfo.pf Test_GenericGridComp.pf Test_TimeInterpolateAction.pf diff --git a/generic3g/tests/Test_AddFieldSpec.pf b/generic3g/tests/Test_AddFieldSpec.pf index 22696a416d8c..cf4809a69d81 100644 --- a/generic3g/tests/Test_AddFieldSpec.pf +++ b/generic3g/tests/Test_AddFieldSpec.pf @@ -1,5 +1,6 @@ module Test_AddFieldSpec use funit + use mapl3g_VerticalStaggerLoc, only: VerticalStaggerLoc use mapl3g_UngriddedDims, only: UngriddedDims use mapl3g_FieldSpec, only: FieldSpec use mapl3g_StateSpec, only: StateSpec diff --git a/generic3g/tests/Test_FieldInfo.pf b/generic3g/tests/Test_FieldInfo.pf deleted file mode 100644 index 46823cec916c..000000000000 --- a/generic3g/tests/Test_FieldInfo.pf +++ /dev/null @@ -1,102 +0,0 @@ -#include "MAPL_TestErr.h" -module Test_FieldInfo - use mapl3g_FieldSpec - use mapl3g_VerticalDimSpec - use mapl3g_BasicVerticalGrid - use mapl3g_UngriddedDims - use mapl3g_UngriddedDim - use mapl3g_esmf_info_keys - use mapl3g_InfoUtilities - use esmf - use funit - implicit none - -contains - - @test - subroutine test_field_set_info - type(FieldSpec) :: spec - type(ESMF_Geom) :: geom - type(ESMF_Grid) :: grid - type(BasicVerticalGrid) :: vertical_grid - type(ESMF_Field) :: f - type(ESMF_Info) :: info - type(UngriddedDims) :: ungridded_dims - integer :: status - logical :: found - real, allocatable :: coords(:) - character(len=:), allocatable :: temp_string - integer :: temp_int - - grid = ESMF_GridCreateNoPeriDim(maxIndex=[4,4], name='I_AM_GROOT', _RC) - geom = ESMF_GeomCreate(grid, _RC) - vertical_grid = BasicVerticalGrid(4) - - call ungridded_dims%add_dim(UngriddedDim([1.,2.], name='a', units='m')) - call ungridded_dims%add_dim(UngriddedDim([1.,2.,3.], name='b', units='s')) - - spec = FieldSpec(geom=geom, vertical_grid=vertical_grid, & - vertical_dim_spec=VERTICAL_DIM_CENTER, & - typekind=ESMF_TYPEKIND_R4, ungridded_dims=ungridded_dims, & - standard_name='t', long_name='p', units='unknown') - - f = ESMF_FieldCreate(geom, ESMF_TYPEKIND_R4, ungriddedLbound=[1,1], ungriddedUbound=[2,3], _RC) - call spec%set_info(f, _RC) - - info = MAPL_InfoCreateFromInternal(f, _RC) - - found = ESMF_InfoIsPresent(info, key=KEY_VERT_DIM, _RC) - @assert_that(found, is(true())) - found = ESMF_InfoIsPresent(info, key=KEY_VLOC, _RC) - @assert_that(found, is(true())) - - found = ESMF_InfoIsPresent(info, key=KEY_VERT_GRID, _RC) - @assert_that(found, is(true())) - found = ESMF_InfoIsPresent(info, key=KEY_NUM_LEVELS, _RC) - @assert_that(found, is(true())) - call MAPL_InfoGet(info, KEY_NUM_LEVELS, temp_int, _RC) - @assert_that(temp_int, equal_to(4)) - - found = ESMF_InfoIsPresent(info, key=KEY_UNGRIDDED_DIMS, _RC) - @assert_that(found, is(true())) - - found = ESMF_InfoIsPresent(info, key=KEY_UNGRIDDED_DIMS//'/dim_1', _RC) - @assert_that(found, is(true())) - found = ESMF_InfoIsPresent(info, key=KEY_UNGRIDDED_DIMS//'/dim_1/name', _RC) - @assert_that(found, is(true())) - found = ESMF_InfoIsPresent(info, key=KEY_UNGRIDDED_DIMS//'/dim_1/units', _RC) - @assert_that(found, is(true())) - found = ESMF_InfoIsPresent(info, key=KEY_UNGRIDDED_DIMS//'/dim_1/coordinates', _RC) - @assert_that(found, is(true())) - call MAPL_InfoGet(info, KEY_UNGRIDDED_DIMS//'/dim_1/coordinates', coords, _RC) - @assert_that(coords, equal_to([1.,2.])) - - found = ESMF_InfoIsPresent(info, key=KEY_UNGRIDDED_DIMS//'/dim_2', _RC) - @assert_that(found, is(true())) - found = ESMF_InfoIsPresent(info, key=KEY_UNGRIDDED_DIMS//'/dim_2/name', _RC) - @assert_that(found, is(true())) - found = ESMF_InfoIsPresent(info, key=KEY_UNGRIDDED_DIMS//'/dim_2/units', _RC) - @assert_that(found, is(true())) - found = ESMF_InfoIsPresent(info, key=KEY_UNGRIDDED_DIMS//'/dim_2/coordinates', _RC) - @assert_that(found, is(true())) - call MAPL_InfoGet(info, KEY_UNGRIDDED_DIMS//'/dim_2/coordinates', coords, _RC) - @assert_that(coords, equal_to([1.,2.,3.])) - - found = ESMF_InfoIsPresent(info, key='/standard_name', _RC) - @assert_that(found, is(true())) - call MAPL_InfoGet(info, '/standard_name', temp_string, _RC) - @assert_that(temp_string, equal_to("t")) - - found = ESMF_InfoIsPresent(info, key='/long_name', _RC) - @assert_that(found, is(true())) - call MAPL_InfoGet(info, '/long_name', temp_string, _RC) - @assert_that(temp_string, equal_to("p")) - - found = ESMF_InfoIsPresent(info, key='/units', _RC) - @assert_that(found, is(true())) - call MAPL_InfoGet(info, '/units', temp_string, _RC) - @assert_that(temp_string, equal_to("unknown")) - - call ESMF_InfoDestroy(info) - end subroutine test_field_set_info -end module Test_FieldInfo From 90755f069e675f278386e957cbabe98dd8c271d3 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Mon, 4 Nov 2024 09:26:59 -0500 Subject: [PATCH 2/7] Missed items that are only tested in gridcomps --- esmf_utils/FieldDimensionInfo.F90 | 13 ++++++++++--- shared/MAPL_ESMF_InfoKeys.F90 | 3 +++ 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/esmf_utils/FieldDimensionInfo.F90 b/esmf_utils/FieldDimensionInfo.F90 index 84d537e251cb..6d4f31a4dd70 100644 --- a/esmf_utils/FieldDimensionInfo.F90 +++ b/esmf_utils/FieldDimensionInfo.F90 @@ -93,11 +93,18 @@ integer function get_num_levels_info(info, rc) result(num) integer, optional, intent(out) :: rc integer :: status character(len=:), allocatable :: spec_name + integer :: num_field_levels num = 0 spec_name = get_vertical_dim_spec_info(info, _RC) - _RETURN_IF(spec_name == VERT_DIM_NONE) - call MAPL_InfoGet(info, key=KEY_NUM_LEVELS, value=num, _RC) + _RETURN_IF(spec_name == "VERTICAL_STAGGER_NONE") + call MAPL_InfoGet(info, key=KEY_NUM_LEVELS, value=num_field_levels, _RC) + + if (spec_name == "VERTICAL_STAGGER_EDGE") then + num = num_field_levels - 1 + else + num = num_field_levels + end if _RETURN(_SUCCESS) end function get_num_levels_info @@ -153,7 +160,7 @@ function get_vertical_dim_spec_info(info, rc) result(spec_name) integer :: status logical :: isPresent - call MAPL_InfoGet(info, key=KEY_VLOC, value=spec_name, _RC) + call MAPL_InfoGet(info, key=KEY_VERT_STAGGERLOC, value=spec_name, _RC) isPresent = ESMF_InfoIsPresent(info, key=KEY_VLOC, _RC) _RETURN(_SUCCESS) diff --git a/shared/MAPL_ESMF_InfoKeys.F90 b/shared/MAPL_ESMF_InfoKeys.F90 index b27657914fd9..c938e88b4162 100644 --- a/shared/MAPL_ESMF_InfoKeys.F90 +++ b/shared/MAPL_ESMF_InfoKeys.F90 @@ -25,6 +25,7 @@ module mapl3g_esmf_info_keys public :: KEY_UNGRIDDED_COORD public :: KEY_DIM_STRINGS public :: make_dim_key + public :: KEY_VERT_STAGGERLOC private ! FieldSpec info keys @@ -47,6 +48,8 @@ module mapl3g_esmf_info_keys ! VerticalDimSpec info keys character(len=*), parameter :: KEY_VLOC = KEY_VERT_DIM // '/vloc' + character(len=*), parameter :: KEY_VERT_STAGGERLOC = "/vert_staggerloc" + ! UngriddedDims info keys character(len=*), parameter :: KEY_NUM_UNGRIDDED_DIMS = '/num_ungridded_dimensions' From 4b9e9cf503e8968678bd573464d6d3fa526c14cb Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Mon, 4 Nov 2024 10:12:30 -0500 Subject: [PATCH 3/7] One more fix --- esmf_utils/tests/Test_FieldDimensionInfo.pf | 43 ++++++++------------- 1 file changed, 16 insertions(+), 27 deletions(-) diff --git a/esmf_utils/tests/Test_FieldDimensionInfo.pf b/esmf_utils/tests/Test_FieldDimensionInfo.pf index c3388f6af2f7..1f6a7273a050 100644 --- a/esmf_utils/tests/Test_FieldDimensionInfo.pf +++ b/esmf_utils/tests/Test_FieldDimensionInfo.pf @@ -17,7 +17,7 @@ module Test_FieldDimensionInfo implicit none integer, parameter :: NUM_LEVELS_DEFAULT = 3 - character(len=*), parameter :: VLOC_DEFAULT = 'VERTICAL_DIM_CENTER' + character(len=*), parameter :: VERT_STAGGER_DEFAULT = 'VERTICAL_STAGGER_CENTER' character(len=*), parameter :: NAME_DEFAULT = 'A1' character(len=*), parameter :: UNITS_DEFAULT = 'stones' real, parameter :: COORDINATES_DEFAULT(*) = [2.0, 2.4, 2.5] @@ -48,16 +48,16 @@ contains @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' + character(len=*), parameter :: EXPECTED_NAME_1 = 'VERTICAL_STAGGER_CENTER' + character(len=*), parameter :: EXPECTED_NAME_2 = 'VERTICAL_STAGGER_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) + bundle_info(1) = make_esmf_info(vert_stagger=EXPECTED_NAME_1, _RC) + bundle_info(2) = make_esmf_info(vert_stagger=EXPECTED_NAME_2, _RC) + bundle_info(3) = make_esmf_info(vert_stagger=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.') @@ -107,11 +107,11 @@ contains end subroutine test_get_ungridded_dims - function make_esmf_info(num_levels, vloc, num_ungridded, names, units_array, coordinates, rc) & + function make_esmf_info(num_levels, vert_stagger, 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 + character(len=*), optional, intent(in) :: vert_stagger integer, optional, intent(in) :: num_ungridded character(len=*), optional, intent(in) :: names(:) character(len=*), optional, intent(in) :: units_array(:) @@ -119,16 +119,16 @@ contains integer, optional, intent(out) :: rc integer :: status integer :: num_levels_, num_ungridded_ - character(len=:), allocatable :: vloc_ + character(len=:), allocatable :: vert_stagger_ num_ungridded_ = -1 num_levels_ = NUM_LEVELS_DEFAULT if(present(num_levels)) num_levels_ = num_levels - vloc_ = VLOC_DEFAULT - if(present(vloc)) vloc_ = vloc + vert_stagger_ = VERT_STAGGER_DEFAULT + if(present(vert_stagger)) vert_stagger_ = vert_stagger info = ESMF_InfoCreate(_RC) - call make_vertical_dim(info, vloc_, _RC) - call make_vertical_geom(info, num_levels_, _RC) + call make_vertical_dim(info, vert_stagger_, _RC) + call ESMF_InfoSet(info, KEY_NUM_LEVELS, num_levels_, _RC) SET_RC(status) @@ -145,28 +145,17 @@ contains end function make_esmf_info - subroutine make_vertical_dim(info, vloc, rc) + subroutine make_vertical_dim(info, vert_stagger, rc) type(ESMF_Info), intent(inout) :: info - character(len=*), intent(in) :: vloc + character(len=*), intent(in) :: vert_stagger integer, optional, intent(out) :: rc integer :: status - call ESMF_InfoSet(info, KEY_VLOC, vloc, _RC) + call ESMF_InfoSet(info, KEY_VERT_STAGGERLOC, vert_stagger, _RC) SET_RC(status) 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(status) - - 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 From 4c6ced247fc0e250e69c42263a2e3db6a01ed13a Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Mon, 4 Nov 2024 08:54:40 -0500 Subject: [PATCH 4/7] Fixes #3146 Merged field_utils into field --- CMakeLists.txt | 1 - MAPL/CMakeLists.txt | 2 +- base/CMakeLists.txt | 2 +- field/CMakeLists.txt | 18 ++++++- {field_utils => field}/EsmfRegridder.F90 | 0 {field_utils => field}/FieldBLAS.F90 | 0 .../FieldBinaryOperations.F90 | 0 .../FieldBinaryOperatorTemplate.H | 0 {field_utils => field}/FieldBundleDelta.F90 | 0 .../FieldCondensedArray.F90 | 0 .../FieldCondensedArray_private.F90 | 0 {field_utils => field}/FieldDelta.F90 | 0 .../FieldPointerUtilities.F90 | 0 .../FieldUnaryFunctionTemplate.H | 0 .../FieldUnaryFunctions.F90 | 0 {field_utils => field}/FieldUnits.F90 | 0 {field_utils => field}/FieldUtilities.F90 | 0 {field_utils => field}/FieldUtils.F90 | 0 .../function_overload.macro | 0 field/tests/CMakeLists.txt | 11 ++++- .../tests/Test_FieldArithmetic.pf | 0 .../tests/Test_FieldBLAS.pf | 0 .../tests/Test_FieldBundleDelta.pf | 0 .../tests/Test_FieldCondensedArray_private.pf | 0 .../tests/Test_FieldDelta.pf | 0 .../tests/field_utils_setup.F90 | 0 .../undo_function_overload.macro | 0 field_utils/CMakeLists.txt | 49 ------------------- field_utils/tests/CMakeLists.txt | 32 ------------ generic3g/CMakeLists.txt | 3 +- geom_mgr/CMakeLists.txt | 2 +- mapl3g/CMakeLists.txt | 2 +- pfunit/CMakeLists.txt | 2 +- regridder_mgr/CMakeLists.txt | 2 +- 34 files changed, 34 insertions(+), 92 deletions(-) rename {field_utils => field}/EsmfRegridder.F90 (100%) rename {field_utils => field}/FieldBLAS.F90 (100%) rename {field_utils => field}/FieldBinaryOperations.F90 (100%) rename {field_utils => field}/FieldBinaryOperatorTemplate.H (100%) rename {field_utils => field}/FieldBundleDelta.F90 (100%) rename {field_utils => field}/FieldCondensedArray.F90 (100%) rename {field_utils => field}/FieldCondensedArray_private.F90 (100%) rename {field_utils => field}/FieldDelta.F90 (100%) rename {field_utils => field}/FieldPointerUtilities.F90 (100%) rename {field_utils => field}/FieldUnaryFunctionTemplate.H (100%) rename {field_utils => field}/FieldUnaryFunctions.F90 (100%) rename {field_utils => field}/FieldUnits.F90 (100%) rename {field_utils => field}/FieldUtilities.F90 (100%) rename {field_utils => field}/FieldUtils.F90 (100%) rename {field_utils => field}/function_overload.macro (100%) rename {field_utils => field}/tests/Test_FieldArithmetic.pf (100%) rename {field_utils => field}/tests/Test_FieldBLAS.pf (100%) rename {field_utils => field}/tests/Test_FieldBundleDelta.pf (100%) rename {field_utils => field}/tests/Test_FieldCondensedArray_private.pf (100%) rename {field_utils => field}/tests/Test_FieldDelta.pf (100%) rename {field_utils => field}/tests/field_utils_setup.F90 (100%) rename {field_utils => field}/undo_function_overload.macro (100%) delete mode 100644 field_utils/CMakeLists.txt delete mode 100644 field_utils/tests/CMakeLists.txt diff --git a/CMakeLists.txt b/CMakeLists.txt index 7acc9357b46e..0b6fde400116 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -210,7 +210,6 @@ add_subdirectory (pfio) add_subdirectory (profiler) add_subdirectory (generic) add_subdirectory (generic3g) -add_subdirectory (field_utils) add_subdirectory (field) add_subdirectory (oomph) # temporary - will rename to generic when done add_subdirectory (shared) diff --git a/MAPL/CMakeLists.txt b/MAPL/CMakeLists.txt index 89cf1671c2ad..ee4ff2a79f4f 100644 --- a/MAPL/CMakeLists.txt +++ b/MAPL/CMakeLists.txt @@ -3,7 +3,7 @@ esma_set_this() esma_add_library (${this} SRCS MAPL.F90 - DEPENDENCIES MAPL.base MAPL.generic MAPL.pfio MAPL_cfio_r4 MAPL.gridcomps MAPL.orbit MAPL.griddedio MAPL.field_utils ${EXTDATA_TARGET} + DEPENDENCIES MAPL.base MAPL.generic MAPL.pfio MAPL_cfio_r4 MAPL.gridcomps MAPL.orbit MAPL.griddedio MAPL.field ${EXTDATA_TARGET} ESMF::ESMF NetCDF::NetCDF_Fortran MPI::MPI_Fortran TYPE SHARED ) diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index 8da90b1e4cb4..9151b3678248 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -67,7 +67,7 @@ endif() esma_add_library( ${this} SRCS ${srcs} - DEPENDENCIES MAPL.shared MAPL.constants MAPL.profiler MAPL.pfio MAPL_cfio_r4 MAPL.field_utils PFLOGGER::pflogger + DEPENDENCIES MAPL.shared MAPL.constants MAPL.profiler MAPL.pfio MAPL_cfio_r4 MAPL.field PFLOGGER::pflogger GFTL_SHARED::gftl-shared-v2 GFTL_SHARED::gftl-shared-v1 GFTL::gftl-v2 GFTL::gftl-v1 ESMF::ESMF NetCDF::NetCDF_Fortran MPI::MPI_Fortran TYPE SHARED) diff --git a/field/CMakeLists.txt b/field/CMakeLists.txt index bf44a397a48a..3de315fea60c 100644 --- a/field/CMakeLists.txt +++ b/field/CMakeLists.txt @@ -2,6 +2,18 @@ esma_set_this (OVERRIDE MAPL.field) set(srcs API.F90 + FieldUtils.F90 + FieldBLAS.F90 + FieldPointerUtilities.F90 + FieldDelta.F90 + FieldUtilities.F90 + FieldUnaryFunctions.F90 + FieldBinaryOperations.F90 + FieldUnits.F90 + FieldCondensedArray.F90 + FieldCondensedArray_private.F90 + FieldDelta.F90 + FieldBundleDelta.F90 VerticalStaggerLoc.F90 FieldCreate.F90 FieldReset.F90 @@ -11,9 +23,13 @@ set(srcs list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}") +if (BUILD_WITH_PFLOGGER) + find_package (PFLOGGER REQUIRED) +endif () + esma_add_library(${this} SRCS ${srcs} - DEPENDENCIES MAPL.shared MAPL.esmf_utils ESMF::ESMF + DEPENDENCIES MAPL.shared MAPL.esmf_utils PFLOGGER::pflogger ESMF::ESMF udunits2f TYPE SHARED ) diff --git a/field_utils/EsmfRegridder.F90 b/field/EsmfRegridder.F90 similarity index 100% rename from field_utils/EsmfRegridder.F90 rename to field/EsmfRegridder.F90 diff --git a/field_utils/FieldBLAS.F90 b/field/FieldBLAS.F90 similarity index 100% rename from field_utils/FieldBLAS.F90 rename to field/FieldBLAS.F90 diff --git a/field_utils/FieldBinaryOperations.F90 b/field/FieldBinaryOperations.F90 similarity index 100% rename from field_utils/FieldBinaryOperations.F90 rename to field/FieldBinaryOperations.F90 diff --git a/field_utils/FieldBinaryOperatorTemplate.H b/field/FieldBinaryOperatorTemplate.H similarity index 100% rename from field_utils/FieldBinaryOperatorTemplate.H rename to field/FieldBinaryOperatorTemplate.H diff --git a/field_utils/FieldBundleDelta.F90 b/field/FieldBundleDelta.F90 similarity index 100% rename from field_utils/FieldBundleDelta.F90 rename to field/FieldBundleDelta.F90 diff --git a/field_utils/FieldCondensedArray.F90 b/field/FieldCondensedArray.F90 similarity index 100% rename from field_utils/FieldCondensedArray.F90 rename to field/FieldCondensedArray.F90 diff --git a/field_utils/FieldCondensedArray_private.F90 b/field/FieldCondensedArray_private.F90 similarity index 100% rename from field_utils/FieldCondensedArray_private.F90 rename to field/FieldCondensedArray_private.F90 diff --git a/field_utils/FieldDelta.F90 b/field/FieldDelta.F90 similarity index 100% rename from field_utils/FieldDelta.F90 rename to field/FieldDelta.F90 diff --git a/field_utils/FieldPointerUtilities.F90 b/field/FieldPointerUtilities.F90 similarity index 100% rename from field_utils/FieldPointerUtilities.F90 rename to field/FieldPointerUtilities.F90 diff --git a/field_utils/FieldUnaryFunctionTemplate.H b/field/FieldUnaryFunctionTemplate.H similarity index 100% rename from field_utils/FieldUnaryFunctionTemplate.H rename to field/FieldUnaryFunctionTemplate.H diff --git a/field_utils/FieldUnaryFunctions.F90 b/field/FieldUnaryFunctions.F90 similarity index 100% rename from field_utils/FieldUnaryFunctions.F90 rename to field/FieldUnaryFunctions.F90 diff --git a/field_utils/FieldUnits.F90 b/field/FieldUnits.F90 similarity index 100% rename from field_utils/FieldUnits.F90 rename to field/FieldUnits.F90 diff --git a/field_utils/FieldUtilities.F90 b/field/FieldUtilities.F90 similarity index 100% rename from field_utils/FieldUtilities.F90 rename to field/FieldUtilities.F90 diff --git a/field_utils/FieldUtils.F90 b/field/FieldUtils.F90 similarity index 100% rename from field_utils/FieldUtils.F90 rename to field/FieldUtils.F90 diff --git a/field_utils/function_overload.macro b/field/function_overload.macro similarity index 100% rename from field_utils/function_overload.macro rename to field/function_overload.macro diff --git a/field/tests/CMakeLists.txt b/field/tests/CMakeLists.txt index 4385e7022569..de6b38980859 100644 --- a/field/tests/CMakeLists.txt +++ b/field/tests/CMakeLists.txt @@ -16,4 +16,13 @@ add_pfunit_ctest(MAPL.field.test_fieldreset MAX_PES 1 ) -add_dependencies(build-tests MAPL.field.test_fieldcreate) +add_pfunit_ctest(MAPL.field.test_utils + TEST_SOURCES Test_FieldBLAS.pf Test_FieldArithmetic.pf Test_FieldCondensedArray_private.pf + Test_FieldDelta.pf Test_FieldBundleDelta.pf + LINK_LIBRARIES MAPL.pfunit + EXTRA_INITIALIZE Initialize + EXTRA_USE MAPL_pFUnit_Initialize + OTHER_SOURCES field_utils_setup.F90 + MAX_PES 4 + ) +add_dependencies(build-tests MAPL.field.test_fieldcreate MAPL.field.test_fieldreset MAPL.field.test_utils) diff --git a/field_utils/tests/Test_FieldArithmetic.pf b/field/tests/Test_FieldArithmetic.pf similarity index 100% rename from field_utils/tests/Test_FieldArithmetic.pf rename to field/tests/Test_FieldArithmetic.pf diff --git a/field_utils/tests/Test_FieldBLAS.pf b/field/tests/Test_FieldBLAS.pf similarity index 100% rename from field_utils/tests/Test_FieldBLAS.pf rename to field/tests/Test_FieldBLAS.pf diff --git a/field_utils/tests/Test_FieldBundleDelta.pf b/field/tests/Test_FieldBundleDelta.pf similarity index 100% rename from field_utils/tests/Test_FieldBundleDelta.pf rename to field/tests/Test_FieldBundleDelta.pf diff --git a/field_utils/tests/Test_FieldCondensedArray_private.pf b/field/tests/Test_FieldCondensedArray_private.pf similarity index 100% rename from field_utils/tests/Test_FieldCondensedArray_private.pf rename to field/tests/Test_FieldCondensedArray_private.pf diff --git a/field_utils/tests/Test_FieldDelta.pf b/field/tests/Test_FieldDelta.pf similarity index 100% rename from field_utils/tests/Test_FieldDelta.pf rename to field/tests/Test_FieldDelta.pf diff --git a/field_utils/tests/field_utils_setup.F90 b/field/tests/field_utils_setup.F90 similarity index 100% rename from field_utils/tests/field_utils_setup.F90 rename to field/tests/field_utils_setup.F90 diff --git a/field_utils/undo_function_overload.macro b/field/undo_function_overload.macro similarity index 100% rename from field_utils/undo_function_overload.macro rename to field/undo_function_overload.macro diff --git a/field_utils/CMakeLists.txt b/field_utils/CMakeLists.txt deleted file mode 100644 index e8627b2604e1..000000000000 --- a/field_utils/CMakeLists.txt +++ /dev/null @@ -1,49 +0,0 @@ -esma_set_this (OVERRIDE MAPL.field_utils) - -set(srcs - FieldUtils.F90 - FieldBLAS.F90 - FieldPointerUtilities.F90 - FieldDelta.F90 - FieldUtilities.F90 - FieldUnaryFunctions.F90 - FieldBinaryOperations.F90 - FieldUnits.F90 - FieldCondensedArray.F90 - FieldCondensedArray_private.F90 - FieldDelta.F90 - FieldBundleDelta.F90 - ) - -# To use extended udunits2 procedures, udunits2.c must be built and linked. - -# Workaround for strict NAG Fortran with ESMF implicit interface for private state. -#set_property( SOURCE InnerMetaComponent.F90 OuterMetaComponent.F90 -# PROPERTY COMPILE_FLAGS ${MISMATCH}) - -list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}") - -if (BUILD_WITH_PFLOGGER) - find_package (PFLOGGER REQUIRED) -endif () - -esma_add_library(${this} - SRCS ${srcs} - DEPENDENCIES MAPL.field MAPL.shared MAPL.esmf_utils PFLOGGER::pflogger udunits2f - TYPE SHARED - ) - #DEPENDENCIES MAPL.shared PFLOGGER::pflogger udunits2f - -#add_subdirectory(specs) -#add_subdirectory(registry) -#add_subdirectory(connection_pt) - -target_include_directories (${this} PUBLIC - $) -target_link_libraries (${this} PUBLIC ESMF::ESMF) - -if (PFUNIT_FOUND) - # Turning off until test with GNU can be fixed - add_subdirectory(tests EXCLUDE_FROM_ALL) -endif () - diff --git a/field_utils/tests/CMakeLists.txt b/field_utils/tests/CMakeLists.txt deleted file mode 100644 index acf2e9837803..000000000000 --- a/field_utils/tests/CMakeLists.txt +++ /dev/null @@ -1,32 +0,0 @@ -set(MODULE_DIRECTORY "${esma_include}/MAPL.field_utils.tests") - -# Test_udunits2private.pf tests udunits2 private procedures -set (test_srcs - Test_FieldBLAS.pf - Test_FieldArithmetic.pf - Test_FieldCondensedArray_private.pf - Test_FieldDelta.pf - Test_FieldBundleDelta.pf - ) - - -add_pfunit_ctest(MAPL.field_utils.tests - TEST_SOURCES ${test_srcs} - LINK_LIBRARIES MAPL.field_utils MAPL.pfunit - EXTRA_INITIALIZE Initialize - EXTRA_USE MAPL_pFUnit_Initialize - OTHER_SOURCES field_utils_setup.F90 - MAX_PES 4 - ) -set_target_properties(MAPL.field_utils.tests PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) -set_tests_properties(MAPL.field_utils.tests PROPERTIES LABELS "ESSENTIAL") - -if (APPLE) - set(LD_PATH "DYLD_LIBRARY_PATH") -else() - set(LD_PATH "LD_LIBRARY_PATH") -endif () -set_property(TEST MAPL.field_utils.tests PROPERTY ENVIRONMENT "${LD_PATH}=${CMAKE_CURRENT_BINARY_DIR}/field_utils:$ENV{${LD_PATH}}") - -add_dependencies(build-tests MAPL.field_utils.tests) - diff --git a/generic3g/CMakeLists.txt b/generic3g/CMakeLists.txt index c24e88233649..b2f4b6a1662b 100644 --- a/generic3g/CMakeLists.txt +++ b/generic3g/CMakeLists.txt @@ -56,7 +56,7 @@ endif () esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL.regridder_mgr MAPL.geom_mgr MAPL.GeomIO MAPL.esmf_utils MAPL.field MAPL.shared MAPL.profiler MAPL.base MAPL.hconfig_utils - PFLOGGER::pflogger GFTL_SHARED::gftl-shared-v2 GFTL::gftl-v2 + ESMF::ESMF NetCDF::NetCDF_Fortran udunits2f PFLOGGER::pflogger GFTL_SHARED::gftl-shared-v2 GFTL::gftl-v2 TYPE SHARED ) @@ -108,7 +108,6 @@ esma_add_fortran_submodules( target_include_directories (${this} PUBLIC $) -target_link_libraries (${this} PUBLIC udunits2f MAPL.field_utils ESMF::ESMF NetCDF::NetCDF_Fortran) if (PFUNIT_FOUND) add_subdirectory(tests EXCLUDE_FROM_ALL) diff --git a/geom_mgr/CMakeLists.txt b/geom_mgr/CMakeLists.txt index 383b977d6449..fb945c994449 100644 --- a/geom_mgr/CMakeLists.txt +++ b/geom_mgr/CMakeLists.txt @@ -24,7 +24,7 @@ set(srcs esma_add_library(${this} SRCS ${srcs} - DEPENDENCIES MAPL.pfio MAPL.base MAPL.shared MAPL.field_utils MAPL.hconfig_utils GFTL::gftl-v2 + DEPENDENCIES MAPL.pfio MAPL.base MAPL.shared MAPL.hconfig_utils GFTL::gftl-v2 TYPE SHARED ) diff --git a/mapl3g/CMakeLists.txt b/mapl3g/CMakeLists.txt index a8de27c0f780..41cc713491cf 100644 --- a/mapl3g/CMakeLists.txt +++ b/mapl3g/CMakeLists.txt @@ -7,7 +7,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} - DEPENDENCIES MAPL.generic3g MAPL.pfio MAPL.cap3g MAPL.gridcomps MAPL.griddedio MAPL.field_utils ${EXTDATA_TARGET} + DEPENDENCIES MAPL.generic3g MAPL.pfio MAPL.cap3g MAPL.gridcomps MAPL.griddedio MAPL.field ${EXTDATA_TARGET} ESMF::ESMF NetCDF::NetCDF_Fortran MPI::MPI_Fortran PFLOGGER::pflogger TYPE SHARED ) diff --git a/pfunit/CMakeLists.txt b/pfunit/CMakeLists.txt index 77e4cff4377e..d6aa5be1f53c 100644 --- a/pfunit/CMakeLists.txt +++ b/pfunit/CMakeLists.txt @@ -10,5 +10,5 @@ set (srcs esma_add_library (${this} EXCLUDE_FROM_ALL SRCS ${srcs} NOINSTALL TYPE SHARED) -target_link_libraries (${this} MAPL.shared MAPL.field_utils PFUNIT::pfunit ESMF::ESMF NetCDF::NetCDF_Fortran) +target_link_libraries (${this} MAPL.shared PFUNIT::pfunit ESMF::ESMF NetCDF::NetCDF_Fortran udunits2f) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/regridder_mgr/CMakeLists.txt b/regridder_mgr/CMakeLists.txt index f74021a507d4..e98364b0ea3a 100644 --- a/regridder_mgr/CMakeLists.txt +++ b/regridder_mgr/CMakeLists.txt @@ -29,7 +29,7 @@ set(srcs esma_add_library(${this} SRCS ${srcs} - DEPENDENCIES MAPL.geom_mgr MAPL.pfio MAPL.base MAPL.shared MAPL.field_utils GFTL::gftl-v2 + DEPENDENCIES MAPL.geom_mgr MAPL.pfio MAPL.base MAPL.shared GFTL::gftl-v2 TYPE SHARED ) From 6dbf25718e271f7aab9893972db77196937e02b9 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Mon, 4 Nov 2024 11:26:46 -0500 Subject: [PATCH 5/7] Missing dependency. --- field/tests/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/field/tests/CMakeLists.txt b/field/tests/CMakeLists.txt index de6b38980859..2af91a09e700 100644 --- a/field/tests/CMakeLists.txt +++ b/field/tests/CMakeLists.txt @@ -19,7 +19,7 @@ add_pfunit_ctest(MAPL.field.test_fieldreset add_pfunit_ctest(MAPL.field.test_utils TEST_SOURCES Test_FieldBLAS.pf Test_FieldArithmetic.pf Test_FieldCondensedArray_private.pf Test_FieldDelta.pf Test_FieldBundleDelta.pf - LINK_LIBRARIES MAPL.pfunit + LINK_LIBRARIES MAPL.field MAPL.pfunit EXTRA_INITIALIZE Initialize EXTRA_USE MAPL_pFUnit_Initialize OTHER_SOURCES field_utils_setup.F90 From 5fe042d4776b5283c2f6f9ada53fefb8dc1a7cc1 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Mon, 4 Nov 2024 13:09:00 -0500 Subject: [PATCH 6/7] Fixes related to VerticalGrid This PR crossed paths with outher work on VerticalGrid. Patches here let the tests run, but more work is needed to clean this up. --- generic3g/ComponentSpecParser.F90 | 4 +- .../parse_component_spec.F90 | 2 +- .../parse_geometry_spec.F90 | 2 +- generic3g/OuterMetaComponent.F90 | 4 +- generic3g/OuterMetaComponent/SetServices.F90 | 2 +- .../vertical/FixedLevelsVerticalGrid.F90 | 49 ++++++++++++------- 6 files changed, 39 insertions(+), 24 deletions(-) diff --git a/generic3g/ComponentSpecParser.F90 b/generic3g/ComponentSpecParser.F90 index 257b66652b01..bb0e73abf658 100644 --- a/generic3g/ComponentSpecParser.F90 +++ b/generic3g/ComponentSpecParser.F90 @@ -68,14 +68,14 @@ module mapl3g_ComponentSpecParser module function parse_component_spec(hconfig, registry, rc) result(spec) type(ComponentSpec) :: spec type(ESMF_HConfig), target, intent(inout) :: hconfig - type(StateRegistry), optional, intent(in) :: registry + type(StateRegistry), optional, target, intent(in) :: registry integer, optional, intent(out) :: rc end function parse_component_spec module function parse_geometry_spec(mapl_cfg, registry, rc) result(geometry_spec) type(GeometrySpec) :: geometry_spec type(ESMF_HConfig), intent(in) :: mapl_cfg - type(StateRegistry), optional, intent(in) :: registry + type(StateRegistry), optional, target, intent(in) :: registry integer, optional, intent(out) :: rc end function parse_geometry_spec diff --git a/generic3g/ComponentSpecParser/parse_component_spec.F90 b/generic3g/ComponentSpecParser/parse_component_spec.F90 index 65b05fc3f737..51c7a44415c1 100644 --- a/generic3g/ComponentSpecParser/parse_component_spec.F90 +++ b/generic3g/ComponentSpecParser/parse_component_spec.F90 @@ -7,7 +7,7 @@ module function parse_component_spec(hconfig, registry, rc) result(spec) type(ComponentSpec) :: spec type(ESMF_HConfig), target, intent(inout) :: hconfig - type(StateRegistry), optional, intent(in) :: registry + type(StateRegistry), optional, target, intent(in) :: registry integer, optional, intent(out) :: rc integer :: status diff --git a/generic3g/ComponentSpecParser/parse_geometry_spec.F90 b/generic3g/ComponentSpecParser/parse_geometry_spec.F90 index 0030c6574032..5c83c722b0a7 100644 --- a/generic3g/ComponentSpecParser/parse_geometry_spec.F90 +++ b/generic3g/ComponentSpecParser/parse_geometry_spec.F90 @@ -16,7 +16,7 @@ module function parse_geometry_spec(mapl_cfg, registry, rc) result(geometry_spec) type(GeometrySpec) :: geometry_spec type(ESMF_HConfig), intent(in) :: mapl_cfg - type(StateRegistry), optional, intent(in) :: registry + type(StateRegistry), optional, target, intent(in) :: registry integer, optional, intent(out) :: rc integer :: status diff --git a/generic3g/OuterMetaComponent.F90 b/generic3g/OuterMetaComponent.F90 index f3862082747c..8542d39496b2 100644 --- a/generic3g/OuterMetaComponent.F90 +++ b/generic3g/OuterMetaComponent.F90 @@ -145,8 +145,8 @@ end subroutine I_child_Op interface recursive module subroutine SetServices_(this, rc) - class(OuterMetaComponent), intent(inout) :: this - integer, intent(out) ::rc + class(OuterMetaComponent), target, intent(inout) :: this + integer, intent(out) :: rc end subroutine module recursive subroutine add_child_by_name(this, child_name, setservices, hconfig, rc) diff --git a/generic3g/OuterMetaComponent/SetServices.F90 b/generic3g/OuterMetaComponent/SetServices.F90 index b97866257cfe..758a4ac61a10 100644 --- a/generic3g/OuterMetaComponent/SetServices.F90 +++ b/generic3g/OuterMetaComponent/SetServices.F90 @@ -26,7 +26,7 @@ recursive module subroutine SetServices_(this, rc) use mapl3g_GenericGridComp, only: generic_setservices => setservices - class(OuterMetaComponent), intent(inout) :: this + class(OuterMetaComponent), target, intent(inout) :: this integer, intent(out) :: rc integer :: status diff --git a/generic3g/vertical/FixedLevelsVerticalGrid.F90 b/generic3g/vertical/FixedLevelsVerticalGrid.F90 index ed569a73a0de..8bfbc953e135 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid.F90 @@ -4,6 +4,8 @@ module mapl3g_FixedLevelsVerticalGrid use mapl_ErrorHandling use mapl3g_VerticalGrid + use mapl3g_VerticalStaggerLoc + use mapl3g_FieldCreate use mapl3g_GriddedComponentDriver use mapl3g_VerticalDimSpec use mapl3g_InfoUtilities, only: MAPL_InfoSetInternal @@ -90,7 +92,7 @@ subroutine get_coordinate_field(this, field, coupler, standard_name, geom, typek _FAIL("invalid vertical_dim_spec") end if - field = esmf_field_create_(geom, adjusted_levels, vloc, _RC) + field = esmf_field_create_(geom, adjusted_levels, _RC) _RETURN(_SUCCESS) _UNUSED_DUMMY(coupler) @@ -149,36 +151,49 @@ end function not_equal_FixedLevelsVerticalGrid ! Create an ESMF_Field containing a 3D array that is replicated from ! a 1D array at each point of the horizontal grid - function esmf_field_create_(geom, farray1d, vloc, rc) result(field) + function esmf_field_create_(geom, farray1d, rc) result(field) type(ESMF_Field) :: field ! result type(ESMF_Geom), intent(in) :: geom real(kind=REAL32), intent(in) :: farray1d(:) - character(len=*), intent(in) :: vloc +!# character(len=*), intent(in) :: vloc integer, optional, intent(out) :: rc integer, allocatable :: local_cell_count(:) - real(kind=REAL32), allocatable :: farray3d(:, :, :) + real(kind=REAL32), pointer :: farray3d(:, :, :) integer :: i, j, IM, JM, status - ! First, copy the 1D array, farray1d, to each point on the horz grid +!# ! First, copy the 1D array, farray1d, to each point on the horz grid +!# allocate(farray3d(IM, JM, size(farray1d))) +!# do concurrent (i=1:IM, j=1:JM) +!# farray3d(i, j, :) = farray1d(:) +!# end do + + ! Create an ESMF_Field containing farray3d + field = MAPL_FieldCreate( & + geom=geom, typekind=ESMF_TYPEKIND_R4, & + num_levels=size(farray1d), & + vert_staggerloc=VERTICAL_STAGGER_CENTER, & + _RC) + +!# ! First, copy the 1D array, farray1d, to each point on the horz grid + call ESMF_FieldGet(field, fArrayPtr=farray3d, _RC) call MAPL_GeomGet_(geom, localCellCount=local_cell_count, _RC) IM = local_cell_count(1); JM = local_cell_count(2) - allocate(farray3d(IM, JM, size(farray1d))) do concurrent (i=1:IM, j=1:JM) farray3d(i, j, :) = farray1d(:) end do - ! Create an ESMF_Field containing farray3d - field = ESMF_FieldCreate( & - geom=geom, & - farray=farray3d, & - indexflag=ESMF_INDEX_DELOCAL, & - datacopyFlag=ESMF_DATACOPY_VALUE, & - ungriddedLBound=[1], & - ungriddedUBound=[size(farray1d)], & - _RC) - call MAPL_InfoSetInternal(field, key=KEY_NUM_LEVELS, value=size(farray1d), _RC) - call MAPL_InfoSetInternal(field, key=KEY_VLOC, value=vloc, _RC) +!# field = ESMF_FieldCreate( & +!# geom=geom, & +!# farray=farray3d, & +!# indexflag=ESMF_INDEX_DELOCAL, & +!# datacopyFlag=ESMF_DATACOPY_VALUE, & +!# ungriddedLBound=[1], & +!# ungriddedUBound=[size(farray1d)], & +!# _RC) +!# +!# call MAPL_InfoSetInternal(field, key=KEY_NUM_LEVELS, value=size(farray1d), _RC) +!# call MAPL_InfoSetInternal(field, key=KEY_VEVLOC, value=vloc, _RC) _RETURN(_SUCCESS) end function esmf_field_create_ From 3ee5edc24e0385c9ff726f78ca6cff2eb91d1c6a Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Mon, 4 Nov 2024 14:38:14 -0500 Subject: [PATCH 7/7] Eliminated dead code. --- field/FieldCreate.F90 | 2 +- generic3g/specs/FieldSpec.F90 | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/field/FieldCreate.F90 b/field/FieldCreate.F90 index 56998ea6b05e..30948b586a67 100644 --- a/field/FieldCreate.F90 +++ b/field/FieldCreate.F90 @@ -89,7 +89,7 @@ subroutine field_empty_complete( field, & bounds = make_bounds(num_levels=num_levels, ungridded_dims=ungridded_dims) call ESMF_FieldEmptyComplete(field, typekind=typekind, & -!# gridToFieldMap=gridToFieldMap, & + gridToFieldMap=gridToFieldMap, & ungriddedLBound=bounds%lower, ungriddedUBound=bounds%upper, _RC) call MAPL_FieldInfoSetInternal(field, & diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index 1744f489e85e..45efee13533c 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -24,7 +24,6 @@ module mapl3g_FieldSpec use mapl3g_ActualConnectionPt use mapl_ErrorHandling use mapl_KeywordEnforcer -!# use mapl3g_esmf_info_keys use mapl3g_InfoUtilities use mapl3g_ExtensionAction use mapl3g_VerticalGrid @@ -113,7 +112,6 @@ module mapl3g_FieldSpec procedure :: make_adapters -!# procedure :: set_info procedure :: set_geometry procedure :: write_formatted