45 character(len=*),
parameter ::
ftype =
'UZT'
46 character(len=*),
parameter ::
flowtype =
'UZF'
47 character(len=16) ::
text =
' UZT'
51 integer(I4B),
pointer :: idxbudinfl => null()
52 integer(I4B),
pointer :: idxbudrinf => null()
53 integer(I4B),
pointer :: idxbuduzet => null()
54 integer(I4B),
pointer :: idxbudritm => null()
55 real(dp),
dimension(:),
pointer,
contiguous :: concinfl => null()
56 real(dp),
dimension(:),
pointer,
contiguous :: concuzet => null()
86 subroutine uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
87 mempath, fmi, eqnsclfac, dvt, dvu, dvua)
89 class(
bndtype),
pointer :: packobj
90 integer(I4B),
intent(in) :: id
91 integer(I4B),
intent(in) :: ibcnum
92 integer(I4B),
intent(in) :: inunit
93 integer(I4B),
intent(in) :: iout
94 character(len=*),
intent(in) :: namemodel
95 character(len=*),
intent(in) :: pakname
96 character(len=*),
intent(in) :: mempath
98 real(dp),
intent(in),
pointer :: eqnsclfac
99 character(len=*),
intent(in) :: dvt
100 character(len=*),
intent(in) :: dvu
101 character(len=*),
intent(in) :: dvua
110 call packobj%set_names(ibcnum, namemodel, pakname,
ftype, mempath)
114 call uztobj%allocate_scalars()
117 call packobj%pack_initialize()
119 packobj%inunit = inunit
122 packobj%ibcnum = ibcnum
133 uztobj%eqnsclfac => eqnsclfac
136 uztobj%depvartype = dvt
137 uztobj%depvarunit = dvu
138 uztobj%depvarunitabbrev = dvua
149 character(len=LINELENGTH) :: errmsg
150 class(
bndtype),
pointer :: packobj
151 integer(I4B) :: ip, icount
152 integer(I4B) :: nbudterm
162 if (this%fmi%flows_from_file)
then
163 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
164 if (
associated(this%flowbudptr)) found = .true.
167 if (
associated(this%fmi%gwfbndlist))
then
170 do ip = 1, this%fmi%gwfbndlist%Count()
172 if (packobj%packName == this%flowpackagename)
then
177 this%flowpackagebnd => packobj
178 select type (packobj)
180 this%flowbudptr => packobj%budobj
189 if (.not. found)
then
190 write (errmsg,
'(a)')
'Could not find flow package with name '&
191 &//trim(adjustl(this%flowpackagename))//
'.'
198 nbudterm = this%flowbudptr%nbudterm
199 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
202 write (this%iout,
'(/, a, a)') &
203 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
204 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
205 write (this%iout,
'(a, i0)') &
206 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
208 do ip = 1, this%flowbudptr%nbudterm
209 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
210 case (
'FLOW-JA-FACE')
212 this%idxbudssm(ip) = 0
215 this%idxbudssm(ip) = 0
218 this%idxbudssm(ip) = 0
219 case (
'INFILTRATION')
221 this%idxbudssm(ip) = 0
224 this%idxbudssm(ip) = 0
227 this%idxbudssm(ip) = 0
228 case (
'REJ-INF-TO-MVR')
230 this%idxbudssm(ip) = 0
233 this%idxbudssm(ip) = 0
236 this%idxbudssm(ip) = 0
239 this%idxbudssm(ip) = 0
244 this%idxbudssm(ip) = icount
247 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
248 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
249 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
251 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
262 integer(I4B),
intent(in) :: itemno
263 character(len=*),
intent(in) :: key
267 select case (trim(key))
268 case (
'INFILTRATION')
269 val = this%concinfl(itemno)
271 val = this%concuzet(itemno)
284 real(DP),
dimension(:),
intent(inout) :: rhs
285 integer(I4B),
dimension(:),
intent(in) :: ia
286 integer(I4B),
dimension(:),
intent(in) :: idxglo
289 integer(I4B) :: j, n1, n2
291 integer(I4B) :: iposd
297 if (this%idxbudinfl /= 0)
then
298 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
299 call this%uzt_infl_term(j, n1, n2, rrate, rhsval, hcofval)
300 iloc = this%idxlocnode(n1)
301 iposd = this%idxpakdiag(n1)
302 call matrix_sln%add_value_pos(iposd, hcofval)
303 rhs(iloc) = rhs(iloc) + rhsval
308 if (this%idxbudrinf /= 0)
then
309 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
310 call this%uzt_rinf_term(j, n1, n2, rrate, rhsval, hcofval)
311 iloc = this%idxlocnode(n1)
312 iposd = this%idxpakdiag(n1)
313 call matrix_sln%add_value_pos(iposd, hcofval)
314 rhs(iloc) = rhs(iloc) + rhsval
319 if (this%idxbuduzet /= 0)
then
320 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
321 call this%uzt_uzet_term(j, n1, n2, rrate, rhsval, hcofval)
322 iloc = this%idxlocnode(n1)
323 iposd = this%idxpakdiag(n1)
324 call matrix_sln%add_value_pos(iposd, hcofval)
325 rhs(iloc) = rhs(iloc) + rhsval
330 if (this%idxbudritm /= 0)
then
331 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
332 call this%uzt_ritm_term(j, n1, n2, rrate, rhsval, hcofval)
333 iloc = this%idxlocnode(n1)
334 iposd = this%idxpakdiag(n1)
335 call matrix_sln%add_value_pos(iposd, hcofval)
336 rhs(iloc) = rhs(iloc) + rhsval
350 integer(I4B) :: n1, n2
354 if (this%idxbudinfl /= 0)
then
355 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
356 call this%uzt_infl_term(j, n1, n2, rrate)
357 this%dbuff(n1) = this%dbuff(n1) + rrate
362 if (this%idxbudrinf /= 0)
then
363 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
364 call this%uzt_rinf_term(j, n1, n2, rrate)
365 this%dbuff(n1) = this%dbuff(n1) + rrate
370 if (this%idxbuduzet /= 0)
then
371 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
372 call this%uzt_uzet_term(j, n1, n2, rrate)
373 this%dbuff(n1) = this%dbuff(n1) + rrate
378 if (this%idxbudritm /= 0)
then
379 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
380 call this%uzt_ritm_term(j, n1, n2, rrate)
381 this%dbuff(n1) = this%dbuff(n1) + rrate
395 integer(I4B) :: nbudterms
400 if (this%idxbudinfl /= 0) nbudterms = nbudterms + 1
401 if (this%idxbudrinf /= 0) nbudterms = nbudterms + 1
402 if (this%idxbuduzet /= 0) nbudterms = nbudterms + 1
403 if (this%idxbudritm /= 0) nbudterms = nbudterms + 1
427 integer(I4B),
intent(inout) :: idx
429 integer(I4B) :: maxlist, naux
430 character(len=LENBUDTXT) :: text
433 text =
' INFILTRATION'
435 maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist
437 call this%budobj%budterm(idx)%initialize(text, &
442 maxlist, .false., .false., &
446 if (this%idxbudrinf /= 0)
then
449 maxlist = this%flowbudptr%budterm(this%idxbudrinf)%maxlist
451 call this%budobj%budterm(idx)%initialize(text, &
456 maxlist, .false., .false., &
461 if (this%idxbuduzet /= 0)
then
464 maxlist = this%flowbudptr%budterm(this%idxbuduzet)%maxlist
466 call this%budobj%budterm(idx)%initialize(text, &
471 maxlist, .false., .false., &
476 if (this%idxbudritm /= 0)
then
477 text =
' INF-REJ-TO-MVR'
479 maxlist = this%flowbudptr%budterm(this%idxbudritm)%maxlist
481 call this%budobj%budterm(idx)%initialize(text, &
486 maxlist, .false., .false., &
496 integer(I4B),
intent(inout) :: idx
497 real(DP),
dimension(:),
intent(in) :: x
498 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
499 real(DP),
intent(inout) :: ccratin
500 real(DP),
intent(inout) :: ccratout
502 integer(I4B) :: j, n1, n2
503 integer(I4B) :: nlist
509 nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist
510 call this%budobj%budterm(idx)%reset(nlist)
512 call this%uzt_infl_term(j, n1, n2, q)
513 call this%budobj%budterm(idx)%update_term(n1, n2, q)
514 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
518 if (this%idxbudrinf /= 0)
then
520 nlist = this%flowbudptr%budterm(this%idxbudrinf)%nlist
521 call this%budobj%budterm(idx)%reset(nlist)
523 call this%uzt_rinf_term(j, n1, n2, q)
524 call this%budobj%budterm(idx)%update_term(n1, n2, q)
525 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
530 if (this%idxbuduzet /= 0)
then
532 nlist = this%flowbudptr%budterm(this%idxbuduzet)%nlist
533 call this%budobj%budterm(idx)%reset(nlist)
535 call this%uzt_uzet_term(j, n1, n2, q)
536 call this%budobj%budterm(idx)%update_term(n1, n2, q)
537 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
542 if (this%idxbudritm /= 0)
then
544 nlist = this%flowbudptr%budterm(this%idxbudritm)%nlist
545 call this%budobj%budterm(idx)%reset(nlist)
547 call this%uzt_ritm_term(j, n1, n2, q)
548 call this%budobj%budterm(idx)%update_term(n1, n2, q)
549 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
566 call this%TspAptType%allocate_scalars()
569 call mem_allocate(this%idxbudinfl,
'IDXBUDINFL', this%memoryPath)
570 call mem_allocate(this%idxbudrinf,
'IDXBUDRINF', this%memoryPath)
571 call mem_allocate(this%idxbuduzet,
'IDXBUDUZET', this%memoryPath)
572 call mem_allocate(this%idxbudritm,
'IDXBUDRITM', this%memoryPath)
593 call mem_setptr(this%concinfl,
'INFILTRATION', this%input_mempath)
594 call mem_setptr(this%concuzet,
'UZET', this%input_mempath)
597 call this%TspAptType%apt_allocate_arrays()
611 call this%TspAptType%apt_checkin_deprecated_names()
614 'INFILTRATION', this%input_mempath,
'6.8.2')
616 'UZET', this%input_mempath,
'6.8.2')
637 nullify (this%concinfl)
638 nullify (this%concuzet)
641 call this%TspAptType%bnd_da()
653 integer(I4B),
intent(in) :: ientry
654 integer(I4B),
intent(inout) :: n1
655 integer(I4B),
intent(inout) :: n2
656 real(DP),
intent(inout),
optional :: rrate
657 real(DP),
intent(inout),
optional :: rhsval
658 real(DP),
intent(inout),
optional :: hcofval
664 n1 = this%flowbudptr%budterm(this%idxbudinfl)%id1(ientry)
665 n2 = this%flowbudptr%budterm(this%idxbudinfl)%id2(ientry)
667 qbnd = this%flowbudptr%budterm(this%idxbudinfl)%flow(ientry)
668 if (qbnd <
dzero)
then
669 ctmp = this%xnewpak(n1)
673 ctmp = this%concinfl(n1)
677 if (
present(rrate)) rrate = qbnd * ctmp
678 if (
present(rhsval)) rhsval = r
679 if (
present(hcofval)) hcofval = h
693 integer(I4B),
intent(in) :: ientry
694 integer(I4B),
intent(inout) :: n1
695 integer(I4B),
intent(inout) :: n2
696 real(DP),
intent(inout),
optional :: rrate
697 real(DP),
intent(inout),
optional :: rhsval
698 real(DP),
intent(inout),
optional :: hcofval
703 n1 = this%flowbudptr%budterm(this%idxbudrinf)%id1(ientry)
704 n2 = this%flowbudptr%budterm(this%idxbudrinf)%id2(ientry)
705 qbnd = this%flowbudptr%budterm(this%idxbudrinf)%flow(ientry)
706 ctmp = this%concinfl(n1)
707 if (
present(rrate)) rrate = ctmp * qbnd
708 if (
present(rhsval)) rhsval =
dzero
709 if (
present(hcofval)) hcofval = qbnd
721 integer(I4B),
intent(in) :: ientry
722 integer(I4B),
intent(inout) :: n1
723 integer(I4B),
intent(inout) :: n2
724 real(DP),
intent(inout),
optional :: rrate
725 real(DP),
intent(inout),
optional :: rhsval
726 real(DP),
intent(inout),
optional :: hcofval
732 n1 = this%flowbudptr%budterm(this%idxbuduzet)%id1(ientry)
733 n2 = this%flowbudptr%budterm(this%idxbuduzet)%id2(ientry)
735 qbnd = this%flowbudptr%budterm(this%idxbuduzet)%flow(ientry)
736 ctmp = this%concuzet(n1)
737 if (this%xnewpak(n1) < ctmp)
then
742 if (
present(rrate)) &
743 rrate = omega * qbnd * this%xnewpak(n1) + &
744 (
done - omega) * qbnd * ctmp
745 if (
present(rhsval)) rhsval = -(
done - omega) * qbnd * ctmp
746 if (
present(hcofval)) hcofval = omega * qbnd
760 integer(I4B),
intent(in) :: ientry
761 integer(I4B),
intent(inout) :: n1
762 integer(I4B),
intent(inout) :: n2
763 real(DP),
intent(inout),
optional :: rrate
764 real(DP),
intent(inout),
optional :: rhsval
765 real(DP),
intent(inout),
optional :: hcofval
770 n1 = this%flowbudptr%budterm(this%idxbudritm)%id1(ientry)
771 n2 = this%flowbudptr%budterm(this%idxbudritm)%id2(ientry)
772 qbnd = this%flowbudptr%budterm(this%idxbudritm)%flow(ientry)
773 ctmp = this%concinfl(n1)
774 if (
present(rrate)) rrate = ctmp * qbnd
775 if (
present(rhsval)) rhsval =
dzero
776 if (
present(hcofval)) hcofval = qbnd
794 call this%obs%StoreObsType(
'concentration', .false., indx)
799 call this%obs%StoreObsType(
'flow-ja-face', .true., indx)
804 call this%obs%StoreObsType(
'from-mvr', .true., indx)
813 call this%obs%StoreObsType(
'storage', .true., indx)
818 call this%obs%StoreObsType(
'constant', .true., indx)
823 call this%obs%StoreObsType(
'uzt', .true., indx)
828 call this%obs%StoreObsType(
'infiltration', .true., indx)
833 call this%obs%StoreObsType(
'rej-inf', .true., indx)
838 call this%obs%StoreObsType(
'uzet', .true., indx)
843 call this%obs%StoreObsType(
'rej-inf-to-mvr', .true., indx)
855 logical,
intent(inout) :: found
859 select case (obsrv%ObsTypeId)
860 case (
'INFILTRATION')
861 call this%rp_obs_byfeature(obsrv)
863 call this%rp_obs_byfeature(obsrv)
865 call this%rp_obs_byfeature(obsrv)
866 case (
'REJ-INF-TO-MVR')
867 call this%rp_obs_byfeature(obsrv)
878 character(len=*),
intent(in) :: obstypeid
879 real(DP),
intent(inout) :: v
880 integer(I4B),
intent(in) :: jj
881 logical,
intent(inout) :: found
883 integer(I4B) :: n1, n2
886 select case (obstypeid)
887 case (
'INFILTRATION')
888 if (this%iboundpak(jj) /= 0 .and. this%idxbudinfl > 0)
then
889 call this%uzt_infl_term(jj, n1, n2, v)
892 if (this%iboundpak(jj) /= 0 .and. this%idxbudrinf > 0)
then
893 call this%uzt_rinf_term(jj, n1, n2, v)
896 if (this%iboundpak(jj) /= 0 .and. this%idxbuduzet > 0)
then
897 call this%uzt_uzet_term(jj, n1, n2, v)
899 case (
'REJ-INF-TO-MVR')
900 if (this%iboundpak(jj) /= 0 .and. this%idxbudritm > 0)
then
901 call this%uzt_ritm_term(jj, n1, n2, v)
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 dnodata
real no data constant
integer(i4b), parameter lenvarname
maximum length of a variable name
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 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.
real(dp) function uzt_setting_value(this, itemno, key)
Value for a package-specific PERIOD setting.
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, public uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, fmi, eqnsclfac, dvt, dvu, dvua)
Create a new UZT package.
subroutine uzt_checkin_deprecated_names(this)
Alias deprecated UZT variable names to their current storage.
subroutine find_uzt_package(this)
Find corresponding uzt package.
This module defines variable data types.
Previous variable names checked in as deprecated aliases.
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 store_error_filename(filename, terminate)
Store the erroring file name.
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.
This class is used to store a single deferred-length character string. It was designed to work in an ...