53 character(len=*),
parameter ::
ftype =
'MWE'
54 character(len=*),
parameter ::
flowtype =
'MAW'
55 character(len=16) ::
text =
' MWE'
61 integer(I4B),
pointer :: idxbudrate => null()
62 integer(I4B),
pointer :: idxbudfwrt => null()
63 integer(I4B),
pointer :: idxbudrtmv => null()
64 integer(I4B),
pointer :: idxbudfrtm => null()
65 integer(I4B),
pointer :: idxbudmwcd => null()
66 real(dp),
dimension(:),
pointer,
contiguous :: temprate => null()
94 subroutine mwe_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
95 fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
97 class(
bndtype),
pointer :: packobj
98 integer(I4B),
intent(in) :: id
99 integer(I4B),
intent(in) :: ibcnum
100 integer(I4B),
intent(in) :: inunit
101 integer(I4B),
intent(in) :: iout
102 character(len=*),
intent(in) :: namemodel
103 character(len=*),
intent(in) :: pakname
105 real(dp),
intent(in),
pointer :: eqnsclfac
107 character(len=*),
intent(in) :: dvt
108 character(len=*),
intent(in) :: dvu
109 character(len=*),
intent(in) :: dvua
118 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
122 call mweobj%allocate_scalars()
125 call packobj%pack_initialize()
127 packobj%inunit = inunit
130 packobj%ibcnum = ibcnum
140 mweobj%eqnsclfac => eqnsclfac
145 mweobj%gwecommon => gwecommon
148 mweobj%depvartype = dvt
149 mweobj%depvarunit = dvu
150 mweobj%depvarunitabbrev = dvua
164 character(len=LINELENGTH) :: errmsg
165 class(
bndtype),
pointer :: packobj
166 integer(I4B) :: ip, icount
167 integer(I4B) :: nbudterm
177 if (this%fmi%flows_from_file)
then
178 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
179 if (
associated(this%flowbudptr)) found = .true.
182 if (
associated(this%fmi%gwfbndlist))
then
185 do ip = 1, this%fmi%gwfbndlist%Count()
187 if (packobj%packName == this%flowpackagename)
then
192 this%flowpackagebnd => packobj
193 select type (packobj)
195 this%flowbudptr => packobj%budobj
204 if (.not. found)
then
205 write (errmsg,
'(a)')
'COULD NOT FIND FLOW PACKAGE WITH NAME '&
206 &//trim(adjustl(this%flowpackagename))//
'.'
208 call this%parser%StoreErrorUnit()
213 nbudterm = this%flowbudptr%nbudterm
214 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
217 write (this%iout,
'(/, a, a)') &
218 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
219 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
220 write (this%iout,
'(a, i0)') &
221 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
223 do ip = 1, this%flowbudptr%nbudterm
224 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
225 case (
'FLOW-JA-FACE')
227 this%idxbudssm(ip) = 0
230 this%idxbudssm(ip) = 0
233 this%idxbudssm(ip) = 0
236 this%idxbudssm(ip) = 0
239 this%idxbudssm(ip) = 0
242 this%idxbudssm(ip) = 0
243 case (
'FW-RATE-TO-MVR')
245 this%idxbudssm(ip) = 0
248 this%idxbudssm(ip) = 0
251 this%idxbudssm(ip) = 0
254 this%idxbudssm(ip) = 0
259 this%idxbudssm(ip) = icount
262 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
263 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
264 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
266 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
269 this%idxbudmwcd = this%idxbudgwf
283 real(DP),
dimension(:),
intent(inout) :: rhs
284 integer(I4B),
dimension(:),
intent(in) :: ia
285 integer(I4B),
dimension(:),
intent(in) :: idxglo
288 integer(I4B) :: j, n, n1, n2
290 integer(I4B) :: iposd, iposoffd
291 integer(I4B) :: ipossymd, ipossymoffd
292 integer(I4B) :: auxpos
302 if (this%idxbudrate /= 0)
then
303 do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
304 call this%mwe_rate_term(j, n1, n2, rrate, rhsval, hcofval)
305 iloc = this%idxlocnode(n1)
306 iposd = this%idxpakdiag(n1)
307 call matrix_sln%add_value_pos(iposd, hcofval)
308 rhs(iloc) = rhs(iloc) + rhsval
313 if (this%idxbudfwrt /= 0)
then
314 do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
315 call this%mwe_fwrt_term(j, n1, n2, rrate, rhsval, hcofval)
316 iloc = this%idxlocnode(n1)
317 iposd = this%idxpakdiag(n1)
318 call matrix_sln%add_value_pos(iposd, hcofval)
319 rhs(iloc) = rhs(iloc) + rhsval
324 if (this%idxbudrtmv /= 0)
then
325 do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
326 call this%mwe_rtmv_term(j, n1, n2, rrate, rhsval, hcofval)
327 iloc = this%idxlocnode(n1)
328 iposd = this%idxpakdiag(n1)
329 call matrix_sln%add_value_pos(iposd, hcofval)
330 rhs(iloc) = rhs(iloc) + rhsval
335 if (this%idxbudfrtm /= 0)
then
336 do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
337 call this%mwe_frtm_term(j, n1, n2, rrate, rhsval, hcofval)
338 iloc = this%idxlocnode(n1)
339 iposd = this%idxpakdiag(n1)
340 call matrix_sln%add_value_pos(iposd, hcofval)
341 rhs(iloc) = rhs(iloc) + rhsval
346 do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
349 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
350 if (this%iboundpak(n) /= 0)
then
353 auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
354 wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, j)
357 ctherm = ktf * wa / s
360 iposd = this%idxdglo(j)
361 iposoffd = this%idxoffdglo(j)
362 call matrix_sln%add_value_pos(iposd, -ctherm)
363 call matrix_sln%add_value_pos(iposoffd, ctherm)
366 ipossymd = this%idxsymdglo(j)
367 ipossymoffd = this%idxsymoffdglo(j)
368 call matrix_sln%add_value_pos(ipossymd, -ctherm)
369 call matrix_sln%add_value_pos(ipossymoffd, ctherm)
385 integer(I4B) :: n1, n2
389 if (this%idxbudrate /= 0)
then
390 do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
391 call this%mwe_rate_term(j, n1, n2, rrate)
392 this%dbuff(n1) = this%dbuff(n1) + rrate
397 if (this%idxbudfwrt /= 0)
then
398 do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
399 call this%mwe_fwrt_term(j, n1, n2, rrate)
400 this%dbuff(n1) = this%dbuff(n1) + rrate
405 if (this%idxbudrtmv /= 0)
then
406 do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
407 call this%mwe_rtmv_term(j, n1, n2, rrate)
408 this%dbuff(n1) = this%dbuff(n1) + rrate
413 if (this%idxbudfrtm /= 0)
then
414 do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
415 call this%mwe_frtm_term(j, n1, n2, rrate)
416 this%dbuff(n1) = this%dbuff(n1) + rrate
432 integer(I4B) :: nbudterms
436 if (this%idxbudfwrt /= 0) nbudterms = nbudterms + 1
437 if (this%idxbudrtmv /= 0) nbudterms = nbudterms + 1
438 if (this%idxbudfrtm /= 0) nbudterms = nbudterms + 1
439 if (this%idxbudmwcd /= 0) nbudterms = nbudterms + 1
452 integer(I4B),
intent(inout) :: idx
454 integer(I4B) :: n, n1, n2
455 integer(I4B) :: maxlist, naux
457 character(len=LENBUDTXT) :: text
462 maxlist = this%flowbudptr%budterm(this%idxbudrate)%maxlist
464 call this%budobj%budterm(idx)%initialize(text, &
469 maxlist, .false., .false., &
473 if (this%idxbudfwrt /= 0)
then
476 maxlist = this%flowbudptr%budterm(this%idxbudfwrt)%maxlist
478 call this%budobj%budterm(idx)%initialize(text, &
483 maxlist, .false., .false., &
488 if (this%idxbudrtmv /= 0)
then
489 text =
' RATE-TO-MVR'
491 maxlist = this%flowbudptr%budterm(this%idxbudrtmv)%maxlist
493 call this%budobj%budterm(idx)%initialize(text, &
498 maxlist, .false., .false., &
503 if (this%idxbudfrtm /= 0)
then
504 text =
' FW-RATE-TO-MVR'
506 maxlist = this%flowbudptr%budterm(this%idxbudfrtm)%maxlist
508 call this%budobj%budterm(idx)%initialize(text, &
513 maxlist, .false., .false., &
518 text =
' WELLBORE-COND'
520 maxlist = this%flowbudptr%budterm(this%idxbudmwcd)%maxlist
522 call this%budobj%budterm(idx)%initialize(text, &
527 maxlist, .false., .false., &
529 call this%budobj%budterm(idx)%reset(maxlist)
532 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(n)
533 n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(n)
534 call this%budobj%budterm(idx)%update_term(n1, n2, q)
546 integer(I4B),
intent(inout) :: idx
547 real(DP),
dimension(:),
intent(in) :: x
548 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
549 real(DP),
intent(inout) :: ccratin
550 real(DP),
intent(inout) :: ccratout
552 integer(I4B) :: j, n1, n2
553 integer(I4B) :: nlist
554 integer(I4B) :: igwfnode
555 integer(I4B) :: idiag
556 integer(I4B) :: auxpos
565 nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist
566 call this%budobj%budterm(idx)%reset(nlist)
568 call this%mwe_rate_term(j, n1, n2, q)
569 call this%budobj%budterm(idx)%update_term(n1, n2, q)
570 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
574 if (this%idxbudfwrt /= 0)
then
576 nlist = this%flowbudptr%budterm(this%idxbudfwrt)%nlist
577 call this%budobj%budterm(idx)%reset(nlist)
579 call this%mwe_fwrt_term(j, n1, n2, q)
580 call this%budobj%budterm(idx)%update_term(n1, n2, q)
581 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
586 if (this%idxbudrtmv /= 0)
then
588 nlist = this%flowbudptr%budterm(this%idxbudrtmv)%nlist
589 call this%budobj%budterm(idx)%reset(nlist)
591 call this%mwe_rtmv_term(j, n1, n2, q)
592 call this%budobj%budterm(idx)%update_term(n1, n2, q)
593 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
598 if (this%idxbudfrtm /= 0)
then
600 nlist = this%flowbudptr%budterm(this%idxbudfrtm)%nlist
601 call this%budobj%budterm(idx)%reset(nlist)
603 call this%mwe_frtm_term(j, n1, n2, q)
604 call this%budobj%budterm(idx)%update_term(n1, n2, q)
605 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
611 call this%budobj%budterm(idx)%reset(this%maxbound)
612 do j = 1, this%flowbudptr%budterm(this%idxbudmwcd)%nlist
614 n1 = this%flowbudptr%budterm(this%idxbudmwcd)%id1(j)
615 if (this%iboundpak(n1) /= 0)
then
616 igwfnode = this%flowbudptr%budterm(this%idxbudmwcd)%id2(j)
617 auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
618 wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, j)
620 s = this%rfeatthk(n1)
621 ctherm = ktf * wa / s
622 q = ctherm * (x(igwfnode) - this%xnewpak(n1))
624 call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
625 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
626 if (this%iboundpak(n1) /= 0)
then
628 this%simvals(j) = this%simvals(j) - q
629 idiag = this%dis%con%ia(igwfnode)
630 flowja(idiag) = flowja(idiag) - q
648 call this%TspAptType%allocate_scalars()
651 call mem_allocate(this%idxbudrate,
'IDXBUDRATE', this%memoryPath)
652 call mem_allocate(this%idxbudfwrt,
'IDXBUDFWRT', this%memoryPath)
653 call mem_allocate(this%idxbudrtmv,
'IDXBUDRTMV', this%memoryPath)
654 call mem_allocate(this%idxbudfrtm,
'IDXBUDFRTM', this%memoryPath)
655 call mem_allocate(this%idxbudmwcd,
'IDXBUDMWCD', this%memoryPath)
680 call mem_allocate(this%temprate, this%ncv,
'TEMPRATE', this%memoryPath)
683 call this%TspAptType%apt_allocate_arrays()
687 this%temprate(n) =
dzero
713 call this%TspAptType%bnd_da()
725 integer(I4B),
intent(in) :: ientry
726 integer(I4B),
intent(inout) :: n1
727 integer(I4B),
intent(inout) :: n2
728 real(DP),
intent(inout),
optional :: rrate
729 real(DP),
intent(inout),
optional :: rhsval
730 real(DP),
intent(inout),
optional :: hcofval
736 n1 = this%flowbudptr%budterm(this%idxbudrate)%id1(ientry)
737 n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry)
739 qbnd = this%flowbudptr%budterm(this%idxbudrate)%flow(ientry)
740 if (qbnd <
dzero)
then
741 ctmp = this%xnewpak(n1)
745 ctmp = this%temprate(n1)
749 if (
present(rrate)) rrate = qbnd * ctmp * this%eqnsclfac
750 if (
present(rhsval)) rhsval = r * this%eqnsclfac
751 if (
present(hcofval)) hcofval = h * this%eqnsclfac
763 integer(I4B),
intent(in) :: ientry
764 integer(I4B),
intent(inout) :: n1
765 integer(I4B),
intent(inout) :: n2
766 real(DP),
intent(inout),
optional :: rrate
767 real(DP),
intent(inout),
optional :: rhsval
768 real(DP),
intent(inout),
optional :: hcofval
773 n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry)
774 n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry)
775 qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry)
776 ctmp = this%xnewpak(n1)
777 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
778 if (
present(rhsval)) rhsval =
dzero
779 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
791 integer(I4B),
intent(in) :: ientry
792 integer(I4B),
intent(inout) :: n1
793 integer(I4B),
intent(inout) :: n2
794 real(DP),
intent(inout),
optional :: rrate
795 real(DP),
intent(inout),
optional :: rhsval
796 real(DP),
intent(inout),
optional :: hcofval
801 n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry)
802 n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry)
803 qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry)
804 ctmp = this%xnewpak(n1)
805 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
806 if (
present(rhsval)) rhsval =
dzero
807 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
819 integer(I4B),
intent(in) :: ientry
820 integer(I4B),
intent(inout) :: n1
821 integer(I4B),
intent(inout) :: n2
822 real(DP),
intent(inout),
optional :: rrate
823 real(DP),
intent(inout),
optional :: rhsval
824 real(DP),
intent(inout),
optional :: hcofval
829 n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry)
830 n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry)
831 qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry)
832 ctmp = this%xnewpak(n1)
833 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
834 if (
present(rhsval)) rhsval =
dzero
835 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
854 call this%obs%StoreObsType(
'temperature', .false., indx)
863 call this%obs%StoreObsType(
'from-mvr', .true., indx)
872 call this%obs%StoreObsType(
'storage', .true., indx)
877 call this%obs%StoreObsType(
'constant', .true., indx)
882 call this%obs%StoreObsType(
'mwe', .true., indx)
887 call this%obs%StoreObsType(
'rate', .true., indx)
892 call this%obs%StoreObsType(
'fw-rate', .true., indx)
897 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
902 call this%obs%StoreObsType(
'fw-rate-to-mvr', .true., indx)
917 logical,
intent(inout) :: found
920 select case (obsrv%ObsTypeId)
922 call this%rp_obs_byfeature(obsrv)
924 call this%rp_obs_byfeature(obsrv)
926 call this%rp_obs_byfeature(obsrv)
927 case (
'FW-RATE-TO-MVR')
928 call this%rp_obs_byfeature(obsrv)
942 character(len=*),
intent(in) :: obstypeid
943 real(DP),
intent(inout) :: v
944 integer(I4B),
intent(in) :: jj
945 logical,
intent(inout) :: found
947 integer(I4B) :: n1, n2
950 select case (obstypeid)
952 if (this%iboundpak(jj) /= 0)
then
953 call this%mwe_rate_term(jj, n1, n2, v)
956 if (this%iboundpak(jj) /= 0 .and. this%idxbudfwrt > 0)
then
957 call this%mwe_fwrt_term(jj, n1, n2, v)
960 if (this%iboundpak(jj) /= 0 .and. this%idxbudrtmv > 0)
then
961 call this%mwe_rtmv_term(jj, n1, n2, v)
963 case (
'FW-RATE-TO-MVR')
964 if (this%iboundpak(jj) /= 0 .and. this%idxbudfrtm > 0)
then
965 call this%mwe_frtm_term(jj, n1, n2, v)
982 integer(I4B),
intent(in) :: itemno
983 character(len=*),
intent(in) :: keyword
984 logical,
intent(inout) :: found
986 character(len=LINELENGTH) :: text
989 real(DP),
pointer :: bndElem => null()
994 select case (keyword)
996 ierr = this%apt_check_valid(itemno)
1000 call this%parser%GetString(text)
1002 bndelem => this%temprate(itemno)
1004 this%packName,
'BND', this%tsManager, &
1005 this%iprpak,
'RATE')
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
subroutine allocate_scalars(this)
Allocate scalars specific to the multi-aquifer well energy transport (MWE) package.
character(len= *), parameter flowtype
subroutine mwe_rp_obs(this, obsrv, found)
Process package specific obs.
subroutine mwe_rtmv_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Thermal transport matrix term(s) associated with pumped-water- to-mover term (mwe_rtmv_term)
subroutine mwe_allocate_arrays(this)
Allocate arrays specific to the streamflow mass transport (SFT) package.
subroutine, public mwe_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
Create new MWE package.
subroutine mwe_bd_obs(this, obstypeid, jj, v, found)
Calculate observation value and pass it back to APT.
subroutine find_mwe_package(this)
Find corresponding mwe package.
subroutine mwe_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
Copy flow terms into thisbudobj.
character(len= *), parameter ftype
subroutine mwe_da(this)
Deallocate memory associated with MWE package.
subroutine mwe_setup_budobj(this, idx)
Set up the budget object that stores all the mwe flows.
integer(i4b) function mwe_get_nbudterms(this)
Function to return the number of budget terms just for this package.
subroutine mwe_frtm_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Thermal transport matrix term(s) associated with the flowing- well-rate-to-mover term (mwe_frtm_term)
subroutine mwe_solve(this)
Add terms specific to multi-aquifer wells to the explicit multi- aquifer well energy transport solve.
subroutine mwe_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to MWE.
subroutine mwe_set_stressperiod(this, itemno, keyword, found)
Sets the stress period attributes for keyword use.
subroutine mwe_fwrt_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Thermal transport matrix term(s) associated with a flowing- well rate term associated with pumping (o...
subroutine mwe_rate_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Thermal transport matrix term(s) associated with a user-specified flow rate (mwe_rate_term)
subroutine mwe_df_obs(this)
Observations.
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.