chdmodule Module Reference

Data Types
type	chdtype

Functions/Subroutines
subroutine, public	chd_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
	Create a new constant head package.
subroutine	chd_allocate_arrays (this, nodelist, auxvar)
	Allocate arrays specific to the constant head package.
subroutine	chd_rp (this)
	Constant concentration/temperature read and prepare (rp) routine.
subroutine	chd_ad (this)
	Constant head package advance routine.
subroutine	chd_ck (this)
	Check constant concentration/temperature boundary condition data.
subroutine	chd_fc (this, rhs, ia, idxglo, matrix_sln)
	Override bnd_fc and do nothing.
subroutine	chd_cq (this, x, flowja, iadv)
	Calculate flow associated with constant head boundary.
subroutine	calc_chd_rate (this)
	Calculate the CHD cell rates, to be called.
subroutine	chd_bd (this, model_budget)
	Add package ratin/ratout to model budget.
subroutine	chd_da (this)
	Deallocate memory.
subroutine	define_listlabel (this)
	Define the list heading that is written to iout when PRINT_INPUT option is used.
logical function	chd_obs_supported (this)
	Overrides bnd_obs_supported from bndType class.
subroutine	chd_df_obs (this)
	Overrides bnd_df_obs from bndType class.
real(dp) function	head_mult (this, row)
	Apply auxiliary multiplier to specified head if appropriate.
real(dp) function	chd_bound_value (this, col, row)
	@ brief Return a bound value

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

Function/Subroutine Documentation

calc_chd_rate()

subroutine chdmodule::calc_chd_rate ( class(chdtype), intent(inout) this )

private

Definition at line 260 of file gwf-chd.f90.

    ! -- modules
    ! -- dummy
    class(ChdType), intent(inout) :: this
    ! -- 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 = this%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 chd, 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%ratechdin(i) = ratein
        this%ratechdout(i) = rateout
        this%flowja(idiag) = this%flowja(idiag) + rate
        !
      end do
      !
    end if

chd_ad()

subroutine chdmodule::chd_ad ( class(chdtype) this )

private

Add package connections to matrix

Definition at line 171 of file gwf-chd.f90.

    ! -- modules
    ! -- dummy
    class(ChdType) :: this
    ! -- local
    integer(I4B) :: i, node
    real(DP) :: hb
    ! -- formats
    !
    ! -- Process each entry in the specified-head cell list
    do i = 1, this%nbound
      node = this%nodelist(i)
      hb = this%head_mult(i)
      !
      this%xnew(node) = hb
      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()

chd_allocate_arrays()

subroutine chdmodule::chd_allocate_arrays ( class(chdtype) this, integer(i4b), dimension(:), optional, pointer, contiguous nodelist, real(dp), dimension(:, :), optional, pointer, contiguous auxvar )

private

Definition at line 93 of file gwf-chd.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate, mem_setptr, mem_checkin
    ! -- dummy
    class(ChdType) :: 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 ratechdex
    call mem_allocate(this%ratechdin, this%maxbound, 'RATECHDIN', this%memoryPath)
    call mem_allocate(this%ratechdout, this%maxbound, 'RATECHDOUT', &
                      this%memoryPath)
    do i = 1, this%maxbound
      this%ratechdin(i) = dzero
      this%ratechdout(i) = dzero
    end do
    !
    ! -- set constant head array input context pointer
    call mem_setptr(this%head, 'HEAD', this%input_mempath)
    !
    ! -- checkin constant head array input context pointer
    call mem_checkin(this%head, 'HEAD', this%memoryPath, &
                     'HEAD', this%input_mempath)

chd_bd()

subroutine chdmodule::chd_bd ( class(chdtype) this, type(budgettype), intent(inout) model_budget )

private

Definition at line 320 of file gwf-chd.f90.

    ! -- add package ratin/ratout to model budget
    use tdismodule, only: delt
    use budgetmodule, only: budgettype, rate_accumulator
    class(ChdType) :: this
    type(BudgetType), intent(inout) :: model_budget
    real(DP) :: ratin
    real(DP) :: ratout
    real(DP) :: dum
    integer(I4B) :: isuppress_output
 
    ! For CHDs at an exchange, under some conditions
    ! (XT3D), the model flowja into the cell is not
    ! finalized until after exg_cq. So we calculate
    ! the CHD rate here
    call this%calc_chd_rate()
 
    isuppress_output = 0
    call rate_accumulator(this%ratechdin(1:this%nbound), ratin, dum)
    call rate_accumulator(this%ratechdout(1:this%nbound), ratout, dum)
    call model_budget%addentry(ratin, ratout, delt, this%text, &
                               isuppress_output, this%packName)

Here is the call graph for this function:

chd_bound_value()

real(dp) function chdmodule::chd_bound_value ( class(chdtype), intent(inout) this, integer(i4b), intent(in) col, integer(i4b), intent(in) row )

private

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

Definition at line 438 of file gwf-chd.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy variables
    class(ChdType), intent(inout) :: this
    integer(I4B), intent(in) :: col
    integer(I4B), intent(in) :: row
    ! -- result
    real(DP) :: bndval
    !
    select case (col)
    case (1)
      bndval = this%head_mult(row)
    case default
      errmsg = 'Programming error. CHD bound value requested column '&
               &'outside range of ncolbnd (1).'
      call store_error(errmsg)
      call store_error_filename(this%input_fname)
    end select

Here is the call graph for this function:

chd_ck()

subroutine chdmodule::chd_ck ( class(chdtype), intent(inout) this )

private

Definition at line 197 of file gwf-chd.f90.

    ! -- modules
    ! -- dummy
    class(ChdType), intent(inout) :: this
    ! -- local
    character(len=30) :: nodestr
    integer(I4B) :: i
    integer(I4B) :: node
    real(DP) :: bt
    ! -- formats
    character(len=*), parameter :: fmtchderr = &
      "('CHD BOUNDARY ',i0,' HEAD (',g0,') IS LESS THAN CELL &
      &BOTTOM (',g0,')',' FOR CELL ',a)"
    !
    ! -- check stress period data
    do i = 1, this%nbound
      node = this%nodelist(i)
      bt = this%dis%bot(node)
      ! -- accumulate errors
      if (this%head_mult(i) < bt .and. this%icelltype(node) /= 0) then
        call this%dis%noder_to_string(node, nodestr)
        write (errmsg, fmt=fmtchderr) i, this%head_mult(i), bt, trim(nodestr)
        call store_error(errmsg)
      end if
    end do
    !
    ! write summary of chd package error messages
    if (count_errors() > 0) then
      call store_error_filename(this%input_fname)
    end if

Here is the call graph for this function:

chd_cq()

subroutine chdmodule::chd_cq ( class(chdtype), 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 248 of file gwf-chd.f90.

    class(ChdType), intent(inout) :: this
    real(DP), dimension(:), intent(in) :: x
    real(DP), dimension(:), contiguous, intent(inout) :: flowja
    integer(I4B), optional, intent(in) :: iadv
 
    ! NB: the rate calculation cannot be done until chd_bd below
 

chd_create()

subroutine, public chdmodule::chd_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=*), intent(in)	mempath )

Routine points packobj to the newly created package

Definition at line 54 of file gwf-chd.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=*), intent(in) :: mempath
    ! -- local
    type(ChdType), pointer :: chdobj
    !
    ! -- allocate the object and assign values to object variables
    allocate (chdobj)
    packobj => chdobj
    !
    ! -- create name and memory path
    call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
    packobj%text = text
    !
    ! -- allocate scalars
    call chdobj%allocate_scalars()
    !
    ! -- initialize package
    call packobj%pack_initialize()
    !
    ! -- store values
    packobj%inunit = inunit
    packobj%iout = iout
    packobj%id = id
    packobj%ibcnum = ibcnum
    packobj%ncolbnd = 1
    packobj%ictMemPath = create_mem_path(namemodel, 'NPF')

Here is the call graph for this function:

Here is the caller graph for this function:

chd_da()

subroutine chdmodule::chd_da ( class(chdtype) this )

private

Definition at line 346 of file gwf-chd.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(ChdType) :: this
    !
    ! -- Deallocate parent package
    call this%BndExtType%bnd_da()
    !
    ! -- arrays
    call mem_deallocate(this%ratechdin)
    call mem_deallocate(this%ratechdout)
    call mem_deallocate(this%head, 'HEAD', this%memoryPath)

chd_df_obs()

subroutine chdmodule::chd_df_obs ( class(chdtype) this )

private

(1) Store observation type supported by CHD package and (2) override BndTypebnd_df_obs

Definition at line 404 of file gwf-chd.f90.

    implicit none
    ! -- dummy
    class(ChdType) :: this
    ! -- local
    integer(I4B) :: indx
    !
    call this%obs%StoreObsType('chd', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => defaultobsidprocessor

Here is the call graph for this function:

chd_fc()

subroutine chdmodule::chd_fc ( class(chdtype) 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 head boundary type, the call to bnd_fc needs to be overwritten to do nothing

Definition at line 234 of file gwf-chd.f90.

    ! -- dummy
    class(ChdType) :: 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

chd_obs_supported()

logical function chdmodule::chd_obs_supported ( class(chdtype) this )

private

Return true since CHD package supports observations

Definition at line 391 of file gwf-chd.f90.

    implicit none
    !
    class(ChdType) :: this
    !
    chd_obs_supported = .true.

Here is the call graph for this function:

Here is the caller graph for this function:

chd_rp()

subroutine chdmodule::chd_rp ( class(chdtype), intent(inout) this )

private

Definition at line 125 of file gwf-chd.f90.

    !
    use tdismodule, only: kper
    ! -- dummy
    class(ChdType), intent(inout) :: this
    ! -- local
    character(len=30) :: nodestr
    integer(I4B) :: i, node, ibd, ierr
    !
    if (this%iper /= kper) return
    !
    ! -- Reset previous CHDs 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 head 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)
        write (errmsg, '(3a)') &
          'Cell is already a constant head (', trim(adjustl(nodestr)), ').'
        call store_error(errmsg)
        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

Here is the call graph for this function:

define_listlabel()

subroutine chdmodule::define_listlabel ( class(chdtype), intent(inout) this )

private

Definition at line 364 of file gwf-chd.f90.

    class(ChdType), 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), 'HEAD'
    if (this%inamedbound == 1) then
      write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
    end if

head_mult()

real(dp) function chdmodule::head_mult ( class(chdtype), intent(inout) this, integer(i4b), intent(in) row )

private

Definition at line 417 of file gwf-chd.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy variables
    class(ChdType), intent(inout) :: this
    integer(I4B), intent(in) :: row
    ! -- result
    real(DP) :: head
    !
    if (this%iauxmultcol > 0) then
      head = this%head(row) * this%auxvar(this%iauxmultcol, row)
    else
      head = this%head(row)
    end if

Variable Documentation

ftype

character(len=lenftype) chdmodule::ftype = 'CHD'

private

Definition at line 22 of file gwf-chd.f90.

text

character(len=lenpackagename) chdmodule::text = ' CHD'

private

Definition at line 23 of file gwf-chd.f90.