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_ad (this)
	Advance the package one time step. More...
subroutine	bndext_rp (this)
subroutine	bndext_rp_log (this)
	Write the input list to the listing file if requested. More...
integer(i4b) function	validate_ifno (this, ifno_val, nfeatures, nboundchk, feature_label, blockname)
	@ brief Validate a list-input row's IFNO and update the per-feature coverage counter More...
subroutine	report_ifno_coverage (this, nboundchk, nfeatures, feature_label, blockname, check_missing)
	@ brief Report missing or duplicate list-input rows for each feature More...
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	allocate_featureauxvar (this)
	Point the per-feature auxiliary variable array at the input context's permanent, feature-indexed AUX array. For packages with PACKAGEDATA AUX variables only. A live alias, permuted from row order to IFNO order, skipping out-of-range IFNO. 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	cellid_to_nlist (this)
	@ brief Update package nodelist More...
subroutine	nodeu_to_nlist (this)
	@ brief Update package nodelist More...
subroutine	layarr_to_nlist (this)
	Update the nodelist based on layer number variable input. More...
subroutine	default_nodelist (this)
	Assign default nodelist when READASARRAYS is specified. More...
subroutine	check_cellid (this, ii, cellid, mshape, ndim)
	@ brief Check for valid cellid More...
subroutine	write_lstfile (this)
	@ brief Log package stress period 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

allocate_featureauxvar()

subroutine bndextmodule::allocate_featureauxvar

(

class(bndexttype)

this

)

Parameters

this	BndExtType object

Definition at line 415 of file BoundaryPackageExt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_setptr
    ! -- dummy
    class(BndExtType) :: this !< BndExtType object
    ! -- local
    real(DP), dimension(:, :), allocatable :: aux_row_order
    integer(I4B) :: n, ifeat, jj, nrow
    !
    ! -- set input context PACKAGEDATA pointers
    call mem_setptr(this%pkg_ifno, 'PACKAGEDATA_IFNO', this%input_mempath)
    if (this%naux > 0) then
      call mem_setptr(this%featureauxvar, 'AUX', this%input_mempath)
      nrow = size(this%pkg_ifno)
      allocate (aux_row_order(this%naux, nrow))
      aux_row_order = this%featureauxvar(:, 1:nrow)
      do n = 1, nrow
        ifeat = this%pkg_ifno(n)
        if (ifeat < 1 .or. ifeat > size(this%featureauxvar, 2)) cycle
        do jj = 1, this%naux
          this%featureauxvar(jj, ifeat) = aux_row_order(jj, n)
        end do
      end do
      deallocate (aux_row_order)
    end if

bndext_ad()

subroutine bndextmodule::bndext_ad

(

class(bndexttype)

this

)

Does not call thisTsManagerad()/thisTasManagerad() – those managers are unused by this type (see bndext_df).

Definition at line 164 of file BoundaryPackageExt.f90.

    ! -- dummy
    class(BndExtType) :: this
    !
    ! -- advance observations
    call this%obs%obs_ad()

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 364 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
    !
    if (this%isadvpak /= 0) then
      !
      ! -- advanced package (MAW, SFR, LAK, UZF): allocate connections-level BndType arrays
      call this%BndType%allocate_arrays(nodelist, auxvar)
      call mem_checkin(this%auxvar, 'AUXVAR_IDM', this%memoryPath, 'AUXVAR', &
                       this%memoryPath)
      return
    end if
    !
    ! -- list/layerarray/gridarray package: 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%nodeulist, 'NODEULIST', 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%nodeulist, 'NODEULIST', this%memoryPath, &
                     'NODEULIST', 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

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 333 of file BoundaryPackageExt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_setptr
    ! -- dummy variables
    class(BndExtType) :: this !< BndExtType object
    ! -- local variables
    !
    ! -- allocate base BndType scalars
    call this%BndType%allocate_scalars()
    !
    ! -- set IPER pointer
    call mem_setptr(this%iper, 'IPER', this%input_mempath)
 
    ! -- allocate internal scalars
    allocate (this%readarraygrid)
    allocate (this%readasarrays)
    allocate (this%ts_active)
 
    ! -- initialize internal scalars
    this%readarraygrid = .false.
    this%readasarrays = .false.
    this%ts_active = .false.

bndext_da()

subroutine bndextmodule::bndext_da ( class(bndexttype)  this )

private

Parameters

this	BndExtType object

Definition at line 288 of file BoundaryPackageExt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate, mem_setptr
    ! -- dummy variables
    class(BndExtType) :: this !< BndExtType object
    !
    if (this%isadvpak /= 0) then
      !
      ! -- advanced package cleanup (MAW, SFR, LAK, UZF)
      nullify (this%featureauxvar)
      call mem_deallocate(this%auxvar, 'AUXVAR_IDM', this%memoryPath)
      nullify (this%pkg_ifno)
    else
      !
      ! -- list/array package cleanup
      call mem_deallocate(this%cellid, 'CELLID', this%memoryPath)
      call mem_deallocate(this%nodeulist, 'NODEULIST', 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)
    end if
    !
    ! -- scalars
    deallocate (this%readarraygrid)
    deallocate (this%readasarrays)
    deallocate (this%ts_active)
    nullify (this%readarraygrid)
    nullify (this%readasarrays)
    nullify (this%ts_active)
    nullify (this%iper)
    !
    ! -- deallocate
    call this%BndType%bnd_da()

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 93 of file BoundaryPackageExt.f90.

    ! -- modules
    use basedismodule, only: disbasetype
    use memorymanagermodule, only: get_isize
    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
    ! -- local
    integer(I4B) :: isize
    ! -- formats
    character(len=*), parameter :: fmtpkghdr = &
      &"(1X,/1X,a,' -- ',a,' PACKAGE, VERSION 8, 2/22/2014',&
      &' INPUT READ FROM MEMPATH: ',a)"
    !
    ! -- 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, fmtpkghdr) trim(this%filtyp), trim(adjustl(this%text)), &
      this%input_mempath
    !
    ! -- source options
    call this%source_options()
    !
    ! -- detect TS6 files; used by subclass _ad to bypass per-timestep re-dispatch
    call get_isize('TS6_FILENAME', this%input_mempath, isize)
    if (isize > 0) this%ts_active = .true.
    !
    ! -- 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
    !
    ! -- Call define_listlabel to construct the list label that is written
    !    when PRINT_INPUT option is used.
    call this%define_listlabel()

Here is the call graph for this function:

bndext_rp()

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

private

Parameters

[in,out]

this

BndExtType object

Definition at line 172 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
 
    if (.not. this%readasarrays) then
      ! -- copy nbound from input context
      call mem_set_value(this%nbound, 'NBOUND', this%input_mempath, &
                         found, release=.false.)
    end if
 
    if (this%readarraygrid) then
      call this%nodeu_to_nlist()
    else if (this%readasarrays) then
      call this%layarr_to_nlist()
    else
      call this%cellid_to_nlist()
      !
      ! -- 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
    end if

bndext_rp_log()

subroutine bndextmodule::bndext_rp_log

(

class(bndexttype), intent(inout)

this

)

Called from model control files after bnd_rp(), which ensures bound_value() dispatches to the correct derived type.

Definition at line 212 of file BoundaryPackageExt.f90.

    ! -- dummy
    class(BndExtType), intent(inout) :: this
    !
    if (this%iprpak /= 0 .and. this%isadvpak == 0) then
      call this%write_lstfile()
    end if

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 1053 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

cellid_to_nlist()

subroutine bndextmodule::cellid_to_nlist

(

class(bndexttype)

this

)

Convert period updated cellids to node numbers.

Parameters

this	BndExtType object

Definition at line 657 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

Here is the call graph for this function:

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  )

private

Parameters

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

Definition at line 829 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

Here is the call graph for this function:

default_nodelist()

subroutine bndextmodule::default_nodelist

(

class(bndexttype)

this

)

Equivalent to reading layer number array as CONSTANT 1

Definition at line 791 of file BoundaryPackageExt.f90.

    ! -- dummy
    class(BndExtType) :: this
    ! -- local
    integer(I4B) :: il, ir, ic, ncol, nrow, nlay, nodeu, noder, ipos
    !
    if (this%readasarrays) then
      !
      ! -- set variables
      if (this%dis%ndim == 3) then
        nlay = this%dis%mshape(1)
        nrow = this%dis%mshape(2)
        ncol = this%dis%mshape(3)
      elseif (this%dis%ndim == 2) then
        nlay = this%dis%mshape(1)
        nrow = 1
        ncol = this%dis%mshape(2)
      end if
      !
      ! -- Populate nodelist
      ipos = 1
      il = 1
      do ir = 1, nrow
        do ic = 1, ncol
          nodeu = get_node(il, ir, ic, nlay, nrow, ncol)
          noder = this%dis%get_nodenumber(nodeu, 0)
          this%nodelist(ipos) = noder
          ipos = ipos + 1
        end do
      end do
      !
      ! -- Assign nbound
      this%nbound = ipos - 1
    end if

Here is the call graph for this function:

layarr_to_nlist()

subroutine bndextmodule::layarr_to_nlist

(

class(bndexttype)

this

)

This is a module scoped routine to check for I<filtyp> input. If array input was provided, INI<filtyp> and I<filtyp> will be allocated in the input context. If the read state variable INI<filtyp> is set to 1 during this period update, I<filtyp> input was read and is used here to update the nodelist.

Parameters

this	BndExtType object

Definition at line 754 of file BoundaryPackageExt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_setptr
    use constantsmodule, only: lenvarname
    ! -- dummy
    class(BndExtType) :: this !< BndExtType object
    character(len=LENVARNAME) :: ilayname, inilayname
    character(len=24) :: aname = '     LAYER OR NODE INDEX'
    ! -- local
    integer(I4B), dimension(:), contiguous, &
      pointer :: ilay => null()
    integer(I4B), pointer :: inilay => null()
    !
    ! set ilay and read state variable names
    ilayname = 'I'//trim(this%filtyp)
    inilayname = 'INI'//trim(this%filtyp)
    !
    ! -- set pointer to input context read state variable
    call mem_setptr(inilay, inilayname, this%input_mempath)
    !
    ! -- check read state
    if (inilay == 1) then
      ! -- ilay variable was read this period
      !
      ! -- set pointer to input context layer index variable
      call mem_setptr(ilay, ilayname, this%input_mempath)
      !
      ! -- update nodelist
      call this%dis%nlarray_to_nodelist(ilay, this%nodelist, this%maxbound, &
                                        this%nbound, aname)
    end if

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 556 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 :: fmtreadasarrays = &
      &"(4x, 'PACKAGE INPUT WILL BE READ AS LAYER ARRAYS.')"
    character(len=*), parameter :: fmtreadarraygrid = &
      &"(4x, 'PACKAGE INPUT WILL BE READ AS GRID ARRAYS.')"
    character(len=*), parameter :: fmtflow = &
      &"(4x, 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL')"
    !
    ! -- log found options
    write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) &
      //' BASE OPTIONS'
    !
    if (this%readasarrays) then
      write (this%iout, fmtreadasarrays)
    end if
    !
    if (this%readarraygrid) then
      write (this%iout, fmtreadarraygrid)
    end if
    !
    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'

nodeu_to_nlist()

subroutine bndextmodule::nodeu_to_nlist

(

class(bndexttype)

this

)

Convert period user nodes to reduced nodes

Parameters

this	BndExtType object

Definition at line 720 of file BoundaryPackageExt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_setptr
    ! -- dummy
    class(BndExtType) :: this !< BndExtType object
    integer(I4B) :: n, noder, nodeuser, ninactive
 
    ninactive = 0
 
    ! -- Set the nodelist
    do n = 1, this%nbound
      nodeuser = this%nodeulist(n)
      noder = this%dis%get_nodenumber(nodeuser, 0)
      if (noder > 0) then
        this%nodelist(n) = noder
      else
        ninactive = ninactive + 1
      end if
    end do
 
    ! update nbound
    this%nbound = this%nbound - ninactive

report_ifno_coverage()

subroutine bndextmodule::report_ifno_coverage ( class(bndexttype), intent(inout)  this, integer(i4b), dimension(:), intent(in)  nboundchk, integer(i4b), intent(in)  nfeatures, character(len=*), intent(in)  feature_label, character(len=*), intent(in)  blockname, logical(lgp), intent(in), optional  check_missing  )

private

Set check_missing=.false. for an optional block where not every feature is expected to have a row (duplicates are still reported).

Definition at line 256 of file BoundaryPackageExt.f90.

    ! -- dummy
    class(BndExtType), intent(inout) :: this
    integer(I4B), dimension(:), intent(in) :: nboundchk
    integer(I4B), intent(in) :: nfeatures
    character(len=*), intent(in) :: feature_label
    character(len=*), intent(in) :: blockname
    logical(LGP), intent(in), optional :: check_missing
    ! -- local
    integer(I4B) :: n
    logical(LGP) :: do_check_missing
    !
    do_check_missing = .true.
    if (present(check_missing)) do_check_missing = check_missing
    !
    do n = 1, nfeatures
      if (do_check_missing .and. nboundchk(n) == 0) then
        write (errmsg, '(a,1x,a,1x,a,1x,i0,a)') &
          trim(blockname), 'no data specified for', trim(feature_label), n, '.'
        call store_error(errmsg)
      else if (nboundchk(n) > 1) then
        write (errmsg, '(a,1x,a,1x,a,1x,i0,1x,a,1x,i0,1x,a)') &
          trim(blockname), 'data for', trim(feature_label), n, &
          'specified', nboundchk(n), 'times.'
        call store_error(errmsg)
      end if
    end do

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 619 of file BoundaryPackageExt.f90.

    use memorymanagerextmodule, only: mem_set_value
    ! -- dummy variables
    class(BndExtType), intent(inout) :: this !< BndExtType object
    ! -- local variables
    type(BndExtFoundType) :: found
    !
    if (this%readasarrays) then
      this%maxbound = this%dis%get_ncpl()
    else
      ! -- 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, release=.false.)
 
      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'
    end if
    !
    ! -- 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

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 444 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
    logical(LGP) :: found_readarr
    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, &
                       release=.false.)
    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, release=.false.)
    call mem_set_value(sfacauxname, 'AUXMULTNAME', this%input_mempath, &
                       found%auxmultname)
    call mem_set_value(this%inewton, 'INEWTON', this%input_mempath, found%inewton)
    call mem_set_value(this%readarraygrid, 'READARRAYGRID', this%input_mempath, &
                       found_readarr)
    call mem_set_value(this%readasarrays, 'READASARRAYS', this%input_mempath, &
                       found_readarr)
    !
    ! -- 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, release=.false.)
      !
      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
    !
    if (this%readasarrays) then
      if (.not. this%dis%supports_layers()) then
        errmsg = 'READASARRAYS option is not compatible with selected'// &
                 ' discretization type.'
        call store_error(errmsg)
        call store_error_filename(this%input_fname)
      end if
    end if
    !
    ! -- terminate if errors were detected
    if (count_errors() > 0) then
      call store_error_filename(this%input_fname)
    end if

Here is the call graph for this function:

validate_ifno()

integer(i4b) function bndextmodule::validate_ifno ( class(bndexttype), intent(inout)  this, integer(i4b), intent(in)  ifno_val, integer(i4b), intent(in)  nfeatures, integer(i4b), dimension(:), intent(inout)  nboundchk, character(len=*), intent(in)  feature_label, character(len=*), intent(in)  blockname  )

private

Returns the validated feature index, or 0 if out of range (an error is logged; the caller should skip further processing for the row).

Definition at line 227 of file BoundaryPackageExt.f90.

    ! -- dummy
    class(BndExtType), intent(inout) :: this
    integer(I4B), intent(in) :: ifno_val
    integer(I4B), intent(in) :: nfeatures
    integer(I4B), dimension(:), intent(inout) :: nboundchk
    character(len=*), intent(in) :: feature_label
    character(len=*), intent(in) :: blockname
    ! -- return
    integer(I4B) :: idx
    !
    idx = ifno_val
    if (idx < 1 .or. idx > nfeatures) then
      write (errmsg, '(a,1x,a,1x,a,i0,a,1x,i0,a)') &
        trim(blockname), trim(feature_label), '(', idx, &
        ') must be greater than 0 and less than or equal to', nfeatures, '.'
      call store_error(errmsg)
      idx = 0
      return
    end if
    nboundchk(idx) = nboundchk(idx) + 1

Here is the call graph for this function:

write_lstfile()

subroutine bndextmodule::write_lstfile

(

class(bndexttype)

this

)

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

Parameters

this	BndExtType object

Definition at line 890 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)

Here is the call graph for this function: