ExplicitModel.f90

Go to the documentation of this file.

!> @brief Models that solve themselves
module explicitmodelmodule
 
  use kindmodule, only: i4b, dp
  use constantsmodule, only: linelength
  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
    character(len=LINELENGTH), pointer :: filename => null() !< input file name
    integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< ibound
    type(listtype), pointer :: bndlist => null() !< array of boundary packages
    class(disbasetype), pointer :: dis => null() !< discretization object
  contains
    ! -- Overridden methods
    procedure :: model_ad
    procedure :: model_solve
    procedure :: model_cq
    procedure :: model_bd
    procedure :: model_da
    ! -- Utility methods
    procedure :: allocate_scalars
    procedure :: allocate_arrays
    procedure :: set_idsoln
  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)
 
    ! -- deallocate arrays
    call mem_deallocate(this%ibound)
 
    ! -- nullify pointers
    if (associated(this%ibound)) &
      call mem_deallocate(this%ibound, 'IBOUND', this%memoryPath)
 
    ! -- member 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%ibound, this%dis%nodes, 'IBOUND', this%memoryPath)
    do i = 1, this%dis%nodes
      this%ibound(i) = 1 ! active by default
    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
 
end module explicitmodelmodule