BaseSolution.f90

Go to the documentation of this file.

! -- A solution contains a list of models, packages, and exchanges
module basesolutionmodule
 
  use kindmodule, only: dp, i4b
  use constantsmodule, only: lensolutionname
  use basemodelmodule, only: basemodeltype
  use baseexchangemodule, only: baseexchangetype
  use listmodule, only: listtype
  implicit none
 
  private
  public :: basesolutiontype, addbasesolutiontolist, getbasesolutionfromlist
  private :: castasbasesolutionclass
 
  type, abstract :: basesolutiontype
    character(len=LENSOLUTIONNAME) :: name
  contains
    procedure(sln_df), deferred :: sln_df
    procedure(sln_ar), deferred :: sln_ar
    procedure(sln_dt), deferred :: sln_dt
    procedure(sln_ad), deferred :: sln_ad
    procedure(sln_ca), deferred :: sln_ca
    procedure(sln_ot), deferred :: sln_ot
    procedure(sln_fp), deferred :: sln_fp
    procedure(sln_da), deferred :: sln_da
    procedure(slnsave), deferred :: save
    procedure(slnaddmodel), deferred :: add_model
    procedure(slnaddexchange), deferred :: add_exchange
    procedure(slngetmodels), deferred :: get_models
    procedure(slngetexchanges), deferred :: get_exchanges
 
    ! Expose these for use through the BMI/XMI:
    procedure(preparesolve), deferred :: preparesolve
    procedure(solve), deferred :: solve
    procedure(finalizesolve), deferred :: finalizesolve
  end type basesolutiontype
 
  abstract interface
 
    subroutine sln_df(this)
      import basesolutiontype
      class(basesolutiontype) :: this
    end subroutine
 
    subroutine slnaddexchange(this, exchange)
      import basesolutiontype
      import baseexchangetype
      class(basesolutiontype) :: this
      class(baseexchangetype), pointer, intent(in) :: exchange
    end subroutine
 
    subroutine assignconnectionsiface(this)
      import basesolutiontype
      class(basesolutiontype) :: this
    end subroutine
 
    subroutine sln_ar(this)
      import basesolutiontype
      class(basesolutiontype) :: this
    end subroutine
 
    subroutine sln_rp(this)
      import basesolutiontype
      class(basesolutiontype) :: this
    end subroutine
 
    subroutine sln_dt(this)
      import basesolutiontype
      class(basesolutiontype) :: this
    end subroutine
 
    subroutine sln_ad(this)
      import basesolutiontype
      class(basesolutiontype) :: this
    end subroutine
 
    subroutine sln_ot(this)
      import basesolutiontype
      class(basesolutiontype) :: this
    end subroutine
 
    subroutine sln_ca(this, isgcnvg, isuppress_output)
      use kindmodule, only: dp, i4b
      import basesolutiontype
      class(basesolutiontype) :: this
      integer(I4B), intent(in) :: isuppress_output
      integer(I4B), intent(inout) :: isgcnvg
    end subroutine
 
    subroutine slnsave(this, filename)
      import basesolutiontype
      class(basesolutiontype) :: this
      character(len=*), intent(in) :: filename
    end subroutine
 
    subroutine slnaddmodel(this, mp)
      import basesolutiontype
      import basemodeltype
      class(basesolutiontype) :: this
      class(basemodeltype), pointer, intent(in) :: mp
    end subroutine
 
    function slngetmodels(this) result(models)
      import basesolutiontype
      import listtype
      class(basesolutiontype) :: this
      type(listtype), pointer :: models
    end function
 
    function slngetexchanges(this) result(models)
      import basesolutiontype
      import listtype
      class(basesolutiontype) :: this
      type(listtype), pointer :: models
    end function
 
    subroutine sln_fp(this)
      import basesolutiontype
      class(basesolutiontype) :: this
    end subroutine
 
    subroutine sln_da(this)
      import basesolutiontype
      class(basesolutiontype) :: this
    end subroutine
 
    subroutine preparesolve(this)
      import basesolutiontype
      class(basesolutiontype) :: this
    end subroutine preparesolve
 
    subroutine solve(this, kiter)
      use kindmodule, only: i4b
      import basesolutiontype
      class(basesolutiontype) :: this
      integer(I4B), intent(in) :: kiter
    end subroutine solve
 
    subroutine finalizesolve(this, kiter, isgcnvg, isuppress_output)
      use kindmodule, only: i4b
      import basesolutiontype
      class(basesolutiontype) :: this
      integer(I4B), intent(in) :: kiter
      integer(I4B), intent(inout) :: isgcnvg
      integer(I4B), intent(in) :: isuppress_output
    end subroutine finalizesolve
 
  end interface
 
contains
 
  function castasbasesolutionclass(obj) result(res)
    implicit none
    class(*), pointer, intent(inout) :: obj
    class(basesolutiontype), pointer :: res
    !
    res => null()
    if (.not. associated(obj)) return
    !
    select type (obj)
    class is (basesolutiontype)
      res => obj
    end select
  end function castasbasesolutionclass
 
  subroutine addbasesolutiontolist(list, solution)
    implicit none
    ! -- dummy
    type(listtype), intent(inout) :: list
    class(basesolutiontype), pointer, intent(in) :: solution
    ! -- local
    class(*), pointer :: obj
    !
    obj => solution
    call list%Add(obj)
  end subroutine addbasesolutiontolist
 
  function getbasesolutionfromlist(list, idx) result(res)
    implicit none
    ! -- dummy
    type(listtype), intent(inout) :: list
    integer(I4B), intent(in) :: idx
    class(basesolutiontype), pointer :: res
    ! -- local
    class(*), pointer :: obj
    !
    obj => list%GetItem(idx)
    res => castasbasesolutionclass(obj)
  end function getbasesolutionfromlist
 
end module basesolutionmodule