47 character(len=*),
parameter ::
ftype =
'UZE'
48 character(len=*),
parameter ::
flowtype =
'UZF'
49 character(len=16) ::
text =
' UZE'
55 integer(I4B),
pointer :: idxbudinfl => null()
56 integer(I4B),
pointer :: idxbudrinf => null()
57 integer(I4B),
pointer :: idxbuduzet => null()
58 integer(I4B),
pointer :: idxbudritm => null()
59 integer(I4B),
pointer :: idxbudtheq => null()
61 real(dp),
dimension(:),
pointer,
contiguous :: tempinfl => null()
62 real(dp),
dimension(:),
pointer,
contiguous :: tempuzet => null()
97 subroutine uze_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
98 mempath, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
100 class(
bndtype),
pointer :: packobj
101 integer(I4B),
intent(in) :: id
102 integer(I4B),
intent(in) :: ibcnum
103 integer(I4B),
intent(in) :: inunit
104 integer(I4B),
intent(in) :: iout
105 character(len=*),
intent(in) :: namemodel
106 character(len=*),
intent(in) :: pakname
107 character(len=*),
intent(in) :: mempath
109 real(dp),
intent(in),
pointer :: eqnsclfac
111 character(len=*),
intent(in) :: dvt
112 character(len=*),
intent(in) :: dvu
113 character(len=*),
intent(in) :: dvua
122 call packobj%set_names(ibcnum, namemodel, pakname,
ftype, mempath)
126 call uzeobj%allocate_scalars()
129 call packobj%pack_initialize()
131 packobj%inunit = inunit
134 packobj%ibcnum = ibcnum
145 uzeobj%eqnsclfac => eqnsclfac
150 uzeobj%gwecommon => gwecommon
153 uzeobj%depvartype = dvt
154 uzeobj%depvarunit = dvu
155 uzeobj%depvarunitabbrev = dvua
167 class(
bndtype),
pointer :: packobj
168 integer(I4B) :: ip, icount
169 integer(I4B) :: nbudterm
179 if (this%fmi%flows_from_file)
then
180 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
181 if (
associated(this%flowbudptr))
then
186 if (
associated(this%fmi%gwfbndlist))
then
189 do ip = 1, this%fmi%gwfbndlist%Count()
191 if (packobj%packName == this%flowpackagename)
then
196 this%flowpackagebnd => packobj
197 select type (packobj)
199 this%flowbudptr => packobj%budobj
208 if (.not. found)
then
209 write (
errmsg,
'(a)')
'Could not find flow package with name '&
210 &//trim(adjustl(this%flowpackagename))//
'.'
217 nbudterm = this%flowbudptr%nbudterm
218 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
221 write (this%iout,
'(/, a, a)') &
222 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
223 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
224 write (this%iout,
'(a, i0)') &
225 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
227 do ip = 1, this%flowbudptr%nbudterm
228 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
229 case (
'FLOW-JA-FACE')
231 this%idxbudssm(ip) = 0
234 this%idxbudssm(ip) = 0
237 this%idxbudssm(ip) = 0
238 case (
'INFILTRATION')
240 this%idxbudssm(ip) = 0
243 this%idxbudssm(ip) = 0
246 this%idxbudssm(ip) = 0
247 case (
'REJ-INF-TO-MVR')
249 this%idxbudssm(ip) = 0
252 this%idxbudssm(ip) = 0
255 this%idxbudssm(ip) = 0
258 this%idxbudssm(ip) = 0
263 this%idxbudssm(ip) = icount
267 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
268 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
269 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
271 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
274 this%idxbudtheq = this%flowbudptr%nbudterm + 1
285 integer(I4B),
intent(in) :: itemno
286 character(len=*),
intent(in) :: key
290 select case (trim(key))
291 case (
'INFILTRATION')
292 val = this%tempinfl(itemno)
294 val = this%tempuzet(itemno)
309 integer(I4B),
intent(in) :: moffset
312 integer(I4B) :: i, ii
318 integer(I4B) :: idxjj
319 integer(I4B) :: idxnglo
320 integer(I4B) :: idxjglo
323 if (this%imatrows /= 0)
then
327 nglo = moffset + this%dis%nodes + this%ioffset + n
328 call sparse%addconnection(nglo, nglo, 1)
334 do i = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
335 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(i)
336 jj = this%flowbudptr%budterm(this%idxbudgwf)%id2(i)
337 nglo = moffset + this%dis%nodes + this%ioffset + n
339 call sparse%addconnection(nglo, jglo, 1)
340 call sparse%addconnection(jglo, nglo, 1)
348 if (this%idxbudfjf /= 0)
then
349 do i = 1, this%flowbudptr%budterm(this%idxbudfjf)%maxlist
350 n = this%flowbudptr%budterm(this%idxbudfjf)%id1(i)
351 jj = this%flowbudptr%budterm(this%idxbudfjf)%id2(i)
352 nglo = moffset + this%dis%nodes + this%ioffset + n
353 jglo = moffset + this%dis%nodes + this%ioffset + jj
356 do ii = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
357 idxn = this%flowbudptr%budterm(this%idxbudgwf)%id1(ii)
358 idxjj = this%flowbudptr%budterm(this%idxbudgwf)%id2(ii)
359 idxnglo = moffset + this%dis%nodes + this%ioffset + idxn
360 idxjglo = moffset + idxjj
361 if (nglo == idxnglo)
exit
363 call sparse%addconnection(idxjglo, jglo, 1)
371 subroutine uze_mc(this, moffset, matrix_sln)
375 integer(I4B),
intent(in) :: moffset
378 integer(I4B) :: n, j, iglo, jglo
379 integer(I4B) :: idxn, idxj, idxiglo, idxjglo
380 integer(I4B) :: ipos, idxpos
383 call this%apt_allocate_index_arrays()
386 if (this%imatrows /= 0)
then
395 iglo = moffset + this%dis%nodes + this%ioffset + n
396 this%idxpakdiag(n) = matrix_sln%get_position_diag(iglo)
400 do ipos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
401 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(ipos)
402 j = this%flowbudptr%budterm(this%idxbudgwf)%id2(ipos)
403 iglo = moffset + this%dis%nodes + this%ioffset + n
408 this%idxlocnode(n) = j
412 this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
413 this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
417 do ipos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
418 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(ipos)
419 j = this%flowbudptr%budterm(this%idxbudgwf)%id2(ipos)
421 jglo = moffset + this%dis%nodes + this%ioffset + n
425 this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
426 this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
430 if (this%idxbudfjf /= 0)
then
431 do ipos = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
432 n = this%flowbudptr%budterm(this%idxbudfjf)%id1(ipos)
433 j = this%flowbudptr%budterm(this%idxbudfjf)%id2(ipos)
434 iglo = moffset + this%dis%nodes + this%ioffset + n
435 jglo = moffset + this%dis%nodes + this%ioffset + j
438 do idxpos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
439 idxn = this%flowbudptr%budterm(this%idxbudgwf)%id1(idxpos)
440 idxj = this%flowbudptr%budterm(this%idxbudgwf)%id2(idxpos)
441 idxjglo = moffset + this%dis%nodes + this%ioffset + idxn
442 idxiglo = moffset + idxj
443 if (idxjglo == iglo)
exit
449 this%idxfjfdglo(ipos) = matrix_sln%get_position_diag(idxiglo)
450 this%idxfjfoffdglo(ipos) = matrix_sln%get_position(idxiglo, jglo)
464 real(DP),
dimension(:),
intent(inout) :: rhs
465 integer(I4B),
dimension(:),
intent(in) :: ia
466 integer(I4B),
dimension(:),
intent(in) :: idxglo
469 integer(I4B) :: j, n, n1, n2
471 integer(I4B) :: iposd, iposoffd
472 integer(I4B) :: ipossymoffd
484 if (this%idxbudinfl /= 0)
then
485 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
486 call this%uze_infl_term(j, n1, n2, rrate, rhsval, hcofval)
487 iloc = this%idxlocnode(n1)
488 ipossymoffd = this%idxsymoffdglo(j)
489 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
490 rhs(iloc) = rhs(iloc) + rhsval
495 if (this%idxbudrinf /= 0)
then
496 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
497 call this%uze_rinf_term(j, n1, n2, rrate, rhsval, hcofval)
498 iloc = this%idxlocnode(n1)
499 ipossymoffd = this%idxsymoffdglo(j)
500 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
501 rhs(iloc) = rhs(iloc) + rhsval
506 if (this%idxbuduzet /= 0)
then
507 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
508 call this%uze_uzet_term(j, n1, n2, rrate, rhsval, hcofval)
509 iloc = this%idxlocnode(n1)
510 ipossymoffd = this%idxsymoffdglo(j)
511 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
512 rhs(iloc) = rhs(iloc) + rhsval
517 if (this%idxbudritm /= 0)
then
518 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
519 call this%uze_ritm_term(j, n1, n2, rrate, rhsval, hcofval)
520 iloc = this%idxlocnode(n1)
521 ipossymoffd = this%idxsymoffdglo(j)
522 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
523 rhs(iloc) = rhs(iloc) + rhsval
532 cold = this%xoldpak(n)
533 iloc = this%idxlocnode(n)
534 ipossymoffd = this%idxsymoffdglo(n)
535 call this%apt_stor_term(n, n1, n2, rrate, rhsval, hcofval)
536 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
537 rhs(iloc) = rhs(iloc) + rhsval
541 if (this%idxbudtmvr /= 0)
then
542 do j = 1, this%flowbudptr%budterm(this%idxbudtmvr)%nlist
543 call this%apt_tmvr_term(j, n1, n2, rrate, rhsval, hcofval)
544 iloc = this%idxlocnode(n1)
545 ipossymoffd = this%idxsymoffdglo(j)
546 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
547 rhs(iloc) = rhs(iloc) + rhsval
552 if (this%idxbudfmvr /= 0)
then
554 rhsval = this%qmfrommvr(n)
555 iloc = this%idxlocnode(n)
556 rhs(iloc) = rhs(iloc) - rhsval
561 do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
564 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
565 if (this%iboundpak(n) /= 0)
then
569 iposd = this%idxdglo(j)
570 iposoffd = this%idxoffdglo(j)
571 call matrix_sln%add_value_pos(iposd,
done)
572 call matrix_sln%add_value_pos(iposoffd, -
done)
577 if (this%idxbudfjf /= 0)
then
578 do j = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
579 n1 = this%flowbudptr%budterm(this%idxbudfjf)%id1(j)
580 n2 = this%flowbudptr%budterm(this%idxbudfjf)%id2(j)
581 qbnd = this%flowbudptr%budterm(this%idxbudfjf)%flow(j)
582 if (qbnd <=
dzero)
then
587 iposd = this%idxfjfdglo(j)
588 iposoffd = this%idxfjfoffdglo(j)
589 call matrix_sln%add_value_pos(iposd, omega * qbnd * this%eqnsclfac)
590 call matrix_sln%add_value_pos(iposoffd, &
591 (
done - omega) * qbnd * this%eqnsclfac)
606 integer(I4B) :: n1, n2
610 if (this%idxbudinfl /= 0)
then
611 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
612 call this%uze_infl_term(j, n1, n2, rrate)
613 this%dbuff(n1) = this%dbuff(n1) + rrate
618 if (this%idxbudrinf /= 0)
then
619 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
620 call this%uze_rinf_term(j, n1, n2, rrate)
621 this%dbuff(n1) = this%dbuff(n1) + rrate
626 if (this%idxbuduzet /= 0)
then
627 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
628 call this%uze_uzet_term(j, n1, n2, rrate)
629 this%dbuff(n1) = this%dbuff(n1) + rrate
634 if (this%idxbudritm /= 0)
then
635 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
636 call this%uze_ritm_term(j, n1, n2, rrate)
637 this%dbuff(n1) = this%dbuff(n1) + rrate
651 integer(I4B) :: nbudterms
655 if (this%idxbudinfl /= 0) nbudterms = nbudterms + 1
656 if (this%idxbudrinf /= 0) nbudterms = nbudterms + 1
657 if (this%idxbuduzet /= 0) nbudterms = nbudterms + 1
658 if (this%idxbudritm /= 0) nbudterms = nbudterms + 1
659 if (this%idxbudtheq /= 0) nbudterms = nbudterms + 1
686 integer(I4B),
intent(inout) :: idx
688 integer(I4B) :: maxlist, naux
689 character(len=LENBUDTXT) :: text
692 text =
' INFILTRATION'
694 maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist
696 call this%budobj%budterm(idx)%initialize(text, &
701 maxlist, .false., .false., &
705 if (this%idxbudrinf /= 0)
then
708 maxlist = this%flowbudptr%budterm(this%idxbudrinf)%maxlist
710 call this%budobj%budterm(idx)%initialize(text, &
715 maxlist, .false., .false., &
720 if (this%idxbuduzet /= 0)
then
723 maxlist = this%flowbudptr%budterm(this%idxbuduzet)%maxlist
725 call this%budobj%budterm(idx)%initialize(text, &
730 maxlist, .false., .false., &
735 if (this%idxbudritm /= 0)
then
736 text =
' INF-REJ-TO-MVR'
738 maxlist = this%flowbudptr%budterm(this%idxbudritm)%maxlist
740 call this%budobj%budterm(idx)%initialize(text, &
745 maxlist, .false., .false., &
750 text =
' THERMAL-EQUIL'
753 maxlist = this%flowbudptr%budterm(this%idxbudgwf)%maxlist
755 call this%budobj%budterm(idx)%initialize(text, &
760 maxlist, .false., .false., &
772 integer(I4B),
intent(inout) :: idx
773 real(DP),
dimension(:),
intent(in) :: x
774 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
775 real(DP),
intent(inout) :: ccratin
776 real(DP),
intent(inout) :: ccratout
778 integer(I4B) :: j, n1, n2, indx
779 integer(I4B) :: nlist, nlen
780 integer(I4B) :: igwfnode
781 integer(I4B) :: idiag
783 real(DP),
dimension(:),
allocatable :: budresid
785 allocate (budresid(this%ncv))
794 if (this%idxbudfjf /= 0)
then
795 nlen = this%flowbudptr%budterm(this%idxbudfjf)%maxlist
799 nlist = this%budobj%budterm(indx)%nlist
801 n1 = this%budobj%budterm(indx)%id1(j)
802 n2 = this%budobj%budterm(indx)%id2(j)
804 q = this%budobj%budterm(indx)%flow(j)
805 budresid(n1) = budresid(n1) + q
806 budresid(n2) = budresid(n2) - q
813 nlist = this%budobj%budterm(indx)%nlist
815 n1 = this%budobj%budterm(indx)%id1(j)
816 q = this%budobj%budterm(indx)%flow(j)
817 budresid(n1) = budresid(n1) + q
821 indx = this%idxlastpak
826 q = this%budobj%budterm(indx)%flow(n1)
827 budresid(n1) = budresid(n1) + q
831 if (this%idxbudtmvr /= 0)
then
833 nlist = this%budobj%budterm(indx)%nlist
835 n1 = this%budobj%budterm(indx)%id1(j)
836 q = this%budobj%budterm(indx)%flow(j)
837 budresid(n1) = budresid(n1) + q
842 if (this%idxbudfmvr /= 0)
then
844 nlist = this%budobj%budterm(indx)%nlist
846 n1 = this%budobj%budterm(indx)%id1(j)
847 q = this%budobj%budterm(indx)%flow(j)
848 budresid(n1) = budresid(n1) + q
855 q = this%budobj%budterm(indx)%flow(n1)
856 budresid(n1) = budresid(n1) + q
866 nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist
867 call this%budobj%budterm(idx)%reset(nlist)
869 call this%uze_infl_term(j, n1, n2, q)
870 call this%budobj%budterm(idx)%update_term(n1, n2, q)
871 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
872 budresid(n1) = budresid(n1) + q
876 if (this%idxbudrinf /= 0)
then
878 nlist = this%flowbudptr%budterm(this%idxbudrinf)%nlist
879 call this%budobj%budterm(idx)%reset(nlist)
881 call this%uze_rinf_term(j, n1, n2, q)
882 call this%budobj%budterm(idx)%update_term(n1, n2, q)
883 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
884 budresid(n1) = budresid(n1) + q
889 if (this%idxbuduzet /= 0)
then
891 nlist = this%flowbudptr%budterm(this%idxbuduzet)%nlist
892 call this%budobj%budterm(idx)%reset(nlist)
894 call this%uze_uzet_term(j, n1, n2, q)
895 call this%budobj%budterm(idx)%update_term(n1, n2, q)
896 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
897 budresid(n1) = budresid(n1) + q
902 if (this%idxbudritm /= 0)
then
904 nlist = this%flowbudptr%budterm(this%idxbudritm)%nlist
905 call this%budobj%budterm(idx)%reset(nlist)
907 call this%uze_ritm_term(j, n1, n2, q)
908 call this%budobj%budterm(idx)%update_term(n1, n2, q)
909 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
910 budresid(n1) = budresid(n1) + q
917 nlist = this%flowbudptr%budterm(this%idxbudgwf)%nlist
918 call this%budobj%budterm(idx)%reset(nlist)
920 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
921 igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(j)
923 call this%uze_theq_term(j, n1, igwfnode, q)
924 call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
925 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
926 if (this%iboundpak(n1) /= 0)
then
928 this%simvals(n1) = this%simvals(n1) - q
929 idiag = this%dis%con%ia(igwfnode)
930 flowja(idiag) = flowja(idiag) - q
934 deallocate (budresid)
949 call this%TspAptType%allocate_scalars()
952 call mem_allocate(this%idxbudinfl,
'IDXBUDINFL', this%memoryPath)
953 call mem_allocate(this%idxbudrinf,
'IDXBUDRINF', this%memoryPath)
954 call mem_allocate(this%idxbuduzet,
'IDXBUDUZET', this%memoryPath)
955 call mem_allocate(this%idxbudritm,
'IDXBUDRITM', this%memoryPath)
956 call mem_allocate(this%idxbudtheq,
'IDXBUDTHEQ', this%memoryPath)
978 call mem_setptr(this%tempinfl,
'INFILTRATION', this%input_mempath)
979 call mem_setptr(this%tempuzet,
'UZET', this%input_mempath)
982 call this%TspAptType%apt_allocate_arrays()
996 call this%TspAptType%apt_checkin_deprecated_names()
999 'INFILTRATION', this%input_mempath,
'6.8.2')
1001 'UZET', this%input_mempath,
'6.8.2')
1020 nullify (this%tempinfl)
1021 nullify (this%tempuzet)
1024 call this%TspAptType%bnd_da()
1036 integer(I4B),
intent(in) :: ientry
1037 integer(I4B),
intent(inout) :: n1
1038 integer(I4B),
intent(inout) :: n2
1039 real(DP),
intent(inout),
optional :: rrate
1040 real(DP),
intent(inout),
optional :: rhsval
1041 real(DP),
intent(inout),
optional :: hcofval
1047 n1 = this%flowbudptr%budterm(this%idxbudinfl)%id1(ientry)
1048 n2 = this%flowbudptr%budterm(this%idxbudinfl)%id2(ientry)
1051 qbnd = this%flowbudptr%budterm(this%idxbudinfl)%flow(ientry)
1052 if (qbnd <
dzero)
then
1053 ctmp = this%xnewpak(n1)
1057 ctmp = this%tempinfl(n1)
1061 if (
present(rrate)) rrate = qbnd * ctmp * this%eqnsclfac
1062 if (
present(rhsval)) rhsval = r * this%eqnsclfac
1063 if (
present(hcofval)) hcofval = h * this%eqnsclfac
1077 integer(I4B),
intent(in) :: ientry
1078 integer(I4B),
intent(inout) :: n1
1079 integer(I4B),
intent(inout) :: n2
1080 real(DP),
intent(inout),
optional :: rrate
1081 real(DP),
intent(inout),
optional :: rhsval
1082 real(DP),
intent(inout),
optional :: hcofval
1087 n1 = this%flowbudptr%budterm(this%idxbudrinf)%id1(ientry)
1088 n2 = this%flowbudptr%budterm(this%idxbudrinf)%id2(ientry)
1089 qbnd = this%flowbudptr%budterm(this%idxbudrinf)%flow(ientry)
1090 ctmp = this%tempinfl(n1)
1091 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
1092 if (
present(rhsval)) rhsval =
dzero
1093 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
1105 integer(I4B),
intent(in) :: ientry
1106 integer(I4B),
intent(inout) :: n1
1107 integer(I4B),
intent(inout) :: n2
1108 real(DP),
intent(inout),
optional :: rrate
1109 real(DP),
intent(inout),
optional :: rhsval
1110 real(DP),
intent(inout),
optional :: hcofval
1116 n1 = this%flowbudptr%budterm(this%idxbuduzet)%id1(ientry)
1117 n2 = this%flowbudptr%budterm(this%idxbuduzet)%id2(ientry)
1119 qbnd = this%flowbudptr%budterm(this%idxbuduzet)%flow(ientry)
1120 ctmp = this%tempuzet(n1)
1121 if (this%xnewpak(n1) < ctmp)
then
1126 if (
present(rrate)) &
1127 rrate = (omega * qbnd * this%xnewpak(n1) + &
1128 (
done - omega) * qbnd * ctmp) * this%eqnsclfac
1129 if (
present(rhsval)) rhsval = -(
done - omega) * qbnd * ctmp * this%eqnsclfac
1130 if (
present(hcofval)) hcofval = omega * qbnd * this%eqnsclfac
1144 integer(I4B),
intent(in) :: ientry
1145 integer(I4B),
intent(inout) :: n1
1146 integer(I4B),
intent(inout) :: n2
1147 real(DP),
intent(inout),
optional :: rrate
1148 real(DP),
intent(inout),
optional :: rhsval
1149 real(DP),
intent(inout),
optional :: hcofval
1154 n1 = this%flowbudptr%budterm(this%idxbudritm)%id1(ientry)
1155 n2 = this%flowbudptr%budterm(this%idxbudritm)%id2(ientry)
1156 qbnd = this%flowbudptr%budterm(this%idxbudritm)%flow(ientry)
1157 ctmp = this%tempinfl(n1)
1158 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
1159 if (
present(rhsval)) rhsval =
dzero
1160 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
1173 integer(I4B),
intent(in) :: ientry
1174 integer(I4B),
intent(inout) :: n1
1175 integer(I4B),
intent(inout) :: n2
1176 real(DP),
intent(inout) :: rrate
1180 character(len=LENBUDTXT) :: flowtype
1183 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(ientry)
1184 n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(ientry)
1185 if (this%iboundpak(n1) /= 0)
then
1186 do i = 1, this%budobj%nbudterm
1187 flowtype = this%budobj%budterm(i)%flowtype
1188 select case (trim(adjustl(flowtype)))
1189 case (
'THERMAL-EQUIL')
1193 r = r - this%budobj%budterm(i)%flow(ientry)
1210 integer(I4B) :: indx
1214 call this%obs%StoreObsType(
'temperature', .false., indx)
1219 call this%obs%StoreObsType(
'flow-ja-face', .true., indx)
1224 call this%obs%StoreObsType(
'from-mvr', .true., indx)
1233 call this%obs%StoreObsType(
'storage', .true., indx)
1238 call this%obs%StoreObsType(
'constant', .true., indx)
1243 call this%obs%StoreObsType(
'uze', .true., indx)
1248 call this%obs%StoreObsType(
'infiltration', .true., indx)
1253 call this%obs%StoreObsType(
'rej-inf', .true., indx)
1258 call this%obs%StoreObsType(
'uzet', .true., indx)
1263 call this%obs%StoreObsType(
'rej-inf-to-mvr', .true., indx)
1268 call this%obs%StoreObsType(
'thermal-equil', .true., indx)
1280 logical,
intent(inout) :: found
1283 select case (obsrv%ObsTypeId)
1284 case (
'INFILTRATION')
1285 call this%rp_obs_byfeature(obsrv)
1287 call this%rp_obs_byfeature(obsrv)
1289 call this%rp_obs_byfeature(obsrv)
1290 case (
'REJ-INF-TO-MVR')
1291 call this%rp_obs_byfeature(obsrv)
1292 case (
'THERMAL-EQUIL')
1293 call this%rp_obs_byfeature(obsrv)
1304 character(len=*),
intent(in) :: obstypeid
1305 real(DP),
intent(inout) :: v
1306 integer(I4B),
intent(in) :: jj
1307 logical,
intent(inout) :: found
1309 integer(I4B) :: n1, n2
1312 select case (obstypeid)
1313 case (
'INFILTRATION')
1314 if (this%iboundpak(jj) /= 0 .and. this%idxbudinfl > 0)
then
1315 call this%uze_infl_term(jj, n1, n2, v)
1318 if (this%iboundpak(jj) /= 0 .and. this%idxbudrinf > 0)
then
1319 call this%uze_rinf_term(jj, n1, n2, v)
1322 if (this%iboundpak(jj) /= 0 .and. this%idxbuduzet > 0)
then
1323 call this%uze_uzet_term(jj, n1, n2, v)
1325 case (
'REJ-INF-TO-MVR')
1326 if (this%iboundpak(jj) /= 0 .and. this%idxbudritm > 0)
then
1327 call this%uze_ritm_term(jj, n1, n2, v)
1329 case (
'THERMAL-EQUIL')
1330 if (this%iboundpak(jj) /= 0 .and. this%idxbudtheq > 0)
then
1331 call this%uze_theq_term(jj, n1, n2, v)
1355 integer(I4B) :: igwfnode
1359 nuz = this%flowbudptr%budterm(this%idxbudgwf)%maxlist
1364 igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(n)
1365 carea = this%dis%area(igwfnode)
1366 uzarea = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(1, n)
1368 if (.not.
is_close(carea, uzarea))
then
1369 call this%area_error(igwfnode)
1373 call store_error_filename(this%input_fname)
1385 integer(I4B) :: iloc
1387 character(len=30) :: nodestr
1389 call this%dis%noder_to_string(iloc, nodestr)
1391 'In a GWE model, the area of every UZF object must be equal to that of &
1392 &the host cell. This condition is violated in cell ', &
1393 trim(adjustl(nodestr)),
'. Check use of AUXMULTNAME option in UZF &
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
integer(i4b), parameter izero
integer constant zero
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 uze_ad_chk(this)
Check if UZF object area is not equal to the cell area.
subroutine uze_rp_obs(this, obsrv, found)
Process package specific obs.
character(len= *), parameter ftype
subroutine uze_mc(this, moffset, matrix_sln)
Map package connection to matrix.
subroutine uze_ac(this, moffset, sparse)
Add package connection to matrix.
subroutine allocate_scalars(this)
Allocate scalars.
subroutine, public uze_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
Create a new UZE package.
subroutine uze_setup_budobj(this, idx)
Setup budget object.
subroutine uze_ritm_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rejected infiltration to MVR/MVT term.
subroutine uze_df_obs(this)
Define UZE Observation.
subroutine uze_bd_obs(this, obstypeid, jj, v, found)
Calculate observation value and pass it back to APT.
subroutine uze_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to UZE.
subroutine uze_theq_term(this, ientry, n1, n2, rrate)
Heat transferred through thermal equilibrium with the solid phase.
subroutine uze_rinf_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rejected infiltration term.
integer(i4b) function uze_get_nbudterms(this)
Return the number of UZE-specific budget terms.
subroutine uze_solve(this)
Explicit solve.
character(len= *), parameter flowtype
subroutine uze_checkin_deprecated_names(this)
Alias deprecated UZE variable names to their current storage.
subroutine uze_da(this)
Deallocate memory.
real(dp) function, dimension(:), pointer, contiguous get_mvr_depvar(this)
Override similarly named function in APT.
subroutine find_uze_package(this)
Find corresponding uze package.
subroutine uze_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
Fill UZE budget object.
subroutine uze_allocate_arrays(this)
Allocate arrays.
subroutine area_error(this, iloc)
Print and store error msg indicating area of UZF object is not equal to that of the host cell.
subroutine uze_infl_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Infiltration term.
subroutine uze_uzet_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Evapotranspiration from the unsaturated-zone term.
real(dp) function uze_setting_value(this, itemno, key)
Value for a package-specific PERIOD setting.
This module defines variable data types.
pure logical function, public is_close(a, b, rtol, atol, symmetric)
Check if a real value is approximately equal to another.
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.
integer(i4b) function, public count_errors()
Return number of errors.
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
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 ...