gwectpmodule Module Reference

Data Types
type	gwectptype

Functions/Subroutines
subroutine, public	ctp_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, depvartype, mempath)
	Create a new constant temperature package. More...
subroutine	ctp_allocate_arrays (this, nodelist, auxvar)
	Allocate arrays specific to the constant temperature package. More...
subroutine	ctp_rp (this)
	Constant temperature read and prepare (rp) routine. More...
subroutine	ctp_ad (this)
	Constant temperature package advance routine. More...
subroutine	ctp_ck (this)
	Check constant temperature boundary condition data. More...
subroutine	ctp_fc (this, rhs, ia, idxglo, matrix_sln)
	Override bnd_fc and do nothing. More...
subroutine	ctp_cq (this, x, flowja, iadv)
	Calculate flow associated with constant temperature boundary. More...
subroutine	ctp_bd (this, model_budget)
	Add package ratin/ratout to model budget. More...
subroutine	ctp_da (this)
	Deallocate memory. More...
subroutine	define_listlabel (this)
	Define labels used in list file. More...
logical function	ctp_obs_supported (this)
	Procedure related to observation processing. More...
subroutine	ctp_df_obs (this)
	Procedure related to observation processing. More...
subroutine	ctp_rp_ts (this)
	Procedure related to time series. More...
real(dp) function	temp_mult (this, row)
	Apply auxiliary multiplier to specified temperature if. More...
real(dp) function	ctp_bound_value (this, col, row)
	@ brief Return a bound value More...

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

Function/Subroutine Documentation

ctp_ad()

subroutine gwectpmodule::ctp_ad

(

class(gwectptype)

this

)

Add package connections to matrix

Definition at line 183 of file gwe-ctp.f90.

    ! -- dummy
    class(GweCtpType) :: this
    ! -- local
    integer(I4B) :: i, node
    real(DP) :: cb
    !
    ! -- Advance the time series
    call this%TsManager%ad()
    !
    ! -- Process each entry in the constant temperature cell list
    do i = 1, this%nbound
      node = this%nodelist(i)
      cb = this%temp_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()

ctp_allocate_arrays()

subroutine gwectpmodule::ctp_allocate_arrays ( class(gwectptype)  this, integer(i4b), dimension(:), optional, pointer, contiguous  nodelist, real(dp), dimension(:, :), optional, pointer, contiguous  auxvar  )

private

Definition at line 98 of file gwe-ctp.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate, mem_setptr, mem_checkin
    ! -- dummy
    class(GweCtpType) :: 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 ratectpex
    call mem_allocate(this%ratectpin, this%maxbound, 'RATECTPIN', this%memoryPath)
    call mem_allocate(this%ratectpout, this%maxbound, 'RATECTPOUT', &
                      this%memoryPath)
    do i = 1, this%maxbound
      this%ratectpin(i) = dzero
      this%ratectpout(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)
    !

ctp_bd()

subroutine gwectpmodule::ctp_bd ( class(gwectptype)  this, type(budgettype), intent(inout)  model_budget  )

private

Definition at line 319 of file gwe-ctp.f90.

    ! -- modules
    use tdismodule, only: delt
    use budgetmodule, only: budgettype, rate_accumulator
    ! -- dummy
    class(GweCtpType) :: 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%ratectpin(1:this%nbound), ratin, dum)
    call rate_accumulator(this%ratectpout(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:

ctp_bound_value()

real(dp) function gwectpmodule::ctp_bound_value	(	class(gwectptype), 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 465 of file gwe-ctp.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy variables
    class(GweCtpType), 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%temp_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

Here is the call graph for this function:

ctp_ck()

subroutine gwectpmodule::ctp_ck ( class(gwectptype), intent(inout)  this )

private

Definition at line 210 of file gwe-ctp.f90.

    ! -- dummy
    class(GweCtpType), intent(inout) :: this
    ! -- local
    character(len=30) :: nodestr
    integer(I4B) :: i
    integer(I4B) :: node
    ! -- formats
    character(len=*), parameter :: fmtctperr = &
      &"('Specified dependent variable boundary ',i0, &
      &' temperature (',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%temp_mult(i) < dzero) then
        call this%dis%noder_to_string(node, nodestr)
        write (errmsg, fmt=fmtctperr) i, this%tspvar(i), trim(nodestr)
        call store_error(errmsg)
      end if
    end do
    !
    ! -- write summary of ctp 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:

ctp_cq()

subroutine gwectpmodule::ctp_cq ( class(gwectptype), 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 257 of file gwe-ctp.f90.

    ! -- dummy
    class(GweCtpType), 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 CTP, 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%ratectpin(i) = ratein
        this%ratectpout(i) = rateout
        flowja(idiag) = flowja(idiag) + rate
        !
      end do
      !
    end if

ctp_create()

subroutine, public gwectpmodule::ctp_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 55 of file gwe-ctp.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(GweCtpType), pointer :: ctpobj
    !
    ! -- allocate the object and assign values to object variables
    allocate (ctpobj)
    packobj => ctpobj
    !
    ! -- create name and memory path
    call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
    packobj%text = text
    !
    ! -- allocate scalars
    call ctpobj%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%iscloc = 1
    !
    ! -- Store the appropriate label based on the dependent variable
    ctpobj%depvartype = depvartype

Here is the caller graph for this function:

ctp_da()

subroutine gwectpmodule::ctp_da

(

class(gwectptype)

this

)

Method to deallocate memory for the package.

Definition at line 343 of file gwe-ctp.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(GweCtpType) :: this
    !
    ! -- Deallocate parent package
    call this%BndExtType%bnd_da()
    !
    ! -- arrays
    call mem_deallocate(this%ratectpin)
    call mem_deallocate(this%ratectpout)
    call mem_deallocate(this%tspvar, 'TSPVAR', this%memoryPath)

ctp_df_obs()

subroutine gwectpmodule::ctp_df_obs ( class(gwectptype)  this )

private

This routine:

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

Definition at line 406 of file gwe-ctp.f90.

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

Here is the call graph for this function:

ctp_fc()

subroutine gwectpmodule::ctp_fc ( class(gwectptype)  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 temperature boundary type, the call to bnd_fc needs to be overwritten to prevent logic found in bnd from being executed

Definition at line 244 of file gwe-ctp.f90.

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

ctp_obs_supported()

logical function gwectpmodule::ctp_obs_supported ( class(gwectptype)  this )

private

This routine:

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

Definition at line 391 of file gwe-ctp.f90.

    ! -- dummy
    class(GweCtpType) :: this
    !
    ctp_obs_supported = .true.

ctp_rp()

subroutine gwectpmodule::ctp_rp

(

class(gwectptype), intent(inout)

this

)

Definition at line 130 of file gwe-ctp.f90.

    ! -- modules
    use simmodule, only: store_error
    use inputoutputmodule, only: lowcase
    implicit none
    ! -- dummy
    class(GweCtpType), intent(inout) :: this
    ! -- local
    integer(I4B) :: i, node, ibd, ierr
    character(len=30) :: nodestr
    character(len=LENVARNAME) :: dvtype
    !
    ! -- Reset previous CTPs 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 temperature 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

Here is the call graph for this function:

ctp_rp_ts()

subroutine gwectpmodule::ctp_rp_ts ( class(gwectptype), intent(inout)  this )

private

Assign tsLinkText appropriately for all time series in use by package. For the constant temperature packages, the dependent variable can also be controlled by a time series.

Definition at line 424 of file gwe-ctp.f90.

    ! -- dummy
    class(GweCtpType), 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

Here is the call graph for this function:

define_listlabel()

subroutine gwectpmodule::define_listlabel

(

class(gwectptype), intent(inout)

this

)

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

Definition at line 363 of file gwe-ctp.f90.

    ! -- dummy
    class(GweCtpType), 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

temp_mult()

real(dp) function gwectpmodule::temp_mult ( class(gwectptype), intent(inout)  this, integer(i4b), intent(in)  row  )

private

Parameters

[in,out]

this

BndExtType object

Definition at line 445 of file gwe-ctp.f90.

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

Variable Documentation

ftype

character(len=lenftype) gwectpmodule::ftype = 'CTP'

private

Definition at line 21 of file gwe-ctp.f90.

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

text

character(len=lenpackagename) gwectpmodule::text = ' CTP'

private

Definition at line 22 of file gwe-ctp.f90.

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