diff --git a/esmf_utils/UngriddedDims.F90 b/esmf_utils/UngriddedDims.F90 index 46b411200ab..6b4dc5c23d0 100644 --- a/esmf_utils/UngriddedDims.F90 +++ b/esmf_utils/UngriddedDims.F90 @@ -52,10 +52,14 @@ module mapl3g_UngriddedDims contains - function new_UngriddedDims_empty() result(spec) + function new_UngriddedDims_empty(is_mirror) result(spec) type(UngriddedDims) :: spec + logical, optional, intent(in) :: is_mirror spec%dim_specs = UngriddedDimVector() + if (present(is_mirror)) then + spec%is_mirror = is_mirror + end if end function new_UngriddedDims_empty diff --git a/field/FieldCreate.F90 b/field/FieldCreate.F90 index ab7fa95b44e..c908eec2208 100644 --- a/field/FieldCreate.F90 +++ b/field/FieldCreate.F90 @@ -112,6 +112,7 @@ subroutine field_empty_complete(field, & allocate(grid_to_field_map(dim_count), source=[(idim, idim=1,dim_count)]) end if bounds = make_bounds(num_levels=num_levels, ungridded_dims=ungridded_dims) + call ESMF_FieldEmptyComplete( & field, & typekind=typekind, & diff --git a/field/FieldGet.F90 b/field/FieldGet.F90 index 0445dbe7949..40ebb7f5000 100644 --- a/field/FieldGet.F90 +++ b/field/FieldGet.F90 @@ -28,6 +28,8 @@ subroutine field_get(field, unusable, & ungridded_dims, & units, standard_name, long_name, & allocation_status, & + has_deferred_aspects, & + regridder_param_info, & rc) type(ESMF_Field), intent(in) :: field class(KeywordEnforcer), optional, intent(in) :: unusable @@ -43,13 +45,15 @@ subroutine field_get(field, unusable, & character(len=:), optional, allocatable, intent(out) :: standard_name character(len=:), optional, allocatable, intent(out) :: long_name type(StateItemAllocation), optional, intent(out) :: allocation_status + logical, optional, intent(out) :: has_deferred_aspects + type(esmf_Info), optional, allocatable, intent(out) :: regridder_param_info integer, optional, intent(out) :: rc integer :: status type(ESMF_Info) :: field_info character(len=ESMF_MAXSTR) :: fname type(ESMF_FieldStatus_Flag) :: fstatus - integer, allocatable :: vgrid_id + integer :: vgrid_id type(VerticalGridManager), pointer :: vgrid_manager if (present(short_name)) then @@ -68,28 +72,31 @@ subroutine field_get(field, unusable, & end if end if - if (present(vgrid)) then - allocate(vgrid_id) ! trigger "is present" - end if - if (present(typekind)) then - call ESMF_FieldGet(field, typekind=typekind, _RC) +!# call ESMF_FieldGet(field, typekind=typekind, _RC) end if call ESMF_InfoGetFromHost(field, field_info, _RC) call FieldInfoGetInternal(field_info, & + typekind=typekind, & num_levels=num_levels, & vert_staggerloc=vert_staggerloc, & num_vgrid_levels=num_vgrid_levels, & ungridded_dims=ungridded_dims, & units=units, standard_name=standard_name, long_name=long_name, & - allocation_status=allocation_status, & vgrid_id=vgrid_id, & + allocation_status=allocation_status, & + has_deferred_aspects=has_deferred_aspects, & + regridder_param_info=regridder_param_info, & _RC) if (present(vgrid)) then - vgrid_manager => get_vertical_grid_manager() - vgrid => vgrid_manager%get_grid(id=vgrid_id, _RC) + if (vgrid_id == VERTICAL_GRID_NOT_FOUND) then + vgrid => null() + else + vgrid_manager => get_vertical_grid_manager() + vgrid => vgrid_manager%get_grid(id=vgrid_id, _RC) + end if end if _RETURN(_SUCCESS) diff --git a/field/FieldInfo.F90 b/field/FieldInfo.F90 index 6f581c1eb8b..3a8ed97d081 100644 --- a/field/FieldInfo.F90 +++ b/field/FieldInfo.F90 @@ -6,6 +6,7 @@ module mapl3g_FieldInfo use mapl3g_esmf_info_keys, only: INFO_INTERNAL_NAMESPACE use mapl3g_esmf_info_keys, only: INFO_PRIVATE_NAMESPACE use mapl3g_InfoUtilities + use mapl3g_VerticalGrid_API use mapl3g_UngriddedDims use mapl3g_VerticalStaggerLoc use mapl3g_StateItemAllocation @@ -59,6 +60,7 @@ module mapl3g_FieldInfo character(*), parameter :: KEY_VERT_DIM = "/vert_dim" character(*), parameter :: KEY_UNGRIDDED_DIMS = "/ungridded_dims" character(*), parameter :: KEY_ALLOCATION_STATUS = "/allocation_status" + character(*), parameter :: KEY_REGRIDDER_PARAM = "/EsmfRegridderParam" character(*), parameter :: KEY_UNDEF_VALUE = "/undef_value" character(*), parameter :: KEY_MISSING_VALUE = "/missing_value" @@ -66,6 +68,7 @@ module mapl3g_FieldInfo character(*), parameter :: KEY_SPEC_HANDLE = "/spec_handle" character(*), parameter :: KEY_RESTART_MODE = "/restart_mode" + character(*), parameter :: KEY_HAS_DEFERRED_ASPECTS = "/has_deferred_aspects" contains @@ -75,9 +78,11 @@ subroutine field_info_set_internal(info, unusable, & num_levels, vert_staggerloc, & ungridded_dims, & units, long_name, standard_name, & - allocation_status, & vgrid_id, & spec_handle, & + allocation_status, & + has_deferred_aspects, & + regridder_param_info, & rc) type(ESMF_Info), intent(inout) :: info class(KeywordEnforcer), optional, intent(in) :: unusable @@ -91,7 +96,9 @@ subroutine field_info_set_internal(info, unusable, & character(*), optional, intent(in) :: long_name character(*), optional, intent(in) :: standard_name type(StateItemAllocation), optional, intent(in) :: allocation_status + logical, optional, intent(in) :: has_deferred_aspects integer, optional, intent(in) :: spec_handle(:) + type(esmf_info), optional, intent(in) :: regridder_param_info integer, optional, intent(out) :: rc integer :: status @@ -116,6 +123,7 @@ subroutine field_info_set_internal(info, unusable, & if (present(ungridded_dims)) then ungridded_info = ungridded_dims%make_info(_RC) call MAPL_InfoSet(info, namespace_ // KEY_UNGRIDDED_DIMS, ungridded_info, _RC) + call esmf_InfoDestroy(ungridded_info, _RC) end if if (present(units)) then @@ -134,13 +142,18 @@ subroutine field_info_set_internal(info, unusable, & call MAPL_InfoSet(info, namespace_ // KEY_NUM_LEVELS, num_levels, _RC) end if + if (present(regridder_param_info)) then + call MAPL_InfoSet(info, namespace_ // KEY_REGRIDDER_PARAM, regridder_param_info, _RC) + _HERE + end if + if (present(vert_staggerloc)) then 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(info, namespace_ // KEY_VERT_DIM, "VERTICAL_DIM_NONE", _RC) call MAPL_InfoSet(info, namespace_ // KEY_NUM_VGRID_LEVELS, 0, _RC) @@ -161,6 +174,10 @@ subroutine field_info_set_internal(info, unusable, & call MAPL_InfoSet(info, namespace_ // KEY_ALLOCATION_STATUS, allocation_status%to_string(), _RC) end if + if (present(has_deferred_aspects)) then + call MAPL_InfoSet(info, namespace_ // KEY_HAS_DEFERRED_ASPECTS, has_deferred_aspects, _RC) + end if + if (present(spec_handle)) then call MAPL_InfoSet(info, namespace_ // KEY_SPEC_HANDLE, spec_handle, _RC) end if @@ -179,6 +196,8 @@ subroutine field_info_get_internal(info, unusable, & ungridded_dims, & allocation_status, & spec_handle, & + has_deferred_aspects, & + regridder_param_info, & rc) type(ESMF_Info), intent(in) :: info class(KeywordEnforcer), optional, intent(in) :: unusable @@ -194,16 +213,17 @@ subroutine field_info_get_internal(info, unusable, & type(UngriddedDims), optional, intent(out) :: ungridded_dims type(StateItemAllocation), optional, intent(out) :: allocation_status integer, optional, allocatable, intent(out) :: spec_handle(:) + logical, optional, intent(out) :: has_deferred_aspects + type(esmf_Info), allocatable, optional, intent(out) :: regridder_param_info integer, optional, intent(out) :: rc integer :: status integer :: num_levels_ - type(ESMF_Info) :: ungridded_info + type(esmf_Info) :: ungridded_info character(:), allocatable :: vert_staggerloc_str, allocation_status_str type(VerticalStaggerLoc) :: vert_staggerloc_ character(:), allocatable :: namespace_ character(:), allocatable :: str - logical :: key_is_present logical :: is_present namespace_ = INFO_INTERNAL_NAMESPACE @@ -212,7 +232,8 @@ subroutine field_info_get_internal(info, unusable, & end if if (present(vgrid_id)) then - call mapl_InfoGet(info, namespace_ // KEY_VGRID_ID, vgrid_id, _RC) + call esmf_InfoGet(info, key=namespace_ // KEY_VGRID_ID, & + value=vgrid_id, default=VERTICAL_GRID_NOT_FOUND, _RC) end if if (present(typekind)) then @@ -221,14 +242,32 @@ subroutine field_info_get_internal(info, unusable, & end if if (present(ungridded_dims)) then - ungridded_info = ESMF_InfoCreate(info, namespace_ // KEY_UNGRIDDED_DIMS, _RC) - ungridded_dims = make_UngriddedDims(ungridded_info, _RC) + is_present = esmf_InfoIsPresent(info, namespace_ // KEY_UNGRIDDED_DIMS, _RC) + if (is_present) then + ungridded_info = ESMF_InfoCreate(info, namespace_ // KEY_UNGRIDDED_DIMS, _RC) + ungridded_dims = make_UngriddedDims(ungridded_info, _RC) + call esmf_InfoDestroy(ungridded_info, _RC) + else + ungridded_dims = UngriddedDims(is_mirror=.true.) + end if + end if + + if (present(regridder_param_info)) then + is_present = esmf_InfoIsPresent(info, namespace_ // KEY_REGRIDDER_PARAM, _RC) + if (is_present) then + regridder_param_info = esmf_InfoCreate(info, namespace_ // KEY_REGRIDDER_PARAM, _RC) + end if end if if (present(num_levels) .or. present(num_vgrid_levels)) then - call MAPL_InfoGet(info, namespace_ // KEY_NUM_LEVELS, num_levels_, _RC) - if (present(num_levels)) then - num_levels = num_levels_ + is_present = esmf_InfoIsPresent(info, namespace_ // KEY_NUM_LEVELS, _RC) + if (is_present) then + call MAPL_InfoGet(info, namespace_ // KEY_NUM_LEVELS, num_levels_, _RC) + if (present(num_levels)) then + num_levels = num_levels_ + end if + else + num_levels = 0 end if end if @@ -242,7 +281,7 @@ subroutine field_info_get_internal(info, unusable, & if (present(num_vgrid_levels)) then if (vert_staggerloc_ == VERTICAL_STAGGER_NONE) then - num_vgrid_levels = 0 + num_vgrid_levels = 0 ! num_levels_ must not be used here else if (vert_staggerloc_ == VERTICAL_STAGGER_EDGE) then num_vgrid_levels = num_levels_ - 1 else if (vert_staggerloc_ == VERTICAL_STAGGER_CENTER) then @@ -252,8 +291,11 @@ subroutine field_info_get_internal(info, unusable, & end if end if - if (present(units)) then - call MAPL_InfoGet(info, namespace_ // KEY_UNITS, units, _RC) + if (present(units)) then ! leave unallocated unless found + is_present = esmf_InfoIsPresent(info, key=namespace_ // KEY_UNITS, _RC) + if (is_present) then + call MAPL_InfoGet(info, namespace_ // KEY_UNITS, units, _RC) + end if end if if (present(long_name)) then @@ -273,7 +315,12 @@ subroutine field_info_get_internal(info, unusable, & call MAPL_InfoGet(info, namespace_ // KEY_SPEC_HANDLE, spec_handle, _RC) end if - _RETURN(_SUCCESS) + if (present(has_deferred_aspects)) then + call esmf_InfoGet(info, key=namespace_ // KEY_HAS_DEFERRED_ASPECTS, & + value=has_deferred_aspects, default=.false., _RC) + end if + + _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end subroutine field_info_get_internal diff --git a/field/FieldPointerUtilities.F90 b/field/FieldPointerUtilities.F90 index 70aca19f63a..a8fcfdeb38b 100644 --- a/field/FieldPointerUtilities.F90 +++ b/field/FieldPointerUtilities.F90 @@ -383,7 +383,10 @@ function get_local_element_count(x, rc) result(element_count) integer :: status integer :: rank + element_count = [integer :: ] ! must allocate even under failure call ESMF_FieldGet(x, rank=rank, _RC) + + deallocate(element_count) allocate(element_count(rank)) ! ESMF has a big fat bug with multi tile grids and loal element count !call ESMF_FieldGet(x, localElementCount=element_count, _RC) @@ -482,7 +485,6 @@ subroutine clone(x, y, rc) call ESMF_InfoGetFromHost(x, x_info, _RC) call ESMF_InfoGetFromHost(y, y_info, _RC) call ESMF_InfoUpdate(y_info, x_info, recursive=.true., _RC) - y_info = x_info _RETURN(_SUCCESS) end subroutine clone @@ -891,8 +893,13 @@ subroutine MAPL_FieldGetLocalElementCount(field,local_count,rc) integer(kind=ESMF_KIND_I4), pointer :: i4_1d(:),i4_2d(:,:),i4_3d(:,:,:),i4_4d(:,:,:,:) integer(kind=ESMF_KIND_I8), pointer :: i8_1d(:),i8_2d(:,:),i8_3d(:,:,:),i8_4d(:,:,:,:) + integer, parameter :: MAX_RANK = 4 + + local_count = [integer :: ] ! default in case of failure call ESMF_FieldGet(field,rank=rank,typekind=tk,_RC) + _ASSERT(rank <= MAX_RANK, 'Need to extend FieldPointerUtilities for rank > 4.') + deallocate(local_count) if (tk == ESMF_TypeKind_R4) then select case(rank) case(1) diff --git a/field/FieldSet.F90 b/field/FieldSet.F90 index 6e9322d4aea..36e6eca2aa5 100644 --- a/field/FieldSet.F90 +++ b/field/FieldSet.F90 @@ -4,6 +4,7 @@ module mapl3g_FieldSet use mapl3g_VerticalGrid_API use mapl3g_FieldInfo use mapl3g_FieldDelta + use mapl3g_StateItemAllocation use mapl_KeywordEnforcer use mapl_ErrorHandling use mapl3g_UngriddedDims @@ -28,9 +29,12 @@ subroutine field_set(field, & typekind, & unusable, & num_levels, & - units, & + units, standard_name, long_name, & ungridded_dims, & attributes, & + allocation_status, & + has_deferred_aspects, & + regridder_param_info, & rc) @@ -42,8 +46,13 @@ subroutine field_set(field, & type(esmf_TypeKind_Flag), optional, intent(in) :: typekind integer, optional, intent(in) :: num_levels character(len=*), optional, intent(in) :: units + character(len=*), optional, intent(in) :: standard_name + character(len=*), optional, intent(in) :: long_name type(UngriddedDims), optional, intent(in) :: ungridded_dims type(StringVector), optional, intent(in) :: attributes + type(StateItemAllocation), optional, intent(in) :: allocation_status + logical, optional, intent(in) :: has_deferred_aspects + type(esmf_Info), optional, intent(in) :: regridder_param_info integer, optional, intent(out) :: rc integer :: status @@ -58,6 +67,11 @@ subroutine field_set(field, & call field_delta%update_field(field, _RC) end if + if (fstatus /= ESMF_FIELDSTATUS_COMPLETE .and. present(geom)) then + call esmf_FieldEmptyReset(field, status=ESMF_FIELDSTATUS_EMPTY, _RC) + call esmf_FieldEmptySet(field, geom=geom, _RC) + end if + if (present(vgrid)) then vgrid_id = vgrid%get_id() ! allocate so "present" below end if @@ -66,8 +80,14 @@ subroutine field_set(field, & call FieldInfoSetInternal(field_info, & vgrid_id=vgrid_id, & vert_staggerloc=vert_staggerloc, & - typekind=typekind, units=units, & - ungridded_dims=ungridded_dims, _RC) + num_levels=num_levels, & + typekind=typekind, & + units=units, standard_name=standard_name, long_name=long_name, & + ungridded_dims=ungridded_dims, & + allocation_status=allocation_status, & + has_deferred_aspects=has_deferred_aspects, & + regridder_param_info=regridder_param_info, & + _RC) _RETURN(_SUCCESS) end subroutine field_set diff --git a/field_bundle/FieldBundleGet.F90 b/field_bundle/FieldBundleGet.F90 index 995074c0444..d6532fc544a 100644 --- a/field_bundle/FieldBundleGet.F90 +++ b/field_bundle/FieldBundleGet.F90 @@ -37,6 +37,8 @@ subroutine bundle_get(fieldBundle, unusable, & units, standard_name, long_name, & allocation_status, & bracket_updated, & + has_deferred_aspects, & + regridder_param_info, & rc) type(ESMF_FieldBundle), intent(in) :: fieldBundle @@ -57,13 +59,15 @@ subroutine bundle_get(fieldBundle, unusable, & character(:), optional, allocatable, intent(out) :: long_name type(StateItemAllocation), optional, intent(out) :: allocation_status logical, optional, intent(out) :: bracket_updated + logical, optional, intent(out) :: has_deferred_aspects + type(esmf_Info), optional, allocatable, intent(out) :: regridder_param_info integer, optional, intent(out) :: rc integer :: status integer :: fieldCount_ type(ESMF_Info) :: bundle_info logical :: has_geom - integer, allocatable :: vgrid_id + integer :: vgrid_id type(VerticalGridManager), pointer :: vgrid_manager if (present(fieldCount) .or. present(fieldList)) then @@ -78,10 +82,6 @@ subroutine bundle_get(fieldBundle, unusable, & call ESMF_FieldBundleGet(fieldBundle, fieldList=fieldList, itemOrderflag=ESMF_ITEMORDER_ADDORDER, _RC) end if - if (present(vgrid)) then - allocate(vgrid_id) ! trigger "is present" - end if - ! Get these from FieldBundleInfo call ESMF_InfoGetFromHost(fieldBundle, bundle_info, _RC) call FieldBundleInfoGetInternal(bundle_info, & @@ -94,6 +94,8 @@ subroutine bundle_get(fieldBundle, unusable, & bracket_updated=bracket_updated, & has_geom=has_geom, & vgrid_id=vgrid_id, & + has_deferred_aspects=has_deferred_aspects, & + regridder_param_info=regridder_param_info, & _RC) if (present(geom) .and. has_geom) then @@ -101,6 +103,15 @@ subroutine bundle_get(fieldBundle, unusable, & call get_geom(fieldBundle, geom, rc) end if + if (present(vgrid)) then + if (vgrid_id == VERTICAL_GRID_NOT_FOUND) then + vgrid => null() + else + vgrid_manager => get_vertical_grid_manager() + vgrid => vgrid_manager%get_grid(id=vgrid_id, _RC) + end if + end if + _RETURN(_SUCCESS) contains diff --git a/field_bundle/FieldBundleInfo.F90 b/field_bundle/FieldBundleInfo.F90 index 7cd42e6b0ea..011222c9e05 100644 --- a/field_bundle/FieldBundleInfo.F90 +++ b/field_bundle/FieldBundleInfo.F90 @@ -43,6 +43,8 @@ subroutine fieldbundle_get_internal(info, unusable, & spec_handle, & bracket_updated, & has_geom, & + has_deferred_aspects, & + regridder_param_info, & rc) type(ESMF_Info), intent(in) :: info @@ -63,6 +65,8 @@ subroutine fieldbundle_get_internal(info, unusable, & integer, optional, allocatable, intent(out) :: spec_handle(:) logical, optional, intent(out) :: bracket_updated logical, optional, intent(out) :: has_geom + logical, optional, intent(out) :: has_deferred_aspects + type(esmf_Info), optional, allocatable, intent(out) :: regridder_param_info integer, optional, intent(out) :: rc integer :: status @@ -109,6 +113,8 @@ subroutine fieldbundle_get_internal(info, unusable, & num_levels=num_levels, vert_staggerloc=vert_staggerloc, num_vgrid_levels=num_vgrid_levels, & units=units, long_name=long_name, standard_name=standard_name, spec_handle=spec_handle, & vgrid_id=vgrid_id, & + has_deferred_aspects=has_deferred_aspects, & + regridder_param_info=regridder_param_info, & _RC) _RETURN(_SUCCESS) @@ -145,6 +151,8 @@ subroutine fieldbundle_set_internal(info, unusable, & spec_handle, & bracket_updated, & has_geom, & + has_deferred_aspects, & + regridder_param_info, & rc) type(ESMF_Info), intent(inout) :: info @@ -164,6 +172,8 @@ subroutine fieldbundle_set_internal(info, unusable, & integer, optional, intent(in) :: spec_handle(:) logical, optional, intent(in) :: bracket_updated logical, optional, intent(in) :: has_geom + logical, optional, intent(in) :: has_deferred_aspects + type(esmf_info), optional, intent(in) :: regridder_param_info integer, optional, intent(out) :: rc integer :: status @@ -207,7 +217,10 @@ subroutine fieldbundle_set_internal(info, unusable, & num_levels=num_levels, vert_staggerloc=vert_staggerloc, & units=units, long_name=long_name, standard_name=standard_name, & vgrid_id=vgrid_id, & - spec_handle=spec_handle, _RC) + spec_handle=spec_handle, & + has_deferred_aspects=has_deferred_aspects, & + regridder_param_info=regridder_param_info, & + _RC) _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) diff --git a/field_bundle/FieldBundleSet.F90 b/field_bundle/FieldBundleSet.F90 index c2c2fa95ea0..9b20363f17b 100644 --- a/field_bundle/FieldBundleSet.F90 +++ b/field_bundle/FieldBundleSet.F90 @@ -37,6 +37,8 @@ subroutine bundle_set(fieldBundle, unusable, & units, standard_name, long_name, & allocation_status, & bracket_updated, & + has_deferred_aspects, & + regridder_param_info, & rc) type(ESMF_FieldBundle), intent(inout) :: fieldBundle @@ -54,6 +56,8 @@ subroutine bundle_set(fieldBundle, unusable, & character(*), optional, intent(in) :: long_name type(StateItemAllocation), optional, intent(in) :: allocation_status logical, optional, intent(in) :: bracket_updated + logical, optional, intent(in) :: has_deferred_aspects + type(esmf_Info), optional, intent(in) :: regridder_param_info integer, optional, intent(out) :: rc integer :: status @@ -107,7 +111,9 @@ subroutine bundle_set(fieldBundle, unusable, & allocation_status=allocation_status, & bracket_updated=bracket_updated, & has_geom=has_geom, & - _RC) + has_deferred_aspects=has_deferred_aspects, & + regridder_param_info=regridder_param_info, & + _RC) _RETURN(_SUCCESS) end subroutine bundle_set diff --git a/generic3g/CMakeLists.txt b/generic3g/CMakeLists.txt index f754bf3e426..d264defc109 100644 --- a/generic3g/CMakeLists.txt +++ b/generic3g/CMakeLists.txt @@ -7,7 +7,6 @@ set(srcs FieldDictionaryItem.F90 FieldDictionaryItemMap.F90 FieldDictionary.F90 - StateItemGetVerticalGrid.F90 GenericGrid.F90 diff --git a/generic3g/Generic3g.F90 b/generic3g/Generic3g.F90 index 36f5303d0d4..052551b75de 100644 --- a/generic3g/Generic3g.F90 +++ b/generic3g/Generic3g.F90 @@ -19,5 +19,4 @@ module Generic3g use mapl3g_geomio use mapl3g_ESMF_Utilities use mapl3g_StateItemModify - use mapl3g_StateItemGetVerticalGrid end module Generic3g diff --git a/generic3g/MAPL_Generic.F90 b/generic3g/MAPL_Generic.F90 index 60be5d24134..097055ef2d1 100644 --- a/generic3g/MAPL_Generic.F90 +++ b/generic3g/MAPL_Generic.F90 @@ -304,7 +304,7 @@ subroutine gridcomp_get(gridcomp, unusable, & integer :: status type(OuterMetaComponent), pointer :: outer_meta_ type(ESMF_Geom), allocatable :: geom_ - class(VerticalGrid), allocatable :: vertical_grid_ + class(VerticalGrid), pointer :: vertical_grid_ character(ESMF_MAXSTR) :: buffer call MAPL_GridCompGetOuterMeta(gridcomp, outer_meta_, _RC) @@ -317,8 +317,11 @@ subroutine gridcomp_get(gridcomp, unusable, & call ESMF_GeomGet(geom_, grid=grid, _RC) end if if (present(num_levels)) then - vertical_grid_ = outer_meta_%get_vertical_grid() - num_levels = vertical_grid_%get_num_levels() + vertical_grid_ => outer_meta_%get_vertical_grid() + num_levels = 1 + if (associated(vertical_grid_)) then + num_levels = vertical_grid_%get_num_levels() + end if end if if (present(name)) then diff --git a/generic3g/OuterMetaComponent.F90 b/generic3g/OuterMetaComponent.F90 index b23d77a8d0e..a8b2e7e6cb8 100644 --- a/generic3g/OuterMetaComponent.F90 +++ b/generic3g/OuterMetaComponent.F90 @@ -417,8 +417,8 @@ module subroutine set_vertical_grid(this, vertical_grid) end subroutine set_vertical_grid module function get_vertical_grid(this) result(vertical_grid) - class(VerticalGrid), allocatable :: verticaL_grid - class(OuterMetaComponent), intent(inout) :: this + class(VerticalGrid), pointer :: verticaL_grid + class(OuterMetaComponent), target, intent(inout) :: this end function get_vertical_grid module function get_registry(this) result(registry) diff --git a/generic3g/OuterMetaComponent/get_vertical_grid.F90 b/generic3g/OuterMetaComponent/get_vertical_grid.F90 index 0575ee4a39c..563098e8513 100644 --- a/generic3g/OuterMetaComponent/get_vertical_grid.F90 +++ b/generic3g/OuterMetaComponent/get_vertical_grid.F90 @@ -7,9 +7,14 @@ contains module function get_vertical_grid(this) result(vertical_grid) - class(VerticalGrid), allocatable :: verticaL_grid - class(OuterMetaComponent), intent(inout) :: this - vertical_grid = this%vertical_grid + class(VerticalGrid), pointer :: verticaL_grid + class(OuterMetaComponent), target, intent(inout) :: this + + verticaL_grid => null() + if (allocated(this%verticaL_grid)) then + vertical_grid => this%vertical_grid + end if + end function get_vertical_grid end submodule get_vertical_grid_smod diff --git a/generic3g/StateItemGetVerticalGrid.F90 b/generic3g/StateItemGetVerticalGrid.F90 deleted file mode 100644 index 30fddbdd73f..00000000000 --- a/generic3g/StateItemGetVerticalGrid.F90 +++ /dev/null @@ -1,63 +0,0 @@ -#include "MAPL.h" -module mapl3g_StateItemGetVerticalGrid - use mapl3g_VerticalGrid - use mapl3g_StateItemSpec - use mapl3g_StateItemAspect - use mapl3g_VerticalGridAspect - use mapl3g_FieldInfo, only: FieldInfoGetInternal - use mapl3g_FieldBundleInfo, only: FieldBundleInfoGetInternal - use mapl3g_AspectId - use mapl3g_FieldInfo, only: FieldInfoGetInternal - use mapl_ErrorHandling - use esmf - use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer - implicit none - private - - public :: mapl_FieldGetVerticalGrid -!# public :: mapl_FieldBundleGetVerticalGrid - - interface mapl_FieldGetVerticalGrid - procedure :: field_get_vertical_grid - end interface mapl_FieldGetVerticalGrid - -!# interface mapl_FieldBundleGetVerticalGrid -!# procedure :: bundle_get_vertical_grid -!# end interface mapl_FieldGetVerticalGrid - - -contains - - subroutine field_get_vertical_grid(field, vertical_grid, rc) - type(esmf_Field), intent(inout) :: field - class(VerticalGrid), allocatable, intent(out) :: vertical_grid - integer, optional, intent(out) :: rc - - integer :: status - type(c_ptr) :: spec_cptr - type(StateItemSpec), pointer :: spec - class(StateItemAspect), pointer :: aspect - integer, allocatable :: spec_handle(:) - type(esmf_Info) :: info - - call ESMF_InfoGetFromHost(field, info, _RC) - call FieldBundleInfoGetInternal(info, spec_handle=spec_handle, _RC) - - spec_cptr = transfer(spec_handle, spec_cptr) - call c_f_pointer(spec_cptr, spec) - - aspect => spec%get_aspect(VERTICAL_GRID_ASPECT_ID) - if (.not. associated(aspect)) then - _FAIL('null aspect pointer for VERTICAL_GRID_ASPECT_ID') - end if - select type(aspect) - type is (VerticalGridAspect) - vertical_grid = aspect%get_vertical_grid(_RC) - class default - _FAIL('Expected VerticalGridAspect but got different type') - end select - - _RETURN(_SUCCESS) - end subroutine field_get_vertical_grid - -end module mapl3g_StateItemGetVerticalGrid diff --git a/generic3g/connection/SimpleConnection.F90 b/generic3g/connection/SimpleConnection.F90 index 9f8d34fb87a..3d86466aac2 100644 --- a/generic3g/connection/SimpleConnection.F90 +++ b/generic3g/connection/SimpleConnection.F90 @@ -125,6 +125,7 @@ recursive subroutine connect(this, registry, rc) src_pt = this%get_source() src_registry => registry%get_subregistry(src_pt) + is_deferred = src_registry%item_is_deferred(src_pt%v_pt, _RC) _RETURN_IF(is_deferred) @@ -169,8 +170,8 @@ recursive subroutine connect_sibling(this, dst_registry, src_registry, unusable, dst_extensions = dst_registry%get_extensions(dst_pt%v_pt, _RC) ! Very useful for debugging: -!# _HERE, src_pt%v_pt -!# _HERE, dst_pt%v_pt +!# _HERE, 'src component: ', src_pt%component_name, ' :: ', src_pt%v_pt +!# _HERE, 'dst component: ', dst_pt%component_name, ' :: ', dst_pt%v_pt do i = 1, size(dst_extensions) dst_extension => dst_extensions(i)%ptr diff --git a/generic3g/connection/VirtualConnectionPt.F90 b/generic3g/connection/VirtualConnectionPt.F90 index c0953b1c83a..d9c8c0ea13e 100644 --- a/generic3g/connection/VirtualConnectionPt.F90 +++ b/generic3g/connection/VirtualConnectionPt.F90 @@ -3,6 +3,7 @@ module mapl3g_VirtualConnectionPt use mapl_KeywordEnforcer use esmf + use, intrinsic :: iso_c_binding, only: C_NULL_CHAR implicit none private @@ -239,8 +240,8 @@ logical function matches(this, item) matches = (this%get_state_intent() == item%get_state_intent()) if (.not. matches) return - call regcomp(regex,'^'//this%get_full_name()//'$',flags='xmi') - matches = regexec(regex,item%get_full_name()) + call regcomp(regex,'^'//this%get_full_name()//'$' // C_NULL_CHAR,flags='xmi') + matches = regexec(regex,item%get_full_name() // C_NULL_CHAR) end function matches diff --git a/generic3g/registry/StateItemExtension.F90 b/generic3g/registry/StateItemExtension.F90 index a7b4a8735bd..aab8aa2e746 100644 --- a/generic3g/registry/StateItemExtension.F90 +++ b/generic3g/registry/StateItemExtension.F90 @@ -142,11 +142,13 @@ recursive function make_extension(this, goal, rc) result(extension) type(AspectMap), pointer :: other_aspects call this%spec%activate(_RC) + call this%spec%update_from_payload(_RC) new_spec = this%spec aspect_ids = this%spec%get_aspect_order(goal) do i = 1, size(aspect_ids) + src_aspect => new_spec%get_aspect(aspect_ids(i), _RC) _ASSERT(associated(src_aspect), 'src aspect not found') @@ -158,8 +160,8 @@ recursive function make_extension(this, goal, rc) result(extension) other_aspects => new_spec%get_aspects() allocate(transform, source=src_aspect%make_transform(dst_aspect, other_aspects, rc=status)) _VERIFY(status) - call new_spec%set_aspect(dst_aspect, _RC) + exit end if diff --git a/generic3g/registry/StateRegistry.F90 b/generic3g/registry/StateRegistry.F90 index 479b5f266cd..073a8489fe4 100644 --- a/generic3g/registry/StateRegistry.F90 +++ b/generic3g/registry/StateRegistry.F90 @@ -813,8 +813,17 @@ recursive function extend(registry, v_pt, goal_spec, rc) result(extension) iter_count = 0 do iter_count = iter_count + 1 - _ASSERT(iter_count <= MAX_ITERATIONS, "StateItem extensions for v_pt did not converge.") - + _ASSERT(iter_count <= MAX_ITERATIONS, "StateItem extensions for v_pt did not converge.") + + ! Leave commented code here. This should be migrated to use pflogger in the future. + ! Useful debugging point. + +!# block +!# type(StateItemSpec), pointer :: spec +!# spec => closest_extension%get_spec() +!# _HERE, 'extending? ', iter_count +!# call spec%print_spec(__FILE__,__LINE__) +!# end block tmp_extension = closest_extension%make_extension(goal_spec, _RC) if (.not. associated(tmp_extension%get_producer())) exit ! no further extensions needed diff --git a/generic3g/specs/BracketClassAspect.F90 b/generic3g/specs/BracketClassAspect.F90 index 59013d1bac3..baa337fbc78 100644 --- a/generic3g/specs/BracketClassAspect.F90 +++ b/generic3g/specs/BracketClassAspect.F90 @@ -160,11 +160,13 @@ subroutine allocate(this, other_aspects, rc) integer :: i type(FieldClassAspect) :: tmp + associate (n => this%bracket_size) - do i = 1, n tmp = this%field_aspect call tmp%create(other_aspects, _RC) + call update_payload(tmp, other_aspects, _RC) + call tmp%allocate(other_aspects, _RC) call tmp%add_to_bundle(this%payload, _RC) end do @@ -185,6 +187,31 @@ end function int_to_string end subroutine allocate + subroutine update_payload(field_aspect, other_aspects, rc) + type(FieldClassAspect), intent(inout) :: field_aspect + type(AspectMap), target, intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + integer :: status + type(AspectMapIterator) :: iter + class(StateItemAspect), pointer :: aspect + type(esmf_Field), allocatable :: field + + call field_aspect%get_payload(field=field, _RC) + + associate(e => other_aspects%ftn_end()) + iter = other_aspects%ftn_begin() + do while (iter /= e) + call iter%next() + aspect => iter%second() + call aspect%update_payload(field=field, _RC) + end do + end associate + + _RETURN(_SUCCESS) + + end subroutine update_payload + subroutine destroy(this, rc) class(BracketClassAspect), intent(inout) :: this integer, optional, intent(out) :: rc diff --git a/generic3g/specs/ChildSpecMap.F90 b/generic3g/specs/ChildSpecMap.F90 index ebd806dc0d6..25b29703106 100644 --- a/generic3g/specs/ChildSpecMap.F90 +++ b/generic3g/specs/ChildSpecMap.F90 @@ -3,15 +3,15 @@ module mapl3g_ChildSpecMap #define Key __CHARACTER_DEFERRED #define T ChildSpec -#define Map ChildSpecMap -#define MapIterator ChildSpecMapIterator +#define OrderedMap ChildSpecMap +#define OrderedMapIterator ChildSpecMapIterator #define Pair ChildSpecPair -#include "map/template.inc" +#include "ordered_map/template.inc" #undef Pair -#undef MapIterator -#undef Map +#undef OrderedMapIterator +#undef OrderedMap #undef T #undef Key diff --git a/generic3g/specs/ExpressionClassAspect.F90 b/generic3g/specs/ExpressionClassAspect.F90 index 4021da7c69e..963cb813e2a 100644 --- a/generic3g/specs/ExpressionClassAspect.F90 +++ b/generic3g/specs/ExpressionClassAspect.F90 @@ -58,6 +58,7 @@ module mapl3g_ExpressionClassAspect private character(:), allocatable :: expression type(StateRegistry), pointer :: registry => null() + type(ESMF_Field) :: payload ! to hold metadata contains procedure :: get_aspect_order procedure :: supports_conversion_general @@ -123,6 +124,8 @@ subroutine create(this, other_aspects, handle, rc) integer :: status + this%payload = ESMF_FieldEmptyCreate(name='expression', _RC) + _RETURN(ESMF_SUCCESS) end subroutine create @@ -252,11 +255,13 @@ function make_transform(src, dst, other_aspects, rc) result(transform) type(StringVectorIterator) :: iter character(:), pointer :: variable + transform = NullTransform() multi_state = MultiState() select type (dst) type is (FieldClassAspect) + expression_variables = parser_variables_in_expression(src%expression, _RC) associate (b => expression_variables%begin(), e => expression_variables%end()) iter = b @@ -271,7 +276,9 @@ function make_transform(src, dst, other_aspects, rc) result(transform) goal_aspects => goal_spec%get_aspects() n = goal_aspects%erase(CLASS_ASPECT_ID) call goal_aspects%insert(CLASS_ASPECT_ID, FieldClassAspect(standard_name='', long_name='')) - do i = 1, inputs%size() + call goal_spec%create(_RC) + + do i = 1, inputs%size() v_pt => inputs%of(i) new_extension => src%registry%extend(v_pt, goal_spec, _RC) coupler => new_extension%get_producer() @@ -289,11 +296,11 @@ function make_transform(src, dst, other_aspects, rc) result(transform) class default _FAIL("unsupported aspect type; must be FieldClassAspect") end select - end do + end do + deallocate(transform) allocate(transform, source=EvalTransform(src%expression, multi_state%exportState, input_couplers)) class default - allocate(transform, source=NullTransform()) _FAIL('expression connected to non-field') end select @@ -366,6 +373,8 @@ subroutine get_payload(this, unusable, field, bundle, state, rc) type(esmf_State), optional, allocatable, intent(out) :: state integer, optional, intent(out) :: rc + field = this%payload + _RETURN(_SUCCESS) end subroutine get_payload diff --git a/generic3g/specs/FieldClassAspect.F90 b/generic3g/specs/FieldClassAspect.F90 index 8e2e5905eff..3cf88eae556 100644 --- a/generic3g/specs/FieldClassAspect.F90 +++ b/generic3g/specs/FieldClassAspect.F90 @@ -183,18 +183,17 @@ subroutine allocate(this, other_aspects, rc) type(ESMF_FieldStatus_Flag) :: fstatus type(GeomAspect) :: geom_aspect - type(ESMF_Geom) :: geom + type(ESMF_Geom), allocatable :: geom type(HorizontalDimsSpec) :: horizontal_dims_spec integer :: dim_count integer, allocatable :: grid_to_field_map(:) type(VerticalGridAspect) :: vertical_aspect - class(VerticalGrid), allocatable :: vertical_grid type(VerticalStaggerLoc) :: vertical_stagger integer, allocatable :: num_vgrid_levels integer, allocatable :: num_field_levels + integer :: num_levels - type(UngriddedDimsAspect) :: ungridded_dims_aspect type(UngriddedDims) :: ungridded_dims type(UnitsAspect) :: units_aspect @@ -208,10 +207,19 @@ subroutine allocate(this, other_aspects, rc) call ESMF_FieldGet(this%payload, status=fstatus, _RC) _RETURN_IF(fstatus == ESMF_FIELDSTATUS_COMPLETE) - geom_aspect = to_GeomAspect(other_aspects, _RC) - geom = geom_aspect%get_geom(_RC) - call ESMF_FieldEmptySet(this%payload, geom, _RC) + num_levels = 0 + call mapl_FieldGet(this%payload, & + geom=geom, & + num_levels=num_levels, & + vert_staggerloc=vertical_stagger, & + ungridded_dims=ungridded_dims, & + _RC) + + if (num_levels > 0) then + num_field_levels = num_levels + end if + call ESMF_GeomGet(geom, dimCount=dim_count, _RC) allocate(grid_to_field_map(dim_count), source=0) horizontal_dims_spec = geom_aspect%get_horizontal_dims_spec(_RC) @@ -220,20 +228,6 @@ subroutine allocate(this, other_aspects, rc) grid_to_field_map = [(idim, idim=1,dim_count)] end if - vertical_aspect = to_VerticalGridAspect(other_aspects, _RC) - vertical_stagger = vertical_aspect%get_vertical_stagger() - if (vertical_stagger /= VERTICAL_STAGGER_NONE) then - vertical_grid = vertical_aspect%get_vertical_grid(_RC) - num_vgrid_levels = vertical_grid%get_num_levels() - if (vertical_stagger == VERTICAL_STAGGER_EDGE) then - num_field_levels = num_vgrid_levels + 1 - else if (vertical_stagger == VERTICAL_STAGGER_CENTER) then - num_field_levels = num_vgrid_levels - end if - end if - - ungridded_dims_aspect = to_UngriddedDimsAspect(other_aspects, _RC) - ungridded_dims = ungridded_dims_aspect%get_ungridded_dims() units_aspect = to_UnitsAspect(other_aspects, _RC) units = units_aspect%get_units(_RC) @@ -376,7 +370,7 @@ function make_transform(src, dst, other_aspects, rc) result(transform) class(StateItemAspect), intent(in) :: dst type(AspectMap), target, intent(in) :: other_aspects integer, optional, intent(out) :: rc - + transform = NullTransform() _RETURN(_SUCCESS) diff --git a/generic3g/specs/GeomAspect.F90 b/generic3g/specs/GeomAspect.F90 index c9dc357a460..d631f55c763 100644 --- a/generic3g/specs/GeomAspect.F90 +++ b/generic3g/specs/GeomAspect.F90 @@ -12,10 +12,12 @@ module mapl3g_GeomAspect use mapl3g_NullTransform use mapl3g_Field_API use mapl3g_FieldBundle_API + use mapl3g_EsmfRegridder use mapl_ErrorHandling use ESMF, only: esmf_Geom use ESMF, only: esmf_Field, esmf_FieldBundle, esmf_State - implicit none + use ESMF, only: esmf_Info + implicit none(type,external) private public :: GeomAspect @@ -27,7 +29,7 @@ module mapl3g_GeomAspect end interface to_GeomAspect type, extends(StateItemAspect) :: GeomAspect -!# private + private type(ESMF_Geom), allocatable :: geom type(EsmfRegridderParam), allocatable :: regridder_param type(HorizontalDimsSpec) :: horizontal_dims_spec = HORIZONTAL_DIMS_GEOM ! none, geom @@ -45,7 +47,8 @@ module mapl3g_GeomAspect procedure :: update_from_payload procedure :: update_payload - end type GeomAspect + procedure :: print_aspect + end type GeomAspect interface GeomAspect procedure new_GeomAspect @@ -266,13 +269,20 @@ subroutine update_from_payload(this, field, bundle, state, rc) integer, optional, intent(out) :: rc integer :: status + type(esmf_Info), allocatable :: regridder_param_info _RETURN_UNLESS(present(field) .or. present(bundle)) if (present(field)) then - call mapl_FieldGet(field, geom=this%geom, _RC) + call mapl_FieldGet(field, geom=this%geom, regridder_param_info=regridder_param_info, _RC) else if (present(bundle)) then - call mapl_FieldBundleGet(bundle, geom=this%geom, _RC) + call mapl_FieldBundleGet(bundle, geom=this%geom, regridder_param_info=regridder_param_info, _RC) + end if + + if (allocated(regridder_param_info)) then + this%regridder_param = make_EsmfRegridderParam(regridder_param_info, _RC) + else + if (allocated(this%regridder_param)) deallocate(this%regridder_param) end if call this%set_mirror(.not. allocated(this%geom)) @@ -288,16 +298,33 @@ subroutine update_payload(this, field, bundle, state, rc) integer, optional, intent(out) :: rc integer :: status + type(esmf_Info), allocatable :: regridder_param_info _RETURN_UNLESS(present(field) .or. present(bundle)) + if (allocated(this%regridder_param)) then + regridder_param_info = this%regridder_param%make_info(_RC) + end if if (present(field)) then - call mapl_FieldSet(field, geom=this%geom, _RC) + call mapl_FieldSet(field, geom=this%geom, regridder_param_info=regridder_param_info, _RC) else if (present(bundle)) then - call mapl_FieldBundleSet(bundle, geom=this%geom, _RC) + call mapl_FieldBundleSet(bundle, geom=this%geom, regridder_param_info=regridder_param_info, _RC) end if _RETURN(_SUCCESS) end subroutine update_payload + subroutine print_aspect(this, file, line, rc) + class(GeomAspect), intent(in) :: this + character(*), intent(in) :: file + integer, intent(in) :: line + integer, optional, intent(out) :: rc + + _HERE, file, line, this%is_mirror(), allocated(this%geom) + _HERE, file, line, this%is_mirror(), allocated(this%regridder_param) + + + _RETURN(_SUCCESS) + end subroutine print_aspect + end module mapl3g_GeomAspect diff --git a/generic3g/specs/StateItemAspect.F90 b/generic3g/specs/StateItemAspect.F90 index d807daf7364..cec916a65c7 100644 --- a/generic3g/specs/StateItemAspect.F90 +++ b/generic3g/specs/StateItemAspect.F90 @@ -88,6 +88,8 @@ module mapl3g_StateItemAspect procedure(I_update_from_payload), deferred :: update_from_payload procedure(I_update_payload), deferred :: update_payload + procedure :: print_aspect + end type StateItemAspect #include "map/specification.inc" @@ -267,6 +269,16 @@ subroutine connect_to_import(this, import, rc) _UNUSED_DUMMY(this) _UNUSED_DUMMY(import) end subroutine connect_to_import + + ! default + subroutine print_aspect(this, file, line, rc) + class(StateItemAspect), intent(in) :: this + character(*), intent(in) :: file + integer, intent(in) :: line + integer, optional, intent(out) :: rc + + _RETURN(_SUCCESS) + end subroutine print_aspect #undef AspectPair diff --git a/generic3g/specs/StateItemSpec.F90 b/generic3g/specs/StateItemSpec.F90 index d8ed275abeb..60b1bff759f 100644 --- a/generic3g/specs/StateItemSpec.F90 +++ b/generic3g/specs/StateItemSpec.F90 @@ -13,6 +13,7 @@ module mapl3g_StateItemSpec use mapl3g_VerticalGrid use mapl_ErrorHandling use mapl3g_Field_API + use mapl3g_FieldBundle_API use esmf use gftl2_stringvector implicit none @@ -73,6 +74,8 @@ module mapl3g_StateItemSpec procedure :: add_to_state procedure :: set_geometry + procedure :: print_spec + procedure :: update_from_payload end type StateItemSpec type :: StateItemSpecPtr @@ -172,9 +175,16 @@ function get_aspect_by_id(this, aspect_id, rc) result(aspect) integer, optional, intent(out) :: rc integer :: status + class(ClassAspect), pointer :: class_aspect + type(esmf_Field), allocatable :: field + type(esmf_FieldBundle), allocatable :: bundle + type(esmf_State), allocatable :: state aspect => this%aspects%at(aspect_id, _RC) - call aspect%update_from_payload(_RC) + + class_aspect => to_ClassAspect(this%aspects, _RC) + call class_aspect%get_payload(field=field, bundle=bundle, state=state, _RC) + call aspect%update_from_payload(field=field, bundle=bundle, state=state, _RC) _RETURN(_SUCCESS) end function get_aspect_by_id @@ -182,7 +192,9 @@ end function get_aspect_by_id function get_aspects(this) result(aspects) type(AspectMap), pointer :: aspects class(StateItemSpec), target, intent(in) :: this + aspects => this%aspects + end function get_aspects subroutine set_aspect(this, aspect, rc) @@ -266,6 +278,13 @@ subroutine create(this, rc) call class_aspect%get_payload(field=field, bundle=bundle, state=state, _RC) call update_payload_from_aspects(this, field=field, bundle=bundle, state=state, _RC) + if (allocated(field)) then + call mapl_FieldSet(field, has_deferred_aspects=this%has_deferred_aspects_, _RC) + end if + if (allocated(bundle)) then + call mapl_FieldBundleSet(bundle, has_deferred_aspects=this%has_deferred_aspects_, _RC) + end if + _RETURN(_SUCCESS) contains @@ -536,11 +555,34 @@ subroutine set_has_deferred_aspects(this, has_deferred_aspects) this%has_deferred_aspects_ = has_deferred_aspects end subroutine set_has_deferred_aspects - logical function has_deferred_aspects(this) result(flag) - class(StateItemSpec), intent(in) :: this + logical function has_deferred_aspects(this, rc) + class(StateItemSpec), target, intent(in) :: this + integer, optional, intent(out) :: rc - flag = this%has_deferred_aspects_ + integer :: status + class(ClassAspect), pointer :: class_aspect + type(esmf_Field), allocatable :: field + type(esmf_FieldBundle), allocatable :: bundle + type(esmf_State), allocatable :: state + has_deferred_aspects = .false. ! default + + class_aspect => to_ClassAspect(this%aspects, _RC) + call class_aspect%get_payload(field=field, bundle=bundle, state=state, _RC) + + if (allocated(field)) then + call mapl_FieldGet(field, has_deferred_aspects=has_deferred_aspects, _RC) + end if + + if (allocated(bundle)) then + call mapl_FieldBundleGet(bundle, has_deferred_aspects=has_deferred_aspects, _RC) + end if + + if (allocated(state)) then + _FAIL('unsupported use case') + end if + + _RETURN(_SUCCESS) end function has_deferred_aspects subroutine set_allocation_status(this, allocation_status) @@ -557,4 +599,72 @@ function get_allocation_status(this) result(allocation_status) allocation_status = this%allocation_status end function get_allocation_status + subroutine print_spec(this, file, line, rc) + class(StateItemSpec), target, intent(in) :: this + character(*), intent(in) :: file + integer, intent(in) :: line + integer, optional, intent(out) :: rc + + integer :: status + class(ClassAspect), pointer :: class_aspect + type(esmf_field), allocatable :: field + type(esmf_fieldbundle), allocatable :: bundle + type(esmf_info) :: info + + class_aspect => to_ClassAspect(this%aspects, _RC) + call class_aspect%get_payload(field=field, bundle=bundle, _RC) + if (allocated(field)) then + call esmf_infogetfromhost(field, info, _RC) + _HERE, file, line, 'field:' + call esmf_infoprint(info, _RC) + end if + if (allocated(bundle)) then + call esmf_infogetfromhost(bundle, info, _RC) + _HERE, file, line, 'bundle:' + call esmf_infoprint(info, _RC) + end if + _RETURN(_SUCCESS) + end subroutine print_spec + + subroutine update_from_payload(this, rc) + class(StateItemSpec), target, intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + class(ClassAspect), pointer :: class_aspect + type(AspectMapIterator) :: iter + class(StateItemAspect), pointer :: aspect + type(esmf_Field), allocatable :: field + type(esmf_FieldBundle), allocatable :: bundle + type(esmf_State), allocatable :: state + + class_aspect => to_ClassAspect(this%aspects, _RC) + call class_aspect%get_payload(field=field, bundle=bundle, state=state, _RC) + + associate(e => this%aspects%ftn_end()) + iter = this%aspects%ftn_begin() + do while (iter /= e) + call iter%next() + ! Must skip "class" or it will overwrite aspects in info ... + if (iter%first() == CLASS_ASPECT_ID) cycle + aspect => iter%second() + call aspect%update_from_payload(field=field, bundle=bundle, state=state, _RC) + end do + end associate + + _RETURN(_SUCCESS) + contains + + function make_handle(this) result(handle) + use, intrinsic :: iso_c_binding, only: c_ptr, c_loc + integer, allocatable :: handle(:) + type(StateItemSpec), target, intent(in) :: this + type(c_ptr) :: ptr + + ptr = c_loc(this) + handle = transfer(ptr, [1]) + end function make_handle + + end subroutine update_from_payload + end module mapl3g_StateItemSpec diff --git a/generic3g/specs/UnitsAspect.F90 b/generic3g/specs/UnitsAspect.F90 index ed746f12ca3..199ab2ea1f1 100644 --- a/generic3g/specs/UnitsAspect.F90 +++ b/generic3g/specs/UnitsAspect.F90 @@ -40,6 +40,7 @@ module mapl3g_UnitsAspect procedure :: update_from_payload procedure :: update_payload + procedure :: print_aspect end type UnitsAspect interface UnitsAspect @@ -207,7 +208,7 @@ subroutine update_from_payload(this, field, bundle, state, rc) integer :: status _RETURN_UNLESS(present(field) .or. present(bundle)) - + if (present(field)) then call mapl_FieldGet(field, units=this%units, _RC) else if (present(bundle)) then @@ -239,5 +240,18 @@ subroutine update_payload(this, field, bundle, state, rc) _RETURN(_SUCCESS) end subroutine update_payload + subroutine print_aspect(this, file, line, rc) + class(UnitsAspect), intent(in) :: this + character(*), intent(in) :: file + integer, intent(in) :: line + integer, optional, intent(out) :: rc + + _HERE, file, line, this%is_mirror(), allocated(this%units) + if (allocated(this%units)) then + _HERE, file, line, '<', this%units, '>' + end if + + _RETURN(_SUCCESS) + end subroutine print_aspect end module mapl3g_UnitsAspect diff --git a/generic3g/specs/VectorBracketClassAspect.F90 b/generic3g/specs/VectorBracketClassAspect.F90 index a3a62d5d2b1..0f5215de030 100644 --- a/generic3g/specs/VectorBracketClassAspect.F90 +++ b/generic3g/specs/VectorBracketClassAspect.F90 @@ -167,6 +167,7 @@ subroutine allocate(this, other_aspects, rc) do i = 1, n tmp = this%field_aspect call tmp%create(other_aspects, _RC) + call update_payload(tmp, other_aspects, _RC) call tmp%allocate(other_aspects, _RC) call tmp%add_to_bundle(this%payload, _RC) end do @@ -187,6 +188,31 @@ end function int_to_string end subroutine allocate + subroutine update_payload(field_aspect, other_aspects, rc) + type(FieldClassAspect), intent(inout) :: field_aspect + type(AspectMap), target, intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + integer :: status + type(AspectMapIterator) :: iter + class(StateItemAspect), pointer :: aspect + type(esmf_Field), allocatable :: field + + call field_aspect%get_payload(field=field, _RC) + + associate(e => other_aspects%ftn_end()) + iter = other_aspects%ftn_begin() + do while (iter /= e) + call iter%next() + aspect => iter%second() + call aspect%update_payload(field=field, _RC) + end do + end associate + + _RETURN(_SUCCESS) + + end subroutine update_payload + subroutine destroy(this, rc) class(VectorBracketClassAspect), intent(inout) :: this integer, optional, intent(out) :: rc diff --git a/generic3g/specs/VectorClassAspect.F90 b/generic3g/specs/VectorClassAspect.F90 index a813e6b6fb0..34508ff56c6 100644 --- a/generic3g/specs/VectorClassAspect.F90 +++ b/generic3g/specs/VectorClassAspect.F90 @@ -152,10 +152,10 @@ subroutine allocate(this, other_aspects, rc) integer :: status integer :: i - type(FieldClassAspect) :: tmp do i = 1, NUM_COMPONENTS call this%component_specs(i)%create(other_aspects, _RC) + call update_payload(this%component_specs(i), other_aspects, _RC) call this%component_specs(i)%allocate(other_aspects, _RC) call this%component_specs(i)%add_to_bundle(this%payload, _RC) end do @@ -163,6 +163,30 @@ subroutine allocate(this, other_aspects, rc) _RETURN(ESMF_SUCCESS) end subroutine allocate + subroutine update_payload(field_aspect, other_aspects, rc) + type(FieldClassAspect), intent(inout) :: field_aspect + type(AspectMap), target, intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + integer :: status + type(AspectMapIterator) :: iter + class(StateItemAspect), pointer :: aspect + type(esmf_Field), allocatable :: field + + call field_aspect%get_payload(field=field, _RC) + + associate(e => other_aspects%ftn_end()) + iter = other_aspects%ftn_begin() + do while (iter /= e) + call iter%next() + aspect => iter%second() + call aspect%update_payload(field=field, _RC) + end do + end associate + + _RETURN(_SUCCESS) + + end subroutine update_payload subroutine destroy(this, rc) class(VectorClassAspect), intent(inout) :: this diff --git a/generic3g/specs/VerticalGridAspect.F90 b/generic3g/specs/VerticalGridAspect.F90 index 9bee1abf203..c91965603ad 100644 --- a/generic3g/specs/VerticalGridAspect.F90 +++ b/generic3g/specs/VerticalGridAspect.F90 @@ -293,12 +293,12 @@ function get_aspect_id() result(aspect_id) end function get_aspect_id function get_vertical_grid(this, rc) result(vertical_grid) - class(VerticalGridAspect), intent(in) :: this - class(VerticalGrid), allocatable :: vertical_grid + class(VerticalGridAspect), target, intent(in) :: this + class(VerticalGrid), pointer :: vertical_grid integer, optional, intent(out) :: rc _ASSERT(allocated(this%vertical_grid), "vertical_grid not allocated.") - vertical_grid = this%vertical_grid + vertical_grid => this%vertical_grid _RETURN(_SUCCESS) end function get_vertical_grid @@ -325,18 +325,25 @@ subroutine update_from_payload(this, field, bundle, state, rc) ! Must use a pointer for get/set, but aspect uses an allocatable ! Future work should consider changing aspect to also be pointer. class(VerticalGrid), pointer :: vgrid + logical :: is_mirror _RETURN_UNLESS(present(field) .or. present(bundle)) if (present(field)) then - call mapl_FieldGet(field, vgrid=vgrid, _RC) + call mapl_FieldGet(field, vgrid=vgrid, vert_staggerloc=this%vertical_stagger, _RC) else if (present(bundle)) then - call mapl_FieldBundleGet(bundle, vgrid=vgrid, _RC) + call mapl_FieldBundleGet(bundle, vgrid=vgrid, vert_staggerloc=this%vertical_stagger, _RC) end if - call this%set_mirror(.not. associated(vgrid)) + is_mirror = .not. allocated(this%vertical_stagger) + if (.not. is_mirror) then + if (this%vertical_stagger /= VERTICAL_STAGGER_NONE) then + is_mirror = .not. associated(vgrid) + end if + end if + call this%set_mirror(is_mirror) - deallocate(this%vertical_grid) + if (allocated(this%vertical_grid)) deallocate(this%vertical_grid) if (associated(vgrid)) then this%vertical_grid = vgrid end if @@ -352,13 +359,24 @@ subroutine update_payload(this, field, bundle, state, rc) integer, optional, intent(out) :: rc integer :: status + integer :: num_vgrid_levels + integer, allocatable :: num_levels _RETURN_UNLESS(present(field) .or. present(bundle)) + if (allocated(this%vertical_grid)) then + num_vgrid_levels = this%vertical_grid%get_num_levels() + if (this%vertical_stagger == VERTICAL_STAGGER_EDGE) then + num_levels = num_vgrid_levels + 1 + else if (this%vertical_stagger == VERTICAL_STAGGER_CENTER) then + num_levels = num_vgrid_levels + end if + end if + if (present(field)) then - call mapl_FieldSet(field, vgrid=this%vertical_grid, _RC) + call mapl_FieldSet(field, vgrid=this%vertical_grid, vert_staggerloc=this%vertical_stagger, num_levels=num_levels, _RC) else if (present(bundle)) then - call mapl_FieldBundleSet(bundle, vgrid=this%vertical_grid, _RC) + call mapl_FieldBundleSet(bundle, vgrid=this%vertical_grid, vert_staggerloc=this%vertical_stagger, num_levels=num_levels, _RC) end if _RETURN(_SUCCESS) diff --git a/generic3g/tests/CMakeLists.txt b/generic3g/tests/CMakeLists.txt index 1c9d5bc3f84..c5fff7cb3e7 100644 --- a/generic3g/tests/CMakeLists.txt +++ b/generic3g/tests/CMakeLists.txt @@ -10,6 +10,7 @@ set (test_srcs Test_ConfigurableGridComp.pf + Test_ComponentSpec.pf Test_ComponentSpecParser.pf Test_Aspects.pf Test_BracketClassAspect.pf diff --git a/generic3g/tests/Test_ComponentSpec.pf b/generic3g/tests/Test_ComponentSpec.pf new file mode 100644 index 00000000000..aca8a2ca85b --- /dev/null +++ b/generic3g/tests/Test_ComponentSpec.pf @@ -0,0 +1,70 @@ +module Test_ComponentSpec + use pfunit + use mapl3g_ComponentSpec + use mapl3g_ChildSpec + use mapl3g_ChildSpecMap + implicit none (type,external) + +contains + + @test + ! This is a simple test that ensures that the order of a components + ! children is preserved in the spec. OuterMetaComponent properly uses + ! an "ordered" map container to hold children, but the ComponentSpecMap is + ! a simple map. Unfortunately, the existing unit tests did not detect this + ! discrepancy. (Which will not usually matter.) + + subroutine test_child_order() + + type(ComponentSpec), target :: parent_spec + type(ChildSpec) :: child + type(ChildSpecMapIterator) :: iter + character(:), pointer :: p_name + + call parent_spec%children%insert('a', child) + call parent_spec%children%insert('b', child) + call parent_spec%children%insert('c', child) + + iter = parent_spec%children%begin() + p_name => iter%first() + @assertEqual('a', p_name) + + call iter%next() + p_name => iter%first() + @assertEqual('b', p_name) + + call iter%next() + p_name => iter%first() + @assertEqual('c', p_name) + + end subroutine test_child_order + + @test + ! The "hard" case is when children are inserted in reverse + ! alphabetic order. + subroutine test_child_order_reverse() + + type(ComponentSpec), target :: parent_spec + type(ChildSpec) :: child + type(ChildSpecMapIterator) :: iter + character(:), pointer :: p_name + + call parent_spec%children%insert('c', child) + call parent_spec%children%insert('b', child) + call parent_spec%children%insert('a', child) + + iter = parent_spec%children%begin() + p_name => iter%first() + @assertEqual('c', p_name) + + call iter%next() + p_name => iter%first() + @assertEqual('b', p_name) + + call iter%next() + p_name => iter%first() + @assertEqual('a', p_name) + + end subroutine test_child_order_reverse + +end module Test_ComponentSpec diff --git a/generic3g/tests/Test_ConfigurableGridComp.pf b/generic3g/tests/Test_ConfigurableGridComp.pf index 7ef15099f5b..cd6d2f5d677 100644 --- a/generic3g/tests/Test_ConfigurableGridComp.pf +++ b/generic3g/tests/Test_ConfigurableGridComp.pf @@ -453,14 +453,14 @@ contains outer_meta => get_outer_meta(outer_gc, rc=status) @assert_that(status, is(0)) - call check('child_A', 'import', 'I_A1', ESMF_FIELDSTATUS_EMPTY, rc=status) + call check('child_A', 'import', 'I_A1', ESMF_FIELDSTATUS_GEOMSET, rc=status) @assert_that(status, is(0)) call check('child_A', 'export', 'E_A1', ESMF_FIELDSTATUS_COMPLETE, rc=status) @assert_that(status, is(0)) call check('child_B', 'import', 'I_B1', ESMF_FIELDSTATUS_COMPLETE, rc=status) @assert_that(status, is(0)) - call check('child_B', 'export', 'E_B1', ESMF_FIELDSTATUS_EMPTY, rc=status) + call check('child_B', 'export', 'E_B1', ESMF_FIELDSTATUS_GEOMSET, rc=status) @assert_that(status, is(0)) if(.false.) print*,shape(this) diff --git a/generic3g/tests/Test_Couplers.pf b/generic3g/tests/Test_Couplers.pf index 515ee989322..3affe61ec18 100644 --- a/generic3g/tests/Test_Couplers.pf +++ b/generic3g/tests/Test_Couplers.pf @@ -21,7 +21,7 @@ module Test_Couplers implicit none type(ESMF_Geom) :: geom - class(VerticalGrid), allocatable :: vertical_grid + class(VerticalGrid), pointer :: vertical_grid contains @@ -31,6 +31,7 @@ contains type(ESMF_HConfig) :: hconfig type(MaplGeom) :: mapl_geom type(GeomManager), pointer :: geom_mgr + type(VerticalGridManager), pointer :: vgrid_mgr type(BasicVerticalGridSpec) :: vspec type(BasicVerticalGridFactory) :: factory integer :: status @@ -40,9 +41,9 @@ contains mapl_geom = geom_mgr%get_mapl_geom(hconfig, _RC) geom = mapl_geom%get_geom() - if(allocated(vertical_grid)) deallocate(vertical_grid) vspec = BasicVerticalGridSpec(num_levels=5) - vertical_grid = factory%create_grid_from_spec(vspec, _RC) + vgrid_mgr => get_vertical_grid_manager() + vertical_grid => vgrid_mgr%create_grid(vspec, _RC) _UNUSED_DUMMY(this) end subroutine setUp @@ -76,8 +77,8 @@ contains character(len=:), allocatable :: units integer :: status - ! VerticalGrid should be allocated in @Before subroutine - @assertTrue(allocated(vertical_grid), 'The VerticalGrid has not been allocated.') + ! VerticalGrid should be associated in @Before subroutine + @assertTrue(associated(vertical_grid), 'The VerticalGrid has not been allocated.') registry = StateRegistry('StateRegistry') regptr => registry @@ -92,7 +93,7 @@ contains var_spec = make_VariableSpec(ESMF_STATEINTENT_IMPORT, IMPORT_NAME,& & typekind=TYPEKIND, itemtype=ITEMTYPE, units=IMPORT_UNITS, _RC) import_spec = var_spec%make_StateItemSpec(regptr, component_geom=geom,& - & vertical_grid=vertical_grid, _RC) + & vertical_grid=vertical_grid, _RC) call import_spec%create(_RC) virtual_pt = VirtualConnectionPt(state_intent='export', short_name=EXPORT_NAME) diff --git a/generic3g/tests/Test_ModelVerticalGrid.pf b/generic3g/tests/Test_ModelVerticalGrid.pf index 1f937799ebe..d61440bf8a2 100644 --- a/generic3g/tests/Test_ModelVerticalGrid.pf +++ b/generic3g/tests/Test_ModelVerticalGrid.pf @@ -10,6 +10,7 @@ module Test_ModelVerticalGrid use mapl_ErrorHandling use mapl3g_VerticalStaggerLoc + use mapl3g_VerticalGrid_API use mapl3g_ModelVerticalGrid use mapl3g_StateRegistry use mapl3g_VariableSpec @@ -24,6 +25,7 @@ module Test_ModelVerticalGrid use mapl3g_MultiState use mapl3g_Geom_API use mapl3g_CouplerPhases, only: GENERIC_COUPLER_UPDATE + use gFTL2_StringVector use esmf ! testing framework use ESMF_TestMethod_mod @@ -41,7 +43,7 @@ contains subroutine setup_(var_name, geom, vgrid, registry, rc) character(*), intent(in) :: var_name type(ESMF_Geom), intent(in) :: geom - type(ModelVerticalGrid), intent(in) :: vgrid + class(VerticalGrid), intent(in) :: vgrid type(StateRegistry), intent(inout) :: registry integer, optional, intent(out) :: rc @@ -65,7 +67,7 @@ contains var_spec = make_VariableSpec(& short_name=var_name, & state_intent=ESMF_STATEINTENT_EXPORT, & - standard_name="air_pressure", & + standard_name="air_pressure " // var_name, & units="hPa", & vertical_stagger=vertical_stagger, & default_value=3., _RC) @@ -84,17 +86,33 @@ contains subroutine setup(geom, vgrid, rc) type(ESMF_Geom), intent(out) :: geom - type(ModelVerticalGrid), intent(out) :: vgrid + class(VerticalGrid), allocatable, intent(out) :: vgrid integer, intent(out) :: rc integer :: status + type(VerticalGridManager), pointer :: vgrid_mgr + type(ModelVerticalGridSpec) :: vspec + type(StringVector) :: names, dims ! geom, registry etc. geom = make_geom(_RC) r = StateRegistry("dyn") - vgrid = ModelVerticalGrid(physical_dimension="pressure", short_name='PLE', num_levels=LM) - call vgrid%set_registry(r) ! MAPL_SetVerticalGrid(...) + vgrid_mgr => get_vertical_grid_manager() + names = StringVector() + call names%push_back("PLE") + call names%push_back("PL") + dims = StringVector() + call dims%push_back("pressure") + call dims%push_back("pressure") + vspec = ModelVerticalGridSpec(names, dims, num_levels=LM) + vgrid = vgrid_mgr%create_grid(vspec, _RC) + +!# vgrid = ModelVerticalGrid(physical_dimension="pressure", short_name='PLE', num_levels=LM) + select type (vgrid) + type is (ModelVerticalGrid) + call vgrid%set_registry(r) ! MAPL_SetVerticalGrid(...) + end select call setup_("PLE", geom, vgrid, r, _RC) call setup_("PL", geom, vgrid, r, _RC) @@ -130,7 +148,7 @@ contains @test(type=ESMF_TestMethod, npes=[1]) subroutine test_created_fields_have_num_levels(this) class(ESMF_TestMethod), intent(inout) :: this - type(ModelVerticalGrid) :: vgrid + class(VerticalGrid), allocatable :: vgrid integer :: rank integer, allocatable :: localElementCount(:) type(VirtualConnectionPt) :: ple_pt @@ -164,7 +182,7 @@ contains ! should force extensions. subroutine test_get_coordinate_field_simple(this) class(ESMF_TestMethod), intent(inout) :: this - type(ModelVerticalGrid) :: vgrid + class(VerticalGrid), allocatable :: vgrid class(ComponentDriver), pointer :: coupler type(ESMF_Field) :: vcoord type(ESMF_Geom) :: geom @@ -195,7 +213,7 @@ contains ! scaled by 100 (hPa = 100 Pa) subroutine test_get_coordinate_field_change_units_edge(this) class(ESMF_TestMethod), intent(inout) :: this - type(ModelVerticalGrid) :: vgrid + class(VerticalGrid), allocatable :: vgrid type(ESMF_Field) :: vcoord type(ESMF_Geom) :: geom integer :: status diff --git a/generic3g/tests/Test_Scenarios.pf b/generic3g/tests/Test_Scenarios.pf index 9b6f587aba5..1f53254a1b0 100644 --- a/generic3g/tests/Test_Scenarios.pf +++ b/generic3g/tests/Test_Scenarios.pf @@ -119,9 +119,6 @@ contains ScenarioDescription('scenario_1', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('scenario_2', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('scenario_reexport_twice', 'grandparent.yaml', check_name, check_stateitem), & - ScenarioDescription('history_1', 'cap.yaml', check_name, check_stateitem), & - ScenarioDescription('history_wildcard', 'cap.yaml', check_name, check_stateitem), & - ScenarioDescription('extdata_1', 'cap.yaml', check_name, check_stateitem), & ScenarioDescription('precision_extension', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('precision_extension_3d', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('3d_specs', 'parent.yaml', check_name, check_stateitem), & @@ -137,8 +134,11 @@ contains ScenarioDescription('expression', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('expression_defer_geom', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('invalidate', 'cap.yaml', check_name, check_stateitem), & -!# ScenarioDescription('statistics_real', 'cap.yaml', check_name, check_stateitem), & - ScenarioDescription('statistics', 'cap.yaml', check_name, check_stateitem) & + ScenarioDescription('statistics', 'cap.yaml', check_name, check_stateitem), & + ScenarioDescription('statistics_real', 'cap.yaml', check_name, check_stateitem), & + ScenarioDescription('history_1', 'cap.yaml', check_name, check_stateitem), & + ScenarioDescription('history_wildcard', 'cap.yaml', check_name, check_stateitem), & + ScenarioDescription('extdata_1', 'cap.yaml', check_name, check_stateitem) & ] end function add_params diff --git a/generic3g/tests/gridcomps/ProtoStatGridComp.F90 b/generic3g/tests/gridcomps/ProtoStatGridComp.F90 index 335ecf1e4ed..afae219ed57 100644 --- a/generic3g/tests/gridcomps/ProtoStatGridComp.F90 +++ b/generic3g/tests/gridcomps/ProtoStatGridComp.F90 @@ -3,6 +3,7 @@ module ProtoStatGridComp use mapl3g_State_API + use mapl3g_Field_API use mapl3g_Generic use mapl3g_esmf_subset use mapl3g_VerticalStaggerLoc @@ -62,7 +63,7 @@ subroutine init_modify_advertised(gc, importState, exportState, clock, rc) _RETURN_IF(exports_ready) call esmf_StateGet(exportState, itemName='avg_T', field=field, _RC) - call mapl_FieldModify(field, has_deferred_aspects=.false., _RC) + call mapl_FieldSet(field, has_deferred_aspects = .false., _RC) exports_ready = .true. diff --git a/generic3g/tests/scenarios/expression/A.yaml b/generic3g/tests/scenarios/expression/A.yaml index b8d49d1f410..229efd1bd7d 100644 --- a/generic3g/tests/scenarios/expression/A.yaml +++ b/generic3g/tests/scenarios/expression/A.yaml @@ -2,10 +2,6 @@ mapl: states: import: {} export: - expr: - expression: (A + B)/C - units: m - vertical_dim_spec: NONE A: standard_name: A units: 'm' @@ -17,11 +13,14 @@ mapl: default_value: 2 vertical_dim_spec: NONE C: - standard_name: B + standard_name: C units: 'm' default_value: 3 vertical_dim_spec: NONE + expr: + expression: (A + B)/C + units: m + vertical_dim_spec: NONE internal: {} - diff --git a/generic3g/tests/scenarios/expression_defer_geom/expectations.yaml b/generic3g/tests/scenarios/expression_defer_geom/expectations.yaml index 60db386958d..280a3695acc 100644 --- a/generic3g/tests/scenarios/expression_defer_geom/expectations.yaml +++ b/generic3g/tests/scenarios/expression_defer_geom/expectations.yaml @@ -8,8 +8,8 @@ B: {status: complete} A(1): {status: complete, value: 1., tolerance: 1.e-6} B(1): {status: complete, value: 2., tolerance: 1.e-6} - expr(3): {status: complete, value: 3., tolerance: 1.e-6} - expr(6): {status: complete, value: 3., tolerance: 1.e-6} + expr(2): {status: complete, value: 3., tolerance: 1.e-6} + expr(4): {status: complete, value: 3., tolerance: 1.e-6} - component: B/ import: @@ -29,6 +29,6 @@ internal: {} - component: export: - A/expr(3): {status: complete} + A/expr(2): {status: complete} A/A: {status: complete} A/B: {status: complete} diff --git a/generic3g/tests/scenarios/history_1/expectations.yaml b/generic3g/tests/scenarios/history_1/expectations.yaml index a1625e49a86..52cba41a449 100644 --- a/generic3g/tests/scenarios/history_1/expectations.yaml +++ b/generic3g/tests/scenarios/history_1/expectations.yaml @@ -6,22 +6,22 @@ - component: root/A/ export: E_A1: {status: complete} - E_A2: {status: empty} + E_A2: {status: gridset} - component: root/A export: E_A1: {status: complete} - E_A2: {status: empty} + E_A2: {status: gridset} - component: root/B/ export: - E_B1: {status: empty} + E_B1: {status: gridset} E_B2: {status: complete} E_B3: {status: complete, value: 17.} - component: root/B export: - E_B1: {status: empty} + E_B1: {status: gridset} E_B2: {status: complete} E_B3: {status: complete, value: 17.} @@ -31,8 +31,8 @@ - component: root export: A/E_A1: {status: complete, value: 1.} - A/E_A2: {status: empty} - B/E_B1: {status: empty} + A/E_A2: {status: gridset} + B/E_B1: {status: gridset} B/E_B2: {status: complete, value: 1.} B/E_B3: {status: complete, value: 17.} @@ -81,6 +81,6 @@ import: {} export: A/E_A1: {status: complete} - A/E_A2: {status: empty} - B/E_B1: {status: empty} + A/E_A2: {status: gridset} + B/E_B1: {status: gridset} B/E_B2: {status: complete} diff --git a/generic3g/tests/scenarios/history_wildcard/expectations.yaml b/generic3g/tests/scenarios/history_wildcard/expectations.yaml index 84c8794f9c3..76315d60643 100644 --- a/generic3g/tests/scenarios/history_wildcard/expectations.yaml +++ b/generic3g/tests/scenarios/history_wildcard/expectations.yaml @@ -7,7 +7,7 @@ export: E_A1: {status: complete} E_A2: {status: complete} - E1_A0: {status: empty} + E1_A0: {status: gridset} - component: root/A export: @@ -16,12 +16,12 @@ - component: root/B/ export: - E_B1: {status: empty} + E_B1: {status: gridset} E_B2: {status: complete} - component: root/B export: - E_B1: {status: empty} + E_B1: {status: gridset} E_B2: {status: complete} - component: root/ @@ -31,7 +31,7 @@ export: A/E_A1: {status: complete} A/E_A2: {status: complete} - B/E_B1: {status: empty} + B/E_B1: {status: gridset} B/E_B2: {status: complete} - component: history/collection_1/ @@ -65,5 +65,5 @@ export: A/E_A1: {status: complete} A/E_A2: {status: complete} - B/E_B1: {status: empty} + B/E_B1: {status: gridset} B/E_B2: {status: complete} diff --git a/generic3g/tests/scenarios/propagate_geom/expectations.yaml b/generic3g/tests/scenarios/propagate_geom/expectations.yaml index 48195912ef1..90e4b95c487 100644 --- a/generic3g/tests/scenarios/propagate_geom/expectations.yaml +++ b/generic3g/tests/scenarios/propagate_geom/expectations.yaml @@ -5,7 +5,7 @@ - component: child_A/ import: - I_A1: {status: empty} + I_A1: {status: gridset} export: E_A1: {status: complete} Z_A1: {status: complete} @@ -13,7 +13,7 @@ Z_A1: {status: complete} - component: child_A import: - I_A1: {status: empty} + I_A1: {status: gridset} export: E_A1: {status: complete} Z_A1: {status: complete} @@ -22,22 +22,22 @@ import: I_B1: {status: complete} export: - E_B1: {status: empty} + E_B1: {status: gridset} internal: Z_B1: {status: complete} - component: child_B import: I_B1: {status: complete} export: - E_B1: {status: empty} + E_B1: {status: gridset} - component: import: {} export: {} internal: {} - component: import: - I_A1(1): {status: empty} # unsatisfied + I_A1(1): {status: gridset} # unsatisfied export: child_A/E_A1: {status: complete} child_A/Z_A1: {status: complete} # re-export - child_B/E_B1: {status: empty} # re-export + child_B/E_B1: {status: gridset} # re-export diff --git a/generic3g/tests/scenarios/scenario_1/expectations.yaml b/generic3g/tests/scenarios/scenario_1/expectations.yaml index dce2eb45131..a2dc6e31391 100644 --- a/generic3g/tests/scenarios/scenario_1/expectations.yaml +++ b/generic3g/tests/scenarios/scenario_1/expectations.yaml @@ -5,7 +5,7 @@ - component: child_A/ import: - I_A1: {status: empty} + I_A1: {status: gridset} export: E_A1: {status: complete} Z_A1: {status: complete} @@ -13,7 +13,7 @@ Z_A1: {status: complete} - component: child_A import: - I_A1: {status: empty} + I_A1: {status: gridset} export: E_A1: {status: complete} Z_A1: {status: complete} @@ -22,22 +22,22 @@ import: I_B1: {status: complete} export: - E_B1: {status: empty} + E_B1: {status: gridset} internal: Z_B1: {status: complete} - component: child_B import: I_B1: {status: complete} export: - E_B1: {status: empty} + E_B1: {status: gridset} - component: import: {} export: {} internal: {} - component: import: - I_A1(1): {status: empty} # unsatisfied + I_A1(1): {status: gridset} # unsatisfied export: child_A/E_A1: {status: complete} child_A/Z_A1: {status: complete} # re-export - child_B/E_B1: {status: empty} # re-export + child_B/E_B1: {status: gridset} # re-export diff --git a/generic3g/tests/scenarios/scenario_2/expectations.yaml b/generic3g/tests/scenarios/scenario_2/expectations.yaml index 53f5d766807..c2d028b1e69 100644 --- a/generic3g/tests/scenarios/scenario_2/expectations.yaml +++ b/generic3g/tests/scenarios/scenario_2/expectations.yaml @@ -5,7 +5,7 @@ - component: child_A/ import: - I_A1: {status: empty} + I_A1: {status: gridset} export: E_A1: {status: complete} ZZ_A1: {status: complete} @@ -13,7 +13,7 @@ Z_A1: {status: complete} - component: child_A import: - I_A1: {status: empty} + I_A1: {status: gridset} export: E_A1: {status: complete} ZZ_A1: {status: complete} @@ -22,24 +22,24 @@ import: I_B1: {status: complete} export: - E_B1: {status: empty} + E_B1: {status: gridset} internal: Z_B1: {status: complete} - component: child_B import: I_B1: {status: complete} export: - E_B1: {status: empty} + E_B1: {status: gridset} - component: import: {} export: - EE_B1: {status: empty} # re-export + EE_B1: {status: gridset} # re-export internal: {} - component: import: - I_A1(1): {status: empty} # unsatisfied + I_A1(1): {status: gridset} # unsatisfied export: child_A/E_A1: {status: complete} child_A/ZZ_A1: {status: complete} # re-export - child_B/E_B1: {status: empty} # re-export - EE_B1: {status: empty} # re-export + child_B/E_B1: {status: gridset} # re-export + EE_B1: {status: gridset} # re-export diff --git a/generic3g/tests/scenarios/scenario_reexport_twice/expectations.yaml b/generic3g/tests/scenarios/scenario_reexport_twice/expectations.yaml index 013eb80639d..ec2216d0193 100644 --- a/generic3g/tests/scenarios/scenario_reexport_twice/expectations.yaml +++ b/generic3g/tests/scenarios/scenario_reexport_twice/expectations.yaml @@ -5,57 +5,57 @@ - component: parent/child_A/ import: - I_A1: {status: empty} + I_A1: {status: gridset} export: - E_A1: {status: empty} + E_A1: {status: gridset} internal: Z_A1: {status: complete} - component: parent/child_A import: - I_A1: {status: empty} + I_A1: {status: gridset} export: - E_A1: {status: empty} + E_A1: {status: gridset} - component: parent/child_B/ import: - I_B1: {status: empty} + I_B1: {status: gridset} export: - E_B1: {status: empty} + E_B1: {status: gridset} internal: Z_B1: {status: complete} - component: parent/child_B import: - I_B1: {status: empty} + I_B1: {status: gridset} export: - E_B1: {status: empty} + E_B1: {status: gridset} - component: parent/ import: {} export: - Eparent_B1: {status: empty} # re-export + Eparent_B1: {status: gridset} # re-export internal: {} - component: parent import: - "I_A1(1)": {status: empty} # unsatisfied - "I_B1(1)": {status: empty} # unsatisfied + "I_A1(1)": {status: gridset} # unsatisfied + "I_B1(1)": {status: gridset} # unsatisfied export: - "child_A/E_A1": {status: empty} - "child_B/E_B1": {status: empty} # re-export - Eparent_B1: {status: empty} # re-export + "child_A/E_A1": {status: gridset} + "child_B/E_B1": {status: gridset} # re-export + Eparent_B1: {status: gridset} # re-export - component: import: {} export: - Egrandparent_B1: {status: empty} # re-export + Egrandparent_B1: {status: gridset} # re-export internal: {} - component: import: - "I_A1(1)": {status: empty} # unsatisfied - "I_B1(1)": {status: empty} # unsatisfied + "I_A1(1)": {status: gridset} # unsatisfied + "I_B1(1)": {status: gridset} # unsatisfied export: - "child_A/E_A1": {status: empty} - "child_B/E_B1": {status: empty} # re-export - Egrandparent_B1: {status: empty} # re-export + "child_A/E_A1": {status: gridset} + "child_B/E_B1": {status: gridset} # re-export + Egrandparent_B1: {status: gridset} # re-export diff --git a/generic3g/tests/scenarios/statistics_real/A.yaml b/generic3g/tests/scenarios/statistics_real/A.yaml index ce8d3412b1b..e0c12fd9dd0 100644 --- a/generic3g/tests/scenarios/statistics_real/A.yaml +++ b/generic3g/tests/scenarios/statistics_real/A.yaml @@ -1,5 +1,5 @@ run: - TS: [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 24] + TS: [0, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] mapl: states: diff --git a/generic3g/tests/scenarios/statistics_real/expectations.yaml b/generic3g/tests/scenarios/statistics_real/expectations.yaml index 13de616807d..e813f49144d 100644 --- a/generic3g/tests/scenarios/statistics_real/expectations.yaml +++ b/generic3g/tests/scenarios/statistics_real/expectations.yaml @@ -20,30 +20,30 @@ - component: history/collection_1/ import: - TS: {status: complete, value: 1.} + TS_avg: {status: complete, value: 1.} - component: history/collection_1 import: - TS: {status: complete} + TS_avg: {status: complete} -- component: history/STAT/ +- component: history/stat/ import: A/TS: {status: complete} export: - TS: {status: complete} + A/TS: {status: complete} -- component: history/STAT +- component: history/stat import: A/TS: {status: complete} export: - TS: {status: complete} + A/TS: {status: complete} - component: history/ import: {} - component: history export: - stat/TS: {status: complete} + stat/A/TS: {status: complete} - component: import: {} @@ -54,4 +54,4 @@ import: {} export: A/TS: {status: complete} - stat/TS: {status: complete} + stat/A/TS: {status: complete} diff --git a/generic3g/tests/scenarios/statistics_real/history.yaml b/generic3g/tests/scenarios/statistics_real/history.yaml index c0781d843d6..3a2456dc812 100644 --- a/generic3g/tests/scenarios/statistics_real/history.yaml +++ b/generic3g/tests/scenarios/statistics_real/history.yaml @@ -5,7 +5,7 @@ mapl: dso: libconfigurable_gridcomp config_file: scenarios/statistics_real/collection_1.yaml stat: - dso: libmapl_statisticsgridcomp + dso: libMAPL_StatisticsGridComp config_file: scenarios/statistics_real/stat.yaml states: {} diff --git a/generic3g/tests/scenarios/statistics_real/stat.yaml b/generic3g/tests/scenarios/statistics_real/stat.yaml index 30512e00de0..f86e7a93e8d 100644 --- a/generic3g/tests/scenarios/statistics_real/stat.yaml +++ b/generic3g/tests/scenarios/statistics_real/stat.yaml @@ -13,15 +13,15 @@ hourly: &hourly monthly_average: &monthly_average action: average - <<: monthly + <<: *monthly monthly_variance: &monthly_variance action: variance - <<: monthly + <<: *monthly monthly_covariance: &monthly_covariance action: variance - <<: monthly + <<: *monthly stats: - name: A/TS diff --git a/generic3g/tests/scenarios/vertical_regridding_2/expectations.yaml b/generic3g/tests/scenarios/vertical_regridding_2/expectations.yaml index cbb1405f70c..f3b8a563f7a 100644 --- a/generic3g/tests/scenarios/vertical_regridding_2/expectations.yaml +++ b/generic3g/tests/scenarios/vertical_regridding_2/expectations.yaml @@ -5,7 +5,7 @@ - component: A export: - PL: {status: empty} + PL: {status: gridset} PLE: {status: complete, typekind: R4, rank: 3, value: 13.} - component: B diff --git a/generic3g/vertical/ModelVerticalGrid.F90 b/generic3g/vertical/ModelVerticalGrid.F90 index 93366069e75..c80e698c44c 100644 --- a/generic3g/vertical/ModelVerticalGrid.F90 +++ b/generic3g/vertical/ModelVerticalGrid.F90 @@ -74,8 +74,11 @@ module mapl3g_ModelVerticalGrid procedure :: create_grid_from_spec end type ModelVerticalGridFactory + interface ModelVerticalGridSpec + procedure new_ModelVerticalGridSpec + end interface ModelVerticalGridSpec - interface ModelVerticalGrid + interface ModelVerticalGrid procedure new_ModelVerticalGrid_basic end interface ModelVerticalGrid @@ -92,6 +95,18 @@ module mapl3g_ModelVerticalGrid contains + function new_ModelVerticalGridSpec(names, physical_dimensions, num_levels) result(spec) + type(ModelVerticalGridSpec) :: spec + type(StringVector), intent(in) :: names + type(StringVector), intent(in) :: physical_dimensions + integer, intent(in) :: num_levels + + spec%names = names + spec%physical_dimensions = physical_dimensions + spec%num_levels = num_levels + + end function new_ModelVerticalGridSpec + function new_ModelVerticalGrid_basic(physical_dimension, short_name, num_levels) result(vgrid) type(ModelVerticalGrid) :: vgrid character(*), intent(in) :: physical_dimension @@ -103,6 +118,7 @@ function new_ModelVerticalGrid_basic(physical_dimension, short_name, num_levels) call vgrid%spec%physical_dimensions%push_back(physical_dimension) end function new_ModelVerticalGrid_basic + integer function get_num_levels(this) result(num_levels) class(ModelVerticalGrid), intent(in) :: this num_levels = this%spec%num_levels @@ -215,6 +231,7 @@ function get_coordinate_field(this, geom, physical_dimension, units, typekind, c call aspects%insert(UNITS_ASPECT_ID, UnitsAspect(units)) call aspects%insert(UNGRIDDED_DIMS_ASPECT_ID, UngriddedDimsAspect(UngriddedDimS())) call aspects%insert(ATTRIBUTES_ASPECT_ID, AttributesAspect()) + call goal_spec%create(_RC) new_extension => this%registry%extend(v_pt, goal_spec, _RC) coupler => new_extension%get_producer() diff --git a/geom/MaplGeom/get_geom.F90 b/geom/MaplGeom/get_geom.F90 index 7a5646372dc..2e9e38b0e44 100644 --- a/geom/MaplGeom/get_geom.F90 +++ b/geom/MaplGeom/get_geom.F90 @@ -2,7 +2,6 @@ submodule (mapl3g_MaplGeom) get_geom_smod use mapl3g_GeomSpec - use mapl3g_VectorBasis use mapl3g_GeomUtilities use mapl_ErrorHandlingMod use pfio_FileMetadataMod, only: FileMetadata diff --git a/geom/VectorBasis.F90 b/geom/VectorBasis.F90 index b0c3335ba27..aae90d7eb51 100644 --- a/geom/VectorBasis.F90 +++ b/geom/VectorBasis.F90 @@ -6,7 +6,7 @@ module mapl3g_VectorBasis use mapl_FieldPointerUtilities use mapl_ErrorHandlingMod - implicit none + implicit none(type,external) private public :: VectorBasis diff --git a/geom/VectorBasis/new_GridVectorBasis.F90 b/geom/VectorBasis/new_GridVectorBasis.F90 index cfae1cfff6f..3dc2ece9369 100644 --- a/geom/VectorBasis/new_GridVectorBasis.F90 +++ b/geom/VectorBasis/new_GridVectorBasis.F90 @@ -1,6 +1,7 @@ #include "MAPL_ErrLog.h" submodule (mapl3g_VectorBasis) new_GridVectorBasis_smod + implicit none(type,external) contains ! Valid only for grids. diff --git a/gridcomps/ExtData3G/PrimaryExport.F90 b/gridcomps/ExtData3G/PrimaryExport.F90 index 31cb17633d9..8e91760a3af 100644 --- a/gridcomps/ExtData3G/PrimaryExport.F90 +++ b/gridcomps/ExtData3G/PrimaryExport.F90 @@ -141,6 +141,7 @@ subroutine complete_export_spec(this, item_name, exportState, rc) type(ESMF_FieldBundle) :: bundle type(GeomManager), pointer :: geom_mgr type(EsmfRegridderParam) :: regridder_param + type(esmf_Info) :: regridder_param_info class(VerticalGrid), pointer :: vertical_grid type(VerticalGridManager), pointer :: vgrid_manager character(len=:), pointer :: variable_name @@ -160,18 +161,17 @@ subroutine complete_export_spec(this, item_name, exportState, rc) this%vcoord = verticalCoordinate(metadata, variable_name, _RC) regridder_param = generate_esmf_regrid_param(regrid_method_string_to_int(this%regridding_method), & ESMF_TYPEKIND_R4, _RC) + regridder_param_info = regridder_param%make_info(_RC) call ESMF_StateGet(exportState, item_name, bundle, _RC) if (this%vcoord%vertical_type == NO_COORD) then - call MAPL_FieldBundleModify(bundle, geom=esmfgeom, units='', typekind=ESMF_TYPEKIND_R4, & - vertical_stagger=VERTICAL_STAGGER_NONE, regridder_param=regridder_param, _RC) - call MAPL_FieldBundleSet(bundle, geom=esmfgeom, _RC) + call mapl_FieldBundleSet(bundle, geom=esmfgeom, units='', typekind=ESMF_TYPEKIND_R4, & + vert_staggerloc=VERTICAL_STAGGER_NONE, regridder_param_info=regridder_param_info, _RC) else if (this%vcoord%vertical_type == SIMPLE_COORD) then vertical_grid => vgrid_manager%create_grid(BasicVerticalGridSpec(num_levels=this%vcoord%num_levels), _RC) - call MAPL_FieldBundleModify(bundle, geom=esmfgeom, units='', & - typekind=ESMF_TYPEKIND_R4, vertical_grid=vertical_grid, & - vertical_stagger=VERTICAL_STAGGER_CENTER, regridder_param=regridder_param, _RC) - call MAPL_FieldBundleSet(bundle, geom=esmfgeom, _RC) + call MAPL_FieldBundleSet(bundle, geom=esmfgeom, units='', & + typekind=ESMF_TYPEKIND_R4, vgrid=vertical_grid, & + vert_staggerloc=VERTICAL_STAGGER_CENTER, regridder_param_info=regridder_param_info, _RC) else _FAIL("unsupported vertical coordinate for item "//trim(this%export_var)) end if diff --git a/gridcomps/StatisticsGridComp/StatisticsGridComp.F90 b/gridcomps/StatisticsGridComp/StatisticsGridComp.F90 index adaf7660597..062bec6bdf9 100644 --- a/gridcomps/StatisticsGridComp/StatisticsGridComp.F90 +++ b/gridcomps/StatisticsGridComp/StatisticsGridComp.F90 @@ -7,7 +7,7 @@ module mapl3g_StatisticsGridComp use mapl3g_StatisticsVector use mapl3g_NullStatistic use mapl3g_TimeAverage - use pflogger + use pflogger, only: Logger implicit none(type,external) private public :: setServices @@ -31,6 +31,7 @@ subroutine setServices(gridComp, rc) type(esmf_HConfigIter) :: iter, b, e call mapl_GridCompSetEntryPoint(gridComp, ESMF_METHOD_INITIALIZE, modify_advertise, phase_name='GENERIC::INIT_MODIFY_ADVERTISED', _RC) + call mapl_GridCompSetEntryPoint(gridComp, ESMF_METHOD_INITIALIZE, initialize, _RC) call mapl_GridCompSetEntryPoint(gridComp, ESMF_METHOD_RUN, run, phase_name='run', _RC) call mapl_GridCompSetEntryPoint(gridComp, ESMF_METHOD_READRESTART, custom_read_restart, phase_name='GENERIC:READ_RESTART', _RC) call mapl_GridCompSetEntryPoint(gridComp, ESMF_METHOD_WRITERESTART, custom_write_restart, phase_name='GENERIC::WRITE_RESTART', _RC) @@ -71,6 +72,7 @@ subroutine advertise_item(gridcomp, iter, rc) hconfig = esmf_HConfigCreateAt(iter, _RC) action = esmf_HConfigAsString(hconfig, keystring='action', _RC) name = esmf_HConfigAsString(hconfig, keystring='name', _RC) + itemtype = mapl_HConfigAsItemType(hconfig, keystring='itemtype', _RC) varspec = make_VariableSpec(ESMF_STATEINTENT_IMPORT, name, _RC) @@ -115,7 +117,6 @@ subroutine modify_advertise(gridcomp, importState, exportState, clock, rc) type(esmf_HConfig) :: hconfig, items_hconfig class(AbstractTimeStatistic), allocatable :: item - _HERE _GET_NAMED_PRIVATE_STATE(gridcomp, Statistics, PRIVATE_STATE, stats) call mapl_GridCompGet(gridcomp, hconfig=hconfig, _RC) items_hconfig = esmf_HConfigCreateAt(hconfig, keystring='stats', _RC) @@ -148,44 +149,41 @@ subroutine modify_advertise_item(iter, rc) character(:), allocatable :: units character(:), allocatable :: standard_name, long_name type(esmf_TypeKind_Flag) :: typekind - class(VerticalGrid), allocatable :: vertical_grid + class(VerticalGrid), pointer :: vertical_grid + type(VerticalStaggerLoc) :: vstagger type(UngriddedDims) :: ungridded_dims type(esmf_StateItem_Flag) :: itemtype - _HERE - _HERE, importState action = esmf_HConfigAsString(iter, keystring='action', _RC) name = esmf_HConfigAsString(iter, keystring='name', _RC) call mapl_StateGet(importState, itemName=name, itemtype=itemtype, _RC) _RETURN_IF(itemtype == ESMF_STATEITEM_NOTFOUND) - _HERE call mapl_StateGet(importState, itemName=name, field=f_in, _RC) - _HERE call mapl_FieldGet(f_in, allocation_status=allocation_status, _RC) - _HERE, allocation_status%to_string() _RETURN_UNLESS(allocation_status == STATEITEM_ALLOCATION_CONNECTED) - _HERE,' woo hoo - connected now !!!' - call mapl_FieldGet(f_in, & geom=geom, & ungridded_dims=ungridded_dims, & units=units, & typekind=typekind, & + vgrid=vertical_grid, & + vert_staggerloc=vstagger, & _RC) - call mapl_FieldGetVerticalGrid(f_in, vertical_grid=vertical_grid, _RC) - _HERE call mapl_StateGet(exportState, itemName=name, field=f_out, _RC) - call mapl_FieldModify(f_out, & - has_deferred_aspects=.false., & + + call mapl_FieldSet(f_out, & geom=geom, & ungridded_dims=ungridded_dims, & units=units, & typekind=typekind, & - vertical_grid=vertical_grid, & + vgrid=vertical_grid, & + vert_staggerloc=vstagger, & + standard_name='foo', & + has_deferred_aspects=.false., & _RC) item = make_item(name, iter, clock, _RC) @@ -245,13 +243,13 @@ function make_alarm(clock, iter, rc) result(alarm) integer, optional, intent(out) :: rc integer :: status - type(esmf_TimeInterval) :: period, offset + type(esmf_TimeInterval) :: period, offset, timeStep type(esmf_Time) :: ringTime, refTime character(:), allocatable :: iso_timeinterval period = mapl_HConfigAsTimeInterval(iter, keystring='period', _RC) offset = mapl_HConfigAsTimeInterval(iter, keystring='offset', _RC) -!# refTime= + call esmf_ClockGet(clock, refTime=refTime, timeStep=timeStep, _RC) ringTime = refTime + offset alarm = esmf_AlarmCreate(clock, ringTime=ringTime, ringInterval=period, _RC) @@ -260,6 +258,32 @@ end function make_alarm end subroutine modify_advertise + subroutine initialize(gridcomp, importState, exportState, clock, rc) + type(esmf_GridComp) :: gridcomp + type(esmf_State) :: importState + type(esmf_State) :: exportState + type(esmf_Clock) :: clock + integer, intent(out) :: rc + + type(Statistics), pointer :: stats + class(AbstractTimeStatistic), pointer :: stat + integer :: status + + type(StatisticsVectorIterator) :: iter + + _GET_NAMED_PRIVATE_STATE(gridcomp, Statistics, PRIVATE_STATE, stats) + + iter = stats%items%ftn_begin() + associate (e => stats%items%ftn_end()) + do while (iter /= e) + call iter%next() + stat => iter%of() + call stat%initialize(_RC) + end do + end associate + + _RETURN(_SUCCESS) + end subroutine initialize subroutine run(gridcomp, importState, exportState, clock, rc) type(esmf_GridComp) :: gridcomp @@ -274,6 +298,8 @@ subroutine run(gridcomp, importState, exportState, clock, rc) type(StatisticsVectorIterator) :: iter + _GET_NAMED_PRIVATE_STATE(gridcomp, Statistics, PRIVATE_STATE, stats) + iter = stats%items%ftn_begin() associate (e => stats%items%ftn_end()) do while (iter /= e) diff --git a/gridcomps/StatisticsGridComp/TimeAverage.F90 b/gridcomps/StatisticsGridComp/TimeAverage.F90 index a88a8621bad..5623b363ac1 100644 --- a/gridcomps/StatisticsGridComp/TimeAverage.F90 +++ b/gridcomps/StatisticsGridComp/TimeAverage.F90 @@ -58,6 +58,7 @@ subroutine initialize(this, rc) call mapl_FieldGet(this%f, short_name=name, _RC) call mapl_FieldClone(this%f, this%sum_f, _RC) + call esmf_FieldSet(this%sum_f, name='sum_'//name, _RC) call esmf_FieldGet(this%f, rank=rank, _RC) @@ -112,7 +113,7 @@ subroutine update(this, rc) call update_r8(this, _RC) end if - is_ringing = esmf_AlarmIsRinging(this%alarm, _RC) + is_ringing = esmf_AlarmWillRingNext(this%alarm, _RC) _RETURN_UNLESS(is_ringing) call this%compute_result(_RC) @@ -184,6 +185,7 @@ subroutine compute_result_r4(this, rc) call MAPL_AssignFptr(this%f, f, _RC) call MAPL_AssignFptr(this%sum_f, sum_f, _RC) + call MAPL_AssignFptr(this%avg_f, avg_f, _RC) where (this%counts > 0) avg_f = sum_f / this%counts diff --git a/gridcomps/StatisticsGridComp/statistics.yaml b/gridcomps/StatisticsGridComp/statistics.yaml index a18c6074b71..1353d1e62be 100644 --- a/gridcomps/StatisticsGridComp/statistics.yaml +++ b/gridcomps/StatisticsGridComp/statistics.yaml @@ -14,15 +14,15 @@ hourly: &hourly monthly_average: &monthly_average action: average - <<: monthly + <<: *monthly monthly_variance: &monthly_variance action: variance - <<: monthly + <<: *monthly monthly_covariance: &monthly_covariance action: variance - <<: monthly + <<: *monthly stats: - name: T diff --git a/regridder_mgr/EsmfRegridder.F90 b/regridder_mgr/EsmfRegridder.F90 index 568fc31cb1a..233e1284021 100644 --- a/regridder_mgr/EsmfRegridder.F90 +++ b/regridder_mgr/EsmfRegridder.F90 @@ -15,6 +15,7 @@ module mapl3g_EsmfRegridder public :: EsmfRegridder public :: EsmfRegridderParam + public :: make_EsmfRegridderParam type, extends(RegridderParam) :: EsmfRegridderParam private @@ -26,6 +27,7 @@ module mapl3g_EsmfRegridder contains procedure :: equal_to procedure :: get_routehandle_param + procedure :: make_info end type EsmfRegridderParam type, extends(Regridder) :: EsmfRegridder @@ -45,6 +47,12 @@ module mapl3g_EsmfRegridder interface EsmfRegridder procedure :: new_EsmfRegridder end interface EsmfRegridder + + interface make_EsmfRegridderParam + procedure make_regridder_param_from_info + end interface make_EsmfRegridderParam + + character(*), parameter :: KEY_ROUTEHANDLE = 'EsmfRouteHandle' contains @@ -255,4 +263,40 @@ function get_routehandle_param(this) result(routehandle_param) routehandle_param = this%routehandle_param end function get_routehandle_param + function make_info(this, rc) result(info) + type(esmf_Info) :: info + class(EsmfRegridderParam), intent(in) :: this + integer, optional, intent(out) :: rc + + integer :: status + type(esmf_Info) :: rh_info + + info = esmf_InfoCreate(_RC) + rh_info = this%routehandle_param%make_info(_RC) + call esmf_InfoSet(info, key=KEY_ROUTEHANDLE, value=rh_info, _RC) + call esmf_InfoDestroy(rh_info, _RC) + + call esmf_InfoPrint(info, _RC) + + _RETURN(_SUCCESS) + end function make_info + + function make_regridder_param_from_info(info, rc) result(regridder_param) + type(EsmfRegridderParam) :: regridder_param + type(esmf_Info), intent(in) :: info + integer, optional, intent(out) :: rc + + integer :: status + type(esmf_Info) :: rh_info + type(RouteHandleParam) :: rh_param + + rh_info = esmf_InfoCreate(info, key=KEY_ROUTEHANDLE, _RC) + rh_param = make_RouteHandleParam(rh_info, _RC) + regridder_param = EsmfRegridderParam(rh_param) + + call esmf_InfoDestroy(rh_info, _RC) + + _RETURN(_SUCCESS) + end function make_regridder_param_from_info + end module mapl3g_EsmfRegridder diff --git a/regridder_mgr/RoutehandleParam.F90 b/regridder_mgr/RoutehandleParam.F90 index edb8b4e0b4c..652b0c3fc3e 100644 --- a/regridder_mgr/RoutehandleParam.F90 +++ b/regridder_mgr/RoutehandleParam.F90 @@ -8,7 +8,8 @@ module mapl3g_RoutehandleParam private public :: RoutehandleParam - public :: make_routehandle + public :: make_RouteHandle + public :: make_RouteHandleParam public :: operator(==) ! If an argument to FieldRegridStore is optional _and_ has no default @@ -21,7 +22,7 @@ module mapl3g_RoutehandleParam ! optional argument in new_ESMF_Routehandle integer(kind=ESMF_KIND_I4), allocatable :: srcMaskValues(:) integer(kind=ESMF_KIND_I4), allocatable :: dstMaskValues(:) - type(ESMF_RegridMethod_Flag) :: regridmethod + type(ESMF_RegridMethod_Flag) :: regridMethod type(ESMF_PoleMethod_Flag) :: polemethod integer, allocatable :: regridPoleNPnts type(ESMF_LineType_Flag) :: linetype @@ -33,12 +34,17 @@ module mapl3g_RoutehandleParam type(ESMF_UnmappedAction_Flag) :: unmappedaction logical :: ignoreDegenerate !# integer :: srcTermProcessing + contains + procedure :: make_info end type RoutehandleParam + interface make_RouteHandleParam + procedure :: make_rh_param_from_info + end interface make_RouteHandleParam - interface make_routehandle + interface make_RouteHandle procedure :: make_routehandle_from_param - end interface make_routehandle + end interface make_RouteHandle interface operator(==) procedure :: equal_to @@ -53,6 +59,11 @@ module mapl3g_RoutehandleParam procedure :: new_RoutehandleParam end interface RouteHandleParam + character(*), parameter :: BILINEAR = 'bilinear' + character(*), parameter :: CONSERVE = 'conserve' + character(*), parameter :: KEY_REGRID_METHOD = 'regrid_method' + + contains function new_RoutehandleParam( & @@ -265,5 +276,56 @@ end function same_scalar_int end function equal_to + function make_rh_param_from_info(info, rc) result(rh_param) + type(RouteHandleParam) :: rh_param + type(esmf_Info), intent(in) :: info + integer, optional, intent(out) :: rc + + integer :: status + character(:), allocatable :: regrid_method_str + type(esmf_RegridMethod_Flag), allocatable :: regrid_method + logical :: is_present + + is_present = esmf_InfoIsPresent(info, key=KEY_REGRID_METHOD, _RC) + if (is_present) then + call esmf_InfoGetCharAlloc(info, key=KEY_REGRID_METHOD, value=regrid_method_str, _RC) + select case(regrid_method_str) + case(BILINEAR) + regrid_method = ESMF_REGRIDMETHOD_BILINEAR + case (CONSERVE) + regrid_method = ESMF_REGRIDMETHOD_CONSERVE + case default + _FAIL('unsupported regrid method:: ' // regrid_method_str) + end select + end if + + rh_param = RouteHandleParam(regridMethod=regrid_method) + + _RETURN(_SUCCESS) + end function make_rh_param_from_info + + function make_info(this, rc) result(info) + type(esmf_Info) :: info + class(RouteHandleParam), intent(in) :: this + integer, optional, intent(out) :: rc + + integer :: status + character(:), allocatable :: regrid_method_str + type(esmf_RegridMethod_Flag), allocatable :: regrid_method + logical :: is_present + + if (this%regridMethod == ESMF_REGRIDMETHOD_BILINEAR) then + regrid_method_str = BILINEAR + else if (this%regridMethod == ESMF_REGRIDMETHOD_CONSERVE) then + regrid_method_str = CONSERVE + else + _FAIL('unsupported esmf regrid method') + end if + + info = esmf_InfoCreate(_RC) + call esmf_InfoSet(info, key=KEY_REGRID_METHOD, value=regrid_method_str, _RC) + + _RETURN(_SUCCESS) + end function make_info end module mapl3g_RoutehandleParam diff --git a/vertical_grid/API.F90 b/vertical_grid/API.F90 index 7f146e70a78..23e5e068530 100644 --- a/vertical_grid/API.F90 +++ b/vertical_grid/API.F90 @@ -1,5 +1,6 @@ module mapl3g_VerticalGrid_API use mapl3g_VerticalGrid, only: VerticalGrid + use mapl3g_VerticalGrid, only: VERTICAL_GRID_NOT_FOUND use mapl3g_VerticalGridSpec, only: VerticalGridSpec use mapl3g_VerticalGridFactory, only: VerticalGridFactory use mapl3g_VerticalGridManager, only: VerticalGridManager @@ -16,7 +17,7 @@ module mapl3g_VerticalGrid_API public :: VerticalGrid public :: VerticalGridSpec public :: VerticalGridFactory - + ! Manager public :: VerticalGridManager public :: get_vertical_grid_manager @@ -37,5 +38,9 @@ module mapl3g_VerticalGrid_API public :: BasicVerticalGrid public :: BasicVerticalGridSpec public :: BasicVerticalGridFactory + + ! Parameters + public :: VERTICAL_GRID_NOT_FOUND + end module mapl3g_VerticalGrid_API diff --git a/vertical_grid/VerticalGrid.F90 b/vertical_grid/VerticalGrid.F90 index 24dae5c7b74..84b1c4b8566 100644 --- a/vertical_grid/VerticalGrid.F90 +++ b/vertical_grid/VerticalGrid.F90 @@ -8,6 +8,7 @@ module mapl3g_VerticalGrid private public :: VerticalGrid + public :: VERTICAL_GRID_NOT_FOUND type, abstract :: VerticalGrid private @@ -74,7 +75,10 @@ end function I_matches end interface + integer, parameter :: VERTICAL_GRID_NOT_FOUND = -1 + contains + function get_id(this) result(id) integer :: id class(VerticalGrid), intent(in) :: this