tspaptmodule Module Reference

Data Types
type	tspapttype

Functions/Subroutines
subroutine	apt_ac (this, moffset, sparse)
	Add package connection to matrix. More...
subroutine	apt_mc (this, moffset, matrix_sln)
	Advanced package transport map package connections to matrix. More...
subroutine	apt_ar (this)
	Advanced package transport allocate and read (ar) routine. More...
subroutine	apt_rp (this)
	Advanced package transport read and prepare (rp) routine. More...
subroutine	apt_ad_chk (this)
integer(i4b) function	apt_check_valid (this, itemno)
	Advanced package transport routine. More...
real(dp) function, dimension(:), pointer, contiguous	get_mvr_depvar (this)
	Advanced package transport utility function. More...
subroutine	apt_ad (this)
	Advanced package transport routine. More...
subroutine	apt_ad_resync (this)
	Per-timestep TS re-sync and state update. More...
subroutine	apt_ad_ts (this)
	Virtual hook: called every timestep, after the time series manager advances, before apt_ad_chk. No-op extension point for packages to override. More...
real(dp) function	apt_setting_value (this, itemno, key)
	Virtual hook: value for a package-specific PERIOD setting. Override in individual packages to supply the already-resolved value for a PERIOD field beyond STATUS, CONCENTRATION/TEMPERATURE, and AUXILIARY, so the shared apt_rp table echo can print it. More...
subroutine	apt_reset (this)
	Override bnd reset for custom mover logic. More...
subroutine	apt_fc (this, rhs, ia, idxglo, matrix_sln)
subroutine	apt_fc_nonexpanded (this, rhs, ia, idxglo, matrix_sln)
	Advanced package transport fill coefficient (fc) method. More...
subroutine	apt_fc_expanded (this, rhs, ia, idxglo, matrix_sln)
	Advanced package transport fill coefficient (fc) method. More...
subroutine	pak_fc_expanded (this, rhs, ia, idxglo, matrix_sln)
	Advanced package transport fill coefficient (fc) method. More...
subroutine	apt_cfupdate (this)
	Advanced package transport routine. More...
subroutine	apt_cq (this, x, flowja, iadv)
	Advanced package transport calculate flows (cq) routine. More...
subroutine	apt_ot_package_flows (this, icbcfl, ibudfl)
	Save advanced package flows routine. More...
subroutine	apt_ot_dv (this, idvsave, idvprint)
subroutine	apt_ot_bdsummary (this, kstp, kper, iout, ibudfl)
	Print advanced package transport dependent variables. More...
subroutine	allocate_scalars (this)
	@ brief Allocate scalars More...
subroutine	apt_allocate_index_arrays (this)
	@ brief Allocate index arrays More...
subroutine	apt_allocate_arrays (this)
	@ brief Allocate arrays More...
subroutine	apt_da (this)
	@ brief Deallocate memory More...
subroutine	find_apt_package (this)
	Find corresponding advanced package transport package. More...
subroutine	apt_source_options (this)
	Source OPTIONS block from the input context. More...
subroutine	apt_source_dimensions (this)
	Source DIMENSIONS from the flow package; allocate package arrays. More...
subroutine	apt_source_cvs (this)
	Source PACKAGEDATA feature information from the input context. More...
subroutine	apt_read_initial_attr (this)
	Read the initial parameters for an advanced package. More...
subroutine	apt_solve (this)
	Add terms specific to advanced package transport to the explicit solve. More...
subroutine	pak_solve (this)
	Add terms specific to advanced package transport features to the explicit solve routine. More...
subroutine	apt_accumulate_ccterm (this, ilak, rrate, ccratin, ccratout)
	Accumulate constant concentration (or temperature) terms for budget. More...
subroutine	define_listlabel (this)
	Define the list heading that is written to iout when PRINT_INPUT option is used. More...
subroutine	apt_set_pointers (this, neq, ibound, xnew, xold, flowja)
	Set pointers to model arrays and variables so that a package has access to these items. More...
subroutine	apt_get_volumes (this, icv, vnew, vold, delt)
	Return the feature new volume and old volume. More...
integer(i4b) function	pak_get_nbudterms (this)
	Function to return the number of budget terms just for this package. More...
subroutine	apt_setup_budobj (this)
	Set up the budget object that stores advanced package flow terms. More...
subroutine	pak_setup_budobj (this, idx)
	Set up a budget object that stores an advanced package flows. More...
subroutine	apt_fill_budobj (this, x, flowja)
	Copy flow terms into thisbudobj. More...
subroutine	pak_fill_budobj (this, idx, x, flowja, ccratin, ccratout)
	Copy flow terms into thisbudobj, must be overridden. More...
subroutine	apt_stor_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
	Account for mass or energy storage in advanced package features. More...
subroutine	apt_tmvr_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
	Account for mass or energy transferred to the MVR package. More...
subroutine	apt_fmvr_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
	Account for mass or energy transferred to this package from the MVR package. More...
subroutine	apt_fjf_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
	Go through each "within apt-apt" connection (e.g., lkt-lkt, or sft-sft) and accumulate total mass (or energy) in dbuff mass. More...
subroutine	apt_copy2flowp (this)
	Copy concentrations (or temperatures) into flow package aux variable. More...
logical function	apt_obs_supported (this)
	Determine whether an obs type is supported. More...
subroutine	apt_df_obs (this)
	Define observation type. More...
subroutine	pak_df_obs (this)
	Define apt observation type. More...
subroutine	pak_rp_obs (this, obsrv, found)
	Process package specific obs. More...
subroutine	rp_obs_byfeature (this, obsrv)
	Prepare observation. More...
subroutine	rp_obs_budterm (this, obsrv, budterm)
	Prepare observation. More...
subroutine	rp_obs_flowjaface (this, obsrv, budterm)
	Prepare observation. More...
subroutine	apt_rp_obs (this)
	Read and prepare apt-related observations. More...
subroutine	apt_bd_obs (this)
	Calculate observation values. More...
subroutine	pak_bd_obs (this, obstypeid, jj, v, found)
	Check if observation exists in an advanced package. More...
subroutine, public	apt_process_obsid (obsrv, dis, inunitobs, iout)
	Process observation IDs for an advanced package. More...
subroutine, public	apt_process_obsid12 (obsrv, dis, inunitobs, iout)
	Process observation IDs for a package. More...
subroutine	apt_setup_tableobj (this)
	Setup a table object an advanced package. More...

Variables
character(len=lenftype)	ftype = 'APT'
character(len=lenvarname)	text = ' APT'

Function/Subroutine Documentation

allocate_scalars()

subroutine tspaptmodule::allocate_scalars

(

class(tspapttype)

this

)

Allocate scalar variables for an advanced package

Definition at line 1012 of file tsp-apt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    !
    ! -- allocate scalars in BndExtType
    call this%BndExtType%allocate_scalars()
    !
    ! -- Allocate
    call mem_allocate(this%iauxfpconc, 'IAUXFPCONC', this%memoryPath)
    call mem_allocate(this%imatrows, 'IMATROWS', this%memoryPath)
    call mem_allocate(this%iprconc, 'IPRCONC', this%memoryPath)
    call mem_allocate(this%iconcout, 'ICONCOUT', this%memoryPath)
    call mem_allocate(this%ibudgetout, 'IBUDGETOUT', this%memoryPath)
    call mem_allocate(this%ibudcsv, 'IBUDCSV', this%memoryPath)
    call mem_allocate(this%igwfaptpak, 'IGWFAPTPAK', this%memoryPath)
    call mem_allocate(this%ncv, 'NCV', this%memoryPath)
    call mem_allocate(this%idxbudfjf, 'IDXBUDFJF', this%memoryPath)
    call mem_allocate(this%idxbudgwf, 'IDXBUDGWF', this%memoryPath)
    call mem_allocate(this%idxbudsto, 'IDXBUDSTO', this%memoryPath)
    call mem_allocate(this%idxbudtmvr, 'IDXBUDTMVR', this%memoryPath)
    call mem_allocate(this%idxbudfmvr, 'IDXBUDFMVR', this%memoryPath)
    call mem_allocate(this%idxbudaux, 'IDXBUDAUX', this%memoryPath)
    call mem_allocate(this%nconcbudssm, 'NCONCBUDSSM', this%memoryPath)
    call mem_allocate(this%idxprepak, 'IDXPREPAK', this%memoryPath)
    call mem_allocate(this%idxlastpak, 'IDXLASTPAK', this%memoryPath)
    !
    ! -- Initialize
    this%iauxfpconc = 0
    this%imatrows = 1
    this%iprconc = 0
    this%iconcout = 0
    this%ibudgetout = 0
    this%ibudcsv = 0
    this%igwfaptpak = 0
    this%ncv = 0
    this%idxbudfjf = 0
    this%idxbudgwf = 0
    this%idxbudsto = 0
    this%idxbudtmvr = 0
    this%idxbudfmvr = 0
    this%idxbudaux = 0
    this%nconcbudssm = 0
    this%idxprepak = 0
    this%idxlastpak = 0
    !
    ! -- set this package as causing asymmetric matrix terms
    this%iasym = 1

apt_ac()

subroutine tspaptmodule::apt_ac	(	class(tspapttype), intent(inout)	this,
		integer(i4b), intent(in)	moffset,
		type(sparsematrix), intent(inout)	sparse
	)

Definition at line 200 of file tsp-apt.f90.

    use memorymanagermodule, only: mem_setptr
    use sparsemodule, only: sparsematrix
    ! -- dummy
    class(TspAptType), intent(inout) :: this
    integer(I4B), intent(in) :: moffset
    type(sparsematrix), intent(inout) :: sparse
    ! -- local
    integer(I4B) :: i, n
    integer(I4B) :: jj, jglo
    integer(I4B) :: nglo
    ! -- format
    !
    ! -- Add package rows to sparse
    if (this%imatrows /= 0) then
      !
      ! -- diagonal
      do n = 1, this%ncv
        nglo = moffset + this%dis%nodes + this%ioffset + n
        call sparse%addconnection(nglo, nglo, 1)
      end do
      !
      ! -- apt-gwf connections
      do i = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
        n = this%flowbudptr%budterm(this%idxbudgwf)%id1(i)
        jj = this%flowbudptr%budterm(this%idxbudgwf)%id2(i)
        nglo = moffset + this%dis%nodes + this%ioffset + n
        jglo = jj + moffset
        call sparse%addconnection(nglo, jglo, 1)
        call sparse%addconnection(jglo, nglo, 1)
      end do
      !
      ! -- apt-apt connections
      if (this%idxbudfjf /= 0) then
        do i = 1, this%flowbudptr%budterm(this%idxbudfjf)%maxlist
          n = this%flowbudptr%budterm(this%idxbudfjf)%id1(i)
          jj = this%flowbudptr%budterm(this%idxbudfjf)%id2(i)
          nglo = moffset + this%dis%nodes + this%ioffset + n
          jglo = moffset + this%dis%nodes + this%ioffset + jj
          call sparse%addconnection(nglo, jglo, 1)
        end do
      end if
    end if

apt_accumulate_ccterm()

subroutine tspaptmodule::apt_accumulate_ccterm	(	class(tspapttype)	this,
		integer(i4b), intent(in)	ilak,
		real(dp), intent(in)	rrate,
		real(dp), intent(inout)	ccratin,
		real(dp), intent(inout)	ccratout
	)

Definition at line 1637 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType) :: this
    integer(I4B), intent(in) :: ilak
    real(DP), intent(in) :: rrate
    real(DP), intent(inout) :: ccratin
    real(DP), intent(inout) :: ccratout
    ! -- locals
    real(DP) :: q
    ! format
    ! code
    !
    if (this%iboundpak(ilak) < 0) then
      q = -rrate
      this%ccterm(ilak) = this%ccterm(ilak) + q
      !
      ! -- See if flow is into lake or out of lake.
      if (q < dzero) then
        !
        ! -- Flow is out of lake subtract rate from ratout.
        ccratout = ccratout - q
      else
        !
        ! -- Flow is into lake; add rate to ratin.
        ccratin = ccratin + q
      end if
    end if

apt_ad()

subroutine tspaptmodule::apt_ad

(

class(tspapttype)

this

)

Add package connections to matrix

Definition at line 565 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType) :: this
    !
    ! -- sync PACKAGEDATA AUX TS and advance observations
    call this%BndExtType%bnd_ad()
    !
    call this%apt_ad_resync()

apt_ad_chk()

subroutine tspaptmodule::apt_ad_chk

(

class(tspapttype), intent(inout)

this

)

Definition at line 522 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType), intent(inout) :: this
    ! function available for override by packages

apt_ad_resync()

subroutine tspaptmodule::apt_ad_resync

(

class(tspapttype)

this

)

Called directly by packages that override bnd_ad (e.g. SFT/SFE) so apt_ad_ts/apt_ad_chk still dispatch to their own overrides.

Definition at line 580 of file tsp-apt.f90.

    ! -- modules
    use simvariablesmodule, only: ifailedstepretry
    use tdismodule, only: kstp
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    integer(I4B) :: n
    integer(I4B) :: j, iaux
    !
    ! -- re-sync period TS; package-specific fields via apt_ad_ts
    if (this%ts_active) then
      call this%apt_ad_ts()
    end if
    !
    ! -- update auxiliary variables by copying from featureauxvar into
    !    bndpackage auxvar for GWF budget file output; featureauxvar can
    !    only have changed at period start (kstp==1) or, when TS-active,
    !    this timestep's apt_ad_ts() call above
    if (this%naux > 0 .and. (kstp == 1 .or. this%ts_active)) then
      do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
        n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
        do iaux = 1, this%naux
          this%auxvar(iaux, j) = this%featureauxvar(iaux, n)
        end do
      end do
    end if
    !
    ! -- copy xnew into xold and set xnewpak to specified concentration (or
    !    temperature) for constant concentration/temperature features
    if (ifailedstepretry == 0) then
      do n = 1, this%ncv
        this%xoldpak(n) = this%xnewpak(n)
        if (this%iboundpak(n) < 0) then
          this%xnewpak(n) = this%concfeat(n)
        end if
      end do
    else
      do n = 1, this%ncv
        this%xnewpak(n) = this%xoldpak(n)
        if (this%iboundpak(n) < 0) then
          this%xnewpak(n) = this%concfeat(n)
        end if
      end do
    end if
    !
    ! -- run package-specific checks
    call this%apt_ad_chk()

apt_ad_ts()

subroutine tspaptmodule::apt_ad_ts

(

class(tspapttype), intent(inout)

this

)

Definition at line 634 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType), intent(inout) :: this

apt_allocate_arrays()

subroutine tspaptmodule::apt_allocate_arrays

(

class(tspapttype), intent(inout)

this

)

Allocate advanced package transport arrays

Definition at line 1125 of file tsp-apt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate, mem_setptr
    ! -- dummy
    class(TspAptType), intent(inout) :: this
    ! -- local
    integer(I4B) :: n
    !
    ! -- call standard BndExtType allocate arrays
    call this%BndExtType%allocate_arrays()
    !
    ! -- Allocate
    !
    ! -- allocate and initialize dbuff
    if (this%iconcout > 0) then
      call mem_allocate(this%dbuff, this%ncv, 'DBUFF', this%memoryPath)
      do n = 1, this%ncv
        this%dbuff(n) = dzero
      end do
    else
      call mem_allocate(this%dbuff, 0, 'DBUFF', this%memoryPath)
    end if
    !
    ! -- allocate character array for status
    allocate (this%status(this%ncv))
    !
    ! -- alias into the input context's permanent, feature-indexed
    ! CONCENTRATION/TEMPERATURE array (allocated and DZERO-initialized by
    ! the input context)
    call mem_setptr(this%concfeat, trim(this%depvartype), this%input_mempath)
    !
    ! -- budget terms
    call mem_allocate(this%qsto, this%ncv, 'QSTO', this%memoryPath)
    call mem_allocate(this%ccterm, this%ncv, 'CCTERM', this%memoryPath)
    !
    ! -- concentration for budget terms
    call mem_allocate(this%concbudssm, this%nconcbudssm, this%ncv, &
                      'CONCBUDSSM', this%memoryPath)
    !
    ! -- mass (or energy) added from the mover transport package
    call mem_allocate(this%qmfrommvr, this%ncv, 'QMFROMMVR', this%memoryPath)
    !
    ! -- initialize arrays
    do n = 1, this%ncv
      this%status(n) = 'ACTIVE'
      this%qsto(n) = dzero
      this%ccterm(n) = dzero
      this%qmfrommvr(n) = dzero
      this%concbudssm(:, n) = dzero
    end do

apt_allocate_index_arrays()

subroutine tspaptmodule::apt_allocate_index_arrays

(

class(tspapttype), intent(inout)

this

)

Allocate arrays that map to locations in the numerical solution

Definition at line 1068 of file tsp-apt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(TspAptType), intent(inout) :: this
    ! -- local
    integer(I4B) :: n
    !
    if (this%imatrows /= 0) then
      !
      ! -- count number of flow-ja-face connections
      n = 0
      if (this%idxbudfjf /= 0) then
        n = this%flowbudptr%budterm(this%idxbudfjf)%maxlist
      end if
      !
      ! -- allocate pointers to global matrix
      call mem_allocate(this%idxlocnode, this%ncv, 'IDXLOCNODE', &
                        this%memoryPath)
      call mem_allocate(this%idxpakdiag, this%ncv, 'IDXPAKDIAG', &
                        this%memoryPath)
      call mem_allocate(this%idxdglo, this%maxbound, 'IDXGLO', &
                        this%memoryPath)
      call mem_allocate(this%idxoffdglo, this%maxbound, 'IDXOFFDGLO', &
                        this%memoryPath)
      call mem_allocate(this%idxsymdglo, this%maxbound, 'IDXSYMDGLO', &
                        this%memoryPath)
      call mem_allocate(this%idxsymoffdglo, this%maxbound, 'IDXSYMOFFDGLO', &
                        this%memoryPath)
      call mem_allocate(this%idxfjfdglo, n, 'IDXFJFDGLO', &
                        this%memoryPath)
      call mem_allocate(this%idxfjfoffdglo, n, 'IDXFJFOFFDGLO', &
                        this%memoryPath)
    else
      call mem_allocate(this%idxlocnode, 0, 'IDXLOCNODE', &
                        this%memoryPath)
      call mem_allocate(this%idxpakdiag, 0, 'IDXPAKDIAG', &
                        this%memoryPath)
      call mem_allocate(this%idxdglo, 0, 'IDXGLO', &
                        this%memoryPath)
      call mem_allocate(this%idxoffdglo, 0, 'IDXOFFDGLO', &
                        this%memoryPath)
      call mem_allocate(this%idxsymdglo, 0, 'IDXSYMDGLO', &
                        this%memoryPath)
      call mem_allocate(this%idxsymoffdglo, 0, 'IDXSYMOFFDGLO', &
                        this%memoryPath)
      call mem_allocate(this%idxfjfdglo, 0, 'IDXFJFDGLO', &
                        this%memoryPath)
      call mem_allocate(this%idxfjfoffdglo, 0, 'IDXFJFOFFDGLO', &
                        this%memoryPath)
    end if

apt_ar()

subroutine tspaptmodule::apt_ar

(

class(tspapttype), intent(inout)

this

)

Definition at line 308 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType), intent(inout) :: this
    ! -- local
    integer(I4B) :: j
    logical :: found
    ! -- formats
    character(len=*), parameter :: fmtapt = &
      "(1x,/1x,'APT -- ADVANCED PACKAGE TRANSPORT, VERSION 1, 3/5/2020', &
      &' INPUT READ FROM UNIT ', i0, //)"
    !
    ! -- Get obs setup
    call this%obs%obs_ar()
    !
    ! --print a message identifying the apt package.
    write (this%iout, fmtapt) this%inunit
    !
    ! -- Allocate arrays
    call this%apt_allocate_arrays()
    !
    ! -- read optional initial package parameters
    call this%read_initial_attr()
    !
    ! -- Find the package index in the GWF model or GWF budget file
    !    for the corresponding apt flow package
    call this%fmi%get_package_index(this%flowpackagename, this%igwfaptpak)
    !
    ! -- Tell fmi that this package is being handled by APT, otherwise
    !    SSM would handle the flows into GWT from this pack.  Then point the
    !    fmi data for an advanced package to xnewpak and qmfrommvr
    this%fmi%iatp(this%igwfaptpak) = 1
    this%fmi%datp(this%igwfaptpak)%concpack => this%get_mvr_depvar()
    this%fmi%datp(this%igwfaptpak)%qmfrommvr => this%qmfrommvr
    !
    ! -- If there is an associated flow package and the user wishes to put
    !    simulated concentrations (or temperatures) into a aux variable
    !    column, then find the column number.
    if (associated(this%flowpackagebnd)) then
      if (this%cauxfpconc /= '') then
        found = .false.
        do j = 1, this%flowpackagebnd%naux
          if (this%flowpackagebnd%auxname(j) == this%cauxfpconc) then
            this%iauxfpconc = j
            found = .true.
            exit
          end if
        end do
        if (this%iauxfpconc == 0) then
          errmsg = 'Could not find auxiliary variable '// &
                   trim(adjustl(this%cauxfpconc))//' in flow package '// &
                   trim(adjustl(this%flowpackagename))
          call store_error(errmsg)
          call store_error_filename(this%input_fname)
        else
          ! -- tell package not to update this auxiliary variable
          this%flowpackagebnd%noupdateauxvar(this%iauxfpconc) = 1
          call this%apt_copy2flowp()
        end if
      end if
    end if

Here is the call graph for this function:

apt_bd_obs()

subroutine tspaptmodule::apt_bd_obs

(

class(tspapttype)

this

)

Routine calculates observations common to SFT/LKT/MWT/UZT (or SFE/LKE/MWE/UZE) for as many TspAptType observations that are common among the advanced transport packages

Definition at line 2582 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: igwfnode
    integer(I4B) :: j
    integer(I4B) :: jj
    integer(I4B) :: n
    integer(I4B) :: n1
    integer(I4B) :: n2
    real(DP) :: v
    type(ObserveType), pointer :: obsrv => null()
    logical :: found
    !
    ! -- Write simulated values for all Advanced Package observations
    if (this%obs%npakobs > 0) then
      call this%obs%obs_bd_clear()
      do i = 1, this%obs%npakobs
        obsrv => this%obs%pakobs(i)%obsrv
        do j = 1, obsrv%indxbnds_count
          v = dnodata
          jj = obsrv%indxbnds(j)
          select case (obsrv%ObsTypeId)
          case ('CONCENTRATION', 'TEMPERATURE')
            if (this%iboundpak(jj) /= 0) then
              v = this%xnewpak(jj)
            end if
          case ('LKT', 'SFT', 'MWT', 'UZT', 'LKE', 'SFE', 'MWE', 'UZE')
            n = this%flowbudptr%budterm(this%idxbudgwf)%id1(jj)
            if (this%iboundpak(n) /= 0) then
              igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(jj)
              v = this%hcof(jj) * this%xnew(igwfnode) - this%rhs(jj)
              v = -v
            end if
          case ('FLOW-JA-FACE')
            n = this%flowbudptr%budterm(this%idxbudfjf)%id1(jj)
            if (this%iboundpak(n) /= 0) then
              call this%apt_fjf_term(jj, n1, n2, v)
            end if
          case ('STORAGE')
            if (this%iboundpak(jj) /= 0) then
              v = this%qsto(jj)
            end if
          case ('CONSTANT')
            if (this%iboundpak(jj) /= 0) then
              v = this%ccterm(jj)
            end if
          case ('FROM-MVR')
            if (this%iboundpak(jj) /= 0 .and. this%idxbudfmvr > 0) then
              call this%apt_fmvr_term(jj, n1, n2, v)
            end if
          case ('TO-MVR')
            if (this%idxbudtmvr > 0) then
              n = this%flowbudptr%budterm(this%idxbudtmvr)%id1(jj)
              if (this%iboundpak(n) /= 0) then
                call this%apt_tmvr_term(jj, n1, n2, v)
              end if
            end if
          case default
            found = .false.
            !
            ! -- check the child package for any specific obs
            call this%pak_bd_obs(obsrv%ObsTypeId, jj, v, found)
            !
            ! -- if none found then terminate with an error
            if (.not. found) then
              errmsg = 'Unrecognized observation type "'// &
                       trim(obsrv%ObsTypeId)//'" for '// &
                       trim(adjustl(this%text))//' package '// &
                       trim(this%packName)
              call store_error(errmsg, terminate=.true.)
            end if
          end select
          call this%obs%SaveOneSimval(obsrv, v)
        end do
      end do
      !
      ! -- write summary of error messages
      if (count_errors() > 0) then
        call store_error_unit(this%obs%inunitobs)
      end if
    end if

Here is the call graph for this function:

apt_cfupdate()

subroutine tspaptmodule::apt_cfupdate

(

class(tspapttype)

this

)

Calculate advanced package transport hcof and rhs so transport budget is calculated.

Definition at line 845 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    integer(I4B) :: j, n
    real(DP) :: qbnd
    real(DP) :: omega
    !
    ! -- Calculate hcof and rhs terms so GWF exchanges are calculated correctly
    ! -- go through each apt-gwf connection and calculate
    !    rhs and hcof terms for gwt/gwe matrix rows
    do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
      n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
      this%hcof(j) = dzero
      this%rhs(j) = dzero
      if (this%iboundpak(n) /= 0) then
        qbnd = this%flowbudptr%budterm(this%idxbudgwf)%flow(j)
        omega = dzero
        if (qbnd < dzero) omega = done
        this%hcof(j) = -(done - omega) * qbnd * this%eqnsclfac
        this%rhs(j) = omega * qbnd * this%xnewpak(n) * this%eqnsclfac
      end if
    end do

apt_check_valid()

integer(i4b) function tspaptmodule::apt_check_valid	(	class(tspapttype), intent(inout)	this,
		integer(i4b), intent(in)	itemno
	)

Determine if a valid feature number has been specified.

Definition at line 532 of file tsp-apt.f90.

    ! -- return
    integer(I4B) :: ierr
    ! -- dummy
    class(TspAptType), intent(inout) :: this
    integer(I4B), intent(in) :: itemno
    ! -- formats
    ierr = 0
    if (itemno < 1 .or. itemno > this%ncv) then
      write (errmsg, '(a,1x,i6,1x,a,1x,i6)') &
        'Featureno ', itemno, 'must be > 0 and <= ', this%ncv
      call store_error(errmsg)
      ierr = 1
    end if

Here is the call graph for this function:

apt_copy2flowp()

subroutine tspaptmodule::apt_copy2flowp

(

class(tspapttype)

this

)

Definition at line 2228 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    integer(I4B) :: n, j
    !
    ! -- copy
    if (this%iauxfpconc /= 0) then
      !
      ! -- go through each apt-gwf connection
      do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
        !
        ! -- set n to feature number and process if active feature
        n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
        this%flowpackagebnd%auxvar(this%iauxfpconc, j) = this%xnewpak(n)
      end do
    end if

apt_cq()

subroutine tspaptmodule::apt_cq	(	class(tspapttype), intent(inout)	this,
		real(dp), dimension(:), intent(in)	x,
		real(dp), dimension(:), intent(inout), contiguous	flowja,
		integer(i4b), intent(in), optional	iadv
	)

Calculate flows for the advanced package transport feature

Definition at line 875 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType), 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) :: n, n1, n2
    real(DP) :: rrate
    !
    ! -- Solve the feature concentrations (or temperatures) again or update
    !    the feature hcof and rhs terms
    if (this%imatrows == 0) then
      call this%apt_solve()
    else
      call this%apt_cfupdate()
    end if
    !
    ! -- call base functionality in bnd_cq
    call this%BndType%bnd_cq(x, flowja)
    !
    ! -- calculate storage term
    do n = 1, this%ncv
      rrate = dzero
      if (this%iboundpak(n) > 0) then
        call this%apt_stor_term(n, n1, n2, rrate)
      end if
      this%qsto(n) = rrate
    end do
    !
    ! -- Copy concentrations (or temperatures) into the flow package auxiliary variable
    call this%apt_copy2flowp()
    !
    ! -- fill the budget object
    call this%apt_fill_budobj(x, flowja)

apt_da()

subroutine tspaptmodule::apt_da

(

class(tspapttype)

this

)

Deallocate memory associated with this package

Definition at line 1181 of file tsp-apt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    !
    ! -- deallocate arrays
    call mem_deallocate(this%dbuff)
    call mem_deallocate(this%qsto)
    call mem_deallocate(this%ccterm)
    call mem_deallocate(this%strt)
    call mem_deallocate(this%xoldpak)
    if (this%imatrows == 0) then
      call mem_deallocate(this%iboundpak)
      call mem_deallocate(this%xnewpak)
    end if
    call mem_deallocate(this%concbudssm)
    nullify (this%concfeat) ! input-context-owned alias, not package-allocated
    call mem_deallocate(this%qmfrommvr)
    deallocate (this%status)
    deallocate (this%featname)
    !
    ! -- budobj
    call this%budobj%budgetobject_da()
    deallocate (this%budobj)
    nullify (this%budobj)
    !
    ! -- conc table
    if (this%iprconc > 0) then
      call this%dvtab%table_da()
      deallocate (this%dvtab)
      nullify (this%dvtab)
    end if
    !
    ! -- index pointers
    call mem_deallocate(this%idxlocnode)
    call mem_deallocate(this%idxpakdiag)
    call mem_deallocate(this%idxdglo)
    call mem_deallocate(this%idxoffdglo)
    call mem_deallocate(this%idxsymdglo)
    call mem_deallocate(this%idxsymoffdglo)
    call mem_deallocate(this%idxfjfdglo)
    call mem_deallocate(this%idxfjfoffdglo)
    !
    ! -- deallocate scalars
    call mem_deallocate(this%iauxfpconc)
    call mem_deallocate(this%imatrows)
    call mem_deallocate(this%iprconc)
    call mem_deallocate(this%iconcout)
    call mem_deallocate(this%ibudgetout)
    call mem_deallocate(this%ibudcsv)
    call mem_deallocate(this%igwfaptpak)
    call mem_deallocate(this%ncv)
    call mem_deallocate(this%idxbudfjf)
    call mem_deallocate(this%idxbudgwf)
    call mem_deallocate(this%idxbudsto)
    call mem_deallocate(this%idxbudtmvr)
    call mem_deallocate(this%idxbudfmvr)
    call mem_deallocate(this%idxbudaux)
    call mem_deallocate(this%idxbudssm)
    call mem_deallocate(this%nconcbudssm)
    call mem_deallocate(this%idxprepak)
    call mem_deallocate(this%idxlastpak)
    !
    ! -- deallocate scalars in BndExtType
    call this%BndExtType%bnd_da()

apt_df_obs()

subroutine tspaptmodule::apt_df_obs

(

class(tspapttype)

this

)

This routine:

• stores observation types supported by APT package.
• overrides BndTypebnd_df_obs

Definition at line 2269 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    !
    ! -- call additional specific observations for lkt, sft, mwt, and uzt
    call this%pak_df_obs()

apt_fc()

subroutine tspaptmodule::apt_fc	(	class(tspapttype)	this,
		real(dp), dimension(:), intent(inout)	rhs,
		integer(i4b), dimension(:), intent(in)	ia,
		integer(i4b), dimension(:), intent(in)	idxglo,
		class(matrixbasetype), pointer	matrix_sln
	)

Definition at line 664 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: 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
    !
    ! -- Call fc depending on whether or not a matrix is expanded or not
    if (this%imatrows == 0) then
      call this%apt_fc_nonexpanded(rhs, ia, idxglo, matrix_sln)
    else
      call this%apt_fc_expanded(rhs, ia, idxglo, matrix_sln)
    end if

apt_fc_expanded()

subroutine tspaptmodule::apt_fc_expanded	(	class(tspapttype)	this,
		real(dp), dimension(:), intent(inout)	rhs,
		integer(i4b), dimension(:), intent(in)	ia,
		integer(i4b), dimension(:), intent(in)	idxglo,
		class(matrixbasetype), pointer	matrix_sln
	)

Routine to formulate the expanded matrix case in which new rows are added to the system of equations for each advanced package transport feature

Definition at line 716 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: 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
    integer(I4B) :: j, n, n1, n2
    integer(I4B) :: iloc
    integer(I4B) :: iposd, iposoffd
    integer(I4B) :: ipossymd, ipossymoffd
    real(DP) :: cold
    real(DP) :: qbnd, qbnd_scaled
    real(DP) :: omega
    real(DP) :: rrate
    real(DP) :: rhsval
    real(DP) :: hcofval
    !
    ! -- call the specific method for the advanced transport package, such as
    !    what would be overridden by
    !      GwtLktType, GwtSftType, GwtMwtType, GwtUztType
    !    This routine will add terms for rainfall, runoff, or other terms
    !    specific to the package
    call this%pak_fc_expanded(rhs, ia, idxglo, matrix_sln)
    !
    ! -- mass (or energy) storage in features
    do n = 1, this%ncv
      cold = this%xoldpak(n)
      iloc = this%idxlocnode(n)
      iposd = this%idxpakdiag(n)
      call this%apt_stor_term(n, n1, n2, rrate, rhsval, hcofval)
      call matrix_sln%add_value_pos(iposd, hcofval)
      rhs(iloc) = rhs(iloc) + rhsval
    end do
    !
    ! -- add to mover contribution
    if (this%idxbudtmvr /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudtmvr)%nlist
        call this%apt_tmvr_term(j, n1, n2, rrate, rhsval, hcofval)
        iloc = this%idxlocnode(n1)
        iposd = this%idxpakdiag(n1)
        call matrix_sln%add_value_pos(iposd, hcofval)
        rhs(iloc) = rhs(iloc) + rhsval
      end do
    end if
    !
    ! -- add from mover contribution
    if (this%idxbudfmvr /= 0) then
      do n = 1, this%ncv
        rhsval = this%qmfrommvr(n) ! this will already be in terms of energy for heat transport
        iloc = this%idxlocnode(n)
        rhs(iloc) = rhs(iloc) - rhsval
      end do
    end if
    !
    ! -- go through each apt-gwf connection
    do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
      !
      ! -- set n to feature number and process if active feature
      n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
      if (this%iboundpak(n) /= 0) then
        !
        ! -- set acoef and rhs to negative so they are relative to apt and not gwt
        qbnd = this%flowbudptr%budterm(this%idxbudgwf)%flow(j)
        omega = dzero
        if (qbnd < dzero) omega = done
        qbnd_scaled = qbnd * this%eqnsclfac
        !
        ! -- add to apt row
        iposd = this%idxdglo(j)
        iposoffd = this%idxoffdglo(j)
        call matrix_sln%add_value_pos(iposd, omega * qbnd_scaled)
        call matrix_sln%add_value_pos(iposoffd, (done - omega) * qbnd_scaled)
        !
        ! -- add to gwf row for apt connection
        ipossymd = this%idxsymdglo(j)
        ipossymoffd = this%idxsymoffdglo(j)
        call matrix_sln%add_value_pos(ipossymd, -(done - omega) * qbnd_scaled)
        call matrix_sln%add_value_pos(ipossymoffd, -omega * qbnd_scaled)
      end if
    end do
    !
    ! -- go through each apt-apt connection
    if (this%idxbudfjf /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
        n1 = this%flowbudptr%budterm(this%idxbudfjf)%id1(j)
        n2 = this%flowbudptr%budterm(this%idxbudfjf)%id2(j)
        qbnd = this%flowbudptr%budterm(this%idxbudfjf)%flow(j)
        if (qbnd <= dzero) then
          omega = done
        else
          omega = dzero
        end if
        qbnd_scaled = qbnd * this%eqnsclfac
        iposd = this%idxfjfdglo(j)
        iposoffd = this%idxfjfoffdglo(j)
        call matrix_sln%add_value_pos(iposd, omega * qbnd_scaled)
        call matrix_sln%add_value_pos(iposoffd, (done - omega) * qbnd_scaled)
      end do
    end if

apt_fc_nonexpanded()

subroutine tspaptmodule::apt_fc_nonexpanded	(	class(tspapttype)	this,
		real(dp), dimension(:), intent(inout)	rhs,
		integer(i4b), dimension(:), intent(in)	ia,
		integer(i4b), dimension(:), intent(in)	idxglo,
		class(matrixbasetype), pointer	matrix_sln
	)

Routine to formulate the nonexpanded matrix case in which feature concentrations (or temperatures) are solved explicitly

Definition at line 687 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: 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
    integer(I4B) :: j, igwfnode, idiag
    !
    ! -- solve for concentration (or temperatures) in the features
    call this%apt_solve()
    !
    ! -- add hcof and rhs terms (from apt_solve) to the gwf matrix
    do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
      igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(j)
      if (this%ibound(igwfnode) < 1) cycle
      idiag = idxglo(ia(igwfnode))
      call matrix_sln%add_value_pos(idiag, this%hcof(j))
      rhs(igwfnode) = rhs(igwfnode) + this%rhs(j)
    end do

apt_fill_budobj()

subroutine tspaptmodule::apt_fill_budobj	(	class(tspapttype)	this,
		real(dp), dimension(:), intent(in)	x,
		real(dp), dimension(:), intent(inout), contiguous	flowja
	)

Definition at line 1961 of file tsp-apt.f90.

    ! -- modules
    use tdismodule, only: delt
    ! -- dummy
    class(TspAptType) :: this
    real(DP), dimension(:), intent(in) :: x
    real(DP), dimension(:), contiguous, intent(inout) :: flowja
    ! -- local
    integer(I4B) :: naux
    real(DP), dimension(:), allocatable :: auxvartmp
    integer(I4B) :: i, j, n1, n2
    integer(I4B) :: idx
    integer(I4B) :: nlen
    integer(I4B) :: nlist
    integer(I4B) :: igwfnode
    real(DP) :: q
    real(DP) :: v0, v1
    real(DP) :: ccratin, ccratout
    ! -- formats
    !
    ! -- initialize counter
    idx = 0
    !
    ! -- initialize ccterm, which is used to sum up all mass (or energy) flows
    !    into a constant concentration (or temperature) cell
    ccratin = dzero
    ccratout = dzero
    do n1 = 1, this%ncv
      this%ccterm(n1) = dzero
    end do
    !
    ! -- FLOW JA FACE
    nlen = 0
    if (this%idxbudfjf /= 0) then
      nlen = this%flowbudptr%budterm(this%idxbudfjf)%maxlist
    end if
    if (nlen > 0) then
      idx = idx + 1
      nlist = this%flowbudptr%budterm(this%idxbudfjf)%maxlist
      call this%budobj%budterm(idx)%reset(nlist)
      q = dzero
      do j = 1, nlist
        call this%apt_fjf_term(j, n1, n2, q)
        call this%budobj%budterm(idx)%update_term(n1, n2, q)
        call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
      end do
    end if
    !
    ! -- GWF (LEAKAGE)
    idx = idx + 1
    call this%budobj%budterm(idx)%reset(this%maxbound)
    do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
      q = dzero
      n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
      igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(j)
      if (this%iboundpak(n1) /= 0) then
        q = this%hcof(j) * x(igwfnode) - this%rhs(j)
        q = -q ! flip sign so relative to advanced package feature
      end if
      call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
      call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
    end do
    !
    ! -- skip individual package terms for now and process them last
    ! -- in case they depend on the other terms (as for uze)
    idx = this%idxlastpak
    !
    ! -- STORAGE
    idx = idx + 1
    call this%budobj%budterm(idx)%reset(this%ncv)
    allocate (auxvartmp(1))
    do n1 = 1, this%ncv
      call this%apt_get_volumes(n1, v1, v0, delt)
      auxvartmp(1) = v1 * this%xnewpak(n1) ! Note: When GWE is added, check if this needs a factor of eqnsclfac
      q = this%qsto(n1)
      call this%budobj%budterm(idx)%update_term(n1, n1, q, auxvartmp)
      call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
    end do
    deallocate (auxvartmp)
    !
    ! -- TO MOVER
    if (this%idxbudtmvr /= 0) then
      idx = idx + 1
      nlist = this%flowbudptr%budterm(this%idxbudtmvr)%nlist
      call this%budobj%budterm(idx)%reset(nlist)
      do j = 1, nlist
        call this%apt_tmvr_term(j, n1, n2, q)
        call this%budobj%budterm(idx)%update_term(n1, n2, q)
        call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
      end do
    end if
    !
    ! -- FROM MOVER
    if (this%idxbudfmvr /= 0) then
      idx = idx + 1
      nlist = this%ncv
      call this%budobj%budterm(idx)%reset(nlist)
      do j = 1, nlist
        call this%apt_fmvr_term(j, n1, n2, q)
        call this%budobj%budterm(idx)%update_term(n1, n1, q)
        call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
      end do
    end if
    !
    ! -- CONSTANT FLOW
    idx = idx + 1
    call this%budobj%budterm(idx)%reset(this%ncv)
    do n1 = 1, this%ncv
      q = this%ccterm(n1)
      call this%budobj%budterm(idx)%update_term(n1, n1, q)
    end do
    !
    ! -- AUXILIARY VARIABLES
    naux = this%naux
    if (naux > 0) then
      idx = idx + 1
      allocate (auxvartmp(naux))
      call this%budobj%budterm(idx)%reset(this%ncv)
      do n1 = 1, this%ncv
        q = dzero
        do i = 1, naux
          auxvartmp(i) = this%featureauxvar(i, n1)
        end do
        call this%budobj%budterm(idx)%update_term(n1, n1, q, auxvartmp)
      end do
      deallocate (auxvartmp)
    end if
    !
    ! -- individual package terms processed last
    idx = this%idxprepak
    call this%pak_fill_budobj(idx, x, flowja, ccratin, ccratout)
    !
    ! --Terms are filled, now accumulate them for this time step
    call this%budobj%accumulate_terms()

apt_fjf_term()

subroutine tspaptmodule::apt_fjf_term	(	class(tspapttype)	this,
		integer(i4b), intent(in)	ientry,
		integer(i4b), intent(inout)	n1,
		integer(i4b), intent(inout)	n2,
		real(dp), intent(inout), optional	rrate,
		real(dp), intent(inout), optional	rhsval,
		real(dp), intent(inout), optional	hcofval
	)

Definition at line 2197 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    integer(I4B), intent(in) :: ientry
    integer(I4B), intent(inout) :: n1
    integer(I4B), intent(inout) :: n2
    real(DP), intent(inout), optional :: rrate
    real(DP), intent(inout), optional :: rhsval
    real(DP), intent(inout), optional :: hcofval
    ! -- local
    real(DP) :: qbnd
    real(DP) :: ctmp
    !
    n1 = this%flowbudptr%budterm(this%idxbudfjf)%id1(ientry)
    n2 = this%flowbudptr%budterm(this%idxbudfjf)%id2(ientry)
    qbnd = this%flowbudptr%budterm(this%idxbudfjf)%flow(ientry)
    if (qbnd <= 0) then
      ctmp = this%xnewpak(n1)
    else
      ctmp = this%xnewpak(n2)
    end if
    if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
    if (present(rhsval)) rhsval = -rrate * this%eqnsclfac
    if (present(hcofval)) hcofval = dzero

apt_fmvr_term()

subroutine tspaptmodule::apt_fmvr_term	(	class(tspapttype)	this,
		integer(i4b), intent(in)	ientry,
		integer(i4b), intent(inout)	n1,
		integer(i4b), intent(inout)	n2,
		real(dp), intent(inout), optional	rrate,
		real(dp), intent(inout), optional	rhsval,
		real(dp), intent(inout), optional	hcofval
	)

Definition at line 2174 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    integer(I4B), intent(in) :: ientry
    integer(I4B), intent(inout) :: n1
    integer(I4B), intent(inout) :: n2
    real(DP), intent(inout), optional :: rrate
    real(DP), intent(inout), optional :: rhsval
    real(DP), intent(inout), optional :: hcofval
    !
    ! -- Calculate MVR-related terms
    n1 = ientry
    n2 = n1
    if (present(rrate)) rrate = this%qmfrommvr(n1) ! NOTE: When bringing in GWE, ensure this is in terms of energy. Might need to apply eqnsclfac here.
    if (present(rhsval)) rhsval = this%qmfrommvr(n1)
    if (present(hcofval)) hcofval = dzero

apt_get_volumes()

subroutine tspaptmodule::apt_get_volumes	(	class(tspapttype)	this,
		integer(i4b), intent(in)	icv,
		real(dp), intent(inout)	vnew,
		real(dp), intent(inout)	vold,
		real(dp), intent(in)	delt
	)

Definition at line 1719 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    integer(I4B), intent(in) :: icv
    real(DP), intent(inout) :: vnew, vold
    real(DP), intent(in) :: delt
    ! -- local
    real(DP) :: qss
    !
    ! -- get volumes
    vold = dzero
    vnew = vold
    if (this%idxbudsto /= 0) then
      qss = this%flowbudptr%budterm(this%idxbudsto)%flow(icv)
      vnew = this%flowbudptr%budterm(this%idxbudsto)%auxvar(1, icv)
      vold = vnew + qss * delt
    end if

apt_mc()

subroutine tspaptmodule::apt_mc	(	class(tspapttype), intent(inout)	this,
		integer(i4b), intent(in)	moffset,
		class(matrixbasetype), pointer	matrix_sln
	)

Definition at line 247 of file tsp-apt.f90.

    use sparsemodule, only: sparsematrix
    ! -- dummy
    class(TspAptType), intent(inout) :: this
    integer(I4B), intent(in) :: moffset
    class(MatrixBaseType), pointer :: matrix_sln
    ! -- local
    integer(I4B) :: n, j, iglo, jglo
    integer(I4B) :: ipos
    ! -- format
    !
    ! -- allocate memory for index arrays
    call this%apt_allocate_index_arrays()
    !
    ! -- store index positions
    if (this%imatrows /= 0) then
      !
      ! -- Find the position of each connection in the global ia, ja structure
      !    and store them in idxglo.  idxglo allows this model to insert or
      !    retrieve values into or from the global A matrix
      ! -- apt rows
      do n = 1, this%ncv
        this%idxlocnode(n) = this%dis%nodes + this%ioffset + n
        iglo = moffset + this%dis%nodes + this%ioffset + n
        this%idxpakdiag(n) = matrix_sln%get_position_diag(iglo)
      end do
      do ipos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
        n = this%flowbudptr%budterm(this%idxbudgwf)%id1(ipos)
        j = this%flowbudptr%budterm(this%idxbudgwf)%id2(ipos)
        iglo = moffset + this%dis%nodes + this%ioffset + n
        jglo = j + moffset
        this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
        this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
      end do
      !
      ! -- apt contributions to gwf portion of global matrix
      do ipos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
        n = this%flowbudptr%budterm(this%idxbudgwf)%id1(ipos)
        j = this%flowbudptr%budterm(this%idxbudgwf)%id2(ipos)
        iglo = j + moffset
        jglo = moffset + this%dis%nodes + this%ioffset + n
        this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
        this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
      end do
      !
      ! -- apt-apt contributions to gwf portion of global matrix
      if (this%idxbudfjf /= 0) then
        do ipos = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
          n = this%flowbudptr%budterm(this%idxbudfjf)%id1(ipos)
          j = this%flowbudptr%budterm(this%idxbudfjf)%id2(ipos)
          iglo = moffset + this%dis%nodes + this%ioffset + n
          jglo = moffset + this%dis%nodes + this%ioffset + j
          this%idxfjfdglo(ipos) = matrix_sln%get_position_diag(iglo)
          this%idxfjfoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
        end do
      end if
    end if

apt_obs_supported()

logical function tspaptmodule::apt_obs_supported

(

class(tspapttype)

this

)

This function:

• returns true if APT package supports named observation.
• overrides BndTypebnd_obs_supported()

Definition at line 2254 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    !
    ! -- Set to true
    apt_obs_supported = .true.

apt_ot_bdsummary()

subroutine tspaptmodule::apt_ot_bdsummary	(	class(tspapttype)	this,
		integer(i4b), intent(in)	kstp,
		integer(i4b), intent(in)	kper,
		integer(i4b), intent(in)	iout,
		integer(i4b), intent(in)	ibudfl
	)

Parameters

	this	TspAptType object
[in]	kstp	time step number
[in]	kper	period number
[in]	iout	flag and unit number for the model listing file
[in]	ibudfl	flag indicating budget should be written

Definition at line 995 of file tsp-apt.f90.

    ! -- module
    use tdismodule, only: totim, delt
    ! -- dummy
    class(TspAptType) :: this !< TspAptType object
    integer(I4B), intent(in) :: kstp !< time step number
    integer(I4B), intent(in) :: kper !< period number
    integer(I4B), intent(in) :: iout !< flag and unit number for the model listing file
    integer(I4B), intent(in) :: ibudfl !< flag indicating budget should be written
    !
    call this%budobj%write_budtable(kstp, kper, iout, ibudfl, totim, delt)

apt_ot_dv()

subroutine tspaptmodule::apt_ot_dv	(	class(tspapttype)	this,
		integer(i4b), intent(in)	idvsave,
		integer(i4b), intent(in)	idvprint
	)

Definition at line 939 of file tsp-apt.f90.

    ! -- modules
    use constantsmodule, only: lenbudtxt
    use tdismodule, only: kstp, kper, pertim, totim
    use constantsmodule, only: dhnoflo, dhdry, lenbudtxt
    use inputoutputmodule, only: ulasav
    ! -- dummy
    class(TspAptType) :: this
    integer(I4B), intent(in) :: idvsave
    integer(I4B), intent(in) :: idvprint
    ! -- local
    integer(I4B) :: ibinun
    integer(I4B) :: n
    real(DP) :: c
    character(len=LENBUDTXT) :: text
    !
    ! -- set unit number for binary dependent variable output
    ibinun = 0
    if (this%iconcout /= 0) then
      ibinun = this%iconcout
    end if
    if (idvsave == 0) ibinun = 0
    !
    ! -- write binary output
    if (ibinun > 0) then
      do n = 1, this%ncv
        c = this%xnewpak(n)
        if (this%iboundpak(n) == 0) then
          c = dhnoflo
        end if
        this%dbuff(n) = c
      end do
      write (text, '(a)') str_pad_left(this%depvartype, lenvarname)
      call ulasav(this%dbuff, text, kstp, kper, pertim, totim, &
                  this%ncv, 1, 1, ibinun)
    end if
    !
    ! -- write apt conc table
    if (idvprint /= 0 .and. this%iprconc /= 0) then
      !
      ! -- set table kstp and kper
      call this%dvtab%set_kstpkper(kstp, kper)
      !
      ! -- fill concentration data
      do n = 1, this%ncv
        if (this%inamedbound == 1) then
          call this%dvtab%add_term(this%featname(n))
        end if
        call this%dvtab%add_term(n)
        call this%dvtab%add_term(this%xnewpak(n))
      end do
    end if

Here is the call graph for this function:

apt_ot_package_flows()

subroutine tspaptmodule::apt_ot_package_flows	(	class(tspapttype)	this,
		integer(i4b), intent(in)	icbcfl,
		integer(i4b), intent(in)	ibudfl
	)

Definition at line 915 of file tsp-apt.f90.

    use tdismodule, only: kstp, kper, delt, pertim, totim
    class(TspAptType) :: this
    integer(I4B), intent(in) :: icbcfl
    integer(I4B), intent(in) :: ibudfl
    integer(I4B) :: ibinun
    !
    ! -- write the flows from the budobj
    ibinun = 0
    if (this%ibudgetout /= 0) then
      ibinun = this%ibudgetout
    end if
    if (icbcfl == 0) ibinun = 0
    if (ibinun > 0) then
      call this%budobj%save_flows(this%dis, ibinun, kstp, kper, delt, &
                                  pertim, totim, this%iout)
    end if
    !
    ! -- Print lake flows table
    if (ibudfl /= 0 .and. this%iprflow /= 0) then
      call this%budobj%write_flowtable(this%dis, kstp, kper)
    end if

apt_process_obsid()

subroutine, public tspaptmodule::apt_process_obsid	(	type(observetype), intent(inout)	obsrv,
		class(disbasetype), intent(in)	dis,
		integer(i4b), intent(in)	inunitobs,
		integer(i4b), intent(in)	iout
	)

Method to process observation ID strings for an APT package. This processor is only for observation types that support ID1 and not ID2.

Parameters

[in,out]	obsrv	Observation object
[in]	dis	Discretization object
[in]	inunitobs	file unit number for the package observation file
[in]	iout	model listing file unit number

Definition at line 2689 of file tsp-apt.f90.

    ! -- dummy variables
    type(ObserveType), intent(inout) :: obsrv !< Observation object
    class(DisBaseType), intent(in) :: dis !< Discretization object
    integer(I4B), intent(in) :: inunitobs !< file unit number for the package observation file
    integer(I4B), intent(in) :: iout !< model listing file unit number
    ! -- local variables
    integer(I4B) :: nn1
    integer(I4B) :: icol
    integer(I4B) :: istart
    integer(I4B) :: istop
    character(len=LINELENGTH) :: string
    character(len=LENBOUNDNAME) :: bndname
    !
    ! -- initialize local variables
    string = obsrv%IDstring
    !
    ! -- Extract reach number from string and store it.
    !    If 1st item is not an integer(I4B), it should be a
    !    boundary name--deal with it.
    icol = 1
    !
    ! -- get reach number or boundary name
    call extract_idnum_or_bndname(string, icol, istart, istop, nn1, bndname)
    if (nn1 == namedboundflag) then
      obsrv%FeatureName = bndname
    end if
    !
    ! -- store reach number (NodeNumber)
    obsrv%NodeNumber = nn1
    !
    ! -- store NodeNumber2 as 1 so that this can be used
    !    as the iconn value for SFT.  This works for SFT
    !    because there is only one reach per GWT connection.
    obsrv%NodeNumber2 = 1

Here is the call graph for this function:

Here is the caller graph for this function:

apt_process_obsid12()

subroutine, public tspaptmodule::apt_process_obsid12	(	type(observetype), intent(inout)	obsrv,
		class(disbasetype), intent(in)	dis,
		integer(i4b), intent(in)	inunitobs,
		integer(i4b), intent(in)	iout
	)

Method to process observation ID strings for an APT package. This processor is for the case where if ID1 is an integer then ID2 must be provided.

Parameters

[in,out]	obsrv	Observation object
[in]	dis	Discretization object
[in]	inunitobs	file unit number for the package observation file
[in]	iout	model listing file unit number

Definition at line 2732 of file tsp-apt.f90.

    ! -- dummy variables
    type(ObserveType), intent(inout) :: obsrv !< Observation object
    class(DisBaseType), intent(in) :: dis !< Discretization object
    integer(I4B), intent(in) :: inunitobs !< file unit number for the package observation file
    integer(I4B), intent(in) :: iout !< model listing file unit number
    ! -- local variables
    integer(I4B) :: nn1
    integer(I4B) :: iconn
    integer(I4B) :: icol
    integer(I4B) :: istart
    integer(I4B) :: istop
    character(len=LINELENGTH) :: string
    character(len=LENBOUNDNAME) :: bndname
    !
    ! -- initialize local variables
    string = obsrv%IDstring
    !
    ! -- Extract reach number from string and store it.
    !    If 1st item is not an integer(I4B), it should be a
    !    boundary name--deal with it.
    icol = 1
    !
    ! -- get reach number or boundary name
    call extract_idnum_or_bndname(string, icol, istart, istop, nn1, bndname)
    if (nn1 == namedboundflag) then
      obsrv%FeatureName = bndname
    else
      call extract_idnum_or_bndname(string, icol, istart, istop, iconn, bndname)
      if (len_trim(bndname) < 1 .and. iconn < 0) then
        write (errmsg, '(a,1x,a,a,1x,a,1x,a)') &
          'For observation type', trim(adjustl(obsrv%ObsTypeId)), &
          ', ID given as an integer and not as boundname,', &
          'but ID2 is missing.  Either change ID to valid', &
          'boundname or supply valid entry for ID2.'
        call store_error(errmsg)
      end if
      obsrv%NodeNumber2 = iconn
    end if
    !
    ! -- store reach number (NodeNumber)
    obsrv%NodeNumber = nn1

Here is the call graph for this function:

Here is the caller graph for this function:

apt_read_initial_attr()

subroutine tspaptmodule::apt_read_initial_attr

(

class(tspapttype), intent(inout)

this

)

Definition at line 1489 of file tsp-apt.f90.

    use constantsmodule, only: linelength
    use budgetmodule, only: budget_cr
    ! -- dummy
    class(TspAptType), intent(inout) :: this
    ! -- local
    !character(len=LINELENGTH) :: text
    integer(I4B) :: j, n
 
    !
    ! -- initialize xnewpak and set feature concentration (or temperature)
    ! -- todo: this should be a time series?
    do n = 1, this%ncv
      this%xnewpak(n) = this%strt(n)
      !
      ! -- todo: read aux
      !
      ! -- todo: read boundname
    end do
    !
    ! -- initialize status (iboundpak) of lakes to active
    do n = 1, this%ncv
      if (this%status(n) == 'CONSTANT') then
        this%iboundpak(n) = -1
      else if (this%status(n) == 'INACTIVE') then
        this%iboundpak(n) = 0
      else if (this%status(n) == 'ACTIVE ') then
        this%iboundpak(n) = 1
      end if
    end do
    !
    ! -- set boundname for each connection
    if (this%inamedbound /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
        n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
        this%boundname(j) = this%featname(n)
      end do
    end if
    !
    ! -- copy boundname into boundname_cst
    call this%copy_boundname()

Here is the call graph for this function:

apt_reset()

subroutine tspaptmodule::apt_reset

(

class(tspapttype)

this

)

Parameters

this	GwtAptType object

Definition at line 654 of file tsp-apt.f90.

    class(TspAptType) :: this !< GwtAptType object
    ! local
    integer(I4B) :: i
    !
    do i = 1, size(this%qmfrommvr)
      this%qmfrommvr(i) = dzero
    end do

apt_rp()

subroutine tspaptmodule::apt_rp

(

class(tspapttype), intent(inout)

this

)

This subroutine calls the attached packages' read and prepare routines.

Definition at line 375 of file tsp-apt.f90.

    use tdismodule, only: kper
    use constantsmodule, only: lenvarname
    ! -- dummy
    class(TspAptType), intent(inout) :: this
    ! -- local
    integer(I4B) :: n, itemno, igwfnode, isize
    integer(I4B), pointer :: nbound => null()
    integer(I4B), dimension(:), pointer, contiguous :: ifno => null()
    type(CharacterStringType), dimension(:), pointer, contiguous :: &
      setting => null()
    type(CharacterStringType), dimension(:), pointer, contiguous :: &
      status => null()
    type(CharacterStringType), dimension(:), pointer, contiguous :: &
      auxname => null()
    real(DP), dimension(:), pointer, contiguous :: auxval => null()
    character(len=LINELENGTH) :: str
    character(len=LENVARNAME) :: key
    character(len=LINELENGTH) :: title
    character(len=LINELENGTH) :: text
    character(len=LENVARNAME) :: auxnamestr
    character(len=*), parameter :: fmtlsp = &
      "(1X,/1X,'REUSING ',A,'S FROM LAST &
      &STRESS PERIOD')"
    !
    ! -- set nbound to maxbound
    this%nbound = this%maxbound
    !
    ! -- check if the input context has data for this stress period
    if (this%iper == kper) then
      !
      ! -- get period data arrays
      call mem_setptr(nbound, 'NBOUND', this%input_mempath)
      !
      ! -- setup table to echo period data
      if (this%iprpak /= 0) then
        title = trim(adjustl(this%text))//' PACKAGE ('// &
                trim(adjustl(this%packName))//') DATA FOR PERIOD'
        write (title, '(a,1x,i6)') trim(adjustl(title)), kper
        call table_cr(this%inputtab, this%packName, title)
        call this%inputtab%table_df(1, 4, this%iout, finalize=.false.)
        text = 'NUMBER'
        call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
        text = 'KEYWORD'
        call this%inputtab%initialize_column(text, 20, alignment=tableft)
        do n = 1, 2
          write (text, '(a,1x,i6)') 'VALUE', n
          call this%inputtab%initialize_column(text, 15, alignment=tabcenter)
        end do
      end if
      !
      if (nbound > 0) then
        call mem_setptr(ifno, 'IFNO', this%input_mempath)
        call mem_setptr(setting, 'SETTING', this%input_mempath)
        call mem_setptr(status, 'STATUS', this%input_mempath)
        if (this%naux > 0) then
          call get_isize('AUXVAL', this%input_mempath, isize)
          if (isize > 0) then
            call mem_setptr(auxname, 'AUXNAME', this%input_mempath)
            call mem_setptr(auxval, 'AUXVAL', this%input_mempath)
          end if
        end if
        !
        do n = 1, nbound
          itemno = ifno(n)
          if (this%apt_check_valid(itemno) /= 0) cycle
          key = setting(n)
          !
          ! -- STATUS (string; not TS-capable)
          if (trim(key) == 'STATUS') then
            str = status(n)
            select case (trim(str))
            case ('CONSTANT')
              this%iboundpak(itemno) = -1
            case ('INACTIVE')
              this%iboundpak(itemno) = 0
            case ('ACTIVE')
              this%iboundpak(itemno) = 1
            case default
              write (errmsg, '(a,a)') &
                'Unknown '//trim(this%text)//' status keyword: ', &
                trim(str)//'.'
              call store_error(errmsg)
            end select
            this%status(itemno) = trim(str)
            if (this%iprpak /= 0) then
              call this%inputtab%add_term(itemno)
              call this%inputtab%add_term(trim(key))
              call this%inputtab%add_term(trim(str))
              call this%inputtab%add_term(' ')
            end if
            !
            ! -- CONCENTRATION/TEMPERATURE: value already resolved by the
            !    input context; echo it directly
          else if (trim(key) == trim(this%depvartype)) then
            if (this%iprpak /= 0) then
              call this%inputtab%add_term(itemno)
              call this%inputtab%add_term(trim(key))
              call this%inputtab%add_term(this%concfeat(itemno))
              call this%inputtab%add_term(' ')
            end if
            !
            ! -- AUXILIARY: value already resolved by the input context;
            !    echo the raw auxname and resolved auxval for this row
          else if (trim(key) == 'PERIOD_AUXILIARY') then
            if (this%iprpak /= 0) then
              auxnamestr = auxname(n)
              call this%inputtab%add_term(itemno)
              call this%inputtab%add_term('AUXILIARY')
              call this%inputtab%add_term(trim(auxnamestr))
              call this%inputtab%add_term(auxval(n))
            end if
            !
            ! -- package-specific setting; value already resolved by the
            !    input context, package supplies it for the table
          else
            if (this%iprpak /= 0) then
              call this%inputtab%add_term(itemno)
              call this%inputtab%add_term(trim(key))
              call this%inputtab%add_term(this%apt_setting_value(itemno, key))
              call this%inputtab%add_term(' ')
            end if
          end if
        end do
      end if
      !
      if (this%iprpak /= 0) then
        call this%inputtab%finalize_table()
      end if
      !
    else
      write (this%iout, fmtlsp) trim(this%filtyp)
    end if
    !
    ! -- write summary of stress period error messages
    if (count_errors() > 0) then
      call store_error_filename(this%input_fname)
    end if
    !
    ! -- fill nodelist every period; non-vertical connections are not updated
    !    by cf so must be set here
    do n = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
      igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(n)
      this%nodelist(n) = igwfnode
    end do

Here is the call graph for this function:

apt_rp_obs()

subroutine tspaptmodule::apt_rp_obs

(

class(tspapttype), intent(inout)

this

)

Method to process specific observations for an apt package

Definition at line 2504 of file tsp-apt.f90.

    ! -- modules
    use tdismodule, only: kper
    ! -- dummy
    class(TspAptType), intent(inout) :: this
    ! -- local
    integer(I4B) :: i
    logical :: found
    class(ObserveType), pointer :: obsrv => null()
    !
    if (kper == 1) then
      do i = 1, this%obs%npakobs
        obsrv => this%obs%pakobs(i)%obsrv
        select case (obsrv%ObsTypeId)
        case ('CONCENTRATION', 'TEMPERATURE')
          call this%rp_obs_byfeature(obsrv)
          !
          ! -- catch non-cumulative observation assigned to observation defined
          !    by a boundname that is assigned to more than one element
          if (obsrv%indxbnds_count > 1) then
            write (errmsg, '(a, a, a, a)') &
              trim(adjustl(this%depvartype))// &
              ' for observation', trim(adjustl(obsrv%Name)), &
              ' must be assigned to a feature with a unique boundname.'
            call store_error(errmsg)
          end if
        case ('LKT', 'SFT', 'MWT', 'UZT', 'LKE', 'SFE', 'MWE', 'UZE')
          call this%rp_obs_budterm(obsrv, &
                                   this%flowbudptr%budterm(this%idxbudgwf))
        case ('FLOW-JA-FACE')
          if (this%idxbudfjf > 0) then
            call this%rp_obs_flowjaface(obsrv, &
                                        this%flowbudptr%budterm(this%idxbudfjf))
          else
            write (errmsg, '(7a)') &
              'Observation ', trim(obsrv%Name), ' of type ', &
              trim(adjustl(obsrv%ObsTypeId)), ' in package ', &
              trim(this%packName), &
              ' cannot be processed because there are no flow connections.'
            call store_error(errmsg)
          end if
        case ('STORAGE')
          call this%rp_obs_byfeature(obsrv)
        case ('CONSTANT')
          call this%rp_obs_byfeature(obsrv)
        case ('FROM-MVR')
          call this%rp_obs_byfeature(obsrv)
        case default
          !
          ! -- check the child package for any specific obs
          found = .false.
          call this%pak_rp_obs(obsrv, found)
          !
          ! -- if none found then terminate with an error
          if (.not. found) then
            errmsg = 'Unrecognized observation type "'// &
                     trim(obsrv%ObsTypeId)//'" for '// &
                     trim(adjustl(this%text))//' package '// &
                     trim(this%packName)
            call store_error(errmsg, terminate=.true.)
          end if
        end select
 
      end do
      !
      ! -- check for errors
      if (count_errors() > 0) then
        call store_error_unit(this%obs%inunitobs)
      end if
    end if

Here is the call graph for this function:

apt_set_pointers()

subroutine tspaptmodule::apt_set_pointers	(	class(tspapttype)	this,
		integer(i4b), pointer	neq,
		integer(i4b), dimension(:), pointer, contiguous	ibound,
		real(dp), dimension(:), pointer, contiguous	xnew,
		real(dp), dimension(:), pointer, contiguous	xold,
		real(dp), dimension(:), pointer, contiguous	flowja
	)

Definition at line 1693 of file tsp-apt.f90.

    class(TspAptType) :: this
    integer(I4B), pointer :: neq
    integer(I4B), dimension(:), pointer, contiguous :: ibound
    real(DP), dimension(:), pointer, contiguous :: xnew
    real(DP), dimension(:), pointer, contiguous :: xold
    real(DP), dimension(:), pointer, contiguous :: flowja
    ! -- local
    integer(I4B) :: istart, iend
    !
    ! -- call base BndType set_pointers
    call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja)
    !
    ! -- Set the pointers
    !
    ! -- set package pointers
    if (this%imatrows /= 0) then
      istart = this%dis%nodes + this%ioffset + 1
      iend = istart + this%ncv - 1
      this%iboundpak => this%ibound(istart:iend)
      this%xnewpak => this%xnew(istart:iend)
    end if

apt_setting_value()

real(dp) function tspaptmodule::apt_setting_value	(	class(tspapttype), intent(inout)	this,
		integer(i4b), intent(in)	itemno,
		character(len=*), intent(in)	key
	)

Parameters

[in]	itemno	feature number
[in]	key	SETTING dispatch key

Definition at line 644 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType), intent(inout) :: this
    integer(I4B), intent(in) :: itemno !< feature number
    character(len=*), intent(in) :: key !< SETTING dispatch key
    real(DP) :: val
    val = dzero

apt_setup_budobj()

subroutine tspaptmodule::apt_setup_budobj

(

class(tspapttype)

this

)

Definition at line 1759 of file tsp-apt.f90.

    ! -- modules
    use constantsmodule, only: lenbudtxt
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    integer(I4B) :: nbudterm
    integer(I4B) :: nlen
    integer(I4B) :: n, n1, n2
    integer(I4B) :: maxlist, naux
    integer(I4B) :: idx
    logical :: ordered_id1
    real(DP) :: q
    character(len=LENBUDTXT) :: bddim_opt
    character(len=LENBUDTXT) :: text, textt
    character(len=LENBUDTXT), dimension(1) :: auxtxt
    !
    ! -- initialize nbudterm
    nbudterm = 0
    !
    ! -- Determine if there are flow-ja-face terms
    nlen = 0
    if (this%idxbudfjf /= 0) then
      nlen = this%flowbudptr%budterm(this%idxbudfjf)%maxlist
    end if
    !
    ! -- Determine the number of budget terms associated with apt.
    !    These are fixed for the simulation and cannot change
    !
    ! -- add one if flow-ja-face present
    if (this%idxbudfjf /= 0) nbudterm = nbudterm + 1
    !
    ! -- All the APT packages have GWF, STORAGE, and CONSTANT
    nbudterm = nbudterm + 3
    !
    ! -- add terms for the specific package
    nbudterm = nbudterm + this%pak_get_nbudterms()
    !
    ! -- add for mover terms and auxiliary
    if (this%idxbudtmvr /= 0) nbudterm = nbudterm + 1
    if (this%idxbudfmvr /= 0) nbudterm = nbudterm + 1
    if (this%naux > 0) nbudterm = nbudterm + 1
    !
    ! -- set up budobj
    call budgetobject_cr(this%budobj, this%packName)
    !
    bddim_opt = this%depvarunitabbrev
    call this%budobj%budgetobject_df(this%ncv, nbudterm, 0, 0, &
                                     bddim_opt=bddim_opt, ibudcsv=this%ibudcsv)
    idx = 0
    !
    ! -- Go through and set up each budget term
    if (nlen > 0) then
      text = '    FLOW-JA-FACE'
      idx = idx + 1
      maxlist = this%flowbudptr%budterm(this%idxbudfjf)%maxlist
      naux = 0
      ordered_id1 = this%flowbudptr%budterm(this%idxbudfjf)%ordered_id1
      call this%budobj%budterm(idx)%initialize(text, &
                                               this%name_model, &
                                               this%packName, &
                                               this%name_model, &
                                               this%packName, &
                                               maxlist, .false., .false., &
                                               naux, ordered_id1=ordered_id1)
      !
      ! -- store outlet connectivity
      call this%budobj%budterm(idx)%reset(maxlist)
      q = dzero
      do n = 1, maxlist
        n1 = this%flowbudptr%budterm(this%idxbudfjf)%id1(n)
        n2 = this%flowbudptr%budterm(this%idxbudfjf)%id2(n)
        call this%budobj%budterm(idx)%update_term(n1, n2, q)
      end do
    end if
    !
    ! --
    text = '             GWF'
    idx = idx + 1
    maxlist = this%flowbudptr%budterm(this%idxbudgwf)%maxlist
    naux = 0
    call this%budobj%budterm(idx)%initialize(text, &
                                             this%name_model, &
                                             this%packName, &
                                             this%name_model, &
                                             this%name_model, &
                                             maxlist, .false., .true., &
                                             naux)
    call this%budobj%budterm(idx)%reset(maxlist)
    q = dzero
    do n = 1, maxlist
      n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(n)
      n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(n)
      call this%budobj%budterm(idx)%update_term(n1, n2, q)
    end do
    !
    ! -- Reserve space for the package specific terms
    this%idxprepak = idx
    call this%pak_setup_budobj(idx)
    this%idxlastpak = idx
    !
    ! --
    text = '         STORAGE'
    idx = idx + 1
    maxlist = this%flowbudptr%budterm(this%idxbudsto)%maxlist
    naux = 1
    write (textt, '(a)') str_pad_left(this%depvarunit, 16)
    auxtxt(1) = textt ! '            MASS' or '          ENERGY'
    call this%budobj%budterm(idx)%initialize(text, &
                                             this%name_model, &
                                             this%packName, &
                                             this%name_model, &
                                             this%packName, &
                                             maxlist, .false., .false., &
                                             naux, auxtxt)
    if (this%idxbudtmvr /= 0) then
      !
      ! --
      text = '          TO-MVR'
      idx = idx + 1
      maxlist = this%flowbudptr%budterm(this%idxbudtmvr)%maxlist
      naux = 0
      ordered_id1 = this%flowbudptr%budterm(this%idxbudtmvr)%ordered_id1
      call this%budobj%budterm(idx)%initialize(text, &
                                               this%name_model, &
                                               this%packName, &
                                               this%name_model, &
                                               this%packName, &
                                               maxlist, .false., .false., &
                                               naux, ordered_id1=ordered_id1)
    end if
    if (this%idxbudfmvr /= 0) then
      !
      ! --
      text = '        FROM-MVR'
      idx = idx + 1
      maxlist = this%ncv
      naux = 0
      call this%budobj%budterm(idx)%initialize(text, &
                                               this%name_model, &
                                               this%packName, &
                                               this%name_model, &
                                               this%packName, &
                                               maxlist, .false., .false., &
                                               naux)
    end if
    !
    ! --
    text = '        CONSTANT'
    idx = idx + 1
    maxlist = this%ncv
    naux = 0
    call this%budobj%budterm(idx)%initialize(text, &
                                             this%name_model, &
                                             this%packName, &
                                             this%name_model, &
                                             this%packName, &
                                             maxlist, .false., .false., &
                                             naux)
 
    !
    ! --
    naux = this%naux
    if (naux > 0) then
      !
      ! --
      text = '       AUXILIARY'
      idx = idx + 1
      maxlist = this%ncv
      call this%budobj%budterm(idx)%initialize(text, &
                                               this%name_model, &
                                               this%packName, &
                                               this%name_model, &
                                               this%packName, &
                                               maxlist, .false., .false., &
                                               naux, this%auxname)
    end if
    !
    ! -- if flow for each control volume are written to the listing file
    if (this%iprflow /= 0) then
      call this%budobj%flowtable_df(this%iout)
    end if

Here is the call graph for this function:

apt_setup_tableobj()

subroutine tspaptmodule::apt_setup_tableobj

(

class(tspapttype)

this

)

Set up the table object that is used to write the apt concentration (or temperature) data. The terms listed here must correspond in the apt_ot method.

Definition at line 2782 of file tsp-apt.f90.

    ! -- modules
    use constantsmodule, only: linelength, lenbudtxt
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    integer(I4B) :: nterms
    character(len=LINELENGTH) :: title
    character(len=LINELENGTH) :: text_temp
    !
    ! -- setup well head table
    if (this%iprconc > 0) then
      !
      ! -- Determine the number of head table columns
      nterms = 2
      if (this%inamedbound == 1) nterms = nterms + 1
      !
      ! -- set up table title
      title = trim(adjustl(this%text))//' PACKAGE ('// &
              trim(adjustl(this%packName))// &
              ') '//trim(adjustl(this%depvartype))// &
              &' FOR EACH CONTROL VOLUME'
      !
      ! -- set up dv tableobj
      call table_cr(this%dvtab, this%packName, title)
      call this%dvtab%table_df(this%ncv, nterms, this%iout, &
                               transient=.true.)
      !
      ! -- Go through and set up table budget term
      if (this%inamedbound == 1) then
        text_temp = 'NAME'
        call this%dvtab%initialize_column(text_temp, 20, alignment=tableft)
      end if
      !
      ! -- feature number
      text_temp = 'NUMBER'
      call this%dvtab%initialize_column(text_temp, 10, alignment=tabcenter)
      !
      ! -- feature conc
      text_temp = this%depvartype(1:4)
      call this%dvtab%initialize_column(text_temp, 12, alignment=tabcenter)
    end if

Here is the call graph for this function:

apt_solve()

subroutine tspaptmodule::apt_solve

(

class(tspapttype)

this

)

Explicit solve for concentration (or temperature) in advaced package features, which is an alternative to the iterative implicit solve.

Definition at line 1538 of file tsp-apt.f90.

    use constantsmodule, only: linelength
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    integer(I4B) :: n, j, igwfnode
    integer(I4B) :: n1, n2
    real(DP) :: rrate
    real(DP) :: ctmp
    real(DP) :: c1, qbnd
    real(DP) :: hcofval, rhsval
    !
    ! -- initialize dbuff
    do n = 1, this%ncv
      this%dbuff(n) = dzero
    end do
    !
    ! -- call the individual package routines to add terms specific to the
    !    advanced transport package
    call this%pak_solve()
    !
    ! -- add to mover contribution
    if (this%idxbudtmvr /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudtmvr)%nlist
        call this%apt_tmvr_term(j, n1, n2, rrate)
        this%dbuff(n1) = this%dbuff(n1) + rrate
      end do
    end if
    !
    ! -- add from mover contribution
    if (this%idxbudfmvr /= 0) then
      do n1 = 1, size(this%qmfrommvr)
        rrate = this%qmfrommvr(n1) ! Will be in terms of energy for heat transport
        this%dbuff(n1) = this%dbuff(n1) + rrate
      end do
    end if
    !
    ! -- go through each gwf connection and accumulate
    !    total mass (or energy) in dbuff mass
    do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
      n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
      this%hcof(j) = dzero
      this%rhs(j) = dzero
      igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(j)
      qbnd = this%flowbudptr%budterm(this%idxbudgwf)%flow(j)
      if (qbnd <= dzero) then
        ctmp = this%xnewpak(n)
        this%rhs(j) = qbnd * ctmp * this%eqnsclfac
      else
        ctmp = this%xnew(igwfnode)
        this%hcof(j) = -qbnd * this%eqnsclfac
      end if
      c1 = qbnd * ctmp * this%eqnsclfac
      this%dbuff(n) = this%dbuff(n) + c1
    end do
    !
    ! -- go through each "within apt-apt" connection (e.g., lak-lak) and
    !    accumulate total mass (or energy) in dbuff mass
    if (this%idxbudfjf /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
        call this%apt_fjf_term(j, n1, n2, rrate)
        c1 = rrate
        this%dbuff(n1) = this%dbuff(n1) + c1
      end do
    end if
    !
    ! -- calculate the feature concentration/temperature
    do n = 1, this%ncv
      call this%apt_stor_term(n, n1, n2, rrate, rhsval, hcofval)
      !
      ! -- at this point, dbuff has q * c for all sources, so now
      !    add Vold / dt * Cold
      this%dbuff(n) = this%dbuff(n) - rhsval
      !
      ! -- Now to calculate c, need to divide dbuff by hcofval
      c1 = -this%dbuff(n) / hcofval
      if (this%iboundpak(n) > 0) then
        this%xnewpak(n) = c1
      end if
    end do

apt_source_cvs()

subroutine tspaptmodule::apt_source_cvs

(

class(tspapttype), intent(inout)

this

)

Definition at line 1406 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType), intent(inout) :: this
    ! -- local
    character(len=LENBOUNDNAME) :: bndName
    character(len=9) :: cno
    integer(I4B) :: n, itemno, isize, nfeat
    integer(I4B), allocatable, dimension(:) :: nboundchk
    real(DP), dimension(:), pointer, contiguous :: strt_ptr => null()
    type(CharacterStringType), dimension(:), pointer, contiguous :: &
      boundname_ptr => null()
    !
    ! -- allocate package simulation arrays
    call mem_allocate(this%strt, this%ncv, 'STRT', this%memoryPath)
    if (this%imatrows == 0) then
      call mem_allocate(this%iboundpak, this%ncv, 'IBOUND', this%memoryPath)
      call mem_allocate(this%xnewpak, this%ncv, 'XNEWPAK', this%memoryPath)
    end if
    call mem_allocate(this%xoldpak, this%ncv, 'XOLDPAK', this%memoryPath)
    allocate (this%featname(this%ncv))
    !
    ! -- initialize arrays
    do n = 1, this%ncv
      this%strt(n) = dep20
      this%xoldpak(n) = dep20
      if (this%imatrows == 0) then
        this%iboundpak(n) = 1
        this%xnewpak(n) = dep20
      end if
    end do
    !
    ! -- set up featureauxvar; allocate_featureauxvar also sets pkg_ifno
    !    from PACKAGEDATA_IFNO
    call this%allocate_featureauxvar()
    !
    ! -- validate PACKAGEDATA specifies IFNO exactly once for every feature
    nfeat = size(this%pkg_ifno)
    allocate (nboundchk(this%ncv))
    nboundchk = 0
    do n = 1, nfeat
      itemno = this%validate_ifno(this%pkg_ifno(n), this%ncv, nboundchk, 'IFNO', &
                                  trim(adjustl(this%text))//' PACKAGEDATA')
    end do
    call this%report_ifno_coverage(nboundchk, this%ncv, 'feature', &
                                   trim(adjustl(this%text))//' PACKAGEDATA')
    deallocate (nboundchk)
    if (count_errors() > 0) then
      call store_error_filename(this%input_fname)
    end if
    !
    ! -- source STRT from the input context
    call mem_setptr(strt_ptr, 'STRT', this%input_mempath)
    do n = 1, nfeat
      itemno = this%pkg_ifno(n)
      this%strt(itemno) = strt_ptr(n)
    end do
    call memorystore_release('STRT', this%input_mempath)
    !
    ! -- set default feature names then override with BOUNDNAME if present
    do n = 1, this%ncv
      write (cno, '(i9.9)') n
      this%featname(n) = 'Feature'//cno
    end do
    if (this%inamedbound /= 0) then
      call get_isize('BOUNDNAME', this%input_mempath, isize)
      if (isize > 0) then
        call mem_setptr(boundname_ptr, 'BOUNDNAME', this%input_mempath)
        do n = 1, nfeat
          itemno = this%pkg_ifno(n)
          if (itemno < 1 .or. itemno > this%ncv) cycle
          bndname = boundname_ptr(n)
          if (trim(bndname) /= '') this%featname(itemno) = trim(bndname)
        end do
      end if
    end if
    call memorystore_release('BOUNDNAME', this%input_mempath)
    !
    write (this%iout, '(/1x,a)') 'END OF '//trim(adjustl(this%text))// &
      ' PACKAGEDATA'

Here is the call graph for this function:

apt_source_dimensions()

subroutine tspaptmodule::apt_source_dimensions

(

class(tspapttype), intent(inout)

this

)

Definition at line 1353 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType), intent(inout) :: this
    ! -- local
    integer(I4B) :: ierr
    !
    ! -- default flow package name to package name if not specified in OPTIONS
    if (this%flowpackagename == '') then
      this%flowpackagename = this%packName
      write (this%iout, '(4x,a)') &
        'THE FLOW PACKAGE NAME FOR '//trim(adjustl(this%text))//' WAS NOT &
        &SPECIFIED.  SETTING FLOW PACKAGE NAME TO '// &
        trim(adjustl(this%flowpackagename))
    end if
    call this%find_apt_package()
    !
    ! -- derive dimensions from the corresponding GWF advanced package
    this%ncv = this%flowbudptr%ncv
    this%maxbound = this%flowbudptr%budterm(this%idxbudgwf)%maxlist
    this%nbound = this%maxbound
    write (this%iout, '(a, a)') 'SETTING DIMENSIONS FOR PACKAGE ', this%packName
    write (this%iout, '(2x,a,i0)') 'NUMBER OF CONTROL VOLUMES = ', this%ncv
    write (this%iout, '(2x,a,i0)') 'MAXBOUND = ', this%maxbound
    write (this%iout, '(2x,a,i0)') 'NBOUND = ', this%nbound
    if (this%imatrows /= 0) then
      this%npakeq = this%ncv
      write (this%iout, '(2x,a)') trim(adjustl(this%text))// &
        ' SOLVED AS PART OF GWT MATRIX EQUATIONS'
    else
      write (this%iout, '(2x,a)') trim(adjustl(this%text))// &
        ' SOLVED SEPARATELY FROM GWT MATRIX EQUATIONS '
    end if
    write (this%iout, '(a, //)') 'DONE SETTING DIMENSIONS FOR '// &
      trim(adjustl(this%text))
    !
    if (this%ncv < 0) then
      write (errmsg, '(a)') &
        'Number of control volumes could not be determined correctly.'
      call store_error(errmsg)
    end if
    ierr = count_errors()
    if (ierr > 0) call store_error_filename(this%input_fname)
    !
    ! -- source packagedata from the input context
    call this%apt_source_cvs()
    !
    call this%define_listlabel()
    call this%apt_setup_budobj()
    call this%apt_setup_tableobj()

Here is the call graph for this function:

apt_source_options()

subroutine tspaptmodule::apt_source_options

(

class(tspapttype), intent(inout)

this

)

Definition at line 1266 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType), intent(inout) :: this
    ! -- local
    character(len=LINELENGTH) :: fname
    logical :: found
    ! -- formats
    character(len=*), parameter :: fmtaptbin = &
      "(4x, a, 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, &
      &/4x, 'OPENED ON UNIT: ', I0)"
    !
    ! -- call base class for AUXILIARY/BOUNDNAMES/PRINT_INPUT/PRINT_FLOWS/
    !    SAVE_FLOWS/OBS6/TS6 options
    call this%BndExtType%source_options()
    !
    write (this%iout, '(1x,a)') &
      'PROCESSING '//trim(adjustl(this%text))//' OPTIONS'
    !
    ! -- FLOW_PKG_NAME (DFN: flow_package_name)
    call mem_set_value(this%flowpackagename, 'FLOW_PKG_NAME', &
                       this%input_mempath, found)
    if (found) then
      write (this%iout, '(4x,a)') &
        'THIS '//trim(adjustl(this%text))//' PACKAGE CORRESPONDS TO A GWF &
        &PACKAGE WITH THE NAME '//trim(adjustl(this%flowpackagename))
    end if
    !
    ! -- FP_AUX_NAME (DFN: flow_package_auxiliary_name)
    call mem_set_value(this%cauxfpconc, 'FP_AUX_NAME', &
                       this%input_mempath, found)
    if (found) then
      write (this%iout, '(4x,a)') &
        'SIMULATED CONCENTRATIONS WILL BE COPIED INTO THE FLOW PACKAGE &
        &AUXILIARY VARIABLE WITH THE NAME '//trim(adjustl(this%cauxfpconc))
    end if
    !
    ! -- DEV_NONEXPANDING_MATRIX is intentionally not sourced: this
    !    package's imatrows=0 solve path divides by a per-feature
    !    storage term that is zero without a stage-volume table.
    !
    ! -- IPRCONC (DFN: print_concentration or print_temperature)
    call mem_set_value(this%iprconc, 'IPRCONC', this%input_mempath, found)
    if (found) then
      write (this%iout, '(4x,a)') trim(adjustl(this%text))// &
        ' '//trim(adjustl(this%depvartype))//'S WILL BE PRINTED TO LISTING FILE.'
    end if
    !
    ! -- concentration/temperature output file: 'CONCFILE' (GWT) or 'TEMPFILE' (GWE)
    if (this%depvartype == 'CONCENTRATION') then
      call mem_set_value(fname, 'CONCFILE', this%input_mempath, found)
    else
      call mem_set_value(fname, 'TEMPFILE', this%input_mempath, found)
    end if
    if (found) then
      call assign_iounit(this%iconcout, this%inunit, &
                         trim(this%depvartype)//" fileout")
      call openfile(this%iconcout, this%iout, fname, 'DATA(BINARY)', &
                    form, access, 'REPLACE', mode_opt=mnormal)
      write (this%iout, fmtaptbin) trim(adjustl(this%text)), &
        trim(adjustl(this%depvartype)), trim(fname), this%iconcout
    end if
    !
    ! -- BUDGET FILEOUT
    call mem_set_value(fname, 'BUDGETFILE', this%input_mempath, found)
    if (found) then
      call assign_iounit(this%ibudgetout, this%inunit, "BUDGET fileout")
      call openfile(this%ibudgetout, this%iout, fname, 'DATA(BINARY)', &
                    form, access, 'REPLACE', mode_opt=mnormal)
      write (this%iout, fmtaptbin) trim(adjustl(this%text)), 'BUDGET', &
        trim(fname), this%ibudgetout
    end if
    !
    ! -- BUDGETCSV FILEOUT
    call mem_set_value(fname, 'BUDGETCSVFILE', this%input_mempath, found)
    if (found) then
      call assign_iounit(this%ibudcsv, this%inunit, "BUDGETCSV fileout")
      call openfile(this%ibudcsv, this%iout, fname, 'CSV', filstat_opt='REPLACE')
      write (this%iout, fmtaptbin) trim(adjustl(this%text)), 'BUDGET CSV', &
        trim(fname), this%ibudcsv
    end if
    !
    write (this%iout, '(1x,a)') &
      'END OF '//trim(adjustl(this%text))//' OPTIONS'

Here is the call graph for this function:

apt_stor_term()

subroutine tspaptmodule::apt_stor_term	(	class(tspapttype)	this,
		integer(i4b), intent(in)	ientry,
		integer(i4b), intent(inout)	n1,
		integer(i4b), intent(inout)	n2,
		real(dp), intent(inout), optional	rrate,
		real(dp), intent(inout), optional	rhsval,
		real(dp), intent(inout), optional	hcofval
	)

Definition at line 2118 of file tsp-apt.f90.

    use tdismodule, only: delt
    class(TspAptType) :: this
    integer(I4B), intent(in) :: ientry
    integer(I4B), intent(inout) :: n1
    integer(I4B), intent(inout) :: n2
    real(DP), intent(inout), optional :: rrate
    real(DP), intent(inout), optional :: rhsval
    real(DP), intent(inout), optional :: hcofval
    real(DP) :: v0, v1
    real(DP) :: c0, c1
    !
    n1 = ientry
    n2 = ientry
    call this%apt_get_volumes(n1, v1, v0, delt)
    c0 = this%xoldpak(n1)
    c1 = this%xnewpak(n1)
    if (present(rrate)) then
      rrate = (-c1 * v1 / delt + c0 * v0 / delt) * this%eqnsclfac
    end if
    !
    if (present(rhsval)) rhsval = -c0 * v0 * this%eqnsclfac / delt
    if (present(hcofval)) hcofval = -v1 * this%eqnsclfac / delt

apt_tmvr_term()

subroutine tspaptmodule::apt_tmvr_term	(	class(tspapttype)	this,
		integer(i4b), intent(in)	ientry,
		integer(i4b), intent(inout)	n1,
		integer(i4b), intent(inout)	n2,
		real(dp), intent(inout), optional	rrate,
		real(dp), intent(inout), optional	rhsval,
		real(dp), intent(inout), optional	hcofval
	)

Definition at line 2146 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    integer(I4B), intent(in) :: ientry
    integer(I4B), intent(inout) :: n1
    integer(I4B), intent(inout) :: n2
    real(DP), intent(inout), optional :: rrate
    real(DP), intent(inout), optional :: rhsval
    real(DP), intent(inout), optional :: hcofval
    ! -- local
    real(DP) :: qbnd
    real(DP) :: ctmp
    !
    ! -- Calculate MVR-related terms
    n1 = this%flowbudptr%budterm(this%idxbudtmvr)%id1(ientry)
    n2 = this%flowbudptr%budterm(this%idxbudtmvr)%id2(ientry)
    qbnd = this%flowbudptr%budterm(this%idxbudtmvr)%flow(ientry)
    ctmp = this%xnewpak(n1)
    if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
    if (present(rhsval)) rhsval = dzero
    if (present(hcofval)) hcofval = qbnd * this%eqnsclfac

define_listlabel()

subroutine tspaptmodule::define_listlabel

(

class(tspapttype), intent(inout)

this

)

Definition at line 1669 of file tsp-apt.f90.

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

find_apt_package()

subroutine tspaptmodule::find_apt_package

(

class(tspapttype)

this

)

Definition at line 1252 of file tsp-apt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    !
    ! -- this routine should never be called
    call store_error('Program error: pak_solve not implemented.', &
                     terminate=.true.)

Here is the call graph for this function:

get_mvr_depvar()

real(dp) function, dimension(:), pointer, contiguous tspaptmodule::get_mvr_depvar

(

class(tspapttype)

this

)

Set the concentration (or temperature) to be used by either MVT or MVE

Definition at line 552 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType) :: this
    ! -- return
    real(dp), dimension(:), contiguous, pointer :: get_mvr_depvar
    !
    get_mvr_depvar => this%xnewpak

pak_bd_obs()

subroutine tspaptmodule::pak_bd_obs	(	class(tspapttype), intent(inout)	this,
		character(len=*), intent(in)	obstypeid,
		integer(i4b), intent(in)	jj,
		real(dp), intent(inout)	v,
		logical, intent(inout)	found
	)

Definition at line 2670 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType), intent(inout) :: this
    character(len=*), intent(in) :: obstypeid
    integer(I4B), intent(in) :: jj
    real(DP), intent(inout) :: v
    logical, intent(inout) :: found
    ! -- local
    !
    ! -- set found = .false. because obstypeid is not known
    found = .false.

pak_df_obs()

subroutine tspaptmodule::pak_df_obs

(

class(tspapttype)

this

)

This routine:

• stores observations supported by the APT package
• must be overridden by child class

Definition at line 2284 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    !
    ! -- this routine should never be called
    call store_error('Program error: pak_df_obs not implemented.', &
                     terminate=.true.)

Here is the call graph for this function:

pak_fc_expanded()

subroutine tspaptmodule::pak_fc_expanded	(	class(tspapttype)	this,
		real(dp), dimension(:), intent(inout)	rhs,
		integer(i4b), dimension(:), intent(in)	ia,
		integer(i4b), dimension(:), intent(in)	idxglo,
		class(matrixbasetype), pointer	matrix_sln
	)

Routine to allow a subclass advanced transport package to inject terms into the matrix assembly. This method must be overridden.

Definition at line 825 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: 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
    !
    ! -- this routine should never be called
    call store_error('Program error: pak_fc_expanded not implemented.', &
                     terminate=.true.)

Here is the call graph for this function:

pak_fill_budobj()

subroutine tspaptmodule::pak_fill_budobj	(	class(tspapttype)	this,
		integer(i4b), intent(inout)	idx,
		real(dp), dimension(:), intent(in)	x,
		real(dp), dimension(:), intent(inout), contiguous	flowja,
		real(dp), intent(inout)	ccratin,
		real(dp), intent(inout)	ccratout
	)

Definition at line 2099 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    integer(I4B), intent(inout) :: idx
    real(DP), dimension(:), intent(in) :: x
    real(DP), dimension(:), contiguous, intent(inout) :: flowja
    real(DP), intent(inout) :: ccratin
    real(DP), intent(inout) :: ccratout
    ! -- local
    ! -- formats
    !
    ! -- this routine should never be called
    call store_error('Program error: pak_fill_budobj not implemented.', &
                     terminate=.true.)

Here is the call graph for this function:

pak_get_nbudterms()

integer(i4b) function tspaptmodule::pak_get_nbudterms

(

class(tspapttype)

this

)

This function must be overridden.

Definition at line 1743 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    ! -- return
    integer(I4B) :: nbudterms
    ! -- local
    !
    ! -- this routine should never be called
    call store_error('Program error: pak_get_nbudterms not implemented.', &
                     terminate=.true.)
    nbudterms = 0

Here is the call graph for this function:

pak_rp_obs()

subroutine tspaptmodule::pak_rp_obs	(	class(tspapttype), intent(inout)	this,
		type(observetype), intent(inout)	obsrv,
		logical, intent(inout)	found
	)

Method to process specific observations for this package.

Parameters

[in,out]	this	package class
[in,out]	obsrv	observation object
[in,out]	found	indicate whether observation was found

Definition at line 2299 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType), intent(inout) :: this !< package class
    type(ObserveType), intent(inout) :: obsrv !< observation object
    logical, intent(inout) :: found !< indicate whether observation was found
    ! -- local
    !
    ! -- this routine should never be called
    call store_error('Program error: pak_rp_obs not implemented.', &
                     terminate=.true.)

Here is the call graph for this function:

pak_setup_budobj()

subroutine tspaptmodule::pak_setup_budobj	(	class(tspapttype)	this,
		integer(i4b), intent(inout)	idx
	)

Individual packages set up their budget terms. Must be overridden.

Definition at line 1947 of file tsp-apt.f90.

    ! -- modules
    ! -- dummy
    class(TspAptType) :: this
    integer(I4B), intent(inout) :: idx
    ! -- local
    !
    ! -- this routine should never be called
    call store_error('Program error: pak_setup_budobj not implemented.', &
                     terminate=.true.)

Here is the call graph for this function:

pak_solve()

subroutine tspaptmodule::pak_solve

(

class(tspapttype)

this

)

This routine must be overridden by the specific apt package

Definition at line 1625 of file tsp-apt.f90.

    ! -- dummy
    class(TspAptType) :: this
    ! -- local
    !
    ! -- this routine should never be called
    call store_error('Program error: pak_solve not implemented.', &
                     terminate=.true.)

Here is the call graph for this function:

rp_obs_budterm()

subroutine tspaptmodule::rp_obs_budterm	(	class(tspapttype), intent(inout)	this,
		type(observetype), intent(inout)	obsrv,
		type(budgettermtype), intent(in)	budterm
	)

Find the indices for this observation assuming they are first indexed by feature number and secondly by a connection number

Parameters

[in,out]	this	object
[in,out]	obsrv	observation
[in]	budterm	budget term

Definition at line 2359 of file tsp-apt.f90.

    class(TspAptType), intent(inout) :: this !< object
    type(ObserveType), intent(inout) :: obsrv !< observation
    type(BudgetTermType), intent(in) :: budterm !< budget term
    integer(I4B) :: nn1
    integer(I4B) :: iconn
    integer(I4B) :: icv
    integer(I4B) :: idx
    integer(I4B) :: j
    logical :: jfound
    character(len=*), parameter :: fmterr = &
      "('Boundary ', a, ' for observation ', a, &
      &' is invalid in package ', a)"
    nn1 = obsrv%NodeNumber
    if (nn1 == namedboundflag) then
      jfound = .false.
      do j = 1, budterm%nlist
        icv = budterm%id1(j)
        if (this%featname(icv) == obsrv%FeatureName) then
          jfound = .true.
          call obsrv%AddObsIndex(j)
        end if
      end do
      if (.not. jfound) then
        write (errmsg, fmterr) trim(obsrv%FeatureName), trim(obsrv%Name), &
          trim(this%packName)
        call store_error(errmsg)
      end if
    else
      !
      ! -- ensure nn1 is > 0 and < ncv
      if (nn1 < 0 .or. nn1 > this%ncv) then
        write (errmsg, '(7a, i0, a, i0, a)') &
          'Observation ', trim(obsrv%Name), ' of type ', &
          trim(adjustl(obsrv%ObsTypeId)), ' in package ', &
          trim(this%packName), ' was assigned ID = ', nn1, &
          '.  ID must be >= 1 and <= ', this%ncv, '.'
        call store_error(errmsg)
      end if
      iconn = obsrv%NodeNumber2
      do j = 1, budterm%nlist
        if (budterm%id1(j) == nn1) then
          ! -- Look for the first occurrence of nn1, then set indxbnds
          !    to the iconn record after that
          idx = j + iconn - 1
          call obsrv%AddObsIndex(idx)
          exit
        end if
      end do
      if (idx < 1 .or. idx > budterm%nlist) then
        write (errmsg, '(7a, i0, a, i0, a)') &
          'Observation ', trim(obsrv%Name), ' of type ', &
          trim(adjustl(obsrv%ObsTypeId)), ' in package ', &
          trim(this%packName), ' specifies iconn = ', iconn, &
          ',  but this is not a valid connection for ID ', nn1, '.'
        call store_error(errmsg)
      else if (budterm%id1(idx) /= nn1) then
        write (errmsg, '(7a, i0, a, i0, a)') &
          'Observation ', trim(obsrv%Name), ' of type ', &
          trim(adjustl(obsrv%ObsTypeId)), ' in package ', &
          trim(this%packName), ' specifies iconn = ', iconn, &
          ',  but this is not a valid connection for ID ', nn1, '.'
        call store_error(errmsg)
      end if
    end if

Here is the call graph for this function:

rp_obs_byfeature()

subroutine tspaptmodule::rp_obs_byfeature	(	class(tspapttype), intent(inout)	this,
		type(observetype), intent(inout)	obsrv
	)

Find the indices for this observation assuming they are indexed by feature number

Parameters

[in,out]	this	object
[in,out]	obsrv	observation

Definition at line 2316 of file tsp-apt.f90.

    class(TspAptType), intent(inout) :: this !< object
    type(ObserveType), intent(inout) :: obsrv !< observation
    integer(I4B) :: nn1
    integer(I4B) :: j
    logical :: jfound
    character(len=*), parameter :: fmterr = &
      "('Boundary ', a, ' for observation ', a, &
      &' is invalid in package ', a)"
    nn1 = obsrv%NodeNumber
    if (nn1 == namedboundflag) then
      jfound = .false.
      do j = 1, this%ncv
        if (this%featname(j) == obsrv%FeatureName) then
          jfound = .true.
          call obsrv%AddObsIndex(j)
        end if
      end do
      if (.not. jfound) then
        write (errmsg, fmterr) trim(obsrv%FeatureName), trim(obsrv%Name), &
          trim(this%packName)
        call store_error(errmsg)
      end if
    else
      !
      ! -- ensure nn1 is > 0 and < ncv
      if (nn1 < 0 .or. nn1 > this%ncv) then
        write (errmsg, '(7a, i0, a, i0, a)') &
          'Observation ', trim(obsrv%Name), ' of type ', &
          trim(adjustl(obsrv%ObsTypeId)), ' in package ', &
          trim(this%packName), ' was assigned ID = ', nn1, &
          '.  ID must be >= 1 and <= ', this%ncv, '.'
        call store_error(errmsg)
      end if
      call obsrv%AddObsIndex(nn1)
    end if

Here is the call graph for this function:

rp_obs_flowjaface()

subroutine tspaptmodule::rp_obs_flowjaface	(	class(tspapttype), intent(inout)	this,
		type(observetype), intent(inout)	obsrv,
		type(budgettermtype), intent(in)	budterm
	)

Find the indices for this observation assuming they are first indexed by a feature number and secondly by a second feature number

Parameters

[in,out]	this	object
[in,out]	obsrv	observation
[in]	budterm	budget term

Definition at line 2431 of file tsp-apt.f90.

    class(TspAptType), intent(inout) :: this !< object
    type(ObserveType), intent(inout) :: obsrv !< observation
    type(BudgetTermType), intent(in) :: budterm !< budget term
    integer(I4B) :: nn1
    integer(I4B) :: nn2
    integer(I4B) :: icv
    integer(I4B) :: j
    logical :: jfound
    character(len=*), parameter :: fmterr = &
      "('Boundary ', a, ' for observation ', a, &
      &' is invalid in package ', a)"
    nn1 = obsrv%NodeNumber
    if (nn1 == namedboundflag) then
      jfound = .false.
      do j = 1, budterm%nlist
        icv = budterm%id1(j)
        if (this%featname(icv) == obsrv%FeatureName) then
          jfound = .true.
          call obsrv%AddObsIndex(j)
        end if
      end do
      if (.not. jfound) then
        write (errmsg, fmterr) trim(obsrv%FeatureName), trim(obsrv%Name), &
          trim(this%packName)
        call store_error(errmsg)
      end if
    else
      !
      ! -- ensure nn1 is > 0 and < ncv
      if (nn1 < 0 .or. nn1 > this%ncv) then
        write (errmsg, '(7a, i0, a, i0, a)') &
          'Observation ', trim(obsrv%Name), ' of type ', &
          trim(adjustl(obsrv%ObsTypeId)), ' in package ', &
          trim(this%packName), ' was assigned ID = ', nn1, &
          '.  ID must be >= 1 and <= ', this%ncv, '.'
        call store_error(errmsg)
      end if
      nn2 = obsrv%NodeNumber2
      !
      ! -- ensure nn2 is > 0 and < ncv
      if (nn2 < 0 .or. nn2 > this%ncv) then
        write (errmsg, '(7a, i0, a, i0, a)') &
          'Observation ', trim(obsrv%Name), ' of type ', &
          trim(adjustl(obsrv%ObsTypeId)), ' in package ', &
          trim(this%packName), ' was assigned ID2 = ', nn2, &
          '.  ID must be >= 1 and <= ', this%ncv, '.'
        call store_error(errmsg)
      end if
      ! -- Look for nn1 and nn2 in id1 and id2
      jfound = .false.
      do j = 1, budterm%nlist
        if (budterm%id1(j) == nn1 .and. budterm%id2(j) == nn2) then
          call obsrv%AddObsIndex(j)
          jfound = .true.
        end if
      end do
      if (.not. jfound) then
        write (errmsg, '(7a, i0, a, i0, a)') &
          'Observation ', trim(obsrv%Name), ' of type ', &
          trim(adjustl(obsrv%ObsTypeId)), ' in package ', &
          trim(this%packName), &
          ' specifies a connection between feature ', nn1, &
          ' feature ', nn2, ', but these features are not connected.'
        call store_error(errmsg)
      end if
    end if

Here is the call graph for this function:

Variable Documentation

ftype

character(len=lenftype) tspaptmodule::ftype = 'APT'

Definition at line 70 of file tsp-apt.f90.

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

text

character(len=lenvarname) tspaptmodule::text = ' APT'

Definition at line 71 of file tsp-apt.f90.

  character(len=LENVARNAME) :: text = '             APT'