diff --git a/CMakeLists.txt b/CMakeLists.txt index 0b6fde400116..ab7111756bae 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -211,6 +211,7 @@ add_subdirectory (profiler) add_subdirectory (generic) add_subdirectory (generic3g) add_subdirectory (field) +add_subdirectory (field_bundle) add_subdirectory (oomph) # temporary - will rename to generic when done add_subdirectory (shared) add_subdirectory (include) diff --git a/GeomIO/CMakeLists.txt b/GeomIO/CMakeLists.txt index a4075ba603b1..aef8f2fcb12a 100644 --- a/GeomIO/CMakeLists.txt +++ b/GeomIO/CMakeLists.txt @@ -11,7 +11,7 @@ set(srcs esma_add_library(${this} SRCS ${srcs} - DEPENDENCIES MAPL.geom_mgr MAPL.pfio MAPL.base MAPL.shared MAPL.esmf_utils MAPL.hconfig_utils GFTL::gftl-v2 + DEPENDENCIES MAPL.field MAPL.field_bundle MAPL.geom_mgr MAPL.pfio MAPL.base MAPL.shared MAPL.esmf_utils MAPL.hconfig_utils GFTL::gftl-v2 TYPE SHARED ) diff --git a/GeomIO/SharedIO.F90 b/GeomIO/SharedIO.F90 index 4f3d932f2c77..698163bfc963 100644 --- a/GeomIO/SharedIO.F90 +++ b/GeomIO/SharedIO.F90 @@ -2,16 +2,20 @@ module mapl3g_SharedIO use mapl_ErrorHandlingMod use mapl3g_InfoUtilities + use mapl3g_FieldBundleGet + use mapl3g_FieldGet + use mapl3g_VerticalStaggerLoc use pfio use gFTL2_StringVector + use gFTL2_StringSet use mapl3g_geom_mgr use MAPL_BaseMod use mapl3g_UngriddedDims use mapl3g_UngriddedDim - use mapl3g_FieldDimensionInfo +!# use mapl3g_FieldDimensionInfo use esmf - implicit none + implicit none(type,external) public add_variables public add_variable @@ -21,7 +25,6 @@ module mapl3g_SharedIO public esmf_to_pfio_type public :: add_vertical_dimensions - public :: get_vertical_dimension_name public :: get_vertical_dimension_num_levels public :: get_vertical_dimension_name_from_field public :: add_ungridded_dimensions @@ -65,16 +68,13 @@ subroutine add_variables(metadata, bundle, rc) type(FileMetaData), intent(inout) :: metadata integer, intent(out), optional :: rc - integer :: status, num_fields, i - character(len=ESMF_MAXSTR), allocatable :: field_names(:) + integer :: status, i type(ESMF_Field) :: field + type(ESMF_Field), allocatable :: fieldList(:) - call ESMF_FieldBundleGet(bundle, fieldCount=num_fields, _RC) - allocate(field_names(num_fields)) - call ESMF_FieldBundleGet(bundle, fieldNameList=field_names, _RC) - do i=1,num_fields - call ESMF_FieldBundleGet(bundle, field_names(i), field=field, _RC) - call add_variable(metadata, field, _RC) + call MAPL_FieldBundleGet(bundle, fieldList=fieldList, _RC) + do i=1,size(fieldList) + call add_variable(metadata, fieldList(i), _RC) enddo _RETURN(_SUCCESS) @@ -101,7 +101,7 @@ subroutine add_variable(metadata, field, rc) mapl_geom => get_mapl_geom(esmfgeom, _RC) grid_variables = mapl_geom%get_gridded_dims() dims = string_vec_to_comma_sep(grid_variables) - call ESMF_FieldGet(field, name=fname, typekind = typekind, _RC) + call ESMF_FieldGet(field, name=fname, typekind=typekind, _RC) ! add vertical dimension vert_dim_name = get_vertical_dimension_name_from_field(field, _RC) if(vert_dim_name /= EMPTY) dims = dims//","//vert_dim_name @@ -112,9 +112,9 @@ subroutine add_variable(metadata, field, rc) dims = dims//",time" pfio_type = esmf_to_pfio_type(typekind ,_RC) v = Variable(type=pfio_type, dimensions=dims) - call MAPL_InfoGetInternal(field, 'units', char, _RC) + call MAPL_FieldGet(field, units=char, _RC) call v%add_attribute('units',char) - call MAPL_InfoGetInternal(field, 'standard_name', char, _RC) + call MAPL_FieldGet(field, standard_name=char, _RC) call v%add_attribute('long_name',char) call metadata%add_variable(trim(fname), v, _RC) _RETURN(_SUCCESS) @@ -188,47 +188,52 @@ subroutine add_vertical_dimensions(bundle, metadata, rc) type(ESMF_FieldBundle), intent(in) :: bundle type(FileMetaData), intent(inout) :: metadata integer, optional, intent(out) :: rc + integer :: status integer :: num_levels type(StringVector) :: vertical_names type(StringVectorIterator) :: iter - character(len=:), allocatable :: spec_name, dim_name - - num_levels = get_num_levels(bundle, _RC) - if(num_levels == 0) return - vertical_names = get_vertical_dim_spec_names(bundle, _RC) - iter = vertical_names%begin() - do while(iter /= vertical_names%end()) - spec_name = iter%of() - num_levels = get_vertical_dimension_num_levels(spec_name, num_levels) - dim_name = get_vertical_dimension_name(spec_name) - call metadata%add_dimension(dim_name, num_levels) - call iter%next() - end do - _RETURN(_SUCCESS) + character(len=:), allocatable :: dim_name + type(VerticalStaggerLoc) :: vert_staggerloc + integer :: i, num_vgrid_levels, field_vgrid_levels + type(ESMF_Field), allocatable :: fieldList(:) - end subroutine add_vertical_dimensions - function get_vertical_dimension_name(dim_spec_name) result(dim_name) - character(len=:), allocatable :: dim_name - character(len=*), intent(in) :: dim_spec_name - character(len=*), parameter :: VERTICAL_CENTER_NAME = 'lev' - character(len=*), parameter :: VERTICAL_EDGE_NAME = 'edge' - character(len=*), parameter :: VERTICAL_UNKNOWN_NAME = EMPTY + call MAPL_FieldBundleGet(bundle, fieldList=fieldList, _RC) + num_vgrid_levels = 0 + + vertical_names = StringVector() + do i = 1, size(fieldList) + call MAPL_FieldGet(fieldList(i), vert_staggerloc=vert_staggerloc, _RC) + if (vert_staggerloc == VERTICAL_STAGGER_NONE) cycle + + ! Ensure consistent vertical grid + call MAPL_FieldGet(fieldList(i), num_vgrid_levels=field_vgrid_levels, _RC) + if (num_vgrid_levels > 0) then + _ASSERT(field_vgrid_levels == num_vgrid_levels, "Inconsistent vertical grid in bundle.") + else + num_vgrid_levels = field_vgrid_levels + end if + + dim_name = vert_staggerloc%get_dimension_name() + call vertical_names%push_back(dim_name) - dim_name = VERTICAL_UNKNOWN_NAME + end do - if(dim_spec_name == 'VERTICAL_DIM_EDGE') then - dim_name = VERTICAL_EDGE_NAME - return - end if + associate (e => vertical_names%ftn_end()) + iter = vertical_names%ftn_begin() + do while(iter /= e) + call iter%next() + dim_name = iter%of() + num_levels = vert_staggerloc%get_num_levels(num_vgrid_levels) + call metadata%add_dimension(dim_name, num_levels) + end do + end associate - if(dim_spec_name == 'VERTICAL_DIM_CENTER') then - dim_name = VERTICAL_CENTER_NAME - return - end if + _RETURN(_SUCCESS) + + end subroutine add_vertical_dimensions - end function get_vertical_dimension_name integer function get_vertical_dimension_num_levels(dim_spec_name, num_levels) result(num) character(len=*), intent(in) :: dim_spec_name @@ -243,11 +248,12 @@ function get_vertical_dimension_name_from_field(field, rc) result(dim_name) character(len=:), allocatable :: dim_name type(ESMF_Field), intent(in) :: field integer, intent(out), optional :: rc + integer :: status - character(len=:), allocatable :: dim_spec_name + type(VerticalStaggerLoc) :: vert_staggerloc - dim_spec_name = get_vertical_dim_spec_name(field, _RC) - dim_name = get_vertical_dimension_name(dim_spec_name) + call MAPL_FieldGet(field, vert_staggerLoc=vert_staggerLoc, _RC) + dim_name = vert_staggerLoc%get_dimension_name() _RETURN(_SUCCESS) end function get_vertical_dimension_name_from_field @@ -257,17 +263,30 @@ subroutine add_ungridded_dimensions(bundle, metadata, rc) type(FileMetaData), intent(inout) :: metadata integer, optional, intent(out) :: rc integer :: status - type(UngriddedDims) :: ungridded_dims + type(UngriddedDims) :: field_ungridded_dims, ungridded_dims type(UngriddedDim) :: u - integer :: i - - ungridded_dims = get_ungridded_dims(bundle, _RC) - do i = 1, ungridded_dims%get_num_ungridded() - u = ungridded_dims%get_ith_dim_spec(i) - call metadata%add_dimension(u%get_name(), u%get_extent()) + integer :: i, j + type(ESMF_Field) :: field + type(ESMF_Field), allocatable :: fieldList(:) + type(StringSet) :: dim_names + character(:), allocatable :: dim_name + logical :: is_new + + call MAPL_FieldBundleGet(bundle, fieldList=fieldList, _RC) + do i = 1, size(fieldList) + call MAPL_FieldGet(fieldList(i), ungridded_dims=field_ungridded_dims, _RC) + + do j = 1, field_ungridded_dims%get_num_ungridded() + u = ungridded_dims%get_ith_dim_spec(i) + dim_name = u%get_name() + call dim_names%insert(dim_name, is_new=is_new) + if (is_new) then + call metadata%add_dimension(u%get_name(), u%get_extent()) + end if + end do end do - _RETURN(_SUCCESS) + _RETURN(_SUCCESS) end subroutine add_ungridded_dimensions function ungridded_dim_names(field, rc) result(dim_names) @@ -275,10 +294,10 @@ function ungridded_dim_names(field, rc) result(dim_names) type(ESMF_Field), intent(in) :: field integer, optional, intent(out) :: rc integer :: status - type(UngriddedDims) :: dims + type(UngriddedDims) :: ungridded_dims - dims = get_ungridded_dims(field, _RC) - dim_names = cat_ungridded_dim_names(dims) + call MAPL_FieldGet(field, ungridded_dims=ungridded_dims, _RC) + dim_names = cat_ungridded_dim_names(ungridded_dims) _RETURN(_SUCCESS) end function ungridded_dim_names diff --git a/GeomIO/tests/Test_SharedIO.pf b/GeomIO/tests/Test_SharedIO.pf index 8d6f30b720ae..5469450c9e7e 100644 --- a/GeomIO/tests/Test_SharedIO.pf +++ b/GeomIO/tests/Test_SharedIO.pf @@ -34,27 +34,6 @@ contains end subroutine assign_character_from_string - @Test - subroutine test_get_vertical_dimension_name() - character(len=:), allocatable :: name - character(len=:), allocatable :: vertical_dim - character(len=:), allocatable :: message - - vertical_dim = DIM_CENTER - name = CENTER_NAME - message = make_message('Dimension name does not match for', vertical_dim) - @assertEqual(name, get_vertical_dimension_name(vertical_dim), message) - - vertical_dim = DIM_EDGE - name = EDGE_NAME - message = make_message('Dimension name does not match for', vertical_dim) - @assertEqual(name, get_vertical_dimension_name(vertical_dim), message) - - vertical_dim = DIM_UNK - message = make_message('Return value should be empty String', vertical_dim) - @assertEqual(0, len(get_vertical_dimension_name(DIM_UNK)), message) - - end subroutine test_get_vertical_dimension_name @Test subroutine test_get_vertical_dimension_num_levels() diff --git a/esmf_utils/CMakeLists.txt b/esmf_utils/CMakeLists.txt index 81ca3467a395..91d628aa7d4c 100644 --- a/esmf_utils/CMakeLists.txt +++ b/esmf_utils/CMakeLists.txt @@ -2,7 +2,6 @@ esma_set_this (OVERRIDE MAPL.esmf_utils) set(srcs InfoUtilities.F90 - FieldDimensionInfo.F90 UngriddedDim.F90 UngriddedDims.F90 UngriddedDimVector.F90 diff --git a/esmf_utils/FieldDimensionInfo.F90 b/esmf_utils/FieldDimensionInfo.F90 deleted file mode 100644 index 6d4f31a4dd70..000000000000 --- a/esmf_utils/FieldDimensionInfo.F90 +++ /dev/null @@ -1,300 +0,0 @@ -#include "MAPL_Generic.h" -module mapl3g_FieldDimensionInfo - use mapl3g_InfoUtilities - use mapl3g_UngriddedDim - use mapl3g_UngriddedDimVector - use mapl3g_UngriddedDims - use mapl3g_esmf_info_keys - use gFTL2_StringVector - use esmf, only: ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet - use esmf, only: ESMF_Info, ESMF_InfoIsPresent, ESMF_InfoGet - use esmf, only: ESMF_InfoDestroy, ESMF_InfoCreate - use esmf, only: ESMF_InfoPrint - use Mapl_ErrorHandling - - implicit none (type, external) - - private - - public :: get_num_levels - 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 - 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_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 - - character(len=*), parameter :: VERT_DIM_NONE = 'VERTICAL_DIM_NONE' - -contains - - 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_Info), allocatable :: info(:) - - info = create_bundle_info(bundle, _RC) - num = get_num_levels_bundle_info(info, _RC) - _RETURN(_SUCCESS) - - end function get_num_levels_bundle - - integer function get_num_levels_bundle_info(infos, rc) result(num) - type(ESMF_Info), intent(in) :: infos(:) - integer, optional, intent(out) :: rc - integer :: status - integer :: i, n - - num = 0 - do i=1, size(infos) - n = get_num_levels_info(infos(i), _RC) - num = max(num, n) - if(n == 0) cycle - _ASSERT(n == num, 'Fields with vertical levels must have the same number of levels.') - end do - _RETURN(_SUCCESS) - - end function get_num_levels_bundle_info - - 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 - - info = MAPL_InfoCreateFromInternal(field, _RC) - num = get_num_levels_info(info, _RC) - call ESMF_InfoDestroy(info, _RC) - - _RETURN(_SUCCESS) - end function get_num_levels_field - - integer function get_num_levels_info(info, rc) result(num) - type(ESMF_Info), intent(in) :: info - 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 == "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 - - function get_vertical_dim_spec_names_bundle(bundle, rc) result(names) - type(StringVector) :: names - type(ESMF_FieldBundle), intent(in) :: bundle - integer, optional, intent(out) :: rc - integer :: status - type(ESMF_Info), allocatable :: info(:) - - info = create_bundle_info(bundle, _RC) - names = get_vertical_dim_spec_names_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 :: spec_name - - names = StringVector() - do i=1, size(info) - spec_name = get_vertical_dim_spec_info(info(i), _RC) - if(find_index(names, spec_name) == 0) call names%push_back(spec_name) - end do - _RETURN(_SUCCESS) - - end function get_vertical_dim_spec_names_bundle_info - - function get_vertical_dim_spec_name_field(field, rc) result(spec_name) - character(len=:), allocatable :: spec_name - type(ESMF_Field), intent(in) :: field - integer, optional, intent(out) :: rc - integer :: status - type(ESMF_Info) :: info - - info = MAPL_InfoCreateFromInternal(field, _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 - - 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 - logical :: isPresent - - call MAPL_InfoGet(info, key=KEY_VERT_STAGGERLOC, value=spec_name, _RC) - isPresent = ESMF_InfoIsPresent(info, key=KEY_VLOC, _RC) - - _RETURN(_SUCCESS) - end function get_vertical_dim_spec_info - - function get_ungridded_dims_bundle(bundle, rc) result(dims) - type(UngriddedDims) :: dims - type(ESMF_FieldBundle), intent(in) :: bundle - integer, optional, intent(out) :: rc - integer :: status - type(ESMF_Info), allocatable :: info(:) - type(UngriddedDimVector) :: vec - - info = create_bundle_info(bundle, _RC) - vec = get_ungridded_dims_bundle_info(info, _RC) - dims = UngriddedDims(vec) - _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 - type(UngriddedDims) :: dims - - do i=1, size(info) - dims = make_ungriddedDims(info(i), key=KEY_UNGRIDDED_DIMS, _RC) - call merge_ungridded_dims(vec, dims, rc) - end do - _RETURN(_SUCCESS) - - end function get_ungridded_dims_bundle_info - - function get_ungridded_dims_field(field, rc) result(ungridded) - type(UngriddedDims) :: ungridded - type(ESMF_Field), intent(in) :: field - integer, optional, intent(out) :: rc - integer :: status - type(ESMF_Info) :: info - - info = MAPL_InfoCreateFromInternal(field, _RC) - ungridded = make_UngriddedDims(info, key=KEY_UNGRIDDED_DIMS, _RC) - call ESMF_InfoDestroy(info, _RC) - - _RETURN(_SUCCESS) - end function get_ungridded_dims_field - - - subroutine merge_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() - 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) - - end subroutine merge_ungridded_dims - - 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 - - subroutine check_duplicate(vec, udim, rc) - class(UngriddedDimVector), intent(in) :: vec - class(UngriddedDim), intent(in) :: udim - integer, optional, intent(out) :: rc - type(UngriddedDimVectorIterator) :: iter - type(UngriddedDim) :: vdim - - iter = vec%ftn_begin() - do while(iter < vec%ftn_end()) - call iter%next() - vdim = iter%of() - if(udim%get_name() /= vdim%get_name()) cycle - _ASSERT(udim == vdim, 'UngriddedDim mismatch.') - end do - - _RETURN(_SUCCESS) - - end subroutine check_duplicate - - 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 - - integer :: status - integer :: field_count, i - 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)) - call ESMF_FieldBundleGet(bundle, fieldList=fields, _RC) - allocate(bundle_info(field_count)) - do i=1, field_count - bundle_info(i) = MAPL_InfoCreateFromInternal(fields(i), _RC) - end do - _RETURN(_SUCCESS) - - end function create_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_FieldDimensionInfo diff --git a/esmf_utils/InfoUtilities.F90 b/esmf_utils/InfoUtilities.F90 index b9b91a4680b2..8664561c6df8 100644 --- a/esmf_utils/InfoUtilities.F90 +++ b/esmf_utils/InfoUtilities.F90 @@ -13,7 +13,7 @@ module mapl3g_InfoUtilities use esmf, only: ESMF_STATEITEM_FIELD use esmf, only: ESMF_STATEITEM_FIELDBundle use esmf, only: operator(==), operator(/=) - use esmf, only: ESMF_Info + use esmf, only: ESMF_Info, ESMF_InfoPrint use esmf, only: ESMF_InfoCreate use esmf, only: ESMF_InfoIsPresent use esmf, only: ESMF_InfoGetFromHost @@ -29,29 +29,20 @@ module mapl3g_InfoUtilities use esmf, only: ESMF_KIND_R4 use esmf, only: ESMF_KIND_R8 - implicit none + implicit none(type,external) private public :: MAPL_InfoGet public :: MAPL_InfoSet - public :: MAPL_InfoCreateFromInternal public :: MAPL_InfoCreateFromShared public :: MAPL_InfoGetShared public :: MAPL_InfoSetShared - public :: MAPL_InfoCopyShared public :: MAPL_InfoGetPrivate public :: MAPL_InfoSetPrivate - public :: MAPL_InfoGetInternal - public :: MAPL_InfoSetInternal public :: MAPL_InfoSetNamespace - interface MAPL_InfoCreateFromInternal - procedure :: info_field_create_from_internal - procedure :: info_bundle_create_from_internal - end interface MAPL_InfoCreateFromInternal - interface MAPL_InfoCreateFromShared procedure :: info_field_create_from_shared end interface MAPL_InfoCreateFromShared @@ -69,7 +60,6 @@ module mapl3g_InfoUtilities ! Access info object from esmf stateitem interface MAPL_InfoGetShared procedure :: info_state_get_shared_string - procedure :: info_field_get_shared_i4 procedure :: info_stateitem_get_shared_string procedure :: info_stateitem_get_shared_logical procedure :: info_stateitem_get_shared_i4 @@ -80,7 +70,6 @@ module mapl3g_InfoUtilities interface MAPL_InfoSetShared procedure :: info_state_set_shared_string - procedure :: info_field_set_shared_i4 procedure :: info_stateitem_set_shared_string procedure :: info_stateitem_set_shared_logical procedure :: info_stateitem_set_shared_i4 @@ -89,9 +78,6 @@ module mapl3g_InfoUtilities procedure :: info_stateitem_set_shared_r4_1d end interface MAPL_InfoSetShared - interface MAPL_InfoCopyShared - procedure :: info_field_copy_shared - end interface MAPL_InfoCopyShared interface MAPL_InfoGetPrivate procedure :: info_stateitem_get_private_string @@ -111,35 +97,6 @@ module mapl3g_InfoUtilities procedure :: info_stateitem_set_private_r4_1d end interface MAPL_InfoSetPrivate - interface MAPL_InfoGetInternal - procedure :: info_field_get_internal_string - procedure :: info_field_get_internal_i4 - procedure :: info_bundle_get_internal_string - procedure :: info_bundle_get_internal_i4 - procedure :: info_bundle_get_internal_r4_1d - procedure :: info_stateitem_get_internal_string - procedure :: info_stateitem_get_internal_logical - procedure :: info_stateitem_get_internal_i4 - procedure :: info_stateitem_get_internal_r4 - procedure :: info_stateitem_get_internal_r8 - procedure :: info_stateitem_get_internal_r4_1d - end interface MAPL_InfoGetInternal - - interface MAPL_InfoSetInternal - procedure :: info_field_set_internal_info - procedure :: info_field_set_internal_string - procedure :: info_field_set_internal_i4 - procedure :: info_bundle_set_internal_info - procedure :: info_bundle_set_internal_string - procedure :: info_bundle_set_internal_i4 - procedure :: info_bundle_set_internal_r4_1d - procedure :: info_stateitem_set_internal_string - procedure :: info_stateitem_set_internal_logical - procedure :: info_stateitem_set_internal_i4 - procedure :: info_stateitem_set_internal_r4 - procedure :: info_stateitem_set_internal_r8 - procedure :: info_stateitem_set_internal_r4_1d - end interface MAPL_InfoSetInternal ! Control namespace in state interface MAPL_InfoSetNamespace @@ -198,6 +155,7 @@ subroutine info_get_i4(info, key, value, unusable, rc) logical :: is_present is_present = ESMF_InfoIsPresent(info, key=key, _RC) + if (.not. is_present) call ESMF_InfoPrint(info) _ASSERT(is_present, "Key not found in info object: " // key) call ESMF_InfoGet(info, key=key, value=value, _RC) @@ -260,50 +218,6 @@ subroutine info_get_r4_1d(info, key, values, unusable, rc) end subroutine info_get_r4_1d - ! MAPL_InfoCreateFromInternal - - function info_field_create_from_internal(field, key, rc) result(info) - type(ESMF_Info) :: info - type(ESMF_Field), intent(in) :: field - character(*), optional, intent(in) :: key - integer, optional, intent(out) :: rc - - type(ESMF_Info) :: host_info - integer :: status - character(:), allocatable :: key_ - - call ESMF_InfoGetFromHost(field, host_info, _RC) - - key_ = INFO_INTERNAL_NAMESPACE - if (present(key)) then - key_ = concat(key_, key) - end if - - info = ESMF_InfoCreate(host_info, key=key_, _RC) - - _RETURN(_SUCCESS) - end function info_field_create_from_internal - - function info_bundle_create_from_internal(bundle, key, rc) result(info) - type(ESMF_Info) :: info - type(ESMF_FieldBundle), intent(in) :: bundle - character(*), optional, intent(in) :: key - integer, optional, intent(out) :: rc - - type(ESMF_Info) :: host_info - character(:), allocatable :: key_ - integer :: status - - key_ = INFO_INTERNAL_NAMESPACE - if (present(key)) then - key_ = concat(key_, key) - end if - - call ESMF_InfoGetFromHost(bundle, host_info, _RC) - info = ESMF_InfoCreate(host_info, key=key_, _RC) - - _RETURN(_SUCCESS) - end function info_bundle_create_from_internal function info_field_create_from_shared(field, rc) result(info) type(ESMF_Info) :: info @@ -337,22 +251,6 @@ subroutine info_state_get_shared_string(state, key, value, unusable, rc) _RETURN(_SUCCESS) end subroutine info_state_get_shared_string - subroutine info_field_get_shared_i4(field, key, value, unusable, rc) - type(ESMF_Field), intent(in) :: field - character(*), intent(in) :: key - integer(kind=ESMF_KIND_I4), intent(out) :: value - class(KeywordEnforcer), optional, intent(in) :: unusable - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: field_info - - call ESMF_InfoGetFromHost(field, field_info, _RC) - call MAPL_InfoGet(field_info, key=concat(INFO_SHARED_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_field_get_shared_i4 - subroutine info_stateitem_get_shared_string(state, short_name, key, value, rc) type(ESMF_State), intent(in) :: state character(*), intent(in) :: short_name @@ -468,21 +366,6 @@ subroutine info_state_set_shared_string(state, key, value, unusable, rc) _RETURN(_SUCCESS) end subroutine info_state_set_shared_string - subroutine info_field_set_shared_i4(field, key, value, rc) - type(ESMF_Field), intent(in) :: field - character(*), intent(in) :: key - integer(kind=ESMF_KIND_I4), intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: field_info - - call ESMF_InfoGetFromHost(field, field_info, _RC) - call MAPL_InfoSet(field_info, key=concat(INFO_SHARED_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_field_set_shared_i4 - subroutine info_stateitem_set_shared_string(state, short_name, key, value, rc) type(ESMF_State), intent(in) :: state character(*), intent(in) :: short_name @@ -833,382 +716,6 @@ subroutine info_stateitem_set_private_r4_1d(state, short_name, key, values, rc) _RETURN(_SUCCESS) end subroutine info_stateitem_set_private_r4_1d - ! MAPL_InfoGetInternal - - subroutine info_field_get_internal_string(field, key, value, rc) - type(ESMF_Field), intent(in) :: field - character(*), intent(in) :: key - character(:), allocatable, intent(out) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call ESMF_InfoGetFromHost(field, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_field_get_internal_string - - subroutine info_field_get_internal_i4(field, key, value, rc) - type(ESMF_Field), intent(in) :: field - character(*), intent(in) :: key - integer(kind=ESMF_KIND_I4), intent(out) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call ESMF_InfoGetFromHost(field, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_field_get_internal_i4 - - subroutine info_bundle_get_internal_string(bundle, key, value, rc) - type(ESMF_FieldBundle), intent(in) :: bundle - character(*), intent(in) :: key - character(:), allocatable, intent(out) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call ESMF_InfoGetFromHost(bundle, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_bundle_get_internal_string - - subroutine info_bundle_get_internal_i4(bundle, key, value, rc) - type(ESMF_FieldBundle), intent(in) :: bundle - character(*), intent(in) :: key - integer(kind=ESMF_KIND_I4), intent(out) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call ESMF_InfoGetFromHost(bundle, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_bundle_get_internal_i4 - - subroutine info_bundle_get_internal_r4_1d(bundle, key, values, rc) - type(ESMF_FieldBundle), intent(in) :: bundle - character(*), intent(in) :: key - real(kind=ESMF_KIND_R4), allocatable, intent(out) :: values(:) - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call ESMF_InfoGetFromHost(bundle, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), values=values, _RC) - - _RETURN(_SUCCESS) - end subroutine info_bundle_get_internal_r4_1d - - subroutine info_stateitem_get_internal_string(state, short_name, key, value, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - character(:), allocatable, intent(out) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_get_internal_string - - subroutine info_stateitem_get_internal_logical(state, short_name, key, value, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - logical, intent(out) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_get_internal_logical - - subroutine info_stateitem_get_internal_i4(state, short_name, key, value, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - integer, intent(out) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_get_internal_i4 - - subroutine info_stateitem_get_internal_r4(state, short_name, key, value, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - real(kind=ESMF_KIND_R4), intent(out) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_get_internal_r4 - - subroutine info_stateitem_get_internal_r8(state, short_name, key, value, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - real(kind=ESMF_KIND_R8), intent(out) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_get_internal_r8 - - subroutine info_stateitem_get_internal_r4_1d(state, short_name, key, values, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - real(kind=ESMF_KIND_R4), allocatable, intent(out) :: values(:) - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoGet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), values=values, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_get_internal_r4_1d - - ! MAPL_InfoSetInternal - - subroutine info_field_set_internal_info(field, key, value, rc) - type(ESMF_Field), intent(in) :: field - character(*), intent(in) :: key - type(ESMF_Info), intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: field_info - - call ESMF_InfoGetFromHost(field, field_info, _RC) - call MAPL_InfoSet(field_info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_field_set_internal_info - - subroutine info_field_set_internal_string(field, key, value, rc) - type(ESMF_Field), intent(in) :: field - character(*), intent(in) :: key - character(*), intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call ESMF_InfoGetFromHost(field, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_field_set_internal_string - - subroutine info_field_set_internal_i4(field, key, value, rc) - type(ESMF_Field), intent(in) :: field - character(*), intent(in) :: key - integer, intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call ESMF_InfoGetFromHost(field, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_field_set_internal_i4 - - subroutine info_bundle_set_internal_info(bundle, key, value, rc) - type(ESMF_FieldBundle), intent(inout) :: bundle - character(*), intent(in) :: key - type(ESMF_Info), intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: bundle_info - - call ESMF_InfoGetFromHost(bundle, bundle_info, _RC) - call MAPL_InfoSet(bundle_info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_bundle_set_internal_info - - subroutine info_bundle_set_internal_string(bundle, key, value, rc) - type(ESMF_FieldBundle), intent(inout) :: bundle - character(*), intent(in) :: key - character(*), intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call ESMF_InfoGetFromHost(bundle, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_bundle_set_internal_string - - subroutine info_bundle_set_internal_i4(bundle, key, value, rc) - type(ESMF_FieldBundle), intent(inout) :: bundle - character(*), intent(in) :: key - integer, intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call ESMF_InfoGetFromHost(bundle, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_bundle_set_internal_i4 - - subroutine info_bundle_set_internal_r4_1d(bundle, key, values, rc) - type(ESMF_FieldBundle), intent(inout) :: bundle - character(*), intent(in) :: key - real(kind=ESMF_KIND_R4), dimension(:), intent(in) :: values - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call ESMF_InfoGetFromHost(bundle, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), values=values, _RC) - - _RETURN(_SUCCESS) - end subroutine info_bundle_set_internal_r4_1d - - subroutine info_stateitem_set_internal_string(state, short_name, key, value, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - character(*), intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_set_internal_string - - subroutine info_stateitem_set_internal_logical(state, short_name, key, value, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - logical, intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_set_internal_logical - - subroutine info_stateitem_set_internal_i4(state, short_name, key, value, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - integer, intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_set_internal_i4 - - subroutine info_stateitem_set_internal_r4(state, short_name, key, value, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - real(kind=ESMF_KIND_R4), intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_set_internal_r4 - - subroutine info_stateitem_set_internal_r8(state, short_name, key, value, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - real(kind=ESMF_KIND_R8), intent(in) :: value - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), value=value, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_set_internal_r8 - - - subroutine info_stateitem_set_internal_r4_1d(state, short_name, key, values, rc) - type(ESMF_State), intent(in) :: state - character(*), intent(in) :: short_name - character(*), intent(in) :: key - real(kind=ESMF_KIND_R4), intent(in) :: values(:) - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: info - - call info_stateitem_get_info(state, short_name, info, _RC) - call MAPL_InfoSet(info, key=concat(INFO_INTERNAL_NAMESPACE,key), values=values, _RC) - - _RETURN(_SUCCESS) - end subroutine info_stateitem_set_internal_r4_1d ! private helper procedure @@ -1277,23 +784,6 @@ function concat(namespace, key) result(full_key) full_key = namespace // '/' //key end function concat - - subroutine info_field_copy_shared(field_in, field_out, rc) - type(ESMF_Field), intent(in) :: field_in - type(ESMF_Field), intent(inout) :: field_out - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_Info) :: shared_info, info_out - - shared_info = MAPL_InfoCreateFromShared(field_in, _RC) - call ESMF_InfoGetFromHost(field_out, info_out, _RC) - ! 'force' may be needed in next, but ideally the import field will not yet have an shared space - call MAPL_InfoSet(info_out, INFO_SHARED_NAMESPACE, shared_info, _RC) - - _RETURN(_SUCCESS) - end subroutine info_field_copy_shared - end module mapl3g_InfoUtilities diff --git a/esmf_utils/tests/CMakeLists.txt b/esmf_utils/tests/CMakeLists.txt index 6ed5da9859c7..de743cba1f84 100644 --- a/esmf_utils/tests/CMakeLists.txt +++ b/esmf_utils/tests/CMakeLists.txt @@ -1,7 +1,6 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.esmf_utils.tests") set (test_srcs - Test_FieldDimensionInfo.pf Test_InfoUtilities.pf Test_Ungridded.pf ) diff --git a/esmf_utils/tests/Test_FieldDimensionInfo.pf b/esmf_utils/tests/Test_FieldDimensionInfo.pf deleted file mode 100644 index 1f6a7273a050..000000000000 --- a/esmf_utils/tests/Test_FieldDimensionInfo.pf +++ /dev/null @@ -1,240 +0,0 @@ -#if defined SET_RC -# 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_FieldDimensionInfo - use mapl3g_FieldDimensionInfo - use mapl3g_esmf_info_keys - use mapl3g_UngriddedDim - use mapl3g_UngriddedDimVector - use pfunit - use esmf - use gFTL2_StringVector - - implicit none - - integer, parameter :: NUM_LEVELS_DEFAULT = 3 - 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] - - type(ESMF_Info), allocatable :: bundle_info(:) - -contains - - @Test - subroutine test_get_num_levels() - integer :: status - 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) - 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 safe_dealloc(bundle_info) - - end subroutine test_get_num_levels - - @Test - subroutine test_get_vertical_dim_spec_names() - integer :: status - 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(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.') - @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 - 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 - - call safe_dealloc(bundle_info) - - do i=1, N - EXPECTED_COORDINATES(i,:) = REAL_ARRAY - end do - - 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, 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) :: vert_stagger - 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 - integer :: num_levels_, num_ungridded_ - character(len=:), allocatable :: vert_stagger_ - - num_ungridded_ = -1 - num_levels_ = NUM_LEVELS_DEFAULT - if(present(num_levels)) num_levels_ = num_levels - vert_stagger_ = VERT_STAGGER_DEFAULT - if(present(vert_stagger)) vert_stagger_ = vert_stagger - info = ESMF_InfoCreate(_RC) - call make_vertical_dim(info, vert_stagger_, _RC) - call ESMF_InfoSet(info, KEY_NUM_LEVELS, num_levels_, _RC) - - SET_RC(status) - - 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(status) - - end function make_esmf_info - - subroutine make_vertical_dim(info, vert_stagger, rc) - type(ESMF_Info), intent(inout) :: info - character(len=*), intent(in) :: vert_stagger - integer, optional, intent(out) :: rc - integer :: status - - call ESMF_InfoSet(info, KEY_VERT_STAGGERLOC, vert_stagger, _RC) - SET_RC(status) - - end subroutine make_vertical_dim - - 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 :: key - character(len=:), allocatable :: name, units - real, allocatable :: coord(:) - - 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 - 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 - - if(present(rc)) rc = -1 - 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_UNGRIDDED_DIMS // KEY_NUM_UNGRIDDED_DIMS, num_ungridded, _RC) - - do i=1, num_ungridded - key = KEY_UNGRIDDED_DIMS // make_dim_key(i, _RC) - name = names_(i) - units = units_(i) - coord = coordinates_(i, :) - 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) - - 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(:) - - call destroy_all(info) - deallocate(info) - - end subroutine deallocate_destroy - - 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_FieldDimensionInfo diff --git a/esmf_utils/tests/Test_InfoUtilities.pf b/esmf_utils/tests/Test_InfoUtilities.pf index 2aa9fc7767e3..7e1c009cb812 100644 --- a/esmf_utils/tests/Test_InfoUtilities.pf +++ b/esmf_utils/tests/Test_InfoUtilities.pf @@ -26,28 +26,7 @@ contains call ESMF_StateDestroy(state, _RC) end subroutine test_set_namespace - @test - subroutine test_info_get_internal_info() - type(ESMF_Info) :: subinfo - integer :: status - type(ESMF_Field) :: field - integer, parameter :: expected = 1 - integer :: found - - field = ESMF_FieldEmptyCreate(name='f', _RC) - call MAPL_InfoSetInternal(field, key='d', value=expected, _RC) - call MAPL_InfoSetInternal(field, key='a', value=2, _RC) - - subinfo = MAPL_InfoCreateFromInternal(field, _RC) - call ESMF_InfoGet(subinfo, key='d', value=found, _RC) - @assert_that(found, is(expected)) - - call ESMF_InfoDestroy(subinfo) - call ESMF_FieldDestroy(field) - - end subroutine test_info_get_internal_info - - @test + @test subroutine test_set_stateitem_shared_string() type(ESMF_State) :: state type(ESMF_Field) :: field @@ -373,208 +352,6 @@ contains end subroutine test_setPrivate_is_private - @test - subroutine test_field_set_string() - type(ESMF_Field) :: field - integer :: status - character(len=:), allocatable :: s - character(len=*), parameter :: expected = 'hello' - - field = ESMF_FieldEmptyCreate(name='f', _RC) - - call MAPL_InfoSetInternal(field, key='a', value=expected, _RC) - call MAPL_InfoGetInternal(field, key='a', value=s, _RC) - - @assert_that(s, is(expected)) - - call ESMF_FieldDestroy(field, _RC) - - end subroutine test_field_set_string - - @test - subroutine test_set_stateitem_internal_string() - type(ESMF_State) :: state - type(ESMF_Field) :: field - integer :: status - character(len=:), allocatable :: s - character(len=*), parameter :: expected = 'hello' - - state = ESMF_StateCreate(name='import', _RC) - - field = ESMF_FieldEmptyCreate(name='f', _RC) - call ESMF_StateAdd(state, [field], _RC) - - call MAPL_InfoSetInternal(state, short_name='f', key='a', value=expected, _RC) - call MAPL_InfoGetInternal(state, short_name='f', key='a', value=s, _RC) - - @assert_that(s, is(expected)) - - call ESMF_FieldDestroy(field, _RC) - call ESMF_StateDestroy(state, _RC) - - end subroutine test_set_stateitem_internal_string - - @test - subroutine test_set_stateitem_internal_logical() - type(ESMF_State) :: state - type(ESMF_Field) :: field - integer :: status - logical :: l - logical, parameter :: expected = .true. - - state = ESMF_StateCreate(name='import', _RC) - - field = ESMF_FieldEmptyCreate(name='f', _RC) - call ESMF_StateAdd(state, [field], _RC) - - call MAPL_InfoSetInternal(state, short_name='f', key='a', value=expected, _RC) - l = .false. - call MAPL_InfoGetInternal(state, short_name='f', key='a', value=l, _RC) - - @assert_that(l, is(true())) - - call ESMF_FieldDestroy(field, _RC) - call ESMF_StateDestroy(state, _RC) - - end subroutine test_set_stateitem_internal_logical - - @test - subroutine test_set_stateitem_internal_i4() - type(ESMF_State) :: state - type(ESMF_Field) :: field - integer :: status - integer(kind=ESMF_KIND_I4) :: i - integer(kind=ESMF_KIND_I4), parameter :: expected = 1 - - state = ESMF_StateCreate(name='import', _RC) - - field = ESMF_FieldEmptyCreate(name='f', _RC) - call ESMF_StateAdd(state, [field], _RC) - - call MAPL_InfoSetInternal(state, short_name='f', key='a', value=expected, _RC) - call MAPL_InfoGetInternal(state, short_name='f', key='a', value=i, _RC) - - @assert_that(i, is(expected)) - - call ESMF_FieldDestroy(field, _RC) - call ESMF_StateDestroy(state, _RC) - - end subroutine test_set_stateitem_internal_i4 - - @test - subroutine test_set_stateitem_internal_r4() - type(ESMF_State) :: state - type(ESMF_Field) :: field - integer :: status - real(kind=ESMF_KIND_R4) :: r - real(kind=ESMF_KIND_R4), parameter :: expected = 1.0 - - state = ESMF_StateCreate(name='import', _RC) - - field = ESMF_FieldEmptyCreate(name='f', _RC) - call ESMF_StateAdd(state, [field], _RC) - - call MAPL_InfoSetInternal(state, short_name='f', key='a', value=expected, _RC) - call MAPL_InfoGetInternal(state, short_name='f', key='a', value=r, _RC) - - @assert_that(r, is(expected)) - - call ESMF_FieldDestroy(field, _RC) - call ESMF_StateDestroy(state, _RC) - - end subroutine test_set_stateitem_internal_r4 - - @test - subroutine test_set_stateitem_internal_r8() - type(ESMF_State) :: state - type(ESMF_Field) :: field - integer :: status - real(kind=ESMF_KIND_R8) :: r - real(kind=ESMF_KIND_R8), parameter :: expected = 1.0 - - state = ESMF_StateCreate(name='import', _RC) - - field = ESMF_FieldEmptyCreate(name='f', _RC) - call ESMF_StateAdd(state, [field], _RC) - - call MAPL_InfoSetInternal(state, short_name='f', key='a', value=expected, _RC) - call MAPL_InfoGetInternal(state, short_name='f', key='a', value=r, _RC) - - @assert_that(r, is(expected)) - - call ESMF_FieldDestroy(field, _RC) - call ESMF_StateDestroy(state, _RC) - - end subroutine test_set_stateitem_internal_r8 - - @test - subroutine test_set_stateitem_internal_r4_1d() - type(ESMF_State) :: state - type(ESMF_Field) :: field - integer :: status - real(kind=ESMF_KIND_R4), allocatable :: r(:) - real(kind=ESMF_KIND_R4), parameter :: expected(2) = [1., 2.] - - state = ESMF_StateCreate(name='import', _RC) - - field = ESMF_FieldEmptyCreate(name='f', _RC) - call ESMF_StateAdd(state, [field], _RC) - - call MAPL_InfoSetInternal(state, short_name='f', key='a', values=expected, _RC) - call MAPL_InfoGetInternal(state, short_name='f', key='a', values=r, _RC) - - @assert_that(r, is(equal_to(expected))) - - call ESMF_FieldDestroy(field, _RC) - call ESMF_StateDestroy(state, _RC) - - end subroutine test_set_stateitem_internal_r4_1d - - - @test - subroutine test_setInternal_bundle() - type(ESMF_State) :: state - type(ESMF_FieldBundle) :: bundle - integer :: status - real(ESMF_KIND_R4), allocatable :: w(:) - real(ESMF_KIND_R4), parameter :: expected(2) = [1., 2.] - - state = ESMF_StateCreate(name='import', _RC) - bundle = ESMF_FieldBundleCreate(name='b', _RC) - call ESMF_StateAdd(state, [bundle], _RC) - - call MAPL_InfoSetInternal(state, short_name='b', key='a', values=expected, _RC) - call MAPL_InfoGetInternal(state, short_name='b', key='a', values=w, _RC) - - @assert_that(w, is(equal_to(expected))) - - call ESMF_FieldBundleDestroy(bundle, _RC) - call ESMF_StateDestroy(state, _RC) - - end subroutine test_setInternal_bundle - - @test - subroutine test_copy_shared_field() - type(ESMF_Field) :: f_in, f_out - integer :: status - integer :: ia, ib - - f_in = ESMF_FieldEmptyCreate(name='f_in', _RC) - f_out= ESMF_FieldEmptyCreate(name='f_out', _RC) - - call MAPL_InfoSetShared(f_in, key='a', value=1, _RC) - call MAPL_InfoSetShared(f_in, key='b', value=2, _RC) - - call MAPL_InfoCopyShared(f_in, f_out, _RC) - - call MAPL_InfoGetShared(f_out, key='a', value=ia, _RC) - call MAPL_InfoGetShared(f_out, key='b', value=ib, _RC) - - @assert_that(ia, is(1)) - @assert_that(ib, is(2)) - - end subroutine test_copy_shared_field - end module Test_InfoUtilities diff --git a/field/API.F90 b/field/API.F90 index 5add5fa3d477..49f79dff4af0 100644 --- a/field/API.F90 +++ b/field/API.F90 @@ -2,7 +2,6 @@ module mapl3g_Field_API use mapl3g_FieldCreate use mapl3g_FieldInfo use mapl3g_VerticalStaggerLoc - ! Internal info should not be exposed to users !# use mapl3g_FieldInfo, only: MAPL_FieldInfoGetPrivate !# use mapl3g_FieldInfo, only: MAPL_FieldInfoSetPrivate diff --git a/field/CMakeLists.txt b/field/CMakeLists.txt index 3de315fea60c..2ef078dc3103 100644 --- a/field/CMakeLists.txt +++ b/field/CMakeLists.txt @@ -13,7 +13,6 @@ set(srcs FieldCondensedArray.F90 FieldCondensedArray_private.F90 FieldDelta.F90 - FieldBundleDelta.F90 VerticalStaggerLoc.F90 FieldCreate.F90 FieldReset.F90 diff --git a/field/FieldCondensedArray.F90 b/field/FieldCondensedArray.F90 index 407b81b427bf..5cf627f23dd6 100644 --- a/field/FieldCondensedArray.F90 +++ b/field/FieldCondensedArray.F90 @@ -1,15 +1,16 @@ #include "MAPL_Generic.h" module mapl3g_FieldCondensedArray - use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer use mapl3g_FieldCondensedArray_private, only: ARRAY_RANK, get_fptr_shape_private - use mapl3g_FieldDimensionInfo, only: get_vertical_dim_spec_name - use MAPL_FieldPointerUtilities, only: FieldGetLocalElementCount, assign_fptr - use MAPL_ExceptionHandling + use mapl_FieldPointerUtilities, only: FieldGetLocalElementCount, assign_fptr + use mapl3g_VerticalStaggerLoc + use mapl_ExceptionHandling + use mapl3g_FieldGet use ESMF, only: ESMF_Field, ESMF_FieldGet use ESMF, only: ESMF_KIND_R4, ESMF_KIND_R8, ESMF_KIND_I8 - - implicit none + use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer + implicit none(type, external) private + public :: assign_fptr_condensed_array interface assign_fptr_condensed_array @@ -54,9 +55,8 @@ function get_fptr_shape(f, rc) result(fptr_shape) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: localElementCount(:) logical :: has_vertical - character(len=:), allocatable :: spec_name - character(len=*), parameter :: VERTICAL_DIM_NONE_NAME = 'VERTICAL_DIM_NONE' integer :: geomDimCount + type(VerticalStaggerLoc) :: vert_staggerloc call ESMF_FieldGet(f, geomDimCount=geomDimCount, rank=rank, _RC) _ASSERT(.not. rank < 0, 'rank cannot be negative.') @@ -67,8 +67,8 @@ function get_fptr_shape(f, rc) result(fptr_shape) ! Due to an ESMF bug, getting the localElementCount must use the module function. ! See FieldGetLocalElementCount (specific function) comments. localElementCount = FieldGetLocalElementCount(f, _RC) - spec_name = get_vertical_dim_spec_name(f, _RC) - has_vertical = spec_name /= VERTICAL_DIM_NONE_NAME + call MAPL_FieldGet(f, vert_staggerloc=vert_staggerloc, _RC) + has_vertical = (vert_staggerloc /= VERTICAL_STAGGER_NONE) fptr_shape = get_fptr_shape_private(gridToFieldMap, localElementCount, has_vertical, _RC) _RETURN(_SUCCESS) diff --git a/field/FieldCreate.F90 b/field/FieldCreate.F90 index 30948b586a67..a1e890aa36b8 100644 --- a/field/FieldCreate.F90 +++ b/field/FieldCreate.F90 @@ -86,13 +86,15 @@ subroutine field_empty_complete( field, & integer :: status type(LU_Bound), allocatable :: bounds(:) + type(ESMF_Info) :: field_info bounds = make_bounds(num_levels=num_levels, ungridded_dims=ungridded_dims) call ESMF_FieldEmptyComplete(field, typekind=typekind, & gridToFieldMap=gridToFieldMap, & ungriddedLBound=bounds%lower, ungriddedUBound=bounds%upper, _RC) - call MAPL_FieldInfoSetInternal(field, & + call ESMF_InfoGetFromHost(field, field_info, _RC) + call MAPL_FieldInfoSetInternal(field_info, & ungridded_dims=ungridded_dims, & num_levels=num_levels, vert_staggerloc=vert_staggerloc, & units=units, standard_name=standard_name, long_name=long_name, _RC) diff --git a/field/FieldDelta.F90 b/field/FieldDelta.F90 index a622ede99062..78c89e895add 100644 --- a/field/FieldDelta.F90 +++ b/field/FieldDelta.F90 @@ -12,7 +12,7 @@ module mapl3g_FieldDelta use mapl_ErrorHandling use mapl_KeywordEnforcer use esmf - implicit none + implicit none(type,external) private public :: FieldDelta @@ -241,7 +241,7 @@ subroutine update_num_levels(num_levels, field, ignore, rc) _RETURN_UNLESS(present(num_levels)) _RETURN_IF(ignore == 'num_levels') - call MAPL_InfoSetInternal(field, key=KEY_NUM_LEVELS, value=num_levels, _RC) + call MAPL_FieldSet(field, num_levels=num_levels, _RC) _RETURN(_SUCCESS) end subroutine update_num_levels @@ -257,7 +257,7 @@ subroutine update_units(units, field, ignore, rc) _RETURN_UNLESS(present(units)) _RETURN_IF(ignore == 'units') - call MAPL_InfoSetInternal(field, key=KEY_UNITS, value=units, _RC) + call MAPL_FieldSet(field, units=units, _RC) _RETURN(_SUCCESS) end subroutine update_units diff --git a/field/FieldGet.F90 b/field/FieldGet.F90 index a4b495ccc81c..25887b2d2c5b 100644 --- a/field/FieldGet.F90 +++ b/field/FieldGet.F90 @@ -11,17 +11,22 @@ module mapl3g_FieldGet private public :: MAPL_FieldGet + public :: MAPL_FieldSet interface MAPL_FieldGet procedure field_get end interface MAPL_FieldGet + interface MAPL_FieldSet + procedure field_set + end interface MAPL_FieldSet + contains subroutine field_get(field, unusable, & num_levels, vert_staggerloc, num_vgrid_levels, & ungridded_dims, & - units, & + units, standard_name, & rc) type(ESMF_Field), intent(in) :: field @@ -31,34 +36,54 @@ subroutine field_get(field, unusable, & integer, optional, intent(out) :: num_vgrid_levels type(UngriddedDims), optional, intent(out) :: ungridded_dims character(len=:), optional, allocatable, intent(out) :: units + character(len=:), optional, allocatable, intent(out) :: standard_name 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 (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 + type(ESMF_Info) :: field_info + + call ESMF_InfoGetFromHost(field, field_info, _RC) + + call MAPL_FieldInfoGetInternal(field_info, & + num_levels=num_levels, & + vert_staggerloc=vert_staggerloc, & + num_vgrid_levels=num_vgrid_levels, & + ungridded_dims=ungridded_dims, & + units=units, standard_name=standard_name, _RC) _RETURN(_SUCCESS) end subroutine field_get + subroutine field_set(field, num_levels, vert_staggerloc, & + ungridded_dims, & + units, & + rc) + + type(ESMF_Field), intent(inout) :: field + integer, optional, intent(in) :: num_levels + type(VerticalStaggerLoc), optional, intent(in) :: vert_staggerloc + type(UngriddedDims), optional, intent(in) :: ungridded_dims + character(len=*), optional, intent(in) :: units + + integer, optional, intent(out) :: rc + + integer :: status + type(ESMF_Info) :: field_info + + call ESMF_InfoGetFromHost(field, field_info, _RC) + + call MAPL_FieldInfoSetInternal(field_info, & + num_levels=num_levels, & + vert_staggerloc=vert_staggerloc, & + ungridded_dims=ungridded_dims, & + units=units, _RC) + + _RETURN(_SUCCESS) + end subroutine field_set + + end module mapl3g_FieldGet diff --git a/field/FieldInfo.F90 b/field/FieldInfo.F90 index ad50d9caf56a..9ae9c90295e8 100644 --- a/field/FieldInfo.F90 +++ b/field/FieldInfo.F90 @@ -1,31 +1,31 @@ #include "MAPL_Generic.h" module mapl3g_FieldInfo + use mapl3g_esmf_info_keys, only: INFO_SHARED_NAMESPACE use mapl3g_esmf_info_keys, only: INFO_INTERNAL_NAMESPACE + use mapl3g_esmf_info_keys, only: INFO_PRIVATE_NAMESPACE use mapl3g_InfoUtilities use mapl3g_UngriddedDims use mapl3g_VerticalStaggerLoc use mapl_KeywordEnforcer use mapl_ErrorHandling - use esmf, only: ESMF_Field - use esmf, only: ESMF_Info, ESMF_InfoGetFromHost, ESMF_InfoCreate + use esmf implicit none(type,external) private + public :: MAPL_FieldInfoGetShared + public :: MAPL_FieldInfoSetShared public :: MAPL_FieldInfoSetInternal public :: MAPL_FieldInfoGetInternal + public :: MAPL_FieldInfoCopyShared - public :: KEY_TYPEKIND - public :: KEY_UNITS - public :: KEY_LONG_NAME - public :: KEY_STANDARD_NAME - public :: KEY_NUM_LEVELS - public :: KEY_VERT_STAGGERLOC - public :: KEY_UNGRIDDED_DIMS + interface MAPL_FieldInfoSetShared + procedure info_field_set_shared_i4 + end interface MAPL_FieldInfoSetShared - public :: KEY_UNDEF_VALUE - public :: KEY_MISSING_VALUE - public :: KEY_FILL_VALUE + interface MAPL_FieldInfoGetShared + procedure info_field_get_shared_i4 + end interface MAPL_FieldInfoGetShared interface MAPL_FieldInfoSetInternal module procedure field_info_set_internal @@ -35,7 +35,10 @@ module mapl3g_FieldInfo module procedure field_info_get_internal end interface - character(*), parameter :: KEY_TYPEKIND = "/typekind" + interface MAPL_FieldInfoCopyShared + procedure :: field_info_copy_shared + end interface MAPL_FieldInfoCopyShared + character(*), parameter :: KEY_UNITS = "/units" character(*), parameter :: KEY_LONG_NAME = "/long_name" character(*), parameter :: KEY_STANDARD_NAME = "/standard_name" @@ -49,13 +52,16 @@ module mapl3g_FieldInfo contains - subroutine field_info_set_internal(field, unusable, num_levels, & - vert_staggerloc, ungridded_dims, & + subroutine field_info_set_internal(info, unusable, & + namespace, & + num_levels, vert_staggerloc, & + ungridded_dims, & units, long_name, standard_name, & rc) - type(ESMF_Field), intent(inout) :: field + type(ESMF_Info), intent(inout) :: info class(KeywordEnforcer), optional, intent(in) :: unusable + character(*), optional, intent(in) :: namespace integer, optional, intent(in) :: num_levels type(VerticalStaggerLoc), optional, intent(in) :: vert_staggerloc type(UngriddedDims), optional, intent(in) :: ungridded_dims @@ -65,47 +71,51 @@ subroutine field_info_set_internal(field, unusable, num_levels, & integer, optional, intent(out) :: rc integer :: status - type(ESMF_Info) :: ungridded_info, field_info + type(ESMF_Info) :: ungridded_info + character(:), allocatable :: namespace_ - call ESMF_InfoGetFromHost(field, field_info, _RC) + namespace_ = INFO_INTERNAL_NAMESPACE + if (present(namespace)) then + namespace_ = namespace + end if if (present(ungridded_dims)) then ungridded_info = ungridded_dims%make_info(_RC) - call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // KEY_UNGRIDDED_DIMS, ungridded_info, _RC) + call MAPL_InfoSet(info, namespace_ // KEY_UNGRIDDED_DIMS, ungridded_info, _RC) end if if (present(units)) then - call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // KEY_UNITS, units, _RC) + call MAPL_InfoSet(info, namespace_ // KEY_UNITS, units, _RC) end if if (present(long_name)) then - call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // KEY_LONG_NAME, long_name, _RC) + call MAPL_InfoSet(info, namespace_ // KEY_LONG_NAME, long_name, _RC) end if if (present(standard_name)) then - call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // KEY_STANDARD_NAME, standard_name, _RC) + call MAPL_InfoSet(info, namespace_ // KEY_STANDARD_NAME, standard_name, _RC) end if if (present(num_levels)) then - call MAPL_InfoSet(field_info, INFO_INTERNAL_NAMESPACE // KEY_NUM_LEVELS, num_levels, _RC) + call MAPL_InfoSet(info, 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) + call MAPL_InfoSet(info, 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) + call MAPL_InfoSet(info, namespace_ // "/vertical_dim/vloc", "VERTICAL_DIM_NONE", _RC) + call MAPL_InfoSet(info, 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) + call MAPL_InfoSet(info, namespace_ // "/vertical_dim/vloc", "VERTICAL_DIM_EDGE", _RC) + call MAPL_InfoSet(info, 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) + call MAPL_InfoSet(info, namespace_ // "/vertical_dim/vloc", "VERTICAL_DIM_CENTER", _RC) + call MAPL_InfoSet(info, namespace_ // "/vertical_grid/num_levels", num_levels, _RC) else _FAIL('unsupported vertical stagger') end if @@ -117,13 +127,15 @@ subroutine field_info_set_internal(field, unusable, num_levels, & _UNUSED_DUMMY(unusable) end subroutine field_info_set_internal - subroutine field_info_get_internal(field, unusable, & + subroutine field_info_get_internal(info, unusable, & + namespace, & num_levels, vert_staggerloc, num_vgrid_levels, & units, long_name, standard_name, & ungridded_dims, rc) - type(ESMF_Field), intent(in) :: field + type(ESMF_Info), intent(in) :: info class(KeywordEnforcer), optional, intent(in) :: unusable + character(*), optional, intent(in) :: namespace integer, optional, intent(out) :: num_levels type(VerticalStaggerLoc), optional, intent(out) :: vert_staggerloc integer, optional, intent(out) :: num_vgrid_levels @@ -135,26 +147,30 @@ subroutine field_info_get_internal(field, unusable, & integer :: status integer :: num_levels_ - type(ESMF_Info) :: ungridded_info, field_info + type(ESMF_Info) :: ungridded_info character(:), allocatable :: vert_staggerloc_str type(VerticalStaggerLoc) :: vert_staggerloc_ + character(:), allocatable :: namespace_ - call ESMF_InfoGetFromHost(field, field_info, _RC) + namespace_ = INFO_INTERNAL_NAMESPACE + if (present(namespace)) then + namespace_ = namespace + end if if (present(ungridded_dims)) then - ungridded_info = ESMF_InfoCreate(field_info, INFO_INTERNAL_NAMESPACE // KEY_UNGRIDDED_DIMS, _RC) + ungridded_info = ESMF_InfoCreate(info, namespace_ // KEY_UNGRIDDED_DIMS, _RC) 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) + call MAPL_InfoGet(info, 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) + call MAPL_InfoGet(info, namespace_ // KEY_VERT_STAGGERLOC, vert_staggerloc_str, _RC) vert_staggerloc_ = VerticalStaggerLoc(vert_staggerloc_str) if (present(vert_staggerloc)) then vert_staggerloc = vert_staggerloc_ @@ -174,19 +190,82 @@ subroutine field_info_get_internal(field, unusable, & end if if (present(units)) then - call MAPL_InfoGet(field_info, INFO_INTERNAL_NAMESPACE // KEY_UNITS, units, _RC) + call MAPL_InfoGet(info, namespace_ // KEY_UNITS, units, _RC) end if if (present(long_name)) then - call MAPL_InfoGet(field_info, INFO_INTERNAL_NAMESPACE // KEY_LONG_NAME, long_name, _RC) + call MAPL_InfoGet(info, namespace_ // KEY_LONG_NAME, long_name, _RC) end if if (present(standard_name)) then - call MAPL_InfoGet(field_info, INFO_INTERNAL_NAMESPACE // KEY_STANDARD_NAME, standard_name, _RC) + call MAPL_InfoGet(info, namespace_ // KEY_STANDARD_NAME, standard_name, _RC) end if _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end subroutine field_info_get_internal + + subroutine info_field_get_shared_i4(field, key, value, unusable, rc) + type(ESMF_Field), intent(in) :: field + character(*), intent(in) :: key + integer(kind=ESMF_KIND_I4), intent(out) :: value + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: rc + + integer :: status + type(ESMF_Info) :: field_info + + call ESMF_InfoGetFromHost(field, field_info, _RC) + call MAPL_InfoGet(field_info, key=concat(INFO_SHARED_NAMESPACE,key), value=value, _RC) + + _RETURN(_SUCCESS) + end subroutine info_field_get_shared_i4 + + + subroutine info_field_set_shared_i4(field, key, value, rc) + type(ESMF_Field), intent(in) :: field + character(*), intent(in) :: key + integer(kind=ESMF_KIND_I4), intent(in) :: value + integer, optional, intent(out) :: rc + + integer :: status + type(ESMF_Info) :: field_info + + call ESMF_InfoGetFromHost(field, field_info, _RC) + call MAPL_InfoSet(field_info, key=concat(INFO_SHARED_NAMESPACE,key), value=value, _RC) + + _RETURN(_SUCCESS) + end subroutine info_field_set_shared_i4 + + subroutine field_info_copy_shared(field_in, field_out, rc) + type(ESMF_Field), intent(in) :: field_in + type(ESMF_Field), intent(inout) :: field_out + integer, optional, intent(out) :: rc + + integer :: status + type(ESMF_Info) :: shared_info, info_out + + shared_info = MAPL_InfoCreateFromShared(field_in, _RC) + call ESMF_InfoGetFromHost(field_out, info_out, _RC) + ! 'force' may be needed in next, but ideally the import field will not yet have an shared space + call MAPL_InfoSet(info_out, INFO_SHARED_NAMESPACE, shared_info, _RC) + + _RETURN(_SUCCESS) + end subroutine field_info_copy_shared + + function concat(namespace, key) result(full_key) + character(*), intent(in) :: namespace + character(*), intent(in) :: key + character(len(namespace)+len(key)+1) :: full_key + + if (key(1:1) == '/') then + full_key = namespace // key + return + end if + full_key = namespace // '/' //key + + end function concat + + end module mapl3g_FieldInfo diff --git a/field/FieldUtilities.F90 b/field/FieldUtilities.F90 index 3221474055cf..e1c35685b90c 100644 --- a/field/FieldUtilities.F90 +++ b/field/FieldUtilities.F90 @@ -2,7 +2,6 @@ module MAPL_FieldUtilities use mapl3g_FieldInfo - use mapl3g_FieldDimensionInfo use MAPL_ErrorHandlingMod use MAPL_FieldPointerUtilities use mapl3g_InfoUtilities @@ -19,9 +18,6 @@ module MAPL_FieldUtilities public :: FieldNegate public :: FieldPow - public :: MAPL_FieldBundleGet - public :: MAPL_FieldBundleSet - interface FieldIsConstant procedure FieldIsConstantR4 end interface FieldIsConstant @@ -205,119 +201,6 @@ subroutine FieldPow(field_out,field_in,expo,rc) end subroutine FieldPow - ! Supplement ESMF - subroutine MAPL_FieldBundleGet(fieldBundle, unusable, fieldList, geom, typekind, ungriddedUbound, rc) - type(ESMF_FieldBundle), intent(in) :: fieldBundle - class(KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Field), optional, allocatable, intent(out) :: fieldList(:) - type(ESMF_Geom), optional, intent(out) :: geom - type(ESMF_TypeKind_Flag), optional, intent(out) :: typekind - integer, allocatable, optional, intent(out) :: ungriddedUbound(:) - integer, optional, intent(out) :: rc - - integer :: status - integer :: fieldCount - type(ESMF_GeomType_Flag) :: geomtype - character(:), allocatable :: typekind_str - type(ESMF_Info) :: ungridded_info - type(UngriddedDims) :: ungridded_dims - type(LU_Bound), allocatable :: bounds(:) - integer :: num_levels - character(:), allocatable :: vert_staggerloc - - if (present(fieldList)) then - call ESMF_FieldBundleGet(fieldBundle, fieldCount=fieldCount, _RC) - allocate(fieldList(fieldCount)) - call ESMF_FieldBundleGet(fieldBundle, fieldList=fieldList, itemOrderflag=ESMF_ITEMORDER_ADDORDER, _RC) - end if - - if (present(geom)) then - call get_geom(fieldBundle, geom, rc) - end if - - if (present(typekind)) then - call MAPL_InfoGetInternal(fieldBundle, key=KEY_TYPEKIND, value=typekind_str, _RC) - select case (typekind_str) - case ('R4') - typekind = ESMF_TYPEKIND_R4 - case ('R8') - typekind = ESMF_TYPEKIND_R8 - case ('I4') - typekind = ESMF_TYPEKIND_I4 - case ('I8') - typekind = ESMF_TYPEKIND_I8 - case ('LOGICAL') - typekind = ESMF_TYPEKIND_LOGICAL - case default - _FAIL('unsupported typekind') - end select - end if - - if (present(ungriddedUbound)) then - ungridded_info = MAPL_InfoCreateFromInternal(fieldBundle, _RC) - ungridded_dims = make_ungriddedDims(ungridded_info, KEY_UNGRIDDED_DIMS, _RC) - bounds = ungridded_dims%get_bounds() - - 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) - bounds = [LU_Bound(1, num_levels), bounds] - end if - ungriddedUbound = bounds%upper - end if - - _RETURN(_SUCCESS) - - contains - - subroutine get_geom(fieldBundle, geom, rc) - type(ESMF_FieldBundle), intent(in) :: fieldBundle - type(ESMF_Geom), intent(inout) :: geom - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_GeomType_Flag) :: geomtype - type(ESMF_Grid) :: grid - - call ESMF_FieldBundleGet(fieldBundle, geomtype=geomtype, _RC) - if (geomtype == ESMF_GEOMTYPE_GRID) then - call ESMF_FieldBundleGet(fieldBundle, grid=grid, _RC) - ! memory leak - geom = ESMF_GeomCreate(grid=grid, _RC) - _RETURN(_SUCCESS) - end if - - _FAIL('unsupported geomtype; needs simple extension') - - _RETURN(_SUCCESS) - end subroutine get_geom - - end subroutine MAPL_FieldBundleGet - - subroutine MAPL_FieldBundleSet(fieldBundle, unusable, geom, rc) - type(ESMF_FieldBundle), intent(inout) :: fieldBundle - class(KeywordEnforcer), optional, intent(in) :: unusable - type(ESMF_Geom), optional, intent(in) :: geom - integer, optional, intent(out) :: rc - - integer :: status - type(ESMF_GeomType_Flag) :: geomtype - type(ESMF_Grid) :: grid - - if (present(geom)) then - call ESMF_GeomGet(geom, geomtype=geomtype, _RC) - if (geomtype == ESMF_GEOMTYPE_GRID) then - call ESMF_GeomGet(geom, grid=grid, _RC) - call ESMF_FieldBundleSet(fieldBundle, grid=grid, _RC) - _RETURN(_SUCCESS) - end if - _FAIL('unsupported geomtype') - end if - - _RETURN(_SUCCESS) - end subroutine MAPL_FieldBundleSet - - end module MAPL_FieldUtilities diff --git a/field/VerticalStaggerLoc.F90 b/field/VerticalStaggerLoc.F90 index 747074c3c7bb..dfd4a7ec7dcf 100644 --- a/field/VerticalStaggerLoc.F90 +++ b/field/VerticalStaggerLoc.F90 @@ -11,6 +11,13 @@ module mapl3g_VerticalStaggerLoc public :: operator(==) public :: operator(/=) + enum, bind(c) + enumerator :: NONE=0 + enumerator :: EDGE=1 + enumerator :: CENTER=2 + enumerator :: INVALID=-1 + end enum + ! 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 @@ -18,10 +25,12 @@ module mapl3g_VerticalStaggerLoc ! modules. Subtle. type :: VerticalStaggerLoc private - integer :: id = -1 + integer :: id = INVALID character(24) :: name = "VERTICAL_STAGGER_INVALID" contains procedure :: to_string + procedure :: get_dimension_name + procedure :: get_num_levels end type VerticalStaggerLoc interface VerticalStaggerLoc @@ -36,10 +45,15 @@ module mapl3g_VerticalStaggerLoc procedure are_not_equal end interface operator(/=) - 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") + character(*), parameter :: DIM_NAME_NONE = "" + character(*), parameter :: DIM_NAME_EDGE = "edge" + character(*), parameter :: DIM_NAME_CENTER = "lev" + character(*), parameter :: DIM_NAME_INVALID = "invalid" + + type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_NONE = VerticalStaggerLoc(NONE, "VERTICAL_STAGGER_NONE") + type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_EDGE = VerticalStaggerLoc(EDGE, "VERTICAL_STAGGER_EDGE") + type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_CENTER = VerticalStaggerLoc(CENTER, "VERTICAL_STAGGER_CENTER") + type(VerticalStaggerLoc), parameter :: VERTICAL_STAGGER_INVALID = VerticalStaggerLoc(INVALID, "VERTICAL_STAGGER_INVALID") contains @@ -80,4 +94,36 @@ elemental logical function are_not_equal(this, that) are_not_equal = .not. (this == that) end function are_not_equal + function get_dimension_name(this) result(dim_name) + character(:), allocatable :: dim_name + class(VerticalStaggerLoc), intent(in) :: this + + select case (this%id) + case (NONE) + dim_name = DIM_NAME_NONE + case (EDGE) + dim_name = DIM_NAME_EDGE + case (CENTER) + dim_name = DIM_NAME_CENTER + case default + dim_name = DIM_NAME_INVALID + end select + end function get_dimension_name + + integer function get_num_levels(this, num_vgrid_levels) result(num_levels) + class(VerticalStaggerLoc), intent(in) :: this + integer, intent(in) :: num_vgrid_levels + + select case (this%id) + case (NONE) + num_levels = 0 + case (EDGE) + num_levels = num_vgrid_levels + case (CENTER) + num_levels = num_vgrid_levels - 1 + case default + num_levels = -1 + end select + end function get_num_levels + end module mapl3g_VerticalStaggerLoc diff --git a/field/tests/CMakeLists.txt b/field/tests/CMakeLists.txt index 2af91a09e700..b49de6d94e68 100644 --- a/field/tests/CMakeLists.txt +++ b/field/tests/CMakeLists.txt @@ -18,7 +18,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 + Test_FieldDelta.pf Test_FieldInfo.pf LINK_LIBRARIES MAPL.field MAPL.pfunit EXTRA_INITIALIZE Initialize EXTRA_USE MAPL_pFUnit_Initialize diff --git a/field/tests/Test_FieldDelta.pf b/field/tests/Test_FieldDelta.pf index ee2588e22e55..cef962535e95 100644 --- a/field/tests/Test_FieldDelta.pf +++ b/field/tests/Test_FieldDelta.pf @@ -2,6 +2,7 @@ #include "unused_dummy.H" module Test_FieldDelta use mapl3g_FieldDelta + use mapl3g_FieldGet use mapl3g_FieldCreate use mapl3g_FieldInfo use mapl3g_UngriddedDims @@ -37,7 +38,7 @@ contains geom = ESMF_GeomCreate(grid, _RC) f = ESMF_FieldCreate(geom, typekind=ESMF_TYPEKIND_R4, name='in', _RC) - call MAPL_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) + call MAPL_FieldSet(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) @@ -69,7 +70,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_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) + call MAPL_FieldSet(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) call ESMF_FieldGet(f, fArrayPtr=x, _RC) x = FILL_VALUE @@ -108,7 +109,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_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) + call MAPL_FieldSet(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) @@ -147,7 +148,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_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) + call MAPL_FieldSet(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) call ESMF_FieldGet(f, fArrayPtr=x, _RC) x = FILL_VALUE @@ -191,7 +192,7 @@ contains f = ESMF_FieldCreate(geom, typekind=ESMF_TYPEKIND_R4, name='in', & 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) + call MAPL_FieldSet(f, num_levels=ORIG_VGRID_LEVELS+1, vert_staggerloc=VERTICAL_STAGGER_EDGE, _RC) delta = FieldDelta(num_levels=NEW_NUM_LEVELS+1) ! edge call delta%reallocate_field(f, _RC) @@ -231,7 +232,7 @@ contains ! Surface field f = ESMF_FieldCreate(geom, typekind=ESMF_TYPEKIND_R4, name='in', & ungriddedLbound=[1,1], ungriddedUbound=[2,3], _RC) - call MAPL_FieldInfoSetInternal(f, num_levels=0, vert_staggerloc=VERTICAL_STAGGER_NONE, _RC) + call MAPL_FieldSet(f, num_levels=0, vert_staggerloc=VERTICAL_STAGGER_NONE, _RC) call ESMF_FieldGet(f, fArrayPtr=x, _RC) x = FILL_VALUE @@ -325,9 +326,9 @@ contains f_ref = ESMF_FieldCreate(geom_ref, typekind=ESMF_TYPEKIND_R8, name='in', & ungriddedLbound=[1,1], ungriddedUbound=[ORIG_VGRID_LEVELS-1,3], _RC) - call MAPL_FieldInfoSetInternal(f, num_levels=ORIG_VGRID_LEVELS, vert_staggerloc=VERTICAL_STAGGER_CENTER, & + call MAPL_FieldSet(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, & + call MAPL_FieldSet(f_ref, num_levels=ORIG_VGRID_LEVELS, vert_staggerloc=VERTICAL_STAGGER_CENTER, & units=REFERENCE_UNITS, _RC) @@ -339,7 +340,7 @@ contains @assert_that(typekind == ESMF_TYPEKIND_R8, is(true())) @assert_that(new_geom == geom, is(true())) - call MAPL_InfoGetInternal(f, key=KEY_UNITS, value=new_units, _RC) + call MAPL_FieldGet(f, units=new_units, _RC) @assertEqual(REFERENCE_UNITS, new_units) ! check that field shape is changed due to new num levels diff --git a/field/tests/Test_FieldInfo.pf b/field/tests/Test_FieldInfo.pf new file mode 100644 index 000000000000..f6e30bfce6f0 --- /dev/null +++ b/field/tests/Test_FieldInfo.pf @@ -0,0 +1,33 @@ +#include "MAPL_TestErr.h" + +module Test_FieldInfo + use pfunit + use mapl3g_FieldInfo + use esmf + implicit none(type,external) + +contains + + @test + subroutine test_copy_shared_field() + type(ESMF_Field) :: f_in, f_out + integer :: status + integer :: ia, ib + + f_in = ESMF_FieldEmptyCreate(name='f_in', _RC) + f_out= ESMF_FieldEmptyCreate(name='f_out', _RC) + + call MAPL_FieldInfoSetShared(f_in, key='a', value=1, _RC) + call MAPL_FieldInfoSetShared(f_in, key='b', value=2, _RC) + + call MAPL_FieldInfoCopyShared(f_in, f_out, _RC) + + call MAPL_FieldInfoGetShared(f_out, key='a', value=ia, _RC) + call MAPL_FieldInfoGetShared(f_out, key='b', value=ib, _RC) + + @assert_that(ia, is(1)) + @assert_that(ib, is(2)) + + end subroutine test_copy_shared_field + +end module Test_FieldInfo diff --git a/field_bundle/CMakeLists.txt b/field_bundle/CMakeLists.txt new file mode 100644 index 000000000000..b5c9ea6e7aa8 --- /dev/null +++ b/field_bundle/CMakeLists.txt @@ -0,0 +1,24 @@ +esma_set_this (OVERRIDE MAPL.field_bundle) + +set(srcs + FieldBundleType_Flag.F90 + FieldBundleGet.F90 + FieldBundleInfo.F90 + FieldBundleDelta.F90 +) + +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 ESMF::ESMF + TYPE SHARED + ) + +if (PFUNIT_FOUND) + add_subdirectory(tests EXCLUDE_FROM_ALL) +endif () diff --git a/field/FieldBundleDelta.F90 b/field_bundle/FieldBundleDelta.F90 similarity index 85% rename from field/FieldBundleDelta.F90 rename to field_bundle/FieldBundleDelta.F90 index 69e4ad76621d..ef6dbb8d8179 100644 --- a/field/FieldBundleDelta.F90 +++ b/field_bundle/FieldBundleDelta.F90 @@ -4,6 +4,8 @@ #include "MAPL_Exceptions.h" module mapl3g_FieldBundleDelta + use mapl3g_FieldBundleGet + use mapl3g_FieldBundleType_Flag use mapl3g_LU_Bound use mapl3g_FieldDelta use mapl3g_InfoUtilities @@ -14,15 +16,15 @@ module mapl3g_FieldBundleDelta use mapl_FieldUtilities use mapl3g_UngriddedDims use mapl_FieldPointerUtilities - use mapl3g_esmf_info_keys, only: KEY_INTERPOLATION_WEIGHTS use mapl_ErrorHandling use mapl_KeywordEnforcer use esmf - implicit none (type, external) + implicit none(type, external) private public :: FieldBundleDelta + ! Note fieldCount can be derivedy from weights type :: FieldBundleDelta private type(FieldDelta) :: field_delta ! constant across bundle @@ -98,8 +100,8 @@ subroutine compute_interpolation_weights_delta(interpolation_weights, bundle_a, integer :: status real(ESMF_KIND_R4), allocatable :: weights_a(:), weights_b(:) - call MAPL_InfoGetInternal(bundle_a, key=KEY_INTERPOLATION_WEIGHTS, values=weights_a, _RC) - call MAPL_InfoGetInternal(bundle_b, key=KEY_INTERPOLATION_WEIGHTS, values=weights_b, _RC) + call MAPL_FieldBundleGet(bundle_a, interpolation_weights=weights_a, _RC) + call MAPL_FieldBundleGet(bundle_b, interpolation_weights=weights_b, _RC) if (any(weights_a /= weights_b)) then interpolation_weights = weights_b @@ -118,20 +120,23 @@ subroutine compute_field_delta(field_delta, bundle_a, bundle_b, rc) integer :: status integer :: fieldCount_a, fieldCount_b type(ESMF_Field), allocatable :: fieldList_a(:), fieldList_b(:) + type(FieldBundleType_Flag) :: fieldBundleType_a, fieldBundleType_b - call ESMF_FieldBundleGet(bundle_a, fieldCount=fieldCount_a, _RC) - call ESMF_FieldBundleGet(bundle_b, fieldCount=fieldCount_b, _RC) - allocate(fieldList_a(fieldCount_a), fieldList_b(fieldCount_b)) + call MAPL_FieldBundleGet(bundle_a, & + fieldCount=fieldCount_a, fieldBundleType=fieldBundleType_a, fieldList=fieldList_a, _RC) + call MAPL_FieldBundleGet(bundle_b, & + fieldCount=fieldCount_b, fieldBundleType=fieldBundleType_b, fieldList=fieldList_b, _RC) - if ((fieldCount_a > 0) .and. (fieldCount_b > 0)) then - call ESMF_FieldBundleGet(bundle_a, fieldList=fieldList_a, _RC) - call ESMF_FieldBundleGet(bundle_b, fieldList=fieldList_b, _RC) + _ASSERT(fieldBundleType_a == FIELDBUNDLETYPE_BRACKET, 'incorrect type of FieldBundle') + _ASSERT(fieldBundleType_b == FIELDBUNDLETYPE_BRACKET, 'incorrect type of FieldBundle') + + ! TODO: add check thta name of 1st field is "bracket-prototype" or similar. + if (fieldCount_a > 0 .and. fieldCount_b > 0) then call field_delta%initialize(fieldList_a(1), fieldList_b(1), _RC) _RETURN(_SUCCESS) end if - if (fieldCount_b > 0) then - call ESMF_FieldBundleGet(bundle_b, fieldList=fieldList_b, _RC) + if (fieldCount_b > 1) then ! full FieldDelta call field_delta%initialize(fieldList_b(1), _RC) _RETURN(_SUCCESS) @@ -182,7 +187,7 @@ subroutine update_interpolation_weights(interpolation_weights, bundle, ignore, r _RETURN_UNLESS(present(interpolation_weights)) _RETURN_IF(ignore == 'interpolation_weights') - call MAPL_InfoSetInternal(bundle, KEY_INTERPOLATION_WEIGHTS, values=interpolation_weights, _RC) + call MAPL_FieldBundleSet(bundle, interpolation_weights=interpolation_weights, _RC) _RETURN(_SUCCESS) end subroutine update_interpolation_weights @@ -209,7 +214,6 @@ subroutine reallocate_bundle(this, bundle, ignore, unusable, rc) type(LU_Bound) :: vertical_bounds type(ESMF_TypeKind_Flag) :: typekind integer, allocatable :: ungriddedLbound(:), ungriddedUbound(:) - type(ESMF_Info) :: ungridded_info integer :: old_field_count, new_field_count integer, allocatable :: num_levels character(:), allocatable :: units, vert_staggerloc_str @@ -238,19 +242,18 @@ subroutine reallocate_bundle(this, bundle, ignore, unusable, rc) allocate(fieldList(new_field_count)) ! Need geom, typekind, and bounds to allocate fields before - call MAPL_FieldBundleGet(bundle, geom=bundle_geom, _RC) - 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_FieldBundleGet(bundle, geom=bundle_geom, & + typekind=typekind, & + ungridded_dims=ungridded_dims, & + units=units, & + vert_staggerloc=vert_staggerloc, & + _RC) - 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 so that it is PRESENT() int FieldEmptyComplete() below. allocate(num_levels) - call MAPL_InfoGetInternal(bundle, KEY_NUM_LEVELS, value=num_levels, _RC) + call MAPL_FieldBundleGet(bundle, num_levels=num_levels, _RC) end if do i = 1, new_field_count @@ -262,8 +265,6 @@ subroutine reallocate_bundle(this, bundle, ignore, unusable, rc) units=units, _RC) end do - call ESMF_InfoDestroy(ungridded_info, _RC) - allocate(fieldNameList(old_field_count)) call ESMF_FieldBundleGet(bundle, fieldNameList=fieldNameList, _RC) call ESMF_FieldBundleRemove(bundle, fieldNameList, multiflag=.true., _RC) diff --git a/field_bundle/FieldBundleGet.F90 b/field_bundle/FieldBundleGet.F90 new file mode 100644 index 000000000000..dcf3aa18d635 --- /dev/null +++ b/field_bundle/FieldBundleGet.F90 @@ -0,0 +1,151 @@ +#include "MAPL_Generic.h" + +module mapl3g_FieldBundleGet + use mapl_KeywordEnforcer + use mapl_ErrorHandling + use mapl3g_Field_API + use mapl3g_UngriddedDims + use mapl3g_FieldBundleType_Flag + use mapl3g_FieldBundleInfo + use mapl3g_InfoUtilities + use mapl3g_LU_Bound + use esmf + implicit none + private + + public :: MAPL_FieldBundleGet + public :: MAPL_FieldBundleSet + + + interface MAPL_FieldBundleGet + procedure bundle_get + end interface MAPL_FieldBundleGet + + interface MAPL_FieldBundleSet + procedure bundle_set + end interface MAPL_FieldBundleSet + + character(*), parameter :: KEY_FIELD_BUNDLE_TYPE = '/fieldBundleType' + +contains + + ! Supplement ESMF + subroutine bundle_get(fieldBundle, unusable, fieldCount, fieldList, & + fieldBundleType, typekind, interpolation_weights, & + geom, ungridded_dims, units, num_levels, vert_staggerloc, num_vgrid_levels, rc) + type(ESMF_FieldBundle), intent(in) :: fieldBundle + class(KeywordEnforcer), optional, intent(in) :: unusable + integer, optional, intent(out) :: fieldCount + type(ESMF_Field), optional, allocatable, intent(out) :: fieldList(:) + type(FieldBundleType_Flag), optional, intent(out) :: fieldBundleType + type(ESMF_TypeKind_Flag), optional, intent(out) :: typekind + real(ESMF_KIND_R4), optional, allocatable, intent(out) :: interpolation_weights(:) + type(ESMF_Geom), optional, intent(out) :: geom + type(UngriddedDims), optional, intent(out) :: ungridded_dims + type(VerticalStaggerLoc), optional, intent(out) :: vert_staggerloc + character(:), optional, allocatable, intent(out) :: units + integer, optional, intent(out) :: num_levels + integer, optional, intent(out) :: num_vgrid_levels + integer, optional, intent(out) :: rc + + integer :: status + integer :: fieldCount_ + type(ESMF_Info) :: bundle_info + + if (present(fieldCount) .or. present(fieldList)) then + call ESMF_FieldBundleGet(fieldBundle, fieldCount=fieldCount_, _RC) + if (present(fieldCount)) then + fieldCount = fieldCount_ + end if + end if + + if (present(fieldList)) then + allocate(fieldList(fieldCount_)) + call ESMF_FieldBundleGet(fieldBundle, fieldList=fieldList, itemOrderflag=ESMF_ITEMORDER_ADDORDER, _RC) + end if + + ! Get these from FieldBundleInfo + call ESMF_InfoGetFromHost(fieldBundle, bundle_info, _RC) + call MAPL_FieldBundleInfoGetInternal(bundle_info, ungridded_dims=ungridded_dims, typekind=typekind, & + fieldBundleType=fieldBundleType, interpolation_weights=interpolation_weights, vert_staggerloc=vert_staggerloc, & + units=units, num_levels=num_levels, num_vgrid_levels=num_vgrid_levels, _RC) + + if (present(geom)) then + call get_geom(fieldBundle, geom, rc) + end if + + call MAPL_FieldBundleInfoGetInternal(bundle_info, typekind=typekind, fieldBundleType=fieldBundleType, _RC) + + _RETURN(_SUCCESS) + + contains + + subroutine get_geom(fieldBundle, geom, rc) + type(ESMF_FieldBundle), intent(in) :: fieldBundle + type(ESMF_Geom), intent(inout) :: geom + integer, optional, intent(out) :: rc + + integer :: status + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_Grid) :: grid + + call ESMF_FieldBundleGet(fieldBundle, geomtype=geomtype, _RC) + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldBundleGet(fieldBundle, grid=grid, _RC) + ! probable memory leak + geom = ESMF_GeomCreate(grid=grid, _RC) + _RETURN(_SUCCESS) + end if + + _FAIL('unsupported geomtype; needs simple extension') + + _RETURN(_SUCCESS) + end subroutine get_geom + + end subroutine bundle_get + + subroutine bundle_set(fieldBundle, unusable, & + fieldBundleType, typekind, geom, & + interpolation_weights, ungridded_dims, & + num_levels, vert_staggerloc, & + units, & + rc) + + type(ESMF_FieldBundle), intent(inout) :: fieldBundle + class(KeywordEnforcer), optional, intent(in) :: unusable + type(FieldBundleType_Flag), optional, intent(in) :: fieldBundleType + type(ESMF_TypeKind_Flag), optional, intent(in) :: typekind + type(ESMF_Geom), optional, intent(in) :: geom + real(ESMF_KIND_R4), optional, intent(in) :: interpolation_weights(:) + type(UngriddedDims), optional, intent(in) :: ungridded_dims + integer, optional, intent(in) :: num_levels + type(VerticalStaggerLoc), optional, intent(in) :: vert_staggerloc + character(*), optional, intent(in) :: units + integer, optional, intent(out) :: rc + + integer :: status + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_Grid) :: grid + type(ESMF_Info) :: bundle_info + + ! Some things are treated as field info: + call ESMF_InfoGetFromHost(fieldBundle, bundle_info, _RC) + call MAPL_FieldBundleInfoSetInternal(bundle_info, ungridded_dims=ungridded_dims, typekind=typekind, & + fieldBundleType=fieldBundleType, interpolation_weights=interpolation_weights, units=units, num_levels=num_levels, & + vert_staggerloc=vert_staggerloc, _RC) + + if (present(geom)) then + call ESMF_GeomGet(geom, geomtype=geomtype, _RC) + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_GeomGet(geom, grid=grid, _RC) + call ESMF_FieldBundleSet(fieldBundle, grid=grid, _RC) + _RETURN(_SUCCESS) + end if + _FAIL('unsupported geomtype') + end if + + _RETURN(_SUCCESS) + end subroutine Bundle_Set + + +end module mapl3g_FieldBundleGet diff --git a/field_bundle/FieldBundleInfo.F90 b/field_bundle/FieldBundleInfo.F90 new file mode 100644 index 000000000000..a0033fab4649 --- /dev/null +++ b/field_bundle/FieldBundleInfo.F90 @@ -0,0 +1,182 @@ +#include "MAPL_Generic.h" + +module mapl3g_FieldBundleInfo + use mapl3g_esmf_info_keys + use mapl3g_InfoUtilities + use mapl3g_ESMF_Info_Keys + use mapl3g_FieldInfo + use mapl3g_UngriddedDims + use mapl3g_FieldBundleType_Flag + use mapl3g_VerticalStaggerLoc + use mapl_KeywordEnforcer + use mapl_ErrorHandling + use esmf + implicit none(type,external) + private + + public :: MAPL_FieldBundleInfoGetInternal + public :: MAPL_FieldBundleInfoSetInternal + + interface MAPL_FieldBundleInfoGetInternal + procedure fieldbundle_get_internal + end interface + + interface MAPL_FieldBundleInfoSetInternal + procedure fieldbundle_set_internal + end interface + + +contains + + subroutine fieldbundle_get_internal(info, unusable, & + namespace, & + num_levels, vert_staggerloc, num_vgrid_levels, & + units, long_name, standard_name, & + ungridded_dims, & + typekind, fieldBundleType, interpolation_weights, & + rc) + + type(ESMF_Info), intent(in) :: info + class(KeywordEnforcer), optional, intent(in) :: unusable + character(*), optional, intent(in) :: namespace + integer, optional, intent(out) :: num_levels + 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 + type(UngriddedDims), optional, intent(out) :: ungridded_dims + type(ESMF_TypeKind_Flag), optional, intent(out) :: typekind + type(FieldBundleType_Flag), optional, intent(out) :: fieldBundleType + real(kind=ESMF_KIND_R4), optional, allocatable, intent(out) :: interpolation_weights(:) + integer, optional, intent(out) :: rc + + integer :: status + character(:), allocatable :: typekind_str + character(:), allocatable :: fieldBundleType_str + character(:), allocatable :: namespace_ + + namespace_ = INFO_INTERNAL_NAMESPACE + if (present(namespace)) then + namespace_ = namespace + end if + + call MAPL_FieldInfoGetInternal(info, namespace = namespace_//KEY_FIELD_PROTOTYPE, & + num_levels=num_levels, vert_staggerloc=vert_staggerloc, num_vgrid_levels=num_vgrid_levels, & + units=units, long_name=long_name, standard_name=standard_name, ungridded_dims=ungridded_dims, _RC) + + if (present(typekind)) then + call MAPL_InfoGet(info, key=namespace_//KEY_TYPEKIND, value=typekind_str, _RC) + typekind = to_TypeKind(typekind_str) + end if + + if (present(fieldBundleType)) then + call ESMF_InfoGet(info, key=namespace_//KEY_FIELDBUNDLETYPE, value=fieldBundleType_str, _RC) + fieldBundleType = FieldBundleType_Flag(fieldBundleType_str) + end if + + if (present(interpolation_weights)) then + call ESMF_InfoGetAlloc(info, key=namespace_//KEY_INTERPOLATION_WEIGHTS, values=interpolation_weights, _RC) + end if + + _RETURN(_SUCCESS) + contains + + function to_TypeKind(typekind_str) result(typekind) + type(ESMF_TypeKind_Flag) :: typekind + character(*), intent(in) :: typekind_str + + select case (typekind_str) + case ('R8') + typekind = ESMF_TYPEKIND_R8 + case ('R4') + typekind = ESMF_TYPEKIND_R4 + case default + typekind = ESMF_NOKIND + end select + + end function to_TypeKind + + end subroutine fieldbundle_get_internal + + + subroutine fieldbundle_set_internal(info, unusable, & + namespace, & + num_levels, vert_staggerloc, & + units, long_name, standard_name, & + ungridded_dims, & + typekind, fieldBundleType, interpolation_weights, & + rc) + + type(ESMF_Info), intent(inout) :: info + class(KeywordEnforcer), optional, intent(in) :: unusable + character(*), optional, intent(in) :: namespace + integer, optional, intent(in) :: num_levels + type(VerticalStaggerLoc), optional, intent(in) :: vert_staggerloc + character(*), optional, intent(in) :: units + character(*), optional, intent(in) :: long_name + character(*), optional, intent(in) :: standard_name + type(UngriddedDims), optional, intent(in) :: ungridded_dims + type(ESMF_TypeKind_Flag), optional, intent(in) :: typekind + type(FieldBundleType_Flag), optional, intent(in) :: fieldBundleType + real(kind=ESMF_KIND_R4), optional, intent(in) :: interpolation_weights(:) + integer, optional, intent(out) :: rc + + integer :: status + character(:), allocatable :: typekind_str + character(:), allocatable :: fieldBundleType_str + character(:), allocatable :: namespace_ + + namespace_ = INFO_INTERNAL_NAMESPACE + if (present(namespace)) then + namespace_ = namespace + end if + + call MAPL_FieldInfoSetInternal(info, namespace=namespace_ // KEY_FIELD_PROTOTYPE, & + num_levels=num_levels, vert_staggerloc=vert_staggerloc, & + units=units, long_name=long_name, standard_name=standard_name, ungridded_dims=ungridded_dims, & + _RC) + + if (present(typekind)) then + typekind_str = to_string(typekind) + call ESMF_InfoSet(info, key=namespace_ // KEY_TYPEKIND, value=typekind_str, _RC) + end if + + if (present(fieldBundleType)) then + fieldBundleType_str = fieldBundleType%to_string() + call ESMF_InfoSet(info, key=namespace_ // KEY_FIELDBUNDLETYPE, value=fieldBundleType_str, _RC) + end if + + if (present(interpolation_weights)) then + call ESMF_InfoSet(info, key=namespace_ // KEY_INTERPOLATION_WEIGHTS, values=interpolation_weights, _RC) + end if + + _RETURN(_SUCCESS) + + contains + + function to_string(typekind) + type(ESMF_TypeKind_Flag), intent(in) :: typekind + character(:), allocatable :: to_string + + if (typekind == ESMF_TYPEKIND_R8) then + to_string = 'R8' + elseif (typekind == ESMF_TYPEKIND_R4) then + to_string = 'R4' + elseif (typekind == ESMF_TYPEKIND_I8) then + to_string = 'I8' + elseif (typekind == ESMF_TYPEKIND_I4) then + to_string = 'I4' + elseif (typekind == ESMF_TYPEKIND_LOGICAL) then + to_string = 'LOGICAL' + elseif (typekind == ESMF_TYPEKIND_CHARACTER) then + to_string = 'CHARACTER' + else + to_string = 'NOKIND' + end if + end function to_string + + + end subroutine fieldbundle_set_internal + +end module mapl3g_FieldBundleInfo diff --git a/field_bundle/FieldBundleType_Flag.F90 b/field_bundle/FieldBundleType_Flag.F90 new file mode 100644 index 000000000000..d25017371cf5 --- /dev/null +++ b/field_bundle/FieldBundleType_Flag.F90 @@ -0,0 +1,73 @@ +module mapl3g_FieldBundleType_Flag + implicit none + private + + public :: FieldBundleType_Flag + public :: FIELDBUNDLETYPE_BASIC + public :: FIELDBUNDLETYPE_BRACKET + public :: FIELDBUNDLETYPE_INVALID + + public :: operator(==) + public :: operator(/=) + + type :: FieldBundleType_Flag + private + integer :: id = -1 + character(32) :: name = "FIELDBUNDLETYPE_INVALID" + contains + procedure :: to_string + end type Fieldbundletype_Flag + + interface FieldBundleType_Flag + procedure new_FieldBundleType_Flag + end interface FieldBundleType_Flag + + interface operator(==) + procedure equal_to + end interface operator(==) + + interface operator(/=) + procedure not_equal_to + end interface operator(/=) + + type(FieldBundleType_Flag), parameter :: FIELDBUNDLETYPE_BASIC = FieldBundleType_Flag(1, "FIELDBUNDLETYPE_BASIC") + type(FieldBundleType_Flag), parameter :: FIELDBUNDLETYPE_BRACKET = FieldBundleType_Flag(2, "FIELDBUNDLETYPE_BRACKET") + type(FieldBundleType_Flag), parameter :: FIELDBUNDLETYPE_INVALID = FieldBundleType_Flag(-1, "FIELDBUNDLETYPE_INVALID") + +contains + + function new_FieldBundleType_Flag(name) result (type_flag) + character(*), intent(in) :: name + type(FieldBundleType_Flag) :: type_flag + + select case (name) + case ("FIELDBUNDLETYPE_BASIC") + type_flag = FIELDBUNDLETYPE_BASIC + case ("FIELDBUNDLETYPE_BRACKET") + type_flag = FIELDBUNDLETYPE_BRACKET + case default + type_flag = FIELDBUNDLETYPE_INVALID + end select + + end function new_FieldBundleType_Flag + + function to_string(this) result(s) + character(:), allocatable :: s + class(FieldBundleType_Flag), intent(in) :: this + + s = trim(this%name) + + end function to_string + + + elemental logical function equal_to(a,b) + type(FieldBundleType_Flag), intent(in) :: a,b + equal_to = a%id == b%id + end function equal_to + + elemental logical function not_equal_to(a,b) + type(FieldBundleType_Flag), intent(in) :: a,b + not_equal_to = .not. (a%id == b%id) + end function not_equal_to + +end module mapl3g_FieldBundleType_Flag diff --git a/field_bundle/tests/CMakeLists.txt b/field_bundle/tests/CMakeLists.txt new file mode 100644 index 000000000000..bbcc252b0878 --- /dev/null +++ b/field_bundle/tests/CMakeLists.txt @@ -0,0 +1,10 @@ +set(MODULE_DIRECTORY "${esma_include}/MAPL.field_bundle.tests") + +add_pfunit_ctest(MAPL.field_bundle.tests + TEST_SOURCES Test_FieldBundleDelta.pf + LINK_LIBRARIES MAPL.field_bundle MAPL.pfunit + EXTRA_INITIALIZE Initialize + EXTRA_USE MAPL_pFUnit_Initialize + MAX_PES 4 + ) +add_dependencies(build-tests MAPL.field_bundle.tests) diff --git a/field/tests/Test_FieldBundleDelta.pf b/field_bundle/tests/Test_FieldBundleDelta.pf similarity index 87% rename from field/tests/Test_FieldBundleDelta.pf rename to field_bundle/tests/Test_FieldBundleDelta.pf index 90a6c6f8a738..eecef81455ae 100644 --- a/field/tests/Test_FieldBundleDelta.pf +++ b/field_bundle/tests/Test_FieldBundleDelta.pf @@ -2,11 +2,12 @@ #include "unused_dummy.H" module Test_FieldBundleDelta use mapl3g_FieldBundleDelta + use mapl3g_FieldBundleGet use mapl3g_FieldDelta use mapl3g_FieldGet use mapl3g_FieldCreate use mapl3g_FieldInfo - use mapl3g_esmf_info_keys, only: KEY_INTERPOLATION_WEIGHTS + use mapl3g_esmf_info_keys use mapl3g_VerticalStaggerLoc use mapl3g_InfoUtilities use mapl_FieldUtilities @@ -100,7 +101,6 @@ contains type(ESMF_Field) :: f integer :: fieldCount type(UngriddedDims) :: ungridded_dims - type(ESMF_Info) :: ungridded_info type(VerticalStaggerLoc) :: vert_staggerloc bundle = ESMF_FieldBundleCreate() @@ -111,27 +111,20 @@ contains call ESMF_FieldBundleAdd(bundle, [f], multiflag=.true.) end do - call MAPL_InfoSetInternal(bundle, KEY_INTERPOLATION_WEIGHTS, weights) - if (typekind == ESMF_TYPEKIND_R4) then - call MAPL_InfoSetInternal(bundle, KEY_TYPEKIND, "R4") - else - call MAPL_InfoSetInternal(bundle, KEY_TYPEKIND, "R8") - end if - call MAPL_InfoSetInternal(bundle, KEY_UNITS, units) + call MAPL_FieldBundleSet(bundle, interpolation_weights=weights, typekind=typekind, units=units) vert_staggerloc = VERTICAL_STAGGER_NONE ungridded_dims = UngriddedDims() if (present(with_ungridded)) then if (with_ungridded) then vert_staggerloc = VERTICAL_STAGGER_CENTER - call MAPL_InfoSetInternal(bundle, KEY_NUM_LEVELS, NUM_LEVELS_VGRID) + call MAPL_FieldBundleSet(bundle, 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()) + call MAPL_FieldBundleSet(bundle, vert_staggerloc=vert_staggerloc) - ungridded_info = ungridded_dims%make_info() - call MAPL_InfoSetInternal(bundle, KEY_UNGRIDDED_DIMS, value=ungridded_info) + call MAPL_FieldBundleSet(bundle, ungridded_dims=ungridded_dims) end subroutine setup_bundle @@ -176,7 +169,7 @@ contains @assert_that(shape(x_r8), is(equal_to([4,4]))) end do - call MAPL_InfoGetInternal(bundle, KEY_INTERPOLATION_WEIGHTS, values=weights, _RC) + call MAPL_FieldBundleGet(bundle, interpolation_weights=weights, _RC) @assert_that(weights, is(equal_to(DEFAULT_WEIGHTS))) call teardown_bundle(bundle) @@ -212,7 +205,7 @@ contains @assert_that(shape(x_r4), is(equal_to([4,4]))) @assert_that(x_r4, every_item(is(FILL_VALUE))) - call MAPL_infoGetInternal(fieldList(i), KEY_UNITS, value=new_units, _RC) + call MAPL_FieldGet(fieldList(i), units=new_units, _RC) @assertEqual('m', new_units) end do @@ -249,7 +242,7 @@ contains call ESMF_FieldGet(fieldList(i), fArrayPtr=x_r4, _RC) @assert_that(shape(x_r4), is(equal_to([6,6]))) - call MAPL_InfoGetInternal(fieldList(i), KEY_UNITS, value=new_units, _RC) + call MAPL_FieldGet(fieldList(i), units=new_units, _RC) @assertEqual('km', new_units) call ESMF_FieldGet(fieldList(i), geom=tmp_geom, _RC) @@ -290,7 +283,7 @@ contains @assert_that(shape(x_r4), is(equal_to([4,4]))) @assert_that(x_r4, every_item(is(FILL_VALUE))) - call MAPL_InfoGetInternal(fieldList(i), KEY_UNITS, value=new_units, _RC) + call MAPL_FieldGet(fieldList(i), units=new_units, _RC) @assertEqual('km', new_units) call ESMF_FieldGet(fieldList(i), geom=tmp_geom, _RC) @@ -327,19 +320,19 @@ contains 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))) - call MAPL_InfoGetInternal(fieldList(i), KEY_UNITS, value=new_units, _RC) + call MAPL_FieldGet(fieldList(i), units=new_units, _RC) @assertEqual('km', new_units) call ESMF_FieldGet(fieldList(i), geom=tmp_geom, _RC) @assert_that(tmp_geom == geom, is(true())) end do - call MAPL_InfoGetInternal(bundle, KEY_INTERPOLATION_WEIGHTS, values=weights, _RC) + call MAPL_FieldBundleGet(bundle, interpolation_weights=weights, _RC) @assert_that(weights, is(equal_to(new_weights))) call teardown_bundle(bundle) @@ -362,7 +355,7 @@ contains character(:), allocatable :: new_units real(kind=ESMF_KIND_R4), allocatable :: weights(:) real(kind=ESMF_KIND_R4), parameter :: new_weights(*) = [0.,0.25,0.75] - integer :: ndims, nlevels, rank + integer :: nlevels, rank type(UngriddedDims) :: ungridded_dims call setup_geom(geom, 4) @@ -381,7 +374,7 @@ contains @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) + call MAPL_FieldGet(fieldList(i), units=new_units, _RC) @assertEqual('km', new_units) call ESMF_FieldGet(fieldList(i), geom=tmp_geom, _RC) @@ -390,18 +383,18 @@ contains 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) + call MAPL_FieldGet(fieldList(i), num_levels=nlevels, _RC) @assert_that(nlevels, is(NUM_LEVELS_VGRID)) end do - call MAPL_InfoGetInternal(bundle, KEY_INTERPOLATION_WEIGHTS, values=weights, _RC) + call MAPL_FieldBundleGet(bundle, interpolation_weights=weights, _RC) @assert_that(weights, is(equal_to(new_weights))) - call MAPL_InfoGetInternal(bundle, KEY_UNGRIDDED_DIMS//'/num_ungridded_dimensions', value=ndims, _RC) - @assert_that(ndims, is(1)) + call MAPL_FieldBundleGet(bundle, ungridded_dims=ungridded_dims, _RC) + @assert_that(ungridded_dims%get_num_ungridded(), is(1)) - call MAPL_InfoGetInternal(bundle, KEY_NUM_LEVELS, value=nlevels, _RC) + call MAPL_FieldBundleGet(bundle, num_levels=nlevels, _RC) @assert_that(nlevels, is(NUM_LEVELS_VGRID)) call teardown_bundle(bundle) @@ -433,24 +426,27 @@ contains call setup_geom(geom, 4) call setup_bundle(bundle, weights=[5.], geom=geom, typekind=ESMF_TYPEKIND_R4, units='km') - delta = FieldBundleDelta(interpolation_weights=new_weights) + _HERE + delta = FieldBundleDelta(interpolation_weights=new_weights) + _HERE call delta%update_bundle(bundle, _RC) ! should allocate fields + _HERE call MAPL_FieldBundleGet(bundle, fieldList=fieldList, _RC) @assert_that(size(fieldList), is(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]))) - - call MAPL_InfoGetInternal(fieldList(i), KEY_UNITS, value=new_units, _RC) + + call MAPL_FieldGet(fieldList(i), units=new_units, _RC) @assertEqual('km', new_units) call ESMF_FieldGet(fieldList(i), geom=tmp_geom, _RC) @assert_that(tmp_geom == geom, is(true())) end do - call MAPL_InfoGetInternal(bundle, KEY_INTERPOLATION_WEIGHTS, values=weights, _RC) + call MAPL_FieldBundleGet(bundle, interpolation_weights=weights, _RC) @assert_that(weights, is(equal_to(new_weights))) call teardown_bundle(bundle) @@ -478,14 +474,14 @@ contains character(:), allocatable :: new_units real(kind=ESMF_KIND_R4), allocatable :: weights(:) real(kind=ESMF_KIND_R4), parameter :: new_weights(*) = [0.,0.25,0.75] - integer :: ndims, nlevels + integer :: nlevels type(UngriddedDims) :: ungridded_dims call setup_geom(geom, 4) call setup_bundle(bundle, weights=[5.], geom=geom, typekind=ESMF_TYPEKIND_R4, units='km', & with_ungridded=.true.) - delta = FieldBundleDelta(interpolation_weights=new_weights) + delta = FieldBundleDelta(interpolation_weights=new_weights) call delta%update_bundle(bundle, _RC) ! should allocate fields call MAPL_FieldBundleGet(bundle, fieldList=fieldList, _RC) @@ -494,8 +490,8 @@ 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_VGRID,NUM_RADII]))) - - call MAPL_InfoGetInternal(fieldList(i), KEY_UNITS, value=new_units, _RC) + + call MAPL_FieldGet(fieldList(i), units=new_units, _RC) @assertEqual('km', new_units) call ESMF_FieldGet(fieldList(i), geom=tmp_geom, _RC) @@ -504,17 +500,17 @@ contains 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) + call MAPL_FieldGet(fieldList(i), num_levels=nlevels, _RC) @assert_that(nlevels, is(NUM_LEVELS_VGRID)) end do - call MAPL_InfoGetInternal(bundle, KEY_INTERPOLATION_WEIGHTS, values=weights, _RC) + call MAPL_FieldBundleGet(bundle, interpolation_weights=weights, _RC) @assert_that(weights, is(equal_to(new_weights))) - call MAPL_InfoGetInternal(bundle, KEY_UNGRIDDED_DIMS // '/num_ungridded_dimensions', value=ndims, _RC) - @assert_that(ndims, is(1)) + call MAPL_FieldBundleGet(bundle, ungridded_dims=ungridded_dims, _RC) + @assert_that(ungridded_dims%get_num_ungridded(), is(1)) - call MAPL_InfoGetInternal(bundle, KEY_NUM_LEVELS, value=nlevels, _RC) + call MAPL_FieldBundleGet(bundle, num_levels=nlevels, _RC) @assert_that(nlevels, is(NUM_LEVELS_VGRID)) call teardown_bundle(bundle) diff --git a/generic3g/CMakeLists.txt b/generic3g/CMakeLists.txt index b2f4b6a1662b..575a161c9bf0 100644 --- a/generic3g/CMakeLists.txt +++ b/generic3g/CMakeLists.txt @@ -109,6 +109,7 @@ esma_add_fortran_submodules( target_include_directories (${this} PUBLIC $) + if (PFUNIT_FOUND) add_subdirectory(tests EXCLUDE_FROM_ALL) endif () diff --git a/generic3g/Generic3g.F90 b/generic3g/Generic3g.F90 index 79527a2934ef..368e1a80104b 100644 --- a/generic3g/Generic3g.F90 +++ b/generic3g/Generic3g.F90 @@ -10,5 +10,4 @@ module Generic3g use mapl3g_GriddedComponentDriver use mapl3g_UserSetServices use mapl3g_ESMF_HConfigUtilities, only: MAPL_HConfigMatch - use mapl3g_FieldDimensionInfo end module Generic3g diff --git a/generic3g/actions/TimeInterpolateAction.F90 b/generic3g/actions/TimeInterpolateAction.F90 index c34222ca5fe4..ac70bca6beb0 100644 --- a/generic3g/actions/TimeInterpolateAction.F90 +++ b/generic3g/actions/TimeInterpolateAction.F90 @@ -3,13 +3,14 @@ module mapl3g_TimeInterpolateAction use mapl3g_ExtensionAction use mapl3g_regridder_mgr + use mapl3g_FieldBundleGet use mapl3g_InfoUtilities use MAPL_FieldUtils use MAPL_Constants, only: MAPL_UNDEFINED_REAL use mapl_ErrorHandling use esmf - implicit none + implicit none(type,external) private public :: TimeInterpolateAction @@ -92,20 +93,15 @@ subroutine run_r4(bundle_in, field_out, rc) real(kind=ESMF_KIND_R4), pointer :: y(:), xi(:) real(kind=ESMF_KIND_R4), allocatable :: weights(:) integer :: i - integer :: fieldCount type(ESMF_Field), allocatable :: fieldList(:) type(ESMF_Info) :: bundle_info - call ESMF_FieldBundleGet(bundle_in, fieldCount=fieldCount, _RC) - allocate(fieldList(fieldCount)) - call ESMF_FieldBundleGet(bundle_in, fieldList=fieldList, _RC) - - call MAPL_InfoGetInternal(bundle_in, 'weights', weights, _RC) + call MAPL_FieldBundleGet(bundle_in, fieldList=fieldList, interpolation_weights=weights, _RC) call assign_fptr(field_out, y, _RC) y = weights(1) - do i = 1, fieldCount + do i = 1, size(fieldList) call assign_fptr(fieldList(i), xi, _RC) where (xi /= MAPL_UNDEFINED_REAL .and. y /= MAPL_UNDEFINED_REAL) y = y + weights(i+1) * xi diff --git a/generic3g/tests/Test_TimeInterpolateAction.pf b/generic3g/tests/Test_TimeInterpolateAction.pf index ab703e5faceb..b69de8816f19 100644 --- a/generic3g/tests/Test_TimeInterpolateAction.pf +++ b/generic3g/tests/Test_TimeInterpolateAction.pf @@ -3,11 +3,12 @@ module Test_TimeInterpolateAction use mapl3g_TimeInterpolateAction use mapl3g_InfoUtilities use MAPL_FieldPointerUtilities + use mapl3g_FieldBundleGet use ESMF_TestMethod_mod use MAPL_Constants, only: MAPL_UNDEFINED_REAL use esmf use funit - implicit none + implicit none(type,external) contains @@ -33,7 +34,7 @@ contains bracket = ESMF_FieldBundleCreate(name='import[1]', _RC) call ESMF_StateAdd(importState, [bracket], _RC) - call MAPL_InfoSetInternal(importState, 'import[1]', 'weights', values=[7.0], _RC) + call MAPL_FieldBundleSet(bracket, interpolation_weights=[7.0], _RC) grid = ESMF_GridCreateNoPeriDim(maxIndex=[4,4], name='I_AM_GROOT', _RC) geom = ESMF_GeomCreate(grid, _RC) @@ -89,7 +90,8 @@ contains end do bracket = ESMF_FieldBundleCreate(name='import[1]', multiflag=.true., fieldList=b, _RC) call ESMF_StateAdd(importState, [bracket], _RC) - call MAPL_InfoSetInternal(importState, 'import[1]', 'weights', values=[1.0, 0.5, 0.5], _RC) + call MAPL_FieldBundleSet(bracket, interpolation_weights=[1.0, 0.5, 0.5], _RC) + f = ESMF_FieldEmptyCreate(name='export[1]', _RC) call ESMF_FieldEmptySet(f, geom=geom, _RC) @@ -148,7 +150,7 @@ contains x(2) = MAPL_UNDEFINED_REAL bracket = ESMF_FieldBundleCreate(name='import[1]', multiflag=.true., fieldList=b, _RC) call ESMF_StateAdd(importState, [bracket], _RC) - call MAPL_InfoSetInternal(importState, 'import[1]', 'weights', values=[1.0, 0.5, 0.5], _RC) + call MAPL_FieldBundleSet(bracket, interpolation_weights=[1.0, 0.5, 0.5], _RC) f = ESMF_FieldEmptyCreate(name='export[1]', _RC) call ESMF_FieldEmptySet(f, geom=geom, _RC) diff --git a/generic3g/vertical/FixedLevelsVerticalGrid.F90 b/generic3g/vertical/FixedLevelsVerticalGrid.F90 index b6deec593ea8..054ced93d55d 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid.F90 @@ -147,6 +147,44 @@ impure elemental logical function not_equal_FixedLevelsVerticalGrid(a, b) result not_equal = .not. (a==b) 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, rc) result(field) + type(ESMF_Field) :: field ! result + type(ESMF_Geom), intent(in) :: geom + real(kind=ESMF_KIND_R4), intent(in) :: farray1d(:) +!# character(len=*), intent(in) :: vloc + integer, optional, intent(out) :: rc + + integer, allocatable :: local_cell_count(:) + real(kind=ESMF_KIND_R4), pointer :: farray3d(:, :, :) + integer :: i, j, IM, JM, status + +!# ! 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) + do concurrent (i=1:IM, j=1:JM) + farray3d(i, j, :) = farray1d(:) + end do + + + _RETURN(_SUCCESS) + end function esmf_field_create_ + ! Temporary version here while the detailed MAPL_GeomGet utility gets developed subroutine MAPL_GeomGet_(geom, localCellCount, rc) use MAPLBase_Mod diff --git a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 index 90177190e2b5..8f4a8b5fc863 100644 --- a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 +++ b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 @@ -10,8 +10,6 @@ module mapl3g_HistoryCollectionGridComp_private use MAPL_NewArthParserMod, only: parser_variables_in_expression use MAPL_TimeStringConversion use MAPL_BaseMod, only: MAPL_UnpackTime - use mapl3g_FieldDimensionInfo, only: get_num_levels, get_vertical_dim_spec_names - use mapl3g_FieldDimensionInfo, only: get_vertical_dim_spec_name, get_ungridded_dims use mapl3g_UngriddedDims use gFTL2_StringSet diff --git a/shared/MAPL_ESMF_InfoKeys.F90 b/shared/MAPL_ESMF_InfoKeys.F90 index c938e88b4162..db696d2f658e 100644 --- a/shared/MAPL_ESMF_InfoKeys.F90 +++ b/shared/MAPL_ESMF_InfoKeys.F90 @@ -12,6 +12,8 @@ module mapl3g_esmf_info_keys public :: KEY_VERT_DIM public :: KEY_VERT_GRID public :: KEY_INTERPOLATION_WEIGHTS + public :: KEY_FIELD_PROTOTYPE + public :: KEY_FIELDBUNDLETYPE public :: KEY_UNITS public :: KEY_LONG_NAME public :: KEY_STANDARD_NAME @@ -38,10 +40,8 @@ module mapl3g_esmf_info_keys character(len=*), parameter :: KEY_VERT_DIM = '/vertical_dim' character(len=*), parameter :: KEY_VERT_GRID = '/vertical_grid' character(len=*), parameter :: KEY_UNITS = '/units' - character(len=*), parameter :: KEY_TYPEKIND = '/typekind' character(len=*), parameter :: KEY_LONG_NAME = '/long_name' character(len=*), parameter :: KEY_STANDARD_NAME = '/standard_name' - character(len=*), parameter :: KEY_INTERPOLATION_WEIGHTS = '/interpolation_weights' ! VerticalGeom info keys character(len=*), parameter :: KEY_NUM_LEVELS = KEY_VERT_GRID // '/num_levels' @@ -65,6 +65,11 @@ module mapl3g_esmf_info_keys KEYSTUB_DIM // '4', KEYSTUB_DIM // '5', KEYSTUB_DIM // '6', & KEYSTUB_DIM // '7', KEYSTUB_DIM // '8', KEYSTUB_DIM // '9'] + character(len=*), parameter :: KEY_TYPEKIND = '/typekind' + character(len=*), parameter :: KEY_FIELD_PROTOTYPE = '/field_prototype' + character(len=*), parameter :: KEY_INTERPOLATION_WEIGHTS = '/interpolation_weights' + character(len=*), parameter :: KEY_FIELDBUNDLETYPE = '/fieldBundleType' + contains function make_dim_key(n, rc) result(key)