52 character(len=*),
parameter ::
ftype =
'MWT'
53 character(len=*),
parameter ::
flowtype =
'MAW'
54 character(len=16) ::
text =
' MWT'
58 integer(I4B),
pointer :: idxbudrate => null()
59 integer(I4B),
pointer :: idxbudfwrt => null()
60 integer(I4B),
pointer :: idxbudrtmv => null()
61 integer(I4B),
pointer :: idxbudfrtm => null()
62 real(dp),
dimension(:),
pointer,
contiguous :: concrate => null()
90 subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
91 fmi, eqnsclfac, dvt, dvu, dvua)
93 class(
bndtype),
pointer :: packobj
94 integer(I4B),
intent(in) :: id
95 integer(I4B),
intent(in) :: ibcnum
96 integer(I4B),
intent(in) :: inunit
97 integer(I4B),
intent(in) :: iout
98 character(len=*),
intent(in) :: namemodel
99 character(len=*),
intent(in) :: pakname
101 real(dp),
intent(in),
pointer :: eqnsclfac
102 character(len=*),
intent(in) :: dvt
103 character(len=*),
intent(in) :: dvu
104 character(len=*),
intent(in) :: dvua
113 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
117 call mwtobj%allocate_scalars()
120 call packobj%pack_initialize()
122 packobj%inunit = inunit
125 packobj%ibcnum = ibcnum
135 mwtobj%eqnsclfac => eqnsclfac
138 mwtobj%depvartype = dvt
139 mwtobj%depvarunit = dvu
140 mwtobj%depvarunitabbrev = dvua
154 character(len=LINELENGTH) :: errmsg
155 class(
bndtype),
pointer :: packobj
156 integer(I4B) :: ip, icount
157 integer(I4B) :: nbudterm
167 if (this%fmi%flows_from_file)
then
168 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
169 if (
associated(this%flowbudptr)) found = .true.
172 if (
associated(this%fmi%gwfbndlist))
then
175 do ip = 1, this%fmi%gwfbndlist%Count()
177 if (packobj%packName == this%flowpackagename)
then
182 this%flowpackagebnd => packobj
183 select type (packobj)
185 this%flowbudptr => packobj%budobj
194 if (.not. found)
then
195 write (errmsg,
'(a)')
'Could not find flow package with name '&
196 &//trim(adjustl(this%flowpackagename))//
'.'
198 call this%parser%StoreErrorUnit()
203 nbudterm = this%flowbudptr%nbudterm
204 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
207 write (this%iout,
'(/, a, a)') &
208 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
209 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
210 write (this%iout,
'(a, i0)') &
211 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
213 do ip = 1, this%flowbudptr%nbudterm
214 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
215 case (
'FLOW-JA-FACE')
217 this%idxbudssm(ip) = 0
220 this%idxbudssm(ip) = 0
223 this%idxbudssm(ip) = 0
226 this%idxbudssm(ip) = 0
229 this%idxbudssm(ip) = 0
232 this%idxbudssm(ip) = 0
233 case (
'FW-RATE-TO-MVR')
235 this%idxbudssm(ip) = 0
238 this%idxbudssm(ip) = 0
241 this%idxbudssm(ip) = 0
244 this%idxbudssm(ip) = 0
249 this%idxbudssm(ip) = icount
252 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
253 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
254 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
256 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
271 real(DP),
dimension(:),
intent(inout) :: rhs
272 integer(I4B),
dimension(:),
intent(in) :: ia
273 integer(I4B),
dimension(:),
intent(in) :: idxglo
276 integer(I4B) :: j, n1, n2
278 integer(I4B) :: iposd
284 if (this%idxbudrate /= 0)
then
285 do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
286 call this%mwt_rate_term(j, n1, n2, rrate, rhsval, hcofval)
287 iloc = this%idxlocnode(n1)
288 iposd = this%idxpakdiag(n1)
289 call matrix_sln%add_value_pos(iposd, hcofval)
290 rhs(iloc) = rhs(iloc) + rhsval
295 if (this%idxbudfwrt /= 0)
then
296 do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
297 call this%mwt_fwrt_term(j, n1, n2, rrate, rhsval, hcofval)
298 iloc = this%idxlocnode(n1)
299 iposd = this%idxpakdiag(n1)
300 call matrix_sln%add_value_pos(iposd, hcofval)
301 rhs(iloc) = rhs(iloc) + rhsval
306 if (this%idxbudrtmv /= 0)
then
307 do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
308 call this%mwt_rtmv_term(j, n1, n2, rrate, rhsval, hcofval)
309 iloc = this%idxlocnode(n1)
310 iposd = this%idxpakdiag(n1)
311 call matrix_sln%add_value_pos(iposd, hcofval)
312 rhs(iloc) = rhs(iloc) + rhsval
317 if (this%idxbudfrtm /= 0)
then
318 do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
319 call this%mwt_frtm_term(j, n1, n2, rrate, rhsval, hcofval)
320 iloc = this%idxlocnode(n1)
321 iposd = this%idxpakdiag(n1)
322 call matrix_sln%add_value_pos(iposd, hcofval)
323 rhs(iloc) = rhs(iloc) + rhsval
339 integer(I4B) :: n1, n2
343 if (this%idxbudrate /= 0)
then
344 do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
345 call this%mwt_rate_term(j, n1, n2, rrate)
346 this%dbuff(n1) = this%dbuff(n1) + rrate
351 if (this%idxbudfwrt /= 0)
then
352 do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
353 call this%mwt_fwrt_term(j, n1, n2, rrate)
354 this%dbuff(n1) = this%dbuff(n1) + rrate
359 if (this%idxbudrtmv /= 0)
then
360 do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
361 call this%mwt_rtmv_term(j, n1, n2, rrate)
362 this%dbuff(n1) = this%dbuff(n1) + rrate
367 if (this%idxbudfrtm /= 0)
then
368 do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
369 call this%mwt_frtm_term(j, n1, n2, rrate)
370 this%dbuff(n1) = this%dbuff(n1) + rrate
387 integer(I4B) :: nbudterms
392 if (this%idxbudfwrt /= 0) nbudterms = nbudterms + 1
393 if (this%idxbudrtmv /= 0) nbudterms = nbudterms + 1
394 if (this%idxbudfrtm /= 0) nbudterms = nbudterms + 1
407 integer(I4B),
intent(inout) :: idx
409 integer(I4B) :: maxlist, naux
410 character(len=LENBUDTXT) :: text
415 maxlist = this%flowbudptr%budterm(this%idxbudrate)%maxlist
417 call this%budobj%budterm(idx)%initialize(text, &
422 maxlist, .false., .false., &
426 if (this%idxbudfwrt /= 0)
then
429 maxlist = this%flowbudptr%budterm(this%idxbudfwrt)%maxlist
431 call this%budobj%budterm(idx)%initialize(text, &
436 maxlist, .false., .false., &
441 if (this%idxbudrtmv /= 0)
then
442 text =
' RATE-TO-MVR'
444 maxlist = this%flowbudptr%budterm(this%idxbudrtmv)%maxlist
446 call this%budobj%budterm(idx)%initialize(text, &
451 maxlist, .false., .false., &
456 if (this%idxbudfrtm /= 0)
then
457 text =
' FW-RATE-TO-MVR'
459 maxlist = this%flowbudptr%budterm(this%idxbudfrtm)%maxlist
461 call this%budobj%budterm(idx)%initialize(text, &
466 maxlist, .false., .false., &
480 integer(I4B),
intent(inout) :: idx
481 real(DP),
dimension(:),
intent(in) :: x
482 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
483 real(DP),
intent(inout) :: ccratin
484 real(DP),
intent(inout) :: ccratout
486 integer(I4B) :: j, n1, n2
487 integer(I4B) :: nlist
493 nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist
494 call this%budobj%budterm(idx)%reset(nlist)
496 call this%mwt_rate_term(j, n1, n2, q)
497 call this%budobj%budterm(idx)%update_term(n1, n2, q)
498 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
502 if (this%idxbudfwrt /= 0)
then
504 nlist = this%flowbudptr%budterm(this%idxbudfwrt)%nlist
505 call this%budobj%budterm(idx)%reset(nlist)
507 call this%mwt_fwrt_term(j, n1, n2, q)
508 call this%budobj%budterm(idx)%update_term(n1, n2, q)
509 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
514 if (this%idxbudrtmv /= 0)
then
516 nlist = this%flowbudptr%budterm(this%idxbudrtmv)%nlist
517 call this%budobj%budterm(idx)%reset(nlist)
519 call this%mwt_rtmv_term(j, n1, n2, q)
520 call this%budobj%budterm(idx)%update_term(n1, n2, q)
521 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
526 if (this%idxbudfrtm /= 0)
then
528 nlist = this%flowbudptr%budterm(this%idxbudfrtm)%nlist
529 call this%budobj%budterm(idx)%reset(nlist)
531 call this%mwt_frtm_term(j, n1, n2, q)
532 call this%budobj%budterm(idx)%update_term(n1, n2, q)
533 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
552 call this%TspAptType%allocate_scalars()
555 call mem_allocate(this%idxbudrate,
'IDXBUDRATE', this%memoryPath)
556 call mem_allocate(this%idxbudfwrt,
'IDXBUDFWRT', this%memoryPath)
557 call mem_allocate(this%idxbudrtmv,
'IDXBUDRTMV', this%memoryPath)
558 call mem_allocate(this%idxbudfrtm,
'IDXBUDFRTM', this%memoryPath)
582 call mem_allocate(this%concrate, this%ncv,
'CONCRATE', this%memoryPath)
585 call this%TspAptType%apt_allocate_arrays()
589 this%concrate(n) =
dzero
616 call this%TspAptType%bnd_da()
628 integer(I4B),
intent(in) :: ientry
629 integer(I4B),
intent(inout) :: n1
630 integer(I4B),
intent(inout) :: n2
631 real(DP),
intent(inout),
optional :: rrate
632 real(DP),
intent(inout),
optional :: rhsval
633 real(DP),
intent(inout),
optional :: hcofval
639 n1 = this%flowbudptr%budterm(this%idxbudrate)%id1(ientry)
640 n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry)
642 qbnd = this%flowbudptr%budterm(this%idxbudrate)%flow(ientry)
643 if (qbnd <
dzero)
then
644 ctmp = this%xnewpak(n1)
648 ctmp = this%concrate(n1)
652 if (
present(rrate)) rrate = qbnd * ctmp
653 if (
present(rhsval)) rhsval = r
654 if (
present(hcofval)) hcofval = h
667 integer(I4B),
intent(in) :: ientry
668 integer(I4B),
intent(inout) :: n1
669 integer(I4B),
intent(inout) :: n2
670 real(DP),
intent(inout),
optional :: rrate
671 real(DP),
intent(inout),
optional :: rhsval
672 real(DP),
intent(inout),
optional :: hcofval
677 n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry)
678 n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry)
679 qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry)
680 ctmp = this%xnewpak(n1)
681 if (
present(rrate)) rrate = ctmp * qbnd
682 if (
present(rhsval)) rhsval =
dzero
683 if (
present(hcofval)) hcofval = qbnd
698 integer(I4B),
intent(in) :: ientry
699 integer(I4B),
intent(inout) :: n1
700 integer(I4B),
intent(inout) :: n2
701 real(DP),
intent(inout),
optional :: rrate
702 real(DP),
intent(inout),
optional :: rhsval
703 real(DP),
intent(inout),
optional :: hcofval
708 n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry)
709 n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry)
710 qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry)
711 ctmp = this%xnewpak(n1)
712 if (
present(rrate)) rrate = ctmp * qbnd
713 if (
present(rhsval)) rhsval =
dzero
714 if (
present(hcofval)) hcofval = qbnd
729 integer(I4B),
intent(in) :: ientry
730 integer(I4B),
intent(inout) :: n1
731 integer(I4B),
intent(inout) :: n2
732 real(DP),
intent(inout),
optional :: rrate
733 real(DP),
intent(inout),
optional :: rhsval
734 real(DP),
intent(inout),
optional :: hcofval
739 n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry)
740 n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry)
741 qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry)
742 ctmp = this%xnewpak(n1)
743 if (
present(rrate)) rrate = ctmp * qbnd
744 if (
present(rhsval)) rhsval =
dzero
745 if (
present(hcofval)) hcofval = qbnd
765 call this%obs%StoreObsType(
'concentration', .false., indx)
774 call this%obs%StoreObsType(
'from-mvr', .true., indx)
783 call this%obs%StoreObsType(
'storage', .true., indx)
788 call this%obs%StoreObsType(
'constant', .true., indx)
793 call this%obs%StoreObsType(
'mwt', .true., indx)
798 call this%obs%StoreObsType(
'rate', .true., indx)
803 call this%obs%StoreObsType(
'fw-rate', .true., indx)
808 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
813 call this%obs%StoreObsType(
'fw-rate-to-mvr', .true., indx)
828 logical,
intent(inout) :: found
832 select case (obsrv%ObsTypeId)
834 call this%rp_obs_byfeature(obsrv)
836 call this%rp_obs_byfeature(obsrv)
838 call this%rp_obs_byfeature(obsrv)
839 case (
'FW-RATE-TO-MVR')
840 call this%rp_obs_byfeature(obsrv)
854 character(len=*),
intent(in) :: obstypeid
855 real(DP),
intent(inout) :: v
856 integer(I4B),
intent(in) :: jj
857 logical,
intent(inout) :: found
859 integer(I4B) :: n1, n2
862 select case (obstypeid)
864 if (this%iboundpak(jj) /= 0)
then
865 call this%mwt_rate_term(jj, n1, n2, v)
868 if (this%iboundpak(jj) /= 0 .and. this%idxbudfwrt > 0)
then
869 call this%mwt_fwrt_term(jj, n1, n2, v)
872 if (this%iboundpak(jj) /= 0 .and. this%idxbudrtmv > 0)
then
873 call this%mwt_rtmv_term(jj, n1, n2, v)
875 case (
'FW-RATE-TO-MVR')
876 if (this%iboundpak(jj) /= 0 .and. this%idxbudfrtm > 0)
then
877 call this%mwt_frtm_term(jj, n1, n2, v)
894 integer(I4B),
intent(in) :: itemno
895 character(len=*),
intent(in) :: keyword
896 logical,
intent(inout) :: found
898 character(len=LINELENGTH) :: text
901 real(DP),
pointer :: bndElem => null()
907 select case (keyword)
909 ierr = this%apt_check_valid(itemno)
913 call this%parser%GetString(text)
915 bndelem => this%concrate(itemno)
917 this%packName,
'BND', this%tsManager, &
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
character(len= *), parameter flowtype
subroutine mwt_bd_obs(this, obstypeid, jj, v, found)
Calculate observation value and pass it back to APT.
subroutine find_mwt_package(this)
find corresponding mwt package
subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to MWT.
subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Transport matrix term(s) associated with a flowing- well rate term associated with pumping (or inject...
subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Flowing well rate-to-mvr term (or injection)
subroutine mwt_setup_budobj(this, idx)
Set up the budget object that stores all the mwt flows.
subroutine mwt_da(this)
Deallocate memory.
character(len= *), parameter ftype
subroutine mwt_rp_obs(this, obsrv, found)
Process package specific obs.
subroutine allocate_scalars(this)
Allocate scalars specific to the streamflow mass transport (SFT) package.
integer(i4b) function mwt_get_nbudterms(this)
Function to return the number of budget terms just for this package.
subroutine mwt_solve(this)
@ brief Add terms specific to multi-aquifer wells to the explicit multi- aquifer well solute transpor...
subroutine mwt_df_obs(this)
Observations.
subroutine mwt_allocate_arrays(this)
Allocate arrays specific to the streamflow mass transport (SFT) package.
subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rate-to-mvr term associated with pumping (or injection)
subroutine mwt_rate_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rate term associated with pumping (or injection)
subroutine mwt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
Copy flow terms into thisbudobj.
subroutine, public mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, dvt, dvu, dvua)
Create new MWT package.
subroutine mwt_set_stressperiod(this, itemno, keyword, found)
Sets the stress period attributes for keyword use.
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.