Merge pull request #1889 from GEOS-ESM/feature/aoloso/merge_v10.23.0_…

…MSTRF_GWD_hybrid

Extend OMP layer to support ESMF callback states

CHANGELOG.md

@@ -7,6 +7,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+### Added
+- Added subroutine MAPL_MethodAdd to MAPL_Generic.F90
+- Added subrutines get_callbacks and copy_callbacks to OpenMP_Support.F90
+- These added subroutines are to support "callback" procedures when inside OpenMP parallel region  for mini states for component level threading.
+
 ### Added
 
 - Added `MAPL_find_bounds => find_bounds` and `MAPL_Interval => Interval` to `MAPL.F90` for use when doing component level OpenMP

generic/CMakeLists.txt

@@ -50,7 +50,11 @@ set (srcs
 
   RunEntryPoint.F90
   EntryPointVector.F90
+
+  MAPL_ESMF_Interfaces.F90
+  CallbackMap.F90
   )
+
 if (BUILD_WITH_PFLOGGER)
   find_package(PFLOGGER REQUIRED)
 endif ()

generic/CallbackMap.F90

@@ -0,0 +1,19 @@
+module mapl_CallbackMap
+
+   use mapl_ESMF_Interfaces
+
+#define Key __CHARACTER_DEFERRED
+#define T CallbackMethodWrapper
+#define Map CallbackMap
+#define Pair CallbackPair
+#define MapIterator CallbackMapIterator
+
+#include "map/template.inc"
+
+#undef MapIterator
+#undef Pair
+#undef Map
+#undef T
+#undef Key
+
+end module mapl_CallbackMap

generic/MAPL_ESMF_Interfaces.F90

@@ -0,0 +1,22 @@
+! This module is a collection of abstract interfaces that enforce
+! interfaces of user routines that are passed to ESMF.
+
+module mapl_ESMF_Interfaces
+   implicit none
+   private ! except
+   public :: I_CallBackMethod
+   public :: CallbackMethodWrapper
+
+   abstract interface
+      subroutine I_CallBackMethod(state, rc)
+         use ESMF
+         type(ESMF_State) :: state
+         integer, intent(out) :: rc
+      end subroutine I_CallBackMethod
+   end interface
+
+   type CallbackMethodWrapper
+      procedure(I_CallBackMethod), pointer, nopass :: userRoutine
+   end type CallbackMethodWrapper
+
+end module mapl_ESMF_Interfaces

generic/MAPL_Generic.F90

@@ -224,6 +224,7 @@ module MAPL_GenericMod
    public MAPL_GenericStateRestore
    public MAPL_RootGcRetrieve
    public MAPL_AddAttributeToFields
+   public MAPL_MethodAdd
 
    !BOP
    ! !PUBLIC TYPES:
@@ -11547,4 +11548,32 @@ recursive subroutine MAPL_AddAttributeToFields_I4(gc,field_name,att_name,att_val
       _RETURN(_SUCCESS)
    end subroutine MAPL_AddAttributeToFields_I4
 
+   subroutine MAPL_MethodAdd(state, label, userRoutine, rc)
+      use mapl_ESMF_Interfaces
+      use mapl_CallbackMap
+      use mapl_OpenMP_Support, only : get_callbacks
+      type(ESMF_State), intent(inout) :: state
+      character(*), intent(in) :: label
+      procedure(I_CallBackMethod) :: userRoutine
+      integer, optional, intent(out) :: rc
+
+      integer :: status
+      type(CallbackMap), pointer :: callbacks
+
+      call ESMF_MethodAdd(state, label=label, userRoutine=userRoutine, _RC)
+
+      call get_callbacks(state, callbacks, _RC)
+      call callbacks%insert(label, wrap(userRoutine))
+
+      _RETURN(ESMF_SUCCESS)
+   contains
+
+      function wrap(userRoutine) result(wrapper)
+         type(CallbackMethodWrapper) :: wrapper
+         procedure(I_CallBackMethod) :: userRoutine
+         wrapper%userRoutine => userRoutine
+      end function wrap
+
+   end subroutine MAPL_MethodAdd
+
 end module MAPL_GenericMod

generic/MaplGenericComponent.F90

@@ -22,8 +22,6 @@ module mapl_MaplGenericComponent
    public :: MaplGenericComponent
    public :: get_grid
 
-   procedure(), pointer :: user_method => null()
-
    type SubComponent
       type(ESMF_GridComp) :: gridcomp
       type(ESMF_State) :: internal_state

generic/OpenMP_Support.F90

@@ -21,6 +21,7 @@ module MAPL_OpenMP_Support
     public :: subset_array
     public :: get_current_thread
     public :: get_num_threads
+    public :: get_callbacks
 
     type :: Interval
         integer :: min
@@ -432,7 +433,7 @@ end function make_subFieldBundles_ordinary
 
     recursive function make_substates_from_num_grids(state, num_subgrids, unusable, rc) result(substates)
       type(ESMF_State), allocatable :: substates(:)
-      type(ESMF_State), intent(in) :: state
+      type(ESMF_State), intent(inout) :: state
       integer, intent(in) :: num_subgrids
       class(KeywordEnforcer), optional, intent(in) :: unusable
       integer, optional, intent(out) :: rc
@@ -491,6 +492,9 @@ recursive function make_substates_from_num_grids(state, num_subgrids, unusable,
             end do
          end if
       end do
+
+      call copy_callbacks(state, substates, _RC)
+
       _RETURN(0)
     end function make_substates_from_num_grids
 
@@ -519,19 +523,20 @@ function make_subgridcomps(GridComp, run_entry_points, num_grids, unusable, rc)
         character(len=ESMF_MAXSTR) :: comp_name
         character(len=:), allocatable :: labels(:)
         integer :: phase
+        type(ESMF_Config) :: CF
 
         allocate(subgridcomps(num_grids))
 
         call ESMF_VMGetCurrent(vm, _RC)
         call ESMF_VMGet(vm, localPET=myPET, _RC)
 
-        call ESMF_GridCompGet(GridComp, name=comp_name, _RC)
+        call ESMF_GridCompGet(GridComp, config=CF, name=comp_name, _RC)
         call ESMF_InternalStateGet(GridComp, labelList=labels, _RC)
         if(myPET==0) print*,__FILE__,__LINE__, 'internal states labels : <',trim(comp_name), (trim(labels(i)),i=1,size(labels)), '>'
         print*,__FILE__,__LINE__, 'splitting component: <',trim(comp_name),'>'
         do i = 1, num_grids
           associate (gc => subgridcomps(i) )
-            gc = ESMF_GridCompCreate(name=trim(comp_name), petlist=[myPet], &
+            gc = ESMF_GridCompCreate(name=trim(comp_name), config=CF, petlist=[myPet], &
                  & contextflag=ESMF_CONTEXT_OWN_VM, _RC)
             call ESMF_GridCompSetServices(gc, set_services, userrc=user_status, _RC)
             _VERIFY(user_status)
@@ -544,7 +549,6 @@ function make_subgridcomps(GridComp, run_entry_points, num_grids, unusable, rc)
            do i = 1, num_grids
               associate (gc => subgridcomps(i) )
                 if (has_private_state) then
-                   !print *, __FILE__, __LINE__, myPET, ilabel, i, trim(comp_name), trim(labels(ilabel)), has_private_state
                    call ESMF_UserCompSetInternalState(gc, trim(labels(ilabel)), wrap, status)
                    _VERIFY(status)
                 end if
@@ -570,6 +574,72 @@ subroutine set_services(gc, rc)
             end do
            _RETURN(ESMF_SUCCESS)
         end subroutine set_services
+
     end function make_subgridcomps
 
+    subroutine copy_callbacks(state, multi_states, rc)
+       use mapl_ESMF_Interfaces
+       use mapl_CallbackMap
+       type(ESMF_State), intent(inout) :: state
+       type(ESMF_State), intent(inout) :: multi_states(:)
+       integer, optional, intent(out) :: rc
+
+       integer :: n_multi, i
+       integer :: status
+       type(CallbackMethodWrapper), pointer :: wrapper
+       type(CallbackMap), pointer :: callbacks
+       type(CallbackMapIterator) :: iter
+
+       n_multi = size(multi_states)
+       call get_callbacks(state, callbacks, _RC)
+       _ASSERT(associated(callbacks), 'callbacks must be associated')
+       associate( e => callbacks%end())
+          iter = callbacks%begin()
+          do while (iter /= e)
+             wrapper => iter%second()
+             do i = 1, n_multi
+                call ESMF_MethodAdd(multi_states(i), label=iter%first(), userRoutine=wrapper%userRoutine, _RC)
+             end do
+             call iter%next()
+          end do
+       end associate
+
+       _RETURN(ESMF_SUCCESS)
+
+    end subroutine copy_callbacks
+
+    subroutine get_callbacks(state, callbacks, rc)
+       use mapl_ESMF_Interfaces
+       use mapl_CallbackMap
+       type(ESMF_State), intent(inout) :: state
+       type(CallbackMap), pointer, intent(out) :: callbacks
+       integer, optional, intent(out) :: rc
+
+       integer :: status
+       integer(kind=ESMF_KIND_I4), allocatable :: valueList(:)
+       logical :: isPresent
+
+       type CallbackMapWrapper
+          type(CallbackMap), pointer :: map
+       end type
+       type(CallbackMapWrapper) :: wrapper
+
+       call ESMF_AttributeGet(state, name='MAPL_CALLBACK_MAP', isPresent=isPresent, _RC)
+       if (.not. isPresent) then ! create callback map for this state
+          allocate(callbacks)
+          wrapper%map => callbacks
+          valueList = transfer(wrapper, valueList)
+          call ESMF_AttributeSet(state, name='MAPL_CALLBACK_MAP', valueList=valueList, _RC)
+       end if
+
+       ! Ugly hack to decode ESMF attribute as a gFTL map
+       valueList = transfer(wrapper, valueList)
+       call ESMF_AttributeGet(state, name='MAPL_CALLBACK_MAP', valueList=valueList, _RC)
+       wrapper = transfer(valueList, wrapper)
+       callbacks => wrapper%map
+
+       _RETURN(ESMF_SUCCESS)
+
+    end subroutine get_callbacks
+
 end module MAPL_OpenMP_Support