loadcontextmodule Module Reference

This module contains the LoadContextModule. More...

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

Enumerations
enum	{   load_undef = 0 , list = 1 , layerarray = 2 , gridarray = 3 ,   keystring = 4 }
enum	{   context_undef = 0 , root = 1 , sim = 2 , model = 3 ,   modelpkg = 4 , stresspkg = 5 , exchange = 6 }

Functions/Subroutines
subroutine	init (this, mf6_input, blockname, named_bound)
	init loader context object More...
subroutine	allocate_scalars (this)
	allocate scalars More...
subroutine	allocate_arrays (this)
	allocate arrays More...
subroutine	allocate_param (this, idt)
	allocate a package dynamic input parameter More...
subroutine	tags (this, params, nparam, input_name, create)
	get in scope package params More...
logical(lgp) function	in_scope (this, mf6_input, blockname, tagname)
	establish if input parameter is in scope for package load More...
subroutine	set_params (this)
	set set of in scope parameters for package More...
character(len=lenvarname) function	rsv_alloc (this, mf6varname)
	allocate a read state variable More...
subroutine	destroy (this)
	destroy input context object More...
type(inputparamdefinitiontype) function, pointer	find_setting_aggregate (mf6_input, rec_cols, nrec_col)
	Return the KEYSTRING aggregate for the SETTING token in rec_cols, or null(). More...
subroutine	expand_record_submembers (mf6_input, rec_idt, member_names, nmembers)
	Append sub-member column names from a RECORD compound entry to member_names. More...
logical(lgp) function, public	is_keystring_period (mf6_input)
	Return .true. if mf6_input's PERIOD block uses keystring dispatch. More...
logical(lgp) function, public	has_dimensions_block (mf6_input)
	Return .true. if mf6_input is a keystring PERIOD dispatch paired with a DIMENSIONS block (e.g. SPC) rather than PACKAGEDATA. More...
logical(lgp) function, public	is_cellid_addressed (mf6_input)
	Return .true. if mf6_input is a keystring PERIOD dispatch whose leading column is CELLID (e.g. TVK/TVS) rather than a stable integer feature number. More...
subroutine	keystring_member_names (this, member_names, nmembers)
	Return keystring member column names for the PERIOD block. More...
character(len=lenvarname) function, public	rsv_name (mf6varname)
	create read state variable name More...
subroutine	allocate_charstr1d (strlen, nrow, varname, mempath)
	allocate character string type array More...
subroutine	allocate_int1d (nrow, varname, mempath)
	allocate int1d More...
subroutine	allocate_int2d (ncol, nrow, varname, mempath)
	allocate int2d More...
subroutine	allocate_dbl1d (nrow, varname, mempath)
	allocate dbl1d More...
subroutine	allocate_dbl2d (ncol, nrow, varname, mempath)
	allocate dbl2d More...
subroutine	sum_named_bounds (named_bound, mempath, total)
	sum named dimension variables from mempath More...
subroutine	setval (intptr, varname, mempath)
	allocate intptr and update from input contextset intptr to varname More...
subroutine	setptr_int (intptr, varname, mempath)
	set intptr to varname More...
subroutine	setptr_charstr1d (charstr1d, varname, mempath, strlen)
	set charstr1d pointer to varname More...
subroutine	setptr_auxvar (auxvar, mempath)
	set auxvar pointer More...

Detailed Description

This module creates a load context for IDM generic loaders (ListLoadType, LayerArrayLoadType, GridArrayLoadType) that supports consistent package side access. It also determines in scope parameters for the generic dynamic loaders and all structarray based static loads.

Enumeration Type Documentation

anonymous enum

anonymous enum

private

Enumerator
load_undef	undefined load type
list	list (structarray) based load
layerarray	readasarrays load
gridarray	readarraygrid load
keystring	basic keystring period block load

Definition at line 30 of file LoadContext.f90.

anonymous enum

anonymous enum

private

Enumerator
context_undef	undefined context type
root	root context type
sim	sim context type
model	model context type
modelpkg	model package context type
stresspkg	model stress package context type
exchange	exchange context type

Definition at line 38 of file LoadContext.f90.

Function/Subroutine Documentation

allocate_arrays()

subroutine loadcontextmodule::allocate_arrays

(

class(loadcontexttype)

this

)

call this routine after input parameters have been allocated, e.g. after load_params() with create has been called for array based loaders or after all mem_create_vector() calls have been made for list based load.

Definition at line 319 of file LoadContext.f90.

    use memorymanagermodule, only: mem_allocate, mem_setptr, get_isize
    class(LoadContextType) :: this
    integer(I4B), dimension(:, :), pointer, contiguous :: cellid
    integer(I4B), dimension(:), pointer, contiguous :: nodeulist
 
    if (this%ctxtype == stresspkg .and. &
        this%blockname == 'PERIOD') then
      ! allocate cellid if this is not list input
      if (this%readarray) then
        call mem_allocate(cellid, 0, 0, 'CELLID', this%mf6_input%mempath)
      end if
 
      ! allocate nodeulist for list and layerarray packages only;
      ! keystring packages do not use a flat nodeulist
      if (this%loadtype /= gridarray .and. &
          this%loadtype /= keystring) then
        call mem_allocate(nodeulist, 0, 'NODEULIST', this%mf6_input%mempath)
      end if
 
      ! set pointers to aux/bound arrays for list and layerarray packages only;
      ! keystring packages manage aux through struct array columns
      if (this%loadtype /= keystring) then
        call setptr(this%auxname_cst, 'AUXILIARY', &
                    this%mf6_input%mempath, lenauxname)
        call setptr(this%boundname_cst, 'BOUNDNAME', &
                    this%mf6_input%mempath, lenboundname)
        call setptr(this%auxvar, this%mf6_input%mempath)
      end if
 
    else if (this%ctxtype == exchange) then
      ! set pointers to arrays
      call setptr(this%auxname_cst, 'AUXILIARY', &
                  this%mf6_input%mempath, lenauxname)
      call setptr(this%boundname_cst, 'BOUNDNAME', &
                  this%mf6_input%mempath, lenboundname)
      call setptr(this%auxvar, this%mf6_input%mempath)
    end if

Here is the call graph for this function:

allocate_charstr1d()

subroutine loadcontextmodule::allocate_charstr1d	(	integer(i4b), intent(in)	strlen,
		integer(i4b), intent(in)	nrow,
		character(len=*), intent(in)	varname,
		character(len=*), intent(in)	mempath
	)

Parameters

[in]	strlen	string number of characters
[in]	nrow	integer array number of rows
[in]	varname	variable name
[in]	mempath	variable mempath

Definition at line 920 of file LoadContext.f90.

    use memorymanagermodule, only: mem_allocate
    integer(I4B), intent(in) :: strlen !< string number of characters
    integer(I4B), intent(in) :: nrow !< integer array number of rows
    character(len=*), intent(in) :: varname !< variable name
    character(len=*), intent(in) :: mempath !< variable mempath
    type(CharacterStringType), dimension(:), pointer, &
      contiguous :: charstr1d
    integer(I4B) :: n
    call mem_allocate(charstr1d, strlen, nrow, varname, mempath)
    do n = 1, nrow
      charstr1d(n) = ''
    end do

Here is the caller graph for this function:

allocate_dbl1d()

subroutine loadcontextmodule::allocate_dbl1d	(	integer(i4b), intent(in)	nrow,
		character(len=*), intent(in)	varname,
		character(len=*), intent(in)	mempath
	)

Parameters

[in]	nrow	integer array number of rows
[in]	varname	variable name
[in]	mempath	variable mempath

Definition at line 970 of file LoadContext.f90.

    use memorymanagermodule, only: mem_allocate
    integer(I4B), intent(in) :: nrow !< integer array number of rows
    character(len=*), intent(in) :: varname !< variable name
    character(len=*), intent(in) :: mempath !< variable mempath
    real(DP), dimension(:), pointer, contiguous :: dbl1d
    integer(I4B) :: n
    call mem_allocate(dbl1d, nrow, varname, mempath)
    do n = 1, nrow
      dbl1d(n) = dzero
    end do

Here is the caller graph for this function:

allocate_dbl2d()

subroutine loadcontextmodule::allocate_dbl2d	(	integer(i4b), intent(in)	ncol,
		integer(i4b), intent(in)	nrow,
		character(len=*), intent(in)	varname,
		character(len=*), intent(in)	mempath
	)

Parameters

[in]	ncol	integer array number of cols
[in]	nrow	integer array number of rows
[in]	varname	variable name
[in]	mempath	variable mempath

Definition at line 985 of file LoadContext.f90.

    use memorymanagermodule, only: mem_allocate
    integer(I4B), intent(in) :: ncol !< integer array number of cols
    integer(I4B), intent(in) :: nrow !< integer array number of rows
    character(len=*), intent(in) :: varname !< variable name
    character(len=*), intent(in) :: mempath !< variable mempath
    real(DP), dimension(:, :), pointer, contiguous :: dbl2d
    integer(I4B) :: n, m
    call mem_allocate(dbl2d, ncol, nrow, varname, mempath)
    do m = 1, nrow
      do n = 1, ncol
        dbl2d(n, m) = dzero
      end do
    end do

Here is the caller graph for this function:

allocate_int1d()

subroutine loadcontextmodule::allocate_int1d	(	integer(i4b), intent(in)	nrow,
		character(len=*), intent(in)	varname,
		character(len=*), intent(in)	mempath
	)

Parameters

[in]	nrow	integer array number of rows
[in]	varname	variable name
[in]	mempath	variable mempath

Definition at line 937 of file LoadContext.f90.

    use memorymanagermodule, only: mem_allocate
    integer(I4B), intent(in) :: nrow !< integer array number of rows
    character(len=*), intent(in) :: varname !< variable name
    character(len=*), intent(in) :: mempath !< variable mempath
    integer(I4B), dimension(:), pointer, contiguous :: int1d
    integer(I4B) :: n
    call mem_allocate(int1d, nrow, varname, mempath)
    do n = 1, nrow
      int1d(n) = izero
    end do

Here is the caller graph for this function:

allocate_int2d()

subroutine loadcontextmodule::allocate_int2d	(	integer(i4b), intent(in)	ncol,
		integer(i4b), intent(in)	nrow,
		character(len=*), intent(in)	varname,
		character(len=*), intent(in)	mempath
	)

Parameters

[in]	ncol	integer array number of cols
[in]	nrow	integer array number of rows
[in]	varname	variable name
[in]	mempath	variable mempath

Definition at line 952 of file LoadContext.f90.

    use memorymanagermodule, only: mem_allocate
    integer(I4B), intent(in) :: ncol !< integer array number of cols
    integer(I4B), intent(in) :: nrow !< integer array number of rows
    character(len=*), intent(in) :: varname !< variable name
    character(len=*), intent(in) :: mempath !< variable mempath
    integer(I4B), dimension(:, :), pointer, contiguous :: int2d
    integer(I4B) :: n, m
    call mem_allocate(int2d, ncol, nrow, varname, mempath)
    do m = 1, nrow
      do n = 1, ncol
        int2d(n, m) = izero
      end do
    end do

Here is the caller graph for this function:

allocate_param()

subroutine loadcontextmodule::allocate_param	(	class(loadcontexttype)	this,
		type(inputparamdefinitiontype), pointer	idt
	)

Definition at line 361 of file LoadContext.f90.

    use inputdefinitionmodule, only: inputparamdefinitiontype
    class(LoadContextType) :: this
    type(InputParamDefinitionType), pointer :: idt
    integer(I4B) :: dimsize
 
    ! initialize
    dimsize = 0
 
    if (this%readarray) then
      select case (idt%shape)
      case ('NCPL', 'NAUX NCPL')
        dimsize = this%ncpl
      case ('NODES', 'NAUX NODES')
        dimsize = this%maxbound
      case default
      end select
    end if
 
    select case (idt%datatype)
    case ('INTEGER')
      if (this%loadtype == list) then
        call allocate_int1d(this%maxbound, idt%mf6varname, &
                            this%mf6_input%mempath)
      end if
    case ('DOUBLE')
      if (this%loadtype == list) then
        call allocate_dbl1d(this%maxbound, idt%mf6varname, &
                            this%mf6_input%mempath)
      end if
    case ('STRING')
      if (this%loadtype == list) then
        call allocate_charstr1d(lenboundname, this%maxbound, idt%mf6varname, &
                                this%mf6_input%mempath)
      end if
    case ('INTEGER1D')
      if (this%loadtype == list) then
        if (idt%shape == 'NCELLDIM') then
          call allocate_int2d(size(this%mshape), this%maxbound, &
                              idt%mf6varname, this%mf6_input%mempath)
        end if
      else if (this%readarray) then
        call allocate_int1d(dimsize, idt%mf6varname, &
                            this%mf6_input%mempath)
      end if
    case ('DOUBLE1D')
      if (idt%shape == 'NAUX') then
        call allocate_dbl2d(this%naux, this%maxbound, &
                            idt%mf6varname, this%mf6_input%mempath)
      else if (this%readarray) then
        call allocate_dbl1d(dimsize, idt%mf6varname, &
                            this%mf6_input%mempath)
      end if
    case ('DOUBLE2D')
      if (this%readarray) then
        call allocate_dbl2d(this%naux, dimsize, idt%mf6varname, &
                            this%mf6_input%mempath)
      end if
    case default
    end select

Here is the call graph for this function:

allocate_scalars()

subroutine loadcontextmodule::allocate_scalars

(

class(loadcontexttype)

this

)

Definition at line 228 of file LoadContext.f90.

    use memorymanagermodule, only: mem_setptr, get_isize
    use definitionselectmodule, only: get_aggregate_definition_type, &
                                      idt_parse_rectype
    class(LoadContextType) :: this
    type(InputParamDefinitionType), pointer :: aidt, ks_aidt
    character(len=LINELENGTH), allocatable :: cols(:), ks_cols(:)
    integer(I4B) :: nmembers, ncol, isize
    integer(I4B), pointer :: maxbound_ptr
 
    if (this%ctxtype == exchange .or. &
        this%ctxtype == modelpkg .or. &
        this%ctxtype == stresspkg) then
 
      call setptr(this%nbound, 'NBOUND', this%mf6_input%mempath)
      call setval(this%naux, 'NAUX', this%mf6_input%mempath)
      call setval(this%ncpl, 'NCPL', this%mf6_input%mempath)
      call setval(this%nodes, 'NODES', this%mf6_input%mempath)
      call setval(this%boundnames, 'BOUNDNAMES', this%mf6_input%mempath)
      call setval(this%iprpak, 'IPRPAK', this%mf6_input%mempath)
 
      ! resolve maxbound: sum all named_bound variable values
      allocate (this%maxbound)
      this%maxbound = 0
      call sum_named_bounds(this%named_bound, this%mf6_input%mempath, &
                            this%maxbound)
      ! fallback: try MAXBOUND directly when named_bound tokens yield nothing
      if (this%maxbound == 0) then
        call get_isize('MAXBOUND', this%mf6_input%mempath, isize)
        if (isize > -1) then
          call mem_setptr(maxbound_ptr, 'MAXBOUND', this%mf6_input%mempath)
          this%maxbound = maxbound_ptr
          nullify (maxbound_ptr)
        end if
      end if
 
      ! reset nbound
      this%nbound = 0
    end if
 
    if (this%ctxtype == stresspkg .and. &
        this%blockname == 'PERIOD') then
      call mem_setptr(this%mshape, 'MODEL_SHAPE', &
                      this%mf6_input%component_mempath)
 
      if (this%ncpl == 0) then
        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
      end if
 
      if (this%nodes == 0) this%nodes = product(this%mshape)
 
      ! scale maxbound by keystring member count; fall back to nodes * nmembers
      ! when no DIMENSIONS block is present (e.g. TVK/TVS)
      if (this%loadtype == keystring) then
        ! count members from the KEYSTRING aggregate type definition, which
        ! names exactly the dispatchable members
        nmembers = 0
        aidt => get_aggregate_definition_type(this%mf6_input%aggregate_dfns, &
                                              this%mf6_input%component_type, &
                                              this%mf6_input%subcomponent_type, &
                                              'PERIOD')
        call idt_parse_rectype(aidt, cols, ncol)
        ks_aidt => find_setting_aggregate(this%mf6_input, cols, ncol)
        if (associated(ks_aidt)) then
          call idt_parse_rectype(ks_aidt, ks_cols, nmembers)
        end if
        if (allocated(cols)) deallocate (cols)
        if (allocated(ks_cols)) deallocate (ks_cols)
        if (this%maxbound == 0) then
          this%maxbound = this%nodes * nmembers
        else if (this%is_dimensions_scoped .and. nmembers > 0) then
          ! DIMENSIONS-block-paired (e.g. SPC): scale the raw feature-count
          ! maxbound by member count; resolve_nfeatures divides it back out
          this%maxbound = this%maxbound * nmembers
        end if
      end if
    end if

Here is the call graph for this function:

destroy()

subroutine loadcontextmodule::destroy

(

class(loadcontexttype)

this

)

Definition at line 662 of file LoadContext.f90.

    class(LoadContextType) :: this
 
    if (allocated(this%named_bound)) deallocate (this%named_bound)
 
    if (associated(this%setting_idt)) then
      deallocate (this%setting_idt)
      nullify (this%setting_idt)
    end if
 
    if (this%ctxtype == exchange .or. &
        this%ctxtype == stresspkg) then
      ! deallocate local
      deallocate (this%naux)
      deallocate (this%ncpl)
      deallocate (this%nodes)
      deallocate (this%maxbound)
      deallocate (this%boundnames)
      deallocate (this%iprpak)
    end if
 
    ! nullify
    nullify (this%naux)
    nullify (this%nbound)
    nullify (this%ncpl)
    nullify (this%nodes)
    nullify (this%maxbound)
    nullify (this%boundnames)
    nullify (this%iprpak)
    nullify (this%auxname_cst)
    nullify (this%boundname_cst)
    nullify (this%auxvar)
    nullify (this%mshape)

expand_record_submembers()

subroutine loadcontextmodule::expand_record_submembers	(	type(modflowinputtype), intent(in)	mf6_input,
		type(inputparamdefinitiontype), intent(in), pointer	rec_idt,
		character(len=linelength), dimension(:), intent(inout), allocatable	member_names,
		integer(i4b), intent(inout)	nmembers
	)

Definition at line 730 of file LoadContext.f90.

    use inputoutputmodule, only: upcase
    use arrayhandlersmodule, only: expandarray
    use definitionselectmodule, only: idt_parse_rectype, idt_datatype
    type(ModflowInputType), intent(in) :: mf6_input
    type(InputParamDefinitionType), pointer, intent(in) :: rec_idt
    character(len=LINELENGTH), allocatable, intent(inout) :: member_names(:)
    integer(I4B), intent(inout) :: nmembers
    type(InputParamDefinitionType), pointer :: sub_idt
    character(len=LINELENGTH), allocatable :: sub_cols(:)
    character(len=LINELENGTH) :: token, tagname
    integer(I4B) :: k, j, nsub_col
    call idt_parse_rectype(rec_idt, sub_cols, nsub_col)
    do k = 1, nsub_col
      token = trim(sub_cols(k))
      call upcase(token)
      do j = 1, size(mf6_input%param_dfns)
        sub_idt => mf6_input%param_dfns(j)
        if (sub_idt%blockname /= 'PERIOD') cycle
        tagname = sub_idt%tagname
        call upcase(tagname)
        if (trim(tagname) /= trim(token)) cycle
        if (idt_datatype(sub_idt) == 'RECORD') cycle
        nmembers = nmembers + 1
        call expandarray(member_names)
        member_names(nmembers) = trim(sub_idt%tagname)
        exit
      end do
    end do
    if (allocated(sub_cols)) deallocate (sub_cols)

Here is the call graph for this function:

Here is the caller graph for this function:

find_setting_aggregate()

type(inputparamdefinitiontype) function, pointer loadcontextmodule::find_setting_aggregate ( type(modflowinputtype), intent(in)  mf6_input, character(len=linelength), dimension(:), intent(in)  rec_cols, integer(i4b), intent(in)  nrec_col  )

private

Definition at line 699 of file LoadContext.f90.

    use inputoutputmodule, only: upcase
    use definitionselectmodule, only: idt_datatype
    type(ModflowInputType), intent(in) :: mf6_input
    character(len=LINELENGTH), intent(in) :: rec_cols(:)
    integer(I4B), intent(in) :: nrec_col
    type(InputParamDefinitionType), pointer :: ks_aidt
    character(len=LINELENGTH) :: token, tagname
    integer(I4B) :: m, n, ilen
    ks_aidt => null()
    do m = 1, nrec_col
      token = trim(rec_cols(m))
      call upcase(token)
      ilen = len_trim(token)
      if (ilen < 8) cycle
      if (token(ilen - 6:ilen) /= 'SETTING') cycle
      do n = 1, size(mf6_input%aggregate_dfns)
        tagname = mf6_input%aggregate_dfns(n)%tagname
        call upcase(tagname)
        if (trim(tagname) == trim(token)) then
          ks_aidt => mf6_input%aggregate_dfns(n)
          if (idt_datatype(ks_aidt) /= 'KEYSTRING') ks_aidt => null()
          exit
        end if
      end do
      exit
    end do

Here is the call graph for this function:

Here is the caller graph for this function:

has_dimensions_block()

logical(lgp) function, public loadcontextmodule::has_dimensions_block

(

type(modflowinputtype), intent(in)

mf6_input

)

Definition at line 795 of file LoadContext.f90.

    type(ModflowInputType), intent(in) :: mf6_input
    logical(LGP) :: res
    integer(I4B) :: n
    logical(LGP) :: has_dimensions
    res = .false.
    if (.not. is_keystring_period(mf6_input)) return
    has_dimensions = .false.
    do n = 1, size(mf6_input%block_dfns)
      if (mf6_input%block_dfns(n)%blockname == 'DIMENSIONS') then
        has_dimensions = .true.
      end if
      ! PACKAGEDATA-paired (e.g. LAK/MAW/SFR/UZF) takes precedence over a
      ! coincidental DIMENSIONS block (e.g. NOUTLETS, NTABLES)
      if (mf6_input%block_dfns(n)%blockname == 'PACKAGEDATA') return
    end do
    res = has_dimensions

Here is the call graph for this function:

Here is the caller graph for this function:

in_scope()

logical(lgp) function loadcontextmodule::in_scope	(	class(loadcontexttype)	this,
		type(modflowinputtype), intent(in)	mf6_input,
		character(len=*), intent(in)	blockname,
		character(len=*), intent(in)	tagname
	)

Definition at line 478 of file LoadContext.f90.

    use memorymanagermodule, only: get_isize, mem_setptr
    use definitionselectmodule, only: get_param_definition_type, idt_datatype
    class(LoadContextType) :: this
    type(ModflowInputType), intent(in) :: mf6_input
    character(len=*), intent(in) :: blockname
    character(len=*), intent(in) :: tagname
    logical(LGP) :: in_scope
    type(InputParamDefinitionType), pointer :: idt
    character(len=LENVARNAME) :: checkname
    character(len=LINELENGTH) :: datatype
    integer(I4B) :: isize, checksize
    integer(I4B), pointer :: intptr
 
    idt => &
      get_param_definition_type(mf6_input%param_dfns, &
                                mf6_input%component_type, &
                                mf6_input%subcomponent_type, &
                                blockname, tagname, '')
    if (idt%required) then
      in_scope = .true.
      return
    else
      in_scope = .false.
      datatype = idt_datatype(idt)
      if (datatype == 'KEYSTRING' .or. &
          datatype == 'RECARRAY' .or. &
          datatype == 'RECORD') return
    end if
 
    ! initialize
    checkname = ''
    checksize = 0
 
    if (tagname == 'AUXVAR' .or. &
        tagname == 'AUX') then
      checkname = 'NAUX'
    else if (tagname == 'BOUNDNAME') then
      checkname = 'BOUNDNAMES'
    else if (tagname == 'I'//trim(mf6_input%subcomponent_type(1:3))) then
      if (this%loadtype == layerarray) in_scope = .true.
    else
      select case (mf6_input%subcomponent_type)
      case ('EVT')
        if (tagname == 'PXDP' .or. tagname == 'PETM') then
          checkname = 'NSEG'
          checksize = 1
        else if (tagname == 'PETM0') then
          checkname = 'SURFRATESPEC'
        end if
      case ('MVR', 'MVT', 'MVE')
        if (tagname == 'MNAME' .or. &
            tagname == 'MNAME1' .or. &
            tagname == 'MNAME2') then
          checkname = 'MODELNAMES'
        end if
      case ('NAM')
        in_scope = .true.
      case ('SSM')
        if (tagname == 'MIXED') in_scope = .true.
      case ('SPC', 'SPCA')
        in_scope = .true.
      case default
        errmsg = 'LoadContext in_scope needs new check for: '// &
                 trim(mf6_input%subcomponent_type)//'/'//trim(idt%tagname)
        call store_error(errmsg, .true.)
      end select
    end if
 
    ! apply checks
    if (.not. in_scope) then
      call get_isize(checkname, mf6_input%mempath, isize)
      if (isize > 0) then
        call mem_setptr(intptr, checkname, mf6_input%mempath)
        if (intptr > checksize) in_scope = .true.
      end if
    end if

Here is the call graph for this function:

init()

subroutine loadcontextmodule::init ( class(loadcontexttype)  this, type(modflowinputtype), intent(in)  mf6_input, character(len=*), intent(in), optional  blockname, character(len=*), dimension(:), intent(in), optional  named_bound  )

private

Definition at line 109 of file LoadContext.f90.

    use inputoutputmodule, only: upcase
    use modelpackageinputsmodule, only: supported_model
    use definitionselectmodule, only: idt_default
    class(LoadContextType) :: this
    type(ModflowInputType), intent(in) :: mf6_input
    character(len=*), optional, intent(in) :: blockname
    character(len=*), dimension(:), optional, intent(in) :: named_bound
    type(InputParamDefinitionType), pointer :: idt
    integer(I4B) :: n
 
    this%mf6_input = mf6_input
    this%readarray = .false.
    this%loadtype = load_undef
    this%ctxtype = context_undef
 
    select case (mf6_input%load_scope)
    case ('ROOT')
      this%ctxtype = root
    case ('SIM')
      if (mf6_input%subcomponent_type == 'NAM') then
        this%ctxtype = model
      else if (mf6_input%subcomponent_type == 'TDIS' .or. &
               mf6_input%subcomponent_type == 'HPC') then
        this%ctxtype = sim
      else if (mf6_input%component_type == 'EXG') then
        this%ctxtype = exchange
      end if
    case ('MODEL')
      if (mf6_input%subcomponent_type == 'OC' .or. &
          mf6_input%subcomponent_type == 'STO') then
        this%ctxtype = modelpkg
      else
        this%ctxtype = stresspkg
      end if
    case default
    end select
 
    if (this%ctxtype == context_undef) then
      errmsg = 'LoadContext unidentified context for mempath: '// &
               trim(mf6_input%mempath)
      call store_error(errmsg, .true.)
    end if
 
    if (present(blockname)) then
      this%blockname = blockname
      call upcase(this%blockname)
    else
      this%blockname = 'PERIOD'
    end if
 
    if (present(named_bound)) then
      allocate (this%named_bound(size(named_bound)))
      do n = 1, size(named_bound)
        this%named_bound(n) = named_bound(n)
        call upcase(this%named_bound(n))
      end do
    else
      allocate (this%named_bound(1))
      this%named_bound(1) = 'MAXBOUND'
    end if
 
    ! determine aggregate load type
    do n = 1, size(mf6_input%block_dfns)
      if (mf6_input%block_dfns(n)%blockname == this%blockname) then
        if (mf6_input%block_dfns(n)%aggregate) then
          if (this%blockname == 'PERIOD' .and. &
              is_keystring_period(mf6_input)) then
            this%loadtype = keystring
          else
            this%loadtype = list
          end if
          exit
        end if
      end if
    end do
 
    ! classify KEYSTRING subtypes needing sticky PERIOD-setting persistence:
    ! DIMENSIONS-block-paired (e.g. SPC) and CELLID-addressed (e.g. TVK/TVS)
    if (this%loadtype == keystring) then
      this%is_dimensions_scoped = has_dimensions_block(mf6_input)
      this%is_cellid_scoped = is_cellid_addressed(mf6_input)
      this%has_setting_dispatch = &
        this%is_dimensions_scoped .or. this%is_cellid_scoped
      if (this%has_setting_dispatch) then
        this%setting_idt => &
          idt_default(mf6_input%component_type, mf6_input%subcomponent_type, &
                      'PERIOD', 'SETTING', 'SETTING', 'STRING')
      end if
    end if
 
    ! determine if array based load
    if (this%loadtype == load_undef) then
      do n = 1, size(mf6_input%param_dfns)
        idt => mf6_input%param_dfns(n)
        if (idt%blockname == 'OPTIONS') then
          select case (idt%tagname)
          case ('READASARRAYS')
            this%loadtype = layerarray
            this%readarray = .true.
          case ('READARRAYGRID')
            this%loadtype = gridarray
            this%readarray = .true.
          case default
            ! no-op
          end select
        end if
      end do
    end if
 
    ! set in scope params for load
    call this%set_params()
 
    ! allocate load context scalars
    call this%allocate_scalars()

Here is the call graph for this function:

is_cellid_addressed()

logical(lgp) function, public loadcontextmodule::is_cellid_addressed

(

type(modflowinputtype), intent(in)

mf6_input

)

Definition at line 818 of file LoadContext.f90.

    type(ModflowInputType), intent(in) :: mf6_input
    logical(LGP) :: res
    integer(I4B) :: n
    res = .false.
    if (.not. is_keystring_period(mf6_input)) return
    do n = 1, size(mf6_input%param_dfns)
      if (mf6_input%param_dfns(n)%blockname == 'PERIOD' .and. &
          mf6_input%param_dfns(n)%tagname == 'CELLID') then
        res = .true.
        exit
      end if
    end do

Here is the call graph for this function:

Here is the caller graph for this function:

is_keystring_period()

logical(lgp) function, public loadcontextmodule::is_keystring_period

(

type(modflowinputtype), intent(in)

mf6_input

)

Definition at line 764 of file LoadContext.f90.

    use definitionselectmodule, only: get_aggregate_definition_type, &
                                      idt_parse_rectype
    type(ModflowInputType), intent(in) :: mf6_input
    logical(LGP) :: res, has_period
    type(InputParamDefinitionType), pointer :: aidt, ks_aidt
    character(len=LINELENGTH), allocatable :: cols(:)
    integer(I4B) :: n, ncol
    res = .false.
    has_period = .false.
    do n = 1, size(mf6_input%block_dfns)
      if (mf6_input%block_dfns(n)%blockname == 'PERIOD') then
        has_period = .true.
      end if
    end do
    if (.not. has_period) return
    aidt => get_aggregate_definition_type(mf6_input%aggregate_dfns, &
                                          mf6_input%component_type, &
                                          mf6_input%subcomponent_type, &
                                          'PERIOD')
    call idt_parse_rectype(aidt, cols, ncol)
    if (ncol >= 2) then
      ks_aidt => find_setting_aggregate(mf6_input, cols, ncol)
      if (associated(ks_aidt)) res = .true.
    end if
    if (allocated(cols)) deallocate (cols)

Here is the call graph for this function:

Here is the caller graph for this function:

keystring_member_names()

subroutine loadcontextmodule::keystring_member_names ( class(loadcontexttype)  this, character(len=linelength), dimension(:), intent(out), allocatable  member_names, integer(i4b), intent(out)  nmembers  )

private

Column order follows the KEYSTRING aggregate definition token list, which is the single authoritative source of order — independent of the order in which individual params appear in param_dfns. For each token in the aggregate:

• RECORD compound group: sub-members are expanded in RECORD type order
• direct-dispatch param: appended as-is

Definition at line 842 of file LoadContext.f90.

    use inputoutputmodule, only: upcase
    use arrayhandlersmodule, only: expandarray
    use definitionselectmodule, only: idt_parse_rectype, idt_datatype, &
                                      get_aggregate_definition_type
    class(LoadContextType) :: this
    character(len=LINELENGTH), allocatable, intent(out) :: member_names(:)
    integer(I4B), intent(out) :: nmembers
    type(InputParamDefinitionType), pointer :: aidt, ks_aidt, idt
    character(len=LINELENGTH), allocatable :: rec_cols(:), ks_cols(:)
    character(len=LINELENGTH) :: rec_token, tagname
    integer(I4B) :: m, n, nrec_col, nks_col
 
    nmembers = 0
 
    ! get RECARRAY aggregate for period block and parse its column tokens
    aidt => get_aggregate_definition_type(this%mf6_input%aggregate_dfns, &
                                          this%mf6_input%component_type, &
                                          this%mf6_input%subcomponent_type, &
                                          this%blockname)
    call idt_parse_rectype(aidt, rec_cols, nrec_col)
 
    ! find the KEYSTRING aggregate for the SETTING token
    ks_aidt => find_setting_aggregate(this%mf6_input, rec_cols, nrec_col)
    if (allocated(rec_cols)) deallocate (rec_cols)
    if (.not. associated(ks_aidt)) return
 
    ! parse the KEYSTRING aggregate to get member token list — canonical order
    call idt_parse_rectype(ks_aidt, ks_cols, nks_col)
 
    ! walk the keystring token list in aggregate order
    do m = 1, nks_col
      rec_token = trim(ks_cols(m))
      call upcase(rec_token)
 
      ! locate matching param_dfns entry for this token
      do n = 1, size(this%mf6_input%param_dfns)
        if (this%mf6_input%param_dfns(n)%blockname /= 'PERIOD') cycle
        tagname = this%mf6_input%param_dfns(n)%tagname
        call upcase(tagname)
        if (trim(tagname) /= trim(rec_token)) cycle
 
        idt => this%mf6_input%param_dfns(n)
        if (idt_datatype(idt) == 'RECORD') then
          ! compound group: expand sub-members in RECORD type order
          call expand_record_submembers(this%mf6_input, idt, member_names, &
                                        nmembers)
        else
          ! direct-dispatch param
          nmembers = nmembers + 1
          call expandarray(member_names)
          member_names(nmembers) = trim(this%mf6_input%param_dfns(n)%tagname)
        end if
        exit
      end do
    end do
 
    if (allocated(ks_cols)) deallocate (ks_cols)

Here is the call graph for this function:

rsv_alloc()

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

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 648 of file LoadContext.f90.

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

Here is the call graph for this function:

rsv_name()

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

(

character(len=*), intent(in)

mf6varname

)

Definition at line 904 of file LoadContext.f90.

    use constantsmodule, only: lenvarname
    character(len=*), intent(in) :: mf6varname
    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

Here is the caller graph for this function:

set_params()

subroutine loadcontextmodule::set_params

(

class(loadcontexttype)

this

)

Definition at line 559 of file LoadContext.f90.

    use arrayhandlersmodule, only: expandarray
    use definitionselectmodule, only: get_param_definition_type, &
                                      get_aggregate_definition_type, &
                                      idt_parse_rectype
    class(LoadContextType) :: this
    type(InputParamDefinitionType), pointer :: idt, aidt
    character(len=LINELENGTH), dimension(:), allocatable :: tags
    character(len=LINELENGTH), dimension(:), allocatable :: cols
    integer(I4B) :: keepcnt, iparam, nparam
    logical(LGP) :: keep, tag_found
 
    ! initialize
    keepcnt = 0
 
    if (this%loadtype == list .or. &
        this%loadtype == keystring) then
      ! get aggregate param definition for period block
      aidt => &
        get_aggregate_definition_type(this%mf6_input%aggregate_dfns, &
                                      this%mf6_input%component_type, &
                                      this%mf6_input%subcomponent_type, &
                                      this%blockname)
      ! split recarray definition
      call idt_parse_rectype(aidt, cols, nparam)
    else
      nparam = size(this%mf6_input%param_dfns)
    end if
 
    ! allocate dfn input params
    do iparam = 1, nparam
      if (this%loadtype == list .or. &
          this%loadtype == keystring) then
        ! use found so keystring placeholders are silently skipped
        idt => get_param_definition_type(this%mf6_input%param_dfns, &
                                         this%mf6_input%component_type, &
                                         this%mf6_input%subcomponent_type, &
                                         this%blockname, cols(iparam), '', &
                                         found=tag_found)
      else
        tag_found = .true.
        idt => this%mf6_input%param_dfns(iparam)
      end if
 
      if (.not. tag_found) then
        keep = .false.
      else if (idt%blockname /= this%blockname) then
        keep = .false.
      else
        keep = this%in_scope(this%mf6_input, this%blockname, idt%tagname)
      end if
 
      if (keep) then
        keepcnt = keepcnt + 1
        call expandarray(tags)
        tags(keepcnt) = trim(idt%tagname)
      end if
    end do
 
    ! update nparam
    nparam = keepcnt
 
    ! for LIST/KEYSTRING packages record the leading-column count; this
    ! is the count of aggregate columns before the keystring placeholder
    if (this%loadtype == list .or. &
        this%loadtype == keystring) this%nleading = nparam
 
    ! allocate filtcols
    allocate (this%params(nparam))
 
    ! set filtcols
    do iparam = 1, nparam
      this%params(iparam) = trim(tags(iparam))
    end do
 
    ! cleanup
    if (allocated(tags)) deallocate (tags)

Here is the call graph for this function:

setptr_auxvar()

subroutine loadcontextmodule::setptr_auxvar	(	real(dp), dimension(:, :), intent(inout), pointer, contiguous	auxvar,
		character(len=*), intent(in)	mempath
	)

Definition at line 1079 of file LoadContext.f90.

    use memorymanagermodule, only: mem_allocate, mem_setptr, get_isize
    real(DP), dimension(:, :), pointer, &
      contiguous, intent(inout) :: auxvar
    character(len=*), intent(in) :: mempath
    integer(I4B) :: isize
    call get_isize('AUXVAR', mempath, isize)
    if (isize > -1) then
      call mem_setptr(auxvar, 'AUXVAR', mempath)
    else
      call mem_allocate(auxvar, 0, 0, 'AUXVAR', mempath)
    end if

setptr_charstr1d()

subroutine loadcontextmodule::setptr_charstr1d	(	type(characterstringtype), dimension(:), intent(inout), pointer, contiguous	charstr1d,
		character(len=*), intent(in)	varname,
		character(len=*), intent(in)	mempath,
		integer(i4b), intent(in)	strlen
	)

Definition at line 1060 of file LoadContext.f90.

    use memorymanagermodule, only: mem_allocate, mem_setptr, get_isize
    type(CharacterStringType), dimension(:), pointer, &
      contiguous, intent(inout) :: charstr1d
    character(len=*), intent(in) :: varname
    character(len=*), intent(in) :: mempath
    integer(I4B), intent(in) :: strlen
    integer(I4B) :: isize
    call get_isize(varname, mempath, isize)
    if (isize > -1) then
      call mem_setptr(charstr1d, varname, mempath)
    else
      call mem_allocate(charstr1d, strlen, 0, varname, mempath)
    end if

setptr_int()

subroutine loadcontextmodule::setptr_int	(	integer(i4b), intent(inout), pointer	intptr,
		character(len=*), intent(in)	varname,
		character(len=*), intent(in)	mempath
	)

Definition at line 1043 of file LoadContext.f90.

    use memorymanagermodule, only: mem_allocate, mem_setptr, get_isize
    integer(I4B), pointer, intent(inout) :: intptr
    character(len=*), intent(in) :: varname
    character(len=*), intent(in) :: mempath
    integer(I4B) :: isize
    call get_isize(varname, mempath, isize)
    if (isize > -1) then
      call mem_setptr(intptr, varname, mempath)
    else
      call mem_allocate(intptr, varname, mempath)
      intptr = 0
    end if

setval()

subroutine loadcontextmodule::setval	(	integer(i4b), intent(inout), pointer	intptr,
		character(len=*), intent(in)	varname,
		character(len=*), intent(in)	mempath
	)

Definition at line 1029 of file LoadContext.f90.

    use memorymanagerextmodule, only: mem_set_value
    integer(I4B), pointer, intent(inout) :: intptr
    character(len=*), intent(in) :: varname
    character(len=*), intent(in) :: mempath
    logical(LGP) :: found
    allocate (intptr)
    intptr = 0
    call mem_set_value(intptr, varname, mempath, found, release=.false.)

Here is the caller graph for this function:

sum_named_bounds()

subroutine loadcontextmodule::sum_named_bounds	(	character(len=*), dimension(:), intent(in)	named_bound,
		character(len=*), intent(in)	mempath,
		integer(i4b), intent(inout)	total
	)

Loops over each name in named_bound and accumulates its value from mempath into total. Variables not present in mempath are silently skipped.

Definition at line 1008 of file LoadContext.f90.

    use memorymanagermodule, only: mem_setptr, get_isize
    character(len=*), dimension(:), intent(in) :: named_bound
    character(len=*), intent(in) :: mempath
    integer(I4B), intent(inout) :: total
    integer(I4B), pointer :: dimptr
    integer(I4B) :: n, isize
 
    do n = 1, size(named_bound)
      call get_isize(trim(named_bound(n)), mempath, isize)
      if (isize > -1) then
        call mem_setptr(dimptr, trim(named_bound(n)), mempath)
        total = total + dimptr
        nullify (dimptr)
      end if
    end do

Here is the call graph for this function:

Here is the caller graph for this function:

tags()

subroutine loadcontextmodule::tags	(	class(loadcontexttype)	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
	)

set input array to tagnames of in scope params, optionally allocate the parameters based on datatype.

Definition at line 429 of file LoadContext.f90.

    use featureflagsmodule, only: developmode
    use simvariablesmodule, only: iout
    use definitionselectmodule, only: get_param_definition_type
    class(LoadContextType) :: 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
    type(InputParamDefinitionType), pointer :: idt
    character(len=LINELENGTH) :: dev_msg
    logical(LGP) :: allocate_params
    integer(I4B) :: n
 
    ! initialize allocate_params
    allocate_params = .false.
 
    ! override default if provided
    if (present(create)) then
      allocate_params = create
    end if
 
    if (allocated(params)) deallocate (params)
    nparam = size(this%params)
    allocate (params(nparam))
    do n = 1, nparam
      idt => &
        get_param_definition_type(this%mf6_input%param_dfns, &
                                  this%mf6_input%component_type, &
                                  this%mf6_input%subcomponent_type, &
                                  this%blockname, this%params(n), '')
 
      ! check if input param is developmode
      if (idt%developmode) then
        dev_msg = 'Input tag "'//trim(idt%tagname)// &
          &'" read from file "'//trim(input_name)// &
          &'" is still under development. Install the &
          &nightly build or compile from source with IDEVELOPMODE = 1.'
        call developmode(dev_msg, iout)
      end if
 
      params(n) = this%params(n)
      if (allocate_params) call this%allocate_param(idt)
    end do

Here is the call graph for this function: