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
162 character(len=LINELENGTH) :: errmsg
163 class(
bndtype),
pointer :: packobj
164 integer(I4B) :: ip, icount
165 integer(I4B) :: nbudterm
175 if (this%fmi%flows_from_file)
then
176 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
177 if (
associated(this%flowbudptr)) found = .true.
180 if (
associated(this%fmi%gwfbndlist))
then
183 do ip = 1, this%fmi%gwfbndlist%Count()
185 if (packobj%packName == this%flowpackagename)
then
190 this%flowpackagebnd => packobj
191 select type (packobj)
193 this%flowbudptr => packobj%budobj
202 if (.not. found)
then
203 write (errmsg,
'(a)')
'COULD NOT FIND FLOW PACKAGE WITH NAME '&
204 &//trim(adjustl(this%flowpackagename))//
'.'
206 call this%parser%StoreErrorUnit()
211 nbudterm = this%flowbudptr%nbudterm
212 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
215 write (this%iout,
'(/, a, a)') &
216 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
217 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
218 write (this%iout,
'(a, i0)') &
219 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
221 do ip = 1, this%flowbudptr%nbudterm
222 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
223 case (
'FLOW-JA-FACE')
225 this%idxbudssm(ip) = 0
228 this%idxbudssm(ip) = 0
231 this%idxbudssm(ip) = 0
232 case (
'INFILTRATION')
234 this%idxbudssm(ip) = 0
237 this%idxbudssm(ip) = 0
240 this%idxbudssm(ip) = 0
241 case (
'REJ-INF-TO-MVR')
243 this%idxbudssm(ip) = 0
246 this%idxbudssm(ip) = 0
249 this%idxbudssm(ip) = 0
252 this%idxbudssm(ip) = 0
257 this%idxbudssm(ip) = icount
261 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
262 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
263 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
265 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
268 this%idxbudtheq = this%flowbudptr%nbudterm + 1
285 integer(I4B),
intent(in) :: moffset
288 integer(I4B) :: i, ii
294 integer(I4B) :: idxjj
295 integer(I4B) :: idxnglo
296 integer(I4B) :: idxjglo
299 if (this%imatrows /= 0)
then
303 nglo = moffset + this%dis%nodes + this%ioffset + n
304 call sparse%addconnection(nglo, nglo, 1)
310 do i = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
311 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(i)
312 jj = this%flowbudptr%budterm(this%idxbudgwf)%id2(i)
313 nglo = moffset + this%dis%nodes + this%ioffset + n
315 call sparse%addconnection(nglo, jglo, 1)
316 call sparse%addconnection(jglo, nglo, 1)
324 if (this%idxbudfjf /= 0)
then
325 do i = 1, this%flowbudptr%budterm(this%idxbudfjf)%maxlist
326 n = this%flowbudptr%budterm(this%idxbudfjf)%id1(i)
327 jj = this%flowbudptr%budterm(this%idxbudfjf)%id2(i)
328 nglo = moffset + this%dis%nodes + this%ioffset + n
329 jglo = moffset + this%dis%nodes + this%ioffset + jj
332 do ii = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
333 idxn = this%flowbudptr%budterm(this%idxbudgwf)%id1(ii)
334 idxjj = this%flowbudptr%budterm(this%idxbudgwf)%id2(ii)
335 idxnglo = moffset + this%dis%nodes + this%ioffset + idxn
336 idxjglo = moffset + idxjj
337 if (nglo == idxnglo)
exit
339 call sparse%addconnection(idxjglo, jglo, 1)
350 subroutine uze_mc(this, moffset, matrix_sln)
354 integer(I4B),
intent(in) :: moffset
357 integer(I4B) :: n, j, iglo, jglo
358 integer(I4B) :: idxn, idxj, idxiglo, idxjglo
359 integer(I4B) :: ipos, idxpos
362 call this%apt_allocate_index_arrays()
365 if (this%imatrows /= 0)
then
374 iglo = moffset + this%dis%nodes + this%ioffset + n
375 this%idxpakdiag(n) = matrix_sln%get_position_diag(iglo)
379 do ipos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
380 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(ipos)
381 j = this%flowbudptr%budterm(this%idxbudgwf)%id2(ipos)
382 iglo = moffset + this%dis%nodes + this%ioffset + n
387 this%idxlocnode(n) = j
391 this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
392 this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
396 do ipos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
397 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(ipos)
398 j = this%flowbudptr%budterm(this%idxbudgwf)%id2(ipos)
400 jglo = moffset + this%dis%nodes + this%ioffset + n
404 this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
405 this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
409 if (this%idxbudfjf /= 0)
then
410 do ipos = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
411 n = this%flowbudptr%budterm(this%idxbudfjf)%id1(ipos)
412 j = this%flowbudptr%budterm(this%idxbudfjf)%id2(ipos)
413 iglo = moffset + this%dis%nodes + this%ioffset + n
414 jglo = moffset + this%dis%nodes + this%ioffset + j
417 do idxpos = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
418 idxn = this%flowbudptr%budterm(this%idxbudgwf)%id1(idxpos)
419 idxj = this%flowbudptr%budterm(this%idxbudgwf)%id2(idxpos)
420 idxjglo = moffset + this%dis%nodes + this%ioffset + idxn
421 idxiglo = moffset + idxj
422 if (idxjglo == iglo)
exit
428 this%idxfjfdglo(ipos) = matrix_sln%get_position_diag(idxiglo)
429 this%idxfjfoffdglo(ipos) = matrix_sln%get_position(idxiglo, jglo)
446 real(DP),
dimension(:),
intent(inout) :: rhs
447 integer(I4B),
dimension(:),
intent(in) :: ia
448 integer(I4B),
dimension(:),
intent(in) :: idxglo
451 integer(I4B) :: j, n, n1, n2
453 integer(I4B) :: iposd, iposoffd
454 integer(I4B) :: ipossymoffd
466 if (this%idxbudinfl /= 0)
then
467 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
468 call this%uze_infl_term(j, n1, n2, rrate, rhsval, hcofval)
469 iloc = this%idxlocnode(n1)
470 ipossymoffd = this%idxsymoffdglo(j)
471 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
472 rhs(iloc) = rhs(iloc) + rhsval
477 if (this%idxbudrinf /= 0)
then
478 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
479 call this%uze_rinf_term(j, n1, n2, rrate, rhsval, hcofval)
480 iloc = this%idxlocnode(n1)
481 ipossymoffd = this%idxsymoffdglo(j)
482 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
483 rhs(iloc) = rhs(iloc) + rhsval
488 if (this%idxbuduzet /= 0)
then
489 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
490 call this%uze_uzet_term(j, n1, n2, rrate, rhsval, hcofval)
491 iloc = this%idxlocnode(n1)
492 ipossymoffd = this%idxsymoffdglo(j)
493 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
494 rhs(iloc) = rhs(iloc) + rhsval
499 if (this%idxbudritm /= 0)
then
500 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
501 call this%uze_ritm_term(j, n1, n2, rrate, rhsval, hcofval)
502 iloc = this%idxlocnode(n1)
503 ipossymoffd = this%idxsymoffdglo(j)
504 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
505 rhs(iloc) = rhs(iloc) + rhsval
514 cold = this%xoldpak(n)
515 iloc = this%idxlocnode(n)
516 ipossymoffd = this%idxsymoffdglo(n)
517 call this%apt_stor_term(n, n1, n2, rrate, rhsval, hcofval)
518 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
519 rhs(iloc) = rhs(iloc) + rhsval
523 if (this%idxbudtmvr /= 0)
then
524 do j = 1, this%flowbudptr%budterm(this%idxbudtmvr)%nlist
525 call this%apt_tmvr_term(j, n1, n2, rrate, rhsval, hcofval)
526 iloc = this%idxlocnode(n1)
527 ipossymoffd = this%idxsymoffdglo(j)
528 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
529 rhs(iloc) = rhs(iloc) + rhsval
534 if (this%idxbudfmvr /= 0)
then
536 rhsval = this%qmfrommvr(n)
537 iloc = this%idxlocnode(n)
538 rhs(iloc) = rhs(iloc) - rhsval
543 do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
546 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
547 if (this%iboundpak(n) /= 0)
then
551 iposd = this%idxdglo(j)
552 iposoffd = this%idxoffdglo(j)
553 call matrix_sln%add_value_pos(iposd,
done)
554 call matrix_sln%add_value_pos(iposoffd, -
done)
559 if (this%idxbudfjf /= 0)
then
560 do j = 1, this%flowbudptr%budterm(this%idxbudfjf)%nlist
561 n1 = this%flowbudptr%budterm(this%idxbudfjf)%id1(j)
562 n2 = this%flowbudptr%budterm(this%idxbudfjf)%id2(j)
563 qbnd = this%flowbudptr%budterm(this%idxbudfjf)%flow(j)
564 if (qbnd <=
dzero)
then
569 iposd = this%idxfjfdglo(j)
570 iposoffd = this%idxfjfoffdglo(j)
571 call matrix_sln%add_value_pos(iposd, omega * qbnd * this%eqnsclfac)
572 call matrix_sln%add_value_pos(iposoffd, &
573 (
done - omega) * qbnd * this%eqnsclfac)
591 integer(I4B) :: n1, n2
595 if (this%idxbudinfl /= 0)
then
596 do j = 1, this%flowbudptr%budterm(this%idxbudinfl)%nlist
597 call this%uze_infl_term(j, n1, n2, rrate)
598 this%dbuff(n1) = this%dbuff(n1) + rrate
603 if (this%idxbudrinf /= 0)
then
604 do j = 1, this%flowbudptr%budterm(this%idxbudrinf)%nlist
605 call this%uze_rinf_term(j, n1, n2, rrate)
606 this%dbuff(n1) = this%dbuff(n1) + rrate
611 if (this%idxbuduzet /= 0)
then
612 do j = 1, this%flowbudptr%budterm(this%idxbuduzet)%nlist
613 call this%uze_uzet_term(j, n1, n2, rrate)
614 this%dbuff(n1) = this%dbuff(n1) + rrate
619 if (this%idxbudritm /= 0)
then
620 do j = 1, this%flowbudptr%budterm(this%idxbudritm)%nlist
621 call this%uze_ritm_term(j, n1, n2, rrate)
622 this%dbuff(n1) = this%dbuff(n1) + rrate
639 integer(I4B) :: nbudterms
643 if (this%idxbudinfl /= 0) nbudterms = nbudterms + 1
644 if (this%idxbudrinf /= 0) nbudterms = nbudterms + 1
645 if (this%idxbuduzet /= 0) nbudterms = nbudterms + 1
646 if (this%idxbudritm /= 0) nbudterms = nbudterms + 1
647 if (this%idxbudtheq /= 0) nbudterms = nbudterms + 1
677 integer(I4B),
intent(inout) :: idx
679 integer(I4B) :: maxlist, naux
680 character(len=LENBUDTXT) :: text
683 text =
' INFILTRATION'
685 maxlist = this%flowbudptr%budterm(this%idxbudinfl)%maxlist
687 call this%budobj%budterm(idx)%initialize(text, &
692 maxlist, .false., .false., &
696 if (this%idxbudrinf /= 0)
then
699 maxlist = this%flowbudptr%budterm(this%idxbudrinf)%maxlist
701 call this%budobj%budterm(idx)%initialize(text, &
706 maxlist, .false., .false., &
711 if (this%idxbuduzet /= 0)
then
714 maxlist = this%flowbudptr%budterm(this%idxbuduzet)%maxlist
716 call this%budobj%budterm(idx)%initialize(text, &
721 maxlist, .false., .false., &
726 if (this%idxbudritm /= 0)
then
727 text =
' INF-REJ-TO-MVR'
729 maxlist = this%flowbudptr%budterm(this%idxbudritm)%maxlist
731 call this%budobj%budterm(idx)%initialize(text, &
736 maxlist, .false., .false., &
741 text =
' THERMAL-EQUIL'
744 maxlist = this%flowbudptr%budterm(this%idxbudgwf)%maxlist
746 call this%budobj%budterm(idx)%initialize(text, &
751 maxlist, .false., .false., &
766 integer(I4B),
intent(inout) :: idx
767 real(DP),
dimension(:),
intent(in) :: x
768 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
769 real(DP),
intent(inout) :: ccratin
770 real(DP),
intent(inout) :: ccratout
772 integer(I4B) :: j, n1, n2, indx
773 integer(I4B) :: nlist, nlen
774 integer(I4B) :: igwfnode
775 integer(I4B) :: idiag
777 real(DP),
dimension(:),
allocatable :: budresid
779 allocate (budresid(this%ncv))
788 if (this%idxbudfjf /= 0)
then
789 nlen = this%flowbudptr%budterm(this%idxbudfjf)%maxlist
793 nlist = this%budobj%budterm(indx)%nlist
795 n1 = this%budobj%budterm(indx)%id1(j)
796 n2 = this%budobj%budterm(indx)%id2(j)
798 q = this%budobj%budterm(indx)%flow(j)
799 budresid(n1) = budresid(n1) + q
800 budresid(n2) = budresid(n2) - q
807 nlist = this%budobj%budterm(indx)%nlist
809 n1 = this%budobj%budterm(indx)%id1(j)
810 q = this%budobj%budterm(indx)%flow(j)
811 budresid(n1) = budresid(n1) + q
815 indx = this%idxlastpak
820 q = this%budobj%budterm(indx)%flow(n1)
821 budresid(n1) = budresid(n1) + q
825 if (this%idxbudtmvr /= 0)
then
827 nlist = this%budobj%budterm(indx)%nlist
829 n1 = this%budobj%budterm(indx)%id1(j)
830 q = this%budobj%budterm(indx)%flow(j)
831 budresid(n1) = budresid(n1) + q
836 if (this%idxbudfmvr /= 0)
then
838 nlist = this%budobj%budterm(indx)%nlist
840 n1 = this%budobj%budterm(indx)%id1(j)
841 q = this%budobj%budterm(indx)%flow(j)
842 budresid(n1) = budresid(n1) + q
849 q = this%budobj%budterm(indx)%flow(n1)
850 budresid(n1) = budresid(n1) + q
860 nlist = this%flowbudptr%budterm(this%idxbudinfl)%nlist
861 call this%budobj%budterm(idx)%reset(nlist)
863 call this%uze_infl_term(j, n1, n2, q)
864 call this%budobj%budterm(idx)%update_term(n1, n2, q)
865 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
866 budresid(n1) = budresid(n1) + q
870 if (this%idxbudrinf /= 0)
then
872 nlist = this%flowbudptr%budterm(this%idxbudrinf)%nlist
873 call this%budobj%budterm(idx)%reset(nlist)
875 call this%uze_rinf_term(j, n1, n2, q)
876 call this%budobj%budterm(idx)%update_term(n1, n2, q)
877 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
878 budresid(n1) = budresid(n1) + q
883 if (this%idxbuduzet /= 0)
then
885 nlist = this%flowbudptr%budterm(this%idxbuduzet)%nlist
886 call this%budobj%budterm(idx)%reset(nlist)
888 call this%uze_uzet_term(j, n1, n2, q)
889 call this%budobj%budterm(idx)%update_term(n1, n2, q)
890 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
891 budresid(n1) = budresid(n1) + q
896 if (this%idxbudritm /= 0)
then
898 nlist = this%flowbudptr%budterm(this%idxbudritm)%nlist
899 call this%budobj%budterm(idx)%reset(nlist)
901 call this%uze_ritm_term(j, n1, n2, q)
902 call this%budobj%budterm(idx)%update_term(n1, n2, q)
903 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
904 budresid(n1) = budresid(n1) + q
911 nlist = this%flowbudptr%budterm(this%idxbudgwf)%nlist
912 call this%budobj%budterm(idx)%reset(nlist)
914 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
915 igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(j)
917 call this%uze_theq_term(j, n1, igwfnode, q)
918 call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
919 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
920 if (this%iboundpak(n1) /= 0)
then
922 this%simvals(n1) = this%simvals(n1) - q
923 idiag = this%dis%con%ia(igwfnode)
924 flowja(idiag) = flowja(idiag) - q
928 deallocate (budresid)
946 call this%TspAptType%allocate_scalars()
949 call mem_allocate(this%idxbudinfl,
'IDXBUDINFL', this%memoryPath)
950 call mem_allocate(this%idxbudrinf,
'IDXBUDRINF', this%memoryPath)
951 call mem_allocate(this%idxbuduzet,
'IDXBUDUZET', this%memoryPath)
952 call mem_allocate(this%idxbudritm,
'IDXBUDRITM', this%memoryPath)
953 call mem_allocate(this%idxbudtheq,
'IDXBUDTHEQ', this%memoryPath)
979 call mem_allocate(this%tempinfl, this%ncv,
'TEMPINFL', this%memoryPath)
980 call mem_allocate(this%tempuzet, this%ncv,
'TEMPUZET', this%memoryPath)
983 call this%TspAptType%apt_allocate_arrays()
987 this%tempinfl(n) =
dzero
988 this%tempuzet(n) =
dzero
1015 call this%TspAptType%bnd_da()
1030 integer(I4B),
intent(in) :: ientry
1031 integer(I4B),
intent(inout) :: n1
1032 integer(I4B),
intent(inout) :: n2
1033 real(DP),
intent(inout),
optional :: rrate
1034 real(DP),
intent(inout),
optional :: rhsval
1035 real(DP),
intent(inout),
optional :: hcofval
1041 n1 = this%flowbudptr%budterm(this%idxbudinfl)%id1(ientry)
1042 n2 = this%flowbudptr%budterm(this%idxbudinfl)%id2(ientry)
1045 qbnd = this%flowbudptr%budterm(this%idxbudinfl)%flow(ientry)
1046 if (qbnd <
dzero)
then
1047 ctmp = this%xnewpak(n1)
1051 ctmp = this%tempinfl(n1)
1055 if (
present(rrate)) rrate = qbnd * ctmp * this%eqnsclfac
1056 if (
present(rhsval)) rhsval = r * this%eqnsclfac
1057 if (
present(hcofval)) hcofval = h * this%eqnsclfac
1074 integer(I4B),
intent(in) :: ientry
1075 integer(I4B),
intent(inout) :: n1
1076 integer(I4B),
intent(inout) :: n2
1077 real(DP),
intent(inout),
optional :: rrate
1078 real(DP),
intent(inout),
optional :: rhsval
1079 real(DP),
intent(inout),
optional :: hcofval
1084 n1 = this%flowbudptr%budterm(this%idxbudrinf)%id1(ientry)
1085 n2 = this%flowbudptr%budterm(this%idxbudrinf)%id2(ientry)
1086 qbnd = this%flowbudptr%budterm(this%idxbudrinf)%flow(ientry)
1087 ctmp = this%tempinfl(n1)
1088 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
1089 if (
present(rhsval)) rhsval =
dzero
1090 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
1147 integer(I4B),
intent(in) :: ientry
1148 integer(I4B),
intent(inout) :: n1
1149 integer(I4B),
intent(inout) :: n2
1150 real(DP),
intent(inout),
optional :: rrate
1151 real(DP),
intent(inout),
optional :: rhsval
1152 real(DP),
intent(inout),
optional :: hcofval
1157 n1 = this%flowbudptr%budterm(this%idxbudritm)%id1(ientry)
1158 n2 = this%flowbudptr%budterm(this%idxbudritm)%id2(ientry)
1159 qbnd = this%flowbudptr%budterm(this%idxbudritm)%flow(ientry)
1160 ctmp = this%tempinfl(n1)
1161 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
1162 if (
present(rhsval)) rhsval =
dzero
1163 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
1179 integer(I4B),
intent(in) :: ientry
1180 integer(I4B),
intent(inout) :: n1
1181 integer(I4B),
intent(inout) :: n2
1182 real(DP),
intent(inout) :: rrate
1186 character(len=LENBUDTXT) :: flowtype
1189 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(ientry)
1190 n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(ientry)
1191 if (this%iboundpak(n1) /= 0)
then
1192 do i = 1, this%budobj%nbudterm
1193 flowtype = this%budobj%budterm(i)%flowtype
1194 select case (trim(adjustl(flowtype)))
1195 case (
'THERMAL-EQUIL')
1199 r = r - this%budobj%budterm(i)%flow(ientry)
1219 integer(I4B) :: indx
1223 call this%obs%StoreObsType(
'temperature', .false., indx)
1228 call this%obs%StoreObsType(
'flow-ja-face', .true., indx)
1233 call this%obs%StoreObsType(
'from-mvr', .true., indx)
1242 call this%obs%StoreObsType(
'storage', .true., indx)
1247 call this%obs%StoreObsType(
'constant', .true., indx)
1252 call this%obs%StoreObsType(
'uze', .true., indx)
1257 call this%obs%StoreObsType(
'infiltration', .true., indx)
1262 call this%obs%StoreObsType(
'rej-inf', .true., indx)
1267 call this%obs%StoreObsType(
'uzet', .true., indx)
1272 call this%obs%StoreObsType(
'rej-inf-to-mvr', .true., indx)
1277 call this%obs%StoreObsType(
'thermal-equil', .true., indx)
1292 logical,
intent(inout) :: found
1295 select case (obsrv%ObsTypeId)
1296 case (
'INFILTRATION')
1297 call this%rp_obs_byfeature(obsrv)
1299 call this%rp_obs_byfeature(obsrv)
1301 call this%rp_obs_byfeature(obsrv)
1302 case (
'REJ-INF-TO-MVR')
1303 call this%rp_obs_byfeature(obsrv)
1304 case (
'THERMAL-EQUIL')
1305 call this%rp_obs_byfeature(obsrv)
1318 character(len=*),
intent(in) :: obstypeid
1319 real(DP),
intent(inout) :: v
1320 integer(I4B),
intent(in) :: jj
1321 logical,
intent(inout) :: found
1323 integer(I4B) :: n1, n2
1326 select case (obstypeid)
1327 case (
'INFILTRATION')
1328 if (this%iboundpak(jj) /= 0 .and. this%idxbudinfl > 0)
then
1329 call this%uze_infl_term(jj, n1, n2, v)
1332 if (this%iboundpak(jj) /= 0 .and. this%idxbudrinf > 0)
then
1333 call this%uze_rinf_term(jj, n1, n2, v)
1336 if (this%iboundpak(jj) /= 0 .and. this%idxbuduzet > 0)
then
1337 call this%uze_uzet_term(jj, n1, n2, v)
1339 case (
'REJ-INF-TO-MVR')
1340 if (this%iboundpak(jj) /= 0 .and. this%idxbudritm > 0)
then
1341 call this%uze_ritm_term(jj, n1, n2, v)
1343 case (
'THERMAL-EQUIL')
1344 if (this%iboundpak(jj) /= 0 .and. this%idxbudtheq > 0)
then
1345 call this%uze_theq_term(jj, n1, n2, v)
1362 integer(I4B),
intent(in) :: itemno
1363 character(len=*),
intent(in) :: keyword
1364 logical,
intent(inout) :: found
1366 character(len=LINELENGTH) :: temp_text
1367 integer(I4B) :: ierr
1369 real(DP),
pointer :: bndElem => null()
1375 select case (keyword)
1376 case (
'INFILTRATION')
1377 ierr = this%apt_check_valid(itemno)
1381 call this%parser%GetString(temp_text)
1383 bndelem => this%tempinfl(itemno)
1385 this%packName,
'BND', this%tsManager, &
1386 this%iprpak,
'INFILTRATION')
1388 ierr = this%apt_check_valid(itemno)
1392 call this%parser%GetString(temp_text)
1394 bndelem => this%tempuzet(itemno)
1396 this%packName,
'BND', this%tsManager, &
1397 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.