ParticleEvents.f90

Go to the documentation of this file.

module particleeventsmodule
  use kindmodule, only: dp, i4b, lgp
  use particlemodule, only: particletype
  use particleeventmodule, only: particleeventtype, &
                                 releaseeventtype, &
                                 cellexiteventtype, &
                                 timestepeventtype, &
                                 terminationeventtype, &
                                 weaksinkeventtype, &
                                 usertimeeventtype
  implicit none
 
  private
 
  type, public, abstract :: particleeventconsumertype
  contains
    procedure(handle_event), deferred :: handle_event
  end type particleeventconsumertype
 
  type, public :: particleeventdispatchertype
    class(particleeventconsumertype), pointer :: consumer => null()
  contains
    procedure, public :: subscribe
    procedure, public :: unsubscribe
    procedure :: dispatch
    procedure :: destroy
    ! particle events
    procedure, public :: release
    procedure, public :: cellexit
    procedure, public :: timestep
    procedure, public :: terminate
    procedure, public :: weaksink
    procedure, public :: usertime
  end type particleeventdispatchertype
 
  abstract interface
    subroutine handle_event(this, particle, event)
      import particleeventconsumertype, particletype, particleeventtype
      class(particleeventconsumertype), intent(inout) :: this
      type(particletype), pointer, intent(in) :: particle
      class(particleeventtype), pointer, intent(in) :: event
    end subroutine handle_event
  end interface
 
contains
  !> @brief Subscribe a consumer to the dispatcher.
  subroutine subscribe(this, consumer)
    class(particleeventdispatchertype), intent(inout) :: this
    class(particleeventconsumertype), target, intent(inout) :: consumer
    this%consumer => consumer
  end subroutine subscribe
 
  !> @brief Unsubscribe the consumer from the dispatcher.
  subroutine unsubscribe(this)
    class(particleeventdispatchertype), intent(inout) :: this
    if (associated(this%consumer)) then
      deallocate (this%consumer)
      this%consumer => null()
    end if
  end subroutine unsubscribe
 
  !> @brief Dispatch an event. Internal use only.
  subroutine dispatch(this, particle, event)
    use tdismodule, only: kper, kstp, totimc
    ! dummy
    class(particleeventdispatchertype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    class(particleeventtype), pointer, intent(inout) :: event
    ! local
    integer(I4B) :: per, stp
 
    per = kper
    stp = kstp
 
    ! If tracking time falls exactly on a boundary between time steps,
    ! report the previous time step for this datum. This is to follow
    ! MP7's behavior, and because the particle will have been tracked
    ! up to this instant under the previous time step's conditions, so
    ! the time step we're about to start shouldn't get "credit" for it.
    if (particle%ttrack == totimc .and. (per > 1 .or. stp > 1)) then
      if (stp > 1) then
        stp = stp - 1
      else if (per > 1) then
        per = per - 1
        stp = 1
      end if
    end if
 
    event%particle => particle
    event%time = particle%ttrack
    event%kper = per
    event%kstp = stp
    call this%consumer%handle_event(particle, event)
    deallocate (event)
  end subroutine dispatch
 
  !> @brief Destroy the dispatcher.
  subroutine destroy(this)
    class(particleeventdispatchertype), intent(inout) :: this
    if (associated(this%consumer)) &
      deallocate (this%consumer)
  end subroutine destroy
 
  !> @brief Particle is released.
  subroutine release(this, particle)
    class(particleeventdispatchertype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    class(particleeventtype), pointer :: event
 
    allocate (releaseeventtype :: event)
    call this%dispatch(particle, event)
  end subroutine release
 
  !> @brief Particle exits a cell.
  subroutine cellexit(this, particle)
    class(particleeventdispatchertype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    class(particleeventtype), pointer :: event
 
    allocate (cellexiteventtype :: event)
    call this%dispatch(particle, event)
  end subroutine cellexit
 
  !> @brief Particle terminates.
  subroutine terminate(this, particle, status)
    class(particleeventdispatchertype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    integer(I4B), intent(in), optional :: status
    class(particleeventtype), pointer :: event
 
    particle%advancing = .false.
    if (present(status)) particle%istatus = status
    allocate (terminationeventtype :: event)
    call this%dispatch(particle, event)
  end subroutine terminate
 
  !> @brief Time step ends.
  subroutine timestep(this, particle)
    class(particleeventdispatchertype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    class(particleeventtype), pointer :: event
 
    allocate (timestepeventtype :: event)
    call this%dispatch(particle, event)
  end subroutine timestep
 
  !> @brief Particle leaves a weak sink.
  subroutine weaksink(this, particle)
    class(particleeventdispatchertype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    class(particleeventtype), pointer :: event
 
    allocate (weaksinkeventtype :: event)
    call this%dispatch(particle, event)
  end subroutine weaksink
 
  !> @brief User-defined tracking time occurs.
  subroutine usertime(this, particle)
    class(particleeventdispatchertype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    class(particleeventtype), pointer :: event
 
    allocate (usertimeeventtype :: event)
    call this%dispatch(particle, event)
  end subroutine usertime
 
end module particleeventsmodule