MAPL_MetaComp Derived Type

type, public, extends(MaplGenericComponent) :: MAPL_MetaComp


Inherits

type~~mapl_metacomp~~InheritsGraph type~mapl_metacomp MAPL_MetaComp ESMF_Alarm ESMF_Alarm type~mapl_metacomp->ESMF_Alarm ALARM ESMF_Clock ESMF_Clock type~mapl_metacomp->ESMF_Clock CLOCK ESMF_Config ESMF_Config type~mapl_metacomp->ESMF_Config CF ESMF_CplComp ESMF_CplComp type~mapl_metacomp->ESMF_CplComp CCS ESMF_GridComp ESMF_GridComp type~mapl_metacomp->ESMF_GridComp RootGC, parentGC ESMF_State ESMF_State type~mapl_metacomp->ESMF_State CIM, CEX, FORCING type~distributedprofiler DistributedProfiler type~mapl_metacomp->type~distributedprofiler t_profiler type~mapl_connectivity MAPL_Connectivity type~mapl_metacomp->type~mapl_connectivity connectList type~mapl_genericrecordtype MAPL_GenericRecordType type~mapl_metacomp->type~mapl_genericrecordtype RECORD type~mapl_initialstate MAPL_InitialState type~mapl_metacomp->type~mapl_initialstate initial_state type~mapl_link MAPL_Link type~mapl_metacomp->type~mapl_link LINK type~mapl_locstream MAPL_LocStream type~mapl_metacomp->type~mapl_locstream ExchangeGrid, LOCSTREAM type~mapl_sunorbit MAPL_SunOrbit type~mapl_metacomp->type~mapl_sunorbit ORBIT type~maplgenericcomponent MaplGenericComponent type~mapl_metacomp->type~maplgenericcomponent type~providedserviceitemvector providedServiceItemVector type~mapl_metacomp->type~providedserviceitemvector provided_services type~requestedserviceitemvector requestedServiceItemVector type~mapl_metacomp->type~requestedserviceitemvector requested_services type~abstractgauge AbstractGauge type~distributedprofiler->type~abstractgauge gauge type~baseprofiler BaseProfiler type~distributedprofiler->type~baseprofiler type~serviceconnectionitemvector serviceConnectionItemVector type~mapl_connectivity->type~serviceconnectionitemvector ServiceConnectionItems type~varconn VarConn type~mapl_connectivity->type~varconn CONNECT, DONOTCONN type~mapl_genericrecordtype->ESMF_Alarm ALARM type~mapl_linkform MAPL_LinkForm type~mapl_link->type~mapl_linkform PTR type~mapl_locstreamtype MAPL_LocStreamType type~mapl_locstream->type~mapl_locstreamtype Ptr type~mapl_sunorbit->ESMF_Clock CLOCK ESMF_Time ESMF_Time type~mapl_sunorbit->ESMF_Time ORB2B_TIME_REF, ORB2B_TIME_EQUINOX, ORB2B_TIME_PERI type~maplgenericcomponent->ESMF_GridComp gridcomp type~maplgenericcomponent->ESMF_State import_state, export_state, internal_state type~baseframeworkcomponent BaseFrameworkComponent type~maplgenericcomponent->type~baseframeworkcomponent type~entrypointvector entryPointVector type~maplgenericcomponent->type~entrypointvector run_entry_points type~subcomponent SubComponent type~maplgenericcomponent->type~subcomponent subcomponents type~v_wrapper~4 v_Wrapper type~providedserviceitemvector->type~v_wrapper~4 elements type~v_wrapper~5 v_Wrapper type~requestedserviceitemvector->type~v_wrapper~5 elements

Inherited by

type~~mapl_metacomp~~InheritedByGraph type~mapl_metacomp MAPL_MetaComp type~historytrajectory HistoryTrajectory type~historytrajectory->type~mapl_metacomp GENSTATE type~masksamplergeosat MaskSamplerGeosat type~masksamplergeosat->type~mapl_metacomp GENSTATE type~stationsampler StationSampler type~stationsampler->type~mapl_metacomp GENSTATE type~historycollection~2 HistoryCollection type~historycollection~2->type~historytrajectory trajectory type~historycollection~2->type~masksamplergeosat mask_sampler type~historycollection~2->type~stationsampler station_sampler type~historycollectionvectoriterator~2 HistoryCollectionVectorIterator type~historycollectionvectoriterator~2->type~historycollection~2 elements type~historycollectionvectorriterator~2 HistoryCollectionVectorRIterator type~historycollectionvectorriterator~2->type~historycollection~2 elements type~historycollectionvector~2 HistoryCollectionVector type~historycollectionvector~2->type~historycollection~2 elements

Components

Type Visibility Attributes Name Initial
character(len=:), public, allocatable :: full_name
character(len=ESMF_MAXSTR), public :: COMPNAME
character(len=ESMF_MAXSTR), public, allocatable :: GCNameList(:)
integer, public :: ALARMLAST = 0
integer, public, pointer :: phase_coldstart(:) => null()
integer, public, pointer :: phase_final(:) => null()
integer, public, pointer :: phase_init(:) => null()
integer, public, pointer :: phase_record(:) => null()
integer, public, pointer :: phase_run(:) => null()
logical, public, pointer :: CCcreated(:,:) => null()
logical, public :: ChildInit = .true.
logical, public :: threading_active = .FALSE.
logical, public :: use_threads = .FALSE.
real, public :: HEARTBEAT
type(ESMF_Alarm), public :: ALARM(0:LAST_ALARM)
type(ESMF_Clock), public :: CLOCK
type(ESMF_Config), public :: CF
type(ESMF_CplComp), public, pointer :: CCS(:,:) => null()
type(ESMF_GridComp), public :: RootGC
type(ESMF_GridComp), public :: gridcomp
type(ESMF_GridComp), public, pointer :: parentGC => null()
type(ESMF_State), public, pointer :: CEX(:,:) => null()
type(ESMF_State), public, pointer :: CIM(:,:) => null()
type(ESMF_State), public :: FORCING
type(ESMF_State), public :: export_state
type(ESMF_State), public :: import_state
type(ESMF_State), public :: internal_state
class(AbstractComponent), public, allocatable :: component
type(ComponentSpecification), public :: component_spec
class(ConcreteComposite), public, pointer :: composite => null()
type(DistributedProfiler), public :: t_profiler
type(MAPL_Connectivity), public :: connectList
type(MAPL_GenericRecordType), public, pointer :: RECORD => null()
type(MAPL_InitialState), public :: initial_state
type(MAPL_Link), public, pointer :: LINK(:) => null()
type(MAPL_LocStream), public :: ExchangeGrid
type(MAPL_LocStream), public :: LOCSTREAM
type(MAPL_SunOrbit), public :: ORBIT
type(MaplGrid), public :: grid
type(SubComponent), public, allocatable :: subcomponents(:)
type(entryPointVector), public :: run_entry_points
type(providedServiceItemVector), public :: provided_services
type(requestedServiceItemVector), public :: requested_services

Type-Bound Procedures

procedure, public :: activate_threading

  • private recursive subroutine activate_threading(this, num_threads, unusable, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    integer, intent(in) :: num_threads
    class(KeywordEnforcer), optional :: unusable
    integer, intent(out), optional :: rc

procedure, public :: add_child

procedure, public :: add_child_component

  • private function add_child_component(this, name, user_component) result(child)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout), target :: this
    character(len=*), intent(in) :: name
    class(AbstractComponent), intent(in) :: user_component

    Return Value class(AbstractFrameworkComponent), pointer

procedure, public :: create_subobjects

  • private subroutine create_subobjects(this, num_threads, unusable, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    integer, intent(in) :: num_threads
    class(KeywordEnforcer), intent(in), optional :: unusable
    integer, intent(out), optional :: rc

procedure, public :: deactivate_threading

  • private recursive subroutine deactivate_threading(this, unusable, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    class(KeywordEnforcer), optional :: unusable
    integer, intent(out), optional :: rc

procedure, public :: finalize => stub

  • private subroutine stub(this, clock, phase, unusable, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    type(ESMF_Clock), intent(inout) :: clock
    character(len=*), intent(in) :: phase
    class(KeywordEnforcer), intent(in), optional :: unusable
    integer, intent(out), optional :: rc

procedure, public :: finalize_child => stub_child

  • private subroutine stub_child(this, name, clock, phase, unusable, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    character(len=*), intent(in) :: name
    type(ESMF_Clock), intent(inout) :: clock
    character(len=*), intent(in) :: phase
    class(KeywordEnforcer), intent(in), optional :: unusable
    integer, intent(out), optional :: rc

generic, public :: get_child => get_child_by_name, get_child_by_index

  • private function get_child_by_name(this, name) result(child)

    Arguments

    Type IntentOptional Attributes Name
    class(CompositeComponent), intent(in) :: this
    character(len=*), intent(in) :: name

    Return Value class(AbstractFrameworkComponent), pointer

  • private function get_child_by_index(this, i) result(child)

    Arguments

    Type IntentOptional Attributes Name
    class(CompositeComponent), intent(in) :: this
    integer, intent(in) :: i

    Return Value class(AbstractFrameworkComponent), pointer

procedure, public :: get_child_by_index

  • private function get_child_by_index(this, i) result(child)

    Arguments

    Type IntentOptional Attributes Name
    class(CompositeComponent), intent(in) :: this
    integer, intent(in) :: i

    Return Value class(AbstractFrameworkComponent), pointer

procedure, public :: get_child_by_name

  • private function get_child_by_name(this, name) result(child)

    Arguments

    Type IntentOptional Attributes Name
    class(CompositeComponent), intent(in) :: this
    character(len=*), intent(in) :: name

    Return Value class(AbstractFrameworkComponent), pointer

procedure, public :: get_child_export_state

  • private function get_child_export_state(this, i) result(state)

    Arguments

    Type IntentOptional Attributes Name
    class(MAPL_MetaComp), intent(in), target :: this
    integer, intent(in) :: i

    Return Value type(ESMF_State), pointer

procedure, public :: get_child_gridcomp

  • private function get_child_gridcomp(this, i) result(gridcomp)

    Arguments

    Type IntentOptional Attributes Name
    class(MAPL_MetaComp), intent(in), target :: this
    integer, intent(in) :: i

    Return Value type(ESMF_GridComp), pointer

procedure, public :: get_child_idx

  • private function get_child_idx(this, child_name) result(idx)

    Arguments

    Type IntentOptional Attributes Name
    class(MAPL_MetaComp), intent(in), target :: this
    character(len=*), intent(in) :: child_name

    Return Value integer

procedure, public :: get_child_import_state

  • private function get_child_import_state(this, i) result(state)

    Arguments

    Type IntentOptional Attributes Name
    class(MAPL_MetaComp), intent(in), target :: this
    integer, intent(in) :: i

    Return Value type(ESMF_State), pointer

procedure, public :: get_child_internal_state

  • private function get_child_internal_state(this, i) result(state)

    Arguments

    Type IntentOptional Attributes Name
    class(MAPL_MetaComp), target :: this
    integer, intent(in) :: i

    Return Value type(ESMF_State), pointer

procedure, public :: get_component

  • private function get_component(this) result(component)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseFrameworkComponent), intent(in), target :: this

    Return Value class(AbstractComponent), pointer

procedure, public :: get_composite

  • private function get_composite(this) result(composite)

    Arguments

    Type IntentOptional Attributes Name
    class(CompositeComponent), intent(in), target :: this

    Return Value class(AbstractComposite), pointer

procedure, public :: get_export_state

  • private function get_export_state(this) result(export_state)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(in), target :: this

    Return Value type(ESMF_State), pointer

procedure, public :: get_grid

  • public function get_grid(this) result(grid)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(in), target :: this

    Return Value type(MaplGrid), pointer

procedure, public :: get_gridcomp

  • private function get_gridcomp(this) result(gridcomp)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(in), target :: this

    Return Value type(ESMF_GridComp), pointer

procedure, public :: get_import_state

  • private function get_import_state(this) result(import_state)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(in), target :: this

    Return Value type(ESMF_State), pointer

procedure, public :: get_internal_state

  • private function get_internal_state(this) result(internal_state)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(in), target :: this

    Return Value type(ESMF_State), pointer

procedure, public :: get_ith_child

  • private function get_ith_child(this, i) result(child)

    Arguments

    Type IntentOptional Attributes Name
    class(MAPL_MetaComp), intent(in), target :: this
    integer, intent(in) :: i

    Return Value class(MaplGenericComponent), pointer

procedure, public :: get_logger

  • private function get_logger(this) result(lgr)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(in) :: this

    Return Value class(Logger), pointer

procedure, public :: get_num_children

  • private function get_num_children(this) result(num_children)

    Arguments

    Type IntentOptional Attributes Name
    class(CompositeComponent), intent(in) :: this

    Return Value integer

procedure, public :: get_parent

procedure, public :: get_use_threads

  • private function get_use_threads(this) result(use_threads)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(in) :: this

    Return Value logical

procedure, public :: initialize => stub

  • private subroutine stub(this, clock, phase, unusable, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    type(ESMF_Clock), intent(inout) :: clock
    character(len=*), intent(in) :: phase
    class(KeywordEnforcer), intent(in), optional :: unusable
    integer, intent(out), optional :: rc

procedure, public :: initialize_child => stub_child

  • private subroutine stub_child(this, name, clock, phase, unusable, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    character(len=*), intent(in) :: name
    type(ESMF_Clock), intent(inout) :: clock
    character(len=*), intent(in) :: phase
    class(KeywordEnforcer), intent(in), optional :: unusable
    integer, intent(out), optional :: rc

procedure, public :: is_threading_active

  • private function is_threading_active(this) result(threading_active)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(in) :: this

    Return Value logical

procedure, public :: run => stub

  • private subroutine stub(this, clock, phase, unusable, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    type(ESMF_Clock), intent(inout) :: clock
    character(len=*), intent(in) :: phase
    class(KeywordEnforcer), intent(in), optional :: unusable
    integer, intent(out), optional :: rc

procedure, public :: run_child => stub_child

  • private subroutine stub_child(this, name, clock, phase, unusable, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    character(len=*), intent(in) :: name
    type(ESMF_Clock), intent(inout) :: clock
    character(len=*), intent(in) :: phase
    class(KeywordEnforcer), intent(in), optional :: unusable
    integer, intent(out), optional :: rc

procedure, public :: set_component

  • private subroutine set_component(this, component)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseFrameworkComponent), intent(inout), target :: this
    class(AbstractComponent), intent(in) :: component

procedure, public :: set_composite

  • private subroutine set_composite(this, composite)

    Arguments

    Type IntentOptional Attributes Name
    class(CompositeComponent), intent(inout) :: this
    class(AbstractComposite), intent(in), target :: composite

procedure, public :: set_logger

  • private subroutine set_logger(this, lgr)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    class(Logger), target :: lgr

procedure, public :: set_use_threads

  • private subroutine set_use_threads(this, use_threads)

    Arguments

    Type IntentOptional Attributes Name
    class(MaplGenericComponent), intent(inout) :: this
    logical, intent(in) :: use_threads

Source Code

   type, extends(MaplGenericComponent) ::  MAPL_MetaComp
!      private
      ! Move to Base ?
      character(len=ESMF_MAXSTR)               :: COMPNAME
      type (ESMF_Config             )          :: CF
      character(:), allocatable :: full_name ! Period separated list of ancestor names
      real                                     :: HEARTBEAT

      ! Move to decorator?
      type (DistributedProfiler), public :: t_profiler

      ! Couplers and connectivity
      type (ESMF_CplComp            ), pointer :: CCS(:,:)         => null()
      type (ESMF_State              ), pointer :: CIM(:,:)         => null()
      type (ESMF_State              ), pointer :: CEX(:,:)         => null()
      logical,                         pointer :: CCcreated(:,:)   => null()
      type (MAPL_Link)               , pointer :: LINK(:)          => null()
      type (MAPL_Connectivity)                 :: connectList

      ! Obsolescent
      character(len=ESMF_MAXSTR)     , allocatable :: GCNameList(:)
      integer                        , pointer :: phase_init (:)    => null()
      integer, public                , pointer :: phase_run  (:)    => null()
      integer                        , pointer :: phase_final(:)    => null()
      integer                        , pointer :: phase_record(:)   => null()
      integer                        , pointer :: phase_coldstart(:)=> null()

      ! Make accessors?
      type(ESMF_GridComp)                      :: RootGC
      type(ESMF_GridComp)            , pointer :: parentGC         => null()

      type (ESMF_Alarm              )          :: ALARM(0:LAST_ALARM)
      integer                                  :: ALARMLAST=0
      type (ESMF_Clock              )          :: CLOCK

      type (MAPL_SunOrbit           )          :: ORBIT

      ! Odd ordering suport.  Needs thought
      logical                                  :: ChildInit = .true.

      ! Migrate to MaplGrid?
      type (MAPL_LocStream)                    :: ExchangeGrid
      type (MAPL_LocStream)                    :: LOCSTREAM

      ! Intermediate checkpointing and replay
      type (MAPL_GenericRecordType)  , pointer :: RECORD           => null()

      ! We don't know what this is for.
      type (MAPL_InitialState)                 :: initial_state

      ! Buffering prev/next buffers.
      ! Could become ExtData if Tiles could be handled???
      type (ESMF_State)                        :: FORCING
      ! Service-Services related fields
      type(ProvidedServiceItemVector) :: provided_services
      type(RequestedServiceItemVector) :: requested_services

   contains

      procedure :: get_ith_child
      procedure :: get_child_idx
      procedure :: get_child_gridcomp
      procedure :: get_child_import_state
      procedure :: get_child_export_state
      procedure :: get_child_internal_state

   end type MAPL_MetaComp