boundinputcontextmodule Module Reference

This module contains the BoundInputContextModule. More...

Data Types
type	readstatevartype
	Pointer type for read state variable. More...
type	boundinputcontexttype
	derived type for boundary package input context More...

Functions/Subroutines
subroutine	create (this, mf6_input, readasarrays)
	create boundary input context More...
subroutine	allocate_scalars (this)
	create boundary input context More...
subroutine	allocate_arrays (this)
	allocate_arrays More...
subroutine	list_params_create (this, params, nparam, input_name)
subroutine	array_params_create (this, params, nparam, input_name)
	allocate dfn array input period block parameters More...
subroutine	destroy (this)
	destroy boundary input context More...
character(len=lenvarname) function	rsv_alloc (this, mf6varname)
	allocate a read state variable More...
subroutine	bound_params (this, params, nparam, input_name, create)
	allocate and set input array to filtered param set More...
character(len=lenvarname) function, public	rsv_name (mf6varname)
	create read state variable name More...

Detailed Description

This module contains a type that stores and creates context relevant to stress package inputs.

Function/Subroutine Documentation

allocate_arrays()

subroutine boundinputcontextmodule::allocate_arrays

(

class(boundinputcontexttype)

this

)

allocate bound input context arrays

Definition at line 149 of file BoundInputContext.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate, mem_setptr, get_isize
    use memorymanagerextmodule, only: mem_set_value
    ! -- dummy
    class(BoundInputContextType) :: this
    integer(I4B), dimension(:, :), pointer, contiguous :: cellid
    ! -- local
    !
    ! -- set auxname_cst and iauxmultcol
    if (this%naux > 0) then
      call mem_setptr(this%auxname_cst, 'AUXILIARY', this%mf6_input%mempath)
    else
      call mem_allocate(this%auxname_cst, lenauxname, 0, &
                        'AUXILIARY', this%mf6_input%mempath)
    end if
    !
    ! -- allocate cellid if this is not list input
    if (this%readasarrays) then
      call mem_allocate(cellid, 0, 0, 'CELLID', this%mf6_input%mempath)
    end if
    !
    ! -- set pointer to BOUNDNAME
    call mem_setptr(this%boundname_cst, 'BOUNDNAME', this%mf6_input%mempath)
    !
    ! -- set pointer to AUXVAR
    call mem_setptr(this%auxvar, 'AUXVAR', this%mf6_input%mempath)
    !
    ! -- return
    return

Here is the call graph for this function:

allocate_scalars()

subroutine boundinputcontextmodule::allocate_scalars ( class(boundinputcontexttype)  this )

private

Definition at line 92 of file BoundInputContext.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate, mem_setptr, get_isize
    use memorymanagerextmodule, only: mem_set_value
    ! -- dummy
    class(BoundInputContextType) :: this
    logical(LGP) :: found
    !
    ! -- set pointers to defined scalars
    call mem_setptr(this%naux, 'NAUX', this%mf6_input%mempath)
    !
    ! -- allocate memory managed scalars
    call mem_allocate(this%nbound, 'NBOUND', this%mf6_input%mempath)
    call mem_allocate(this%ncpl, 'NCPL', this%mf6_input%mempath)
    !
    ! -- internally allocate package optional scalars
    allocate (this%maxbound)
    allocate (this%inamedbound)
    allocate (this%iprpak)
    !
    ! -- initialize allocated and internal scalars
    this%nbound = 0
    this%ncpl = 0
    this%maxbound = 0
    this%inamedbound = 0
    this%iprpak = 0
    !
    ! -- update optional scalars
    call mem_set_value(this%inamedbound, 'BOUNDNAMES', this%mf6_input%mempath, &
                       found)
    call mem_set_value(this%maxbound, 'MAXBOUND', this%mf6_input%mempath, found)
    call mem_set_value(this%iprpak, 'IPRPAK', this%mf6_input%mempath, found)
    !
    ! -- set pointer to model shape
    call mem_setptr(this%mshape, 'MODEL_SHAPE', &
                    this%mf6_input%component_mempath)
    !
    ! -- update ncpl from model shape
    if (size(this%mshape) == 2) then
      this%ncpl = this%mshape(2)
    else if (size(this%mshape) == 3) then
      this%ncpl = this%mshape(2) * this%mshape(3)
    end if
    !
    ! -- initialize package params object
    call this%package_params%init(this%mf6_input, 'PERIOD', this%readasarrays, &
                                  this%naux, this%inamedbound)
    !
    ! -- return
    return

Here is the call graph for this function:

array_params_create()

subroutine boundinputcontextmodule::array_params_create	(	class(boundinputcontexttype)	this,
		character(len=*), dimension(:), intent(in), allocatable	params,
		integer(i4b), intent(in)	nparam,
		character(len=*), intent(in)	input_name
	)

Currently supports numeric (i.e. array based) params

Definition at line 259 of file BoundInputContext.f90.

    ! -- modules
    use definitionselectmodule, only: get_param_definition_type
    use dynamicpackageparamsmodule, only: allocate_param_int1d, &
                                          allocate_param_dbl1d, &
                                          allocate_param_dbl2d
    ! -- dummy
    class(BoundInputContextType) :: this
    character(len=*), dimension(:), allocatable, intent(in) :: params
    integer(I4B), intent(in) :: nparam
    character(len=*), intent(in) :: input_name
    ! -- local
    type(InputParamDefinitionType), pointer :: idt
    integer(I4B) :: iparam
    !
    ! -- allocate dfn input params
    do iparam = 1, nparam
      !
      ! -- assign param definition pointer
      idt => get_param_definition_type(this%mf6_input%param_dfns, &
                                       this%mf6_input%component_type, &
                                       this%mf6_input%subcomponent_type, &
                                       'PERIOD', params(iparam), '')
      !
      if (idt%blockname == 'PERIOD') then
        select case (idt%datatype)
        case ('INTEGER1D')
          call allocate_param_int1d(this%ncpl, idt%mf6varname, &
                                    this%mf6_input%mempath)
          !
        case ('DOUBLE1D')
          call allocate_param_dbl1d(this%ncpl, idt%mf6varname, &
                                    this%mf6_input%mempath)
          !
        case ('DOUBLE2D')
          call allocate_param_dbl2d(this%naux, this%ncpl, idt%mf6varname, &
                                    this%mf6_input%mempath)
          !
        case default
          errmsg = 'IDM unimplemented. BoundInputContext::array_params_create &
                   &datatype='//trim(idt%datatype)
          call store_error(errmsg)
          call store_error_filename(input_name)
        end select
      end if
    end do
    !
    ! -- return
    return

Here is the call graph for this function:

bound_params()

subroutine boundinputcontextmodule::bound_params	(	class(boundinputcontexttype)	this,
		character(len=linelength), dimension(:), intent(inout), allocatable	params,
		integer(i4b), intent(inout)	nparam,
		character(len=*), intent(in)	input_name,
		logical(lgp), intent(in), optional	create
	)

Definition at line 375 of file BoundInputContext.f90.

    ! -- modules
    ! -- dummy
    class(BoundInputContextType) :: this
    character(len=LINELENGTH), dimension(:), allocatable, &
      intent(inout) :: params
    integer(I4B), intent(inout) :: nparam
    character(len=*), intent(in) :: input_name
    logical(LGP), optional, intent(in) :: create
    logical(LGP) :: allocate_params
    integer(I4B) :: n
    !
    ! -- initialize allocate_params
    allocate_params = .true.
    !
    ! -- override default if provided
    if (present(create)) then
      allocate_params = create
    end if
    !
    if (allocated(params)) deallocate (params)
    !
    nparam = this%package_params%nparam
    !
    allocate (params(nparam))
    !
    do n = 1, nparam
      params(n) = this%package_params%params(n)
    end do
    !
    if (allocate_params) then
      if (this%readasarrays) then
        !
        call this%array_params_create(params, nparam, input_name)
      else
        !
        call this%list_params_create(params, nparam, input_name)
      end if
    end if
    !
    ! -- return
    return

create()

subroutine boundinputcontextmodule::create ( class(boundinputcontexttype)  this, type(modflowinputtype), intent(in)  mf6_input, logical(lgp), intent(in)  readasarrays  )

private

Definition at line 72 of file BoundInputContext.f90.

    ! -- modules
    ! -- dummy
    class(BoundInputContextType) :: this
    type(ModflowInputType), intent(in) :: mf6_input
    logical(LGP), intent(in) :: readasarrays
    !
    this%mf6_input = mf6_input
    this%readasarrays = readasarrays
    !
    ! -- create the dynamic package input context
    call this%allocate_scalars()
    !
    ! --return
    return

destroy()

subroutine boundinputcontextmodule::destroy

(

class(boundinputcontexttype)

this

)

Definition at line 313 of file BoundInputContext.f90.

    ! -- modules
    ! -- dummy
    class(BoundInputContextType) :: this
    !
    ! -- destroy package params object
    call this%package_params%destroy()
    !
    ! -- deallocate
    deallocate (this%maxbound)
    deallocate (this%inamedbound)
    deallocate (this%iprpak)
    !
    ! -- nullify
    nullify (this%naux)
    nullify (this%nbound)
    nullify (this%ncpl)
    nullify (this%maxbound)
    nullify (this%inamedbound)
    nullify (this%iprpak)
    nullify (this%auxname_cst)
    nullify (this%boundname_cst)
    nullify (this%auxvar)
    nullify (this%mshape)
    !
    ! --return
    return

list_params_create()

subroutine boundinputcontextmodule::list_params_create	(	class(boundinputcontexttype)	this,
		character(len=*), dimension(:), intent(in), allocatable	params,
		integer(i4b), intent(in)	nparam,
		character(len=*), intent(in)	input_name
	)

Definition at line 181 of file BoundInputContext.f90.

    ! -- modules
    use inputdefinitionmodule, only: inputparamdefinitiontype
    use definitionselectmodule, only: get_param_definition_type
    use dynamicpackageparamsmodule, only: allocate_param_int1d, &
                                          allocate_param_int2d, &
                                          allocate_param_dbl1d, &
                                          allocate_param_dbl2d, &
                                          allocate_param_charstr
    ! -- dummy
    class(BoundInputContextType) :: this
    character(len=*), dimension(:), allocatable, intent(in) :: params
    integer(I4B), intent(in) :: nparam
    character(len=*), intent(in) :: input_name
    ! -- local
    type(InputParamDefinitionType), pointer :: idt
    integer(I4B) :: iparam
    !
    ! --
    do iparam = 1, nparam
      idt => get_param_definition_type(this%mf6_input%param_dfns, &
                                       this%mf6_input%component_type, &
                                       this%mf6_input%subcomponent_type, &
                                       'PERIOD', params(iparam), '')
      !
      ! allocate based on dfn datatype
      select case (idt%datatype)
      case ('INTEGER')
        call allocate_param_int1d(this%maxbound, idt%mf6varname, &
                                  this%mf6_input%mempath)
        !
      case ('DOUBLE')
        call allocate_param_dbl1d(this%maxbound, idt%mf6varname, &
                                  this%mf6_input%mempath)
        !
      case ('STRING')
        call allocate_param_charstr(lenboundname, this%maxbound, idt%mf6varname, &
                                    this%mf6_input%mempath)
        !
      case ('INTEGER1D')
        if (idt%shape == 'NCELLDIM') then
          call allocate_param_int2d(size(this%mshape), this%maxbound, &
                                    idt%mf6varname, this%mf6_input%mempath)
        else
          errmsg = 'IDM unimplemented. BoundInputContext::list_params_create &
                   &shape='//trim(idt%shape)
          call store_error(errmsg)
          call store_error_filename(input_name)
        end if
        !
      case ('DOUBLE1D')
        if (idt%shape == 'NAUX') then
          call allocate_param_dbl2d(this%naux, this%maxbound, &
                                    idt%mf6varname, this%mf6_input%mempath)
        else
          errmsg = 'IDM unimplemented. BoundInputContext::list_params_create &
                   &tagname='//trim(idt%tagname)
          call store_error(errmsg)
          call store_error_filename(input_name)
        end if
        !
      case default
        errmsg = 'IDM unimplemented. BoundInputContext::list_params_create &
                 &datatype='//trim(idt%datatype)
        call store_error(errmsg)
        call store_error_filename(input_name)
      end select
    end do
    !
    ! -- return
    return

Here is the call graph for this function:

rsv_alloc()

character(len=lenvarname) function boundinputcontextmodule::rsv_alloc ( class(boundinputcontexttype)  this, character(len=*), intent(in)  mf6varname  )

private

Create and set a read state variable, e.g. 'INRECHARGE', which are updated per iper load as follows: -1: unset, not in use 0: not read in most recent period block 1: numeric input read in most recent period block 2: time series input read in most recent period block

Definition at line 352 of file BoundInputContext.f90.

    ! -- modules
    use constantsmodule, only: lenvarname
    use memorymanagermodule, only: mem_setptr, mem_allocate
    ! -- dummy
    class(BoundInputContextType) :: this
    character(len=*), intent(in) :: mf6varname
    ! -- local
    character(len=LENVARNAME) :: varname
    integer(I4B), pointer :: intvar
    !
    varname = rsv_name(mf6varname)
    !
    call mem_allocate(intvar, varname, this%mf6_input%mempath)
    intvar = -1
    !
    ! -- return
    return

Here is the call graph for this function:

rsv_name()

character(len=lenvarname) function, public boundinputcontextmodule::rsv_name

(

character(len=*), intent(in)

mf6varname

)

Definition at line 422 of file BoundInputContext.f90.

    ! -- modules
    use constantsmodule, only: lenvarname
    ! -- dummy
    character(len=*), intent(in) :: mf6varname
    ! -- local
    character(len=LENVARNAME) :: varname
    integer(I4B) :: ilen
    character(len=2) :: prefix = 'IN'
    !
    ilen = len_trim(mf6varname)
    !
    if (ilen > (lenvarname - len(prefix))) then
      varname = prefix//mf6varname(1:(lenvarname - len(prefix)))
    else
      varname = prefix//trim(mf6varname)
    end if
    !
    ! -- return
    return

Here is the caller graph for this function: