43 character(len=*),
parameter ::
ftype =
'UZT'
44 character(len=*),
parameter ::
flowtype =
'UZF'
45 character(len=16) ::
text =
' UZT'
49 integer(I4B),
pointer :: idxbudinfl => null()
50 integer(I4B),
pointer :: idxbudrinf => null()
51 integer(I4B),
pointer :: idxbuduzet => null()
52 integer(I4B),
pointer :: idxbudritm => null()
53 real(dp),
dimension(:),
pointer,
contiguous :: concinfl => null()
54 real(dp),
dimension(:),
pointer,
contiguous :: concuzet => null()
83 subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
84 fmi, eqnsclfac, dvt, dvu, dvua)
86 class(
bndtype),
pointer :: packobj
87 integer(I4B),
intent(in) :: id
88 integer(I4B),
intent(in) :: ibcnum
89 integer(I4B),
intent(in) :: inunit
90 integer(I4B),
intent(in) :: iout
91 character(len=*),
intent(in) :: namemodel
92 character(len=*),
intent(in) :: pakname
94 real(dp),
intent(in),
pointer :: eqnsclfac
95 character(len=*),
intent(in) :: dvt
96 character(len=*),
intent(in) :: dvu
97 character(len=*),
intent(in) :: dvua
106 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
110 call uztobj%allocate_scalars()
113 call packobj%pack_initialize()
115 packobj%inunit = inunit
118 packobj%ibcnum = ibcnum
128 uztobj%eqnsclfac => eqnsclfac
131 uztobj%depvartype = dvt
132 uztobj%depvarunit = dvu
133 uztobj%depvarunitabbrev = dvua
144 character(len=LINELENGTH) :: errmsg
145 class(
bndtype),
pointer :: packobj
146 integer(I4B) :: ip, icount
147 integer(I4B) :: nbudterm
157 if (this%fmi%flows_from_file)
then
158 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
159 if (
associated(this%flowbudptr)) found = .true.
162 if (
associated(this%fmi%gwfbndlist))
then
165 do ip = 1, this%fmi%gwfbndlist%Count()
167 if (packobj%packName == this%flowpackagename)
then
172 this%flowpackagebnd => packobj
173 select type (packobj)
175 this%flowbudptr => packobj%budobj
184 if (.not. found)
then
185 write (errmsg,
'(a)')
'Could not find flow package with name '&
186 &//trim(adjustl(this%flowpackagename))//
'.'
188 call this%parser%StoreErrorUnit()
193 nbudterm = this%flowbudptr%nbudterm
194 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
197 write (this%iout,
'(/, a, a)') &
198 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
199 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
200 write (this%iout,
'(a, i0)') &
201 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
203 do ip = 1, this%flowbudptr%nbudterm
204 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
205 case (
'FLOW-JA-FACE')
207 this%idxbudssm(ip) = 0
210 this%idxbudssm(ip) = 0
213 this%idxbudssm(ip) = 0
214 case (
'INFILTRATION')
216 this%idxbudssm(ip) = 0
219 this%idxbudssm(ip) = 0
222 this%idxbudssm(ip) = 0
223 case (
'REJ-INF-TO-MVR')
225 this%idxbudssm(ip) = 0
228 this%idxbudssm(ip) = 0
231 this%idxbudssm(ip) = 0
234 this%idxbudssm(ip) = 0
239 this%idxbudssm(ip) = icount
242 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
243 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
244 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
246 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
258 real(DP),
dimension(:),
intent(inout) :: rhs
259 integer(I4B),
dimension(:),
intent(in) :: ia
260 integer(I4B),
dimension(:),
intent(in) :: idxglo
263 integer(I4B) :: j, n1, n2
265 integer(I4B) :: iposd
271 if (this%idxbudinfl /= 0)
then
272 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
273 call this%uzt_infl_term(j, n1, n2, rrate, rhsval, hcofval)
274 iloc = this%idxlocnode(n1)
275 iposd = this%idxpakdiag(n1)
276 call matrix_sln%add_value_pos(iposd, hcofval)
277 rhs(iloc) = rhs(iloc) + rhsval
282 if (this%idxbudrinf /= 0)
then
283 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
284 call this%uzt_rinf_term(j, n1, n2, rrate, rhsval, hcofval)
285 iloc = this%idxlocnode(n1)
286 iposd = this%idxpakdiag(n1)
287 call matrix_sln%add_value_pos(iposd, hcofval)
288 rhs(iloc) = rhs(iloc) + rhsval
293 if (this%idxbuduzet /= 0)
then
294 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
295 call this%uzt_uzet_term(j, n1, n2, rrate, rhsval, hcofval)
296 iloc = this%idxlocnode(n1)
297 iposd = this%idxpakdiag(n1)
298 call matrix_sln%add_value_pos(iposd, hcofval)
299 rhs(iloc) = rhs(iloc) + rhsval
304 if (this%idxbudritm /= 0)
then
305 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
306 call this%uzt_ritm_term(j, n1, n2, rrate, rhsval, hcofval)
307 iloc = this%idxlocnode(n1)
308 iposd = this%idxpakdiag(n1)
309 call matrix_sln%add_value_pos(iposd, hcofval)
310 rhs(iloc) = rhs(iloc) + rhsval
324 integer(I4B) :: n1, n2
328 if (this%idxbudinfl /= 0)
then
329 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
330 call this%uzt_infl_term(j, n1, n2, rrate)
331 this%dbuff(n1) = this%dbuff(n1) + rrate
336 if (this%idxbudrinf /= 0)
then
337 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
338 call this%uzt_rinf_term(j, n1, n2, rrate)
339 this%dbuff(n1) = this%dbuff(n1) + rrate
344 if (this%idxbuduzet /= 0)
then
345 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
346 call this%uzt_uzet_term(j, n1, n2, rrate)
347 this%dbuff(n1) = this%dbuff(n1) + rrate
352 if (this%idxbudritm /= 0)
then
353 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
354 call this%uzt_ritm_term(j, n1, n2, rrate)
355 this%dbuff(n1) = this%dbuff(n1) + rrate
369 integer(I4B) :: nbudterms
374 if (this%idxbudinfl /= 0) nbudterms = nbudterms + 1
375 if (this%idxbudrinf /= 0) nbudterms = nbudterms + 1
376 if (this%idxbuduzet /= 0) nbudterms = nbudterms + 1
377 if (this%idxbudritm /= 0) nbudterms = nbudterms + 1
401 integer(I4B),
intent(inout) :: idx
403 integer(I4B) :: maxlist, naux
404 character(len=LENBUDTXT) :: text
407 text =
' INFILTRATION'
409 maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist
411 call this%budobj%budterm(idx)%initialize(text, &
416 maxlist, .false., .false., &
420 if (this%idxbudrinf /= 0)
then
423 maxlist = this%flowbudptr%budterm(this%idxbudrinf)%maxlist
425 call this%budobj%budterm(idx)%initialize(text, &
430 maxlist, .false., .false., &
435 if (this%idxbuduzet /= 0)
then
438 maxlist = this%flowbudptr%budterm(this%idxbuduzet)%maxlist
440 call this%budobj%budterm(idx)%initialize(text, &
445 maxlist, .false., .false., &
450 if (this%idxbudritm /= 0)
then
451 text =
' INF-REJ-TO-MVR'
453 maxlist = this%flowbudptr%budterm(this%idxbudritm)%maxlist
455 call this%budobj%budterm(idx)%initialize(text, &
460 maxlist, .false., .false., &
470 integer(I4B),
intent(inout) :: idx
471 real(DP),
dimension(:),
intent(in) :: x
472 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
473 real(DP),
intent(inout) :: ccratin
474 real(DP),
intent(inout) :: ccratout
476 integer(I4B) :: j, n1, n2
477 integer(I4B) :: nlist
483 nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist
484 call this%budobj%budterm(idx)%reset(nlist)
486 call this%uzt_infl_term(j, n1, n2, q)
487 call this%budobj%budterm(idx)%update_term(n1, n2, q)
488 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
492 if (this%idxbudrinf /= 0)
then
494 nlist = this%flowbudptr%budterm(this%idxbudrinf)%nlist
495 call this%budobj%budterm(idx)%reset(nlist)
497 call this%uzt_rinf_term(j, n1, n2, q)
498 call this%budobj%budterm(idx)%update_term(n1, n2, q)
499 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
504 if (this%idxbuduzet /= 0)
then
506 nlist = this%flowbudptr%budterm(this%idxbuduzet)%nlist
507 call this%budobj%budterm(idx)%reset(nlist)
509 call this%uzt_uzet_term(j, n1, n2, q)
510 call this%budobj%budterm(idx)%update_term(n1, n2, q)
511 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
516 if (this%idxbudritm /= 0)
then
518 nlist = this%flowbudptr%budterm(this%idxbudritm)%nlist
519 call this%budobj%budterm(idx)%reset(nlist)
521 call this%uzt_ritm_term(j, n1, n2, q)
522 call this%budobj%budterm(idx)%update_term(n1, n2, q)
523 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
540 call this%TspAptType%allocate_scalars()
543 call mem_allocate(this%idxbudinfl,
'IDXBUDINFL', this%memoryPath)
544 call mem_allocate(this%idxbudrinf,
'IDXBUDRINF', this%memoryPath)
545 call mem_allocate(this%idxbuduzet,
'IDXBUDUZET', this%memoryPath)
546 call mem_allocate(this%idxbudritm,
'IDXBUDRITM', this%memoryPath)
568 call mem_allocate(this%concinfl, this%ncv,
'CONCINFL', this%memoryPath)
569 call mem_allocate(this%concuzet, this%ncv,
'CONCUZET', this%memoryPath)
572 call this%TspAptType%apt_allocate_arrays()
576 this%concinfl(n) =
dzero
577 this%concuzet(n) =
dzero
603 call this%TspAptType%bnd_da()
615 integer(I4B),
intent(in) :: ientry
616 integer(I4B),
intent(inout) :: n1
617 integer(I4B),
intent(inout) :: n2
618 real(DP),
intent(inout),
optional :: rrate
619 real(DP),
intent(inout),
optional :: rhsval
620 real(DP),
intent(inout),
optional :: hcofval
626 n1 = this%flowbudptr%budterm(this%idxbudinfl)%id1(ientry)
627 n2 = this%flowbudptr%budterm(this%idxbudinfl)%id2(ientry)
629 qbnd = this%flowbudptr%budterm(this%idxbudinfl)%flow(ientry)
630 if (qbnd <
dzero)
then
631 ctmp = this%xnewpak(n1)
635 ctmp = this%concinfl(n1)
639 if (
present(rrate)) rrate = qbnd * ctmp
640 if (
present(rhsval)) rhsval = r
641 if (
present(hcofval)) hcofval = h
655 integer(I4B),
intent(in) :: ientry
656 integer(I4B),
intent(inout) :: n1
657 integer(I4B),
intent(inout) :: n2
658 real(DP),
intent(inout),
optional :: rrate
659 real(DP),
intent(inout),
optional :: rhsval
660 real(DP),
intent(inout),
optional :: hcofval
665 n1 = this%flowbudptr%budterm(this%idxbudrinf)%id1(ientry)
666 n2 = this%flowbudptr%budterm(this%idxbudrinf)%id2(ientry)
667 qbnd = this%flowbudptr%budterm(this%idxbudrinf)%flow(ientry)
668 ctmp = this%concinfl(n1)
669 if (
present(rrate)) rrate = ctmp * qbnd
670 if (
present(rhsval)) rhsval =
dzero
671 if (
present(hcofval)) hcofval = qbnd
683 integer(I4B),
intent(in) :: ientry
684 integer(I4B),
intent(inout) :: n1
685 integer(I4B),
intent(inout) :: n2
686 real(DP),
intent(inout),
optional :: rrate
687 real(DP),
intent(inout),
optional :: rhsval
688 real(DP),
intent(inout),
optional :: hcofval
694 n1 = this%flowbudptr%budterm(this%idxbuduzet)%id1(ientry)
695 n2 = this%flowbudptr%budterm(this%idxbuduzet)%id2(ientry)
697 qbnd = this%flowbudptr%budterm(this%idxbuduzet)%flow(ientry)
698 ctmp = this%concuzet(n1)
699 if (this%xnewpak(n1) < ctmp)
then
704 if (
present(rrate)) &
705 rrate = omega * qbnd * this%xnewpak(n1) + &
706 (
done - omega) * qbnd * ctmp
707 if (
present(rhsval)) rhsval = -(
done - omega) * qbnd * ctmp
708 if (
present(hcofval)) hcofval = omega * qbnd
722 integer(I4B),
intent(in) :: ientry
723 integer(I4B),
intent(inout) :: n1
724 integer(I4B),
intent(inout) :: n2
725 real(DP),
intent(inout),
optional :: rrate
726 real(DP),
intent(inout),
optional :: rhsval
727 real(DP),
intent(inout),
optional :: hcofval
732 n1 = this%flowbudptr%budterm(this%idxbudritm)%id1(ientry)
733 n2 = this%flowbudptr%budterm(this%idxbudritm)%id2(ientry)
734 qbnd = this%flowbudptr%budterm(this%idxbudritm)%flow(ientry)
735 ctmp = this%concinfl(n1)
736 if (
present(rrate)) rrate = ctmp * qbnd
737 if (
present(rhsval)) rhsval =
dzero
738 if (
present(hcofval)) hcofval = qbnd
756 call this%obs%StoreObsType(
'concentration', .false., indx)
761 call this%obs%StoreObsType(
'flow-ja-face', .true., indx)
766 call this%obs%StoreObsType(
'from-mvr', .true., indx)
775 call this%obs%StoreObsType(
'storage', .true., indx)
780 call this%obs%StoreObsType(
'constant', .true., indx)
785 call this%obs%StoreObsType(
'uzt', .true., indx)
790 call this%obs%StoreObsType(
'infiltration', .true., indx)
795 call this%obs%StoreObsType(
'rej-inf', .true., indx)
800 call this%obs%StoreObsType(
'uzet', .true., indx)
805 call this%obs%StoreObsType(
'rej-inf-to-mvr', .true., indx)
817 logical,
intent(inout) :: found
821 select case (obsrv%ObsTypeId)
822 case (
'INFILTRATION')
823 call this%rp_obs_byfeature(obsrv)
825 call this%rp_obs_byfeature(obsrv)
827 call this%rp_obs_byfeature(obsrv)
828 case (
'REJ-INF-TO-MVR')
829 call this%rp_obs_byfeature(obsrv)
840 character(len=*),
intent(in) :: obstypeid
841 real(DP),
intent(inout) :: v
842 integer(I4B),
intent(in) :: jj
843 logical,
intent(inout) :: found
845 integer(I4B) :: n1, n2
848 select case (obstypeid)
849 case (
'INFILTRATION')
850 if (this%iboundpak(jj) /= 0 .and. this%idxbudinfl > 0)
then
851 call this%uzt_infl_term(jj, n1, n2, v)
854 if (this%iboundpak(jj) /= 0 .and. this%idxbudrinf > 0)
then
855 call this%uzt_rinf_term(jj, n1, n2, v)
858 if (this%iboundpak(jj) /= 0 .and. this%idxbuduzet > 0)
then
859 call this%uzt_uzet_term(jj, n1, n2, v)
861 case (
'REJ-INF-TO-MVR')
862 if (this%iboundpak(jj) /= 0 .and. this%idxbudritm > 0)
then
863 call this%uzt_ritm_term(jj, n1, n2, v)
876 integer(I4B),
intent(in) :: itemno
877 character(len=*),
intent(in) :: keyword
878 logical,
intent(inout) :: found
880 character(len=LINELENGTH) :: temp_text
883 real(DP),
pointer :: bndElem => null()
890 select case (keyword)
891 case (
'INFILTRATION')
892 ierr = this%apt_check_valid(itemno)
896 call this%parser%GetString(temp_text)
898 bndelem => this%concinfl(itemno)
900 this%packName,
'BND', this%tsManager, &
901 this%iprpak,
'INFILTRATION')
903 ierr = this%apt_check_valid(itemno)
907 call this%parser%GetString(temp_text)
909 bndelem => this%concuzet(itemno)
911 this%packName,
'BND', this%tsManager, &
This module contains the base boundary package.
class(bndtype) function, pointer, public getbndfromlist(list, idx)
Get boundary from package list.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
real(dp), parameter done
real constant 1
subroutine uzt_ritm_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rejected infiltration to MVR/MVT term.
subroutine, public uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, dvt, dvu, dvua)
Create a new UZT package.
subroutine uzt_rp_obs(this, obsrv, found)
Process package specific obs.
subroutine uzt_solve(this)
Explicit solve.
integer(i4b) function uzt_get_nbudterms(this)
Function that returns the number of budget terms for this package.
subroutine uzt_df_obs(this)
Define UZT Observation.
subroutine uzt_da(this)
Deallocate memory.
character(len= *), parameter flowtype
real(dp) function, dimension(:), pointer, contiguous get_mvr_depvar(this)
Override similarly named function in APT.
subroutine allocate_scalars(this)
Allocate scalar variables for package.
subroutine uzt_allocate_arrays(this)
Allocate arrays for package.
subroutine uzt_setup_budobj(this, idx)
Set up the budget object that stores all the unsaturated-zone flows.
subroutine uzt_infl_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Infiltration term.
subroutine uzt_rinf_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rejected infiltration term.
subroutine uzt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to UZT.
subroutine uzt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
Copy flow terms into thisbudobj.
subroutine uzt_bd_obs(this, obstypeid, jj, v, found)
Calculate observation value and pass it back to APT.
character(len= *), parameter ftype
subroutine uzt_uzet_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Evapotranspiration from the unsaturated-zone term.
subroutine uzt_set_stressperiod(this, itemno, keyword, found)
Sets the stress period attributes for keyword use.
subroutine find_uzt_package(this)
Find corresponding uzt package.
This module defines variable data types.
This module contains the derived types ObserveType and ObsDataType.
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
subroutine, public read_value_or_time_series_adv(textInput, ii, jj, bndElem, pkgName, auxOrBnd, tsManager, iprpak, varName)
Call this subroutine from advanced packages to define timeseries link for a variable (varName).
subroutine, public apt_process_obsid(obsrv, dis, inunitobs, iout)
Process observation IDs for an advanced package.
subroutine, public apt_process_obsid12(obsrv, dis, inunitobs, iout)
Process observation IDs for a package.