gwtcncmodule Module Reference

Data Types
type	gwtcnctype

Functions/Subroutines
subroutine, public	cnc_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, depvartype, mempath)
	Create a new constant concentration or temperature package. More...
subroutine	cnc_allocate_arrays (this, nodelist, auxvar)
	Allocate arrays specific to the constant concentration/tempeature package. More...
subroutine	cnc_rp (this)
	Constant concentration/temperature read and prepare (rp) routine. More...
subroutine	cnc_ad (this)
	Constant concentration/temperature package advance routine. More...
subroutine	cnc_ck (this)
	Check constant concentration/temperature boundary condition data. More...
subroutine	cnc_fc (this, rhs, ia, idxglo, matrix_sln)
	Override bnd_fc and do nothing. More...
subroutine	cnc_cq (this, x, flowja, iadv)
	Calculate flow associated with constant concentration/temperature boundary. More...
subroutine	cnc_bd (this, model_budget)
	Add package ratin/ratout to model budget. More...
subroutine	cnc_da (this)
	Deallocate memory. More...
subroutine	define_listlabel (this)
	Define labels used in list file. More...
logical function	cnc_obs_supported (this)
	Procedure related to observation processing. More...
subroutine	cnc_df_obs (this)
	Procedure related to observation processing. More...
subroutine	cnc_rp_ts (this)
	Procedure related to time series. More...
real(dp) function	conc_mult (this, row)
	Apply auxiliary multiplier to specified concentration if. More...
real(dp) function	cnc_bound_value (this, col, row)
	@ brief Return a bound value More...

Variables
character(len=lenftype)	ftype = 'CNC'
character(len=lenpackagename)	text = ' CNC'

Function/Subroutine Documentation

cnc_ad()

subroutine gwtcncmodule::cnc_ad

(

class(gwtcnctype)

this

)

Add package connections to matrix

Definition at line 192 of file gwt-cnc.f90.

    ! -- modules
    ! -- dummy
    class(GwtCncType) :: this
    ! -- local
    integer(I4B) :: i, node
    real(DP) :: cb
    ! -- formats
    !
    ! -- Advance the time series
    call this%TsManager%ad()
    !
    ! -- Process each entry in the constant concentration cell list
    do i = 1, this%nbound
      node = this%nodelist(i)
      cb = this%conc_mult(i)
      !
      this%xnew(node) = cb
      this%xold(node) = this%xnew(node)
    end do
    !
    ! -- For each observation, push simulated value and corresponding
    !    simulation time from "current" to "preceding" and reset
    !    "current" value.
    call this%obs%obs_ad()
    !
    ! -- Return
    return

cnc_allocate_arrays()

subroutine gwtcncmodule::cnc_allocate_arrays ( class(gwtcnctype)  this, integer(i4b), dimension(:), optional, pointer, contiguous  nodelist, real(dp), dimension(:, :), optional, pointer, contiguous  auxvar  )

private

Definition at line 101 of file gwt-cnc.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate, mem_setptr, mem_checkin
    ! -- dummy
    class(GwtCncType) :: this
    integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist
    real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar
    ! -- local
    integer(I4B) :: i
    !
    ! -- call standard BndType allocate scalars
    call this%BndExtType%allocate_arrays(nodelist, auxvar)
    !
    ! -- allocate ratecncex
    call mem_allocate(this%ratecncin, this%maxbound, 'RATECNCIN', this%memoryPath)
    call mem_allocate(this%ratecncout, this%maxbound, 'RATECNCOUT', &
                      this%memoryPath)
    do i = 1, this%maxbound
      this%ratecncin(i) = dzero
      this%ratecncout(i) = dzero
    end do
    ! -- set constant head array input context pointer
    call mem_setptr(this%tspvar, 'TSPVAR', this%input_mempath)
    !
    ! -- checkin constant head array input context pointer
    call mem_checkin(this%tspvar, 'TSPVAR', this%memoryPath, &
                     'TSPVAR', this%input_mempath)
    !
    !
    ! -- Return
    return

cnc_bd()

subroutine gwtcncmodule::cnc_bd ( class(gwtcnctype)  this, type(budgettype), intent(inout)  model_budget  )

private

Definition at line 346 of file gwt-cnc.f90.

    ! -- modules
    use tdismodule, only: delt
    use budgetmodule, only: budgettype, rate_accumulator
    ! -- dummy
    class(GwtCncType) :: this
    ! -- local
    type(BudgetType), intent(inout) :: model_budget
    real(DP) :: ratin
    real(DP) :: ratout
    real(DP) :: dum
    integer(I4B) :: isuppress_output
    !
    isuppress_output = 0
    call rate_accumulator(this%ratecncin(1:this%nbound), ratin, dum)
    call rate_accumulator(this%ratecncout(1:this%nbound), ratout, dum)
    call model_budget%addentry(ratin, ratout, delt, this%text, &
                               isuppress_output, this%packName)
    !
    ! -- Return
    return

Here is the call graph for this function:

cnc_bound_value()

real(dp) function gwtcncmodule::cnc_bound_value	(	class(gwtcnctype), intent(inout)	this,
		integer(i4b), intent(in)	col,
		integer(i4b), intent(in)	row
	)

Return a bound value associated with an ncolbnd index and row.

Parameters

[in,out]

this

BndExtType object

Definition at line 514 of file gwt-cnc.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy variables
    class(GwtCncType), intent(inout) :: this !< BndExtType object
    integer(I4B), intent(in) :: col
    integer(I4B), intent(in) :: row
    ! -- result
    real(DP) :: bndval
    !
    select case (col)
    case (1)
      bndval = this%conc_mult(row)
    case default
      write (errmsg, '(3a)') 'Programming error. ', &
               & adjustl(trim(this%filtyp)), ' bound value requested column '&
               &'outside range of ncolbnd (1).'
      call store_error(errmsg)
      call store_error_filename(this%input_fname)
    end select
    !
    ! -- Return
    return

Here is the call graph for this function:

cnc_ck()

subroutine gwtcncmodule::cnc_ck ( class(gwtcnctype), intent(inout)  this )

private

Definition at line 224 of file gwt-cnc.f90.

    ! -- modules
    ! -- dummy
    class(GwtCncType), intent(inout) :: this
    ! -- local
    character(len=30) :: nodestr
    integer(I4B) :: i
    integer(I4B) :: node
    ! -- formats
    character(len=*), parameter :: fmtcncerr = &
      &"('Specified dependent variable boundary ',i0, &
      &' conc (',g0,') is less than zero for cell', a)"
    !
    ! -- check stress period data
    do i = 1, this%nbound
      node = this%nodelist(i)
      ! -- accumulate errors
      if (this%conc_mult(i) < dzero) then
        call this%dis%noder_to_string(node, nodestr)
        write (errmsg, fmt=fmtcncerr) i, this%tspvar(i), trim(nodestr)
        call store_error(errmsg)
      end if
    end do
    !
    ! -- write summary of cnc package error messages
    if (count_errors() > 0) then
      call store_error_filename(this%input_fname)
    end if
    !
    ! -- Return
    return

Here is the call graph for this function:

cnc_cq()

subroutine gwtcncmodule::cnc_cq ( class(gwtcnctype), intent(inout)  this, real(dp), dimension(:), intent(in)  x, real(dp), dimension(:), intent(inout), contiguous  flowja, integer(i4b), intent(in), optional  iadv  )

private

This method overrides bnd_cq()

Definition at line 280 of file gwt-cnc.f90.

    ! -- modules
    ! -- dummy
    class(GwtCncType), intent(inout) :: this
    real(DP), dimension(:), intent(in) :: x
    real(DP), dimension(:), contiguous, intent(inout) :: flowja
    integer(I4B), optional, intent(in) :: iadv
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: ipos
    integer(I4B) :: node
    integer(I4B) :: n2
    integer(I4B) :: idiag
    real(DP) :: rate
    real(DP) :: ratein, rateout
    real(DP) :: q
    !
    ! -- If no boundaries, skip flow calculations.
    if (this%nbound > 0) then
      !
      ! -- Loop through each boundary calculating flow.
      do i = 1, this%nbound
        node = this%nodelist(i)
        idiag = this%dis%con%ia(node)
        rate = dzero
        ratein = dzero
        rateout = dzero
        !
        ! -- Calculate the flow rate into the cell.
        do ipos = this%dis%con%ia(node) + 1, &
          this%dis%con%ia(node + 1) - 1
          q = flowja(ipos)
          rate = rate - q
          ! -- only accumulate chin and chout for active
          !    connected cells
          n2 = this%dis%con%ja(ipos)
          if (this%ibound(n2) > 0) then
            if (q < dzero) then
              ratein = ratein - q
            else
              rateout = rateout + q
            end if
          end if
        end do
        !
        ! -- For CNC, store total flow in rhs so it is available for other
        !    calculations
        this%rhs(i) = -rate
        this%hcof(i) = dzero
        !
        ! -- Save simulated value to simvals array.
        this%simvals(i) = rate
        this%ratecncin(i) = ratein
        this%ratecncout(i) = rateout
        flowja(idiag) = flowja(idiag) + rate
        !
      end do
      !
    end if
    !
    ! -- Return
    return

cnc_create()

subroutine, public gwtcncmodule::cnc_create	(	class(bndtype), pointer	packobj,
		integer(i4b), intent(in)	id,
		integer(i4b), intent(in)	ibcnum,
		integer(i4b), intent(in)	inunit,
		integer(i4b), intent(in)	iout,
		character(len=*), intent(in)	namemodel,
		character(len=*), intent(in)	pakname,
		character(len=lenvarname), intent(in)	depvartype,
		character(len=*), intent(in)	mempath
	)

Routine points packobj to the newly created package

Definition at line 56 of file gwt-cnc.f90.

    ! -- dummy
    class(BndType), pointer :: packobj
    integer(I4B), intent(in) :: id
    integer(I4B), intent(in) :: ibcnum
    integer(I4B), intent(in) :: inunit
    integer(I4B), intent(in) :: iout
    character(len=*), intent(in) :: namemodel
    character(len=*), intent(in) :: pakname
    character(len=LENVARNAME), intent(in) :: depvartype
    character(len=*), intent(in) :: mempath
    ! -- local
    type(GwtCncType), pointer :: cncobj
    !
    ! -- allocate the object and assign values to object variables
    allocate (cncobj)
    packobj => cncobj
    !
    ! -- create name and memory path
    call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
    packobj%text = text
    !
    ! -- allocate scalars
    call cncobj%allocate_scalars()
    !
    ! -- initialize package
    call packobj%pack_initialize()
    !
    ! -- store values
    packobj%inunit = inunit
    packobj%iout = iout
    packobj%id = id
    packobj%ibcnum = ibcnum
    !
    ! -- Store the appropriate label based on the dependent variable
    cncobj%depvartype = depvartype
    !
    ! -- Return
    return

Here is the caller graph for this function:

cnc_da()

subroutine gwtcncmodule::cnc_da

(

class(gwtcnctype)

this

)

Method to deallocate memory for the package.

Definition at line 373 of file gwt-cnc.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(GwtCncType) :: this
    !
    ! -- Deallocate parent package
    call this%BndExtType%bnd_da()
    !
    ! -- arrays
    call mem_deallocate(this%ratecncin)
    call mem_deallocate(this%ratecncout)
    call mem_deallocate(this%tspvar, 'TSPVAR', this%memoryPath)
    !
    ! -- Return
    return

cnc_df_obs()

subroutine gwtcncmodule::cnc_df_obs ( class(gwtcnctype)  this )

private

This routine:

• defines observations
• stores observation types supported by either of the SDV packages (CNC or CNT),
• overrides BndExtTypebnd_df_obs

Definition at line 445 of file gwt-cnc.f90.

    ! -- dummy
    class(GwtCncType) :: this
    ! -- local
    integer(I4B) :: indx
    !
    call this%obs%StoreObsType(this%filtyp, .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => defaultobsidprocessor
    !
    ! -- Return
    return

Here is the call graph for this function:

cnc_fc()

subroutine gwtcncmodule::cnc_fc ( class(gwtcnctype)  this, real(dp), dimension(:), intent(inout)  rhs, integer(i4b), dimension(:), intent(in)  ia, integer(i4b), dimension(:), intent(in)  idxglo, class(matrixbasetype), pointer  matrix_sln  )

private

For constant concentration/temperature boundary type, the call to bnd_fc needs to be overwritten to prevent logic found in bnd from being executed

Definition at line 262 of file gwt-cnc.f90.

    ! -- dummy
    class(GwtCncType) :: this
    real(DP), dimension(:), intent(inout) :: rhs
    integer(I4B), dimension(:), intent(in) :: ia
    integer(I4B), dimension(:), intent(in) :: idxglo
    class(MatrixBaseType), pointer :: matrix_sln
    ! -- local
    !
    ! -- Return
    return

cnc_obs_supported()

logical function gwtcncmodule::cnc_obs_supported ( class(gwtcnctype)  this )

private

This routine:

• returns true because the SDV package supports observations,
• overrides packagetype_obs_supported()

Definition at line 427 of file gwt-cnc.f90.

    ! -- dummy
    class(GwtCncType) :: this
    !
    cnc_obs_supported = .true.
    !
    ! -- Return
    return

cnc_rp()

subroutine gwtcncmodule::cnc_rp

(

class(gwtcnctype), intent(inout)

this

)

Definition at line 136 of file gwt-cnc.f90.

    ! -- modules
    use simmodule, only: store_error
    use inputoutputmodule, only: lowcase
    implicit none
    ! -- dummy
    class(GwtCncType), intent(inout) :: this
    ! -- local
    integer(I4B) :: i, node, ibd, ierr
    character(len=30) :: nodestr
    character(len=LENVARNAME) :: dvtype
    !
    ! -- Reset previous CNCs to active cell
    do i = 1, this%nbound
      node = this%nodelist(i)
      this%ibound(node) = this%ibcnum
    end do
    !
    ! -- Call the parent class read and prepare
    call this%BndExtType%bnd_rp()
    !
    ! -- Set ibound to -(ibcnum + 1) for constant concentration cells
    ierr = 0
    do i = 1, this%nbound
      node = this%nodelist(i)
      ibd = this%ibound(node)
      if (ibd < 0) then
        call this%dis%noder_to_string(node, nodestr)
        dvtype = trim(this%depvartype)
        call lowcase(dvtype)
        call store_error('Cell is already a constant ' &
                         //dvtype//': '//trim(adjustl(nodestr)))
        ierr = ierr + 1
      else
        this%ibound(node) = -this%ibcnum
      end if
    end do
    !
    ! -- Stop if errors detected
    if (ierr > 0) then
      call store_error_filename(this%input_fname)
    end if
    !
    ! -- Write the list to iout if requested
    if (this%iprpak /= 0) then
      call this%write_list()
    end if
    !
    ! -- Return
    return

Here is the call graph for this function:

cnc_rp_ts()

subroutine gwtcncmodule::cnc_rp_ts ( class(gwtcnctype), intent(inout)  this )

private

Assign tsLinkText appropriately for all time series in use by package. For any specified dependent variable package, for example either the constant concentration or constant temperature packages, the dependent variable can be controlled by time series.

Definition at line 467 of file gwt-cnc.f90.

    ! -- dummy
    class(GwtCncType), intent(inout) :: this
    ! -- local
    integer(I4B) :: i, nlinks
    type(TimeSeriesLinkType), pointer :: tslink => null()
    !
    nlinks = this%TsManager%boundtslinks%Count()
    do i = 1, nlinks
      tslink => gettimeserieslinkfromlist(this%TsManager%boundtslinks, i)
      if (associated(tslink)) then
        select case (tslink%JCol)
        case (1)
          tslink%Text = trim(this%depvartype)
        end select
      end if
    end do
    !
    ! -- Return
    return

Here is the call graph for this function:

conc_mult()

real(dp) function gwtcncmodule::conc_mult ( class(gwtcnctype), intent(inout)  this, integer(i4b), intent(in)  row  )

private

Parameters

[in,out]

this

BndExtType object

Definition at line 491 of file gwt-cnc.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy variables
    class(GwtCncType), intent(inout) :: this !< BndExtType object
    integer(I4B), intent(in) :: row
    ! -- result
    real(DP) :: conc
    !
    if (this%iauxmultcol > 0) then
      conc = this%tspvar(row) * this%auxvar(this%iauxmultcol, row)
    else
      conc = this%tspvar(row)
    end if
    !
    ! -- Return
    return

define_listlabel()

subroutine gwtcncmodule::define_listlabel

(

class(gwtcnctype), intent(inout)

this

)

Define the list heading that is written to iout when PRINT_INPUT option is used.

Definition at line 396 of file gwt-cnc.f90.

    ! -- dummy
    class(GwtCncType), intent(inout) :: this
    !
    ! -- create the header list label
    this%listlabel = trim(this%filtyp)//' NO.'
    if (this%dis%ndim == 3) then
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER'
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'ROW'
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'COL'
    elseif (this%dis%ndim == 2) then
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER'
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'CELL2D'
    else
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'NODE'
    end if
    write (this%listlabel, '(a, a16)') trim(this%listlabel), &
      trim(this%depvartype)
    if (this%inamedbound == 1) then
      write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
    end if
    !
    ! -- Return
    return

Variable Documentation

ftype

character(len=lenftype) gwtcncmodule::ftype = 'CNC'

private

Definition at line 22 of file gwt-cnc.f90.

  character(len=LENFTYPE) :: ftype = 'CNC'

text

character(len=lenpackagename) gwtcncmodule::text = ' CNC'

private

Definition at line 23 of file gwt-cnc.f90.

  character(len=LENPACKAGENAME) :: text = '             CNC'