MethodSubcell.f90

Go to the documentation of this file.

module methodsubcellmodule
  use kindmodule, only: dp, i4b
  use errorutilmodule, only: pstop
  use methodmodule, only: level_subfeature
  use methodcellmodule, only: methodcelltype
  use particlemodule, only: particletype
  use celldefnmodule, only: celldefntype
  use particleeventmodule, only: particleeventtype
  use subcellexiteventmodule, only: subcellexiteventtype
 
  private
  public :: methodsubcelltype
 
  !> @brief Abstract base type for subcell tracking methods
  type, abstract, extends(methodcelltype) :: methodsubcelltype
  contains
    procedure, public :: assess
    procedure, public :: subcellexit
    procedure, public :: get_level
  end type methodsubcelltype
 
contains
 
  !> @brief Assess conditions before tracking
  subroutine assess(this, particle, cell_defn, tmax)
    ! dummy
    class(methodsubcelltype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    type(celldefntype), pointer, intent(inout) :: cell_defn
    real(DP), intent(in) :: tmax
    ! noop
  end subroutine assess
 
  !> @brief Particle exits a subcell.
  subroutine subcellexit(this, particle)
    class(methodsubcelltype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    class(particleeventtype), pointer :: event
    ! local
    integer(I4B) :: i, nhist
    class(*), pointer :: prev
 
    allocate (subcellexiteventtype :: event)
    select type (event)
    type is (subcellexiteventtype)
      event%isc = particle%itrdomain(level_subfeature)
      event%exit_face = particle%iboundary(level_subfeature)
    end select
    call this%events%broadcast(particle, event)
    if (particle%icycwin == 0) then
      deallocate (event)
      return
    end if
    if (this%forms_cycle(particle, event)) then
      print *, "Cyclic subcell pathline detected"
      nhist = particle%history%Count()
      do i = 1, nhist
        prev => particle%history%GetItem(i)
        select type (prev)
        class is (particleeventtype)
          print *, "Back ", nhist - i + 1, ": ", prev%get_text()
        end select
      end do
      print *, "Current :", event%get_text()
      call pstop(1, 'Cyclic subcell pathline detected, aborting')
    else
      call this%store_event(particle, event)
    end if
  end subroutine subcellexit
 
  !> @brief Get the subcell method's level.
  function get_level(this) result(level)
    class(methodsubcelltype), intent(in) :: this
    integer(I4B) :: level
    level = level_subfeature
  end function get_level
 
end module methodsubcellmodule