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()
93 subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
94 mempath, fmi, eqnsclfac, dvt, dvu, dvua)
96 class(
bndtype),
pointer :: packobj
97 integer(I4B),
intent(in) :: id
98 integer(I4B),
intent(in) :: ibcnum
99 integer(I4B),
intent(in) :: inunit
100 integer(I4B),
intent(in) :: iout
101 character(len=*),
intent(in) :: namemodel
102 character(len=*),
intent(in) :: pakname
103 character(len=*),
intent(in) :: mempath
105 real(dp),
intent(in),
pointer :: eqnsclfac
106 character(len=*),
intent(in) :: dvt
107 character(len=*),
intent(in) :: dvu
108 character(len=*),
intent(in) :: dvua
117 call packobj%set_names(ibcnum, namemodel, pakname,
ftype, mempath)
121 call mwtobj%allocate_scalars()
124 call packobj%pack_initialize()
126 packobj%inunit = inunit
129 packobj%ibcnum = ibcnum
140 mwtobj%eqnsclfac => eqnsclfac
143 mwtobj%depvartype = dvt
144 mwtobj%depvarunit = dvu
145 mwtobj%depvarunitabbrev = dvua
156 character(len=LINELENGTH) :: errmsg
157 class(
bndtype),
pointer :: packobj
158 integer(I4B) :: ip, icount
159 integer(I4B) :: nbudterm
169 if (this%fmi%flows_from_file)
then
170 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
171 if (
associated(this%flowbudptr)) found = .true.
174 if (
associated(this%fmi%gwfbndlist))
then
177 do ip = 1, this%fmi%gwfbndlist%Count()
179 if (packobj%packName == this%flowpackagename)
then
184 this%flowpackagebnd => packobj
185 select type (packobj)
187 this%flowbudptr => packobj%budobj
196 if (.not. found)
then
197 write (errmsg,
'(a)')
'Could not find flow package with name '&
198 &//trim(adjustl(this%flowpackagename))//
'.'
205 nbudterm = this%flowbudptr%nbudterm
206 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
209 write (this%iout,
'(/, a, a)') &
210 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
211 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
212 write (this%iout,
'(a, i0)') &
213 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
215 do ip = 1, this%flowbudptr%nbudterm
216 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
217 case (
'FLOW-JA-FACE')
219 this%idxbudssm(ip) = 0
222 this%idxbudssm(ip) = 0
225 this%idxbudssm(ip) = 0
228 this%idxbudssm(ip) = 0
231 this%idxbudssm(ip) = 0
234 this%idxbudssm(ip) = 0
235 case (
'FW-RATE-TO-MVR')
237 this%idxbudssm(ip) = 0
240 this%idxbudssm(ip) = 0
243 this%idxbudssm(ip) = 0
246 this%idxbudssm(ip) = 0
251 this%idxbudssm(ip) = icount
254 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
255 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
256 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
258 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
269 integer(I4B),
intent(in) :: itemno
270 character(len=*),
intent(in) :: key
274 select case (trim(key))
276 val = this%concrate(itemno)
289 real(DP),
dimension(:),
intent(inout) :: rhs
290 integer(I4B),
dimension(:),
intent(in) :: ia
291 integer(I4B),
dimension(:),
intent(in) :: idxglo
294 integer(I4B) :: j, n1, n2
296 integer(I4B) :: iposd
302 if (this%idxbudrate /= 0)
then
303 do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
304 call this%mwt_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%mwt_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%mwt_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%mwt_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
354 integer(I4B) :: n1, n2
358 if (this%idxbudrate /= 0)
then
359 do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
360 call this%mwt_rate_term(j, n1, n2, rrate)
361 this%dbuff(n1) = this%dbuff(n1) + rrate
366 if (this%idxbudfwrt /= 0)
then
367 do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
368 call this%mwt_fwrt_term(j, n1, n2, rrate)
369 this%dbuff(n1) = this%dbuff(n1) + rrate
374 if (this%idxbudrtmv /= 0)
then
375 do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
376 call this%mwt_rtmv_term(j, n1, n2, rrate)
377 this%dbuff(n1) = this%dbuff(n1) + rrate
382 if (this%idxbudfrtm /= 0)
then
383 do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
384 call this%mwt_frtm_term(j, n1, n2, rrate)
385 this%dbuff(n1) = this%dbuff(n1) + rrate
399 integer(I4B) :: nbudterms
404 if (this%idxbudfwrt /= 0) nbudterms = nbudterms + 1
405 if (this%idxbudrtmv /= 0) nbudterms = nbudterms + 1
406 if (this%idxbudfrtm /= 0) nbudterms = nbudterms + 1
416 integer(I4B),
intent(inout) :: idx
418 integer(I4B) :: maxlist, naux
419 character(len=LENBUDTXT) :: text
424 maxlist = this%flowbudptr%budterm(this%idxbudrate)%maxlist
426 call this%budobj%budterm(idx)%initialize(text, &
431 maxlist, .false., .false., &
435 if (this%idxbudfwrt /= 0)
then
438 maxlist = this%flowbudptr%budterm(this%idxbudfwrt)%maxlist
440 call this%budobj%budterm(idx)%initialize(text, &
445 maxlist, .false., .false., &
450 if (this%idxbudrtmv /= 0)
then
451 text =
' RATE-TO-MVR'
453 maxlist = this%flowbudptr%budterm(this%idxbudrtmv)%maxlist
455 call this%budobj%budterm(idx)%initialize(text, &
460 maxlist, .false., .false., &
465 if (this%idxbudfrtm /= 0)
then
466 text =
' FW-RATE-TO-MVR'
468 maxlist = this%flowbudptr%budterm(this%idxbudfrtm)%maxlist
470 call this%budobj%budterm(idx)%initialize(text, &
475 maxlist, .false., .false., &
486 integer(I4B),
intent(inout) :: idx
487 real(DP),
dimension(:),
intent(in) :: x
488 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
489 real(DP),
intent(inout) :: ccratin
490 real(DP),
intent(inout) :: ccratout
492 integer(I4B) :: j, n1, n2
493 integer(I4B) :: nlist
499 nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist
500 call this%budobj%budterm(idx)%reset(nlist)
502 call this%mwt_rate_term(j, n1, n2, q)
503 call this%budobj%budterm(idx)%update_term(n1, n2, q)
504 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
508 if (this%idxbudfwrt /= 0)
then
510 nlist = this%flowbudptr%budterm(this%idxbudfwrt)%nlist
511 call this%budobj%budterm(idx)%reset(nlist)
513 call this%mwt_fwrt_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)
520 if (this%idxbudrtmv /= 0)
then
522 nlist = this%flowbudptr%budterm(this%idxbudrtmv)%nlist
523 call this%budobj%budterm(idx)%reset(nlist)
525 call this%mwt_rtmv_term(j, n1, n2, q)
526 call this%budobj%budterm(idx)%update_term(n1, n2, q)
527 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
532 if (this%idxbudfrtm /= 0)
then
534 nlist = this%flowbudptr%budterm(this%idxbudfrtm)%nlist
535 call this%budobj%budterm(idx)%reset(nlist)
537 call this%mwt_frtm_term(j, n1, n2, q)
538 call this%budobj%budterm(idx)%update_term(n1, n2, q)
539 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
555 call this%TspAptType%allocate_scalars()
558 call mem_allocate(this%idxbudrate,
'IDXBUDRATE', this%memoryPath)
559 call mem_allocate(this%idxbudfwrt,
'IDXBUDFWRT', this%memoryPath)
560 call mem_allocate(this%idxbudrtmv,
'IDXBUDRTMV', this%memoryPath)
561 call mem_allocate(this%idxbudfrtm,
'IDXBUDFRTM', this%memoryPath)
581 call mem_setptr(this%concrate,
'RATE', this%input_mempath)
584 call this%TspAptType%apt_allocate_arrays()
598 call this%TspAptType%apt_checkin_deprecated_names()
601 'RATE', this%input_mempath,
'6.8.2')
620 nullify (this%concrate)
623 call this%TspAptType%bnd_da()
632 integer(I4B),
intent(in) :: ientry
633 integer(I4B),
intent(inout) :: n1
634 integer(I4B),
intent(inout) :: n2
635 real(DP),
intent(inout),
optional :: rrate
636 real(DP),
intent(inout),
optional :: rhsval
637 real(DP),
intent(inout),
optional :: hcofval
643 n1 = this%flowbudptr%budterm(this%idxbudrate)%id1(ientry)
644 n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry)
646 qbnd = this%flowbudptr%budterm(this%idxbudrate)%flow(ientry)
647 if (qbnd <
dzero)
then
648 ctmp = this%xnewpak(n1)
652 ctmp = this%concrate(n1)
656 if (
present(rrate)) rrate = qbnd * ctmp
657 if (
present(rhsval)) rhsval = r
658 if (
present(hcofval)) hcofval = h
668 integer(I4B),
intent(in) :: ientry
669 integer(I4B),
intent(inout) :: n1
670 integer(I4B),
intent(inout) :: n2
671 real(DP),
intent(inout),
optional :: rrate
672 real(DP),
intent(inout),
optional :: rhsval
673 real(DP),
intent(inout),
optional :: hcofval
678 n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry)
679 n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry)
680 qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry)
681 ctmp = this%xnewpak(n1)
682 if (
present(rrate)) rrate = ctmp * qbnd
683 if (
present(rhsval)) rhsval =
dzero
684 if (
present(hcofval)) hcofval = qbnd
696 integer(I4B),
intent(in) :: ientry
697 integer(I4B),
intent(inout) :: n1
698 integer(I4B),
intent(inout) :: n2
699 real(DP),
intent(inout),
optional :: rrate
700 real(DP),
intent(inout),
optional :: rhsval
701 real(DP),
intent(inout),
optional :: hcofval
706 n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry)
707 n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry)
708 qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry)
709 ctmp = this%xnewpak(n1)
710 if (
present(rrate)) rrate = ctmp * qbnd
711 if (
present(rhsval)) rhsval =
dzero
712 if (
present(hcofval)) hcofval = qbnd
724 integer(I4B),
intent(in) :: ientry
725 integer(I4B),
intent(inout) :: n1
726 integer(I4B),
intent(inout) :: n2
727 real(DP),
intent(inout),
optional :: rrate
728 real(DP),
intent(inout),
optional :: rhsval
729 real(DP),
intent(inout),
optional :: hcofval
734 n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry)
735 n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry)
736 qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry)
737 ctmp = this%xnewpak(n1)
738 if (
present(rrate)) rrate = ctmp * qbnd
739 if (
present(rhsval)) rhsval =
dzero
740 if (
present(hcofval)) hcofval = qbnd
757 call this%obs%StoreObsType(
'concentration', .false., indx)
766 call this%obs%StoreObsType(
'from-mvr', .true., indx)
775 call this%obs%StoreObsType(
'storage', .true., indx)
780 call this%obs%StoreObsType(
'constant', .true., indx)
785 call this%obs%StoreObsType(
'mwt', .true., indx)
790 call this%obs%StoreObsType(
'rate', .true., indx)
795 call this%obs%StoreObsType(
'fw-rate', .true., indx)
800 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
805 call this%obs%StoreObsType(
'fw-rate-to-mvr', .true., indx)
817 logical,
intent(inout) :: found
821 select case (obsrv%ObsTypeId)
823 call this%rp_obs_byfeature(obsrv)
825 call this%rp_obs_byfeature(obsrv)
827 call this%rp_obs_byfeature(obsrv)
828 case (
'FW-RATE-TO-MVR')
829 call this%rp_obs_byfeature(obsrv)
840 character(len=*),
intent(in) :: obstypeid
841 real(DP),
intent(inout) :: v
842 integer(I4B),
intent(in) :: jj
843 logical,
intent(inout) :: found
845 integer(I4B) :: n1, n2
848 select case (obstypeid)
850 if (this%iboundpak(jj) /= 0)
then
851 call this%mwt_rate_term(jj, n1, n2, v)
854 if (this%iboundpak(jj) /= 0 .and. this%idxbudfwrt > 0)
then
855 call this%mwt_fwrt_term(jj, n1, n2, v)
858 if (this%iboundpak(jj) /= 0 .and. this%idxbudrtmv > 0)
then
859 call this%mwt_rtmv_term(jj, n1, n2, v)
861 case (
'FW-RATE-TO-MVR')
862 if (this%iboundpak(jj) /= 0 .and. this%idxbudfrtm > 0)
then
863 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_checkin_deprecated_names(this)
Alias deprecated MWT variable names to their current storage.
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.
Previous variable names checked in as deprecated aliases.
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 ...