ExplicitSolution.f90

Go to the documentation of this file.

!> @brief Explicit Solution Module
!!
!! This module contains the Explicit Solution, which is a
!! class for solving explicit models.  The explicit solution
!! scrolls through a list of explicit models and calls
!! methods in a prescribed sequence.
!!
!<
module explicitsolutionmodule
  use kindmodule, only: i4b, dp
  use timermodule, only: code_timer
  use constantsmodule, only: lenmempath, lensolutionname, mvalidate, &
                             mnormal, linelength, dzero
  use memoryhelpermodule, only: create_mem_path
  use basemodelmodule, only: basemodeltype
  use numericalmodelmodule, only: numericalmodeltype, &
                                  addnumericalmodeltolist, &
                                  getnumericalmodelfromlist
  use baseexchangemodule, only: baseexchangetype
  use basesolutionmodule, only: basesolutiontype, addbasesolutiontolist
  use listmodule, only: listtype
  use listsmodule, only: basesolutionlist
  use simvariablesmodule, only: iout, isim_mode
  use blockparsermodule, only: blockparsertype
  use memorymanagermodule, only: mem_allocate, mem_deallocate
  use inputoutputmodule, only: getunit
 
  implicit none
  private
 
  public :: create_explicit_solution
  public :: explicitsolutiontype
 
  !> @brief Manages and solves explicit models.
  !!
  !! An explicit solution simply scrolls through a list of explicit
  !! models and calls solution procedures in a prescribed sequence.
  !<
  type, extends(basesolutiontype) :: explicitsolutiontype
    character(len=LENMEMPATH) :: memorypath !< the path for storing solution variables in the memory manager
    type(listtype), pointer :: modellist !< list of models in solution
    integer(I4B), pointer :: id !< solution number
    integer(I4B), pointer :: iu !< input file unit
    real(dp), pointer :: ttsoln !< timer - total solution time
    integer(I4B), pointer :: icnvg => null() !< convergence flag
    type(blockparsertype) :: parser !< block parser object
  contains
    procedure :: sln_df
    procedure :: sln_ar
    procedure :: sln_dt
    procedure :: sln_ad
    procedure :: sln_ot
    procedure :: sln_ca
    procedure :: sln_fp
    procedure :: sln_da
    procedure :: add_model
    procedure :: add_exchange
    procedure :: get_models
    procedure :: get_exchanges
    procedure :: save
 
    procedure, private :: allocate_scalars
 
    ! Expose these for use through the BMI/XMI:
    procedure, public :: preparesolve
    procedure, public :: solve
    procedure, public :: finalizesolve
 
  end type explicitsolutiontype
 
contains
 
  !> @ brief Create a new solution
  !!
  !! Create a new solution using the data in filename, assign this new
  !! solution an id number and store the solution in the basesolutionlist.
  !! Also open the filename for later reading.
  !<
  subroutine create_explicit_solution(exp_sol, filename, id)
    ! -- modules
    use inputoutputmodule, only: getunit, openfile
    ! -- dummy variables
    class(explicitsolutiontype), pointer :: exp_sol !< the create solution
    character(len=*), intent(in) :: filename !< solution input file name
    integer(I4B), intent(in) :: id !< solution id
    ! -- local variables
    integer(I4B) :: inunit
    class(basesolutiontype), pointer :: solbase => null()
    character(len=LENSOLUTIONNAME) :: solutionname
 
    ! -- Create a new solution and add it to the basesolutionlist container
    solbase => exp_sol
    write (solutionname, '(a, i0)') 'SLN_', id
    exp_sol%name = solutionname
    exp_sol%memoryPath = create_mem_path(solutionname)
    allocate (exp_sol%modellist)
    !todo: do we need this?  allocate (exp_sol%exchangelist)
    call exp_sol%allocate_scalars()
    call addbasesolutiontolist(basesolutionlist, solbase)
    exp_sol%id = id
 
    ! -- Open solution input file for reading later after problem size is known
    !    Check to see if the file is already opened, which can happen when
    !    running in single model mode
    inquire (file=filename, number=inunit)
    if (inunit < 0) inunit = getunit()
    exp_sol%iu = inunit
    write (iout, '(/a,a/)') ' Creating explicit solution (EMS): ', exp_sol%name
    call openfile(exp_sol%iu, iout, filename, 'IMS')
 
    ! -- Initialize block parser
    call exp_sol%parser%Initialize(exp_sol%iu, iout)
  end subroutine create_explicit_solution
 
  !> @ brief Allocate scalars
  !<
  subroutine allocate_scalars(this)
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
 
    ! -- allocate scalars
    call mem_allocate(this%id, 'ID', this%memoryPath)
    call mem_allocate(this%iu, 'IU', this%memoryPath)
    call mem_allocate(this%ttsoln, 'TTSOLN', this%memoryPath)
    call mem_allocate(this%icnvg, 'ICNVG', this%memoryPath)
 
    ! -- initialize
    this%id = 0
    this%iu = 0
    this%ttsoln = dzero
    this%icnvg = 0
  end subroutine allocate_scalars
 
  !> @ brief Define the solution
  !<
  subroutine sln_df(this)
    class(explicitsolutiontype) :: this
  end subroutine
 
  !> @ brief Allocate and read
  !<
  subroutine sln_ar(this)
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
 
    ! -- close ems input file
    call this%parser%Clear()
  end subroutine sln_ar
 
  !> @ brief Calculate time step length
  !<
  subroutine sln_dt(this)
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
  end subroutine sln_dt
 
  !> @ brief Advance the solution
  !<
  subroutine sln_ad(this)
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
 
    ! -- reset convergence flag
    this%icnvg = 0
  end subroutine sln_ad
 
  !> @ brief Solution output
  !<
  subroutine sln_ot(this)
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
  end subroutine sln_ot
 
  subroutine sln_fp(this)
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
  end subroutine sln_fp
 
  !> @ brief Deallocate
  !<
  subroutine sln_da(this)
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
 
    ! -- lists
    call this%modellist%Clear()
    deallocate (this%modellist)
 
    ! -- Scalars
    call mem_deallocate(this%id)
    call mem_deallocate(this%iu)
    call mem_deallocate(this%ttsoln)
    call mem_deallocate(this%icnvg)
  end subroutine sln_da
 
  !> @ brief Calculate
  !<
  subroutine sln_ca(this, isgcnvg, isuppress_output)
    ! -- dummy variables
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
    integer(I4B), intent(inout) :: isgcnvg !< solution group convergence flag
    integer(I4B), intent(in) :: isuppress_output !< flag for suppressing output
    ! -- local variables
    class(numericalmodeltype), pointer :: mp => null()
    character(len=LINELENGTH) :: line
    character(len=LINELENGTH) :: fmt
    integer(I4B) :: im
    integer(I4B) :: kiter
 
    kiter = 1
 
    ! advance the models and solution
    call this%prepareSolve()
 
    select case (isim_mode)
    case (mvalidate)
      line = 'mode="validation" -- Skipping assembly and solution.'
      fmt = "(/,1x,a,/)"
      do im = 1, this%modellist%Count()
        mp => getnumericalmodelfromlist(this%modellist, im)
        call mp%model_message(line, fmt=fmt)
      end do
    case (mnormal)
 
      ! solve the models
      call this%solve(kiter)
 
      ! finish up
      call this%finalizeSolve(kiter, isgcnvg, isuppress_output)
    end select
  end subroutine sln_ca
 
  !> @ brief Prepare to solve
  !<
  subroutine preparesolve(this)
    ! -- dummy variables
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
    ! -- local variables
    integer(I4B) :: im
    class(numericalmodeltype), pointer :: mp => null()
 
    ! -- Model advance
    do im = 1, this%modellist%Count()
      mp => getnumericalmodelfromlist(this%modellist, im)
      call mp%model_ad()
    end do
 
    ! advance solution
    call this%sln_ad()
  end subroutine preparesolve
 
  !> @ brief Solve each model
  !<
  subroutine solve(this, kiter)
    ! -- dummy variables
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
    integer(I4B), intent(in) :: kiter !< Picard iteration (1 for explicit)
    ! -- local variables
    class(numericalmodeltype), pointer :: mp => null()
    integer(I4B) :: im
    real(DP) :: ttsoln
 
    call code_timer(0, ttsoln, this%ttsoln)
    do im = 1, this%modellist%Count()
      mp => getnumericalmodelfromlist(this%modellist, im)
      call mp%model_solve()
    end do
    call code_timer(1, ttsoln, this%ttsoln)
    this%icnvg = 1
  end subroutine solve
 
  !> @ brief Finalize solve
  !<
  subroutine finalizesolve(this, kiter, isgcnvg, isuppress_output)
    ! -- dummy variables
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
    integer(I4B), intent(in) :: kiter !< Picard iteration number (always 1 for explicit)
    integer(I4B), intent(inout) :: isgcnvg !< solution group convergence flag
    integer(I4B), intent(in) :: isuppress_output !< flag for suppressing output
    ! -- local variables
    integer(I4B) :: im
    class(numericalmodeltype), pointer :: mp => null()
 
    ! -- Calculate flow for each model
    do im = 1, this%modellist%Count()
      mp => getnumericalmodelfromlist(this%modellist, im)
      call mp%model_cq(this%icnvg, isuppress_output)
    end do
 
    ! -- Budget terms for each model
    do im = 1, this%modellist%Count()
      mp => getnumericalmodelfromlist(this%modellist, im)
      call mp%model_bd(this%icnvg, isuppress_output)
    end do
  end subroutine finalizesolve
 
  !> @ brief Save output
  !<
  subroutine save(this, filename)
    ! -- dummy variables
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
    character(len=*), intent(in) :: filename !< filename to save solution data
    ! -- local variables
    integer(I4B) :: inunit
 
    inunit = getunit()
    open (unit=inunit, file=filename, status='unknown')
    write (inunit, *) 'The save routine currently writes nothing'
    close (inunit)
  end subroutine save
 
  !> @ brief Add explicit model to list
  !<
  subroutine add_model(this, mp)
    ! -- dummy variables
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
    class(basemodeltype), pointer, intent(in) :: mp !< model instance
    ! -- local variables
    class(numericalmodeltype), pointer :: m => null()
 
    ! -- add a model
    select type (mp)
    class is (numericalmodeltype)
      m => mp
      call addnumericalmodeltolist(this%modellist, m)
    end select
  end subroutine add_model
 
  !> @brief Get a pointer to a list of models in the solution
  !<
  function get_models(this) result(models)
    type(listtype), pointer :: models !< pointer to the model list
    class(explicitsolutiontype) :: this !< ExplicitSolutionType instance
 
    models => this%modellist
  end function get_models
 
  !> @ brief Add exchange to list of exchanges
  !<
  subroutine add_exchange(this, exchange)
    class(explicitsolutiontype) :: this
    class(baseexchangetype), pointer, intent(in) :: exchange
  end subroutine add_exchange
 
  !> @ brief Get list of exchanges
  !<
  function get_exchanges(this) result(exchanges)
    class(explicitsolutiontype) :: this
    type(listtype), pointer :: exchanges
  end function get_exchanges
 
end module explicitsolutionmodule