structarraymodule Module Reference

This module contains the StructArrayModule. More...

Data Types
type	structarraytype
	type for structured array More...

Functions/Subroutines
type(structarraytype) function, pointer, public	constructstructarray (mf6_input, ncol, nrow, blocknum, mempath, component_mempath, size_init)
	constructor for a struct_array More...
subroutine, public	destructstructarray (struct_array)
	destructor for a struct_array More...
subroutine	mem_create_vector (this, icol, idt, charlen, varname)
	create new vector in StructArrayType More...
subroutine	mem_create_metadata_vector (this, icol, idt, body_start, head_nbody)
	Create a metadata-only StructVector for a KEYWORD indicator column. More...
character(len=lenvarname) function, public	idm_input_varname (idt)
	Derive a TS-capable setting's raw input array name, distinct from its persistent array (allocated under mf6varname itself). More...
integer(i4b) function	count (this)
subroutine	set_pointer (sv, sv_target)
type(structvectortype) function, pointer	get (this, idx)
subroutine	allocate_int_type (this, sv)
	allocate integer input type More...
subroutine	allocate_dbl_type (this, sv)
	allocate double input type More...
subroutine	allocate_charstr_type (this, sv)
	allocate charstr input type More...
subroutine	allocate_int1d_type (this, sv)
	allocate int1d input type More...
subroutine	allocate_dbl1d_type (this, sv)
	allocate dbl1d input type More...
subroutine	load_deferred_vector (this, icol)
subroutine	memload_vectors (this)
	load deferred vectors into managed memory More...
subroutine	log_structarray_vars (this, iout)
	log information about the StructArrayType More...
subroutine	check_reallocate (this)
	reallocate local memory for deferred vectors if necessary More...
subroutine	read_param (this, parser, sv_col, irow, timeseries, iout)
logical(lgp) function, public	is_auxval (idt)
	True if idt is AUXVAL: its AUX index is resolved dynamically from a sibling AUXNAME, not feature-indexed by its own mf6varname. More...
integer(i4b) function, public	find_auxname_index (auxname, auxnames, naux)
	Find the AUX array position matching auxname, 0 if none. More...
integer(i4b) function	read_from_parser (this, parser, timeseries, iout, input_name)
	read from the block parser to fill the StructArrayType More...
integer(i4b) function	read_from_parser_keystring (this, parser, timeseries, nleading, iout, input_name)
	read keystring period block into the StructArrayType More...
integer(i4b) function	read_from_binary (this, inunit, iout)
	read from binary input to fill the StructArrayType More...
subroutine	ts_update (this, tsmanager, subcomp_name, iprpak, input_name, auxname_cst, clear_strlocs, ifno_map)
	link time-series strings in this struct array to a tsmanager More...
subroutine	ts_update_dedup (this, icol, tsmanager, subcomp_name, iprpak, nrows, addr_map, category, names, featarr2d, raw2d)
	Shared dedup-aware TS resolution for one PERIOD-block column: TS-linked rows resolve via their preserved token, remaining literal rows via remove_existing_link, then clear(). naux=1 (via both rank remaps in ts_update_indexed) covers the single-column BND case. More...
subroutine	ts_update_adv (this, icol, tsmanager, subcomp_name, iprpak, nrows, ifno_map, auxname_cst, featarr2d)
	Dedup-aware counterpart to ts_update for one MTYPE_DBL2D (AUX) PERIOD-block column. More...
subroutine	ts_update_indexed (this, icol, tsmanager, subcomp_name, iprpak, nrows, row_addr, varname, featarr)
	Dedup-aware resolution of one MTYPE_DBL PERIOD-block column into its permanent array, shared by both loaders. nrows is explicit since the list loader's row_addr is a permanent, maxbound-sized array, not sized to nrows. More...

Detailed Description

This module contains the routines for reading a structured list, which consists of a separate vector for each column in the list.

Function/Subroutine Documentation

allocate_charstr_type()

subroutine structarraymodule::allocate_charstr_type ( class(structarraytype)  this, type(structvectortype), intent(inout)  sv  )

private

Parameters

this	StructArrayType

Definition at line 331 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    type(StructVectorType), intent(inout) :: sv
    type(CharacterStringType), dimension(:), pointer, contiguous :: charstr1d
    integer(I4B) :: j
 
    if (this%deferred_shape) then
      allocate (charstr1d(this%deferred_size_init))
    else
      call mem_allocate(charstr1d, sv%charlen, this%nrow, &
                        sv%idt%mf6varname, this%mempath)
    end if
 
    do j = 1, this%nrow
      charstr1d(j) = ''
    end do
 
    sv%memtype = mtype_str
    sv%charstr1d => charstr1d

allocate_dbl1d_type()

subroutine structarraymodule::allocate_dbl1d_type	(	class(structarraytype)	this,
		type(structvectortype), intent(inout)	sv
	)

Parameters

this	StructArrayType

Definition at line 440 of file StructArray.f90.

    use memorymanagermodule, only: get_isize
    class(StructArrayType) :: this !< StructArrayType
    type(StructVectorType), intent(inout) :: sv
    real(DP), dimension(:, :), pointer, contiguous :: dbl2d
    integer(I4B), pointer :: naux, nseg, nseg_1
    integer(I4B) :: nseg1_isize, n, m
 
    if (sv%idt%shape == 'NAUX') then
      call mem_setptr(naux, sv%idt%shape, this%mempath)
 
      if (this%deferred_shape) then
        ! deferred: plain allocate so check_reallocate can grow it safely
        allocate (dbl2d(naux, sv%size))
      else
        call mem_allocate(dbl2d, naux, this%nrow, sv%idt%mf6varname, this%mempath)
      end if
 
      ! initialize
      do m = 1, sv%size
        do n = 1, naux
          dbl2d(n, m) = dzero
        end do
      end do
 
      sv%memtype = mtype_dbl2d
      sv%dbl2d => dbl2d
      sv%intshape => naux
    else if (sv%idt%shape == 'NSEG-1') then
      call mem_setptr(nseg, 'NSEG', this%mempath)
      call get_isize('NSEG_1', this%mempath, nseg1_isize)
 
      if (nseg1_isize < 0) then
        call mem_allocate(nseg_1, 'NSEG_1', this%mempath)
        nseg_1 = nseg - 1
      else
        call mem_setptr(nseg_1, 'NSEG_1', this%mempath)
      end if
 
      if (this%deferred_shape) then
        ! deferred: plain allocate so check_reallocate can grow it safely
        allocate (dbl2d(nseg_1, sv%size))
      else
        call mem_allocate(dbl2d, nseg_1, sv%size, sv%idt%mf6varname, this%mempath)
      end if
 
      ! initialize
      do m = 1, sv%size
        do n = 1, nseg_1
          dbl2d(n, m) = dzero
        end do
      end do
 
      sv%memtype = mtype_dbl2d
      sv%dbl2d => dbl2d
      sv%intshape => nseg_1
    else
      errmsg = 'IDM unimplemented. StructArray::allocate_dbl1d_type &
               & unsupported shape "'//trim(sv%idt%shape)//'".'
      call store_error(errmsg, terminate=.true.)
    end if

Here is the call graph for this function:

allocate_dbl_type()

subroutine structarraymodule::allocate_dbl_type ( class(structarraytype)  this, type(structvectortype), intent(inout)  sv  )

private

Parameters

this	StructArrayType

Definition at line 300 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    type(StructVectorType), intent(inout) :: sv
    real(DP), dimension(:), pointer, contiguous :: dbl1d
    character(len=LENVARNAME) :: varname
    integer(I4B) :: j, nrow
 
    varname = sv%idt%mf6varname
    if (len_trim(sv%varname_override) > 0) varname = sv%varname_override
 
    if (this%deferred_shape) then
      ! shape not known, allocate locally
      nrow = this%deferred_size_init
      allocate (dbl1d(this%deferred_size_init))
    else
      ! shape known, allocate in managed memory
      nrow = this%nrow
      call mem_allocate(dbl1d, this%nrow, varname, this%mempath)
    end if
 
    ! initialize
    do j = 1, nrow
      dbl1d(j) = dzero
    end do
 
    sv%memtype = mtype_dbl
    sv%dbl1d => dbl1d

allocate_int1d_type()

subroutine structarraymodule::allocate_int1d_type ( class(structarraytype)  this, type(structvectortype), intent(inout)  sv  )

private

Parameters

this	StructArrayType

Definition at line 354 of file StructArray.f90.

    use constantsmodule, only: lenmodelname
    use memoryhelpermodule, only: create_mem_path
    use simvariablesmodule, only: idm_context
    class(StructArrayType) :: this !< StructArrayType
    type(StructVectorType), intent(inout) :: sv
    integer(I4B), dimension(:, :), pointer, contiguous :: int2d
    type(STLVecInt), pointer :: intvector
    type(STLVecInt), pointer :: intvector_ia
    integer(I4B), pointer :: ncelldim, exgid
    character(len=LENMEMPATH) :: input_mempath
    character(len=LENMODELNAME) :: mname
    type(CharacterStringType), dimension(:), contiguous, &
      pointer :: charstr1d
    integer(I4B) :: nrow, n, m
 
    if (sv%idt%shape == 'NCELLDIM') then
      ! if EXCHANGE set to NCELLDIM of appropriate model
      if (this%mf6_input%component_type == 'EXG') then
        ! set pointer to EXGID
        call mem_setptr(exgid, 'EXGID', this%mf6_input%mempath)
        ! set pointer to appropriate exchange model array
        input_mempath = create_mem_path('SIM', 'NAM', idm_context)
        if (sv%idt%tagname == 'CELLIDM1') then
          call mem_setptr(charstr1d, 'EXGMNAMEA', input_mempath)
        else if (sv%idt%tagname == 'CELLIDM2') then
          call mem_setptr(charstr1d, 'EXGMNAMEB', input_mempath)
        end if
 
        ! set the model name
        mname = charstr1d(exgid)
 
        ! set ncelldim pointer
        input_mempath = create_mem_path(component=mname, context=idm_context)
        call mem_setptr(ncelldim, sv%idt%shape, input_mempath)
      else
        call mem_setptr(ncelldim, sv%idt%shape, this%component_mempath)
      end if
 
      if (this%deferred_shape) then
        ! shape not known, allocate locally
        nrow = this%deferred_size_init
        allocate (int2d(ncelldim, this%deferred_size_init))
      else
        ! shape known, allocate in managed memory
        nrow = this%nrow
        call mem_allocate(int2d, ncelldim, this%nrow, &
                          sv%idt%mf6varname, this%mempath)
      end if
 
      ! initialize
      do m = 1, nrow
        do n = 1, ncelldim
          int2d(n, m) = izero
        end do
      end do
 
      sv%memtype = mtype_int2d
      sv%int2d => int2d
      sv%intshape => ncelldim
    else
      ! allocate intvector object
      allocate (intvector)
      ! initialize STLVecInt
      call intvector%init()
      sv%memtype = mtype_intvec
      sv%intvector => intvector
      sv%size = -1
      ! seed the CSR row-offset vector (ia(1) = 1)
      allocate (intvector_ia)
      call intvector_ia%init()
      call intvector_ia%push_back(1)
      sv%intvector_ia => intvector_ia
      if (trim(sv%idt%shape) == ':') then
        ! ragged column: width unknown until read_param reads to end of
        ! record; intvector_shape stays unassociated
        sv%intvector_ragged = .true.
      else
        ! set pointer to dynamic shape
        call mem_setptr(sv%intvector_shape, sv%idt%shape, this%mempath)
      end if
    end if

Here is the call graph for this function:

allocate_int_type()

subroutine structarraymodule::allocate_int_type ( class(structarraytype)  this, type(structvectortype), intent(inout)  sv  )

private

Parameters

this	StructArrayType

Definition at line 273 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    type(StructVectorType), intent(inout) :: sv
    integer(I4B), dimension(:), pointer, contiguous :: int1d
    integer(I4B) :: j, nrow
 
    if (this%deferred_shape) then
      ! shape not known, allocate locally
      nrow = this%deferred_size_init
      allocate (int1d(this%deferred_size_init))
    else
      ! shape known, allocate in managed memory
      nrow = this%nrow
      call mem_allocate(int1d, this%nrow, sv%idt%mf6varname, this%mempath)
    end if
 
    ! initialize vector values
    do j = 1, nrow
      int1d(j) = izero
    end do
 
    sv%memtype = mtype_int
    sv%int1d => int1d

check_reallocate()

subroutine structarraymodule::check_reallocate ( class(structarraytype)  this )

private

Parameters

this	StructArrayType

Definition at line 802 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    integer(I4B) :: i, j, k, newsize
    integer(I4B), dimension(:), pointer, contiguous :: p_int1d
    integer(I4B), dimension(:, :), pointer, contiguous :: p_int2d
    real(DP), dimension(:), pointer, contiguous :: p_dbl1d
    real(DP), dimension(:, :), pointer, contiguous :: p_dbl2d
    type(CharacterStringType), dimension(:), pointer, contiguous :: p_charstr1d
    integer(I4B) :: reallocate_mult
 
    ! set growth rate
    reallocate_mult = 2
 
    do j = 1, this%ncol
      ! reallocate based on memtype
      select case (this%struct_vectors(j)%memtype)
      case (mtype_int)
        ! check if more space needed
        if (this%nrow > this%struct_vectors(j)%size) then
          ! calculate new size
          newsize = this%struct_vectors(j)%size * reallocate_mult
          ! allocate new vector
          allocate (p_int1d(newsize))
 
          ! copy from old to new
          do i = 1, this%struct_vectors(j)%size
            p_int1d(i) = this%struct_vectors(j)%int1d(i)
          end do
 
          ! deallocate old vector
          deallocate (this%struct_vectors(j)%int1d)
 
          ! update struct array object
          this%struct_vectors(j)%int1d => p_int1d
          this%struct_vectors(j)%size = newsize
        end if
      case (mtype_dbl)
        if (this%nrow > this%struct_vectors(j)%size) then
          newsize = this%struct_vectors(j)%size * reallocate_mult
          allocate (p_dbl1d(newsize))
 
          do i = 1, this%struct_vectors(j)%size
            p_dbl1d(i) = this%struct_vectors(j)%dbl1d(i)
          end do
 
          deallocate (this%struct_vectors(j)%dbl1d)
 
          this%struct_vectors(j)%dbl1d => p_dbl1d
          this%struct_vectors(j)%size = newsize
        end if
        !
      case (mtype_str)
        if (this%nrow > this%struct_vectors(j)%size) then
          newsize = this%struct_vectors(j)%size * reallocate_mult
          allocate (p_charstr1d(newsize))
 
          do i = 1, this%struct_vectors(j)%size
            p_charstr1d(i) = this%struct_vectors(j)%charstr1d(i)
            call this%struct_vectors(j)%charstr1d(i)%destroy()
          end do
 
          deallocate (this%struct_vectors(j)%charstr1d)
 
          this%struct_vectors(j)%charstr1d => p_charstr1d
          this%struct_vectors(j)%size = newsize
        end if
      case (mtype_int2d)
        if (this%nrow > this%struct_vectors(j)%size) then
          newsize = this%struct_vectors(j)%size * reallocate_mult
          allocate (p_int2d(this%struct_vectors(j)%intshape, newsize))
 
          do i = 1, this%struct_vectors(j)%size
            do k = 1, this%struct_vectors(j)%intshape
              p_int2d(k, i) = this%struct_vectors(j)%int2d(k, i)
            end do
          end do
 
          deallocate (this%struct_vectors(j)%int2d)
 
          this%struct_vectors(j)%int2d => p_int2d
          this%struct_vectors(j)%size = newsize
        end if
      case (mtype_dbl2d)
        if (this%nrow > this%struct_vectors(j)%size) then
          newsize = this%struct_vectors(j)%size * reallocate_mult
          allocate (p_dbl2d(this%struct_vectors(j)%intshape, newsize))
 
          do i = 1, this%struct_vectors(j)%size
            do k = 1, this%struct_vectors(j)%intshape
              p_dbl2d(k, i) = this%struct_vectors(j)%dbl2d(k, i)
            end do
          end do
 
          deallocate (this%struct_vectors(j)%dbl2d)
 
          this%struct_vectors(j)%dbl2d => p_dbl2d
          this%struct_vectors(j)%size = newsize
        end if
      case (mtype_undef, mtype_intvec)
        ! metadata-only or unsupported: skip reallocation check
      case default
        errmsg = 'IDM unimplemented. StructArray::check_reallocate &
                 &unsupported memtype.'
        call store_error(errmsg, terminate=.true.)
      end select
    end do

Here is the call graph for this function:

constructstructarray()

type(structarraytype) function, pointer, public structarraymodule::constructstructarray	(	type(modflowinputtype), intent(in)	mf6_input,
		integer(i4b), intent(in)	ncol,
		integer(i4b), intent(in)	nrow,
		integer(i4b), intent(in)	blocknum,
		character(len=*), intent(in)	mempath,
		character(len=*), intent(in)	component_mempath,
		integer(i4b), intent(in), optional	size_init
	)

Parameters

[in]	ncol	number of columns in the StructArrayType
[in]	nrow	number of rows in the StructArrayType
[in]	blocknum	valid block number or 0
[in]	mempath	memory path for storing the vector
[in]	size_init	initial deferred allocation size (default 5)

Returns

new StructArrayType

Definition at line 88 of file StructArray.f90.

    type(ModflowInputType), intent(in) :: mf6_input
    integer(I4B), intent(in) :: ncol !< number of columns in the StructArrayType
    integer(I4B), intent(in) :: nrow !< number of rows in the StructArrayType
    integer(I4B), intent(in) :: blocknum !< valid block number or 0
    character(len=*), intent(in) :: mempath !< memory path for storing the vector
    character(len=*), intent(in) :: component_mempath
    integer(I4B), optional, intent(in) :: size_init !< initial deferred allocation size (default 5)
    type(StructArrayType), pointer :: struct_array !< new StructArrayType
 
    ! allocate StructArrayType
    allocate (struct_array)
 
    ! set description of input
    struct_array%mf6_input = mf6_input
 
    ! set number of arrays
    struct_array%ncol = ncol
 
    ! set rows if known or set deferred
    struct_array%nrow = nrow
    if (struct_array%nrow == -1) then
      struct_array%nrow = 0
      struct_array%deferred_shape = .true.
      if (present(size_init)) then
        ! ignore a non-sensible value and keep the default deferred_size_init
        if (size_init >= 1) struct_array%deferred_size_init = size_init
      end if
    end if
 
    ! set blocknum
    if (blocknum > 0) then
      struct_array%blocknum = blocknum
    else
      struct_array%blocknum = 0
    end if
 
    ! set mempath
    struct_array%mempath = mempath
    struct_array%component_mempath = component_mempath
 
    ! allocate StructVectorType objects
    allocate (struct_array%struct_vectors(ncol))
    allocate (struct_array%startidx(ncol))
    allocate (struct_array%numcols(ncol))

Here is the caller graph for this function:

count()

integer(i4b) function structarraymodule::count ( class(structarraytype)  this )

private

Parameters

this	StructArrayType

Definition at line 252 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    integer(I4B) :: count
    count = size(this%struct_vectors)

destructstructarray()

subroutine, public structarraymodule::destructstructarray

(

type(structarraytype), intent(inout), pointer

struct_array

)

Parameters

[in,out]

struct_array

StructArrayType to destroy

Definition at line 138 of file StructArray.f90.

    type(StructArrayType), pointer, intent(inout) :: struct_array !< StructArrayType to destroy
    deallocate (struct_array%struct_vectors)
    deallocate (struct_array%startidx)
    deallocate (struct_array%numcols)
    deallocate (struct_array)
    nullify (struct_array)

Here is the caller graph for this function:

find_auxname_index()

integer(i4b) function, public structarraymodule::find_auxname_index	(	character(len=*), intent(in)	auxname,
		type(characterstringtype), dimension(:), intent(in)	auxnames,
		integer(i4b), intent(in)	naux
	)

Definition at line 1050 of file StructArray.f90.

    character(len=*), intent(in) :: auxname
    type(CharacterStringType), dimension(:), intent(in) :: auxnames
    integer(I4B), intent(in) :: naux
    integer(I4B) :: jj
    character(len=LINELENGTH) :: thisauxname
    integer(I4B) :: n
 
    jj = 0
    do n = 1, naux
      thisauxname = auxnames(n)
      if (trim(auxname) == trim(thisauxname)) then
        jj = n
        return
      end if
    end do

Here is the caller graph for this function:

get()

type(structvectortype) function, pointer structarraymodule::get ( class(structarraytype)  this, integer(i4b), intent(in)  idx  )

private

Parameters

this	StructArrayType

Definition at line 264 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    integer(I4B), intent(in) :: idx
    type(StructVectorType), pointer :: sv
    call set_pointer(sv, this%struct_vectors(idx))

Here is the call graph for this function:

idm_input_varname()

character(len=lenvarname) function, public structarraymodule::idm_input_varname

(

type(inputparamdefinitiontype), intent(in)

idt

)

Definition at line 237 of file StructArray.f90.

    type(InputParamDefinitionType), intent(in) :: idt
    character(len=LENVARNAME) :: varname
 
    if (len_trim(idt%mf6varname) + len(idm_input_suffix) > lenvarname) then
      write (errmsg, '(*(G0))') &
        'IDM mf6internal "', trim(idt%mf6varname), '" exceeds ', &
        lenvarname - len(idm_input_suffix), ' characters (IDM reserves ', &
        len(idm_input_suffix), ' for the internal input-array suffix "', &
        idm_input_suffix, '").'
      call store_error(errmsg, terminate=.true.)
    end if
    varname = trim(idt%mf6varname)//idm_input_suffix

Here is the call graph for this function:

Here is the caller graph for this function:

is_auxval()

logical(lgp) function, public structarraymodule::is_auxval

(

type(inputparamdefinitiontype), intent(in)

idt

)

Definition at line 1041 of file StructArray.f90.

    type(InputParamDefinitionType), intent(in) :: idt
    logical(LGP) :: res
 
    res = (trim(idt%tagname) == 'AUXVAL')

Here is the caller graph for this function:

load_deferred_vector()

subroutine structarraymodule::load_deferred_vector	(	class(structarraytype)	this,
		integer(i4b), intent(in)	icol
	)

Parameters

this	StructArrayType

Definition at line 503 of file StructArray.f90.

    use memorymanagermodule, only: get_isize
    class(StructArrayType) :: this !< StructArrayType
    integer(I4B), intent(in) :: icol
    integer(I4B) :: i, j, isize
    integer(I4B), dimension(:), pointer, contiguous :: p_int1d
    integer(I4B), dimension(:, :), pointer, contiguous :: p_int2d
    real(DP), dimension(:), pointer, contiguous :: p_dbl1d
    real(DP), dimension(:, :), pointer, contiguous :: p_dbl2d
    type(CharacterStringType), dimension(:), pointer, contiguous :: p_charstr1d
    character(len=LENVARNAME) :: varname
    logical(LGP) :: overwrite
 
    overwrite = .true.
    if (this%struct_vectors(icol)%idt%blockname == 'SOLUTIONGROUP') &
      overwrite = .false.
 
    ! set varname
    varname = this%struct_vectors(icol)%idt%mf6varname
    ! check if already mem managed variable
    call get_isize(varname, this%mempath, isize)
 
    ! allocate and load based on memtype
    select case (this%struct_vectors(icol)%memtype)
    case (mtype_int)
      if (isize > -1) then
        ! variable exists, reallocate and append
        call mem_setptr(p_int1d, varname, this%mempath)
 
        if (overwrite) then
          ! overwrite existing array
          if (this%nrow > isize) then
            ! reallocate
            call mem_reallocate(p_int1d, this%nrow, varname, this%mempath)
          end if
 
          ! write new data
          do i = 1, this%nrow
            p_int1d(i) = this%struct_vectors(icol)%int1d(i)
          end do
 
          if (isize > this%nrow) then
            ! initialize excess space
            do i = this%nrow + 1, isize
              p_int1d(i) = izero
            end do
          end if
        else
          ! reallocate to new size
          call mem_reallocate(p_int1d, this%nrow + isize, varname, this%mempath)
 
          ! write new data after existing
          do i = 1, this%nrow
            p_int1d(isize + i) = this%struct_vectors(icol)%int1d(i)
          end do
        end if
      else
        ! allocate memory manager vector
        call mem_allocate(p_int1d, this%nrow, varname, this%mempath)
 
        ! load local vector to managed memory
        do i = 1, this%nrow
          p_int1d(i) = this%struct_vectors(icol)%int1d(i)
        end do
      end if
 
      ! deallocate local memory
      deallocate (this%struct_vectors(icol)%int1d)
 
      ! update structvector
      this%struct_vectors(icol)%int1d => p_int1d
      this%struct_vectors(icol)%size = this%nrow
    case (mtype_dbl)
      if (isize > -1) then
        call mem_setptr(p_dbl1d, varname, this%mempath)
 
        if (overwrite) then
          if (this%nrow > isize) then
            call mem_reallocate(p_dbl1d, this%nrow, varname, this%mempath)
          end if
 
          do i = 1, this%nrow
            p_dbl1d(i) = this%struct_vectors(icol)%dbl1d(i)
          end do
 
          if (isize > this%nrow) then
            do i = this%nrow + 1, isize
              p_dbl1d(i) = dzero
            end do
          end if
        else
          call mem_reallocate(p_dbl1d, this%nrow + isize, varname, &
                              this%mempath)
          do i = 1, this%nrow
            p_dbl1d(isize + i) = this%struct_vectors(icol)%dbl1d(i)
          end do
        end if
      else
        call mem_allocate(p_dbl1d, this%nrow, varname, this%mempath)
 
        do i = 1, this%nrow
          p_dbl1d(i) = this%struct_vectors(icol)%dbl1d(i)
        end do
      end if
 
      deallocate (this%struct_vectors(icol)%dbl1d)
 
      this%struct_vectors(icol)%dbl1d => p_dbl1d
      this%struct_vectors(icol)%size = this%nrow
      !
    case (mtype_str)
      if (isize > -1) then
        call mem_setptr(p_charstr1d, varname, this%mempath)
 
        if (overwrite) then
          if (this%nrow > isize) then
            call mem_reallocate(p_charstr1d, this%struct_vectors(icol)%charlen, &
                                this%nrow, varname, this%mempath)
          end if
 
          do i = 1, this%nrow
            p_charstr1d(i) = this%struct_vectors(icol)%charstr1d(i)
          end do
 
          if (isize > this%nrow) then
            do i = this%nrow + 1, isize
              p_charstr1d(i) = ''
            end do
          end if
        else
          call mem_reallocate(p_charstr1d, this%struct_vectors(icol)%charlen, &
                              this%nrow + isize, varname, this%mempath)
          do i = 1, this%nrow
            p_charstr1d(isize + i) = this%struct_vectors(icol)%charstr1d(i)
          end do
        end if
      else
        call mem_allocate(p_charstr1d, this%struct_vectors(icol)%charlen, &
                          this%nrow, varname, this%mempath)
        do i = 1, this%nrow
          p_charstr1d(i) = this%struct_vectors(icol)%charstr1d(i)
          call this%struct_vectors(icol)%charstr1d(i)%destroy()
        end do
      end if
 
      deallocate (this%struct_vectors(icol)%charstr1d)
 
      this%struct_vectors(icol)%charstr1d => p_charstr1d
      this%struct_vectors(icol)%size = this%nrow
    case (mtype_intvec) ! intvector reallocate unimplemented
      errmsg = 'StructArray::load_deferred_vector &
               &intvector reallocate unimplemented.'
      call store_error(errmsg, terminate=.true.)
    case (mtype_int2d)
      if (isize > -1) then
        errmsg = 'StructArray::load_deferred_vector &
                 &int2d reallocate unimplemented.'
        call store_error(errmsg, terminate=.true.)
      else
        call mem_allocate(p_int2d, this%struct_vectors(icol)%intshape, &
                          this%nrow, varname, this%mempath)
        do i = 1, this%nrow
          do j = 1, this%struct_vectors(icol)%intshape
            p_int2d(j, i) = this%struct_vectors(icol)%int2d(j, i)
          end do
        end do
      end if
 
      deallocate (this%struct_vectors(icol)%int2d)
 
      this%struct_vectors(icol)%int2d => p_int2d
      this%struct_vectors(icol)%size = this%nrow
    case (mtype_dbl2d)
      if (isize > -1) then
        errmsg = 'StructArray::load_deferred_vector &
                 &dbl2d reallocate unimplemented.'
        call store_error(errmsg, terminate=.true.)
      else
        call mem_allocate(p_dbl2d, this%struct_vectors(icol)%intshape, &
                          this%nrow, varname, this%mempath)
        do i = 1, this%nrow
          do j = 1, this%struct_vectors(icol)%intshape
            p_dbl2d(j, i) = this%struct_vectors(icol)%dbl2d(j, i)
          end do
        end do
      end if
 
      deallocate (this%struct_vectors(icol)%dbl2d)
 
      this%struct_vectors(icol)%dbl2d => p_dbl2d
      this%struct_vectors(icol)%size = this%nrow
    case default
    end select

Here is the call graph for this function:

log_structarray_vars()

subroutine structarraymodule::log_structarray_vars ( class(structarraytype)  this, integer(i4b), intent(in)  iout  )

private

Parameters

	this	StructArrayType
[in]	iout	unit number for output

Definition at line 750 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    integer(I4B), intent(in) :: iout !< unit number for output
    integer(I4B) :: j, nts
    integer(I4B), dimension(:), pointer, contiguous :: int1d
    character(len=LINELENGTH) :: ts_count_str
 
    ! idm variable logging
    do j = 1, this%ncol
      ! log based on memtype
      select case (this%struct_vectors(j)%memtype)
      case (mtype_int)
        call idm_log_var(this%struct_vectors(j)%int1d, &
                         this%struct_vectors(j)%idt%tagname, &
                         this%mempath, iout)
      case (mtype_dbl)
        nts = this%struct_vectors(j)%ts_strlocs%count()
        if (nts > 0) then
          write (ts_count_str, '(i0, " time-series bound entries")') nts
          call idm_log_var(this%struct_vectors(j)%idt%tagname, &
                           this%mempath, iout, .false., trim(ts_count_str))
        else
          call idm_log_var(this%struct_vectors(j)%dbl1d, &
                           this%struct_vectors(j)%idt%tagname, &
                           this%mempath, iout)
        end if
      case (mtype_intvec)
        call mem_setptr(int1d, this%struct_vectors(j)%idt%mf6varname, &
                        this%mempath)
        call idm_log_var(int1d, this%struct_vectors(j)%idt%tagname, &
                         this%mempath, iout)
      case (mtype_int2d)
        call idm_log_var(this%struct_vectors(j)%int2d, &
                         this%struct_vectors(j)%idt%tagname, &
                         this%mempath, iout)
      case (mtype_dbl2d)
        nts = this%struct_vectors(j)%ts_strlocs%count()
        if (nts > 0) then
          write (ts_count_str, '(i0, " time-series bound entries")') nts
          call idm_log_var(this%struct_vectors(j)%idt%tagname, &
                           this%mempath, iout, .false., trim(ts_count_str))
        else
          call idm_log_var(this%struct_vectors(j)%dbl2d, &
                           this%struct_vectors(j)%idt%tagname, &
                           this%mempath, iout)
        end if
      end select
    end do

mem_create_metadata_vector()

subroutine structarraymodule::mem_create_metadata_vector ( class(structarraytype)  this, integer(i4b), intent(in)  icol, type(inputparamdefinitiontype), pointer  idt, integer(i4b), intent(in)  body_start, integer(i4b), intent(in)  head_nbody  )

private

Sets idt, body_start, and head_nbody but allocates no data arrays. Used for KEYWORD indicator columns that have been consolidated into the SETTING column; these vectors serve only as dispatch-map entries.

Parameters

	this	StructArrayType
[in]	icol	column index
	idt	input definition (for tagname lookup)
[in]	body_start	SA column index of the head's first body (0 if none)
[in]	head_nbody	number of body columns following the head

Definition at line 210 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    integer(I4B), intent(in) :: icol !< column index
    type(InputParamDefinitionType), pointer :: idt !< input definition (for tagname lookup)
    integer(I4B), intent(in) :: body_start !< SA column index of the head's first body (0 if none)
    integer(I4B), intent(in) :: head_nbody !< number of body columns following the head
    type(StructVectorType) :: sv
 
    sv%idt => idt
    sv%icol = icol
    sv%body_start = body_start
    sv%head_nbody = head_nbody
    sv%memtype = mtype_undef
    sv%size = 0
 
    this%struct_vectors(icol) = sv
    this%numcols(icol) = 0
    if (icol == 1) then
      this%startidx(icol) = 1
    else
      this%startidx(icol) = this%startidx(icol - 1) + this%numcols(icol - 1)
    end if

mem_create_vector()

subroutine structarraymodule::mem_create_vector ( class(structarraytype)  this, integer(i4b), intent(in)  icol, type(inputparamdefinitiontype), pointer  idt, integer(i4b), intent(in), optional  charlen, character(len=*), intent(in), optional  varname  )

private

Parameters

	this	StructArrayType
[in]	icol	column to create
[in]	charlen	override character length for charstr1d
[in]	varname	override the memory-manager name (default idtmf6varname)

Definition at line 149 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    integer(I4B), intent(in) :: icol !< column to create
    type(InputParamDefinitionType), pointer :: idt
    integer(I4B), optional, intent(in) :: charlen !< override character length for charstr1d
    character(len=*), optional, intent(in) :: varname !< override the memory-manager name (default idt%mf6varname)
    type(StructVectorType) :: sv
    integer(I4B) :: numcol
 
    ! initialize
    numcol = 1
    sv%idt => idt
    sv%icol = icol
    if (present(charlen)) sv%charlen = charlen
    if (present(varname)) sv%varname_override = varname
 
    ! set size
    if (this%deferred_shape) then
      sv%size = this%deferred_size_init
    else
      sv%size = this%nrow
    end if
 
    ! allocate array memory for StructVectorType
    select case (idt%datatype)
    case ('INTEGER')
      call this%allocate_int_type(sv)
    case ('DOUBLE')
      call this%allocate_dbl_type(sv)
    case ('STRING', 'KEYWORD')
      call this%allocate_charstr_type(sv)
    case ('INTEGER1D')
      call this%allocate_int1d_type(sv)
      if (sv%memtype == mtype_int2d) then
        numcol = sv%intshape
      end if
    case ('DOUBLE1D')
      call this%allocate_dbl1d_type(sv)
      numcol = sv%intshape
    case default
      errmsg = 'IDM unimplemented. StructArray::mem_create_vector &
               &type='//trim(idt%datatype)
      call store_error(errmsg, .true.)
    end select
 
    ! set the object in the Struct Array
    this%struct_vectors(icol) = sv
    this%numcols(icol) = numcol
    if (icol == 1) then
      this%startidx(icol) = 1
    else
      this%startidx(icol) = this%startidx(icol - 1) + this%numcols(icol - 1)
    end if

Here is the call graph for this function:

memload_vectors()

subroutine structarraymodule::memload_vectors

(

class(structarraytype)

this

)

Parameters

this	StructArrayType

Definition at line 700 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    integer(I4B) :: icol, j
    integer(I4B), dimension(:), pointer, contiguous :: p_intvector
    integer(I4B), dimension(:), pointer, contiguous :: p_intvector_ia
    character(len=LENVARNAME) :: varname
 
    do icol = 1, this%ncol
      ! set varname
      varname = this%struct_vectors(icol)%idt%mf6varname
 
      if (this%struct_vectors(icol)%memtype == mtype_intvec) then
        ! intvectors always need to be loaded
        ! size intvector to number of values read
        call this%struct_vectors(icol)%intvector%shrink_to_fit()
 
        ! allocate memory manager vector
        call mem_allocate(p_intvector, &
                          this%struct_vectors(icol)%intvector%size, &
                          varname, this%mempath)
 
        ! load local vector to managed memory
        do j = 1, this%struct_vectors(icol)%intvector%size
          p_intvector(j) = this%struct_vectors(icol)%intvector%at(j)
        end do
 
        ! cleanup local memory
        call this%struct_vectors(icol)%intvector%destroy()
        deallocate (this%struct_vectors(icol)%intvector)
        nullify (this%struct_vectors(icol)%intvector_shape)
 
        ! publish the parallel CSR-style row-offset vector as <TAGNAME>_IA
        call mem_allocate(p_intvector_ia, &
                          this%struct_vectors(icol)%intvector_ia%size, &
                          trim(varname)//'_IA', this%mempath)
        do j = 1, this%struct_vectors(icol)%intvector_ia%size
          p_intvector_ia(j) = this%struct_vectors(icol)%intvector_ia%at(j)
        end do
        call this%struct_vectors(icol)%intvector_ia%destroy()
        deallocate (this%struct_vectors(icol)%intvector_ia)
        nullify (this%struct_vectors(icol)%intvector_ia)
      else if (this%deferred_shape) then
        ! load as shape wasn't known
        call this%load_deferred_vector(icol)
      end if
    end do

read_from_binary()

integer(i4b) function structarraymodule::read_from_binary	(	class(structarraytype)	this,
		integer(i4b), intent(in)	inunit,
		integer(i4b), intent(in)	iout
	)

Parameters

	this	StructArrayType
[in]	inunit	unit number for binary input
[in]	iout	unit number for output

Definition at line 1295 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    integer(I4B), intent(in) :: inunit !< unit number for binary input
    integer(I4B), intent(in) :: iout !< unit number for output
    integer(I4B) :: irow, ierr
    integer(I4B) :: j, k
    integer(I4B) :: intval, numval
    character(len=LINELENGTH) :: fname
    character(len=*), parameter :: fmtlsterronly = &
      "('Error reading LIST from file: ',&
      &1x,a,1x,' on UNIT: ',I0)"
 
    ! set error and exit if deferred shape
    if (this%deferred_shape) then
      errmsg = 'IDM unimplemented. StructArray::read_from_binary deferred shape &
               &not supported for binary inputs.'
      call store_error(errmsg, terminate=.true.)
    end if
    ! initialize
    irow = 0
    ierr = 0
    readloop: do
      ! update irow index
      irow = irow + 1
      ! handle line reads by column memtype
      do j = 1, this%ncol
        select case (this%struct_vectors(j)%memtype)
        case (mtype_int)
          read (inunit, iostat=ierr) this%struct_vectors(j)%int1d(irow)
        case (mtype_dbl)
          read (inunit, iostat=ierr) this%struct_vectors(j)%dbl1d(irow)
        case (mtype_str)
          errmsg = 'List style binary inputs not supported &
                   &for text columns, tag='// &
                   trim(this%struct_vectors(j)%idt%tagname)//'.'
          call store_error(errmsg, terminate=.true.)
        case (mtype_intvec)
          if (this%struct_vectors(j)%intvector_ragged) then
            errmsg = 'List style binary inputs not supported for &
                     &self-sizing (ragged) columns, tag='// &
                     trim(this%struct_vectors(j)%idt%tagname)//'.'
            call store_error(errmsg, terminate=.true.)
          end if
          ! get shape for this row
          numval = this%struct_vectors(j)%intvector_shape(irow)
          ! read and store row values
          do k = 1, numval
            if (ierr == 0) then
              read (inunit, iostat=ierr) intval
              call this%struct_vectors(j)%intvector%push_back(intval)
            end if
          end do
        case (mtype_int2d)
          ! read and store row values
          do k = 1, this%struct_vectors(j)%intshape
            if (ierr == 0) then
              read (inunit, iostat=ierr) this%struct_vectors(j)%int2d(k, irow)
            end if
          end do
        case (mtype_dbl2d)
          do k = 1, this%struct_vectors(j)%intshape
            if (ierr == 0) then
              read (inunit, iostat=ierr) this%struct_vectors(j)%dbl2d(k, irow)
            end if
          end do
        end select
 
        ! handle error cases
        select case (ierr)
        case (0)
          ! no error
        case (:-1)
          ! End of block was encountered
          irow = irow - 1
          exit readloop
        case (1:)
          ! Error
          inquire (unit=inunit, name=fname)
          write (errmsg, fmtlsterronly) trim(adjustl(fname)), inunit
          call store_error(errmsg, terminate=.true.)
        case default
        end select
      end do
      if (irow == this%nrow) exit readloop
    end do readloop
 
    ! Stop if errors were detected
    !if (count_errors() > 0) then
    !  call store_error_unit(inunit)
    !end if
 
    ! if deferred shape vectors were read, load to input path
    call this%memload_vectors()
 
    ! log loaded variables
    if (iout > 0) then
      call this%log_structarray_vars(iout)
    end if

Here is the call graph for this function:

read_from_parser()

integer(i4b) function structarraymodule::read_from_parser ( class(structarraytype)  this, type(blockparsertype), intent(inout)  parser, logical(lgp), intent(in)  timeseries, integer(i4b), intent(in)  iout, character(len=*), intent(in)  input_name  )

private

Parameters

	this	StructArrayType
[in,out]	parser	block parser to read from
[in]	iout	unit number for output
[in]	input_name	input filename for error messages

Definition at line 1070 of file StructArray.f90.

    class(StructArrayType) :: this !< StructArrayType
    type(BlockParserType), intent(inout) :: parser !< block parser to read from
    logical(LGP), intent(in) :: timeseries
    integer(I4B), intent(in) :: iout !< unit number for output
    character(len=*), intent(in) :: input_name !< input filename for error messages
    integer(I4B) :: irow, j
    logical(LGP) :: endOfBlock
 
    ! initialize index irow
    irow = 0
 
    ! reset nrow if deferred shape
    if (this%deferred_shape) then
      this%nrow = 0
    end if
 
    ! read entire block
    do
      ! read next line
      call parser%GetNextLine(endofblock)
      if (endofblock) then
        ! no more lines
        exit
      else if (this%deferred_shape) then
        ! shape unknown, track lines read
        this%nrow = this%nrow + 1
        ! check and update memory allocation
        call this%check_reallocate()
      end if
      ! update irow index
      irow = irow + 1
      if (this%deferred_shape) then
      else
        ! check allocated array size against user bound
        if (irow > this%nrow) then
          write (errmsg, '(a,i0,a)') &
            'Input error: line count exceeds input dimension. Expected rows=', &
            this%nrow, '.'
          call store_error(errmsg)
          call store_error_filename(input_name)
        end if
      end if
      ! handle line reads by column memtype
      do j = 1, this%ncol
        call this%read_param(parser, j, irow, timeseries, iout)
      end do
    end do
    ! if deferred shape vectors were read, load to input path
    call this%memload_vectors()
    ! log loaded variables
    if (iout > 0) then
      call this%log_structarray_vars(iout)
    end if

Here is the call graph for this function:

read_from_parser_keystring()

integer(i4b) function structarraymodule::read_from_parser_keystring ( class(structarraytype)  this, type(blockparsertype), intent(inout)  parser, logical(lgp), intent(in)  timeseries, integer(i4b), intent(in)  nleading, integer(i4b), intent(in)  iout, character(len=*), intent(in)  input_name  )

private

Each input line contains nleading fixed columns followed by a dispatch keyword. Two dispatch modes are supported:

Simple dispatch: keyword matches a DOUBLE/STRING/INTEGER column. One value token is read from the parser into that column. All other member columns receive their sentinel for that row.

Compound dispatch: keyword matches a KEYWORD-type column (e.g. FLOWING_WELL). No parser token is read for the KEYWORD column — the dispatch keyword itself is stored. Subsequent non-KEYWORD columns (the compound sub-members, e.g. FWELEV/FWCOND/FWRLEN) are read from the parser in order until the next KEYWORD column or the end of the member columns.

No-value KEYWORD dispatch: a KEYWORD column with no sub-members immediately following stores the dispatch keyword and reads nothing further.

Parameters

	this	StructArrayType
[in,out]	parser	block parser to read from
[in]	timeseries	.true. when TS files loaded
[in]	nleading	number of leading (fixed) columns
[in]	iout	unit number for output
[in]	input_name	input filename for error messages

Definition at line 1148 of file StructArray.f90.

    use inputoutputmodule, only: upcase
    use simmodule, only: store_error_filename
    class(StructArrayType) :: this !< StructArrayType
    type(BlockParserType), intent(inout) :: parser !< block parser to read from
    logical(LGP), intent(in) :: timeseries !< .true. when TS files loaded
    integer(I4B), intent(in) :: nleading !< number of leading (fixed) columns
    integer(I4B), intent(in) :: iout !< unit number for output
    character(len=*), intent(in) :: input_name !< input filename for error messages
    integer(I4B) :: irow
    logical(LGP) :: endOfBlock, is_keyword_dispatch
    character(len=LINELENGTH) :: keyword
    integer(I4B) :: icol, found_col, last_set_col, setting_icol
 
    irow = 0
 
    ! SETTING column is always at nleading+1 when present; detect by tagname
    setting_icol = 0
    if (nleading + 1 <= this%ncol) then
      if (trim(this%struct_vectors(nleading + 1)%idt%tagname) == 'SETTING') then
        setting_icol = nleading + 1
      end if
    end if
 
    ! reset nrow if deferred shape
    if (this%deferred_shape) then
      this%nrow = 0
    end if
 
    do
      call parser%GetNextLine(endofblock)
      if (endofblock) exit
 
      if (this%deferred_shape) then
        this%nrow = this%nrow + 1
        call this%check_reallocate()
      end if
      irow = irow + 1
 
      ! bounds check for pre-allocated (non-deferred) arrays
      if (.not. this%deferred_shape) then
        if (irow > this%nrow) then
          write (errmsg, '(a,i0,a)') &
            'Input error: keystring row count exceeds pre-allocated maxbound=', &
            this%nrow, '.'
          call store_error(errmsg)
          call store_error_filename(input_name)
          exit
        end if
      end if
 
      ! read leading fixed columns (e.g. CELLID, IFNO)
      do icol = 1, nleading
        call this%read_param(parser, icol, irow, .false., iout)
      end do
 
      ! read dispatch keyword
      call parser%GetString(keyword)
      call upcase(keyword)
 
      ! match the keystring-member column, skipping SETTING and a KEYWORD
      ! header's own sub-members (reachable only through their header)
      found_col = 0
      icol = nleading + 1
      do while (icol <= this%ncol)
        if (icol == setting_icol) then
          icol = icol + 1
          cycle
        end if
        if (trim(this%struct_vectors(icol)%idt%tagname) == trim(keyword)) then
          found_col = icol
          exit
        end if
        if (this%struct_vectors(icol)%head_nbody > 0) then
          icol = icol + this%struct_vectors(icol)%head_nbody + 1
        else
          icol = icol + 1
        end if
      end do
 
      if (found_col < 1) then
        write (errmsg, '(a,a,a)') &
          'Unrecognized keystring keyword "', trim(keyword), &
          '" in PERIOD block.'
        call store_error(errmsg)
        call store_error_filename(input_name)
        cycle
      end if
 
      ! write mf6varname, not tagname, since SETTING is also used as
      ! a memory-manager name and tagname can exceed LENVARNAME
      if (setting_icol > 0) then
        this%struct_vectors(setting_icol)%charstr1d(irow) = &
          trim(this%struct_vectors(found_col)%idt%mf6varname)
      end if
 
      ! determine dispatch mode and set/read matched column(s)
      is_keyword_dispatch = &
        (this%struct_vectors(found_col)%idt%datatype == 'KEYWORD')
 
      if (is_keyword_dispatch) then
        ! compound/no-value KEYWORD dispatch has no data of its own;
        ! read its body members starting at body_start instead
        last_set_col = found_col
        if (this%struct_vectors(found_col)%body_start > 0) then
          do icol = this%struct_vectors(found_col)%body_start, &
            this%struct_vectors(found_col)%body_start + &
            this%struct_vectors(found_col)%head_nbody - 1
            if (icol > this%ncol) exit
            call this%read_param(parser, icol, irow, timeseries, iout)
            last_set_col = icol
          end do
        end if
      else
        ! Simple single-value dispatch: read one value for the matched column
        call this%read_param(parser, found_col, irow, timeseries, iout)
        last_set_col = found_col
      end if
 
      ! fill sentinels for all non-matched member columns
      do icol = nleading + 1, this%ncol
        ! skip SETTING column (always written above when present)
        if (icol == setting_icol) cycle
        ! skip metadata vectors (MTYPE_UNDEF, no allocated data arrays)
        if (this%struct_vectors(icol)%memtype == mtype_undef) cycle
        if (icol >= found_col .and. icol <= last_set_col) cycle
        select case (this%struct_vectors(icol)%memtype)
        case (mtype_int) ! INTEGER: use IZERO sentinel
          this%struct_vectors(icol)%int1d(irow) = izero
        case (mtype_dbl) ! DOUBLE: use DNODATA sentinel
          this%struct_vectors(icol)%dbl1d(irow) = dnodata
        case (mtype_str) ! STRING or KEYWORD: use empty string sentinel
          this%struct_vectors(icol)%charstr1d(irow) = ''
        end select
      end do
    end do
 
    call this%memload_vectors()
 
    if (iout > 0) then
      call this%log_structarray_vars(iout)
    end if

Here is the call graph for this function:

read_param()

subroutine structarraymodule::read_param ( class(structarraytype)  this, type(blockparsertype), intent(inout)  parser, integer(i4b), intent(in)  sv_col, integer(i4b), intent(in)  irow, logical(lgp), intent(in)  timeseries, integer(i4b), intent(in)  iout  )

private

Parameters

	this	StructArrayType
[in,out]	parser	block parser to read from
[in]	iout	unit number for output

Definition at line 910 of file StructArray.f90.

    use inputoutputmodule, only: upcase
    class(StructArrayType) :: this !< StructArrayType
    type(BlockParserType), intent(inout) :: parser !< block parser to read from
    integer(I4B), intent(in) :: sv_col
    integer(I4B), intent(in) :: irow
    logical(LGP), intent(in) :: timeseries
    integer(I4B), intent(in) :: iout !< unit number for output
    integer(I4B) :: n, intval, numval, icol
    character(len=LINELENGTH) :: str
    character(len=:), allocatable :: line
    logical(LGP) :: preserve_case, success
 
    select case (this%struct_vectors(sv_col)%memtype)
    case (mtype_undef)
      ! MTYPE_UNDEF vectors are metadata-only (KEYWORD dispatch headers).
      write (errmsg, '(a,i0)') &
        'IDM read_param called for MTYPE_UNDEF metadata vector at column ', sv_col
      call store_error(errmsg, .true.)
    case (mtype_int)
      ! if reloadable block and first col, store blocknum
      if (sv_col == 1 .and. this%blocknum > 0) then
        ! store blocknum
        this%struct_vectors(sv_col)%int1d(irow) = this%blocknum
      else
        ! read and store int
        this%struct_vectors(sv_col)%int1d(irow) = parser%GetInteger()
      end if
    case (mtype_dbl)
      if (this%struct_vectors(sv_col)%idt%timeseries .and. timeseries) then
        call parser%GetString(str)
        this%struct_vectors(sv_col)%dbl1d(irow) = &
          this%struct_vectors(sv_col)%read_token(str, this%startidx(sv_col), &
                                                 1, irow)
      else if (sv_col == this%ncol .and. &
               .not. this%struct_vectors(sv_col)%idt%required) then
        call parser%TryGetDouble(this%struct_vectors(sv_col)%dbl1d(irow), success)
        if (.not. success) &
          this%struct_vectors(sv_col)%dbl1d(irow) = dnodata
      else
        this%struct_vectors(sv_col)%dbl1d(irow) = parser%GetDouble()
      end if
    case (mtype_str)
      if (this%struct_vectors(sv_col)%idt%shape /= '' .and. &
          sv_col == this%ncol) then
        ! last column with any shape: store rest of line
        call parser%GetRemainingLine(line)
        this%struct_vectors(sv_col)%charstr1d(irow) = line
        deallocate (line)
      else
        ! read string token; a shape on a non-last column marks something
        ! other than "rest of line", so it reads the same as unshaped
        preserve_case = (.not. this%struct_vectors(sv_col)%idt%preserve_case)
        call parser%GetString(str, preserve_case)
        this%struct_vectors(sv_col)%charstr1d(irow) = str
      end if
    case (mtype_intvec)
      if (this%struct_vectors(sv_col)%intvector_ragged) then
        ! read to end of record; consumers compare the actual count read
        ! against whatever width they independently expect
        numval = 0
        success = .true.
        do while (success)
          call parser%TryGetInteger(intval, success)
          if (success) then
            call this%struct_vectors(sv_col)%intvector%push_back(intval)
            numval = numval + 1
          end if
        end do
      else
        ! get shape for this row
        numval = this%struct_vectors(sv_col)%intvector_shape(irow)
        ! read and store row values
        do n = 1, numval
          intval = parser%GetInteger()
          call this%struct_vectors(sv_col)%intvector%push_back(intval)
        end do
      end if
      ! extend the CSR-style row-offset vector with this row's running total
      call this%struct_vectors(sv_col)%intvector_ia%push_back( &
        this%struct_vectors(sv_col)%intvector_ia%at( &
        this%struct_vectors(sv_col)%intvector_ia%size) + numval)
    case (mtype_int2d)
      ! read and store row values
      ! handle 'NONE' keyword (SFR unconnected reaches) for backward compatibility
      if (trim(this%mf6_input%subcomponent_type) == 'SFR' .and. &
          this%struct_vectors(sv_col)%idt%tagname == 'CELLID') then
        call parser%GetString(str)
        call upcase(str)
        if (str == 'NONE') then
          ! NONE means unconnected; store zeros for all dimensions
          do n = 1, this%struct_vectors(sv_col)%intshape
            this%struct_vectors(sv_col)%int2d(n, irow) = 0
          end do
        else
          ! first token already read as str; parse as integer and read the rest
          read (str, *, iostat=numval) intval
          if (numval /= 0) then
            write (errmsg, '(a,a,a)') &
              'CELLID must be an integer or the keyword NONE, got: ', &
              trim(str), '.'
            call store_error(errmsg, terminate=.true.)
          end if
          this%struct_vectors(sv_col)%int2d(1, irow) = intval
          do n = 2, this%struct_vectors(sv_col)%intshape
            this%struct_vectors(sv_col)%int2d(n, irow) = parser%GetInteger()
          end do
        end if
      else
        do n = 1, this%struct_vectors(sv_col)%intshape
          this%struct_vectors(sv_col)%int2d(n, irow) = parser%GetInteger()
        end do
      end if
    case (mtype_dbl2d)
      ! read and store row values
      do n = 1, this%struct_vectors(sv_col)%intshape
        if (this%struct_vectors(sv_col)%idt%timeseries .and. timeseries) then
          call parser%GetString(str)
          icol = this%startidx(sv_col) + n - 1
          this%struct_vectors(sv_col)%dbl2d(n, irow) = &
            this%struct_vectors(sv_col)%read_token(str, icol, n, irow)
        else
          this%struct_vectors(sv_col)%dbl2d(n, irow) = parser%GetDouble()
        end if
      end do
    end select

Here is the call graph for this function:

set_pointer()

subroutine structarraymodule::set_pointer ( type(structvectortype), pointer  sv, type(structvectortype), target  sv_target  )

private

Definition at line 258 of file StructArray.f90.

    type(StructVectorType), pointer :: sv
    type(StructVectorType), target :: sv_target
    sv => sv_target

Here is the caller graph for this function:

ts_update()

subroutine structarraymodule::ts_update ( class(structarraytype), intent(inout)  this, type(timeseriesmanagertype), intent(inout), pointer  tsmanager, character(len=*), intent(in)  subcomp_name, integer(i4b), intent(in)  iprpak, character(len=*), intent(in)  input_name, type(characterstringtype), dimension(:), intent(in), optional, pointer  auxname_cst, logical(lgp), intent(in), optional  clear_strlocs, integer(i4b), dimension(:), intent(in), optional  ifno_map  )

private

Iterates over struct vectors that carry deferred TS tokens and registers each with the supplied tsmanager. Handles both BND (MTYPE_DBL / dbl1d) and AUX (MTYPE_DBL2D / dbl2d) columns. Pass auxname_cst only when AUX columns may carry time series.

Parameters

[in]	clear_strlocs	if .false. strlocs are preserved for re-registration (default .true.)
[in]	ifno_map	if present, maps ts_strlocrow (PACKAGEDATA row) to its feature number, used as the TS link row address

Definition at line 1403 of file StructArray.f90.

    class(StructArrayType), intent(inout) :: this
    type(TimeSeriesManagerType), pointer, intent(inout) :: tsmanager
    character(len=*), intent(in) :: subcomp_name
    integer(I4B), intent(in) :: iprpak
    character(len=*), intent(in) :: input_name
    type(CharacterStringType), dimension(:), pointer, intent(in), &
      optional :: auxname_cst
    logical(LGP), optional, intent(in) :: clear_strlocs !< if .false. strlocs are preserved for re-registration (default .true.)
    integer(I4B), dimension(:), optional, intent(in) :: ifno_map !< if present, maps ts_strloc%row (PACKAGEDATA row) to its feature number, used as the TS link row address
    type(TSStringLocType), pointer :: ts_strloc
    type(TimeSeriesLinkType), pointer :: tsLink
    real(DP), pointer :: bndElem
    character(len=LENBOUNDNAME) :: boundname
    integer(I4B) :: m, n, iboundname, irow
    logical(LGP) :: do_clear
 
    do_clear = .true.
    if (present(clear_strlocs)) do_clear = clear_strlocs
 
    ! find BOUNDNAME column (0 = none)
    iboundname = 0
    do m = 1, this%ncol
      if (this%struct_vectors(m)%idt%mf6varname == 'BOUNDNAME') then
        iboundname = m
        exit
      end if
    end do
 
    do m = 1, this%ncol
      if (.not. this%struct_vectors(m)%idt%timeseries) cycle
      do n = 1, this%struct_vectors(m)%ts_strlocs%count()
        ts_strloc => this%struct_vectors(m)%get_ts_strloc(n)
        nullify (tslink)
        irow = ts_strloc%row
        if (present(ifno_map)) irow = ifno_map(ts_strloc%row)
        select case (this%struct_vectors(m)%memtype)
        case (mtype_dbl) ! dbl1d (BND)
          bndelem => this%struct_vectors(m)%dbl1d(ts_strloc%row)
          ! -- JCol=0, consistent with ts_update_indexed, so a stale
          ! -- PACKAGEDATA-level link is found and cleared like AUX's
          call read_value_or_time_series(ts_strloc%token, irow, &
                                         0, bndelem, &
                                         subcomp_name, 'BND', tsmanager, &
                                         iprpak, tslink)
          if (associated(tslink)) then
            tslink%Text = this%struct_vectors(m)%idt%mf6varname
            if (iboundname > 0) then
              boundname = &
                this%struct_vectors(iboundname)%charstr1d(ts_strloc%row)
              tslink%BndName = boundname
            end if
          end if
        case (mtype_dbl2d) ! dbl2d (AUX)
          if (.not. present(auxname_cst)) cycle
          if (.not. associated(auxname_cst)) cycle
          bndelem => this%struct_vectors(m)%dbl2d(ts_strloc%col, ts_strloc%row)
          ! -- JCol is the AUX array position (ts_strloc%col), not the
          ! -- row-schema column, so remove_existing_link can find it
          call read_value_or_time_series(ts_strloc%token, irow, &
                                         ts_strloc%col, bndelem, &
                                         subcomp_name, 'AUX', tsmanager, &
                                         iprpak, tslink)
          if (associated(tslink)) then
            tslink%Text = auxname_cst(ts_strloc%col)
            if (iboundname > 0) then
              boundname = &
                this%struct_vectors(iboundname)%charstr1d(ts_strloc%row)
              tslink%BndName = boundname
            end if
          end if
        end select
      end do
      if (do_clear) call this%struct_vectors(m)%clear()
    end do
 
    if (count_errors() > 0) then
      call store_error_filename(input_name)
    end if

Here is the call graph for this function:

ts_update_adv()

subroutine structarraymodule::ts_update_adv ( class(structarraytype), intent(inout)  this, integer(i4b), intent(in)  icol, type(timeseriesmanagertype), intent(inout), pointer  tsmanager, character(len=*), intent(in)  subcomp_name, integer(i4b), intent(in)  iprpak, integer(i4b), intent(in)  nrows, integer(i4b), dimension(:), intent(in)  ifno_map, type(characterstringtype), dimension(:), intent(in), pointer  auxname_cst, real(dp), dimension(:, :), intent(in), pointer  featarr2d  )

private

Parameters

[in]	nrows	rows read this period
[in]	ifno_map	PERIOD row -> feature index
[in]	auxname_cst	AUX column names, indexed 1..naux
[in]	featarr2d	permanent dbl2d (AUX) target

Definition at line 1550 of file StructArray.f90.

    class(StructArrayType), intent(inout) :: this
    integer(I4B), intent(in) :: icol
    type(TimeSeriesManagerType), pointer, intent(inout) :: tsmanager
    character(len=*), intent(in) :: subcomp_name
    integer(I4B), intent(in) :: iprpak
    integer(I4B), intent(in) :: nrows !< rows read this period
    integer(I4B), dimension(:), intent(in) :: ifno_map !< PERIOD row -> feature index
    type(CharacterStringType), dimension(:), pointer, intent(in) :: auxname_cst !< AUX column names, indexed 1..naux
    real(DP), dimension(:, :), pointer, intent(in) :: featarr2d !< permanent dbl2d (AUX) target
    character(len=LENVARNAME) :: names(size(auxname_cst))
    integer(I4B) :: j
 
    do j = 1, size(auxname_cst)
      names(j) = auxname_cst(j)
    end do
    call this%ts_update_dedup(icol, tsmanager, subcomp_name, iprpak, &
                              nrows, ifno_map, 'AUX', names, featarr2d, &
                              this%struct_vectors(icol)%dbl2d)

ts_update_dedup()

subroutine structarraymodule::ts_update_dedup ( class(structarraytype), intent(inout)  this, integer(i4b), intent(in)  icol, type(timeseriesmanagertype), intent(inout), pointer  tsmanager, character(len=*), intent(in)  subcomp_name, integer(i4b), intent(in)  iprpak, integer(i4b), intent(in)  nrows, integer(i4b), dimension(:), intent(in)  addr_map, character(len=*), intent(in)  category, character(len=lenvarname), dimension(:), intent(in)  names, real(dp), dimension(:, :), intent(in), pointer  featarr2d, real(dp), dimension(:, :), intent(in), pointer  raw2d  )

private

Parameters

[in]	category	'AUX' or 'BND'
[in]	nrows	rows read this period
[in]	addr_map	PERIOD row -> feature index
[in]	names	size naux
[in]	featarr2d	(naux, nfeatures) permanent target
[in]	raw2d	(naux, nrows) raw column source

Definition at line 1490 of file StructArray.f90.

    class(StructArrayType), intent(inout) :: this
    integer(I4B), intent(in) :: icol
    type(TimeSeriesManagerType), pointer, intent(inout) :: tsmanager
    character(len=*), intent(in) :: subcomp_name
    character(len=*), intent(in) :: category !< 'AUX' or 'BND'
    integer(I4B), intent(in) :: iprpak
    integer(I4B), intent(in) :: nrows !< rows read this period
    integer(I4B), dimension(:), intent(in) :: addr_map !< PERIOD row -> feature index
    character(len=LENVARNAME), dimension(:), intent(in) :: names !< size naux
    real(DP), dimension(:, :), pointer, intent(in) :: featarr2d !< (naux, nfeatures) permanent target
    real(DP), dimension(:, :), pointer, intent(in) :: raw2d !< (naux, nrows) raw column source
    type(TSStringLocType), pointer :: ts_strloc
    real(DP), pointer :: bndElem
    logical(LGP) :: found
    integer(I4B) :: n, j, k, nts, i, naux
    logical(LGP), dimension(:, :), allocatable :: handled2
 
    naux = size(names)
    allocate (handled2(naux, nrows))
    handled2 = .false.
 
    ! time-series-linked rows: resolve via their preserved token
    nts = this%struct_vectors(icol)%ts_strlocs%count()
    do k = 1, nts
      ts_strloc => this%struct_vectors(icol)%get_ts_strloc(k)
      i = addr_map(ts_strloc%row)
      if (i < 1 .or. i > size(featarr2d, 2)) cycle
      bndelem => featarr2d(ts_strloc%col, i)
      call read_value_or_time_series_adv( &
        ts_strloc%token, i, ts_strloc%col, bndelem, subcomp_name, &
        category, tsmanager, iprpak, trim(names(ts_strloc%col)))
      handled2(ts_strloc%col, ts_strloc%row) = .true.
    end do
 
    ! literal rows: clear any stale link, then assign; DNODATA means
    ! unset this row -- leave the value and any link untouched
    do n = 1, nrows
      i = addr_map(n)
      if (i < 1 .or. i > size(featarr2d, 2)) cycle
      do j = 1, naux
        if (handled2(j, n)) cycle
        if (raw2d(j, n) == dnodata) cycle
        found = remove_existing_link(tsmanager, i, j, subcomp_name, &
                                     category, trim(names(j)))
        featarr2d(j, i) = raw2d(j, n)
      end do
    end do
    deallocate (handled2)
 
    ! clear strlocs so a later period's parse (different row indexing)
    ! doesn't reprocess these against a mismatched addr_map
    call this%struct_vectors(icol)%clear()

Here is the call graph for this function:

ts_update_indexed()

subroutine structarraymodule::ts_update_indexed ( class(structarraytype), intent(inout)  this, integer(i4b), intent(in)  icol, type(timeseriesmanagertype), intent(inout), pointer  tsmanager, character(len=*), intent(in)  subcomp_name, integer(i4b), intent(in)  iprpak, integer(i4b), intent(in)  nrows, integer(i4b), dimension(:), intent(in)  row_addr, character(len=*), intent(in)  varname, real(dp), dimension(:), intent(in), pointer, contiguous  featarr  )

private

Parameters

[in]

nrows

rows to process this period

Definition at line 1577 of file StructArray.f90.

    class(StructArrayType), intent(inout) :: this
    integer(I4B), intent(in) :: icol
    type(TimeSeriesManagerType), pointer, intent(inout) :: tsmanager
    character(len=*), intent(in) :: subcomp_name
    integer(I4B), intent(in) :: iprpak
    integer(I4B), intent(in) :: nrows !< rows to process this period
    integer(I4B), dimension(:), intent(in) :: row_addr
    character(len=*), intent(in) :: varname
    real(DP), dimension(:), pointer, contiguous, intent(in) :: featarr
    real(DP), dimension(:, :), pointer :: featarr2d, raw2d
    character(len=LENVARNAME) :: names(1)
 
    ! naux=1 rank remaps onto the shared 2D core; neither is a copy
    featarr2d(1:1, 1:size(featarr)) => featarr
    raw2d(1:1, 1:nrows) => this%struct_vectors(icol)%dbl1d(1:nrows)
    names(1) = varname
    call this%ts_update_dedup(icol, tsmanager, subcomp_name, iprpak, &
                              nrows, row_addr, 'BND', names, featarr2d, &
                              raw2d)