NumericalExchange.f90

Go to the documentation of this file.

module numericalexchangemodule
 
  use kindmodule, only: dp, i4b
  use basemodelmodule, only: basemodeltype
  use baseexchangemodule, only: baseexchangetype, addbaseexchangetolist
  use numericalmodelmodule, only: numericalmodeltype
  use listmodule, only: listtype
  use matrixbasemodule
 
  implicit none
 
  private
  public :: numericalexchangetype, &
            addnumericalexchangetolist, getnumericalexchangefromlist
 
  type, extends(baseexchangetype) :: numericalexchangetype
    character(len=7) :: typename !< name of the type (e.g., 'GWF-GWF')
 
  contains
 
    procedure :: exg_df
    procedure :: exg_ac
    procedure :: exg_mc
    procedure :: exg_ar
    !procedure :: exg_rp (not needed yet; base exg_rp does nothing)
    procedure :: exg_ad
    procedure :: exg_cf
    procedure :: exg_fc
    procedure :: exg_cc
    procedure :: exg_cq
    procedure :: exg_bd
    procedure :: exg_ot
    procedure :: exg_da
    procedure :: get_iasym
  end type numericalexchangetype
 
contains
 
  !> @brief Define the exchange
  !<
  subroutine exg_df(this)
    ! -- modules
    use basemodelmodule, only: basemodeltype
    use inputoutputmodule, only: getunit, openfile
    ! -- dummy
    class(numericalexchangetype) :: this
    !
    ! -- Return
    return
  end subroutine exg_df
 
  !> @brief If an implicit exchange then add connections to sparse
  !<
  subroutine exg_ac(this, sparse)
    ! -- modules
    use sparsemodule, only: sparsematrix
    ! -- dummy
    class(numericalexchangetype) :: this
    type(sparsematrix), intent(inout) :: sparse
    !
    ! -- Return
    return
  end subroutine exg_ac
 
  !> @brief Map the connections in the global matrix
  !<
  subroutine exg_mc(this, matrix_sln)
    ! -- module
    use sparsemodule, only: sparsematrix
    ! -- dummy
    class(numericalexchangetype) :: this
    class(matrixbasetype), pointer :: matrix_sln
    !
    ! -- Return
  end subroutine exg_mc
 
  !> @brief Allocate and read
  !<
  subroutine exg_ar(this)
    !
    class(numericalexchangetype) :: this
    !
    ! -- Return
    return
  end subroutine exg_ar
 
  !> @brief Advance
  !<
  subroutine exg_ad(this)
    ! -- dummy
    class(numericalexchangetype) :: this
    !
    ! -- Return
    return
  end subroutine exg_ad
 
  !> @brief Calculate conductance, and for explicit exchanges, set the
  !! conductance in the boundary package
  !<
  subroutine exg_cf(this, kiter)
    ! -- dummy
    class(numericalexchangetype) :: this
    integer(I4B), intent(in) :: kiter
    !
    ! -- Return
    return
  end subroutine exg_cf
 
  !> @brief Fill the matrix
  !<
  subroutine exg_fc(this, kiter, matrix_sln, rhs_sln, inwtflag)
    ! -- dummy
    class(numericalexchangetype) :: this
    integer(I4B), intent(in) :: kiter
    class(matrixbasetype), pointer :: matrix_sln
    real(DP), dimension(:), intent(inout) :: rhs_sln
    integer(I4B), optional, intent(in) :: inwtflag
    !
    ! -- Return
    return
  end subroutine exg_fc
 
  !> @brief Additional convergence check
  !<
  subroutine exg_cc(this, icnvg)
    ! -- dummy
    class(numericalexchangetype) :: this
    integer(I4B), intent(inout) :: icnvg
    !
    ! -- Return
    return
  end subroutine exg_cc
 
  !> @brief Calculate flow
  !<
  subroutine exg_cq(this, icnvg, isuppress_output, isolnid)
    ! -- modules
    use constantsmodule, only: lenbudtxt
    ! -- dummy
    class(numericalexchangetype) :: this
    integer(I4B), intent(inout) :: icnvg
    integer(I4B), intent(in) :: isuppress_output
    integer(I4B), intent(in) :: isolnid
    !
    ! -- Return
    return
  end subroutine exg_cq
 
  !> @brief Exchange budget
  !<
  subroutine exg_bd(this, icnvg, isuppress_output, isolnid)
    ! -- modules
    use constantsmodule, only: lenbudtxt
    ! -- dummy
    class(numericalexchangetype) :: this
    integer(I4B), intent(inout) :: icnvg
    integer(I4B), intent(in) :: isuppress_output
    integer(I4B), intent(in) :: isolnid
    !
    ! -- Return
    return
  end subroutine exg_bd
 
  !> @brief Output
  !<
  subroutine exg_ot(this)
    ! -- dummy
    class(numericalexchangetype) :: this
    !
    ! -- Return
    return
  end subroutine exg_ot
 
  !> @brief Deallocate memory
  !<
  subroutine exg_da(this)
    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(numericalexchangetype) :: this
    !
    ! -- Return
    return
  end subroutine exg_da
 
  function get_iasym(this) result(iasym)
    ! -- dummy
    class(numericalexchangetype) :: this
    ! -- return
    integer(I4B) :: iasym
    !
    iasym = 0
    !
    ! -- Return
    return
  end function get_iasym
 
  function castasnumericalexchangeclass(obj) result(res)
    implicit none
    ! -- dummy
    class(*), pointer, intent(inout) :: obj
    ! -- return
    class(numericalexchangetype), pointer :: res
    !
    res => null()
    if (.not. associated(obj)) return
    !
    select type (obj)
    class is (numericalexchangetype)
      res => obj
    end select
    !
    ! -- Return
    return
  end function castasnumericalexchangeclass
 
  !> @brief Add numerical exchange to a list
  !<
  subroutine addnumericalexchangetolist(list, exchange)
    implicit none
    ! -- dummy
    type(listtype), intent(inout) :: list
    class(numericalexchangetype), pointer, intent(in) :: exchange
    ! -- local
    class(*), pointer :: obj
    !
    obj => exchange
    call list%Add(obj)
    !
    ! -- Return
    return
  end subroutine addnumericalexchangetolist
 
  !> @brief Retrieve a specific numerical exchange from a list
  !<
  function getnumericalexchangefromlist(list, idx) result(res)
    implicit none
    ! -- dummy
    type(listtype), intent(inout) :: list
    integer(I4B), intent(in) :: idx
    class(numericalexchangetype), pointer :: res
    ! -- local
    class(*), pointer :: obj
    !
    obj => list%GetItem(idx)
    res => castasnumericalexchangeclass(obj)
    !
    ! -- Return
    return
  end function getnumericalexchangefromlist
 
end module numericalexchangemodule