Merge pull request #3301 from GEOS-ESM/feature/tclune/#3267-refactor-…

…variable-spec

Fixes #3267

generic3g/actions/VerticalRegridAction.F90

@@ -46,15 +46,17 @@ function new_VerticalRegridAction(v_in_coord, v_in_coupler, v_out_coord, v_out_c
       class(ComponentDriver), pointer, intent(in) :: v_in_coupler
       type(ESMF_Field), intent(in) :: v_out_coord
       class(ComponentDriver), pointer, intent(in) :: v_out_coupler
-      type(VerticalRegridMethod), intent(in) :: method
+      type(VerticalRegridMethod), optional, intent(in) :: method
 
       action%v_in_coord = v_in_coord
       action%v_out_coord = v_out_coord
 
       action%v_in_coupler => v_in_coupler
       action%v_out_coupler => v_out_coupler
 
-      action%method = method
+      if (present(method)) then
+         action%method = method
+      end if
    end function new_VerticalRegridAction
 
    subroutine initialize(this, importState, exportState, clock, rc)

generic3g/registry/ExtensionFamily.F90

@@ -139,6 +139,7 @@ function find_closest_extension(family, goal_spec, rc) result(closest_extension)
       do i = 1, aspect_names%size()
          aspect_name => aspect_names%of(i)
          dst_aspect => goal_spec%get_aspect(aspect_name, _RC)
+         _ASSERT(associated(dst_aspect), 'expected aspect '//aspect_name//' is missing')
 
          ! Find subset that match current aspect
          new_subgroup = StateItemExtensionPtrVector()
@@ -158,27 +159,6 @@ function find_closest_extension(family, goal_spec, rc) result(closest_extension)
 
       end do
 
-      ! old
-
-      adapters = archetype%make_adapters(goal_spec, _RC)
-
-      do i = 1, size(adapters)
-         new_subgroup = StateItemExtensionPtrVector()
-         do j = 1, subgroup%size()
-            extension_ptr = subgroup%of(j)
-            spec => extension_ptr%ptr%get_spec()
-            associate (adapter => adapters(i)%adapter)
-              match = adapter%match(spec, _RC)
-              if (match) then
-                 call new_subgroup%push_back(extension_ptr)
-              end if
-            end associate
-         end do
-
-         if (new_subgroup%size() == 0) exit
-         subgroup = new_subgroup
-      end do
-
       extension_ptr = subgroup%front()
       closest_extension => extension_ptr%ptr
 

generic3g/registry/StateItemExtension.F90

@@ -123,7 +123,7 @@ recursive function make_extension(this, goal, rc) result(extension)
 
       integer :: status
       integer :: i
-      class(StateItemSpec), allocatable :: new_spec
+      class(StateItemSpec), target, allocatable :: new_spec
       class(ExtensionAction), allocatable :: action
       class(ComponentDriver), pointer :: producer
       class(ComponentDriver), pointer :: source
@@ -144,7 +144,11 @@ recursive function make_extension(this, goal, rc) result(extension)
       do i = 1, aspect_names%size()
          aspect_name => aspect_names%of(i)
          src_aspect => new_spec%get_aspect(aspect_name, _RC)
+         _ASSERT(associated(src_aspect), 'src aspect not found')
+
          dst_aspect => goal%get_aspect(aspect_name, _RC)
+         _ASSERT(associated(dst_aspect), 'dst aspect not found')
+
          _ASSERT(src_aspect%can_connect_to(dst_aspect), 'cannot connect aspect ' // aspect_name)
 
          if (src_aspect%needs_extension_for(dst_aspect)) then
@@ -167,30 +171,6 @@ recursive function make_extension(this, goal, rc) result(extension)
          _RETURN(_SUCCESS)
       end if
 
-      ! The logic below 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)
-         if (match) cycle
-         call adapters(i)%adapter%adapt(new_spec, action, _RC)
-         exit
-      end do
-
-      if (.not. allocated(action)) then
-         extension = StateItemExtension(this%spec)
-         _RETURN(_SUCCESS)
-      end if
-
-      call new_spec%create(_RC)
-      call new_spec%set_active()
-
-      source => this%get_producer()
-      coupler_gridcomp = make_coupler(action, source, _RC)
-      producer => this%add_consumer(GriddedComponentDriver(coupler_gridcomp, fake_clock, MultiState()))
-      extension = StateItemExtension(new_spec)
-      call extension%set_producer(producer)
-
       _RETURN(_SUCCESS)
    end function make_extension
 

generic3g/specs/AspectCollection.F90

@@ -2,15 +2,15 @@
 
 module mapl3g_AspectCollection
    use mapl3g_StateItemAspect
-
    use mapl3g_GeomAspect
+   use mapl3g_VerticalGridAspect
    use mapl3g_UnitsAspect
    use mapl3g_TypekindAspect
    use mapl3g_FrequencyAspect
    use mapl3g_UngriddedDimsAspect
-
    use mapl_KeywordEnforcer
    use mapl_ErrorHandling
+   use esmf
    implicit none
    private
 
@@ -19,6 +19,7 @@ module mapl3g_AspectCollection
    type AspectCollection
       private
       type(GeomAspect), allocatable :: geom_aspect
+      type(VerticalGridAspect), allocatable :: vertical_grid_aspect
       type(UnitsAspect), allocatable :: units_aspect
       type(TypekindAspect), allocatable :: typekind_aspect
       type(UngriddedDimsAspect), allocatable :: ungridded_dims_aspect
@@ -31,6 +32,9 @@ module mapl3g_AspectCollection
       procedure :: get_geom_aspect
       procedure :: set_geom_aspect
 
+      procedure :: get_vertical_grid_aspect
+      procedure :: set_vertical_grid_aspect
+
       procedure :: get_units_aspect
       procedure :: set_units_aspect
 
@@ -74,6 +78,8 @@ function get_aspect(this, name, rc) result(aspect)
       select case (name)
       case ('GEOM')
          aspect => this%get_geom_aspect()
+      case ('VERTICAL')
+         aspect => this%get_vertical_grid_aspect()
       case ('UNITS')
          aspect => this%get_units_aspect()
       case ('TYPEKIND')
@@ -94,26 +100,58 @@ logical function has_aspect(this, name)
       character(*), intent(in) :: name
 
       select case (name)
-      case ('GEOM', 'UNITS', 'UNGRIDDED_DIMS', 'FREQUENCY')
-         has_aspect = .true.
+
+      case ('GEOM')
+         has_aspect = allocated(this%geom_aspect)
+      case ('VERTICAL')
+         has_aspect = allocated(this%vertical_grid_aspect)
+      case ('UNITS')
+         has_aspect = allocated(this%units_aspect)
+      case ('TYPEKIND')
+         has_aspect = allocated(this%typekind_aspect)
+      case ('UNGRIDDED_DIMS')
+         has_aspect = allocated(this%ungridded_dims_aspect)
+
       case default
          has_aspect = .false.
       end select
 
    end function has_aspect
 
    subroutine set_aspect(this, aspect, rc)
-      class(AspectCollection) :: this
+      class(AspectCollection), target :: this
       class(StateItemAspect), target, intent(in) :: aspect
       integer, optional, intent(out) :: rc
 
+      type(ESMF_Geom) :: geom
+      type(ESMF_Typekind_Flag) :: typekind
+      integer :: status
+
       select type (aspect)
       type is (GeomAspect)
          this%geom_aspect = aspect
+         ! aux vertical
+         if (allocated( this%vertical_grid_aspect)) then
+            geom = aspect%get_geom()
+            call this%vertical_grid_aspect%set_geom(geom)
+         end if
+      type is (VerticalGridAspect)
+         if (allocated(this%vertical_grid_aspect)) then
+            if (allocated(this%vertical_grid_aspect%vertical_grid)) then
+            end if
+         end if
+         this%vertical_grid_aspect = aspect
+         if (allocated(this%vertical_grid_aspect%vertical_grid)) then
+         end if
       type is (UnitsAspect)
          this%units_aspect = aspect
       type is (TypekindAspect)
          this%typekind_aspect = aspect
+         ! aux vertical
+         typekind = aspect%get_typekind()
+         if (allocated( this%vertical_grid_aspect)) then
+            call this%vertical_grid_aspect%set_typekind(typekind)
+         end if
       type is (UngriddedDimsAspect)
          this%ungridded_dims_aspect = aspect
       type is (FrequencyAspect)
@@ -140,6 +178,21 @@ subroutine set_geom_aspect(this, geom_aspect)
       this%geom_aspect = geom_aspect
    end subroutine set_geom_aspect
 
+   function get_vertical_grid_aspect(this) result(vertical_grid_aspect)
+      type(VerticalGridAspect), pointer :: vertical_grid_aspect
+      class(AspectCollection), target, intent(in) :: this
+      vertical_grid_aspect => null()
+      if (allocated(this%vertical_grid_aspect)) then
+         vertical_grid_aspect => this%vertical_grid_aspect
+      end if
+   end function get_vertical_grid_aspect
+
+   subroutine set_vertical_grid_aspect(this, vertical_grid_aspect)
+      class(AspectCollection), intent(inout) :: this
+      type(VerticalGridAspect), intent(in) :: vertical_grid_aspect
+      this%vertical_grid_aspect = vertical_grid_aspect
+   end subroutine set_vertical_grid_aspect
+
    function get_units_aspect(this) result(units_aspect)
       type(UnitsAspect), pointer :: units_aspect
       class(AspectCollection), target, intent(in) :: this

generic3g/specs/BracketSpec.F90

@@ -45,7 +45,6 @@ module mapl3g_BracketSpec
       procedure :: add_to_state
       procedure :: add_to_bundle
 
-      procedure :: make_adapters
       procedure :: set_geometry
       procedure :: write_formatted
    end type BracketSpec
@@ -281,19 +280,4 @@ subroutine write_formatted(this, unit, iotype, v_list, iostat, iomsg)
       write(unit, "(a)", iostat=iostat, iomsg=iomsg) "BracketSpec(write not implemented yet)"
    end subroutine write_formatted
 
-   function make_adapters(this, goal_spec, rc) result(adapters)
-      type(StateItemAdapterWrapper), allocatable :: adapters(:)
-      class(BracketSpec), intent(in) :: this
-      class(StateItemSpec), intent(in) :: goal_spec
-      integer, optional, intent(out) :: rc
-
-
-      allocate(adapters(0))
-      _FAIL('unimplemented')
-
-      _RETURN(_SUCCESS)
-      _UNUSED_DUMMY(this)
-      _UNUSED_DUMMY(goal_spec)
-   end function make_adapters
-
 end module mapl3g_BracketSpec

generic3g/specs/CMakeLists.txt

@@ -3,6 +3,7 @@ target_sources(MAPL.generic3g PRIVATE
   AspectCollection.F90
   GeomAspect.F90
   TypekindAspect.F90
+  VerticalGridAspect.F90
   UngriddedDimsAspect.F90
   UnitsAspect.F90
   FrequencyAspect.F90