MethodCellPassToBot.f90

Go to the documentation of this file.

module methodcellpasstobotmodule
 
  use kindmodule, only: dp, i4b
  use methodcellmodule, only: methodcelltype
  use celldefnmodule, only: celldefntype, create_defn
  use prtfmimodule, only: prtfmitype
  use basedismodule, only: disbasetype
  use dismodule, only: distype
  use disvmodule, only: disvtype
  use particlemodule, only: particletype
  use cellmodule, only: celltype
  use subcellmodule, only: subcelltype
  use trackcontrolmodule, only: trackcontroltype
  implicit none
 
  private
  public :: methodcellpasstobottype
  public :: create_method_cell_ptb
 
  type, extends(methodcelltype) :: methodcellpasstobottype
    private
  contains
    procedure, public :: apply => apply_ptb
    procedure, public :: deallocate
  end type methodcellpasstobottype
 
contains
 
  !> @brief Create a new pass-to-bottom tracking method
  subroutine create_method_cell_ptb(method)
    type(methodcellpasstobottype), pointer :: method
    allocate (method)
    allocate (method%name)
    method%name = "passtobottom"
    method%delegates = .false.
  end subroutine create_method_cell_ptb
 
  !> @brief Deallocate the pass-to-bottom tracking method
  subroutine deallocate (this)
    class(methodcellpasstobottype), intent(inout) :: this
    deallocate (this%name)
  end subroutine deallocate
 
  !> @brief Pass particle vertically and instantaneously to the cell bottom
  subroutine apply_ptb(this, particle, tmax)
    use particlemodule, only: term_no_exits
    ! dummy
    class(methodcellpasstobottype), intent(inout) :: this
    type(particletype), pointer, intent(inout) :: particle
    real(DP), intent(in) :: tmax
    ! local
    integer(I4B) :: nlay
 
    ! Check termination/reporting conditions
    call this%check(particle, this%cell%defn, tmax)
    if (.not. particle%advancing) return
 
    ! Pass to bottom face
    particle%z = this%cell%defn%bot
    particle%iboundary(2) = this%cell%defn%npolyverts + 2
 
    ! Terminate if in bottom layer
    select type (dis => this%fmi%dis)
    type is (distype)
      nlay = dis%nlay
    type is (disvtype)
      nlay = dis%nlay
    end select
    if (particle%ilay == nlay) then
      particle%advancing = .false.
      particle%istatus = term_no_exits
      call this%save(particle, reason=3)
    end if
 
    ! Save record
    call this%save(particle, reason=1)
  end subroutine apply_ptb
 
end module methodcellpasstobotmodule