UpstreamScheme.f90

Go to the documentation of this file.

module upstreamschememodule
  use kindmodule, only: dp, i4b
  use constantsmodule, only: dzero
  use interpolationschemeinterfacemodule, only: interpolationschemeinterface, &
                                                coefficientstype
  use basedismodule, only: disbasetype
  use tspfmimodule, only: tspfmitype
 
  implicit none
  private
 
  public :: upstreamschemetype
 
  type, extends(interpolationschemeinterface) :: upstreamschemetype
    private
    class(disbasetype), pointer :: dis
    type(tspfmitype), pointer :: fmi
    real(dp), dimension(:), pointer :: phi
  contains
    procedure :: compute
    procedure :: set_field
  end type upstreamschemetype
 
  interface upstreamschemetype
    module procedure constructor
  end interface upstreamschemetype
 
contains
  function constructor(dis, fmi) result(interpolation_scheme)
    ! -- return
    type(upstreamschemetype) :: interpolation_scheme
    ! --dummy
    class(disbasetype), pointer, intent(in) :: dis
    type(tspfmitype), pointer, intent(in) :: fmi
 
    interpolation_scheme%dis => dis
    interpolation_scheme%fmi => fmi
 
  end function constructor
 
  !> @brief Set the scalar field for which interpolation will be computed
  !!
  !! This method establishes a pointer to the scalar field data for
  !! subsequent upstream interpolation computations.
  !<
  subroutine set_field(this, phi)
    ! -- dummy
    class(upstreamschemetype), target :: this
    real(DP), intent(in), dimension(:), pointer :: phi
 
    this%phi => phi
  end subroutine set_field
 
  function compute(this, n, m, iposnm) result(phi_face)
    !-- return
    type(coefficientstype) :: phi_face
    ! -- dummy
    class(upstreamschemetype), target :: this
    integer(I4B), intent(in) :: n
    integer(I4B), intent(in) :: m
    integer(I4B), intent(in) :: iposnm
    ! -- local
    real(dp) :: qnm
 
    ! -- Compute the coefficients for the upwind scheme
    qnm = this%fmi%gwfflowja(iposnm)
 
    if (qnm < dzero) then
      phi_face%c_n = 1.0_dp
    else
      phi_face%c_m = 1.0_dp
    end if
 
  end function compute
 
end module upstreamschememodule