bndextmodule Module Reference

This module contains the extended boundary package. More...

Data Types
type	bndexttype
	@ brief BndExtType More...
type	bndextfoundtype
	@ brief BndExtFoundType More...

Functions/Subroutines
subroutine	bndext_df (this, neq, dis)
	@ brief Define boundary package options and dimensions More...
subroutine	bndext_rp (this)
subroutine	bndext_da (this)
	@ brief Deallocate package memory More...
subroutine	bndext_allocate_scalars (this)
	@ brief Allocate package scalars More...
subroutine	bndext_allocate_arrays (this, nodelist, auxvar)
	@ brief Allocate package arrays More...
subroutine	source_options (this)
	@ brief Source package options from input context More...
subroutine	log_options (this, found, sfacauxname)
	@ brief Log package options More...
subroutine	source_dimensions (this)
	@ brief Source package dimensions from input context More...
subroutine	nodelist_update (this)
	@ brief Update package nodelist More...
subroutine	check_cellid (this, ii, cellid, mshape, ndim)
	@ brief Check for valid cellid More...
subroutine	write_list (this)
	@ brief Log package list input More...
real(dp) function	bound_value (this, col, row)
	@ brief Return a bound value More...

Detailed Description

This module contains the extended boundary type that itself should be extended by model boundary packages that have been updated to source static and dynamic input data from the input context.

Function/Subroutine Documentation

bndext_allocate_arrays()

subroutine bndextmodule::bndext_allocate_arrays	(	class(bndexttype)	this,
		integer(i4b), dimension(:), optional, pointer, contiguous	nodelist,
		real(dp), dimension(:, :), optional, pointer, contiguous	auxvar
	)

Allocate and initialize base boundary package arrays. This method only needs to be overridden if additional arrays are defined for a specific package.

Parameters

this	BndExtType object
nodelist	package nodelist
auxvar	package aux variable array

Definition at line 227 of file BoundaryPackageExt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate, mem_setptr, mem_checkin
    ! -- dummy variables
    class(BndExtType) :: this !< BndExtType object
    ! -- local variables
    integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist !< package nodelist
    real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar !< package aux variable array
    !
    ! -- allocate base BndType arrays
    call this%BndType%allocate_arrays(nodelist, auxvar)
    !
    ! -- set input context pointers
    call mem_setptr(this%cellid, 'CELLID', this%input_mempath)
    call mem_setptr(this%boundname_cst, 'BOUNDNAME', this%input_mempath)
    !
    ! -- checkin input context pointers
    call mem_checkin(this%cellid, 'CELLID', this%memoryPath, &
                     'CELLID', this%input_mempath)
    call mem_checkin(this%boundname_cst, lenboundname, 'BOUNDNAME_IDM', &
                     this%memoryPath, 'BOUNDNAME', this%input_mempath)
    !
    if (present(auxvar)) then
      ! no-op
    else
      ! -- set auxvar input context pointer
      call mem_setptr(this%auxvar, 'AUXVAR', this%input_mempath)
      !
      ! -- checkin auxvar input context pointer
      call mem_checkin(this%auxvar, 'AUXVAR_IDM', this%memoryPath, &
                       'AUXVAR', this%input_mempath)
    end if
    !
    ! -- return
    return

bndext_allocate_scalars()

subroutine bndextmodule::bndext_allocate_scalars

(

class(bndexttype)

this

)

Allocate and initialize base boundary package scalars. This method only needs to be overridden if additional scalars are defined for a specific package.

Parameters

this	BndExtType object

Definition at line 196 of file BoundaryPackageExt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_setptr
    use memorymanagerextmodule, only: mem_set_value
    use memoryhelpermodule, only: create_mem_path
    use simvariablesmodule, only: idm_context
    ! -- dummy variables
    class(BndExtType) :: this !< BndExtType object
    ! -- local variables
    character(len=LENMEMPATH) :: input_mempath
    !
    ! -- set memory path
    input_mempath = create_mem_path(this%name_model, this%packName, idm_context)
    !
    ! -- allocate base BndType scalars
    call this%BndType%allocate_scalars()
    !
    ! -- set pointers to period input data scalars
    call mem_setptr(this%iper, 'IPER', input_mempath)
    !
    ! -- return
    return

Here is the call graph for this function:

bndext_da()

subroutine bndextmodule::bndext_da

(

class(bndexttype)

this

)

Parameters

this	BndExtType object

Definition at line 164 of file BoundaryPackageExt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate, mem_setptr
    ! -- dummy variables
    class(BndExtType) :: this !< BndExtType object
    !
    ! -- deallocate checkin paths
    call mem_deallocate(this%cellid, 'CELLID', this%memoryPath)
    call mem_deallocate(this%boundname_cst, 'BOUNDNAME_IDM', this%memoryPath)
    call mem_deallocate(this%auxvar, 'AUXVAR_IDM', this%memoryPath)
    !
    ! -- reassign pointers for base class _da
    call mem_setptr(this%boundname_cst, 'BOUNDNAME_CST', this%memoryPath)
    call mem_setptr(this%auxvar, 'AUXVAR', this%memoryPath)
    !
    ! -- scalars
    nullify (this%iper)
    !
    ! -- deallocate
    call this%BndType%bnd_da()
    !
    ! -- return
    return

bndext_df()

subroutine bndextmodule::bndext_df ( class(bndexttype), intent(inout)  this, integer(i4b), intent(inout)  neq, class(disbasetype), pointer  dis  )

private

Define base boundary package options and dimensions for a model boundary package.

Parameters

[in,out]	this	BndExtType object
[in,out]	neq	number of equations
	dis	discretization object

Definition at line 76 of file BoundaryPackageExt.f90.

    ! -- modules
    use basedismodule, only: disbasetype
    use timearrayseriesmanagermodule, only: timearrayseriesmanagertype, &
                                            tasmanager_cr
    use timeseriesmanagermodule, only: timeseriesmanagertype, tsmanager_cr
    ! -- dummy variables
    class(BndExtType), intent(inout) :: this !< BndExtType object
    integer(I4B), intent(inout) :: neq !< number of equations
    class(DisBaseType), pointer :: dis !< discretization object
    !
    ! -- set pointer to dis object for the model
    this%dis => dis
    !
    ! -- Create time series managers
    ! -- Not in use by this type but BndType uses and deallocates
    call tsmanager_cr(this%TsManager, this%iout)
    call tasmanager_cr(this%TasManager, dis, this%name_model, this%iout)
    !
    ! -- create obs package
    call obs_cr(this%obs, this%inobspkg)
    !
    ! -- Write information to model list file
    write (this%iout, 1) this%filtyp, trim(adjustl(this%text)), this%input_mempath
1   format(1x, /1x, a, ' -- ', a, ' PACKAGE, VERSION 8, 2/22/2014', &
           ' INPUT READ FROM MEMPATH: ', a)
    !
    ! -- source options
    call this%source_options()
    !
    ! -- Define time series managers
    call this%tsmanager%tsmanager_df()
    call this%tasmanager%tasmanager_df()
    !
    ! -- source dimensions
    call this%source_dimensions()
    !
    ! -- update package moffset for packages that add rows
    if (this%npakeq > 0) then
      this%ioffset = neq - this%dis%nodes
    end if
    !
    ! -- update neq
    neq = neq + this%npakeq
    !
    ! -- Store information needed for observations
    if (this%bnd_obs_supported()) then
      call this%obs%obs_df(this%iout, this%packName, this%filtyp, this%dis)
      call this%bnd_df_obs()
    end if
    !
    ! -- return
    return

Here is the call graph for this function:

bndext_rp()

subroutine bndextmodule::bndext_rp

(

class(bndexttype), intent(inout)

this

)

Parameters

[in,out]

this

BndExtType object

Definition at line 131 of file BoundaryPackageExt.f90.

    ! -- modules
    use tdismodule, only: kper
    use memorymanagermodule, only: mem_deallocate, mem_reallocate
    use memorymanagerextmodule, only: mem_set_value
    ! -- dummy variables
    class(BndExtType), intent(inout) :: this !< BndExtType object
    ! -- local variables
    logical(LGP) :: found
    integer(I4B) :: n
    !
    if (this%iper /= kper) return
    !
    ! -- copy nbound from input context
    call mem_set_value(this%nbound, 'NBOUND', this%input_mempath, &
                       found)
    !
    ! -- convert cellids to node numbers
    call this%nodelist_update()
    !
    ! -- update boundname string list
    if (this%inamedbound /= 0) then
      do n = 1, size(this%boundname_cst)
        this%boundname(n) = this%boundname_cst(n)
      end do
    end if
    !
    ! -- return
    return

bound_value()

real(dp) function bndextmodule::bound_value	(	class(bndexttype), intent(inout)	this,
		integer(i4b), intent(in)	col,
		integer(i4b), intent(in)	row
	)

Return a bound value associated with an ncolbnd index and row. This function should be overridden in the derived package class.

Parameters

[in,out]

this

BndExtType object

Definition at line 761 of file BoundaryPackageExt.f90.

    ! -- modules
    use constantsmodule, only: dnodata
    ! -- dummy variables
    class(BndExtType), intent(inout) :: this !< BndExtType object
    integer(I4B), intent(in) :: col
    integer(I4B), intent(in) :: row
    ! -- result
    real(DP) :: bndval
    !
    ! -- override this return value by redefining this
    !    routine in the derived package.
    bndval = dnodata
    !
    ! -- return
    return

check_cellid()

subroutine bndextmodule::check_cellid	(	class(bndexttype)	this,
		integer(i4b), intent(in)	ii,
		integer(i4b), dimension(:), intent(in)	cellid,
		integer(i4b), dimension(:), intent(in)	mshape,
		integer(i4b), intent(in)	ndim
	)

Parameters

	this	BndExtType object
[in]	mshape	model shape
[in]	ndim	size of mshape

Definition at line 530 of file BoundaryPackageExt.f90.

    ! -- modules
    use simvariablesmodule, only: errmsg
    ! -- dummy
    class(BndExtType) :: this !< BndExtType object
    ! -- local
    integer(I4B), intent(in) :: ii
    integer(I4B), dimension(:), intent(in) :: cellid !< cellid
    integer(I4B), dimension(:), intent(in) :: mshape !< model shape
    integer(I4B), intent(in) :: ndim !< size of mshape
    character(len=20) :: cellstr, mshstr
    character(len=*), parameter :: fmterr = &
      "('List entry ',i0,' contains cellid ',a,' but this cellid is invalid &
      &for model with shape ', a)"
    character(len=*), parameter :: fmtndim1 = &
                                   "('(',i0,')')"
    character(len=*), parameter :: fmtndim2 = &
                                   "('(',i0,',',i0,')')"
    character(len=*), parameter :: fmtndim3 = &
                                   "('(',i0,',',i0,',',i0,')')"
    select case (ndim)
    case (1)
      !
      if (cellid(1) < 1 .or. cellid(1) > mshape(1)) then
        write (cellstr, fmtndim1) cellid(1)
        write (mshstr, fmtndim1) mshape(1)
        write (errmsg, fmterr) ii, trim(adjustl(cellstr)), trim(adjustl(mshstr))
        call store_error(errmsg)
      end if
      !
    case (2)
      !
      if (cellid(1) < 1 .or. cellid(1) > mshape(1) .or. &
          cellid(2) < 1 .or. cellid(2) > mshape(2)) then
        write (cellstr, fmtndim2) cellid(1), cellid(2)
        write (mshstr, fmtndim2) mshape(1), mshape(2)
        write (errmsg, fmterr) ii, trim(adjustl(cellstr)), trim(adjustl(mshstr))
        call store_error(errmsg)
      end if
      !
    case (3)
      !
      if (cellid(1) < 1 .or. cellid(1) > mshape(1) .or. &
          cellid(2) < 1 .or. cellid(2) > mshape(2) .or. &
          cellid(3) < 1 .or. cellid(3) > mshape(3)) then
        write (cellstr, fmtndim3) cellid(1), cellid(2), cellid(3)
        write (mshstr, fmtndim3) mshape(1), mshape(2), mshape(3)
        write (errmsg, fmterr) ii, trim(adjustl(cellstr)), trim(adjustl(mshstr))
        call store_error(errmsg)
      end if
      !
    case default
    end select
    !
    ! -- return
    return

Here is the call graph for this function:

log_options()

subroutine bndextmodule::log_options	(	class(bndexttype), intent(inout)	this,
		type(bndextfoundtype), intent(in)	found,
		character(len=*), intent(in)	sfacauxname
	)

Parameters

[in,out]

this

BndExtType object

Definition at line 366 of file BoundaryPackageExt.f90.

    ! -- modules
    ! -- dummy variables
    class(BndExtType), intent(inout) :: this !< BndExtType object
    type(BndExtFoundType), intent(in) :: found
    character(len=*), intent(in) :: sfacauxname
    ! -- local variables
    ! -- format
    character(len=*), parameter :: fmtflow = &
      &"(4x, 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL')"
    character(len=*), parameter :: fmttas = &
      &"(4x, 'TIME-ARRAY SERIES DATA WILL BE READ FROM FILE: ', a)"
    character(len=*), parameter :: fmtts = &
      &"(4x, 'TIME-SERIES DATA WILL BE READ FROM FILE: ', a)"
    character(len=*), parameter :: fmtnme = &
      &"(a, i0, a)"
    !
    ! -- log found options
    write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) &
      //' BASE OPTIONS'
    !
    if (found%ipakcb) then
      write (this%iout, fmtflow)
    end if
    !
    if (found%iprpak) then
      write (this%iout, '(4x,a)') &
        'LISTS OF '//trim(adjustl(this%text))//' CELLS WILL BE PRINTED.'
    end if
    !
    if (found%iprflow) then
      write (this%iout, '(4x,a)') trim(adjustl(this%text))// &
        ' FLOWS WILL BE PRINTED TO LISTING FILE.'
    end if
    !
    if (found%boundnames) then
      write (this%iout, '(4x,a)') trim(adjustl(this%text))// &
        ' BOUNDARIES HAVE NAMES IN LAST COLUMN.'
    end if
    !
    if (found%auxmultname) then
      write (this%iout, '(4x,a,a)') &
        'AUXILIARY MULTIPLIER NAME: ', sfacauxname
    end if
    !
    if (found%inewton) then
      write (this%iout, '(4x,a)') &
        'NEWTON-RAPHSON method disabled for unconfined cells'
    end if
    !
    ! -- close logging block
    write (this%iout, '(1x,a)') &
      'END OF '//trim(adjustl(this%text))//' BASE OPTIONS'
    !
    ! -- return
    return

nodelist_update()

subroutine bndextmodule::nodelist_update

(

class(bndexttype)

this

)

Convert period updated cellids to node numbers.

Parameters

this	BndExtType object

Definition at line 467 of file BoundaryPackageExt.f90.

    ! -- modules
    use simvariablesmodule, only: errmsg
    ! -- dummy
    class(BndExtType) :: this !< BndExtType object
    ! -- local
    integer(I4B), dimension(:), pointer :: cellid
    integer(I4B) :: n, nodeu, noder
    character(len=LINELENGTH) :: nodestr
    !
    ! -- update nodelist
    do n = 1, this%nbound
      !
      ! -- set cellid
      cellid => this%cellid(:, n)
      !
      ! -- ensure cellid is valid, store an error otherwise
      call this%check_cellid(n, cellid, this%dis%mshape, this%dis%ndim)
      !
      ! -- Determine user node number
      if (this%dis%ndim == 1) then
        nodeu = cellid(1)
      elseif (this%dis%ndim == 2) then
        nodeu = get_node(cellid(1), 1, cellid(2), &
                         this%dis%mshape(1), 1, &
                         this%dis%mshape(2))
      else
        nodeu = get_node(cellid(1), cellid(2), cellid(3), &
                         this%dis%mshape(1), &
                         this%dis%mshape(2), &
                         this%dis%mshape(3))
      end if
      !
      ! -- update the nodelist
      if (this%dis%nodes < this%dis%nodesuser) then
        ! -- convert user to reduced node numbers
        noder = this%dis%get_nodenumber(nodeu, 0)
        if (noder <= 0) then
          call this%dis%nodeu_to_string(nodeu, nodestr)
          write (errmsg, *) &
            ' Cell is outside active grid domain: '// &
            trim(adjustl(nodestr))
          call store_error(errmsg)
        end if
        this%nodelist(n) = noder
      else
        this%nodelist(n) = nodeu
      end if
    end do
    !
    ! -- exit if errors were found
    if (count_errors() > 0) then
      write (errmsg, *) count_errors(), ' errors encountered.'
      call store_error(errmsg)
      call store_error_filename(this%input_fname)
    end if
    !
    ! -- return
    return

Here is the call graph for this function:

source_dimensions()

subroutine bndextmodule::source_dimensions ( class(bndexttype), intent(inout)  this )

private

Parameters

[in,out]

this

BndExtType object

Definition at line 426 of file BoundaryPackageExt.f90.

    use memorymanagerextmodule, only: mem_set_value
    ! -- dummy variables
    class(BndExtType), intent(inout) :: this !< BndExtType object
    ! -- local variables
    type(BndExtFoundType) :: found
    !
    ! -- open dimensions logging block
    write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// &
      ' BASE DIMENSIONS'
    !
    ! -- update defaults with idm sourced values
    call mem_set_value(this%maxbound, 'MAXBOUND', this%input_mempath, &
                       found%maxbound)
    !
    write (this%iout, '(4x,a,i7)') 'MAXBOUND = ', this%maxbound
    !
    ! -- close logging block
    write (this%iout, '(1x,a)') &
      'END OF '//trim(adjustl(this%text))//' BASE DIMENSIONS'
    !
    ! -- verify dimensions were set
    if (this%maxbound <= 0) then
      write (errmsg, '(a)') 'MAXBOUND must be an integer greater than zero.'
      call store_error(errmsg)
      call store_error_filename(this%input_fname)
    end if
    !
    ! -- Call define_listlabel to construct the list label that is written
    !    when PRINT_INPUT option is used.
    call this%define_listlabel()
    !
    ! -- return
    return

Here is the call graph for this function:

source_options()

subroutine bndextmodule::source_options

(

class(bndexttype), intent(inout)

this

)

Parameters

[in,out]

this

BndExtType object

Definition at line 266 of file BoundaryPackageExt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_reallocate, mem_setptr !, get_isize
    use memorymanagerextmodule, only: mem_set_value
    use inputoutputmodule, only: getunit, openfile
    use characterstringmodule, only: characterstringtype
    use sourcecommonmodule, only: filein_fname
    ! -- dummy variables
    class(BndExtType), intent(inout) :: this !< BndExtType object
    ! -- local variables
    type(BndExtFoundType) :: found
    character(len=LENAUXNAME) :: sfacauxname
    integer(I4B) :: n
    !
    ! -- update defaults with idm sourced values
    call mem_set_value(this%naux, 'NAUX', this%input_mempath, found%naux)
    call mem_set_value(this%ipakcb, 'IPAKCB', this%input_mempath, found%ipakcb)
    call mem_set_value(this%iprpak, 'IPRPAK', this%input_mempath, found%iprpak)
    call mem_set_value(this%iprflow, 'IPRFLOW', this%input_mempath, found%iprflow)
    call mem_set_value(this%inamedbound, 'BOUNDNAMES', this%input_mempath, &
                       found%boundnames)
    call mem_set_value(sfacauxname, 'AUXMULTNAME', this%input_mempath, &
                       found%auxmultname)
    call mem_set_value(this%inewton, 'INEWTON', this%input_mempath, found%inewton)
    !
    ! -- log found options
    call this%log_options(found, sfacauxname)
    !
    ! -- reallocate aux arrays if aux variables provided
    if (found%naux .and. this%naux > 0) then
      call mem_reallocate(this%auxname, lenauxname, this%naux, &
                          'AUXNAME', this%memoryPath)
      call mem_reallocate(this%auxname_cst, lenauxname, this%naux, &
                          'AUXNAME_CST', this%memoryPath)
      call mem_set_value(this%auxname_cst, 'AUXILIARY', this%input_mempath, &
                         found%auxiliary)
      !
      do n = 1, this%naux
        this%auxname(n) = this%auxname_cst(n)
      end do
    end if
    !
    ! -- save flows option active
    if (found%ipakcb) this%ipakcb = -1
    !
    ! -- auxmultname provided
    if (found%auxmultname) this%iauxmultcol = -1
    !
    !
    ! -- enforce 0 or 1 OBS6_FILENAME entries in option block
    if (filein_fname(this%obs%inputFilename, 'OBS6_FILENAME', &
                     this%input_mempath, this%input_fname)) then
      this%obs%active = .true.
      this%obs%inUnitObs = getunit()
      call openfile(this%obs%inUnitObs, this%iout, this%obs%inputFilename, 'OBS')
    end if
    !
    ! -- no newton specified
    if (found%inewton) this%inewton = 0
    !
    ! -- AUXMULTNAME was specified, so find column of auxvar that will be multiplier
    if (this%iauxmultcol < 0) then
      !
      ! -- Error if no aux variable specified
      if (this%naux == 0) then
        write (errmsg, '(a,2(1x,a))') &
          'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
          'but no AUX variables specified.'
        call store_error(errmsg)
      end if
      !
      ! -- Assign mult column
      this%iauxmultcol = 0
      do n = 1, this%naux
        if (sfacauxname == this%auxname(n)) then
          this%iauxmultcol = n
          exit
        end if
      end do
      !
      ! -- Error if aux variable cannot be found
      if (this%iauxmultcol == 0) then
        write (errmsg, '(a,2(1x,a))') &
          'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
          'but no AUX variable found with this name.'
        call store_error(errmsg)
      end if
    end if
    !
    ! -- terminate if errors were detected
    if (count_errors() > 0) then
      call store_error_filename(this%input_fname)
    end if
    !
    ! -- return
    return

Here is the call graph for this function:

write_list()

subroutine bndextmodule::write_list

(

class(bndexttype)

this

)

Log period list based input. This routine requires a package specific bound_value() routine to report accurate bound values.

Parameters

this	BndExtType object

Definition at line 594 of file BoundaryPackageExt.f90.

    ! -- modules
    use constantsmodule, only: linelength, lenboundname, &
                               tableft, tabcenter, dzero
    use inputoutputmodule, only: ulstlb
    use tablemodule, only: tabletype, table_cr
    ! -- dummy
    class(BndExtType) :: this !< BndExtType object
    ! -- local
    character(len=10) :: cpos
    character(len=LINELENGTH) :: tag
    character(len=LINELENGTH), allocatable, dimension(:) :: words
    integer(I4B) :: ntabrows
    integer(I4B) :: ntabcols
    integer(I4B) :: ipos
    integer(I4B) :: ii, jj, i, j, k, nod
    integer(I4B) :: ldim
    integer(I4B) :: naux
    type(TableType), pointer :: inputtab => null()
    ! -- formats
    character(len=LINELENGTH) :: fmtlstbn
! ------------------------------------------------------------------------------
    !
    ! -- Determine sizes
    ldim = this%ncolbnd
    naux = size(this%auxvar, 1)
    !
    ! -- dimension table
    ntabrows = this%nbound
    !
    ! -- start building format statement to parse this%label, which
    !    contains the column headers (except for boundname and auxnames)
    ipos = index(this%listlabel, 'NO.')
    if (ipos /= 0) then
      write (cpos, '(i10)') ipos + 3
      fmtlstbn = '(a'//trim(adjustl(cpos))
    else
      fmtlstbn = '(a7'
    end if
    ! -- sequence number, layer, row, and column.
    if (size(this%dis%mshape) == 3) then
      ntabcols = 4
      fmtlstbn = trim(fmtlstbn)//',a7,a7,a7'
      !
      ! -- sequence number, layer, and cell2d.
    else if (size(this%dis%mshape) == 2) then
      ntabcols = 3
      fmtlstbn = trim(fmtlstbn)//',a7,a7'
      !
      ! -- sequence number and node.
    else
      ntabcols = 2
      fmtlstbn = trim(fmtlstbn)//',a7'
    end if
    !
    ! -- Add fields for non-optional real values
    ntabcols = ntabcols + ldim
    do i = 1, ldim
      fmtlstbn = trim(fmtlstbn)//',a16'
    end do
    !
    ! -- Add field for boundary name
    if (this%inamedbound == 1) then
      ntabcols = ntabcols + 1
      fmtlstbn = trim(fmtlstbn)//',a16'
    end if
    !
    ! -- Add fields for auxiliary variables
    ntabcols = ntabcols + naux
    do i = 1, naux
      fmtlstbn = trim(fmtlstbn)//',a16'
    end do
    fmtlstbn = trim(fmtlstbn)//')'
    !
    ! -- allocate words
    allocate (words(ntabcols))
    !
    ! -- parse this%listlabel into words
    read (this%listlabel, fmtlstbn) (words(i), i=1, ntabcols)
    !
    ! -- initialize the input table object
    call table_cr(inputtab, ' ', ' ')
    call inputtab%table_df(ntabrows, ntabcols, this%iout)
    !
    ! -- add the columns
    ipos = 1
    call inputtab%initialize_column(words(ipos), 10, alignment=tabcenter)
    !
    ! -- discretization
    do i = 1, size(this%dis%mshape)
      ipos = ipos + 1
      call inputtab%initialize_column(words(ipos), 7, alignment=tabcenter)
    end do
    !
    ! -- non-optional variables
    do i = 1, ldim
      ipos = ipos + 1
      call inputtab%initialize_column(words(ipos), 16, alignment=tabcenter)
    end do
    !
    ! -- boundname
    if (this%inamedbound == 1) then
      ipos = ipos + 1
      tag = 'BOUNDNAME'
      call inputtab%initialize_column(tag, lenboundname, alignment=tableft)
    end if
    !
    ! -- aux variables
    do i = 1, naux
      call inputtab%initialize_column(this%auxname(i), 16, alignment=tabcenter)
    end do
    !
    ! -- Write the table
    do ii = 1, this%nbound
      call inputtab%add_term(ii)
      !
      ! -- discretization
      if (size(this%dis%mshape) == 3) then
        nod = this%nodelist(ii)
        call get_ijk(nod, this%dis%mshape(2), this%dis%mshape(3), &
                     this%dis%mshape(1), i, j, k)
        call inputtab%add_term(k)
        call inputtab%add_term(i)
        call inputtab%add_term(j)
      else if (size(this%dis%mshape) == 2) then
        nod = this%nodelist(ii)
        call get_ijk(nod, 1, this%dis%mshape(2), this%dis%mshape(1), i, j, k)
        call inputtab%add_term(k)
        call inputtab%add_term(j)
      else
        nod = this%nodelist(ii)
        call inputtab%add_term(nod)
      end if
      !
      ! -- non-optional variables
      do jj = 1, ldim
        call inputtab%add_term(this%bound_value(jj, ii))
      end do
      !
      ! -- boundname
      if (this%inamedbound == 1) then
        call inputtab%add_term(this%boundname(ii))
      end if
      !
      ! -- aux variables
      do jj = 1, naux
        call inputtab%add_term(this%auxvar(jj, ii))
      end do
    end do
    !
    ! -- deallocate the local variables
    call inputtab%table_da()
    deallocate (inputtab)
    nullify (inputtab)
    deallocate (words)
    !
    ! -- return
    return

Here is the call graph for this function: