From aaa5364b7fc09023cce9dfebfb91d74904e1de24 Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Tue, 20 Dec 2022 14:05:20 -0500 Subject: [PATCH 01/12] First pass at callback dictionary for mini GCs --- generic/CMakeLists.txt | 4 ++ generic/CallbackMap.F90 | 11 ++++++ generic/ESMF_Interfaces.F90 | 20 ++++++++++ generic/MaplGenericComponent.F90 | 24 ++++++++++++ generic/OpenMP_Support.F90 | 65 +++++++++++++++++++++++++++++++- 5 files changed, 123 insertions(+), 1 deletion(-) create mode 100644 generic/CallbackMap.F90 create mode 100644 generic/ESMF_Interfaces.F90 diff --git a/generic/CMakeLists.txt b/generic/CMakeLists.txt index 04b34fb8f012..fa2fcd2d996b 100644 --- a/generic/CMakeLists.txt +++ b/generic/CMakeLists.txt @@ -50,7 +50,11 @@ set (srcs RunEntryPoint.F90 EntryPointVector.F90 + + CallbackMap.F90 + ESMF_Interfaces.F90 ) + if (BUILD_WITH_PFLOGGER) find_package(PFLOGGER REQUIRED) endif () diff --git a/generic/CallbackMap.F90 b/generic/CallbackMap.F90 new file mode 100644 index 000000000000..a9ba9301507a --- /dev/null +++ b/generic/CallbackMap.F90 @@ -0,0 +1,11 @@ +! This module uses gFTL to construct a map. +module mapl_CallbackMap + + use mapl_ESMF_Interfaces + + ! gftl ... +#define Key __CHARACTER_DEFERRED +#define T CallbackMethodWrapper +#include "map/template.inc" + +end module mapl_CallbackMap diff --git a/generic/ESMF_Interfaces.F90 b/generic/ESMF_Interfaces.F90 new file mode 100644 index 000000000000..ad08d87300c1 --- /dev/null +++ b/generic/ESMF_Interfaces.F90 @@ -0,0 +1,20 @@ +! This module is a collection of abstract interfaces that enforce +! interfaces of user routines that are passed to ESMF. MAPL3 has +! several of these for ... SetServices, GridCompRun, etc. +module mapl_ESMF_Interfaces + public :: I_CallBackMethod + public :: CallbackMethodWrapper + + abstract interface + subroutine I_CallBackMethod(state, rc) + use ESMF + type(ESMF_State), intent(inout) :: state + integer, optional, 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 diff --git a/generic/MaplGenericComponent.F90 b/generic/MaplGenericComponent.F90 index 2d3a379744b9..ff9147c84872 100644 --- a/generic/MaplGenericComponent.F90 +++ b/generic/MaplGenericComponent.F90 @@ -16,11 +16,14 @@ module mapl_MaplGenericComponent use mapl_MaplGrid use mapl_RunEntryPoint use mapl_EntryPointVector + use mapl_ESMF_Interfaces + use mapl_CallbackMap implicit none private public :: MaplGenericComponent public :: get_grid + public :: MAPL_AddMethod procedure(), pointer :: user_method => null() @@ -380,4 +383,25 @@ function get_gridcomp(this) result(gridcomp) end function get_gridcomp + subroutine MAPL_AddMethod(state, label, userRoutine, rc) + type(ESMF_State), intent(inout) :: state + character(*), intent(in) :: label + procedure(I_CallBackMethod) :: userRoutine + integer, optional, intent(out) :: rc + + call ESMF_AddMethod(state, userRoutine, _RC) + + call get_callbacks(state, callbacks, _RC) + call callbacks%insert(label, wrap(userRoutine) + + contains + + function wrap(proc) result(userRoutine) + type(CallbackMethodWrapper) :: wrapper + procedure(I_CallBackMethod) :: userRoutine + wrapper%userRoutine => proc + end function wrap + + end subroutine MAPL_AddMethod + end module mapl_MaplGenericComponent diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index 901dfa3f59d8..fee32ae65f44 100644 --- a/generic/OpenMP_Support.F90 +++ b/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 @@ -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,13 +523,14 @@ 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, name=comp_name, CONFIG=CF, _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),'>' @@ -533,6 +538,7 @@ function make_subgridcomps(GridComp, run_entry_points, num_grids, unusable, rc) associate (gc => subgridcomps(i) ) gc = ESMF_GridCompCreate(name=trim(comp_name), petlist=[myPet], & & contextflag=ESMF_CONTEXT_OWN_VM, _RC) + call ESMF_GridCompSet(gc, CONFIG=CF, _RC) call ESMF_GridCompSetServices(gc, set_services, userrc=user_status, _RC) _VERIFY(user_status) end associate @@ -570,6 +576,63 @@ 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(in ) :: state + type(ESMF_State), intent(inout) :: multi_states(:) + + integer :: n_multi + type(CallbackMethodWrapper) :: wrapper + type(CallbackMap), pointer :: callbacks + + n_multi = size(multi_states) + call get_callbacks(state, callbacks, _RC) + if (associated(callbacks)) then + associate (e => callbacks%end()) + iter = callbacks%begin() + do + wrapper => iter%second() + do i = 1, n_multi + call ESMF_MethodAdd(multi_states(i), iter%first(), wrapper%userRoutine, _RC) + end do + call iter%next() + end do + end associate + end if + + _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 + + type(CallbackMethodWrapper) :: wrapper + integer :: value(:) + + call ESMF_AttributeGet(state, label='MAPL_CALLBACK_MAP', value, rc=status) + if (status /= 0) then ! create callback map for this state + allocate(callbacks) + wrapper%map => callbacks + value = transfer(wrapper, value) + call ESMD_AttributeSet(state, label='MAPL_CALLBACK_MAP', value, _RC) + end if + + call ESMF_AttributeGet(state, label='MAPL_CALLBACK_MAP', value, rc=status) + + wrapper = transfer(value, wrapper) + callbacks => wrapper%map + + _RETURN(ESMF_SUCCESS) + + end subroutine get_callbacks + end module MAPL_OpenMP_Support From 65065b7adf2bf5359fbb34333eb9f4ca6420586b Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Wed, 21 Dec 2022 10:02:10 -0500 Subject: [PATCH 02/12] work in progress --- generic/CMakeLists.txt | 2 +- generic/CallbackMap.F90 | 8 ++++++++ generic/OpenMP_Support.F90 | 14 +++++++++----- 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/generic/CMakeLists.txt b/generic/CMakeLists.txt index fa2fcd2d996b..6e6010a5f00e 100644 --- a/generic/CMakeLists.txt +++ b/generic/CMakeLists.txt @@ -51,8 +51,8 @@ set (srcs RunEntryPoint.F90 EntryPointVector.F90 - CallbackMap.F90 ESMF_Interfaces.F90 + CallbackMap.F90 ) if (BUILD_WITH_PFLOGGER) diff --git a/generic/CallbackMap.F90 b/generic/CallbackMap.F90 index a9ba9301507a..c2692624a154 100644 --- a/generic/CallbackMap.F90 +++ b/generic/CallbackMap.F90 @@ -6,6 +6,14 @@ module mapl_CallbackMap ! gftl ... #define Key __CHARACTER_DEFERRED #define T CallbackMethodWrapper +#define Map CallbackMap +#define MapIterator CallbackMapIterator + #include "map/template.inc" +#undef MapIterator +#undef Map +#undef T +#undef Key + end module mapl_CallbackMap diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index fee32ae65f44..747f50d32927 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -433,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 @@ -582,12 +582,15 @@ end function make_subgridcomps subroutine copy_callbacks(state, multi_states, rc) use mapl_ESMF_Interfaces use mapl_CallbackMap - type(ESMF_State), intent(in ) :: state + type(ESMF_State), intent(inout) :: state type(ESMF_State), intent(inout) :: multi_states(:) + integer, optional, intent(out) :: rc - integer :: n_multi - type(CallbackMethodWrapper) :: wrapper + 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) @@ -615,6 +618,7 @@ subroutine get_callbacks(state, callbacks, rc) type(CallbackMap), pointer, intent(out) :: callbacks integer, optional, intent(out) :: rc + integer :: status type(CallbackMethodWrapper) :: wrapper integer :: value(:) @@ -626,7 +630,7 @@ subroutine get_callbacks(state, callbacks, rc) call ESMD_AttributeSet(state, label='MAPL_CALLBACK_MAP', value, _RC) end if - call ESMF_AttributeGet(state, label='MAPL_CALLBACK_MAP', value, rc=status) + call ESMF_AttributeGet(state, label='MAPL_CALLBACK_MAP', value, _RC) wrapper = transfer(value, wrapper) callbacks => wrapper%map From 4401aed98f8d84b46fb59775e7dcbccedf7886af Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Wed, 21 Dec 2022 11:03:45 -0500 Subject: [PATCH 03/12] ESMF_Interfaces.F90 renamed MAPL_ESMF_Interfaces.F90 --- generic/{ESMF_Interfaces.F90 => MAPL_ESMF_Interfaces.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename generic/{ESMF_Interfaces.F90 => MAPL_ESMF_Interfaces.F90} (100%) diff --git a/generic/ESMF_Interfaces.F90 b/generic/MAPL_ESMF_Interfaces.F90 similarity index 100% rename from generic/ESMF_Interfaces.F90 rename to generic/MAPL_ESMF_Interfaces.F90 From fb1bb65e3da8e30cc4ee0dec697c0abc4d716a99 Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Wed, 21 Dec 2022 10:39:44 -0600 Subject: [PATCH 04/12] Update generic/MaplGenericComponent.F90 Co-authored-by: Tom Clune --- generic/MaplGenericComponent.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/MaplGenericComponent.F90 b/generic/MaplGenericComponent.F90 index ff9147c84872..6681355ebe9c 100644 --- a/generic/MaplGenericComponent.F90 +++ b/generic/MaplGenericComponent.F90 @@ -396,10 +396,10 @@ subroutine MAPL_AddMethod(state, label, userRoutine, rc) contains - function wrap(proc) result(userRoutine) + function wrap(userRoutine) result(wrapper) type(CallbackMethodWrapper) :: wrapper procedure(I_CallBackMethod) :: userRoutine - wrapper%userRoutine => proc + wrapper%userRoutine => userRoutine end function wrap end subroutine MAPL_AddMethod From 4f62ec96bab9a4c0f1dc21c5a049e63eaf6361e3 Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Wed, 21 Dec 2022 13:37:58 -0500 Subject: [PATCH 05/12] working ... --- generic/CMakeLists.txt | 2 +- generic/MaplGenericComponent.F90 | 6 ++---- generic/OpenMP_Support.F90 | 25 +++++++++++-------------- 3 files changed, 14 insertions(+), 19 deletions(-) diff --git a/generic/CMakeLists.txt b/generic/CMakeLists.txt index 6e6010a5f00e..901ec303d3ff 100644 --- a/generic/CMakeLists.txt +++ b/generic/CMakeLists.txt @@ -51,7 +51,7 @@ set (srcs RunEntryPoint.F90 EntryPointVector.F90 - ESMF_Interfaces.F90 + MAPL_ESMF_Interfaces.F90 CallbackMap.F90 ) diff --git a/generic/MaplGenericComponent.F90 b/generic/MaplGenericComponent.F90 index ff9147c84872..2409a2a909ea 100644 --- a/generic/MaplGenericComponent.F90 +++ b/generic/MaplGenericComponent.F90 @@ -25,8 +25,6 @@ module mapl_MaplGenericComponent public :: get_grid public :: MAPL_AddMethod - procedure(), pointer :: user_method => null() - type SubComponent type(ESMF_GridComp) :: gridcomp type(ESMF_State) :: internal_state @@ -396,10 +394,10 @@ subroutine MAPL_AddMethod(state, label, userRoutine, rc) contains - function wrap(proc) result(userRoutine) + function wrap(userRoutine) result(wrapper) type(CallbackMethodWrapper) :: wrapper procedure(I_CallBackMethod) :: userRoutine - wrapper%userRoutine => proc + wrapper%userRoutine => userRoutine end function wrap end subroutine MAPL_AddMethod diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index 747f50d32927..e5a67cba6dfa 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -523,14 +523,13 @@ 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, CONFIG=CF, _RC) + call ESMF_GridCompGet(GridComp, 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),'>' @@ -538,7 +537,6 @@ function make_subgridcomps(GridComp, run_entry_points, num_grids, unusable, rc) associate (gc => subgridcomps(i) ) gc = ESMF_GridCompCreate(name=trim(comp_name), petlist=[myPet], & & contextflag=ESMF_CONTEXT_OWN_VM, _RC) - call ESMF_GridCompSet(gc, CONFIG=CF, _RC) call ESMF_GridCompSetServices(gc, set_services, userrc=user_status, _RC) _VERIFY(user_status) end associate @@ -594,18 +592,17 @@ subroutine copy_callbacks(state, multi_states, rc) n_multi = size(multi_states) call get_callbacks(state, callbacks, _RC) - if (associated(callbacks)) then - associate (e => callbacks%end()) - iter = callbacks%begin() - do - wrapper => iter%second() - do i = 1, n_multi - call ESMF_MethodAdd(multi_states(i), iter%first(), wrapper%userRoutine, _RC) - end do - call iter%next() + _ASSERT(associated(callbacks), 'callbacks must be associated') + associate (e => callbacks%end()) + iter = callbacks%begin() + do + wrapper => iter%second() + do i = 1, n_multi + call ESMF_MethodAdd(multi_states(i), iter%first(), wrapper%userRoutine, _RC) end do - end associate - end if + call iter%next() + end do + end associate _RETURN(ESMF_SUCCESS) From acb2f4f96e95e60552fae4db2878e65b4d60961f Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Thu, 22 Dec 2022 20:27:20 -0500 Subject: [PATCH 06/12] work in progress ... --- generic/CallbackMap.F90 | 4 ++-- generic/MAPL_ESMF_Interfaces.F90 | 10 ++++++---- generic/MAPL_Generic.F90 | 29 +++++++++++++++++++++++++++++ generic/MaplGenericComponent.F90 | 24 ------------------------ generic/OpenMP_Support.F90 | 26 +++++++++++++++++--------- 5 files changed, 54 insertions(+), 39 deletions(-) diff --git a/generic/CallbackMap.F90 b/generic/CallbackMap.F90 index c2692624a154..cf044357d061 100644 --- a/generic/CallbackMap.F90 +++ b/generic/CallbackMap.F90 @@ -1,17 +1,17 @@ -! This module uses gFTL to construct a map. module mapl_CallbackMap use mapl_ESMF_Interfaces - ! gftl ... #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 diff --git a/generic/MAPL_ESMF_Interfaces.F90 b/generic/MAPL_ESMF_Interfaces.F90 index ad08d87300c1..8bf09ecfb260 100644 --- a/generic/MAPL_ESMF_Interfaces.F90 +++ b/generic/MAPL_ESMF_Interfaces.F90 @@ -1,15 +1,17 @@ ! This module is a collection of abstract interfaces that enforce -! interfaces of user routines that are passed to ESMF. MAPL3 has -! several of these for ... SetServices, GridCompRun, etc. +! 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), intent(inout) :: state - integer, optional, intent(out) :: rc + type(ESMF_State) :: state + integer, intent(out) :: rc end subroutine I_CallBackMethod end interface diff --git a/generic/MAPL_Generic.F90 b/generic/MAPL_Generic.F90 index 7c67794be568..ed77a88b2b31 100644 --- a/generic/MAPL_Generic.F90 +++ b/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 diff --git a/generic/MaplGenericComponent.F90 b/generic/MaplGenericComponent.F90 index 2409a2a909ea..e4e554b9b593 100644 --- a/generic/MaplGenericComponent.F90 +++ b/generic/MaplGenericComponent.F90 @@ -16,14 +16,11 @@ module mapl_MaplGenericComponent use mapl_MaplGrid use mapl_RunEntryPoint use mapl_EntryPointVector - use mapl_ESMF_Interfaces - use mapl_CallbackMap implicit none private public :: MaplGenericComponent public :: get_grid - public :: MAPL_AddMethod type SubComponent type(ESMF_GridComp) :: gridcomp @@ -381,25 +378,4 @@ function get_gridcomp(this) result(gridcomp) end function get_gridcomp - subroutine MAPL_AddMethod(state, label, userRoutine, rc) - type(ESMF_State), intent(inout) :: state - character(*), intent(in) :: label - procedure(I_CallBackMethod) :: userRoutine - integer, optional, intent(out) :: rc - - call ESMF_AddMethod(state, userRoutine, _RC) - - call get_callbacks(state, callbacks, _RC) - call callbacks%insert(label, wrap(userRoutine) - - contains - - function wrap(userRoutine) result(wrapper) - type(CallbackMethodWrapper) :: wrapper - procedure(I_CallBackMethod) :: userRoutine - wrapper%userRoutine => userRoutine - end function wrap - - end subroutine MAPL_AddMethod - end module mapl_MaplGenericComponent diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index e5a67cba6dfa..bb1a62c48462 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -598,7 +598,7 @@ subroutine copy_callbacks(state, multi_states, rc) do wrapper => iter%second() do i = 1, n_multi - call ESMF_MethodAdd(multi_states(i), iter%first(), wrapper%userRoutine, _RC) + call ESMF_MethodAdd(multi_states(i), label=iter%first(), userRoutine=wrapper%userRoutine, _RC) end do call iter%next() end do @@ -616,20 +616,28 @@ subroutine get_callbacks(state, callbacks, rc) integer, optional, intent(out) :: rc integer :: status - type(CallbackMethodWrapper) :: wrapper - integer :: value(:) + integer, allocatable :: valueList(:) + logical :: isPresent + integer :: i - call ESMF_AttributeGet(state, label='MAPL_CALLBACK_MAP', value, rc=status) - if (status /= 0) then ! create callback map for this state + 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 - value = transfer(wrapper, value) - call ESMD_AttributeSet(state, label='MAPL_CALLBACK_MAP', value, _RC) + valueList = transfer(wrapper, i) + call ESMF_AttributeSet(state, name='MAPL_CALLBACK_MAP', valueList=valueList, _RC) end if - call ESMF_AttributeGet(state, label='MAPL_CALLBACK_MAP', value, _RC) + ! Ugly hack to decode ESMF attribute as a gFTL map + valueList = transfer(wrapper, i) + call ESMF_AttributeGet(state, name='MAPL_CALLBACK_MAP', valueList=valueList, _RC) - wrapper = transfer(value, wrapper) + wrapper = transfer(valueList, wrapper) callbacks => wrapper%map _RETURN(ESMF_SUCCESS) From 9b6716455ef1ec3ced4e6dad8a3529a8f5404257 Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Wed, 28 Dec 2022 14:57:02 -0500 Subject: [PATCH 07/12] Changes to get callback to work in OpenMP --- generic/OpenMP_Support.F90 | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index bb1a62c48462..2bdfcb44b0e4 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -523,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) @@ -548,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 @@ -593,16 +593,17 @@ subroutine copy_callbacks(state, multi_states, rc) 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 - 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 + if (.not. callbacks%empty()) then + iter = callbacks%begin() + do + 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() + if (iter == callbacks%end()) exit + end do + end if _RETURN(ESMF_SUCCESS) @@ -629,14 +630,15 @@ subroutine get_callbacks(state, callbacks, rc) if (.not. isPresent) then ! create callback map for this state allocate(callbacks) wrapper%map => callbacks - valueList = transfer(wrapper, i) + !valueList = transfer(wrapper, i) + 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, i) + !valueList = transfer(wrapper, i) + valueList = transfer(wrapper, valueList) call ESMF_AttributeGet(state, name='MAPL_CALLBACK_MAP', valueList=valueList, _RC) - wrapper = transfer(valueList, wrapper) callbacks => wrapper%map From 6be38154a2ddf35d38dcbf6ebe1d55089004a2cd Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Tue, 3 Jan 2023 10:11:10 -0500 Subject: [PATCH 08/12] Update generic/OpenMP_Support.F90 Co-authored-by: Tom Clune --- generic/OpenMP_Support.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index 2bdfcb44b0e4..b7da0bec328e 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -617,7 +617,7 @@ subroutine get_callbacks(state, callbacks, rc) integer, optional, intent(out) :: rc integer :: status - integer, allocatable :: valueList(:) + integer(kind=ESMF_KIND_I4), allocatable :: valueList(:) logical :: isPresent integer :: i From 541d0cc4f9a4914864b3bc2d351257db73377c7a Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Tue, 3 Jan 2023 10:15:47 -0500 Subject: [PATCH 09/12] Update generic/OpenMP_Support.F90 Co-authored-by: Tom Clune --- generic/OpenMP_Support.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index b7da0bec328e..87355f51d960 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -630,7 +630,6 @@ subroutine get_callbacks(state, callbacks, rc) if (.not. isPresent) then ! create callback map for this state allocate(callbacks) wrapper%map => callbacks - !valueList = transfer(wrapper, i) valueList = transfer(wrapper, valueList) call ESMF_AttributeSet(state, name='MAPL_CALLBACK_MAP', valueList=valueList, _RC) end if From b96852d1b373c3b9d21f75361bbbdb8c7165fee9 Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Tue, 3 Jan 2023 10:15:59 -0500 Subject: [PATCH 10/12] Update generic/OpenMP_Support.F90 Co-authored-by: Tom Clune --- generic/OpenMP_Support.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index 87355f51d960..6efa6f2f5b2c 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -635,7 +635,6 @@ subroutine get_callbacks(state, callbacks, rc) end if ! Ugly hack to decode ESMF attribute as a gFTL map - !valueList = transfer(wrapper, i) valueList = transfer(wrapper, valueList) call ESMF_AttributeGet(state, name='MAPL_CALLBACK_MAP', valueList=valueList, _RC) wrapper = transfer(valueList, wrapper) From 04427ad7ea7ffaad4b0900f797427423422a79a1 Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Tue, 3 Jan 2023 10:16:45 -0500 Subject: [PATCH 11/12] Update generic/OpenMP_Support.F90 Co-authored-by: Tom Clune --- generic/OpenMP_Support.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index 6efa6f2f5b2c..c8ae3ee7d856 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -593,17 +593,16 @@ subroutine copy_callbacks(state, multi_states, rc) n_multi = size(multi_states) call get_callbacks(state, callbacks, _RC) _ASSERT(associated(callbacks), 'callbacks must be associated') - if (.not. callbacks%empty()) then + associate( e => callbacks%end()) iter = callbacks%begin() - do + 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() - if (iter == callbacks%end()) exit end do - end if + end associate _RETURN(ESMF_SUCCESS) From 478c44e45ce48f83520354ca7b01e93ddfe0f072 Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Wed, 4 Jan 2023 10:53:48 -0500 Subject: [PATCH 12/12] Modified CHANGELOG to account for changes made for OpenMP for 'callback' procedures --- CHANGELOG.md | 5 +++++ generic/OpenMP_Support.F90 | 1 - 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 68cb55bb41a4..896a4b318cb2 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index c8ae3ee7d856..329559994cdd 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -618,7 +618,6 @@ subroutine get_callbacks(state, callbacks, rc) integer :: status integer(kind=ESMF_KIND_I4), allocatable :: valueList(:) logical :: isPresent - integer :: i type CallbackMapWrapper type(CallbackMap), pointer :: map