Test_SimpleParentGridComp.pf Source File

#include "MAPL_TestErr.h"
module Test_SimpleParentGridComp
   use mapl3g_GenericPhases
   use mapl3g_Generic
   use mapl3g_UserSetServices
   use mapl3g_GenericGridComp, only: create_grid_comp
   use mapl3g_GenericGridComp, only: setServices
   use mapl3g_GriddedComponentDriver
   use mapl3g_OuterMetaComponent, only: OuterMetaComponent
   use mapl3g_OuterMetaComponent, only: get_outer_meta
   use mapl3g_MultiState
   use mapl3g_GriddedComponentDriver
   use mapl3g_BasicVerticalGrid
   use mapl_KeywordEnforcer
   use esmf
   use nuopc
   use pFunit
   implicit none

   type(MultiState) :: parent_outer_states

contains

   subroutine setup(outer_gc, states, rc)
      type(ESMF_GridComp), intent(inout) :: outer_gc
      type(MultiState), intent(out) :: states
      integer, intent(out) :: rc
      
      integer :: status, userRC
      type(ESMF_Grid) :: grid
      type(ESMF_HConfig) :: config
      integer :: i
      type(BasicVerticalGrid) :: vertical_grid
      type(ESMF_Time) :: t
      type(ESMF_TimeInterval) :: dt
      type(ESMF_Clock) :: clock

      rc = 0
      call NUOPC_FieldDictionarySetup('./scenarios/FieldDictionary.yml', _RC)
      config = ESMF_HConfigCreate(filename = './scenarios/scenario_1/parent.yaml',rc=status)
      @assert_that(status, is(0))

      call ESMF_TimeSet(t, h=0)
      call ESMF_TimeIntervalSet(dt, h=1)
      clock = ESMF_ClockCreate(dt, t)

     outer_gc = create_grid_comp('P', user_setservices('libsimple_parent_gridcomp'), config, clock, _RC)
      call ESMF_GridCompSetServices(outer_gc, setServices, userRC=userRC, _RC)
      _VERIFY(userRC)
      grid = ESMF_GridCreateNoPeriDim(maxIndex=[4,4], name='I_AM_GROOT', _RC)
      call MAPL_GridCompSetGeom(outer_gc, grid, _RC)
      vertical_grid = BasicVerticalGrid(4)
      call MAPL_GridCompSetVerticalGrid(outer_gc, vertical_grid, _RC)

      associate (import => states%importState, export => states%exportState)
        import = ESMF_StateCreate(_RC)
        export = ESMF_StateCreate(_RC)

        do i = 1, size(GENERIC_INIT_PHASE_SEQUENCE)
           associate (phase => GENERIC_INIT_PHASE_SEQUENCE(i))
             call ESMF_GridCompInitialize(outer_gc, &
                  importState=import, exportState=export, clock=clock, &
                  phase=phase, userRC=userRC, _RC)
             _VERIFY(userRC)
           end associate
        end do

      end associate

      rc = 0

   end subroutine setup


   subroutine tearDown(outer_gc)
      type(ESMF_GridComp), intent(inout) :: outer_gc
   end subroutine tearDown


   @test(npes=[0])
   subroutine test_child_user_items_created(this)
      class(MpiTestMethod), intent(inout) :: this

      integer :: status
      type(ESMF_GridComp) :: outer_gc

      type(OuterMetaComponent), pointer :: outer_meta
      type(MultiState) :: states
      type(ESMF_Field) :: f

      call setup(outer_gc, states, status)
      @assert_that(status, is(0))

      outer_meta => get_outer_meta(outer_gc, rc=status)
      @assert_that(status, is(0))

      @assert_that('import', check('child_A', 'import', ['I_A1']), is(0))
      @assert_that('export', check('child_A', 'export', ['E_A1', 'Z_A1']), is(0))
      @assert_that('internal', check('child_A', 'internal', ['Z_A1']), is(0))

      @assert_that('import', check('child_B', 'import', ['I_B1']), is(0))
      @assert_that('export', check('child_B', 'export', ['E_B1']), is(0))
      @assert_that('internal', check('child_B', 'internal', ['Z_B1']), is(0))

   contains

      integer function check(child_name, state_intent, expected_items) result(status)
         character(*), intent(in) :: child_name
         character(*), intent(in) :: state_intent
         character(*), intent(in) :: expected_items(:)

         type(ESMF_Field) :: f
         type(ESMF_State) :: state
         type(MultiState) :: states
         integer :: i
         type(OuterMetaComponent), pointer :: child_meta
         type(ESMF_GridComp) :: child_gc
         type(GriddedComponentDriver) :: child_comp
         type(GriddedComponentDriver), pointer :: user_component

         status = 1

          child_comp = outer_meta%get_child(child_name, rc=status)
         if (status /= 0) then
            status = 2
            return
         end if
         
          child_gc = child_comp%get_gridcomp()
         child_meta => get_outer_meta(child_gc)
         user_component => child_meta%get_user_gc_driver()
         states = user_component%get_states()
         call states%get_state(state, state_intent, rc=status)
         if (status /= 0) then
            status = 3
            return
         end if

         do i = 1, size(expected_items)
            call ESMF_StateGet(state, trim(expected_items(i)), f, rc=status)
            if (status /= 0) then
               status = 10 + i
               return
            end if
         end do

         status = 0

      end function check

   end subroutine test_child_user_items_created


   @test(npes=[0])
   subroutine test_child_outer_items_created(this)
      class(MpiTestMethod), intent(inout) :: this

      integer :: status
      type(ESMF_GridComp) :: outer_gc

      type(OuterMetaComponent), pointer :: outer_meta
      type(MultiState) :: states
      type(ESMF_Field) :: f

      call setup(outer_gc, states, status)
      @assert_that(status, is(0))

      outer_meta => get_outer_meta(outer_gc, rc=status)
      @assert_that(status, is(0))

      call get_child_user_states(states, outer_meta, 'child_A', rc=status)
      @assert_that(status, is(0))

      call get_field(f, states, state_intent='import', field_name='I_A1', rc=status)
      @assert_that(status, is(0))
      call get_field(f, states, state_intent='export', field_name='E_A1', rc=status)
      @assert_that(status, is(0))
      call get_field(f, states, state_intent='internal', field_name='Z_A1', rc=status)
     @assert_that(status, is(0))
      
      call get_child_user_states(states, outer_meta, 'child_B', rc=status)
      @assert_that(status, is(0))

      call get_field(f, states, state_intent='import', field_name='I_B1', rc=status)
      @assert_that(status, is(0))
      call get_field(f, states, state_intent='export', field_name='E_B1', rc=status)
      @assert_that(status, is(0))
      call get_field(f, states, state_intent='internal', field_name='Z_B1', rc=status)
      @assert_that(status, is(0))

!!$      @assert_that('import', check('child_B', 'import', ['I_B1']), is(0))
!!$      @assert_that('export', check('child_B', 'export', ['E_B1']), is(0))
!!$      @assert_that('internal', check('child_B', 'internal', ['Z_B1']), is(0))


   contains

      integer function check(child_name, state_intent, expected_items) result(status)
         character(*), intent(in) :: child_name
         character(*), intent(in) :: state_intent
         character(*), intent(in) :: expected_items(:)

         type(ESMF_Field) :: f
         type(ESMF_State) :: state
         type(MultiState) :: states
         integer :: i
         type(OuterMetaComponent), pointer :: child_meta
         type(ESMF_GridComp) :: child_gc
         type(GriddedComponentDriver) :: child_comp
         type(GriddedComponentDriver), pointer :: user_component
         status = 1

         child_comp = outer_meta%get_child(child_name, rc=status)
         if (status /= 0) then
            status = 2
            return
         end if
         
         child_gc = child_comp%get_gridcomp()
         child_meta => get_outer_meta(child_gc)
         user_component => child_meta%get_user_gc_driver()
         states = user_component%get_states()

         call states%get_state(state, state_intent, rc=status)
         if (status /= 0) then
            status = 3
            return
         end if
         
         do i = 1, size(expected_items)
            call ESMF_StateGet(state, trim(expected_items(i)), f, rc=status)
            if (status /= 0) then
               status = 10 + i
               return
            end if
         end do

         status = 0

      end function check

   end subroutine test_child_outer_items_created

   @test(npes=[0])
   subroutine test_parent_user_items_created(this)
      class(MpiTestMethod), intent(inout) :: this

      integer :: status
      type(ESMF_GridComp) :: outer_gc

      type(OuterMetaComponent), pointer :: outer_meta
      type(MultiState) :: states
      type(ESMF_Field) :: f

      call setup(outer_gc, states, status)
      @assert_that(status, is(0))

      outer_meta => get_outer_meta(outer_gc, rc=status)
      @assert_that(status, is(0))

      @assert_that(check(outer_meta, 'import', expected_count=0), is(0))
      @assert_that(check(outer_meta, 'export', expected_count=0), is(0))
      @assert_that(check(outer_meta, 'internal', expected_count=0), is(0))

   contains

      integer function check(meta, state_intent, expected_count) result(status)
         type(OuterMetaComponent), intent(in) :: meta
         character(*), intent(in) :: state_intent
         integer, intent(in) :: expected_count

         type(MultiState) :: states
         type(ESMF_State) :: state
         integer :: itemCount
         type(GriddedComponentDriver), pointer :: user_component

         status = -1

         user_component => outer_meta%get_user_gc_driver()
         states = user_component%get_states()
         call states%get_state(state, 'import', rc=status)
         if (status /= 0) then
            status = -2
            return
         end if

         call ESMF_StateGet(state, itemCount=itemCount, rc=status)
         if (status /= 0) then
            status = -3
            return
         end if

         if (itemCount /= expected_count) then
            status = -4
            return
         end if
         status = 0
      end function check
   end subroutine test_parent_user_items_created

   @test(npes=[0])
   subroutine test_parent_outer_items_created(this)
      class(MpiTestMethod), intent(inout) :: this

      integer :: status
      type(ESMF_GridComp) :: outer_gc

      type(MultiState) :: states
      type(ESMF_Field) :: f

      call setup(outer_gc, states, status)
      @assert_that(status, is(0))

      @assert_that(check(states, 'import', field_name='I_A1(1)'), is(0))
      @assert_that(check(states, 'export', field_name='child_A/E_A1'), is(0))
      @assert_that(check(states, 'export', field_name='child_A/Z_A1'), is(0))
      @assert_that(check(states, 'export', field_name='child_B/E_B1'), is(0))
      @assert_that(check(states, 'export', field_name='child_B/Z_B1'), is(5))


   contains

      integer function check(states, state_intent, field_name) result(status)
         type(MultiState), intent(inout) :: states
         character(*), intent(in) :: state_intent
         character(*), intent(in) :: field_name

         type(ESMF_Field) :: f
         type(ESMF_State) :: state, substate
         type(ESMF_StateItem_Flag) :: itemtype
         integer :: idx

         status = 1

         call states%get_state(state, state_intent, rc=status)
         if (status /= 0) then
            status = 2
            return
         end if

         idx = scan(field_name, '/')
         select case (idx)
         case (1:)

            call ESMF_StateGet(state, field_name(:idx-1), substate, rc=status)
            if (status /= 0) then
               status = 7
               return
            end if
         case (0)
            substate = state
         end select

         call ESMF_StateGet(substate, field_name(idx+1:), itemtype, rc=status)
         if (status /= 0) then
            status = 4
            return
         end if

         if (itemtype == ESMF_STATEITEM_NOTFOUND) then
            status = 5
            return
         end if
         ! This interface allows ESMF to dive down substate, but the checks above do not.
         call ESMF_StateGet(state, field_name, f, rc=status)
         if (status /= 0) then
            status = 3
            return
         end if

         status = 0

      end function check

   end subroutine test_parent_outer_items_created

   subroutine get_child_user_states(states, outer_meta, child_name, rc)
      use mapl3g_GriddedComponentDriver
      type(MultiState), intent(out) :: states
      type(OuterMetaComponent), target, intent(in) :: outer_meta
      character(*), intent(in) :: child_name
      integer, intent(out) :: rc

      integer :: status
      type(GriddedComponentDriver) :: child_comp
      type(ESMF_GridComp) :: child_gc
      type(OuterMetaComponent), pointer :: child_meta
      type(GriddedComponentDriver), pointer :: user_component

      rc = +1
      child_comp = outer_meta%get_child(child_name, rc=status)
      if (status /= 0) then
         rc = +2
         return
      end if
         
      child_gc = child_comp%get_gridcomp()
      child_meta => get_outer_meta(child_gc, rc=status)
      user_component => child_meta%get_user_gc_driver()
      states = user_component%get_states()

      rc = 0

   end subroutine get_child_user_states

   subroutine get_field(field, states, state_intent, unusable, field_name, substate_name, rc)
      type(ESMF_Field), intent(out) :: field
      type(MultiState), intent(in) :: states
      class(KeywordEnforcer), optional, intent(in) :: unusable
      character(*), intent(in) :: state_intent
      character(*), intent(in) :: field_name
      character(*), optional, intent(in) :: substate_name
      integer, intent(out) :: rc

      integer :: status
      type(ESMF_State) :: state, substate

      rc = +1
      call states%get_state(state, state_intent, rc=status)
      if (status /= 0) then
         rc = +2
         return
      end if

      if (present(substate_name)) then
         call ESMF_StateGet(state, substate_name, substate, rc=status)
         if (status /= 0) then
            rc = +3
            return
         end if
      else
         substate = state
      end if

      call ESMF_StateGet(substate, field_name, field, rc=status)
      if (status /= 0) then
         rc = 4
         return
      end if

      rc = 0
         
   end subroutine get_field

   @test(npes=[0])
   subroutine test_state_items_complete(this)
      class(MpiTestMethod), intent(inout) :: this

      integer :: status
      type(ESMF_GridComp) :: outer_gc

      type(ESMF_Field) :: f
      type(OuterMetaComponent), pointer :: outer_meta

      type(MultiState) :: states

      call setup(outer_gc, states, status)
      @assert_that(status, is(0))
      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)
      @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)
      @assert_that(status, is(0))

      if(.false.) print*,shape(this)
   contains

      subroutine check(child_name, state_intent, item, expected_status, rc)
         character(*), intent(in) :: child_name
         character(*), intent(in) :: state_intent

         character(*), intent(in) :: item
         type(ESMF_FieldStatus_Flag), intent(in) :: expected_status
         integer, optional, intent(out) :: rc

         type(MultiState) :: states
         type(ESMF_State) :: state
         type(GriddedComponentDriver) :: child_comp
         type(ESMF_FieldStatus_Flag) :: field_status

         rc = -1
         child_comp = outer_meta%get_child(child_name, rc=status)
         @assert_that('child <'//child_name//'> not found.', status, is(0))
         states = child_comp%get_states()

         call states%get_state(state, state_intent, rc=status)
         @assert_that(status, is(0))
         
         call ESMF_StateGet(state, item, f, rc=status)
         @assert_that('Item <'//item//'> not found in child <'//child_name//'>.', status, is(0))

         call ESMF_FieldGet(f, status=field_status, rc=status)
         @assert_that('FieldGet failed? ', status, is(0))

         @assert_that(expected_status == field_status, is(true()))

         rc = 0
      end subroutine check
      
   end subroutine test_state_items_complete


   @test(npes=[0])
   subroutine test_propagate_imports(this)
      class(MpiTestMethod), intent(inout) :: this

      integer :: status
      type(ESMF_GridComp) :: outer_gc

      type(ESMF_Field) :: f

      type(MultiState) :: states

      call setup(outer_gc, states, status)
      @assert_that(status, is(0))

      ! Child A import is unsatisfied, so it should propagate up
      call ESMF_StateGet(states%importState, 'I_A1(1)', f, rc=status)
      @assert_that('Expected unsatisfied import in parent.', status, is(0))
      
   end subroutine test_propagate_imports

end module Test_SimpleParentGridComp