Improve vector field naming and expose vector state item support (#4926)

* Vector field - derived field names from short name

* Add mapl3g_Utilities to MAPL

* Updated vector scenarios test

* Add vector component support in MAPL_GridCompAddSpec

* scenarios test vector_1 - revert to the original version

* VectorClassAspec - mirroring short names

Author: pchakraborty

mapl3g/MAPL.F90

@@ -12,6 +12,7 @@ module MAPL
    use mapl3g_UngriddedDims, only: UngriddedDims
    use mapl3g_Field_API
    use mapl3g_FieldBundle_API
+   use mapl3g_Utilities
    use MAPL_PythonBridge
    use mapl_base3g
    use mapl_Profiler, initialize_profiler => initialize, finalize_profiler => finalize

superstructure/generic/MAPL_Generic.F90

@@ -33,7 +33,8 @@ module mapl3g_Generic
    use mapl3g_HorizontalDimsSpec, only: HorizontalDimsSpec, HORIZONTAL_DIMS_NONE, HORIZONTAL_DIMS_GEOM
    use mapl3g_UngriddedDim, only: UngriddedDim
    use mapl3g_UngriddedDims, only: UngriddedDims
-   use mapl3g_StateItem, only: MAPL_STATEITEM_STATE, MAPL_STATEITEM_FIELDBUNDLE, MAPL_STATEITEM_SERVICE
+   use mapl3g_StateItem, only: MAPL_STATEITEM_STATE, MAPL_STATEITEM_FIELDBUNDLE
+   use mapl3g_StateItem, only: MAPL_STATEITEM_SERVICE, MAPL_STATEITEM_VECTOR
    use mapl3g_ESMF_Utilities, only: esmf_state_intent_to_string
    use mapl3g_ESMF_Interfaces, only: MAPL_UserCompGetInternalState, MAPL_UserCompSetInternalState
    use mapl3g_hconfig_get
@@ -108,7 +109,8 @@ module mapl3g_Generic
    public :: MAPL_GridCompTimerStop
 
    ! Spec types
-   public :: MAPL_STATEITEM_STATE, MAPL_STATEITEM_FIELDBUNDLE, MAPL_STATEITEM_SERVICE
+   public :: MAPL_STATEITEM_STATE, MAPL_STATEITEM_FIELDBUNDLE
+   public :: MAPL_STATEITEM_SERVICE, MAPL_STATEITEM_VECTOR
 
    public :: MAPL_UserCompGetInternalState, MAPL_UserCompSetInternalState
 
@@ -549,6 +551,7 @@ subroutine gridcomp_add_spec( &
         vstagger, &
         ! OPTIONAL
         unusable, &
+        vector_component_names, &
         ungridded_dims, &
         units, &
         restart, &
@@ -568,6 +571,7 @@ subroutine gridcomp_add_spec( &
       type(VerticalStaggerLoc), intent(in) :: vstagger
       ! OPTIONAL
       class(KeywordEnforcer), optional, intent(in) :: unusable
+      character(*), optional, intent(in) :: vector_component_names(:)
       type(UngriddedDim), optional, intent(in) :: ungridded_dims(:)
       character(*), optional, intent(in) :: units
       type(RestartMode), optional, intent(in) :: restart
@@ -586,6 +590,7 @@ subroutine gridcomp_add_spec( &
       type(ComponentSpec), pointer :: component_spec
       character(len=:), allocatable :: units_
       type(UngriddedDims), allocatable :: dim_specs_vec
+      type(StringVector) :: vector_component_names_vec
       integer :: status
 
       _ASSERT((dims=="xyz") .or. (dims=="xy") .or. (dims=="z"), "dims can be one of xyz/xy/z")
@@ -597,6 +602,14 @@ subroutine gridcomp_add_spec( &
       ! If input units is present, override using input values
       if (present(units)) units_ = units
       if (present(ungridded_dims)) dim_specs_vec = UngriddedDims(ungridded_dims)
+      ! vector_component_names
+      if (present(vector_component_names)) then
+         _ASSERT(present(itemType), "itemType must be present if vector_component_names is present")
+         _ASSERT((itemType==MAPL_STATEITEM_VECTOR), "valid only for vector items")
+         _ASSERT((size(vector_component_names)==2), "vector_component_names must have 2 components")
+         call vector_component_names_vec%push_back(trim(vector_component_names(1)))
+         call vector_component_names_vec%push_back(trim(vector_component_names(2)))
+      end if
       var_spec = make_VariableSpec( &
            state_intent, &
            short_name, &
@@ -611,6 +624,7 @@ subroutine gridcomp_add_spec( &
            has_deferred_aspects=has_deferred_aspects, &
            service_items=service_items, &
            restart_mode=restart, &
+           vector_component_names=vector_component_names_vec, &
            _RC)
       call MAPL_GridCompGetOuterMeta(gridcomp, outer_meta, _RC)
       component_spec => outer_meta%get_component_spec()

superstructure/generic/RestartHandler.F90

@@ -116,7 +116,6 @@ subroutine write_bundle_(this, bundle, filename, rc)
       call o_Clients%post_wait()
 
       _RETURN(_SUCCESS)
-  
    end subroutine write_bundle_
 
    subroutine read_bundle_(this, filename, bundle, rc)

superstructure/generic/specs/VariableSpec.F90

@@ -222,7 +222,7 @@ function make_VariableSpec( &
 
       integer :: status
 
-       var_spec%short_name = short_name
+      var_spec%short_name = short_name
       var_spec%state_intent = state_intent
 
 #if defined(_SET_OPTIONAL)
@@ -248,15 +248,15 @@ function make_VariableSpec( &
       _SET_OPTIONAL(regrid_param)
       _SET_OPTIONAL(horizontal_dims_spec)
       _SET_OPTIONAL(vector_component_names)
-       _SET_OPTIONAL(has_deferred_aspects)
-       _SET_OPTIONAL(use_field_dictionary)
-       _SET_OPTIONAL(restart_mode)
-
-       var_spec%vector_basis_kind = VECTOR_BASIS_KIND_NS
-       if (present(vector_basis_kind)) then
-          _ASSERT(any(var_spec%itemType == [MAPL_STATEITEM_VECTOR, MAPL_STATEITEM_VECTORBRACKET]), 'vector_basis_kind can only be specified for vectors')
-          var_spec%vector_basis_kind = VectorBasisKind(vector_basis_kind)
-       end if
+      _SET_OPTIONAL(has_deferred_aspects)
+      _SET_OPTIONAL(use_field_dictionary)
+      _SET_OPTIONAL(restart_mode)
+
+      var_spec%vector_basis_kind = VECTOR_BASIS_KIND_NS
+      if (present(vector_basis_kind)) then
+         _ASSERT(any(var_spec%itemType == [MAPL_STATEITEM_VECTOR, MAPL_STATEITEM_VECTORBRACKET]), 'vector_basis_kind can only be specified for vectors')
+         var_spec%vector_basis_kind = VectorBasisKind(vector_basis_kind)
+      end if
 
       if (var_spec%use_field_dictionary) then
          call apply_field_dictionary_defaults_(var_spec, short_name, standard_name, units, long_name, _RC)
@@ -647,10 +647,10 @@ function make_ClassAspect(this, registry, rc) result(aspect)
       type(StateRegistry), pointer, optional, intent(in) :: registry
       integer, optional, intent(out) :: rc
 
-       integer :: status
-       character(:), allocatable :: std_name_1, std_name_2
-       type(StringVector) :: vector_component_names
-       type(VectorBasisKind) :: basis_kind
+      integer :: status
+      character(:), allocatable :: std_name_1, std_name_2
+      type(StringVector) :: vector_component_names
+      type(VectorBasisKind) :: basis_kind
 
       select case (this%itemType%ot)
       case (MAPL_STATEITEM_FIELD%ot)
@@ -662,30 +662,29 @@ function make_ClassAspect(this, registry, rc) result(aspect)
          aspect = FieldBundleClassAspect(standard_name=this%standard_name)
       case (MAPL_STATEITEM_STATE%ot)
          aspect = StateClassAspect(state_intent=this%state_intent, standard_name=this%standard_name)
-       case (MAPL_STATEITEM_VECTOR%ot)
-          std_name_1 = 'unknown'
-          std_name_2 = 'unknown'
-          if (allocated(this%standard_name)) then
-             call split_name(this%standard_name, std_name_1, std_name_2, _RC)
-          end if
-          if (this%vector_component_names%size() == 0) then
-             call vector_component_names%push_back('unknown')
-             call vector_component_names%push_back('unknown')
-          else
-             vector_component_names = this%vector_component_names
-          end if
-
-          if (allocated(this%vector_basis_kind)) then
-             basis_kind = this%vector_basis_kind
-          else
-             basis_kind = VECTOR_BASIS_KIND_NS
-          end if
-          aspect = VectorClassAspect(this%vector_component_names, &
-               [ &
-               FieldClassAspect(standard_name=std_name_1, fill_value=this%fill_value), &
-               FieldClassAspect(standard_name=std_name_2, fill_value=this%fill_value) &
-               ], &
-               basis_kind)
+      case (MAPL_STATEITEM_VECTOR%ot)
+         std_name_1 = 'unknown'
+         std_name_2 = 'unknown'
+         if (allocated(this%standard_name)) then
+            call split_name(this%standard_name, std_name_1, std_name_2, _RC)
+         end if
+         if (this%vector_component_names%size() == 0) then
+            call vector_component_names%push_back("unknown1")
+            call vector_component_names%push_back("unknown2")
+         else
+            vector_component_names = this%vector_component_names
+         end if
+         if (allocated(this%vector_basis_kind)) then
+            basis_kind = this%vector_basis_kind
+         else
+            basis_kind = VECTOR_BASIS_KIND_NS
+         end if
+         aspect = VectorClassAspect(this%vector_component_names, &
+              [ &
+              FieldClassAspect(standard_name=std_name_1, fill_value=this%fill_value), &
+              FieldClassAspect(standard_name=std_name_2, fill_value=this%fill_value) &
+              ], &
+              basis_kind)
       case (MAPL_STATEITEM_BRACKET%ot)
          aspect = BracketClassAspect(this%bracket_size, this%standard_name, fill_value=this%fill_value)
       case (MAPL_STATEITEM_VECTORBRACKET%ot)
@@ -707,7 +706,6 @@ function make_ClassAspect(this, registry, rc) result(aspect)
       end select
 
       _RETURN(_SUCCESS)
-
    end function make_ClassAspect
 
    subroutine verify_variable_spec(spec, rc)

superstructure/generic/specs/VectorClassAspect.F90

@@ -1,6 +1,7 @@
 #include "MAPL.h"
 
 module mapl3g_VectorClassAspect
+
    use mapl3g_Field_API
    use mapl3g_FieldBundle_API
    use mapl3g_ActualConnectionPt
@@ -33,6 +34,7 @@ module mapl3g_VectorClassAspect
    use mapl_ErrorHandling
    use gftl2_StringVector
    use esmf
+
    implicit none(type,external)
    private
 
@@ -74,7 +76,6 @@ module mapl3g_VectorClassAspect
       procedure :: new_VectorClassAspect_basic
    end interface VectorClassAspect
 
-
 contains
 
    function new_VectorClassAspect_basic(short_names, component_specs, basis_kind) result(aspect)
@@ -86,10 +87,8 @@ function new_VectorClassAspect_basic(short_names, component_specs, basis_kind) r
       aspect%short_names = short_names
       aspect%component_specs = component_specs
       aspect%basis_kind = basis_kind
-      
    end function new_VectorClassAspect_basic
 
-
    ! Should always be the same as for Field
    function get_aspect_order(this, goal_aspects, rc) result(aspect_ids)
       type(AspectId), allocatable :: aspect_ids(:)
@@ -98,11 +97,10 @@ function get_aspect_order(this, goal_aspects, rc) result(aspect_ids)
       integer, optional, intent(out) :: rc
 
       integer :: status
-      
+
       aspect_ids = this%component_specs(1)%get_aspect_order(goal_aspects, _RC)
 
       _RETURN(_SUCCESS)
-
       _UNUSED_DUMMY(goal_aspects)
    end function get_aspect_order
 
@@ -129,12 +127,12 @@ subroutine create(this, other_aspects, rc)
       type(ESMF_Info) :: info
 
       this%payload = MAPL_FieldBundleCreate(fieldBundleType=FIELDBUNDLETYPE_VECTOR, _RC)
-      
+
       call ESMF_InfoGetFromHost(this%payload, info, _RC)
       call MAPL_FieldBundleSet(this%payload, &
-                               allocation_status=STATEITEM_ALLOCATION_CREATED, &
-                               vector_basis_kind=this%basis_kind, &
-                               _RC)
+           allocation_status=STATEITEM_ALLOCATION_CREATED, &
+           vector_basis_kind=this%basis_kind, &
+           _RC)
 
       _RETURN(ESMF_SUCCESS)
       _UNUSED_DUMMY(other_aspects)
@@ -181,7 +179,7 @@ subroutine update_payload(field_aspect, other_aspects, rc)
       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)
@@ -192,7 +190,6 @@ subroutine update_payload(field_aspect, other_aspects, rc)
       end associate
 
       _RETURN(_SUCCESS)
-
    end subroutine update_payload
 
    subroutine destroy(this, rc)
@@ -239,27 +236,11 @@ subroutine connect_to_export(this, export, actual_pt, rc)
       call this%destroy(_RC) ! import is replaced by export/extension
       this%payload = export_%payload
 
+      ! mirror short names since they are required in add_to_state routine
+      this%short_names = export_%short_names
+
       _RETURN(_SUCCESS)
       _UNUSED_DUMMY(actual_pt)
-
-   contains
-
-     subroutine mirror(dst, src)
-        real, allocatable, intent(inout) :: dst
-        real, allocatable, intent(in) :: src
-
-        if (.not. allocated(src)) return
-
-        if (.not. allocated(dst)) then
-           dst = src
-           return
-        end if
-
-         ! TODO: Problematic case: both allocated with different values.
-         if (dst /= src) then
-         end if
-      end subroutine mirror
-      
    end subroutine connect_to_export
 
    function to_vectorclassaspect_from_poly(aspect, rc) result(vector_aspect)
@@ -297,7 +278,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)
@@ -332,13 +313,12 @@ subroutine add_to_state(this, multi_state, actual_pt, rc)
 
       type(ESMF_FieldBundle) :: alias, existing_bundle
       type(esmf_StateItem_Flag) :: itemType
-      logical :: is_alias
-      integer :: status
       type(ESMF_State) :: state, substate
-      character(:), allocatable :: full_name, inner_name
-      integer :: idx
-      character(:), allocatable :: intent
-      
+      type(ESMF_Field), allocatable :: field_list(:)
+      logical :: is_alias
+      character(:), allocatable :: full_name, inner_name, intent
+      integer :: idx, status
+
       intent = actual_pt%get_state_intent()
       call multi_state%get_state(state, intent, _RC)
 
@@ -358,6 +338,13 @@ subroutine add_to_state(this, multi_state, actual_pt, rc)
       end if
       call ESMF_StateAddReplace(substate, [alias], _RC)
 
+      ! Also update the names of the components
+      call MAPL_FieldBundleGet(this%payload, fieldList=field_list, _RC)
+      if (size(field_list) > 0) then ! might be empty if import item
+         call ESMF_FieldSet(field_list(1), name=trim(this%short_names%at(1)), _RC)
+         call ESMF_FieldSet(field_list(2), name=trim(this%short_names%at(2)), _RC)
+      end if
+
       _RETURN(_SUCCESS)
    end subroutine add_to_state
 
@@ -376,7 +363,7 @@ subroutine get_payload(this, unusable, field, bundle, state, rc)
       _UNUSED_DUMMY(field)
       _UNUSED_DUMMY(state)
    end subroutine get_payload
-   
+
    function get_aspect_id() result(aspect_id)
       type(AspectId) :: aspect_id
       aspect_id = CLASS_ASPECT_ID