54 character(len=*),
parameter ::
ftype =
'MWT'
55 character(len=*),
parameter ::
flowtype =
'MAW'
56 character(len=16) ::
text =
' MWT'
60 integer(I4B),
pointer :: idxbudrate => null()
61 integer(I4B),
pointer :: idxbudfwrt => null()
62 integer(I4B),
pointer :: idxbudrtmv => null()
63 integer(I4B),
pointer :: idxbudfrtm => null()
64 real(dp),
dimension(:),
pointer,
contiguous :: concrate => null()
92 subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
93 mempath, fmi, eqnsclfac, 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
102 character(len=*),
intent(in) :: mempath
104 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, mempath)
120 call mwtobj%allocate_scalars()
123 call packobj%pack_initialize()
125 packobj%inunit = inunit
128 packobj%ibcnum = ibcnum
139 mwtobj%eqnsclfac => eqnsclfac
142 mwtobj%depvartype = dvt
143 mwtobj%depvarunit = dvu
144 mwtobj%depvarunitabbrev = dvua
155 character(len=LINELENGTH) :: errmsg
156 class(
bndtype),
pointer :: packobj
157 integer(I4B) :: ip, icount
158 integer(I4B) :: nbudterm
168 if (this%fmi%flows_from_file)
then
169 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
170 if (
associated(this%flowbudptr)) found = .true.
173 if (
associated(this%fmi%gwfbndlist))
then
176 do ip = 1, this%fmi%gwfbndlist%Count()
178 if (packobj%packName == this%flowpackagename)
then
183 this%flowpackagebnd => packobj
184 select type (packobj)
186 this%flowbudptr => packobj%budobj
195 if (.not. found)
then
196 write (errmsg,
'(a)')
'Could not find flow package with name '&
197 &//trim(adjustl(this%flowpackagename))//
'.'
204 nbudterm = this%flowbudptr%nbudterm
205 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
208 write (this%iout,
'(/, a, a)') &
209 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
210 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
211 write (this%iout,
'(a, i0)') &
212 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
214 do ip = 1, this%flowbudptr%nbudterm
215 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
216 case (
'FLOW-JA-FACE')
218 this%idxbudssm(ip) = 0
221 this%idxbudssm(ip) = 0
224 this%idxbudssm(ip) = 0
227 this%idxbudssm(ip) = 0
230 this%idxbudssm(ip) = 0
233 this%idxbudssm(ip) = 0
234 case (
'FW-RATE-TO-MVR')
236 this%idxbudssm(ip) = 0
239 this%idxbudssm(ip) = 0
242 this%idxbudssm(ip) = 0
245 this%idxbudssm(ip) = 0
250 this%idxbudssm(ip) = icount
253 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
254 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
255 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
257 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
268 integer(I4B),
intent(in) :: itemno
269 character(len=*),
intent(in) :: key
273 select case (trim(key))
275 val = this%concrate(itemno)
288 real(DP),
dimension(:),
intent(inout) :: rhs
289 integer(I4B),
dimension(:),
intent(in) :: ia
290 integer(I4B),
dimension(:),
intent(in) :: idxglo
293 integer(I4B) :: j, n1, n2
295 integer(I4B) :: iposd
301 if (this%idxbudrate /= 0)
then
302 do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
303 call this%mwt_rate_term(j, n1, n2, rrate, rhsval, hcofval)
304 iloc = this%idxlocnode(n1)
305 iposd = this%idxpakdiag(n1)
306 call matrix_sln%add_value_pos(iposd, hcofval)
307 rhs(iloc) = rhs(iloc) + rhsval
312 if (this%idxbudfwrt /= 0)
then
313 do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
314 call this%mwt_fwrt_term(j, n1, n2, rrate, rhsval, hcofval)
315 iloc = this%idxlocnode(n1)
316 iposd = this%idxpakdiag(n1)
317 call matrix_sln%add_value_pos(iposd, hcofval)
318 rhs(iloc) = rhs(iloc) + rhsval
323 if (this%idxbudrtmv /= 0)
then
324 do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
325 call this%mwt_rtmv_term(j, n1, n2, rrate, rhsval, hcofval)
326 iloc = this%idxlocnode(n1)
327 iposd = this%idxpakdiag(n1)
328 call matrix_sln%add_value_pos(iposd, hcofval)
329 rhs(iloc) = rhs(iloc) + rhsval
334 if (this%idxbudfrtm /= 0)
then
335 do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
336 call this%mwt_frtm_term(j, n1, n2, rrate, rhsval, hcofval)
337 iloc = this%idxlocnode(n1)
338 iposd = this%idxpakdiag(n1)
339 call matrix_sln%add_value_pos(iposd, hcofval)
340 rhs(iloc) = rhs(iloc) + rhsval
353 integer(I4B) :: n1, n2
357 if (this%idxbudrate /= 0)
then
358 do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
359 call this%mwt_rate_term(j, n1, n2, rrate)
360 this%dbuff(n1) = this%dbuff(n1) + rrate
365 if (this%idxbudfwrt /= 0)
then
366 do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
367 call this%mwt_fwrt_term(j, n1, n2, rrate)
368 this%dbuff(n1) = this%dbuff(n1) + rrate
373 if (this%idxbudrtmv /= 0)
then
374 do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
375 call this%mwt_rtmv_term(j, n1, n2, rrate)
376 this%dbuff(n1) = this%dbuff(n1) + rrate
381 if (this%idxbudfrtm /= 0)
then
382 do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
383 call this%mwt_frtm_term(j, n1, n2, rrate)
384 this%dbuff(n1) = this%dbuff(n1) + rrate
398 integer(I4B) :: nbudterms
403 if (this%idxbudfwrt /= 0) nbudterms = nbudterms + 1
404 if (this%idxbudrtmv /= 0) nbudterms = nbudterms + 1
405 if (this%idxbudfrtm /= 0) nbudterms = nbudterms + 1
415 integer(I4B),
intent(inout) :: idx
417 integer(I4B) :: maxlist, naux
418 character(len=LENBUDTXT) :: text
423 maxlist = this%flowbudptr%budterm(this%idxbudrate)%maxlist
425 call this%budobj%budterm(idx)%initialize(text, &
430 maxlist, .false., .false., &
434 if (this%idxbudfwrt /= 0)
then
437 maxlist = this%flowbudptr%budterm(this%idxbudfwrt)%maxlist
439 call this%budobj%budterm(idx)%initialize(text, &
444 maxlist, .false., .false., &
449 if (this%idxbudrtmv /= 0)
then
450 text =
' RATE-TO-MVR'
452 maxlist = this%flowbudptr%budterm(this%idxbudrtmv)%maxlist
454 call this%budobj%budterm(idx)%initialize(text, &
459 maxlist, .false., .false., &
464 if (this%idxbudfrtm /= 0)
then
465 text =
' FW-RATE-TO-MVR'
467 maxlist = this%flowbudptr%budterm(this%idxbudfrtm)%maxlist
469 call this%budobj%budterm(idx)%initialize(text, &
474 maxlist, .false., .false., &
485 integer(I4B),
intent(inout) :: idx
486 real(DP),
dimension(:),
intent(in) :: x
487 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
488 real(DP),
intent(inout) :: ccratin
489 real(DP),
intent(inout) :: ccratout
491 integer(I4B) :: j, n1, n2
492 integer(I4B) :: nlist
498 nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist
499 call this%budobj%budterm(idx)%reset(nlist)
501 call this%mwt_rate_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)
507 if (this%idxbudfwrt /= 0)
then
509 nlist = this%flowbudptr%budterm(this%idxbudfwrt)%nlist
510 call this%budobj%budterm(idx)%reset(nlist)
512 call this%mwt_fwrt_term(j, n1, n2, q)
513 call this%budobj%budterm(idx)%update_term(n1, n2, q)
514 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
519 if (this%idxbudrtmv /= 0)
then
521 nlist = this%flowbudptr%budterm(this%idxbudrtmv)%nlist
522 call this%budobj%budterm(idx)%reset(nlist)
524 call this%mwt_rtmv_term(j, n1, n2, q)
525 call this%budobj%budterm(idx)%update_term(n1, n2, q)
526 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
531 if (this%idxbudfrtm /= 0)
then
533 nlist = this%flowbudptr%budterm(this%idxbudfrtm)%nlist
534 call this%budobj%budterm(idx)%reset(nlist)
536 call this%mwt_frtm_term(j, n1, n2, q)
537 call this%budobj%budterm(idx)%update_term(n1, n2, q)
538 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
554 call this%TspAptType%allocate_scalars()
557 call mem_allocate(this%idxbudrate,
'IDXBUDRATE', this%memoryPath)
558 call mem_allocate(this%idxbudfwrt,
'IDXBUDFWRT', this%memoryPath)
559 call mem_allocate(this%idxbudrtmv,
'IDXBUDRTMV', this%memoryPath)
560 call mem_allocate(this%idxbudfrtm,
'IDXBUDFRTM', this%memoryPath)
580 call mem_setptr(this%concrate,
'RATE', this%input_mempath)
583 call this%TspAptType%apt_allocate_arrays()
603 nullify (this%concrate)
606 call this%TspAptType%bnd_da()
615 integer(I4B),
intent(in) :: ientry
616 integer(I4B),
intent(inout) :: n1
617 integer(I4B),
intent(inout) :: n2
618 real(DP),
intent(inout),
optional :: rrate
619 real(DP),
intent(inout),
optional :: rhsval
620 real(DP),
intent(inout),
optional :: hcofval
626 n1 = this%flowbudptr%budterm(this%idxbudrate)%id1(ientry)
627 n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry)
629 qbnd = this%flowbudptr%budterm(this%idxbudrate)%flow(ientry)
630 if (qbnd <
dzero)
then
631 ctmp = this%xnewpak(n1)
635 ctmp = this%concrate(n1)
639 if (
present(rrate)) rrate = qbnd * ctmp
640 if (
present(rhsval)) rhsval = r
641 if (
present(hcofval)) hcofval = h
651 integer(I4B),
intent(in) :: ientry
652 integer(I4B),
intent(inout) :: n1
653 integer(I4B),
intent(inout) :: n2
654 real(DP),
intent(inout),
optional :: rrate
655 real(DP),
intent(inout),
optional :: rhsval
656 real(DP),
intent(inout),
optional :: hcofval
661 n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry)
662 n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry)
663 qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry)
664 ctmp = this%xnewpak(n1)
665 if (
present(rrate)) rrate = ctmp * qbnd
666 if (
present(rhsval)) rhsval =
dzero
667 if (
present(hcofval)) hcofval = qbnd
679 integer(I4B),
intent(in) :: ientry
680 integer(I4B),
intent(inout) :: n1
681 integer(I4B),
intent(inout) :: n2
682 real(DP),
intent(inout),
optional :: rrate
683 real(DP),
intent(inout),
optional :: rhsval
684 real(DP),
intent(inout),
optional :: hcofval
689 n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry)
690 n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry)
691 qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry)
692 ctmp = this%xnewpak(n1)
693 if (
present(rrate)) rrate = ctmp * qbnd
694 if (
present(rhsval)) rhsval =
dzero
695 if (
present(hcofval)) hcofval = qbnd
707 integer(I4B),
intent(in) :: ientry
708 integer(I4B),
intent(inout) :: n1
709 integer(I4B),
intent(inout) :: n2
710 real(DP),
intent(inout),
optional :: rrate
711 real(DP),
intent(inout),
optional :: rhsval
712 real(DP),
intent(inout),
optional :: hcofval
717 n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry)
718 n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry)
719 qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry)
720 ctmp = this%xnewpak(n1)
721 if (
present(rrate)) rrate = ctmp * qbnd
722 if (
present(rhsval)) rhsval =
dzero
723 if (
present(hcofval)) hcofval = qbnd
740 call this%obs%StoreObsType(
'concentration', .false., indx)
749 call this%obs%StoreObsType(
'from-mvr', .true., indx)
758 call this%obs%StoreObsType(
'storage', .true., indx)
763 call this%obs%StoreObsType(
'constant', .true., indx)
768 call this%obs%StoreObsType(
'mwt', .true., indx)
773 call this%obs%StoreObsType(
'rate', .true., indx)
778 call this%obs%StoreObsType(
'fw-rate', .true., indx)
783 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
788 call this%obs%StoreObsType(
'fw-rate-to-mvr', .true., indx)
800 logical,
intent(inout) :: found
804 select case (obsrv%ObsTypeId)
806 call this%rp_obs_byfeature(obsrv)
808 call this%rp_obs_byfeature(obsrv)
810 call this%rp_obs_byfeature(obsrv)
811 case (
'FW-RATE-TO-MVR')
812 call this%rp_obs_byfeature(obsrv)
823 character(len=*),
intent(in) :: obstypeid
824 real(DP),
intent(inout) :: v
825 integer(I4B),
intent(in) :: jj
826 logical,
intent(inout) :: found
828 integer(I4B) :: n1, n2
831 select case (obstypeid)
833 if (this%iboundpak(jj) /= 0)
then
834 call this%mwt_rate_term(jj, n1, n2, v)
837 if (this%iboundpak(jj) /= 0 .and. this%idxbudfwrt > 0)
then
838 call this%mwt_fwrt_term(jj, n1, n2, v)
841 if (this%iboundpak(jj) /= 0 .and. this%idxbudrtmv > 0)
then
842 call this%mwt_rtmv_term(jj, n1, n2, v)
844 case (
'FW-RATE-TO-MVR')
845 if (this%iboundpak(jj) /= 0 .and. this%idxbudfrtm > 0)
then
846 call this%mwt_frtm_term(jj, n1, n2, v)
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 dnodata
real no data constant
integer(i4b), parameter lenvarname
maximum length of a variable name
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, public mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, fmi, eqnsclfac, dvt, dvu, dvua)
Create new MWT package.
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.
real(dp) function mwt_setting_value(this, itemno, key)
Value for a package-specific PERIOD setting.
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.
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 store_error_filename(filename, terminate)
Store the erroring file name.
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.
This class is used to store a single deferred-length character string. It was designed to work in an ...