BaseModel.f90

Go to the documentation of this file.

module basemodelmodule
 
  use kindmodule, only: dp, i4b
  use constantsmodule, only: lenmodelname, linelength, lenmempath
  use listmodule, only: listtype
  implicit none
 
  private
  public :: basemodeltype, castasbasemodelclass, addbasemodeltolist, &
            getbasemodelfromlist
 
  !> @brief Highest level model type. All models extend this parent type.
  type :: basemodeltype
    character(len=LENMEMPATH) :: memorypath !< the location in the memory manager where the variables are stored
    character(len=LENMODELNAME), pointer :: name => null() !< name of the model
    character(len=3), pointer :: macronym => null() !< 3 letter model acronym (GWF, GWT, ...)
    integer(I4B), pointer :: idsoln => null() !< id of the solution model is in
    integer(I4B), pointer :: id => null() !< model id
    integer(I4B), pointer :: iout => null() !< output unit number
    integer(I4B), pointer :: inewton => null() !< newton-raphson flag
    integer(I4B), pointer :: iprpak => null() !< integer flag to echo input
    integer(I4B), pointer :: iprflow => null() !< flag to print simulated flows
    integer(I4B), pointer :: ipakcb => null() !< save_flows flag
  contains
    procedure :: model_df
    procedure :: model_ar
    procedure :: model_rp
    procedure :: model_calculate_delt
    procedure :: model_ot
    procedure :: model_fp
    procedure :: model_da
    procedure :: allocate_scalars
    procedure :: model_message
  end type basemodeltype
 
contains
 
  !> @brief Define the model
  !<
  subroutine model_df(this)
    class(basemodeltype) :: this
  end subroutine model_df
 
  !> @brief Allocate and read
  !<
  subroutine model_ar(this)
    class(basemodeltype) :: this
  end subroutine model_ar
 
  !> @brief Read and prepare
  !<
  subroutine model_rp(this)
    class(basemodeltype) :: this
  end subroutine model_rp
 
  !> @brief Calculate time step length
  !<
  subroutine model_calculate_delt(this)
    class(basemodeltype) :: this
  end subroutine model_calculate_delt
 
  !> @brief Output results
  !<
  subroutine model_ot(this)
    class(basemodeltype) :: this
  end subroutine model_ot
 
  !> @brief Write line to model iout
  !<
  subroutine model_message(this, line, fmt)
    ! -- dummy
    class(basemodeltype) :: this
    character(len=*), intent(in) :: line
    character(len=*), intent(in), optional :: fmt
    ! -- local
    character(len=LINELENGTH) :: cfmt
    !
    ! -- process optional variables
    if (present(fmt)) then
      cfmt = fmt
    else
      cfmt = '(1x,a)'
    end if
    !
    ! -- write line
    write (this%iout, trim(cfmt)) trim(line)
  end subroutine model_message
 
  !> @brief Final processing
  !<
  subroutine model_fp(this)
    class(basemodeltype) :: this
  end subroutine model_fp
 
  !> @brief Allocate scalar variables
  !<
  subroutine allocate_scalars(this, modelname)
    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(basemodeltype) :: this
    character(len=*), intent(in) :: modelname
    !
    call mem_allocate(this%name, lenmodelname, 'NAME', this%memoryPath)
    call mem_allocate(this%macronym, 3, 'MACRONYM', this%memoryPath)
    call mem_allocate(this%id, 'ID', this%memoryPath)
    call mem_allocate(this%iout, 'IOUT', this%memoryPath)
    call mem_allocate(this%inewton, 'INEWTON', this%memoryPath)
    call mem_allocate(this%iprpak, 'IPRPAK', this%memoryPath)
    call mem_allocate(this%iprflow, 'IPRFLOW', this%memoryPath)
    call mem_allocate(this%ipakcb, 'IPAKCB', this%memoryPath)
    call mem_allocate(this%idsoln, 'IDSOLN', this%memoryPath)
    !
    this%name = modelname
    this%macronym = ''
    this%idsoln = 0
    this%id = 0
    this%iout = 0
    this%iprpak = 0
    this%iprflow = 0
    this%ipakcb = 0
    this%inewton = 0 !default is standard formulation
  end subroutine allocate_scalars
 
  !> @brief Deallocate
  !<
  subroutine model_da(this)
    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(basemodeltype) :: this
    !
    ! -- Strings
    call mem_deallocate(this%name, 'NAME', this%memoryPath)
    call mem_deallocate(this%macronym, 'MACRONYM', this%memoryPath)
    !
    ! -- Scalars
    call mem_deallocate(this%id)
    call mem_deallocate(this%iout)
    call mem_deallocate(this%inewton)
    call mem_deallocate(this%iprpak)
    call mem_deallocate(this%iprflow)
    call mem_deallocate(this%ipakcb)
    call mem_deallocate(this%idsoln)
  end subroutine model_da
 
  function castasbasemodelclass(obj) result(res)
    class(*), pointer, intent(inout) :: obj
    class(basemodeltype), pointer :: res
    !
    res => null()
    if (.not. associated(obj)) return
    !
    select type (obj)
    class is (basemodeltype)
      res => obj
    end select
  end function castasbasemodelclass
 
  subroutine addbasemodeltolist(list, model)
    ! -- dummy
    type(listtype), intent(inout) :: list
    class(basemodeltype), pointer, intent(inout) :: model
    ! -- local
    class(*), pointer :: obj
    !
    obj => model
    call list%Add(obj)
  end subroutine addbasemodeltolist
 
  function getbasemodelfromlist(list, idx) result(res)
    ! -- dummy
    type(listtype), intent(inout) :: list
    integer(I4B), intent(in) :: idx
    class(basemodeltype), pointer :: res
    ! -- local
    class(*), pointer :: obj
    !
    obj => list%GetItem(idx)
    res => castasbasemodelclass(obj)
  end function getbasemodelfromlist
 
end module basemodelmodule