Merge pull request #3249 from GEOS-ESM/feature/tclune/#3247-introduce…

…-aspect-base-class

Fixes #3247 - Initial implementation of StateItemAspect.

generic3g/registry/ExtensionFamily.F90

@@ -7,9 +7,11 @@
 
 module mapl3g_ExtensionFamily
    use mapl3g_StateItemSpec
+   use mapl3g_StateItemAspect
    use mapl3g_StateItemExtension
    use mapl3g_StateItemExtensionPtrVector
    use mapl_ErrorHandling
+   use gFTL2_StringVector
    implicit none
    private
 
@@ -123,11 +125,40 @@ function find_closest_extension(family, goal_spec, rc) result(closest_extension)
       type(StateItemExtension), pointer :: primary
       class(StateItemSpec), pointer :: spec
       logical :: match
-
+      type(StringVector), target :: aspect_names
+      character(:), pointer :: aspect_name
+      class(StateItemAspect), pointer :: src_aspect, dst_aspect
+
       closest_extension => null()
       subgroup = family%get_extensions()
       primary => family%get_primary()  ! archetype defines the rules
       archetype => primary%get_spec()
+
+      ! new
+      aspect_names = archetype%get_aspect_order(goal_spec)
+      do i = 1, aspect_names%size()
+         aspect_name => aspect_names%of(i)
+         dst_aspect => goal_spec%get_aspect(aspect_name, _RC)
+
+         ! Find subset that match current aspect
+         new_subgroup = StateItemExtensionPtrVector()
+         do j = 1, subgroup%size()
+            extension_ptr = subgroup%of(j)
+            spec => extension_ptr%ptr%get_spec()
+            src_aspect => spec%get_aspect(aspect_name, _RC)
+
+            if (src_aspect%matches(dst_aspect)) then
+               call new_subgroup%push_back(extension_ptr)
+            end if
+         end do
+
+         if (new_subgroup%size() == 0) exit
+         subgroup = new_subgroup
+
+      end do
+
+      ! old
+
       adapters = archetype%make_adapters(goal_spec, _RC)
 
       do i = 1, size(adapters)

generic3g/registry/StateItemExtension.F90

@@ -8,8 +8,10 @@ module mapl3g_StateItemExtension
    use mapl3g_ComponentDriverPtrVector
    use mapl3g_ExtensionAction
    use mapl3g_GenericCoupler
+   use mapl3g_StateItemAspect
    use mapl3g_MultiState
    use mapl_ErrorHandling
+   use gftl2_StringVector
    use esmf
    implicit none
    private
@@ -118,10 +120,39 @@ recursive function make_extension(this, goal, rc) result(extension)
       type(StateItemAdapterWrapper), allocatable :: adapters(:)
       type(ESMF_Clock) :: fake_clock
       logical :: match
+      type(StringVector), target :: aspect_names
+      character(:), pointer :: aspect_name
+      class(StateItemAspect), pointer :: src_aspect, dst_aspect
+      type(AspectExtension) :: aspect_extension
 
       call this%spec%set_active()
 
       new_spec = this%spec
+
+      aspect_names = this%spec%get_aspect_order(goal)
+      do i = 1, aspect_names%size()
+         aspect_name => aspect_names%of(i)
+         src_aspect => new_spec%get_aspect(aspect_name, _RC)
+         dst_aspect => goal%get_aspect(aspect_name, _RC)
+         _ASSERT(src_aspect%can_connect_to(dst_aspect), 'cannoct connect aspect ' // aspect_name)
+         if (.not. src_aspect%needs_extension_for(dst_aspect)) cycle
+         aspect_extension = src_aspect%make_extension(dst_aspect, _RC)
+         call new_spec%set_aspect(aspect_name, aspect_extension%aspect)
+         exit
+      end do
+
+      if (allocated(aspect_extension%action)) then
+         call new_spec%create(_RC)
+         call new_spec%set_active()
+         coupler_gridcomp = make_coupler(aspect_extension%action, _RC)
+         producer = GriddedComponentDriver(coupler_gridcomp, fake_clock, MultiState())
+         extension = StateItemExtension(new_spec, producer)
+         _RETURN(_SUCCESS)
+      end if
+
+
+      ! The logic belowe should be removed once Aspects have fully
+      ! replaced Adapters.
       adapters = this%spec%make_adapters(goal, _RC)
       do i = 1, size(adapters)
          match = adapters(i)%adapter%match(new_spec, _RC)

generic3g/specs/AspectMap.F90

@@ -0,0 +1,20 @@
+module mapl3g_AspectMap
+   use mapl3g_StateItemAspect
+
+#define Key __CHARACTER_DEFERRED
+#define T StateItemAspect
+#define T_polymorphic
+#define Map AspectMap
+#define MapIterator AspectMapIterator
+#define Pair AspectPairIterator
+
+#include "map/template.inc"
+
+#undef Pair
+#undef MapIterator
+#undef Map
+#undef T_polymorphic
+#undef T
+#undef Key
+
+end module mapl3g_AspectMap

generic3g/specs/CMakeLists.txt

@@ -1,4 +1,10 @@
 target_sources(MAPL.generic3g PRIVATE
+  StateItemAspect.F90
+  AspectMap.F90
+  GeomAspect.F90
+  UngriddedDimsAspect.F90
+  UnitsAspect.F90
+
   VariableSpec.F90
   StateItem.F90
   VariableSpecVector.F90

generic3g/specs/GeomAspect.F90

@@ -0,0 +1,93 @@
+#include "MAPL_Generic.h"
+
+module mapl3g_GeomAspect
+   use mapl3g_StateItemAspect
+   use mapl3g_geom_mgr, only: MAPL_SameGeom
+   use mapl3g_regridder_mgr, only: EsmfRegridderParam
+   use mapl3g_ExtensionAction
+   use mapl3g_RegridAction
+   use mapl3g_NullAction
+   use mapl_ErrorHandling
+   use ESMF, only: ESMF_Geom
+   implicit none
+   private
+
+   public :: GeomAspect
+
+
+   type, extends(StateItemAspect) :: GeomAspect
+      private
+      type(ESMF_Geom) :: geom
+      type(EsmfRegridderParam) :: regridder_param
+   contains
+      procedure :: matches
+      procedure :: make_action
+      procedure :: supports_conversion_general
+      procedure :: supports_conversion_specific
+   end type GeomAspect
+
+   interface GeomAspect
+      procedure new_GeomAspect
+   end interface
+
+contains
+
+   function new_GeomAspect(geom, regridder_param, is_mirror, is_time_dependent) result(aspect)
+      type(GeomAspect) :: aspect
+      type(ESMF_Geom), intent(in) :: geom
+      type(EsmfRegridderParam), intent(in) :: regridder_param
+      logical, optional, intent(in) :: is_mirror
+      logical, optional, intent(in) :: is_time_dependent
+
+      aspect%geom = geom
+      aspect%regridder_param = regridder_param
+      call aspect%set_mirror(is_mirror)
+      call aspect%set_time_dependent(is_time_dependent)
+
+   end function new_GeomAspect
+
+   ! Generally, geoms can be converted via RouteHandle, but there
+   ! are definitely many exceptions.   A better implementation here could attempt to create
+   ! the relevant regridder.
+   logical function supports_conversion_general(src)
+      class(GeomAspect), intent(in) :: src
+      supports_conversion_general = .true.
+   end function supports_conversion_general
+
+   logical function supports_conversion_specific(src, dst)
+      class(GeomAspect), intent(in) :: src
+      class(StateItemAspect), intent(in) :: dst
+      supports_conversion_specific = .true.
+   end function supports_conversion_specific
+
+   logical function matches(src, dst)
+      class(GeomAspect), intent(in) :: src
+      class(StateItemAspect), intent(in) :: dst
+
+      select type(dst)
+      class is (GeomAspect)
+         matches = MAPL_SameGeom(src%geom, dst%geom)
+      class default
+         matches = .false.
+      end select
+
+   end function matches
+
+   function make_action(src, dst, rc) result(action)
+      class(ExtensionAction), allocatable :: action
+      class(GeomAspect), intent(in) :: src
+      class(StateItemAspect), intent(in)  :: dst
+      integer, optional, intent(out) :: rc
+
+      select type(dst)
+      class is (GeomAspect)
+         action = RegridAction(src%geom, dst%geom, dst%regridder_param)
+      class default
+         action = NullAction()
+         _FAIL('src is GeomAspect but dst is different subclass')
+      end select
+
+      _RETURN(_SUCCESS)
+   end function make_action
+
+end module mapl3g_GeomAspect