45 character(len=*),
parameter ::
ftype =
'UZE'
46 character(len=*),
parameter ::
flowtype =
'UZF'
47 character(len=16) ::
text =
' UZE'
53 integer(I4B),
pointer :: idxbudinfl => null()
54 integer(I4B),
pointer :: idxbudrinf => null()
55 integer(I4B),
pointer :: idxbuduzet => null()
56 integer(I4B),
pointer :: idxbudritm => null()
57 integer(I4B),
pointer :: idxbudtheq => null()
59 real(dp),
dimension(:),
pointer,
contiguous :: tempinfl => null()
60 real(dp),
dimension(:),
pointer,
contiguous :: tempuzet => null()
92 subroutine uze_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
93 fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
95 class(
bndtype),
pointer :: packobj
96 integer(I4B),
intent(in) :: id
97 integer(I4B),
intent(in) :: ibcnum
98 integer(I4B),
intent(in) :: inunit
99 integer(I4B),
intent(in) :: iout
100 character(len=*),
intent(in) :: namemodel
101 character(len=*),
intent(in) :: pakname
103 real(dp),
intent(in),
pointer :: eqnsclfac
105 character(len=*),
intent(in) :: dvt
106 character(len=*),
intent(in) :: dvu
107 character(len=*),
intent(in) :: dvua
116 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
120 call uzeobj%allocate_scalars()
123 call packobj%pack_initialize()
125 packobj%inunit = inunit
128 packobj%ibcnum = ibcnum
138 uzeobj%eqnsclfac => eqnsclfac
143 uzeobj%gwecommon => gwecommon
146 uzeobj%depvartype = dvt
147 uzeobj%depvarunit = dvu
148 uzeobj%depvarunitabbrev = dvua
159 character(len=LINELENGTH) :: errmsg
160 class(
bndtype),
pointer :: packobj
161 integer(I4B) :: ip, icount
162 integer(I4B) :: nbudterm
172 if (this%fmi%flows_from_file)
then
173 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
174 if (
associated(this%flowbudptr)) found = .true.
177 if (
associated(this%fmi%gwfbndlist))
then
180 do ip = 1, this%fmi%gwfbndlist%Count()
182 if (packobj%packName == this%flowpackagename)
then
187 this%flowpackagebnd => packobj
188 select type (packobj)
190 this%flowbudptr => packobj%budobj
199 if (.not. found)
then
200 write (errmsg,
'(a)')
'Could not find flow package with name '&
201 &//trim(adjustl(this%flowpackagename))//
'.'
203 call this%parser%StoreErrorUnit()
208 nbudterm = this%flowbudptr%nbudterm
209 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
212 write (this%iout,
'(/, a, a)') &
213 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
214 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
215 write (this%iout,
'(a, i0)') &
216 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
218 do ip = 1, this%flowbudptr%nbudterm
219 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
220 case (
'FLOW-JA-FACE')
222 this%idxbudssm(ip) = 0
225 this%idxbudssm(ip) = 0
228 this%idxbudssm(ip) = 0
229 case (
'INFILTRATION')
231 this%idxbudssm(ip) = 0
234 this%idxbudssm(ip) = 0
237 this%idxbudssm(ip) = 0
238 case (
'REJ-INF-TO-MVR')
240 this%idxbudssm(ip) = 0
243 this%idxbudssm(ip) = 0
246 this%idxbudssm(ip) = 0
249 this%idxbudssm(ip) = 0
254 this%idxbudssm(ip) = icount
258 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
259 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
260 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
262 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
265 this%idxbudtheq = this%flowbudptr%nbudterm + 1
279 integer(I4B),
intent(in) :: moffset
282 integer(I4B) :: i, ii
288 integer(I4B) :: idxjj
289 integer(I4B) :: idxnglo
290 integer(I4B) :: idxjglo
293 if (this%imatrows /= 0)
then
297 nglo = moffset + this%dis%nodes + this%ioffset + n
298 call sparse%addconnection(nglo, nglo, 1)
304 do i = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
305 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(i)
306 jj = this%flowbudptr%budterm(this%idxbudgwf)%id2(i)
307 nglo = moffset + this%dis%nodes + this%ioffset + n
309 call sparse%addconnection(nglo, jglo, 1)
310 call sparse%addconnection(jglo, nglo, 1)
318 if (this%idxbudfjf /= 0)
then
319 do i = 1, this%flowbudptr%budterm(this%idxbudfjf)%maxlist
320 n = this%flowbudptr%budterm(this%idxbudfjf)%id1(i)
321 jj = this%flowbudptr%budterm(this%idxbudfjf)%id2(i)
322 nglo = moffset + this%dis%nodes + this%ioffset + n
323 jglo = moffset + this%dis%nodes + this%ioffset + jj
326 do ii = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
327 idxn = this%flowbudptr%budterm(this%idxbudgwf)%id1(ii)
328 idxjj = this%flowbudptr%budterm(this%idxbudgwf)%id2(ii)
329 idxnglo = moffset + this%dis%nodes + this%ioffset + idxn
330 idxjglo = moffset + idxjj
331 if (nglo == idxnglo)
exit
333 call sparse%addconnection(idxjglo, jglo, 1)
341 subroutine uze_mc(this, moffset, matrix_sln)
345 integer(I4B),
intent(in) :: moffset
348 integer(I4B) :: n, j, iglo, jglo
349 integer(I4B) :: idxn, idxj, idxiglo, idxjglo
350 integer(I4B) :: ipos, idxpos
353 call this%apt_allocate_index_arrays()
356 if (this%imatrows /= 0)
then
365 iglo = moffset + this%dis%nodes + this%ioffset + n
366 this%idxpakdiag(n) = matrix_sln%get_position_diag(iglo)
370 do ipos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
371 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(ipos)
372 j = this%flowbudptr%budterm(this%idxbudgwf)%id2(ipos)
373 iglo = moffset + this%dis%nodes + this%ioffset + n
378 this%idxlocnode(n) = j
382 this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
383 this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
387 do ipos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
388 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(ipos)
389 j = this%flowbudptr%budterm(this%idxbudgwf)%id2(ipos)
391 jglo = moffset + this%dis%nodes + this%ioffset + n
395 this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
396 this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
400 if (this%idxbudfjf /= 0)
then
401 do ipos = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
402 n = this%flowbudptr%budterm(this%idxbudfjf)%id1(ipos)
403 j = this%flowbudptr%budterm(this%idxbudfjf)%id2(ipos)
404 iglo = moffset + this%dis%nodes + this%ioffset + n
405 jglo = moffset + this%dis%nodes + this%ioffset + j
408 do idxpos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
409 idxn = this%flowbudptr%budterm(this%idxbudgwf)%id1(idxpos)
410 idxj = this%flowbudptr%budterm(this%idxbudgwf)%id2(idxpos)
411 idxjglo = moffset + this%dis%nodes + this%ioffset + idxn
412 idxiglo = moffset + idxj
413 if (idxjglo == iglo)
exit
419 this%idxfjfdglo(ipos) = matrix_sln%get_position_diag(idxiglo)
420 this%idxfjfoffdglo(ipos) = matrix_sln%get_position(idxiglo, jglo)
434 real(DP),
dimension(:),
intent(inout) :: rhs
435 integer(I4B),
dimension(:),
intent(in) :: ia
436 integer(I4B),
dimension(:),
intent(in) :: idxglo
439 integer(I4B) :: j, n, n1, n2
441 integer(I4B) :: iposd, iposoffd
442 integer(I4B) :: ipossymoffd
454 if (this%idxbudinfl /= 0)
then
455 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
456 call this%uze_infl_term(j, n1, n2, rrate, rhsval, hcofval)
457 iloc = this%idxlocnode(n1)
458 ipossymoffd = this%idxsymoffdglo(j)
459 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
460 rhs(iloc) = rhs(iloc) + rhsval
465 if (this%idxbudrinf /= 0)
then
466 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
467 call this%uze_rinf_term(j, n1, n2, rrate, rhsval, hcofval)
468 iloc = this%idxlocnode(n1)
469 ipossymoffd = this%idxsymoffdglo(j)
470 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
471 rhs(iloc) = rhs(iloc) + rhsval
476 if (this%idxbuduzet /= 0)
then
477 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
478 call this%uze_uzet_term(j, n1, n2, rrate, rhsval, hcofval)
479 iloc = this%idxlocnode(n1)
480 ipossymoffd = this%idxsymoffdglo(j)
481 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
482 rhs(iloc) = rhs(iloc) + rhsval
487 if (this%idxbudritm /= 0)
then
488 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
489 call this%uze_ritm_term(j, n1, n2, rrate, rhsval, hcofval)
490 iloc = this%idxlocnode(n1)
491 ipossymoffd = this%idxsymoffdglo(j)
492 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
493 rhs(iloc) = rhs(iloc) + rhsval
502 cold = this%xoldpak(n)
503 iloc = this%idxlocnode(n)
504 ipossymoffd = this%idxsymoffdglo(n)
505 call this%apt_stor_term(n, n1, n2, rrate, rhsval, hcofval)
506 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
507 rhs(iloc) = rhs(iloc) + rhsval
511 if (this%idxbudtmvr /= 0)
then
512 do j = 1, this%flowbudptr%budterm(this%idxbudtmvr)%nlist
513 call this%apt_tmvr_term(j, n1, n2, rrate, rhsval, hcofval)
514 iloc = this%idxlocnode(n1)
515 ipossymoffd = this%idxsymoffdglo(j)
516 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
517 rhs(iloc) = rhs(iloc) + rhsval
522 if (this%idxbudfmvr /= 0)
then
524 rhsval = this%qmfrommvr(n)
525 iloc = this%idxlocnode(n)
526 rhs(iloc) = rhs(iloc) - rhsval
531 do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
534 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
535 if (this%iboundpak(n) /= 0)
then
539 iposd = this%idxdglo(j)
540 iposoffd = this%idxoffdglo(j)
541 call matrix_sln%add_value_pos(iposd,
done)
542 call matrix_sln%add_value_pos(iposoffd, -
done)
547 if (this%idxbudfjf /= 0)
then
548 do j = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
549 n1 = this%flowbudptr%budterm(this%idxbudfjf)%id1(j)
550 n2 = this%flowbudptr%budterm(this%idxbudfjf)%id2(j)
551 qbnd = this%flowbudptr%budterm(this%idxbudfjf)%flow(j)
552 if (qbnd <=
dzero)
then
557 iposd = this%idxfjfdglo(j)
558 iposoffd = this%idxfjfoffdglo(j)
559 call matrix_sln%add_value_pos(iposd, omega * qbnd * this%eqnsclfac)
560 call matrix_sln%add_value_pos(iposoffd, &
561 (
done - omega) * qbnd * this%eqnsclfac)
576 integer(I4B) :: n1, n2
580 if (this%idxbudinfl /= 0)
then
581 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
582 call this%uze_infl_term(j, n1, n2, rrate)
583 this%dbuff(n1) = this%dbuff(n1) + rrate
588 if (this%idxbudrinf /= 0)
then
589 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
590 call this%uze_rinf_term(j, n1, n2, rrate)
591 this%dbuff(n1) = this%dbuff(n1) + rrate
596 if (this%idxbuduzet /= 0)
then
597 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
598 call this%uze_uzet_term(j, n1, n2, rrate)
599 this%dbuff(n1) = this%dbuff(n1) + rrate
604 if (this%idxbudritm /= 0)
then
605 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
606 call this%uze_ritm_term(j, n1, n2, rrate)
607 this%dbuff(n1) = this%dbuff(n1) + rrate
621 integer(I4B) :: nbudterms
625 if (this%idxbudinfl /= 0) nbudterms = nbudterms + 1
626 if (this%idxbudrinf /= 0) nbudterms = nbudterms + 1
627 if (this%idxbuduzet /= 0) nbudterms = nbudterms + 1
628 if (this%idxbudritm /= 0) nbudterms = nbudterms + 1
629 if (this%idxbudtheq /= 0) nbudterms = nbudterms + 1
656 integer(I4B),
intent(inout) :: idx
658 integer(I4B) :: maxlist, naux
659 character(len=LENBUDTXT) :: text
662 text =
' INFILTRATION'
664 maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist
666 call this%budobj%budterm(idx)%initialize(text, &
671 maxlist, .false., .false., &
675 if (this%idxbudrinf /= 0)
then
678 maxlist = this%flowbudptr%budterm(this%idxbudrinf)%maxlist
680 call this%budobj%budterm(idx)%initialize(text, &
685 maxlist, .false., .false., &
690 if (this%idxbuduzet /= 0)
then
693 maxlist = this%flowbudptr%budterm(this%idxbuduzet)%maxlist
695 call this%budobj%budterm(idx)%initialize(text, &
700 maxlist, .false., .false., &
705 if (this%idxbudritm /= 0)
then
706 text =
' INF-REJ-TO-MVR'
708 maxlist = this%flowbudptr%budterm(this%idxbudritm)%maxlist
710 call this%budobj%budterm(idx)%initialize(text, &
715 maxlist, .false., .false., &
720 text =
' THERMAL-EQUIL'
723 maxlist = this%flowbudptr%budterm(this%idxbudgwf)%maxlist
725 call this%budobj%budterm(idx)%initialize(text, &
730 maxlist, .false., .false., &
742 integer(I4B),
intent(inout) :: idx
743 real(DP),
dimension(:),
intent(in) :: x
744 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
745 real(DP),
intent(inout) :: ccratin
746 real(DP),
intent(inout) :: ccratout
748 integer(I4B) :: j, n1, n2, indx
749 integer(I4B) :: nlist, nlen
750 integer(I4B) :: igwfnode
751 integer(I4B) :: idiag
753 real(DP),
dimension(:),
allocatable :: budresid
755 allocate (budresid(this%ncv))
764 if (this%idxbudfjf /= 0)
then
765 nlen = this%flowbudptr%budterm(this%idxbudfjf)%maxlist
769 nlist = this%budobj%budterm(indx)%nlist
771 n1 = this%budobj%budterm(indx)%id1(j)
772 n2 = this%budobj%budterm(indx)%id2(j)
774 q = this%budobj%budterm(indx)%flow(j)
775 budresid(n1) = budresid(n1) + q
776 budresid(n2) = budresid(n2) - q
783 nlist = this%budobj%budterm(indx)%nlist
785 n1 = this%budobj%budterm(indx)%id1(j)
786 q = this%budobj%budterm(indx)%flow(j)
787 budresid(n1) = budresid(n1) + q
791 indx = this%idxlastpak
796 q = this%budobj%budterm(indx)%flow(n1)
797 budresid(n1) = budresid(n1) + q
801 if (this%idxbudtmvr /= 0)
then
803 nlist = this%budobj%budterm(indx)%nlist
805 n1 = this%budobj%budterm(indx)%id1(j)
806 q = this%budobj%budterm(indx)%flow(j)
807 budresid(n1) = budresid(n1) + q
812 if (this%idxbudfmvr /= 0)
then
814 nlist = this%budobj%budterm(indx)%nlist
816 n1 = this%budobj%budterm(indx)%id1(j)
817 q = this%budobj%budterm(indx)%flow(j)
818 budresid(n1) = budresid(n1) + q
825 q = this%budobj%budterm(indx)%flow(n1)
826 budresid(n1) = budresid(n1) + q
836 nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist
837 call this%budobj%budterm(idx)%reset(nlist)
839 call this%uze_infl_term(j, n1, n2, q)
840 call this%budobj%budterm(idx)%update_term(n1, n2, q)
841 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
842 budresid(n1) = budresid(n1) + q
846 if (this%idxbudrinf /= 0)
then
848 nlist = this%flowbudptr%budterm(this%idxbudrinf)%nlist
849 call this%budobj%budterm(idx)%reset(nlist)
851 call this%uze_rinf_term(j, n1, n2, q)
852 call this%budobj%budterm(idx)%update_term(n1, n2, q)
853 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
854 budresid(n1) = budresid(n1) + q
859 if (this%idxbuduzet /= 0)
then
861 nlist = this%flowbudptr%budterm(this%idxbuduzet)%nlist
862 call this%budobj%budterm(idx)%reset(nlist)
864 call this%uze_uzet_term(j, n1, n2, q)
865 call this%budobj%budterm(idx)%update_term(n1, n2, q)
866 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
867 budresid(n1) = budresid(n1) + q
872 if (this%idxbudritm /= 0)
then
874 nlist = this%flowbudptr%budterm(this%idxbudritm)%nlist
875 call this%budobj%budterm(idx)%reset(nlist)
877 call this%uze_ritm_term(j, n1, n2, q)
878 call this%budobj%budterm(idx)%update_term(n1, n2, q)
879 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
880 budresid(n1) = budresid(n1) + q
887 nlist = this%flowbudptr%budterm(this%idxbudgwf)%nlist
888 call this%budobj%budterm(idx)%reset(nlist)
890 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
891 igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(j)
893 call this%uze_theq_term(j, n1, igwfnode, q)
894 call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
895 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
896 if (this%iboundpak(n1) /= 0)
then
898 this%simvals(n1) = this%simvals(n1) - q
899 idiag = this%dis%con%ia(igwfnode)
900 flowja(idiag) = flowja(idiag) - q
904 deallocate (budresid)
919 call this%TspAptType%allocate_scalars()
922 call mem_allocate(this%idxbudinfl,
'IDXBUDINFL', this%memoryPath)
923 call mem_allocate(this%idxbudrinf,
'IDXBUDRINF', this%memoryPath)
924 call mem_allocate(this%idxbuduzet,
'IDXBUDUZET', this%memoryPath)
925 call mem_allocate(this%idxbudritm,
'IDXBUDRITM', this%memoryPath)
926 call mem_allocate(this%idxbudtheq,
'IDXBUDTHEQ', this%memoryPath)
949 call mem_allocate(this%tempinfl, this%ncv,
'TEMPINFL', this%memoryPath)
950 call mem_allocate(this%tempuzet, this%ncv,
'TEMPUZET', this%memoryPath)
953 call this%TspAptType%apt_allocate_arrays()
957 this%tempinfl(n) =
dzero
958 this%tempuzet(n) =
dzero
982 call this%TspAptType%bnd_da()
994 integer(I4B),
intent(in) :: ientry
995 integer(I4B),
intent(inout) :: n1
996 integer(I4B),
intent(inout) :: n2
997 real(DP),
intent(inout),
optional :: rrate
998 real(DP),
intent(inout),
optional :: rhsval
999 real(DP),
intent(inout),
optional :: hcofval
1005 n1 = this%flowbudptr%budterm(this%idxbudinfl)%id1(ientry)
1006 n2 = this%flowbudptr%budterm(this%idxbudinfl)%id2(ientry)
1009 qbnd = this%flowbudptr%budterm(this%idxbudinfl)%flow(ientry)
1010 if (qbnd <
dzero)
then
1011 ctmp = this%xnewpak(n1)
1015 ctmp = this%tempinfl(n1)
1019 if (
present(rrate)) rrate = qbnd * ctmp * this%eqnsclfac
1020 if (
present(rhsval)) rhsval = r * this%eqnsclfac
1021 if (
present(hcofval)) hcofval = h * this%eqnsclfac
1035 integer(I4B),
intent(in) :: ientry
1036 integer(I4B),
intent(inout) :: n1
1037 integer(I4B),
intent(inout) :: n2
1038 real(DP),
intent(inout),
optional :: rrate
1039 real(DP),
intent(inout),
optional :: rhsval
1040 real(DP),
intent(inout),
optional :: hcofval
1045 n1 = this%flowbudptr%budterm(this%idxbudrinf)%id1(ientry)
1046 n2 = this%flowbudptr%budterm(this%idxbudrinf)%id2(ientry)
1047 qbnd = this%flowbudptr%budterm(this%idxbudrinf)%flow(ientry)
1048 ctmp = this%tempinfl(n1)
1049 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
1050 if (
present(rhsval)) rhsval =
dzero
1051 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
1063 integer(I4B),
intent(in) :: ientry
1064 integer(I4B),
intent(inout) :: n1
1065 integer(I4B),
intent(inout) :: n2
1066 real(DP),
intent(inout),
optional :: rrate
1067 real(DP),
intent(inout),
optional :: rhsval
1068 real(DP),
intent(inout),
optional :: hcofval
1074 n1 = this%flowbudptr%budterm(this%idxbuduzet)%id1(ientry)
1075 n2 = this%flowbudptr%budterm(this%idxbuduzet)%id2(ientry)
1077 qbnd = this%flowbudptr%budterm(this%idxbuduzet)%flow(ientry)
1078 ctmp = this%tempuzet(n1)
1079 if (this%xnewpak(n1) < ctmp)
then
1084 if (
present(rrate)) &
1085 rrate = (omega * qbnd * this%xnewpak(n1) + &
1086 (
done - omega) * qbnd * ctmp) * this%eqnsclfac
1087 if (
present(rhsval)) rhsval = -(
done - omega) * qbnd * ctmp * this%eqnsclfac
1088 if (
present(hcofval)) hcofval = omega * qbnd * this%eqnsclfac
1102 integer(I4B),
intent(in) :: ientry
1103 integer(I4B),
intent(inout) :: n1
1104 integer(I4B),
intent(inout) :: n2
1105 real(DP),
intent(inout),
optional :: rrate
1106 real(DP),
intent(inout),
optional :: rhsval
1107 real(DP),
intent(inout),
optional :: hcofval
1112 n1 = this%flowbudptr%budterm(this%idxbudritm)%id1(ientry)
1113 n2 = this%flowbudptr%budterm(this%idxbudritm)%id2(ientry)
1114 qbnd = this%flowbudptr%budterm(this%idxbudritm)%flow(ientry)
1115 ctmp = this%tempinfl(n1)
1116 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
1117 if (
present(rhsval)) rhsval =
dzero
1118 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
1131 integer(I4B),
intent(in) :: ientry
1132 integer(I4B),
intent(inout) :: n1
1133 integer(I4B),
intent(inout) :: n2
1134 real(DP),
intent(inout) :: rrate
1138 character(len=LENBUDTXT) :: flowtype
1141 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(ientry)
1142 n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(ientry)
1143 if (this%iboundpak(n1) /= 0)
then
1144 do i = 1, this%budobj%nbudterm
1145 flowtype = this%budobj%budterm(i)%flowtype
1146 select case (trim(adjustl(flowtype)))
1147 case (
'THERMAL-EQUIL')
1151 r = r - this%budobj%budterm(i)%flow(ientry)
1168 integer(I4B) :: indx
1172 call this%obs%StoreObsType(
'temperature', .false., indx)
1177 call this%obs%StoreObsType(
'flow-ja-face', .true., indx)
1182 call this%obs%StoreObsType(
'from-mvr', .true., indx)
1191 call this%obs%StoreObsType(
'storage', .true., indx)
1196 call this%obs%StoreObsType(
'constant', .true., indx)
1201 call this%obs%StoreObsType(
'uze', .true., indx)
1206 call this%obs%StoreObsType(
'infiltration', .true., indx)
1211 call this%obs%StoreObsType(
'rej-inf', .true., indx)
1216 call this%obs%StoreObsType(
'uzet', .true., indx)
1221 call this%obs%StoreObsType(
'rej-inf-to-mvr', .true., indx)
1226 call this%obs%StoreObsType(
'thermal-equil', .true., indx)
1238 logical,
intent(inout) :: found
1241 select case (obsrv%ObsTypeId)
1242 case (
'INFILTRATION')
1243 call this%rp_obs_byfeature(obsrv)
1245 call this%rp_obs_byfeature(obsrv)
1247 call this%rp_obs_byfeature(obsrv)
1248 case (
'REJ-INF-TO-MVR')
1249 call this%rp_obs_byfeature(obsrv)
1250 case (
'THERMAL-EQUIL')
1251 call this%rp_obs_byfeature(obsrv)
1262 character(len=*),
intent(in) :: obstypeid
1263 real(DP),
intent(inout) :: v
1264 integer(I4B),
intent(in) :: jj
1265 logical,
intent(inout) :: found
1267 integer(I4B) :: n1, n2
1270 select case (obstypeid)
1271 case (
'INFILTRATION')
1272 if (this%iboundpak(jj) /= 0 .and. this%idxbudinfl > 0)
then
1273 call this%uze_infl_term(jj, n1, n2, v)
1276 if (this%iboundpak(jj) /= 0 .and. this%idxbudrinf > 0)
then
1277 call this%uze_rinf_term(jj, n1, n2, v)
1280 if (this%iboundpak(jj) /= 0 .and. this%idxbuduzet > 0)
then
1281 call this%uze_uzet_term(jj, n1, n2, v)
1283 case (
'REJ-INF-TO-MVR')
1284 if (this%iboundpak(jj) /= 0 .and. this%idxbudritm > 0)
then
1285 call this%uze_ritm_term(jj, n1, n2, v)
1287 case (
'THERMAL-EQUIL')
1288 if (this%iboundpak(jj) /= 0 .and. this%idxbudtheq > 0)
then
1289 call this%uze_theq_term(jj, n1, n2, v)
1303 integer(I4B),
intent(in) :: itemno
1304 character(len=*),
intent(in) :: keyword
1305 logical,
intent(inout) :: found
1307 character(len=LINELENGTH) :: temp_text
1308 integer(I4B) :: ierr
1310 real(DP),
pointer :: bndElem => null()
1316 select case (keyword)
1317 case (
'INFILTRATION')
1318 ierr = this%apt_check_valid(itemno)
1322 call this%parser%GetString(temp_text)
1324 bndelem => this%tempinfl(itemno)
1326 this%packName,
'BND', this%tsManager, &
1327 this%iprpak,
'INFILTRATION')
1329 ierr = this%apt_check_valid(itemno)
1333 call this%parser%GetString(temp_text)
1335 bndelem => this%tempuzet(itemno)
1337 this%packName,
'BND', this%tsManager, &
1338 this%iprpak,
'UZET')
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 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 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_set_stressperiod(this, itemno, keyword, found)
Sets the stress period attributes for keyword use.
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, public uze_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
Create a new UZE package.
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_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 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.
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.