ParticleEvents.f90

Go to the documentation of this file.

module particleeventsmodule
  use kindmodule, only: dp, i4b, lgp
  use listmodule, only: listtype
  use particlemodule, only: particletype
  use particleeventmodule, only: particleeventtype
  implicit none
 
  private
  public :: handle_event
 
  !> @brief Subscription to particle events: a procedure to
  !! handle the event with an unlimited pointer for storing
  !! arbitrary context the handling procedure may reference.
  type, public :: particleeventsubscriptiontype
    procedure(handle_event), pointer, nopass :: handler
    class(*), pointer :: context
  end type particleeventsubscriptiontype
 
  !> @brief Dispatcher for particle events. Consumers subscribe
  !! handlers to the dispatcher. Events may be dispatched, with
  !! the first handler to handle the event stopping propagation,
  !! or broadcast, with all handlers receiving the event.
  type, public :: particleeventdispatchertype
    type(listtype) :: subscriptions
  contains
    procedure, public :: subscribe
    procedure, public :: dispatch
    procedure, public :: broadcast
    procedure :: prep_event
    procedure :: destroy
  end type particleeventdispatchertype
 
  abstract interface
    !> @brief Event handler interface. Handlers may signal
    !! to the dispatching caller whether they have handled
    !! the event, but the signal is ignored for broadcasts.
    logical function handle_event(context, particle, event)
      import :: particletype, particleeventtype
      class(*), pointer :: context
      type(particletype), pointer, intent(inout) :: particle
      class(particleeventtype), pointer, intent(in) :: event
    end function
  end interface
 
contains
  !> @brief Add a subscription to the dispatcher.
  subroutine subscribe(this, handler, context)
    class(particleeventdispatchertype), intent(inout) :: this
    procedure(handle_event) :: handler
    class(*), pointer :: context
    ! local
    type(particleeventsubscriptiontype), pointer :: subscription
    class(*), pointer :: p
 
    allocate (subscription)
    subscription%handler => handler
    subscription%context => context
    p => subscription
    call this%subscriptions%Add(p)
  end subroutine subscribe
 
  !> @brief Prepare an event for dispatching, loading it with
  !! the current state of the particle. For internal use only.
  subroutine prep_event(this, particle, event)
    use tdismodule, only: kper, kstp
    ! dummy
    class(particleeventdispatchertype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    class(particleeventtype), pointer, intent(in) :: event
    ! local
    real(DP) :: x, y, z
 
    x = particle%x
    y = particle%y
    z = particle%z
    ! switch to model coordinates if needed
    call particle%get_model_coords(x, y, z)
 
    event%kper = kper
    event%kstp = kstp
    event%imdl = particle%imdl
    event%iprp = particle%iprp
    event%irpt = particle%irpt
    event%ilay = particle%ilay
    event%icu = particle%icu
    event%izone = particle%izone
    event%trelease = particle%trelease
    event%ttrack = particle%ttrack
    event%x = x
    event%y = y
    event%z = z
    event%istatus = particle%istatus
  end subroutine prep_event
 
  !> @brief Dispatch an event for handling. The first
  !! subscriber to handle the event stops propagation.
  subroutine dispatch(this, particle, event)
    class(particleeventdispatchertype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    class(particleeventtype), pointer, intent(in) :: event
    ! local
    logical(LGP) :: handled
    integer(I4B) :: i
    class(*), pointer :: p
 
    call this%prep_event(particle, event)
 
    do i = 1, this%subscriptions%Count()
      p => this%subscriptions%GetItem(i)
      select type (subscription => p)
      type is (particleeventsubscriptiontype)
        handled = subscription%handler( &
                  subscription%context, &
                  particle, &
                  event)
        if (handled) exit
      end select
    end do
  end subroutine dispatch
 
  !> @brief Broadcast an event to all subscribers so
  !! all receive the event and a chance to handle it.
  subroutine broadcast(this, particle, event)
    class(particleeventdispatchertype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    class(particleeventtype), pointer, intent(in) :: event
    ! local
    logical(LGP) :: handled
    integer(I4B) :: i
    class(*), pointer :: p
 
    call this%prep_event(particle, event)
 
    do i = 1, this%subscriptions%Count()
      p => this%subscriptions%GetItem(i)
      select type (subscription => p)
      type is (particleeventsubscriptiontype)
        handled = subscription%handler(subscription%context, particle, event)
      end select
    end do
  end subroutine broadcast
 
  !> @brief Destroy the dispatcher.
  subroutine destroy(this)
    class(particleeventdispatchertype), intent(inout) :: this
    call this%subscriptions%Clear(destroy=.true.)
  end subroutine destroy
 
end module particleeventsmodule