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
147 character(len=LINELENGTH) :: errmsg
148 class(
bndtype),
pointer :: packobj
149 integer(I4B) :: ip, icount
150 integer(I4B) :: nbudterm
160 if (this%fmi%flows_from_file)
then
161 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
162 if (
associated(this%flowbudptr)) found = .true.
165 if (
associated(this%fmi%gwfbndlist))
then
168 do ip = 1, this%fmi%gwfbndlist%Count()
170 if (packobj%packName == this%flowpackagename)
then
175 this%flowpackagebnd => packobj
176 select type (packobj)
178 this%flowbudptr => packobj%budobj
187 if (.not. found)
then
188 write (errmsg,
'(a)')
'Could not find flow package with name '&
189 &//trim(adjustl(this%flowpackagename))//
'.'
191 call this%parser%StoreErrorUnit()
196 nbudterm = this%flowbudptr%nbudterm
197 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
200 write (this%iout,
'(/, a, a)') &
201 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
202 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
203 write (this%iout,
'(a, i0)') &
204 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
206 do ip = 1, this%flowbudptr%nbudterm
207 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
208 case (
'FLOW-JA-FACE')
210 this%idxbudssm(ip) = 0
213 this%idxbudssm(ip) = 0
216 this%idxbudssm(ip) = 0
217 case (
'INFILTRATION')
219 this%idxbudssm(ip) = 0
222 this%idxbudssm(ip) = 0
225 this%idxbudssm(ip) = 0
226 case (
'REJ-INF-TO-MVR')
228 this%idxbudssm(ip) = 0
231 this%idxbudssm(ip) = 0
234 this%idxbudssm(ip) = 0
237 this%idxbudssm(ip) = 0
242 this%idxbudssm(ip) = icount
245 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
246 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
247 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
249 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
264 real(DP),
dimension(:),
intent(inout) :: rhs
265 integer(I4B),
dimension(:),
intent(in) :: ia
266 integer(I4B),
dimension(:),
intent(in) :: idxglo
269 integer(I4B) :: j, n1, n2
271 integer(I4B) :: iposd
277 if (this%idxbudinfl /= 0)
then
278 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
279 call this%uzt_infl_term(j, n1, n2, rrate, rhsval, hcofval)
280 iloc = this%idxlocnode(n1)
281 iposd = this%idxpakdiag(n1)
282 call matrix_sln%add_value_pos(iposd, hcofval)
283 rhs(iloc) = rhs(iloc) + rhsval
288 if (this%idxbudrinf /= 0)
then
289 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
290 call this%uzt_rinf_term(j, n1, n2, rrate, rhsval, hcofval)
291 iloc = this%idxlocnode(n1)
292 iposd = this%idxpakdiag(n1)
293 call matrix_sln%add_value_pos(iposd, hcofval)
294 rhs(iloc) = rhs(iloc) + rhsval
299 if (this%idxbuduzet /= 0)
then
300 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
301 call this%uzt_uzet_term(j, n1, n2, rrate, rhsval, hcofval)
302 iloc = this%idxlocnode(n1)
303 iposd = this%idxpakdiag(n1)
304 call matrix_sln%add_value_pos(iposd, hcofval)
305 rhs(iloc) = rhs(iloc) + rhsval
310 if (this%idxbudritm /= 0)
then
311 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
312 call this%uzt_ritm_term(j, n1, n2, rrate, rhsval, hcofval)
313 iloc = this%idxlocnode(n1)
314 iposd = this%idxpakdiag(n1)
315 call matrix_sln%add_value_pos(iposd, hcofval)
316 rhs(iloc) = rhs(iloc) + rhsval
333 integer(I4B) :: n1, n2
337 if (this%idxbudinfl /= 0)
then
338 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
339 call this%uzt_infl_term(j, n1, n2, rrate)
340 this%dbuff(n1) = this%dbuff(n1) + rrate
345 if (this%idxbudrinf /= 0)
then
346 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
347 call this%uzt_rinf_term(j, n1, n2, rrate)
348 this%dbuff(n1) = this%dbuff(n1) + rrate
353 if (this%idxbuduzet /= 0)
then
354 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
355 call this%uzt_uzet_term(j, n1, n2, rrate)
356 this%dbuff(n1) = this%dbuff(n1) + rrate
361 if (this%idxbudritm /= 0)
then
362 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
363 call this%uzt_ritm_term(j, n1, n2, rrate)
364 this%dbuff(n1) = this%dbuff(n1) + rrate
381 integer(I4B) :: nbudterms
386 if (this%idxbudinfl /= 0) nbudterms = nbudterms + 1
387 if (this%idxbudrinf /= 0) nbudterms = nbudterms + 1
388 if (this%idxbuduzet /= 0) nbudterms = nbudterms + 1
389 if (this%idxbudritm /= 0) nbudterms = nbudterms + 1
416 integer(I4B),
intent(inout) :: idx
418 integer(I4B) :: maxlist, naux
419 character(len=LENBUDTXT) :: text
422 text =
' INFILTRATION'
424 maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist
426 call this%budobj%budterm(idx)%initialize(text, &
431 maxlist, .false., .false., &
435 if (this%idxbudrinf /= 0)
then
438 maxlist = this%flowbudptr%budterm(this%idxbudrinf)%maxlist
440 call this%budobj%budterm(idx)%initialize(text, &
445 maxlist, .false., .false., &
450 if (this%idxbuduzet /= 0)
then
453 maxlist = this%flowbudptr%budterm(this%idxbuduzet)%maxlist
455 call this%budobj%budterm(idx)%initialize(text, &
460 maxlist, .false., .false., &
465 if (this%idxbudritm /= 0)
then
466 text =
' INF-REJ-TO-MVR'
468 maxlist = this%flowbudptr%budterm(this%idxbudritm)%maxlist
470 call this%budobj%budterm(idx)%initialize(text, &
475 maxlist, .false., .false., &
488 integer(I4B),
intent(inout) :: idx
489 real(DP),
dimension(:),
intent(in) :: x
490 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
491 real(DP),
intent(inout) :: ccratin
492 real(DP),
intent(inout) :: ccratout
494 integer(I4B) :: j, n1, n2
495 integer(I4B) :: nlist
501 nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist
502 call this%budobj%budterm(idx)%reset(nlist)
504 call this%uzt_infl_term(j, n1, n2, q)
505 call this%budobj%budterm(idx)%update_term(n1, n2, q)
506 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
510 if (this%idxbudrinf /= 0)
then
512 nlist = this%flowbudptr%budterm(this%idxbudrinf)%nlist
513 call this%budobj%budterm(idx)%reset(nlist)
515 call this%uzt_rinf_term(j, n1, n2, q)
516 call this%budobj%budterm(idx)%update_term(n1, n2, q)
517 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
522 if (this%idxbuduzet /= 0)
then
524 nlist = this%flowbudptr%budterm(this%idxbuduzet)%nlist
525 call this%budobj%budterm(idx)%reset(nlist)
527 call this%uzt_uzet_term(j, n1, n2, q)
528 call this%budobj%budterm(idx)%update_term(n1, n2, q)
529 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
534 if (this%idxbudritm /= 0)
then
536 nlist = this%flowbudptr%budterm(this%idxbudritm)%nlist
537 call this%budobj%budterm(idx)%reset(nlist)
539 call this%uzt_ritm_term(j, n1, n2, q)
540 call this%budobj%budterm(idx)%update_term(n1, n2, q)
541 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
561 call this%TspAptType%allocate_scalars()
564 call mem_allocate(this%idxbudinfl,
'IDXBUDINFL', this%memoryPath)
565 call mem_allocate(this%idxbudrinf,
'IDXBUDRINF', this%memoryPath)
566 call mem_allocate(this%idxbuduzet,
'IDXBUDUZET', this%memoryPath)
567 call mem_allocate(this%idxbudritm,
'IDXBUDRITM', this%memoryPath)
592 call mem_allocate(this%concinfl, this%ncv,
'CONCINFL', this%memoryPath)
593 call mem_allocate(this%concuzet, this%ncv,
'CONCUZET', this%memoryPath)
596 call this%TspAptType%apt_allocate_arrays()
600 this%concinfl(n) =
dzero
601 this%concuzet(n) =
dzero
630 call this%TspAptType%bnd_da()
645 integer(I4B),
intent(in) :: ientry
646 integer(I4B),
intent(inout) :: n1
647 integer(I4B),
intent(inout) :: n2
648 real(DP),
intent(inout),
optional :: rrate
649 real(DP),
intent(inout),
optional :: rhsval
650 real(DP),
intent(inout),
optional :: hcofval
656 n1 = this%flowbudptr%budterm(this%idxbudinfl)%id1(ientry)
657 n2 = this%flowbudptr%budterm(this%idxbudinfl)%id2(ientry)
659 qbnd = this%flowbudptr%budterm(this%idxbudinfl)%flow(ientry)
660 if (qbnd <
dzero)
then
661 ctmp = this%xnewpak(n1)
665 ctmp = this%concinfl(n1)
669 if (
present(rrate)) rrate = qbnd * ctmp
670 if (
present(rhsval)) rhsval = r
671 if (
present(hcofval)) hcofval = h
688 integer(I4B),
intent(in) :: ientry
689 integer(I4B),
intent(inout) :: n1
690 integer(I4B),
intent(inout) :: n2
691 real(DP),
intent(inout),
optional :: rrate
692 real(DP),
intent(inout),
optional :: rhsval
693 real(DP),
intent(inout),
optional :: hcofval
698 n1 = this%flowbudptr%budterm(this%idxbudrinf)%id1(ientry)
699 n2 = this%flowbudptr%budterm(this%idxbudrinf)%id2(ientry)
700 qbnd = this%flowbudptr%budterm(this%idxbudrinf)%flow(ientry)
701 ctmp = this%concinfl(n1)
702 if (
present(rrate)) rrate = ctmp * qbnd
703 if (
present(rhsval)) rhsval =
dzero
704 if (
present(hcofval)) hcofval = qbnd
719 integer(I4B),
intent(in) :: ientry
720 integer(I4B),
intent(inout) :: n1
721 integer(I4B),
intent(inout) :: n2
722 real(DP),
intent(inout),
optional :: rrate
723 real(DP),
intent(inout),
optional :: rhsval
724 real(DP),
intent(inout),
optional :: hcofval
730 n1 = this%flowbudptr%budterm(this%idxbuduzet)%id1(ientry)
731 n2 = this%flowbudptr%budterm(this%idxbuduzet)%id2(ientry)
733 qbnd = this%flowbudptr%budterm(this%idxbuduzet)%flow(ientry)
734 ctmp = this%concuzet(n1)
735 if (this%xnewpak(n1) < ctmp)
then
740 if (
present(rrate)) &
741 rrate = omega * qbnd * this%xnewpak(n1) + &
742 (
done - omega) * qbnd * ctmp
743 if (
present(rhsval)) rhsval = -(
done - omega) * qbnd * ctmp
744 if (
present(hcofval)) hcofval = omega * qbnd
761 integer(I4B),
intent(in) :: ientry
762 integer(I4B),
intent(inout) :: n1
763 integer(I4B),
intent(inout) :: n2
764 real(DP),
intent(inout),
optional :: rrate
765 real(DP),
intent(inout),
optional :: rhsval
766 real(DP),
intent(inout),
optional :: hcofval
771 n1 = this%flowbudptr%budterm(this%idxbudritm)%id1(ientry)
772 n2 = this%flowbudptr%budterm(this%idxbudritm)%id2(ientry)
773 qbnd = this%flowbudptr%budterm(this%idxbudritm)%flow(ientry)
774 ctmp = this%concinfl(n1)
775 if (
present(rrate)) rrate = ctmp * qbnd
776 if (
present(rhsval)) rhsval =
dzero
777 if (
present(hcofval)) hcofval = qbnd
798 call this%obs%StoreObsType(
'concentration', .false., indx)
803 call this%obs%StoreObsType(
'flow-ja-face', .true., indx)
808 call this%obs%StoreObsType(
'from-mvr', .true., indx)
817 call this%obs%StoreObsType(
'storage', .true., indx)
822 call this%obs%StoreObsType(
'constant', .true., indx)
827 call this%obs%StoreObsType(
'uzt', .true., indx)
832 call this%obs%StoreObsType(
'infiltration', .true., indx)
837 call this%obs%StoreObsType(
'rej-inf', .true., indx)
842 call this%obs%StoreObsType(
'uzet', .true., indx)
847 call this%obs%StoreObsType(
'rej-inf-to-mvr', .true., indx)
862 logical,
intent(inout) :: found
866 select case (obsrv%ObsTypeId)
867 case (
'INFILTRATION')
868 call this%rp_obs_byfeature(obsrv)
870 call this%rp_obs_byfeature(obsrv)
872 call this%rp_obs_byfeature(obsrv)
873 case (
'REJ-INF-TO-MVR')
874 call this%rp_obs_byfeature(obsrv)
887 character(len=*),
intent(in) :: obstypeid
888 real(DP),
intent(inout) :: v
889 integer(I4B),
intent(in) :: jj
890 logical,
intent(inout) :: found
892 integer(I4B) :: n1, n2
895 select case (obstypeid)
896 case (
'INFILTRATION')
897 if (this%iboundpak(jj) /= 0 .and. this%idxbudinfl > 0)
then
898 call this%uzt_infl_term(jj, n1, n2, v)
901 if (this%iboundpak(jj) /= 0 .and. this%idxbudrinf > 0)
then
902 call this%uzt_rinf_term(jj, n1, n2, v)
905 if (this%iboundpak(jj) /= 0 .and. this%idxbuduzet > 0)
then
906 call this%uzt_uzet_term(jj, n1, n2, v)
908 case (
'REJ-INF-TO-MVR')
909 if (this%iboundpak(jj) /= 0 .and. this%idxbudritm > 0)
then
910 call this%uzt_ritm_term(jj, n1, n2, v)
926 integer(I4B),
intent(in) :: itemno
927 character(len=*),
intent(in) :: keyword
928 logical,
intent(inout) :: found
930 character(len=LINELENGTH) :: temp_text
933 real(DP),
pointer :: bndElem => null()
940 select case (keyword)
941 case (
'INFILTRATION')
942 ierr = this%apt_check_valid(itemno)
946 call this%parser%GetString(temp_text)
948 bndelem => this%concinfl(itemno)
950 this%packName,
'BND', this%tsManager, &
951 this%iprpak,
'INFILTRATION')
953 ierr = this%apt_check_valid(itemno)
957 call this%parser%GetString(temp_text)
959 bndelem => this%concuzet(itemno)
961 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.