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
151 character(len=LINELENGTH) :: errmsg
152 class(
bndtype),
pointer :: packobj
153 integer(I4B) :: ip, icount
154 integer(I4B) :: nbudterm
164 if (this%fmi%flows_from_file)
then
165 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
166 if (
associated(this%flowbudptr)) found = .true.
169 if (
associated(this%fmi%gwfbndlist))
then
172 do ip = 1, this%fmi%gwfbndlist%Count()
174 if (packobj%packName == this%flowpackagename)
then
179 this%flowpackagebnd => packobj
180 select type (packobj)
182 this%flowbudptr => packobj%budobj
191 if (.not. found)
then
192 write (errmsg,
'(a)')
'Could not find flow package with name '&
193 &//trim(adjustl(this%flowpackagename))//
'.'
195 call this%parser%StoreErrorUnit()
200 nbudterm = this%flowbudptr%nbudterm
201 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
204 write (this%iout,
'(/, a, a)') &
205 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
206 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
207 write (this%iout,
'(a, i0)') &
208 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
210 do ip = 1, this%flowbudptr%nbudterm
211 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
212 case (
'FLOW-JA-FACE')
214 this%idxbudssm(ip) = 0
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
230 case (
'FW-RATE-TO-MVR')
232 this%idxbudssm(ip) = 0
235 this%idxbudssm(ip) = 0
238 this%idxbudssm(ip) = 0
241 this%idxbudssm(ip) = 0
246 this%idxbudssm(ip) = icount
249 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
250 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
251 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
253 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
265 real(DP),
dimension(:),
intent(inout) :: rhs
266 integer(I4B),
dimension(:),
intent(in) :: ia
267 integer(I4B),
dimension(:),
intent(in) :: idxglo
270 integer(I4B) :: j, n1, n2
272 integer(I4B) :: iposd
278 if (this%idxbudrate /= 0)
then
279 do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
280 call this%mwt_rate_term(j, n1, n2, rrate, rhsval, hcofval)
281 iloc = this%idxlocnode(n1)
282 iposd = this%idxpakdiag(n1)
283 call matrix_sln%add_value_pos(iposd, hcofval)
284 rhs(iloc) = rhs(iloc) + rhsval
289 if (this%idxbudfwrt /= 0)
then
290 do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
291 call this%mwt_fwrt_term(j, n1, n2, rrate, rhsval, hcofval)
292 iloc = this%idxlocnode(n1)
293 iposd = this%idxpakdiag(n1)
294 call matrix_sln%add_value_pos(iposd, hcofval)
295 rhs(iloc) = rhs(iloc) + rhsval
300 if (this%idxbudrtmv /= 0)
then
301 do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
302 call this%mwt_rtmv_term(j, n1, n2, rrate, rhsval, hcofval)
303 iloc = this%idxlocnode(n1)
304 iposd = this%idxpakdiag(n1)
305 call matrix_sln%add_value_pos(iposd, hcofval)
306 rhs(iloc) = rhs(iloc) + rhsval
311 if (this%idxbudfrtm /= 0)
then
312 do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
313 call this%mwt_frtm_term(j, n1, n2, rrate, rhsval, hcofval)
314 iloc = this%idxlocnode(n1)
315 iposd = this%idxpakdiag(n1)
316 call matrix_sln%add_value_pos(iposd, hcofval)
317 rhs(iloc) = rhs(iloc) + rhsval
330 integer(I4B) :: n1, n2
334 if (this%idxbudrate /= 0)
then
335 do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
336 call this%mwt_rate_term(j, n1, n2, rrate)
337 this%dbuff(n1) = this%dbuff(n1) + rrate
342 if (this%idxbudfwrt /= 0)
then
343 do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
344 call this%mwt_fwrt_term(j, n1, n2, rrate)
345 this%dbuff(n1) = this%dbuff(n1) + rrate
350 if (this%idxbudrtmv /= 0)
then
351 do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
352 call this%mwt_rtmv_term(j, n1, n2, rrate)
353 this%dbuff(n1) = this%dbuff(n1) + rrate
358 if (this%idxbudfrtm /= 0)
then
359 do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
360 call this%mwt_frtm_term(j, n1, n2, rrate)
361 this%dbuff(n1) = this%dbuff(n1) + rrate
375 integer(I4B) :: nbudterms
380 if (this%idxbudfwrt /= 0) nbudterms = nbudterms + 1
381 if (this%idxbudrtmv /= 0) nbudterms = nbudterms + 1
382 if (this%idxbudfrtm /= 0) nbudterms = nbudterms + 1
392 integer(I4B),
intent(inout) :: idx
394 integer(I4B) :: maxlist, naux
395 character(len=LENBUDTXT) :: text
400 maxlist = this%flowbudptr%budterm(this%idxbudrate)%maxlist
402 call this%budobj%budterm(idx)%initialize(text, &
407 maxlist, .false., .false., &
411 if (this%idxbudfwrt /= 0)
then
414 maxlist = this%flowbudptr%budterm(this%idxbudfwrt)%maxlist
416 call this%budobj%budterm(idx)%initialize(text, &
421 maxlist, .false., .false., &
426 if (this%idxbudrtmv /= 0)
then
427 text =
' RATE-TO-MVR'
429 maxlist = this%flowbudptr%budterm(this%idxbudrtmv)%maxlist
431 call this%budobj%budterm(idx)%initialize(text, &
436 maxlist, .false., .false., &
441 if (this%idxbudfrtm /= 0)
then
442 text =
' FW-RATE-TO-MVR'
444 maxlist = this%flowbudptr%budterm(this%idxbudfrtm)%maxlist
446 call this%budobj%budterm(idx)%initialize(text, &
451 maxlist, .false., .false., &
462 integer(I4B),
intent(inout) :: idx
463 real(DP),
dimension(:),
intent(in) :: x
464 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
465 real(DP),
intent(inout) :: ccratin
466 real(DP),
intent(inout) :: ccratout
468 integer(I4B) :: j, n1, n2
469 integer(I4B) :: nlist
475 nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist
476 call this%budobj%budterm(idx)%reset(nlist)
478 call this%mwt_rate_term(j, n1, n2, q)
479 call this%budobj%budterm(idx)%update_term(n1, n2, q)
480 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
484 if (this%idxbudfwrt /= 0)
then
486 nlist = this%flowbudptr%budterm(this%idxbudfwrt)%nlist
487 call this%budobj%budterm(idx)%reset(nlist)
489 call this%mwt_fwrt_term(j, n1, n2, q)
490 call this%budobj%budterm(idx)%update_term(n1, n2, q)
491 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
496 if (this%idxbudrtmv /= 0)
then
498 nlist = this%flowbudptr%budterm(this%idxbudrtmv)%nlist
499 call this%budobj%budterm(idx)%reset(nlist)
501 call this%mwt_rtmv_term(j, n1, n2, q)
502 call this%budobj%budterm(idx)%update_term(n1, n2, q)
503 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
508 if (this%idxbudfrtm /= 0)
then
510 nlist = this%flowbudptr%budterm(this%idxbudfrtm)%nlist
511 call this%budobj%budterm(idx)%reset(nlist)
513 call this%mwt_frtm_term(j, n1, n2, q)
514 call this%budobj%budterm(idx)%update_term(n1, n2, q)
515 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
531 call this%TspAptType%allocate_scalars()
534 call mem_allocate(this%idxbudrate,
'IDXBUDRATE', this%memoryPath)
535 call mem_allocate(this%idxbudfwrt,
'IDXBUDFWRT', this%memoryPath)
536 call mem_allocate(this%idxbudrtmv,
'IDXBUDRTMV', this%memoryPath)
537 call mem_allocate(this%idxbudfrtm,
'IDXBUDFRTM', this%memoryPath)
558 call mem_allocate(this%concrate, this%ncv,
'CONCRATE', this%memoryPath)
561 call this%TspAptType%apt_allocate_arrays()
565 this%concrate(n) =
dzero
589 call this%TspAptType%bnd_da()
598 integer(I4B),
intent(in) :: ientry
599 integer(I4B),
intent(inout) :: n1
600 integer(I4B),
intent(inout) :: n2
601 real(DP),
intent(inout),
optional :: rrate
602 real(DP),
intent(inout),
optional :: rhsval
603 real(DP),
intent(inout),
optional :: hcofval
609 n1 = this%flowbudptr%budterm(this%idxbudrate)%id1(ientry)
610 n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry)
612 qbnd = this%flowbudptr%budterm(this%idxbudrate)%flow(ientry)
613 if (qbnd <
dzero)
then
614 ctmp = this%xnewpak(n1)
618 ctmp = this%concrate(n1)
622 if (
present(rrate)) rrate = qbnd * ctmp
623 if (
present(rhsval)) rhsval = r
624 if (
present(hcofval)) hcofval = h
634 integer(I4B),
intent(in) :: ientry
635 integer(I4B),
intent(inout) :: n1
636 integer(I4B),
intent(inout) :: n2
637 real(DP),
intent(inout),
optional :: rrate
638 real(DP),
intent(inout),
optional :: rhsval
639 real(DP),
intent(inout),
optional :: hcofval
644 n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry)
645 n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry)
646 qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry)
647 ctmp = this%xnewpak(n1)
648 if (
present(rrate)) rrate = ctmp * qbnd
649 if (
present(rhsval)) rhsval =
dzero
650 if (
present(hcofval)) hcofval = qbnd
662 integer(I4B),
intent(in) :: ientry
663 integer(I4B),
intent(inout) :: n1
664 integer(I4B),
intent(inout) :: n2
665 real(DP),
intent(inout),
optional :: rrate
666 real(DP),
intent(inout),
optional :: rhsval
667 real(DP),
intent(inout),
optional :: hcofval
672 n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry)
673 n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry)
674 qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry)
675 ctmp = this%xnewpak(n1)
676 if (
present(rrate)) rrate = ctmp * qbnd
677 if (
present(rhsval)) rhsval =
dzero
678 if (
present(hcofval)) hcofval = qbnd
690 integer(I4B),
intent(in) :: ientry
691 integer(I4B),
intent(inout) :: n1
692 integer(I4B),
intent(inout) :: n2
693 real(DP),
intent(inout),
optional :: rrate
694 real(DP),
intent(inout),
optional :: rhsval
695 real(DP),
intent(inout),
optional :: hcofval
700 n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry)
701 n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry)
702 qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry)
703 ctmp = this%xnewpak(n1)
704 if (
present(rrate)) rrate = ctmp * qbnd
705 if (
present(rhsval)) rhsval =
dzero
706 if (
present(hcofval)) hcofval = qbnd
723 call this%obs%StoreObsType(
'concentration', .false., indx)
732 call this%obs%StoreObsType(
'from-mvr', .true., indx)
741 call this%obs%StoreObsType(
'storage', .true., indx)
746 call this%obs%StoreObsType(
'constant', .true., indx)
751 call this%obs%StoreObsType(
'mwt', .true., indx)
756 call this%obs%StoreObsType(
'rate', .true., indx)
761 call this%obs%StoreObsType(
'fw-rate', .true., indx)
766 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
771 call this%obs%StoreObsType(
'fw-rate-to-mvr', .true., indx)
783 logical,
intent(inout) :: found
787 select case (obsrv%ObsTypeId)
789 call this%rp_obs_byfeature(obsrv)
791 call this%rp_obs_byfeature(obsrv)
793 call this%rp_obs_byfeature(obsrv)
794 case (
'FW-RATE-TO-MVR')
795 call this%rp_obs_byfeature(obsrv)
806 character(len=*),
intent(in) :: obstypeid
807 real(DP),
intent(inout) :: v
808 integer(I4B),
intent(in) :: jj
809 logical,
intent(inout) :: found
811 integer(I4B) :: n1, n2
814 select case (obstypeid)
816 if (this%iboundpak(jj) /= 0)
then
817 call this%mwt_rate_term(jj, n1, n2, v)
820 if (this%iboundpak(jj) /= 0 .and. this%idxbudfwrt > 0)
then
821 call this%mwt_fwrt_term(jj, n1, n2, v)
824 if (this%iboundpak(jj) /= 0 .and. this%idxbudrtmv > 0)
then
825 call this%mwt_rtmv_term(jj, n1, n2, v)
827 case (
'FW-RATE-TO-MVR')
828 if (this%iboundpak(jj) /= 0 .and. this%idxbudfrtm > 0)
then
829 call this%mwt_frtm_term(jj, n1, n2, v)
843 integer(I4B),
intent(in) :: itemno
844 character(len=*),
intent(in) :: keyword
845 logical,
intent(inout) :: found
847 character(len=LINELENGTH) :: text
850 real(DP),
pointer :: bndElem => null()
856 select case (keyword)
858 ierr = this%apt_check_valid(itemno)
862 call this%parser%GetString(text)
864 bndelem => this%concrate(itemno)
866 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.