Merge pull request #2249 from GEOS-ESM/feature/tclune/mapl3-wildcard-…

…support

Feature/tclune/mapl3 wildcard support

generic3g/ComponentSpecParser.F90

@@ -234,7 +234,7 @@ subroutine to_VerticalDimSpec(vertical_dim_spec, attributes, rc)
          case ('vertical_dim_edge', 'E')
             vertical_dim_spec = VERTICAL_DIM_EDGE
          case default
-            _FAIL('Unsupported typekind')
+            _FAIL('Unsupported vertical_dim_spec')
          end select
 
          _RETURN(_SUCCESS)
@@ -287,6 +287,8 @@ subroutine to_itemtype(itemtype, attributes, rc)
             itemtype = MAPL_STATEITEM_FIELD
          case ('service')
             itemtype = MAPL_STATEITEM_SERVICE
+         case ('wildcard')
+            itemtype = MAPL_STATEITEM_WILDCARD
          case default
             _FAIL('unknown subclass for state item: '//subclass)
          end select
@@ -360,8 +362,8 @@ function process_connection(config, rc) result(conn)
 
          if (ESMF_HConfigIsDefined(config,keyString='all_unsatisfied')) then
             conn = MatchConnection( &
-                 ConnectionPt(src_comp, VirtualConnectionPt(state_intent='export', short_name='*')), &
-                 ConnectionPt(dst_comp, VirtualConnectionPt(state_intent='import', short_name='*'))  &
+                 ConnectionPt(src_comp, VirtualConnectionPt(state_intent='export', short_name='.*')), &
+                 ConnectionPt(dst_comp, VirtualConnectionPt(state_intent='import', short_name='.*'))  &
                  )
             _RETURN(_SUCCESS)
          end if

generic3g/ESMF_Utilities.F90

@@ -164,4 +164,5 @@ subroutine get_substate(state, name, substate, rc)
       _RETURN(_SUCCESS)
    end subroutine get_substate
 
+
 end module mapl3g_ESMF_Utilities

generic3g/OuterMetaComponent.F90

@@ -628,7 +628,6 @@ recursive subroutine initialize_realize(this, clock, unusable, rc)
       call apply_to_children(this, clock, phase_idx=GENERIC_INIT_REALIZE, _RC)
 
       call this%registry%allocate(_RC)
-
 
       _RETURN(ESMF_SUCCESS)
       _UNUSED_DUMMY(unusable)

generic3g/actions/CMakeLists.txt

@@ -7,4 +7,6 @@ target_sources(MAPL.generic3g PRIVATE
   NullAction.F90
   ActionVector.F90
   CopyAction.F90
+
+  SequenceAction.F90
 )

generic3g/actions/SequenceAction.F90

@@ -0,0 +1,37 @@
+#include "MAPL_Generic.h"
+
+module mapl3g_SequenceAction
+   use mapl3g_ExtensionAction
+   use mapl3g_ActionVector
+   use mapl_ErrorHandling
+   implicit none
+   private
+
+   public :: SequenceAction
+
+   type, extends(ExtensionAction) :: SequenceAction
+      type(ActionVector) :: actions
+   contains
+      procedure :: run
+   end type SequenceAction
+
+contains
+
+   subroutine run(this, rc)
+      class(SequenceAction), intent(inout) :: this
+      integer, optional, intent(out) :: rc
+
+      integer :: status
+      integer :: i
+      class(ExtensionAction), pointer :: action
+
+      do i = 1, this%actions%size()
+         action => this%actions%of(i)
+
+         call action%run(_RC)
+      end do
+
+      _RETURN(_SUCCESS)
+   end subroutine run
+
+end module mapl3g_SequenceAction

generic3g/connection/CMakeLists.txt

@@ -3,12 +3,13 @@ target_sources(MAPL.generic3g PRIVATE
   VirtualConnectionPt.F90
   ActualConnectionPt.F90
 
-   ConnectionPt.F90
-   ConnectionPtVector.F90
+  ConnectionPt.F90
+  ConnectionPtVector.F90
 
-   SimpleConnection.F90
-   ReexportConnection.F90
-   MatchConnection.F90
+  SimpleConnection.F90
+  ReexportConnection.F90
+  MatchConnection.F90
 
-   ConnectionVector.F90
+  VirtualConnectionPtVector.F90
+  ConnectionVector.F90
   )

generic3g/connection/MatchConnection.F90

@@ -7,9 +7,11 @@ module mapl3g_MatchConnection
    use mapl3g_HierarchicalRegistry
    use mapl3g_SimpleConnection
    use mapl3g_VirtualConnectionPt
+   use mapl3g_VirtualConnectionPtVector
    use mapl3g_ActualConnectionPt
    use mapl3g_ActualPtVec_Map
    use mapl3g_ActualPtVector
+   use mapl3g_AbstractStateItemSpec
    use mapl_KeywordEnforcer
    use mapl_ErrorHandling
    use esmf
@@ -62,38 +64,48 @@ recursive subroutine connect(this, registry, rc)
       type(HierarchicalRegistry), target, intent(inout) :: registry
       integer, optional, intent(out) :: rc
 
-      type(HierarchicalRegistry), pointer :: src_registry, dst_registry
       integer :: status
-      type(VirtualConnectionPt) :: s_v_pt
-      type(VirtualConnectionPt), pointer :: d_v_pt
-      type(ConnectionPt) :: s_pt,d_pt
-      type(ActualPtVec_MapIterator) :: iter
 
       type(ConnectionPt) :: src_pt, dst_pt
+      type(HierarchicalRegistry), pointer :: src_registry, dst_registry
+      type(VirtualConnectionPtVector) :: src_v_pts, dst_v_pts
+      type(VirtualConnectionPt), pointer :: dst_pattern, src_v_pt
+      type(VirtualConnectionPt) :: src_pattern, dst_v_pt
+      type(VirtualConnectionPt), pointer :: s_v_pt, d_v_pt
+      type(StateItemSpecPtr), allocatable :: dst_specs(:)
+      integer :: i, j, k
+      class(AbstractStateItemSpec), allocatable :: new_spec
+      type(ConnectionPt) :: s_pt, d_pt
 
       src_pt = this%get_source()
       dst_pt = this%get_destination()
 
+      src_registry => registry%get_subregistry(src_pt)
       dst_registry => registry%get_subregistry(dst_pt)
-      ! TODO: Move this into a separate procedure, or introduce
-      ! a 2nd type of connection
-      if (dst_pt%get_esmf_name() == '*') then
-         associate (range => dst_registry%get_range())
-           iter = range(1)
-           do while (iter /= range(2))
-              d_v_pt => iter%first()
-              if (d_v_pt%get_state_intent() /= 'import') cycle
-              s_v_pt = VirtualConnectionPt(ESMF_STATEINTENT_EXPORT, &
-                   d_v_pt%get_esmf_name(), &
-                   comp_name=d_v_pt%get_comp_name())
-              s_pt = ConnectionPt(src_pt%component_name, s_v_pt)
-              d_pt = ConnectionPt(dst_pt%component_name, d_v_pt)
-              call registry%add_connection(SimpleConnection(s_pt, d_pt), _RC)
-              call iter%next()
-           end do
-         end associate
-         _RETURN(_SUCCESS)
-      end if
+
+      dst_v_pts = dst_registry%filter(dst_pt%v_pt)
+
+      do i = 1, dst_v_pts%size()
+         dst_pattern => dst_v_pts%of(i)
+         dst_specs = dst_registry%get_actual_pt_SpecPtrs(dst_pattern, _RC)
+
+         src_pattern = VirtualConnectionPt(ESMF_STATEINTENT_EXPORT, &
+              dst_pattern%get_esmf_name(), comp_name=dst_pattern%get_comp_name())
+
+         src_v_pts = src_registry%filter(src_pattern)
+         do j = 1, src_v_pts%size()
+            src_v_pt => src_v_pts%of(j)
+
+            dst_v_pt = VirtualConnectionPt(ESMF_STATEINTENT_IMPORT, &
+                 src_v_pt%get_esmf_name(), comp_name=src_v_pt%get_comp_name())
+
+            s_pt = ConnectionPt(src_pt%component_name, src_v_pt)
+            d_pt = ConnectionPt(dst_pt%component_name, dst_pattern)
+
+            call registry%add_connection(SimpleConnection(s_pt, d_pt), _RC)
+
+         end do
+      end do
 
       _RETURN(_SUCCESS)
    end subroutine connect

generic3g/connection/SimpleConnection.F90

@@ -90,44 +90,66 @@ subroutine connect_sibling(this, dst_registry, src_registry, unusable, rc)
       class(KeywordEnforcer), optional, intent(in) :: unusable
       integer, optional, intent(out) :: rc
 
-      type(StateItemSpecPtr), allocatable :: export_specs(:), import_specs(:)
-      class(AbstractStateItemSpec), pointer :: export_spec, import_spec
+      type(StateItemSpecPtr), allocatable :: src_specs(:), dst_specs(:)
+      class(AbstractStateItemSpec), pointer :: src_spec, dst_spec
       integer :: i, j
-      logical :: satisfied
       integer :: status
       type(ConnectionPt) :: src_pt, dst_pt
+      integer :: i_extension
+      integer :: cost, lowest_cost
+      class(AbstractStateItemSpec), pointer :: best_spec
+      class(AbstractStateItemSpec), pointer :: old_spec
+      class(AbstractStateItemSpec), allocatable, target :: new_spec
+      type(ActualConnectionPt) :: effective_pt
 
       src_pt = this%get_source()
       dst_pt = this%get_destination()
 
-      import_specs = dst_registry%get_actual_pt_SpecPtrs(dst_pt%v_pt, _RC)
-      export_specs = src_registry%get_actual_pt_SpecPtrs(src_pt%v_pt, _RC)
+      dst_specs = dst_registry%get_actual_pt_SpecPtrs(dst_pt%v_pt, _RC)
+      src_specs = src_registry%get_actual_pt_SpecPtrs(src_pt%v_pt, _RC)
 
-      do i = 1, size(import_specs)
-         import_spec => import_specs(i)%ptr
-         satisfied = .false.
-
-         find_source: do j = 1, size(export_specs)
-            export_spec => export_specs(j)%ptr
-
-            if (.not. import_spec%can_connect_to(export_spec)) cycle
-
-            call export_spec%set_active()
-            call import_spec%set_active()
-
-            if (import_spec%requires_extension(export_spec)) then
-               call src_registry%extend(src_pt%v_pt, import_spec, _RC)
-            else
-               call import_spec%connect_to(export_spec, _RC)
+      do i = 1, size(dst_specs)
+         dst_spec => dst_specs(i)%ptr
+
+         ! Connection is transitive, so we can just check the 1st item
+         src_spec => src_specs(1)%ptr
+         _ASSERT(dst_spec%can_connect_to(src_spec), "impossible connection")
+
+         ! Loop through possible specific exports to find best match.
+         best_spec => src_spec
+         lowest_cost = dst_spec%extension_cost(src_spec, _RC)
+         find_best_source: do j = 2, size(src_specs)
+            if (lowest_cost == 0) exit
+
+            src_spec => src_specs(j)%ptr
+            cost = dst_spec%extension_cost(src_spec)
+
+            if (cost < lowest_cost) then
+               lowest_cost = cost
+               best_spec => src_spec
             end if
+
+         end do find_best_source
+
+         call best_spec%set_active()
+
+         old_spec => best_spec
+         do i_extension = 1, lowest_cost
+            new_spec = old_spec%make_extension(dst_spec, _RC)
+            call new_spec%set_active()
+            call src_registry%extend(src_pt%v_pt, old_spec, new_spec, _RC)
+            old_spec => new_spec
+         end do
+
+         call dst_spec%set_active()
+
+         ! This step (kludge) is for wildcard specs
+         effective_pt = ActualConnectionPt(VirtualConnectionPt(ESMF_STATEINTENT_IMPORT, &
+              src_pt%v_pt%get_esmf_name(), comp_name=src_pt%v_pt%get_comp_name()))
+        call dst_spec%connect_to(old_spec, effective_pt, _RC)
 
-            satisfied = .true.
-            exit find_source
-         end do find_source
-
-         _ASSERT(satisfied,'no matching actual export spec found')
       end do
-
+         
       _RETURN(_SUCCESS)
       _UNUSED_DUMMY(unusable)
    end subroutine connect_sibling

generic3g/connection/VirtualConnectionPt.F90

@@ -9,6 +9,7 @@ module mapl3g_VirtualConnectionPt
    public :: VirtualConnectionPt
    public :: operator(<)
    public :: operator(==)
+   public :: operator(/=)
 
    type :: VirtualConnectionPt
       private
@@ -27,6 +28,8 @@ module mapl3g_VirtualConnectionPt
       procedure :: is_export
       procedure :: is_internal
 
+      procedure :: matches
+
       procedure :: write_formatted
       generic :: write(formatted) => write_formatted
    end type VirtualConnectionPt
@@ -46,6 +49,10 @@ module mapl3g_VirtualConnectionPt
       module procedure equal_to
    end interface operator(==)
 
+   interface operator(/=)
+      module procedure not_equal_to
+   end interface operator(/=)
+
 contains
 
    function new_VirtualPt_basic(state_intent, short_name, unusable, comp_name) result(v_pt)
@@ -171,6 +178,14 @@ logical function equal_to(lhs, rhs)
 
    end function equal_to
 
+   logical function not_equal_to(lhs, rhs)
+      type(VirtualConnectionPt), intent(in) :: lhs
+      type(VirtualConnectionPt), intent(in) :: rhs
+
+      not_equal_to = .not. (lhs == rhs)
+
+   end function not_equal_to
+
    logical function is_import(this)
       class(VirtualConnectionPt), intent(in) :: this
       is_import = (this%get_state_intent() == 'import')
@@ -199,4 +214,19 @@ subroutine write_formatted(this, unit, iotype, v_list, iostat, iomsg)
            this%get_state_intent(), this%get_full_name()
    end subroutine write_formatted
 
+   logical function matches(this, item)
+      use regex_module
+      class(VirtualConnectionPt), intent(in) :: this
+      type(VirtualConnectionPt), intent(in) :: item
+
+      type(regex_type) :: regex
+
+      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())
+
+   end function matches
+
 end module mapl3g_VirtualConnectionPt

generic3g/connection/VirtualConnectionPtVector.F90

@@ -0,0 +1,14 @@
+module mapl3g_VirtualConnectionPtVector
+   use mapl3g_VirtualConnectionPt
+
+#define T VirtualConnectionPt
+#define Vector VirtualConnectionPtVector
+#define VectorIterator VirtualConnectionPtVectorIterator
+
+#include "vector/template.inc"
+
+#undef T
+#undef Vector
+#undef VectorIterator
+
+end module mapl3g_VirtualConnectionPtVector