gweuzemodule Module Reference

Data Types
type	gweuzetype

Functions/Subroutines
subroutine, public	uze_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
	Create a new UZE package. More...
subroutine	find_uze_package (this)
	Find corresponding uze package. More...
subroutine	uze_ac (this, moffset, sparse)
	Add package connection to matrix. More...
subroutine	uze_mc (this, moffset, matrix_sln)
	Map package connection to matrix. More...
subroutine	uze_fc_expanded (this, rhs, ia, idxglo, matrix_sln)
	Add matrix terms related to UZE. More...
subroutine	uze_solve (this)
	Explicit solve. More...
integer(i4b) function	uze_get_nbudterms (this)
	Return the number of UZE-specific budget terms. More...
real(dp) function, dimension(:), pointer, contiguous	get_mvr_depvar (this)
	Override similarly named function in APT. More...
subroutine	uze_setup_budobj (this, idx)
	Setup budget object. More...
subroutine	uze_fill_budobj (this, idx, x, flowja, ccratin, ccratout)
	Fill UZE budget object. More...
subroutine	allocate_scalars (this)
	Allocate scalars. More...
subroutine	uze_allocate_arrays (this)
	Allocate arrays. More...
subroutine	uze_da (this)
	Deallocate memory. More...
subroutine	uze_infl_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
	Infiltration term. More...
subroutine	uze_rinf_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
	Rejected infiltration term. More...
subroutine	uze_uzet_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
	Evapotranspiration from the unsaturated-zone term. More...
subroutine	uze_ritm_term (this, ientry, n1, n2, rrate, rhsval, hcofval)
	Rejected infiltration to MVR/MVT term. More...
subroutine	uze_theq_term (this, ientry, n1, n2, rrate)
	Heat transferred through thermal equilibrium with the solid phase. More...
subroutine	uze_df_obs (this)
	Define UZE Observation. More...
subroutine	uze_rp_obs (this, obsrv, found)
	Process package specific obs. More...
subroutine	uze_bd_obs (this, obstypeid, jj, v, found)
	Calculate observation value and pass it back to APT. More...
subroutine	uze_set_stressperiod (this, itemno, keyword, found)
	Sets the stress period attributes for keyword use. More...

Variables
character(len= *), parameter	ftype = 'UZE'
character(len= *), parameter	flowtype = 'UZF'
character(len=16)	text = ' UZE'

Function/Subroutine Documentation

allocate_scalars()

subroutine gweuzemodule::allocate_scalars

(

class(gweuzetype)

this

)

Allocate scalars specific to UZE package

Definition at line 911 of file gwe-uze.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(GweUzeType) :: this
    ! -- local
    !
    ! -- Allocate scalars in TspAptType
    call this%TspAptType%allocate_scalars()
    !
    ! -- Allocate
    call mem_allocate(this%idxbudinfl, 'IDXBUDINFL', this%memoryPath)
    call mem_allocate(this%idxbudrinf, 'IDXBUDRINF', this%memoryPath)
    call mem_allocate(this%idxbuduzet, 'IDXBUDUZET', this%memoryPath)
    call mem_allocate(this%idxbudritm, 'IDXBUDRITM', this%memoryPath)
    call mem_allocate(this%idxbudtheq, 'IDXBUDTHEQ', this%memoryPath)
    !
    ! -- Initialize
    this%idxbudinfl = 0
    this%idxbudrinf = 0
    this%idxbuduzet = 0
    this%idxbudritm = 0
    this%idxbudtheq = 0

find_uze_package()

subroutine gweuzemodule::find_uze_package

(

class(gweuzetype)

this

)

Definition at line 153 of file gwe-uze.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(GweUzeType) :: this
    ! -- local
    character(len=LINELENGTH) :: errmsg
    class(BndType), pointer :: packobj
    integer(I4B) :: ip, icount
    integer(I4B) :: nbudterm
    logical :: found
    !
    ! -- Initialize found to false, and error later if flow package cannot
    !    be found
    found = .false.
    !
    ! -- If user is specifying flows in a binary budget file, then set up
    !    the budget file reader, otherwise set a pointer to the flow package
    !    budobj
    if (this%fmi%flows_from_file) then
      call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
      if (associated(this%flowbudptr)) found = .true.
      !
    else
      if (associated(this%fmi%gwfbndlist)) then
        ! -- Look through gwfbndlist for a flow package with the same name as
        !    this transport package name
        do ip = 1, this%fmi%gwfbndlist%Count()
          packobj => getbndfromlist(this%fmi%gwfbndlist, ip)
          if (packobj%packName == this%flowpackagename) then
            found = .true.
            !
            ! -- Store BndType pointer to packobj, and then
            !    use the select type to point to the budobj in flow package
            this%flowpackagebnd => packobj
            select type (packobj)
            type is (uzftype)
              this%flowbudptr => packobj%budobj
            end select
          end if
          if (found) exit
        end do
      end if
    end if
    !
    ! -- Error if flow package not found
    if (.not. found) then
      write (errmsg, '(a)') 'Could not find flow package with name '&
                            &//trim(adjustl(this%flowpackagename))//'.'
      call store_error(errmsg)
      call this%parser%StoreErrorUnit()
    end if
    !
    ! -- Allocate space for idxbudssm, which indicates whether this is a
    !    special budget term or one that is a general source and sink
    nbudterm = this%flowbudptr%nbudterm
    call mem_allocate(this%idxbudssm, nbudterm, 'IDXBUDSSM', this%memoryPath)
    !
    ! -- Process budget terms and identify special budget terms
    write (this%iout, '(/, a, a)') &
      'PROCESSING '//ftype//' INFORMATION FOR ', this%packName
    write (this%iout, '(a)') '  IDENTIFYING FLOW TERMS IN '//flowtype//' PACKAGE'
    write (this%iout, '(a, i0)') &
      '  NUMBER OF '//flowtype//' = ', this%flowbudptr%ncv
    icount = 1
    do ip = 1, this%flowbudptr%nbudterm
      select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
      case ('FLOW-JA-FACE')
        this%idxbudfjf = ip
        this%idxbudssm(ip) = 0
      case ('GWF')
        this%idxbudgwf = ip
        this%idxbudssm(ip) = 0
      case ('STORAGE')
        this%idxbudsto = ip
        this%idxbudssm(ip) = 0
      case ('INFILTRATION')
        this%idxbudinfl = ip
        this%idxbudssm(ip) = 0
      case ('REJ-INF')
        this%idxbudrinf = ip
        this%idxbudssm(ip) = 0
      case ('UZET')
        this%idxbuduzet = ip
        this%idxbudssm(ip) = 0
      case ('REJ-INF-TO-MVR')
        this%idxbudritm = ip
        this%idxbudssm(ip) = 0
      case ('TO-MVR')
        this%idxbudtmvr = ip
        this%idxbudssm(ip) = 0
      case ('FROM-MVR')
        this%idxbudfmvr = ip
        this%idxbudssm(ip) = 0
      case ('AUXILIARY')
        this%idxbudaux = ip
        this%idxbudssm(ip) = 0
      case default
        !
        ! -- Set idxbudssm equal to a column index for where the temperatures
        !    are stored in the tempbud(nbudssm, ncv) array
        this%idxbudssm(ip) = icount
        icount = icount + 1
      end select
      !
      write (this%iout, '(a, i0, " = ", a,/, a, i0)') &
        '  TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
        '   MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
    end do
    write (this%iout, '(a, //)') 'DONE PROCESSING '//ftype//' INFORMATION'
    !
    ! -- Thermal equilibration term
    this%idxbudtheq = this%flowbudptr%nbudterm + 1

Here is the call graph for this function:

get_mvr_depvar()

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

(

class(gweuzetype)

this

)

Set the temperature to be used by MVE as the user-specified temperature applied to the infiltration

Definition at line 637 of file gwe-uze.f90.

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

uze_ac()

subroutine gweuzemodule::uze_ac	(	class(gweuzetype), intent(inout)	this,
		integer(i4b), intent(in)	moffset,
		type(sparsematrix), intent(inout)	sparse
	)

Overrides apt_ac to fold the UZE heat balance terms into the row corresponding to the host cell and enforce thermal equilibrium between UZE and the GWE cell.

Parameters

[in]

moffset

current models starting position in global matrix

Definition at line 274 of file gwe-uze.f90.

    use memorymanagermodule, only: mem_setptr
    use sparsemodule, only: sparsematrix
    ! -- dummy
    class(GweUzeType), intent(inout) :: this
    integer(I4B), intent(in) :: moffset !< current models starting position in global matrix
    type(sparsematrix), intent(inout) :: sparse
    ! -- local
    integer(I4B) :: i, ii
    integer(I4B) :: n !< index of a uze object within the complete list of uze objects
    integer(I4B) :: jj !<
    integer(I4B) :: nglo !< index of uze object in global matrix
    integer(I4B) :: jglo !< host cell's position in global matrix for a uze object
    integer(I4B) :: idxn !< used for cross-check
    integer(I4B) :: idxjj !< used for cross-check
    integer(I4B) :: idxnglo !< used for cross-check
    integer(I4B) :: idxjglo !< used for cross-check
    !
    ! -- Add package rows to sparse
    if (this%imatrows /= 0) then
      !
      ! -- Diagonal on the row assoc. with the uze feature
      do n = 1, this%ncv
        nglo = moffset + this%dis%nodes + this%ioffset + n
        call sparse%addconnection(nglo, nglo, 1)
      end do
      !
      ! -- Add uze-to-gwe connections. For uze, this particular do loop
      !    is the same as its counterpart in apt_ac.
      !    nlist: number of gwe cells with a connection to at least one uze object
      do i = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
        n = this%flowbudptr%budterm(this%idxbudgwf)%id1(i) !< uze object position within uze object list
        jj = this%flowbudptr%budterm(this%idxbudgwf)%id2(i) !< position of gwe cell to which uze feature is connected
        nglo = moffset + this%dis%nodes + this%ioffset + n !< uze feature position
        jglo = moffset + jj !< gwe cell position
        call sparse%addconnection(nglo, jglo, 1)
        call sparse%addconnection(jglo, nglo, 1)
      end do
      !
      ! -- For uze, add feature-to-feature connections (i.e.,
      !    vertically stacked UZ objects) to row corresponding
      !    to the host cell. Terms added to the row associated with host
      !    cell are added to columns associated with other uze features.
      !    This approach deviates from the approach taken in apt_ac.
      if (this%idxbudfjf /= 0) then
        do i = 1, this%flowbudptr%budterm(this%idxbudfjf)%maxlist
          n = this%flowbudptr%budterm(this%idxbudfjf)%id1(i) !< position of currently considered uze feature
          jj = this%flowbudptr%budterm(this%idxbudfjf)%id2(i) !< position of connected uze feature
          nglo = moffset + this%dis%nodes + this%ioffset + n !< global position of currently considered uze feature
          jglo = moffset + this%dis%nodes + this%ioffset + jj !< global position of connected uze feature
          ! -- If connected uze feature is upstream, find cell that hosts currently
          !    considered uze feature and add connection to that cell's row
          do ii = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist !< uze object id among uze objects
            idxn = this%flowbudptr%budterm(this%idxbudgwf)%id1(ii) !< uze object position within uze object list
            idxjj = this%flowbudptr%budterm(this%idxbudgwf)%id2(ii) !< position of gwe cell to which uze feature is connected
            idxnglo = moffset + this%dis%nodes + this%ioffset + idxn !< uze feature global position
            idxjglo = moffset + idxjj !< gwe cell global position
            if (nglo == idxnglo) exit
          end do
          call sparse%addconnection(idxjglo, jglo, 1)
        end do
      end if
    end if

uze_allocate_arrays()

subroutine gweuzemodule::uze_allocate_arrays

(

class(gweuzetype), intent(inout)

this

)

Allocate arrays used by the UZE package

Definition at line 940 of file gwe-uze.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(GweUzeType), intent(inout) :: this
    ! -- local
    integer(I4B) :: n
    !
    ! -- Time series
    call mem_allocate(this%tempinfl, this%ncv, 'TEMPINFL', this%memoryPath)
    call mem_allocate(this%tempuzet, this%ncv, 'TEMPUZET', this%memoryPath)
    !
    ! -- Call standard TspAptType allocate arrays
    call this%TspAptType%apt_allocate_arrays()
    !
    ! -- Initialize
    do n = 1, this%ncv
      this%tempinfl(n) = dzero
      this%tempuzet(n) = dzero
    end do

uze_bd_obs()

subroutine gweuzemodule::uze_bd_obs	(	class(gweuzetype), 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 1259 of file gwe-uze.f90.

    ! -- dummy
    class(GweUzeType), intent(inout) :: this
    character(len=*), intent(in) :: obstypeid
    real(DP), intent(inout) :: v
    integer(I4B), intent(in) :: jj
    logical, intent(inout) :: found
    ! -- local
    integer(I4B) :: n1, n2
    !
    found = .true.
    select case (obstypeid)
    case ('INFILTRATION')
      if (this%iboundpak(jj) /= 0 .and. this%idxbudinfl > 0) then
        call this%uze_infl_term(jj, n1, n2, v)
      end if
    case ('REJ-INF')
      if (this%iboundpak(jj) /= 0 .and. this%idxbudrinf > 0) then
        call this%uze_rinf_term(jj, n1, n2, v)
      end if
    case ('UZET')
      if (this%iboundpak(jj) /= 0 .and. this%idxbuduzet > 0) then
        call this%uze_uzet_term(jj, n1, n2, v)
      end if
    case ('REJ-INF-TO-MVR')
      if (this%iboundpak(jj) /= 0 .and. this%idxbudritm > 0) then
        call this%uze_ritm_term(jj, n1, n2, v)
      end if
    case ('THERMAL-EQUIL')
      if (this%iboundpak(jj) /= 0 .and. this%idxbudtheq > 0) then
        call this%uze_theq_term(jj, n1, n2, v)
      end if
    case default
      found = .false.
    end select

uze_create()

subroutine, public gweuzemodule::uze_create	(	class(bndtype), pointer	packobj,
		integer(i4b), intent(in)	id,
		integer(i4b), intent(in)	ibcnum,
		integer(i4b), intent(in)	inunit,
		integer(i4b), intent(in)	iout,
		character(len=*), intent(in)	namemodel,
		character(len=*), intent(in)	pakname,
		type(tspfmitype), pointer	fmi,
		real(dp), intent(in), pointer	eqnsclfac,
		type(gweinputdatatype), intent(in), target	gwecommon,
		character(len=*), intent(in)	dvt,
		character(len=*), intent(in)	dvu,
		character(len=*), intent(in)	dvua
	)

Parameters

[in]	eqnsclfac	governing equation scale factor
[in]	gwecommon	shared data container for use by multiple GWE packages
[in]	dvt	For GWE, set to "TEMPERATURE" in TspAptType
[in]	dvu	For GWE, set to "energy" in TspAptType
[in]	dvua	For GWE, set to "E" in TspAptType

Definition at line 92 of file gwe-uze.f90.

    ! -- dummy
    class(BndType), pointer :: packobj
    integer(I4B), intent(in) :: id
    integer(I4B), intent(in) :: ibcnum
    integer(I4B), intent(in) :: inunit
    integer(I4B), intent(in) :: iout
    character(len=*), intent(in) :: namemodel
    character(len=*), intent(in) :: pakname
    type(TspFmiType), pointer :: fmi
    real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
    type(GweInputDataType), intent(in), target :: gwecommon !< shared data container for use by multiple GWE packages
    character(len=*), intent(in) :: dvt !< For GWE, set to "TEMPERATURE" in TspAptType
    character(len=*), intent(in) :: dvu !< For GWE, set to "energy" in TspAptType
    character(len=*), intent(in) :: dvua !< For GWE, set to "E" in TspAptType
    ! -- local
    type(GweUzeType), pointer :: uzeobj
    !
    ! -- Allocate the object and assign values to object variables
    allocate (uzeobj)
    packobj => uzeobj
    !
    ! -- Create name and memory path
    call packobj%set_names(ibcnum, namemodel, pakname, ftype)
    packobj%text = text
    !
    ! -- Allocate scalars
    call uzeobj%allocate_scalars()
    !
    ! -- Initialize package
    call packobj%pack_initialize()
    !
    packobj%inunit = inunit
    packobj%iout = iout
    packobj%id = id
    packobj%ibcnum = ibcnum
    packobj%ncolbnd = 1
    packobj%iscloc = 1
 
    ! -- Store pointer to flow model interface.  When the GwfGwt exchange is
    !    created, it sets fmi%bndlist so that the GWT model has access to all
    !    the flow packages
    uzeobj%fmi => fmi
    !
    ! -- Store pointer to governing equation scale factor
    uzeobj%eqnsclfac => eqnsclfac
    !
    ! -- Store pointer to shared data module for accessing cpw, rhow
    !    for the budget calculations, and for accessing the latent heat of
    !    vaporization
    uzeobj%gwecommon => gwecommon
    !
    ! -- Set labels that will be used in generalized APT class
    uzeobj%depvartype = dvt
    uzeobj%depvarunit = dvu
    uzeobj%depvarunitabbrev = dvua

Here is the caller graph for this function:

uze_da()

subroutine gweuzemodule::uze_da

(

class(gweuzetype)

this

)

Definition at line 964 of file gwe-uze.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(GweUzeType) :: this
    !
    ! -- Deallocate scalars
    call mem_deallocate(this%idxbudinfl)
    call mem_deallocate(this%idxbudrinf)
    call mem_deallocate(this%idxbuduzet)
    call mem_deallocate(this%idxbudritm)
    call mem_deallocate(this%idxbudtheq)
    !
    ! -- Deallocate time series
    call mem_deallocate(this%tempinfl)
    call mem_deallocate(this%tempuzet)
    !
    ! -- Deallocate scalars in TspAptType
    call this%TspAptType%bnd_da()

uze_df_obs()

subroutine gweuzemodule::uze_df_obs

(

class(gweuzetype)

this

)

This subroutine:

• Stores observation types supported by the parent APT package.
• Overrides BndTypebnd_df_obs

Definition at line 1164 of file gwe-uze.f90.

    ! -- dummy
    class(GweUzeType) :: this
    ! -- local
    integer(I4B) :: indx
    !
    ! -- Store obs type and assign procedure pointer
    !    for temperature observation type.
    call this%obs%StoreObsType('temperature', .false., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
    !
    ! -- Store obs type and assign procedure pointer
    !    for flow between uze cells.
    call this%obs%StoreObsType('flow-ja-face', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid12
    !
    ! -- Store obs type and assign procedure pointer
    !    for from-mvr observation type.
    call this%obs%StoreObsType('from-mvr', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
    !
    ! -- to-mvr not supported for uze
    !call this%obs%StoreObsType('to-mvr', .true., indx)
    !this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
    !
    ! -- Store obs type and assign procedure pointer
    !    for storage observation type.
    call this%obs%StoreObsType('storage', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
    !
    ! -- Store obs type and assign procedure pointer
    !    for constant observation type.
    call this%obs%StoreObsType('constant', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
    !
    ! -- Store obs type and assign procedure pointer
    !    for observation type: uze
    call this%obs%StoreObsType('uze', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
    !
    ! -- Store obs type and assign procedure pointer
    !    for observation type.
    call this%obs%StoreObsType('infiltration', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
    !
    ! -- Store obs type and assign procedure pointer
    !    for observation type.
    call this%obs%StoreObsType('rej-inf', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
    !
    ! -- Store obs type and assign procedure pointer
    !    for observation type.
    call this%obs%StoreObsType('uzet', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
    !
    ! -- Store obs type and assign procedure pointer
    !    for observation type.
    call this%obs%StoreObsType('rej-inf-to-mvr', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
    !
    ! -- Store obs type and assign procedure pointer
    !    for observation type.
    call this%obs%StoreObsType('thermal-equil', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid

Here is the call graph for this function:

uze_fc_expanded()

subroutine gweuzemodule::uze_fc_expanded	(	class(gweuzetype)	this,
		real(dp), dimension(:), intent(inout)	rhs,
		integer(i4b), dimension(:), intent(in)	ia,
		integer(i4b), dimension(:), intent(in)	idxglo,
		class(matrixbasetype), pointer	matrix_sln
	)

This will be called from TspAptTypeapt_fc_expanded() in order to add matrix terms specifically for this package

Definition at line 431 of file gwe-uze.f90.

    ! -- dummy
    class(GweUzeType) :: 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) :: ipossymoffd
    real(DP) :: cold
    real(DP) :: qbnd
    real(DP) :: omega
    real(DP) :: rrate
    real(DP) :: rhsval
    real(DP) :: hcofval
    !
    ! -- Add infiltration contribution
    !    uze does not put feature balance coefficients in the row
    !    associated with the feature.  Instead, these coefficients are
    !    moved into the row associated with cell hosting the uze feature
    if (this%idxbudinfl /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
        call this%uze_infl_term(j, n1, n2, rrate, rhsval, hcofval)
        iloc = this%idxlocnode(n1) !< for uze idxlocnode stores the host cell local row index
        ipossymoffd = this%idxsymoffdglo(j)
        call matrix_sln%add_value_pos(ipossymoffd, hcofval)
        rhs(iloc) = rhs(iloc) + rhsval
      end do
    end if
    !
    ! -- Add rejected infiltration contribution
    if (this%idxbudrinf /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
        call this%uze_rinf_term(j, n1, n2, rrate, rhsval, hcofval)
        iloc = this%idxlocnode(n1) ! for uze idxlocnode stores the host cell local row index
        ipossymoffd = this%idxsymoffdglo(j)
        call matrix_sln%add_value_pos(ipossymoffd, hcofval)
        rhs(iloc) = rhs(iloc) + rhsval
      end do
    end if
    !
    ! -- Add unsaturated et contribution
    if (this%idxbuduzet /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
        call this%uze_uzet_term(j, n1, n2, rrate, rhsval, hcofval)
        iloc = this%idxlocnode(n1) ! for uze idxlocnode stores the host cell local row index
        ipossymoffd = this%idxsymoffdglo(j)
        call matrix_sln%add_value_pos(ipossymoffd, hcofval)
        rhs(iloc) = rhs(iloc) + rhsval
      end do
    end if
    !
    ! -- Add rejected infiltration to mover contribution
    if (this%idxbudritm /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
        call this%uze_ritm_term(j, n1, n2, rrate, rhsval, hcofval)
        iloc = this%idxlocnode(n1) ! for uze idxlocnode stores the host cell local row index
        ipossymoffd = this%idxsymoffdglo(j)
        call matrix_sln%add_value_pos(ipossymoffd, hcofval)
        rhs(iloc) = rhs(iloc) + rhsval
      end do
    end if
    !
    ! -- For UZE, content of apt_fc_expanded placed here as the approach is to
    !    completely override apt_fc_expanded() with what follows
    !
    ! -- Mass (or energy) storage in features
    do n = 1, this%ncv
      cold = this%xoldpak(n)
      iloc = this%idxlocnode(n) ! for uze idxlocnode stores the host cell local row index
      ipossymoffd = this%idxsymoffdglo(n)
      call this%apt_stor_term(n, n1, n2, rrate, rhsval, hcofval)
      call matrix_sln%add_value_pos(ipossymoffd, 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) ! for uze, idxlocnode stores the host cell local row index
        ipossymoffd = this%idxsymoffdglo(j)
        call matrix_sln%add_value_pos(ipossymoffd, 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) ! kluge note: presumably already in terms of energy
        iloc = this%idxlocnode(n) ! for uze idxlocnode stores the host cell local row index
        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
        !
        ! -- This code altered from its counterpart appearing in apt; this equates
        !    uze temperature to cell temperature using the feature's row
        iposd = this%idxdglo(j)
        iposoffd = this%idxoffdglo(j)
        call matrix_sln%add_value_pos(iposd, done)
        call matrix_sln%add_value_pos(iposoffd, -done)
      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
        iposd = this%idxfjfdglo(j) !< position of feature-id1 column in feature id1's host-cell row
        iposoffd = this%idxfjfoffdglo(j) !< position of feature-id2 column in feature id1's host-cell row
        call matrix_sln%add_value_pos(iposd, omega * qbnd * this%eqnsclfac)
        call matrix_sln%add_value_pos(iposoffd, &
                                      (done - omega) * qbnd * this%eqnsclfac)
      end do
    end if

uze_fill_budobj()

subroutine gweuzemodule::uze_fill_budobj	(	class(gweuzetype)	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
	)

Copy flow terms into thisbudobj

Definition at line 738 of file gwe-uze.f90.

    ! -- modules
    ! -- dummy
    class(GweUzeType) :: 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
    integer(I4B) :: j, n1, n2, indx
    integer(I4B) :: nlist, nlen
    integer(I4B) :: igwfnode
    integer(I4B) :: idiag
    real(DP) :: q
    real(DP), dimension(:), allocatable :: budresid
    !
    allocate (budresid(this%ncv))
    do n1 = 1, this%ncv
      budresid(n1) = dzero
    end do
    !
    indx = 0
    !
    ! -- FLOW JA FACE into budresid
    nlen = 0
    if (this%idxbudfjf /= 0) then
      nlen = this%flowbudptr%budterm(this%idxbudfjf)%maxlist
    end if
    if (nlen > 0) then
      indx = indx + 1
      nlist = this%budobj%budterm(indx)%nlist
      do j = 1, nlist
        n1 = this%budobj%budterm(indx)%id1(j)
        n2 = this%budobj%budterm(indx)%id2(j)
        if (n1 < n2) then
          q = this%budobj%budterm(indx)%flow(j)
          budresid(n1) = budresid(n1) + q
          budresid(n2) = budresid(n2) - q
        end if
      end do
    end if
    !
    ! -- GWF (LEAKAGE) into budresid
    indx = indx + 1
    nlist = this%budobj%budterm(indx)%nlist
    do j = 1, nlist
      n1 = this%budobj%budterm(indx)%id1(j)
      q = this%budobj%budterm(indx)%flow(j)
      budresid(n1) = budresid(n1) + q
    end do
    !
    ! -- Skip individual package terms
    indx = this%idxlastpak
    !
    ! -- STORAGE into budresid
    indx = indx + 1
    do n1 = 1, this%ncv
      q = this%budobj%budterm(indx)%flow(n1)
      budresid(n1) = budresid(n1) + q
    end do
    !
    ! -- TO MOVER into budresid
    if (this%idxbudtmvr /= 0) then
      indx = indx + 1
      nlist = this%budobj%budterm(indx)%nlist
      do j = 1, nlist
        n1 = this%budobj%budterm(indx)%id1(j)
        q = this%budobj%budterm(indx)%flow(j)
        budresid(n1) = budresid(n1) + q
      end do
    end if
    !
    ! -- FROM MOVER into budresid
    if (this%idxbudfmvr /= 0) then
      indx = indx + 1
      nlist = this%budobj%budterm(indx)%nlist
      do j = 1, nlist
        n1 = this%budobj%budterm(indx)%id1(j)
        q = this%budobj%budterm(indx)%flow(j)
        budresid(n1) = budresid(n1) + q
      end do
    end if
    !
    ! -- CONSTANT FLOW into budresid
    indx = indx + 1
    do n1 = 1, this%ncv
      q = this%budobj%budterm(indx)%flow(n1)
      budresid(n1) = budresid(n1) + q
    end do
    !
    ! -- AUXILIARY VARIABLES into budresid
    ! -- (No flows associated with these)
    !
    ! -- Individual package terms processed last
    !
    ! -- Infiltration
    idx = idx + 1
    nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist
    call this%budobj%budterm(idx)%reset(nlist)
    do j = 1, nlist
      call this%uze_infl_term(j, n1, n2, q)
      call this%budobj%budterm(idx)%update_term(n1, n2, q)
      call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
      budresid(n1) = budresid(n1) + q
    end do
    !
    ! -- Rej-Inf
    if (this%idxbudrinf /= 0) then
      idx = idx + 1
      nlist = this%flowbudptr%budterm(this%idxbudrinf)%nlist
      call this%budobj%budterm(idx)%reset(nlist)
      do j = 1, nlist
        call this%uze_rinf_term(j, n1, n2, q)
        call this%budobj%budterm(idx)%update_term(n1, n2, q)
        call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
        budresid(n1) = budresid(n1) + q
      end do
    end if
    !
    ! -- UZET
    if (this%idxbuduzet /= 0) then
      idx = idx + 1
      nlist = this%flowbudptr%budterm(this%idxbuduzet)%nlist
      call this%budobj%budterm(idx)%reset(nlist)
      do j = 1, nlist
        call this%uze_uzet_term(j, n1, n2, q)
        call this%budobj%budterm(idx)%update_term(n1, n2, q)
        call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
        budresid(n1) = budresid(n1) + q
      end do
    end if
    !
    ! -- Rej-Inf-To-MVR
    if (this%idxbudritm /= 0) then
      idx = idx + 1
      nlist = this%flowbudptr%budterm(this%idxbudritm)%nlist
      call this%budobj%budterm(idx)%reset(nlist)
      do j = 1, nlist
        call this%uze_ritm_term(j, n1, n2, q)
        call this%budobj%budterm(idx)%update_term(n1, n2, q)
        call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
        budresid(n1) = budresid(n1) + q
      end do
    end if
    !
    ! -- Thermal-Equil
    ! -- processed last because it is calculated from the residual
    idx = idx + 1
    nlist = this%flowbudptr%budterm(this%idxbudgwf)%nlist
    call this%budobj%budterm(idx)%reset(nlist)
    do j = 1, nlist
      n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
      igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(j)
      q = -budresid(n1)
      call this%uze_theq_term(j, n1, igwfnode, q)
      call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
      call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
      if (this%iboundpak(n1) /= 0) then
        ! -- Contribution to gwe cell budget
        this%simvals(n1) = this%simvals(n1) - q
        idiag = this%dis%con%ia(igwfnode)
        flowja(idiag) = flowja(idiag) - q
      end if
    end do
    !
    deallocate (budresid)

uze_get_nbudterms()

integer(i4b) function gweuzemodule::uze_get_nbudterms

(

class(gweuzetype)

this

)

Function to return the number of budget terms just for this package. This overrides function in parent.

Definition at line 617 of file gwe-uze.f90.

    ! -- dummy
    class(GweUzeType) :: this
    ! -- Return
    integer(I4B) :: nbudterms
    !
    ! -- Number of budget terms is 5
    nbudterms = 0
    if (this%idxbudinfl /= 0) nbudterms = nbudterms + 1
    if (this%idxbudrinf /= 0) nbudterms = nbudterms + 1
    if (this%idxbuduzet /= 0) nbudterms = nbudterms + 1
    if (this%idxbudritm /= 0) nbudterms = nbudterms + 1
    if (this%idxbudtheq /= 0) nbudterms = nbudterms + 1

uze_infl_term()

subroutine gweuzemodule::uze_infl_term	(	class(gweuzetype)	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
	)

Accounts for energy added to the subsurface via infiltration, for example, energy entering the model domain via rainfall or irrigation.

Definition at line 990 of file gwe-uze.f90.

    ! -- dummy
    class(GweUzeType) :: 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
    real(DP) :: h, r
    !
    n1 = this%flowbudptr%budterm(this%idxbudinfl)%id1(ientry)
    n2 = this%flowbudptr%budterm(this%idxbudinfl)%id2(ientry)
    !
    ! -- Note that qbnd is negative for negative infiltration
    qbnd = this%flowbudptr%budterm(this%idxbudinfl)%flow(ientry)
    if (qbnd < dzero) then
      ctmp = this%xnewpak(n1)
      h = qbnd
      r = dzero
    else
      ctmp = this%tempinfl(n1)
      h = dzero
      r = -qbnd * ctmp
    end if
    if (present(rrate)) rrate = qbnd * ctmp * this%eqnsclfac
    if (present(rhsval)) rhsval = r * this%eqnsclfac
    if (present(hcofval)) hcofval = h * this%eqnsclfac

uze_mc()

subroutine gweuzemodule::uze_mc	(	class(gweuzetype), intent(inout)	this,
		integer(i4b), intent(in)	moffset,
		class(matrixbasetype), pointer	matrix_sln
	)

Definition at line 341 of file gwe-uze.f90.

    use sparsemodule, only: sparsematrix
    ! -- dummy
    class(GweUzeType), intent(inout) :: this
    integer(I4B), intent(in) :: moffset
    class(MatrixBaseType), pointer :: matrix_sln
    ! -- local
    integer(I4B) :: n, j, iglo, jglo
    integer(I4B) :: idxn, idxj, idxiglo, idxjglo
    integer(I4B) :: ipos, idxpos
    !
    ! -- 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
      !
      ! -- Feature diagonal in global matrix
      do n = 1, this%ncv
        iglo = moffset + this%dis%nodes + this%ioffset + n
        this%idxpakdiag(n) = matrix_sln%get_position_diag(iglo)
      end do
      !
      ! -- Cell to feature connection in global matrix
      do ipos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
        n = this%flowbudptr%budterm(this%idxbudgwf)%id1(ipos) !< feature number
        j = this%flowbudptr%budterm(this%idxbudgwf)%id2(ipos) !< cell number
        iglo = moffset + this%dis%nodes + this%ioffset + n !< feature row index
        jglo = j + moffset !< cell row index
        ! -- Note that this is where idxlocnode is set for uze; it is set
        !    to the host cell local row index rather than the feature local
        !    row index
        this%idxlocnode(n) = j ! kluge note: do we want to introduce a new array instead of co-opting idxlocnode???
        ! -- For connection ipos in list of feature-cell connections,
        !    global positions of feature-row diagonal and off-diagonal
        !    corresponding to the cell
        this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
        this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
      end do
      !
      ! -- Feature to cell connection in global matrix
      do ipos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
        n = this%flowbudptr%budterm(this%idxbudgwf)%id1(ipos) !< feature number
        j = this%flowbudptr%budterm(this%idxbudgwf)%id2(ipos) !< cell number
        iglo = j + moffset !< cell row index
        jglo = moffset + this%dis%nodes + this%ioffset + n !< feature row index
        ! -- For connection ipos in list of feature-cell connections,
        !    global positions of cell-row diagonal and off-diagonal
        !    corresponding to the feature
        this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
        this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
      end do
      !
      ! -- Feature to feature connection in global matrix
      if (this%idxbudfjf /= 0) then
        do ipos = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
          n = this%flowbudptr%budterm(this%idxbudfjf)%id1(ipos) !< number of currently considered uze feature
          j = this%flowbudptr%budterm(this%idxbudfjf)%id2(ipos) !< number of connected uze feature
          iglo = moffset + this%dis%nodes + this%ioffset + n !< global position of currently considered uze feature
          jglo = moffset + this%dis%nodes + this%ioffset + j !< global position of connected uze feature
          ! -- If connected uze feature is upstream, find cell that hosts currently
          !    considered uze feature and map connection to that cell's row
          do idxpos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
            idxn = this%flowbudptr%budterm(this%idxbudgwf)%id1(idxpos) !< feature number
            idxj = this%flowbudptr%budterm(this%idxbudgwf)%id2(idxpos) !< cell number)
            idxjglo = moffset + this%dis%nodes + this%ioffset + idxn !< feature row index
            idxiglo = moffset + idxj !< cell row index
            if (idxjglo == iglo) exit
          end do
          ! -- For connection ipos in list of feature-feature connections,
          !    global positions of host-cell-row entries corresponding to
          !    (in the same columns as) the feature-id1-row diagonal and the
          !    feature-id1-row off-diagonal corresponding to feature id2
          this%idxfjfdglo(ipos) = matrix_sln%get_position_diag(idxiglo)
          this%idxfjfoffdglo(ipos) = matrix_sln%get_position(idxiglo, jglo)
        end do
      end if
    end if

uze_rinf_term()

subroutine gweuzemodule::uze_rinf_term	(	class(gweuzetype)	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
	)

Accounts for energy that is added to the model from specifying an infiltration rate and temperature, but is subsequently removed from the model as that portion of the infiltration that is rejected (and NOT transferred to another advanced package via the MVR/MVT packages).

Definition at line 1031 of file gwe-uze.f90.

    ! -- dummy
    class(GweUzeType) :: 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%idxbudrinf)%id1(ientry)
    n2 = this%flowbudptr%budterm(this%idxbudrinf)%id2(ientry)
    qbnd = this%flowbudptr%budterm(this%idxbudrinf)%flow(ientry)
    ctmp = this%tempinfl(n1)
    if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
    if (present(rhsval)) rhsval = dzero
    if (present(hcofval)) hcofval = qbnd * this%eqnsclfac

uze_ritm_term()

subroutine gweuzemodule::uze_ritm_term	(	class(gweuzetype)	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
	)

Accounts for energy that is added to the model from specifying an infiltration rate and temperature, but does not infiltrate into the subsurface. This subroutine is called when the rejected infiltration is transferred to another advanced package via the MVR/MVT packages.

Definition at line 1098 of file gwe-uze.f90.

    ! -- dummy
    class(GweUzeType) :: 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%idxbudritm)%id1(ientry)
    n2 = this%flowbudptr%budterm(this%idxbudritm)%id2(ientry)
    qbnd = this%flowbudptr%budterm(this%idxbudritm)%flow(ientry)
    ctmp = this%tempinfl(n1)
    if (present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
    if (present(rhsval)) rhsval = dzero
    if (present(hcofval)) hcofval = qbnd * this%eqnsclfac

uze_rp_obs()

subroutine gweuzemodule::uze_rp_obs	(	class(gweuzetype), 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 1234 of file gwe-uze.f90.

    ! -- dummy
    class(GweUzeType), intent(inout) :: this !< package class
    type(ObserveType), intent(inout) :: obsrv !< observation object
    logical, intent(inout) :: found !< indicate whether observation was found
    !
    found = .true.
    select case (obsrv%ObsTypeId)
    case ('INFILTRATION')
      call this%rp_obs_byfeature(obsrv)
    case ('REJ-INF')
      call this%rp_obs_byfeature(obsrv)
    case ('UZET')
      call this%rp_obs_byfeature(obsrv)
    case ('REJ-INF-TO-MVR')
      call this%rp_obs_byfeature(obsrv)
    case ('THERMAL-EQUIL')
      call this%rp_obs_byfeature(obsrv)
    case default
      found = .false.
    end select

uze_set_stressperiod()

subroutine gweuzemodule::uze_set_stressperiod	(	class(gweuzetype), intent(inout)	this,
		integer(i4b), intent(in)	itemno,
		character(len=*), intent(in)	keyword,
		logical, intent(inout)	found
	)

Definition at line 1298 of file gwe-uze.f90.

    ! -- modules
    use timeseriesmanagermodule, only: read_value_or_time_series_adv
    ! -- dummy
    class(GweUzeType), intent(inout) :: this
    integer(I4B), intent(in) :: itemno
    character(len=*), intent(in) :: keyword
    logical, intent(inout) :: found
    ! -- local
    character(len=LINELENGTH) :: temp_text
    integer(I4B) :: ierr
    integer(I4B) :: jj
    real(DP), pointer :: bndElem => null()
    !
    ! INFILTRATION <infiltration>
    ! UZET <uzet>
    !
    found = .true.
    select case (keyword)
    case ('INFILTRATION')
      ierr = this%apt_check_valid(itemno)
      if (ierr /= 0) then
        goto 999
      end if
      call this%parser%GetString(temp_text)
      jj = 1
      bndelem => this%tempinfl(itemno)
      call read_value_or_time_series_adv(temp_text, itemno, jj, bndelem, &
                                         this%packName, 'BND', this%tsManager, &
                                         this%iprpak, 'INFILTRATION')
    case ('UZET')
      ierr = this%apt_check_valid(itemno)
      if (ierr /= 0) then
        goto 999
      end if
      call this%parser%GetString(temp_text)
      jj = 1
      bndelem => this%tempuzet(itemno)
      call read_value_or_time_series_adv(temp_text, itemno, jj, bndelem, &
                                         this%packName, 'BND', this%tsManager, &
                                         this%iprpak, 'UZET')
    case default
      !
      ! -- Keyword not recognized so return to caller with found = .false.
      found = .false.
    end select
    !
999 continue

Here is the call graph for this function:

uze_setup_budobj()

subroutine gweuzemodule::uze_setup_budobj	(	class(gweuzetype)	this,
		integer(i4b), intent(inout)	idx
	)

Set up the budget object that stores all the unsaturated-zone flows

Definition at line 651 of file gwe-uze.f90.

    ! -- modules
    use constantsmodule, only: lenbudtxt
    ! -- dummy
    class(GweUzeType) :: this
    integer(I4B), intent(inout) :: idx
    ! -- local
    integer(I4B) :: maxlist, naux
    character(len=LENBUDTXT) :: text
    !
    ! -- Infiltration
    text = '    INFILTRATION'
    idx = idx + 1
    maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist
    naux = 0
    call this%budobj%budterm(idx)%initialize(text, &
                                             this%name_model, &
                                             this%packName, &
                                             this%name_model, &
                                             this%packName, &
                                             maxlist, .false., .false., &
                                             naux)
    !
    ! -- Rejected infiltration (Hortonian flow)
    if (this%idxbudrinf /= 0) then
      text = '         REJ-INF'
      idx = idx + 1
      maxlist = this%flowbudptr%budterm(this%idxbudrinf)%maxlist
      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
    !
    ! -- Evapotranspiration from the unsaturated zone
    if (this%idxbuduzet /= 0) then
      text = '            UZET'
      idx = idx + 1
      maxlist = this%flowbudptr%budterm(this%idxbuduzet)%maxlist
      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
    !
    ! -- Rejected infiltration that is subsequently transferred by MVR
    if (this%idxbudritm /= 0) then
      text = '  INF-REJ-TO-MVR'
      idx = idx + 1
      maxlist = this%flowbudptr%budterm(this%idxbudritm)%maxlist
      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
    !
    ! -- Energy transferred to solid phase by the thermal equilibrium assumption
    text = '   THERMAL-EQUIL'
    idx = idx + 1
    ! -- use dimension of GWF term
    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%packName, &
                                             maxlist, .false., .false., &
                                             naux)

uze_solve()

subroutine gweuzemodule::uze_solve

(

class(gweuzetype)

this

)

There should be no explicit solve for uze. However, if there were, then this subroutine would add terms specific to the unsaturated zone to the explicit unsaturated-zone solve

Definition at line 571 of file gwe-uze.f90.

    ! -- dummy
    class(GweUzeType) :: this
    ! -- local
    integer(I4B) :: j
    integer(I4B) :: n1, n2
    real(DP) :: rrate
    !
    ! -- Add infiltration contribution
    if (this%idxbudinfl /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
        call this%uze_infl_term(j, n1, n2, rrate)
        this%dbuff(n1) = this%dbuff(n1) + rrate
      end do
    end if
    !
    ! -- Add rejected infiltration contribution
    if (this%idxbudrinf /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
        call this%uze_rinf_term(j, n1, n2, rrate)
        this%dbuff(n1) = this%dbuff(n1) + rrate
      end do
    end if
    !
    ! -- Add unsaturated et contribution
    if (this%idxbuduzet /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
        call this%uze_uzet_term(j, n1, n2, rrate)
        this%dbuff(n1) = this%dbuff(n1) + rrate
      end do
    end if
    !
    ! -- Add rejected infiltration to mover contribution
    if (this%idxbudritm /= 0) then
      do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
        call this%uze_ritm_term(j, n1, n2, rrate)
        this%dbuff(n1) = this%dbuff(n1) + rrate
      end do
    end if

uze_theq_term()

subroutine gweuzemodule::uze_theq_term	(	class(gweuzetype)	this,
		integer(i4b), intent(in)	ientry,
		integer(i4b), intent(inout)	n1,
		integer(i4b), intent(inout)	n2,
		real(dp), intent(inout)	rrate
	)

Accounts for the transfer of energy from the liquid phase to the solid phase as a result of the instantaneous thermal equilibrium assumption.

Definition at line 1126 of file gwe-uze.f90.

    ! -- modules
    use constantsmodule, only: lenbudtxt
    ! -- dummy
    class(GweUzeType) :: this
    integer(I4B), intent(in) :: ientry
    integer(I4B), intent(inout) :: n1
    integer(I4B), intent(inout) :: n2
    real(DP), intent(inout) :: rrate
    ! -- local
    real(DP) :: r
    integer(I4B) :: i
    character(len=LENBUDTXT) :: flowtype
    !
    r = dzero
    n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(ientry)
    n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(ientry)
    if (this%iboundpak(n1) /= 0) then
      do i = 1, this%budobj%nbudterm
        flowtype = this%budobj%budterm(i)%flowtype
        select case (trim(adjustl(flowtype)))
        case ('THERMAL-EQUIL')
          ! -- Skip
          continue
        case default
          r = r - this%budobj%budterm(i)%flow(ientry)
        end select
      end do
    end if
    rrate = r

uze_uzet_term()

subroutine gweuzemodule::uze_uzet_term	(	class(gweuzetype)	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
	)

Accounts for thermal cooling in the unsaturated zone as a result of evapotranspiration from the unsaturated zone. Amount of water converted to vapor phase (UZET) determined by GWF model

Definition at line 1060 of file gwe-uze.f90.

    ! -- dummy
    class(GweUzeType) :: 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
    real(DP) :: omega
    !
    n1 = this%flowbudptr%budterm(this%idxbuduzet)%id1(ientry)
    n2 = this%flowbudptr%budterm(this%idxbuduzet)%id2(ientry)
    ! -- Note that qbnd is negative for uzet
    qbnd = this%flowbudptr%budterm(this%idxbuduzet)%flow(ientry)
    ctmp = this%tempuzet(n1)
    if (this%xnewpak(n1) < ctmp) then
      omega = done
    else
      omega = dzero
    end if
    if (present(rrate)) &
      rrate = (omega * qbnd * this%xnewpak(n1) + &
               (done - omega) * qbnd * ctmp) * this%eqnsclfac
    if (present(rhsval)) rhsval = -(done - omega) * qbnd * ctmp * this%eqnsclfac
    if (present(hcofval)) hcofval = omega * qbnd * this%eqnsclfac

Variable Documentation

flowtype

character(len=*), parameter gweuzemodule::flowtype = 'UZF'

Definition at line 46 of file gwe-uze.f90.

  character(len=*), parameter :: flowtype = 'UZF'

ftype

character(len=*), parameter gweuzemodule::ftype = 'UZE'

Definition at line 45 of file gwe-uze.f90.

  character(len=*), parameter :: ftype = 'UZE'

text

character(len=16) gweuzemodule::text = ' UZE'

Definition at line 47 of file gwe-uze.f90.

  character(len=16) :: text = '             UZE'