#include "MAPL_Exceptions.h" #include "MAPL_ErrLog.h" module mapl_MaplGenericComponent use ESMF use mapl_AbstractFrameworkComponent use mapl_BaseFrameworkComponent use mapl_keywordenforcermod use mapl_AbstractComponent use mapl_CompositeComponent use mapl_ConcreteComposite use mapl_MaplComponent use mapl_ErrorHandlingMod use pFlogger use mapl_OpenMP_Support use mapl_MaplGrid use mapl_RunEntryPoint use mapl_EntryPointVector implicit none private public :: MaplGenericComponent public :: get_grid type SubComponent type(ESMF_GridComp) :: gridcomp type(ESMF_State) :: internal_state type(ESMF_State) :: import_state type(ESMF_State) :: export_state type(MaplGrid) :: grid end type SubComponent abstract interface subroutine UserMethod(gc, import, export, clock, rc) use ESMF implicit none type (ESMF_GridComp), intent(inout) :: gc ! Gridded component type (ESMF_State), intent(inout) :: import ! Import state type (ESMF_State), intent(inout) :: export ! Export state type (ESMF_Clock), intent(inout) :: clock ! The clock integer, optional, intent( out) :: rc ! Error code: end subroutine UserMethod end interface type, extends(BaseFrameworkComponent) :: MaplGenericComponent !!$ private type(ESMF_GridComp) :: gridcomp type(SubComponent), allocatable :: subcomponents(:) type(EntryPointVector) :: run_entry_points type(ESMF_State) :: import_state type(ESMF_State) :: export_state type(ESMF_State) :: internal_state logical :: threading_active = .FALSE. logical :: use_threads = .FALSE. contains procedure :: initialize => stub procedure :: run => stub procedure :: finalize => stub procedure :: initialize_child => stub_child procedure :: run_child => stub_child procedure :: finalize_child => stub_child procedure :: add_child_component procedure :: activate_threading procedure :: deactivate_threading procedure :: create_subobjects ! accessors procedure :: get_logger procedure :: set_logger procedure :: set_use_threads procedure :: get_use_threads procedure :: is_threading_active procedure :: get_internal_state procedure :: get_import_state procedure :: get_export_state procedure :: get_grid procedure :: get_gridcomp end type MaplGenericComponent contains subroutine stub(this, clock, phase, unusable, rc) class(MaplGenericComponent), intent(inout) :: this type(ESMF_Clock), intent(inout) :: clock character(*), intent(in) :: phase class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc integer :: status class(AbstractComponent), pointer :: user_component _UNUSED_DUMMY(unusable) user_component => this%get_component() call user_component%run(this%import_state, this%export_state, clock, phase, _RC) _RETURN(_SUCCESS) end subroutine stub subroutine stub_child(this, name, clock, phase, unusable, rc) class(MaplGenericComponent), intent(inout) :: this character(*), intent(in) :: name type(ESMF_Clock), intent(inout) :: clock character(*), intent(in) :: phase class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc class(AbstractFrameworkComponent), pointer :: child integer :: status _UNUSED_DUMMY(unusable) child => this%get_child(name) call child%run(clock, phase, _RC) _RETURN(_SUCCESS) end subroutine stub_child function add_child_component(this, name, user_component) result(child) class(AbstractFrameworkComponent), pointer :: child class(MaplGenericComponent), target, intent(inout) :: this character(*), intent(in) :: name class(AbstractComponent), intent(in) :: user_component type(MaplGenericComponent) :: tmp child => this%add_child(name, tmp) call child%set_component(user_component) end function add_child_component subroutine generic_entry_point(gridcomp, import, export, clock, rc) type(ESMF_GridComp), intent(inout) :: gridcomp type(ESMF_State), intent(inout) :: import type(ESMF_State), intent(inout) :: export type(ESMF_Clock), intent(inout) :: clock integer, optional, intent(out) :: rc character(len=ESMF_MAXSTR) :: name integer :: phase type(ESMF_Method_Flag) :: method integer :: status class(MaplComponent), pointer :: component type :: ComponentWrapper class(MaplComponent), pointer :: component end type ComponentWrapper type(ComponentWrapper) :: wrapper character(:), pointer :: phase_name call ESMF_UserCompGetInternalState(gridcomp, "MaplComponent", wrapper, status) _VERIFY(status) component => wrapper%component call ESMF_GridCompGet( gridcomp, name=name, currentPhase=phase, currentMethod=method, _RC) if (method == ESMF_METHOD_INITIALIZE) then !!$ phase_name => component%init_phase_map%at(phase) !!$ _ASSERT(associated(phase_name),'no such phase') call component%initialize(import, export, clock, phase_name, _RC) else if (method == ESMF_METHOD_RUN) then !!$ phase_name = component%run_phase_map%at(phase) !!$ _ASSERT(associated(phase_name),'no such phase') call component%run(import, export, clock, phase_name, _RC) else if (method == ESMF_METHOD_FINALIZE) then !!$ phase_name = component%finalize_phase_map%at(phase) !!$ _ASSERT(associated(phase_name),'no such phase') call component%finalize(import, export, clock, phase_name, _RC) else _FAIL('unknown value for ESMF_METHOD_FLAG') end if _RETURN(_SUCCESS) end subroutine generic_entry_point function get_logger(this) result(lgr) class(Logger), pointer :: lgr class(MaplGenericComponent), intent(in) :: this class(AbstractComponent), pointer :: component component => this%get_component() lgr => component%get_logger() end function get_logger subroutine set_logger(this, lgr) class(MaplGenericComponent), intent(inout) :: this class(Logger), target :: lgr class(AbstractComponent), pointer :: component component => this%get_component() call component%set_logger(lgr) end subroutine set_logger subroutine set_use_threads(this, use_threads) class(MaplGenericComponent), intent(inout) :: this logical, intent(in) :: use_threads this%use_threads = use_threads end subroutine set_use_threads function get_use_threads(this) result(use_threads) class(MaplGenericComponent), intent(in) :: this logical :: use_threads use_threads = this%use_threads end function get_use_threads function is_threading_active(this) result(threading_active) class(MaplGenericComponent), intent(in) :: this logical :: threading_active threading_active = this%threading_active end function is_threading_active function get_internal_state(this) result(internal_state) class(MaplGenericComponent), target, intent(in) :: this type(ESMF_State), pointer :: internal_state integer :: thread if (.NOT. this%is_threading_active()) then internal_state => this%internal_state else thread = get_current_thread() internal_state => this%subcomponents(thread+1)%internal_state end if end function get_internal_state function get_import_state(this) result(import_state) class(MaplGenericComponent), target, intent(in) :: this type(ESMF_State), pointer :: import_state integer :: thread if (.NOT. this%is_threading_active()) then import_state => this%import_state else thread = get_current_thread() import_state => this%subcomponents(thread+1)%import_state end if end function get_import_state function get_export_state(this) result(export_state) class(MaplGenericComponent), target, intent(in) :: this type(ESMF_State), pointer :: export_state integer :: thread if (.NOT. this%is_threading_active()) then export_state => this%export_state else thread = get_current_thread() export_state => this%subcomponents(thread+1)%export_state end if end function get_export_state function get_grid(this) result(grid) class(MaplGenericComponent), target, intent(in) :: this type(MaplGrid), pointer :: grid integer :: thread if (.NOT. this%is_threading_active()) then grid => this%grid else thread = get_current_thread() grid => this%subcomponents(thread+1)%grid ! subgrids is of type ESMF_Grid because of the return type of make_subgrids end if end function get_grid recursive subroutine activate_threading(this, num_threads, unusable, rc) class(MaplGenericComponent), intent(inout) :: this integer, intent(in) :: num_threads class(KeywordEnforcer), optional :: unusable integer, optional, intent(out) :: rc class(AbstractFrameworkComponent), pointer :: child integer :: num_children, i, status this%threading_active = .TRUE. num_children = this%get_num_children() if (.NOT. allocated(this%subcomponents)) then call this%create_subobjects(num_threads, _RC) end if do i = 1, num_children child => this%get_child(i) select type (child) class is (MaplGenericComponent) call child%activate_threading(num_threads) class default _FAIL('illegal type for child') end select end do _RETURN(0) _UNUSED_DUMMY(unusable) end subroutine activate_threading subroutine create_subobjects(this, num_threads, unusable, rc) class(MaplGenericComponent), intent(inout) :: this integer, intent(in) :: num_threads class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc integer :: i, status type(ESMF_Grid), allocatable :: subgrids(:) allocate(this%subcomponents(num_threads)) this%subcomponents(:)%import_state = make_substates(this%import_state, num_threads, _RC) this%subcomponents(:)%export_state = make_substates(this%export_state, num_threads, _RC) this%subcomponents(:)%internal_state = make_substates(this%internal_state, num_threads, _RC) subgrids = make_subgrids(this%grid%ESMFGrid, num_threads, _RC) ! make_subgrids requires grid of type ESMF_Grid do i = 1, size(subgrids) call this%subcomponents(i)%grid%set(subgrids(i), _RC) end do deallocate(subgrids) this%subcomponents(:)%gridcomp = make_subgridcomps(this%gridcomp, this%run_entry_points, num_threads, _RC) _RETURN(0) _UNUSED_DUMMY(unusable) end subroutine create_subobjects recursive subroutine deactivate_threading(this, unusable, rc) class(MaplGenericComponent), intent(inout) :: this class(KeywordEnforcer), optional :: unusable integer, optional, intent(out) :: rc class(AbstractFrameworkComponent), pointer :: child integer :: num_children, i num_children = this%get_num_children() do i = 1, num_children child => this%get_child(i) select type (child) class is (MaplGenericComponent) call child%deactivate_threading() class default _FAIL('illegal type for child') end select end do this%threading_active = .FALSE. _RETURN(0) _UNUSED_DUMMY(unusable) end subroutine deactivate_threading function get_gridcomp(this) result(gridcomp) class(MaplGenericComponent), target, intent(in) :: this type(ESMF_GridComp), pointer :: gridcomp integer :: thread if (.NOT. this%is_threading_active()) then gridcomp => this%gridcomp else thread = get_current_thread() gridcomp => this%subcomponents(thread+1)%gridcomp end if end function get_gridcomp end module mapl_MaplGenericComponent