InputLoadType.f90

Go to the documentation of this file.

!> @brief This module contains the InputLoadTypeModule
!!
!! This module defines types that support generic IDM
!! static and dynamic input loading.
!!
!<
module inputloadtypemodule
 
  use kindmodule, only: dp, i4b, lgp
  use constantsmodule, only: linelength, lencomponentname, lenmodelname
  use simvariablesmodule, only: errmsg
  use simmodule, only: store_error, store_error_filename
  use modflowinputmodule, only: modflowinputtype
  use listmodule, only: listtype
  use inputdefinitionmodule, only: inputparamdefinitiontype
 
  implicit none
  private
  public :: staticpkgloadbasetype
  public :: dynamicpkgloadbasetype
  public :: modeldynamicpkgstype
  public :: adddynamicmodeltolist, getdynamicmodelfromlist
  public :: staticpkgloadtype, dynamicpkgloadtype
 
  !> @brief Static loader type
  !!
  !! This type is a base concrete type for a static input loader
  !!
  !<
  type staticpkgloadtype
    type(modflowinputtype) :: mf6_input !< description of modflow6 input
    character(len=LENCOMPONENTNAME) :: component_name !< name of component
    character(len=LINELENGTH) :: component_input_name !< component input name, e.g. model name file
    character(len=LINELENGTH) :: input_name !< input name, e.g. package *.chd file
    integer(I4B) :: iperblock !< index of period block on block definition list
  contains
    procedure :: init => static_init
    procedure :: destroy => static_destroy
  end type staticpkgloadtype
 
  !> @brief Base abstract type for static input loader
  !!
  !! IDM sources should extend and implement this type
  !!
  !<
  type, abstract, extends(staticpkgloadtype) :: staticpkgloadbasetype
  contains
    procedure(load_if), deferred :: load
  end type staticpkgloadbasetype
 
  !> @brief Dynamic loader type
  !!
  !! This type is a base concrete type for a dynamic (period) input loader
  !!
  !<
  type :: dynamicpkgloadtype
    type(modflowinputtype) :: mf6_input !< description of modflow6 input
    character(len=LENCOMPONENTNAME) :: component_name !< name of component
    character(len=LINELENGTH) :: component_input_name !< component input name, e.g. model name file
    character(len=LINELENGTH) :: input_name !< input name, e.g. package *.chd file
    character(len=LINELENGTH), dimension(:), allocatable :: param_names !< dynamic param tagnames
    logical(LGP) :: readasarrays !< is this array based input
    integer(I4B) :: iperblock !< index of period block on block definition list
    integer(I4B) :: iout !< inunit number for logging
    integer(I4B) :: nparam !< number of in scope params
  contains
    procedure :: init => dynamic_init
    procedure :: df => dynamic_df
    procedure :: ad => dynamic_ad
    procedure :: destroy => dynamic_destroy
  end type dynamicpkgloadtype
 
  !> @brief Base abstract type for dynamic input loader
  !!
  !! IDM sources should extend and implement this type
  !!
  !<
  type, abstract, extends(dynamicpkgloadtype) :: dynamicpkgloadbasetype
  contains
    procedure(period_load_if), deferred :: rp
  end type dynamicpkgloadbasetype
 
  !> @brief load interfaces for source static and dynamic types
  !<
  abstract interface
    function load_if(this, iout) result(dynamic_loader)
      import staticpkgloadbasetype, dynamicpkgloadbasetype, i4b
      class(staticpkgloadbasetype), intent(inout) :: this
      integer(I4B), intent(in) :: iout
      class(dynamicpkgloadbasetype), pointer :: dynamic_loader
    end function load_if
    subroutine period_load_if(this)
      import dynamicpkgloadbasetype, i4b
      class(dynamicpkgloadbasetype), intent(inout) :: this
    end subroutine
  end interface
 
  !> @brief type for storing a dynamic package load list
  !!
  !! This type is used to store a list of package
  !! dynamic load types for a model
  !!
  !<
  type :: modeldynamicpkgstype
    character(len=LENMODELNAME) :: modelname !< name of model
    character(len=LINELENGTH) :: modelfname !< name of model input file
    type(listtype) :: pkglist !< list of pointers to model dynamic package loaders
    integer(I4B) :: iout
  contains
    procedure :: init => dynamicpkgs_init
    procedure :: add => dynamicpkgs_add
    procedure :: get => dynamicpkgs_get
    procedure :: rp => dynamicpkgs_rp
    procedure :: df => dynamicpkgs_df
    procedure :: ad => dynamicpkgs_ad
    procedure :: size => dynamicpkgs_size
    procedure :: destroy => dynamicpkgs_destroy
  end type modeldynamicpkgstype
 
contains
 
  !> @brief initialize static package loader
  !!
  !<
  subroutine static_init(this, mf6_input, component_name, component_input_name, &
                         input_name)
    class(staticpkgloadtype), intent(inout) :: this
    type(modflowinputtype), intent(in) :: mf6_input
    character(len=*), intent(in) :: component_name
    character(len=*), intent(in) :: component_input_name
    character(len=*), intent(in) :: input_name
    integer(I4B) :: iblock
    !
    this%mf6_input = mf6_input
    this%component_name = component_name
    this%component_input_name = component_input_name
    this%input_name = input_name
    this%iperblock = 0
    !
    ! -- identify period block definition
    do iblock = 1, size(mf6_input%block_dfns)
      !
      if (mf6_input%block_dfns(iblock)%blockname == 'PERIOD') then
        this%iperblock = iblock
        exit
      end if
    end do
    !
    return
  end subroutine static_init
 
  subroutine static_destroy(this)
    class(staticpkgloadtype), intent(inout) :: this
    !
    return
  end subroutine static_destroy
 
  !> @brief initialize dynamic package loader
  !!
  !! Any managed memory pointed to from model/package context
  !! must be allocated when dynamic loader is initialized.
  !!
  !<
  subroutine dynamic_init(this, mf6_input, component_name, component_input_name, &
                          input_name, iperblock, iout)
    use simvariablesmodule, only: errmsg
    use inputdefinitionmodule, only: inputparamdefinitiontype
    ! -- dummy
    class(dynamicpkgloadtype), intent(inout) :: this
    type(modflowinputtype), intent(in) :: mf6_input
    character(len=*), intent(in) :: component_name
    character(len=*), intent(in) :: component_input_name
    character(len=*), intent(in) :: input_name
    integer(I4B), intent(in) :: iperblock
    integer(I4B), intent(in) :: iout
    type(inputparamdefinitiontype), pointer :: idt
    !
    this%mf6_input = mf6_input
    this%component_name = component_name
    this%component_input_name = component_input_name
    this%input_name = input_name
    this%iperblock = iperblock
    this%nparam = 0
    this%iout = iout
    nullify (idt)
    !
    ! -- throw error and exit if not found
    if (this%iperblock == 0) then
      write (errmsg, '(a,a)') &
        'Programming error. (IDM) PERIOD block not found in '&
        &'dynamic package input block dfns: ', &
        trim(mf6_input%subcomponent_name)
      call store_error(errmsg)
      call store_error_filename(this%input_name)
    end if
    !
    ! -- set readasarrays
    this%readasarrays = (.not. mf6_input%block_dfns(iperblock)%aggregate)
    !
    ! -- return
    return
  end subroutine dynamic_init
 
  !> @brief dynamic package loader define
  !!
  !<
  subroutine dynamic_df(this)
    class(dynamicpkgloadtype), intent(inout) :: this
    !
    ! override in derived type
    !
    return
  end subroutine dynamic_df
 
  !> @brief dynamic package loader advance
  !!
  !<
  subroutine dynamic_ad(this)
    class(dynamicpkgloadtype), intent(inout) :: this
    !
    ! override in derived type
    !
    return
  end subroutine dynamic_ad
 
  !> @brief dynamic package loader destroy
  !!
  !<
  subroutine dynamic_destroy(this)
    use memorymanagermodule, only: mem_deallocate
    use memorymanagerextmodule, only: memorylist_remove
    use simvariablesmodule, only: idm_context
    class(dynamicpkgloadtype), intent(inout) :: this
    !
    ! -- deallocate package static and dynamic input context
    call memorylist_remove(this%mf6_input%component_name, &
                           this%mf6_input%subcomponent_name, &
                           idm_context)
    !
    return
  end subroutine dynamic_destroy
 
  !> @brief model dynamic packages init
  !!
  !<
  subroutine dynamicpkgs_init(this, modelname, modelfname, iout)
    class(modeldynamicpkgstype), intent(inout) :: this
    character(len=*), intent(in) :: modelname
    character(len=*), intent(in) :: modelfname
    integer(I4B), intent(in) :: iout
    !
    this%modelname = modelname
    this%modelfname = modelfname
    this%iout = iout
    !
    return
  end subroutine dynamicpkgs_init
 
  !> @brief add package to model dynamic packages list
  !!
  !<
  subroutine dynamicpkgs_add(this, dynamic_pkg)
    class(modeldynamicpkgstype), intent(inout) :: this
    class(dynamicpkgloadbasetype), pointer, intent(inout) :: dynamic_pkg
    class(*), pointer :: obj
    !
    obj => dynamic_pkg
    call this%pkglist%add(obj)
    !
    return
  end subroutine dynamicpkgs_add
 
  !> @brief retrieve package from model dynamic packages list
  !!
  !<
  function dynamicpkgs_get(this, idx) result(res)
    class(modeldynamicpkgstype), intent(inout) :: this
    integer(I4B), intent(in) :: idx
    class(dynamicpkgloadbasetype), pointer :: res
    class(*), pointer :: obj
    !
    nullify (res)
    obj => this%pkglist%GetItem(idx)
    !
    if (associated(obj)) then
      select type (obj)
      class is (dynamicpkgloadbasetype)
        res => obj
      end select
    end if
    !
    return
  end function dynamicpkgs_get
 
  !> @brief read and prepare model dynamic packages
  !!
  !<
  subroutine dynamicpkgs_rp(this)
    use idmloggermodule, only: idm_log_period_header, idm_log_period_close
    class(modeldynamicpkgstype), intent(inout) :: this
    class(dynamicpkgloadbasetype), pointer :: dynamic_pkg
    integer(I4B) :: n
    !
    call idm_log_period_header(this%modelname, this%iout)
    !
    do n = 1, this%pkglist%Count()
      dynamic_pkg => this%get(n)
      call dynamic_pkg%rp()
    end do
    !
    call idm_log_period_close(this%iout)
    !
    return
  end subroutine dynamicpkgs_rp
 
  !> @brief define model dynamic packages
  !!
  !<
  subroutine dynamicpkgs_df(this)
    class(modeldynamicpkgstype), intent(inout) :: this
    class(dynamicpkgloadbasetype), pointer :: dynamic_pkg
    integer(I4B) :: n
    !
    do n = 1, this%pkglist%Count()
      dynamic_pkg => this%get(n)
      call dynamic_pkg%df()
    end do
    !
    return
  end subroutine dynamicpkgs_df
 
  !> @brief advance model dynamic packages
  !!
  !<
  subroutine dynamicpkgs_ad(this)
    class(modeldynamicpkgstype), intent(inout) :: this
    class(dynamicpkgloadbasetype), pointer :: dynamic_pkg
    integer(I4B) :: n
    !
    do n = 1, this%pkglist%Count()
      dynamic_pkg => this%get(n)
      call dynamic_pkg%ad()
    end do
    !
    return
  end subroutine dynamicpkgs_ad
 
  !> @brief get size of model dynamic packages list
  !!
  !<
  function dynamicpkgs_size(this) result(size)
    class(modeldynamicpkgstype), intent(inout) :: this
    integer(I4B) :: size
    !
    size = this%pkglist%Count()
    !
    return
  end function dynamicpkgs_size
 
  !> @brief destroy model dynamic packages object
  !!
  !<
  subroutine dynamicpkgs_destroy(this)
    class(modeldynamicpkgstype), intent(inout) :: this
    class(dynamicpkgloadbasetype), pointer :: dynamic_pkg
    integer(I4B) :: n
    !
    do n = 1, this%pkglist%Count()
      dynamic_pkg => this%get(n)
      call dynamic_pkg%destroy()
      deallocate (dynamic_pkg)
      nullify (dynamic_pkg)
    end do
    !
    call this%pkglist%Clear()
    !
    return
  end subroutine dynamicpkgs_destroy
 
  !> @brief add model dynamic packages object to list
  !!
  !<
  subroutine adddynamicmodeltolist(list, model_dynamic)
    ! -- dummy variables
    type(listtype), intent(inout) :: list !< package list
    class(modeldynamicpkgstype), pointer, intent(inout) :: model_dynamic
    ! -- local variables
    class(*), pointer :: obj
    !
    obj => model_dynamic
    call list%Add(obj)
    !
    ! -- return
    return
  end subroutine adddynamicmodeltolist
 
  !> @brief get model dynamic packages object from list
  !!
  !<
  function getdynamicmodelfromlist(list, idx) result(res)
    ! -- dummy variables
    type(listtype), intent(inout) :: list !< spd list
    integer(I4B), intent(in) :: idx !< package number
    class(modeldynamicpkgstype), pointer :: res
    ! -- local variables
    class(*), pointer :: obj
    !
    ! -- initialize res
    nullify (res)
    !
    ! -- get the object from the list
    obj => list%GetItem(idx)
    if (associated(obj)) then
      select type (obj)
      class is (modeldynamicpkgstype)
        res => obj
      end select
    end if
    !
    ! -- return
    return
  end function getdynamicmodelfromlist
 
end module inputloadtypemodule