BaseProfiler Derived Type

type, public, abstract :: BaseProfiler


Inherits

type~~baseprofiler~~InheritsGraph type~baseprofiler BaseProfiler type~meternode MeterNode type~baseprofiler->type~meternode root_node type~meternodestack MeterNodeStack type~baseprofiler->type~meternodestack stack type~abstractmeter AbstractMeter type~meternode->type~abstractmeter meter type~abstractmeternode AbstractMeterNode type~meternode->type~abstractmeternode type~meternodevector MeterNodeVector type~meternode->type~meternodevector children type~vector_wrapper~16 vector_wrapper type~meternodestack->type~vector_wrapper~16 elements type~v_wrapper~3 v_Wrapper type~meternodevector->type~v_wrapper~3 elements type~meternodeptr MeterNodePtr type~vector_wrapper~16->type~meternodeptr item type~meternodeptr->type~abstractmeternode ptr type~v_wrapper~3->type~abstractmeternode item

Inherited by

type~~baseprofiler~~InheritedByGraph type~baseprofiler BaseProfiler type~distributedprofiler DistributedProfiler type~distributedprofiler->type~baseprofiler type~memoryprofiler MemoryProfiler type~memoryprofiler->type~baseprofiler type~timeprofiler TimeProfiler type~timeprofiler->type~baseprofiler type~mapl_metacomp MAPL_MetaComp type~mapl_metacomp->type~distributedprofiler t_profiler type~maplframework MaplFramework type~maplframework->type~distributedprofiler time_profiler type~stubprofiler StubProfiler type~stubprofiler->type~distributedprofiler 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-Bound Procedures

procedure, public :: accumulate

  • private recursive subroutine accumulate(a, b)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout), target :: a
    class(BaseProfiler), intent(in), target :: b

generic, public :: assignment(=) => copy

  • private subroutine copy(new, old)

    Arguments

    Type IntentOptional Attributes Name
    class(StubProfiler), intent(inout), target :: new
    class(BaseProfiler), intent(in), target :: old

procedure, public :: begin => begin_profiler

  • private function begin_profiler(this) result(iterator)

    Arguments

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

    Return Value type(BaseProfilerIterator)

procedure(copy_profiler), public, deferred :: copy

procedure, public :: copy_profiler

  • private subroutine copy_profiler(new, old)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout), target :: new
    class(BaseProfiler), intent(in), target :: old

procedure, public :: end => end_profiler

  • private function end_profiler(this) result(iterator)

    Arguments

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

    Return Value type(BaseProfilerIterator)

procedure, public :: finalize

  • private subroutine finalize(this)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout), target :: this

procedure, public :: get_depth

  • private function get_depth(this) result(depth)

    Arguments

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

    Return Value integer

procedure, public :: get_num_meters

  • private function get_num_meters(this) result(num_meters)

    Arguments

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

    Return Value integer

procedure, public :: get_root_node

  • private function get_root_node(this) result(root_node)

    Arguments

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

    Return Value class(AbstractMeterNode), pointer

procedure, public :: get_status

  • private function get_status(this) result(status)

    Arguments

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

    Return Value integer

procedure(i_make_meter), public, deferred :: make_meter

  • function i_make_meter(this) result(meter) Prototype

    Arguments

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

    Return Value class(AbstractMeter), allocatable

procedure, public :: reset

  • private recursive subroutine reset(this)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout), target :: this

procedure, public :: set_comm_world

  • private subroutine set_comm_world(this, comm_world)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout) :: this
    integer, intent(in), optional :: comm_world

procedure, public :: set_node

  • private subroutine set_node(this, node)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout) :: this
    class(MeterNode), intent(in) :: node

generic, public :: start => start_name

  • private subroutine start_name(this, name, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(StubProfiler), intent(inout), target :: this
    character(len=*), intent(in) :: name
    integer, intent(out), optional :: rc

generic, public :: start => start_node

  • private subroutine start_node(this, node)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout) :: this
    class(AbstractMeterNode), intent(inout), target :: node

generic, public :: start => start_self

  • private subroutine start_self(this, unusable, rc)

    Arguments

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

procedure, public :: start_name

  • private subroutine start_name(this, name, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout), target :: this
    character(len=*), intent(in) :: name
    integer, intent(out), optional :: rc

procedure, public :: start_node

  • private subroutine start_node(this, node)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout) :: this
    class(AbstractMeterNode), intent(inout), target :: node

procedure, public :: start_self

  • private subroutine start_self(this, unusable, rc)

    Arguments

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

generic, public :: stop => stop_name

  • private subroutine stop_name(this, name, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(StubProfiler), intent(inout) :: this
    character(len=*), intent(in) :: name
    integer, intent(out), optional :: rc

generic, public :: stop => stop_node

  • private subroutine stop_node(this, node)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout) :: this
    class(AbstractMeterNode), intent(inout), target :: node

generic, public :: stop => stop_self

  • private subroutine stop_self(this, rc)

    Arguments

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

procedure, public :: stop_name

  • private subroutine stop_name(this, name, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout) :: this
    character(len=*), intent(in) :: name
    integer, intent(out), optional :: rc

procedure, public :: stop_node

  • private subroutine stop_node(this, node)

    Arguments

    Type IntentOptional Attributes Name
    class(BaseProfiler), intent(inout) :: this
    class(AbstractMeterNode), intent(inout), target :: node

procedure, public :: stop_self

  • private subroutine stop_self(this, rc)

    Arguments

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

generic, public :: zeit_ci => start_name

  • private subroutine start_name(this, name, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(StubProfiler), intent(inout), target :: this
    character(len=*), intent(in) :: name
    integer, intent(out), optional :: rc

generic, public :: zeit_co => stop_name

  • private subroutine stop_name(this, name, rc)

    Arguments

    Type IntentOptional Attributes Name
    class(StubProfiler), intent(inout) :: this
    character(len=*), intent(in) :: name
    integer, intent(out), optional :: rc

Source Code

   type, abstract :: BaseProfiler
      private
      type(MeterNode) :: root_node
      type(MeterNodeStack) :: stack
      integer :: status = 0
      integer :: comm_world
   contains
      procedure :: start_name
      procedure :: stop_name
      procedure :: start_node
      procedure :: stop_node
      procedure :: start_self
      procedure :: stop_self
      generic :: start => start_name
      generic :: start => start_node
      generic :: start => start_self
      generic :: stop => stop_name
      generic :: stop => stop_node
      generic :: stop => stop_self
      generic :: zeit_ci => start_name
      generic :: zeit_co => stop_name
      procedure :: get_num_meters
      procedure :: finalize

      ! Override make_meter() to measure other things.
      procedure(i_make_meter), deferred :: make_meter

      procedure :: set_node
      procedure :: get_root_node
      procedure :: get_status
      procedure :: copy_profiler
      procedure(copy_profiler), deferred :: copy
      generic :: assignment(=) => copy

      procedure :: reset
      procedure :: accumulate

      procedure :: begin => begin_profiler
      procedure :: end => end_profiler
      procedure :: get_depth
      procedure :: set_comm_world

   end type BaseProfiler