ExplicitModel.f90

Go to the documentation of this file.

!> @brief Models that solve themselves
module explicitmodelmodule
 
  use kindmodule, only: i4b, dp, lgp
  use constantsmodule, only: linelength, dzero
  use listmodule, only: listtype
  use basemodelmodule, only: basemodeltype
  use basedismodule, only: disbasetype
  use memorymanagermodule, only: mem_allocate, mem_deallocate
 
  implicit none
  private
  public :: explicitmodeltype, &
            castasexplicitmodelclass, &
            addexplicitmodeltolist, &
            getexplicitmodelfromlist
 
  !> @brief Base type for models that solve themselves.
  !!
  !! An explicit solution simply scrolls through a list of explicit
  !! models and calls solution procedures in a prescribed sequence.
  !<
  type, extends(basemodeltype) :: explicitmodeltype
  contains
    procedure :: model_ad
    procedure :: model_solve
    procedure :: model_cq
    procedure :: model_bd
    procedure :: model_da
    procedure :: allocate_scalars
    procedure :: allocate_arrays
    procedure :: set_idsoln
    procedure :: has_pending
  end type explicitmodeltype
 
contains
 
  !> @ brief Advance the model
  subroutine model_ad(this)
    class(explicitmodeltype) :: this
  end subroutine model_ad
 
  !> @ brief Solve the model
  subroutine model_solve(this)
    class(explicitmodeltype) :: this
  end subroutine model_solve
 
  !> @ brief Calculate model flows
  subroutine model_cq(this, icnvg, isuppress_output)
    class(explicitmodeltype) :: this
    integer(I4B), intent(in) :: icnvg
    integer(I4B), intent(in) :: isuppress_output
  end subroutine model_cq
 
  !> @ brief Calculate model budget
  subroutine model_bd(this, icnvg, isuppress_output)
    class(explicitmodeltype) :: this
    integer(I4B), intent(in) :: icnvg
    integer(I4B), intent(in) :: isuppress_output
  end subroutine model_bd
 
  !> @ brief Deallocate the model
  subroutine model_da(this)
    class(explicitmodeltype) :: this
 
    ! deallocate scalars
    deallocate (this%filename)
    call mem_deallocate(this%nja)
 
    ! deallocate arrays
    call mem_deallocate(this%ibound)
    call mem_deallocate(this%flowja, 'FLOWJA', this%memoryPath)
 
    ! nullify pointers
    if (associated(this%ibound)) &
      call mem_deallocate(this%ibound, 'IBOUND', this%memoryPath)
 
    ! deallocate derived types
    call this%bndlist%Clear()
    deallocate (this%bndlist)
 
    ! deallocate base type
    call this%BaseModelType%model_da()
  end subroutine model_da
 
  !> @ brief Allocate scalar variables
  subroutine allocate_scalars(this, modelname)
    class(explicitmodeltype) :: this
    character(len=*), intent(in) :: modelname
 
    call this%BaseModelType%allocate_scalars(modelname)
    allocate (this%bndlist)
    allocate (this%filename)
    this%filename = ''
  end subroutine allocate_scalars
 
  !> @brief Allocate array variables
  subroutine allocate_arrays(this)
    class(explicitmodeltype) :: this
    integer(I4B) :: i
 
    call mem_allocate(this%nja, 'NJA', this%memoryPath)
    this%nja = this%dis%nja
 
    call mem_allocate(this%ibound, this%dis%nodes, 'IBOUND', this%memoryPath)
    do i = 1, this%dis%nodes
      this%ibound(i) = 1 ! active by default
    end do
 
    call mem_allocate(this%flowja, this%nja, 'FLOWJA', this%memoryPath)
    do i = 1, this%nja
      this%flowja(i) = dzero
    end do
  end subroutine allocate_arrays
 
  !> @ brief Cast a generic object into an explicit model
  function castasexplicitmodelclass(obj) result(res)
    class(*), pointer, intent(inout) :: obj
    class(explicitmodeltype), pointer :: res
 
    res => null()
    if (.not. associated(obj)) return
 
    select type (obj)
    class is (explicitmodeltype)
      res => obj
    end select
  end function castasexplicitmodelclass
 
  !> @ brief Add explicit model to a generic list
  subroutine addexplicitmodeltolist(list, model)
    ! dummy
    type(listtype), intent(inout) :: list
    class(explicitmodeltype), pointer, intent(inout) :: model
    ! local
    class(*), pointer :: obj
 
    obj => model
    call list%Add(obj)
  end subroutine addexplicitmodeltolist
 
  !> @ brief Get generic object from list and return as explicit model
  function getexplicitmodelfromlist(list, idx) result(res)
    ! dummy
    type(listtype), intent(inout) :: list
    integer(I4B), intent(in) :: idx
    class(explicitmodeltype), pointer :: res
    ! local
    class(*), pointer :: obj
 
    obj => list%GetItem(idx)
    res => castasexplicitmodelclass(obj)
  end function getexplicitmodelfromlist
 
  !> @brief Set the solution ID
  subroutine set_idsoln(this, id)
    class(explicitmodeltype) :: this
    integer(I4B), intent(in) :: id
    this%idsoln = id
  end subroutine set_idsoln
 
  !> @brief Whether the model has any pending work.
  logical function has_pending(this)
    class(explicitmodeltype), intent(in) :: this
    has_pending = .false.
  end function has_pending
 
end module explicitmodelmodule