39 character(len=LENFTYPE) ::
ftype =
'MAW'
40 character(len=LENPACKAGENAME) ::
text =
' MAW'
50 character(len=LENBUDTXT),
dimension(:),
pointer, &
51 contiguous :: cmawbudget => null()
52 character(len=LENAUXNAME),
dimension(:),
pointer, &
53 contiguous :: cauxcbc => null()
56 logical(LGP),
pointer :: correct_flow => null()
59 integer(I4B),
pointer :: iprhed => null()
60 integer(I4B),
pointer :: iheadout => null()
61 integer(I4B),
pointer :: ibudgetout => null()
62 integer(I4B),
pointer :: ibudcsv => null()
63 integer(I4B),
pointer :: cbcauxitems => null()
64 integer(I4B),
pointer :: iflowingwells => null()
65 integer(I4B),
pointer :: imawiss => null()
66 integer(I4B),
pointer :: imawissopt => null()
67 integer(I4B),
pointer :: nmawwells => null()
68 integer(I4B),
pointer :: check_attr => null()
69 integer(I4B),
pointer :: ishutoffcnt => null()
70 integer(I4B),
pointer :: ieffradopt => null()
71 integer(I4B),
pointer :: ioutredflowcsv => null()
72 real(dp),
pointer :: satomega => null()
75 real(dp),
pointer :: theta => null()
76 real(dp),
pointer :: kappa => null()
79 character(len=8),
dimension(:),
pointer,
contiguous :: status => null()
80 integer(I4B),
dimension(:),
pointer,
contiguous :: ngwfnodes => null()
81 integer(I4B),
dimension(:),
pointer,
contiguous :: ieqn => null()
82 integer(I4B),
dimension(:),
pointer,
contiguous :: ishutoff => null()
83 integer(I4B),
dimension(:),
pointer,
contiguous :: ifwdischarge => null()
84 real(dp),
dimension(:),
pointer,
contiguous :: strt => null()
85 real(dp),
dimension(:),
pointer,
contiguous :: radius => null()
86 real(dp),
dimension(:),
pointer,
contiguous :: area => null()
87 real(dp),
dimension(:),
pointer,
contiguous :: pumpelev => null()
88 real(dp),
dimension(:),
pointer,
contiguous :: bot => null()
89 real(dp),
dimension(:),
pointer,
contiguous :: ratesim => null()
90 real(dp),
dimension(:),
pointer,
contiguous :: reduction_length => null()
91 real(dp),
dimension(:),
pointer,
contiguous :: fwelev => null()
92 real(dp),
dimension(:),
pointer,
contiguous :: fwcond => null()
93 real(dp),
dimension(:),
pointer,
contiguous :: fwrlen => null()
94 real(dp),
dimension(:),
pointer,
contiguous :: fwcondsim => null()
95 real(dp),
dimension(:),
pointer,
contiguous :: xsto => null()
96 real(dp),
dimension(:),
pointer,
contiguous :: xoldsto => null()
97 real(dp),
dimension(:),
pointer,
contiguous :: shutoffmin => null()
98 real(dp),
dimension(:),
pointer,
contiguous :: shutoffmax => null()
99 real(dp),
dimension(:),
pointer,
contiguous :: shutofflevel => null()
100 real(dp),
dimension(:),
pointer,
contiguous :: shutoffweight => null()
101 real(dp),
dimension(:),
pointer,
contiguous :: shutoffdq => null()
102 real(dp),
dimension(:),
pointer,
contiguous :: shutoffqold => null()
103 character(len=LENBOUNDNAME),
dimension(:),
pointer, &
104 contiguous :: cmawname => null()
107 real(dp),
dimension(:),
pointer,
contiguous :: rate => null()
108 real(dp),
dimension(:),
pointer,
contiguous :: well_head => null()
109 real(dp),
dimension(:, :),
pointer,
contiguous :: mauxvar => null()
112 integer(I4B),
dimension(:),
pointer,
contiguous :: iaconn => null()
115 integer(I4B),
dimension(:),
pointer,
contiguous :: gwfnodes => null()
116 real(dp),
dimension(:),
pointer,
contiguous :: sradius => null()
117 real(dp),
dimension(:),
pointer,
contiguous :: hk => null()
118 real(dp),
dimension(:),
pointer,
contiguous :: satcond => null()
119 real(dp),
dimension(:),
pointer,
contiguous :: simcond => null()
120 real(dp),
dimension(:),
pointer,
contiguous :: topscrn => null()
121 real(dp),
dimension(:),
pointer,
contiguous :: botscrn => null()
124 integer(I4B),
dimension(:),
pointer,
contiguous :: imap => null()
127 real(dp),
dimension(:),
pointer,
contiguous :: qauxcbc => null()
128 real(dp),
dimension(:),
pointer,
contiguous :: dbuff => null()
129 real(dp),
dimension(:),
pointer,
contiguous :: qleak => null()
130 real(dp),
dimension(:),
pointer,
contiguous :: qout => null()
131 real(dp),
dimension(:),
pointer,
contiguous :: qfw => null()
132 real(dp),
dimension(:),
pointer,
contiguous :: qsto => null()
133 real(dp),
dimension(:),
pointer,
contiguous :: qconst => null()
136 integer(I4B),
pointer :: bditems => null()
143 integer(I4B),
pointer :: gwfiss => null()
144 real(dp),
dimension(:),
pointer,
contiguous :: gwfk11 => null()
145 real(dp),
dimension(:),
pointer,
contiguous :: gwfk22 => null()
146 integer(I4B),
pointer :: gwfik22 => null()
147 real(dp),
dimension(:),
pointer,
contiguous :: gwfsat => null()
150 integer(I4B),
dimension(:),
pointer,
contiguous :: idxlocnode => null()
151 integer(I4B),
dimension(:),
pointer,
contiguous :: idxdglo => null()
152 integer(I4B),
dimension(:),
pointer,
contiguous :: idxoffdglo => null()
153 integer(I4B),
dimension(:),
pointer,
contiguous :: idxsymdglo => null()
154 integer(I4B),
dimension(:),
pointer,
contiguous :: idxsymoffdglo => null()
155 integer(I4B),
dimension(:),
pointer,
contiguous :: iboundpak => null()
156 real(dp),
dimension(:),
pointer,
contiguous :: xnewpak => null()
157 real(dp),
dimension(:),
pointer,
contiguous :: xoldpak => null()
160 integer(I4B),
pointer :: idense
161 real(dp),
dimension(:, :),
pointer,
contiguous :: denseterms => null()
164 real(dp),
dimension(:, :),
pointer,
contiguous :: viscratios => null()
233 subroutine maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
235 class(
bndtype),
pointer :: packobj
236 integer(I4B),
intent(in) :: id
237 integer(I4B),
intent(in) :: ibcnum
238 integer(I4B),
intent(in) :: inunit
239 integer(I4B),
intent(in) :: iout
240 character(len=*),
intent(in) :: namemodel
241 character(len=*),
intent(in) :: pakname
242 type(
mawtype),
pointer :: mawobj
249 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
253 call mawobj%maw_allocate_scalars()
256 call packobj%pack_initialize()
258 packobj%inunit = inunit
261 packobj%ibcnum = ibcnum
274 class(
mawtype),
intent(inout) :: this
277 call this%BndType%allocate_scalars()
280 call mem_allocate(this%correct_flow,
'CORRECT_FLOW', this%memoryPath)
281 call mem_allocate(this%iprhed,
'IPRHED', this%memoryPath)
282 call mem_allocate(this%iheadout,
'IHEADOUT', this%memoryPath)
283 call mem_allocate(this%ibudgetout,
'IBUDGETOUT', this%memoryPath)
284 call mem_allocate(this%ibudcsv,
'IBUDCSV', this%memoryPath)
285 call mem_allocate(this%iflowingwells,
'IFLOWINGWELLS', this%memoryPath)
286 call mem_allocate(this%imawiss,
'IMAWISS', this%memoryPath)
287 call mem_allocate(this%imawissopt,
'IMAWISSOPT', this%memoryPath)
288 call mem_allocate(this%nmawwells,
'NMAWWELLS', this%memoryPath)
289 call mem_allocate(this%check_attr,
'CHECK_ATTR', this%memoryPath)
290 call mem_allocate(this%ishutoffcnt,
'ISHUTOFFCNT', this%memoryPath)
291 call mem_allocate(this%ieffradopt,
'IEFFRADOPT', this%memoryPath)
292 call mem_allocate(this%ioutredflowcsv,
'IOUTREDFLOWCSV', this%memoryPath)
293 call mem_allocate(this%satomega,
'SATOMEGA', this%memoryPath)
294 call mem_allocate(this%bditems,
'BDITEMS', this%memoryPath)
297 call mem_allocate(this%cbcauxitems,
'CBCAUXITEMS', this%memoryPath)
298 call mem_allocate(this%idense,
'IDENSE', this%memoryPath)
301 this%correct_flow = .false.
307 this%iflowingwells = 0
311 this%ioutredflowcsv = 0
312 this%satomega =
dzero
327 class(
mawtype),
intent(inout) :: this
338 this%cmawbudget(1) =
' GWF'
339 this%cmawbudget(2) =
' RATE'
340 this%cmawbudget(3) =
' STORAGE'
341 this%cmawbudget(4) =
' CONSTANT'
342 this%cmawbudget(5) =
' FW-RATE'
343 this%cmawbudget(6) =
' FROM-MVR'
344 this%cmawbudget(7) =
' RATE-TO-MVR'
345 this%cmawbudget(8) =
' FW-RATE-TO-MVR'
350 call mem_allocate(this%status, 8, this%nmawwells,
'STATUS', this%memoryPath)
353 call mem_allocate(this%ngwfnodes, this%nmawwells,
'NGWFNODES', &
355 call mem_allocate(this%ieqn, this%nmawwells,
'IEQN', this%memoryPath)
356 call mem_allocate(this%ishutoff, this%nmawwells,
'ISHUTOFF', this%memoryPath)
357 call mem_allocate(this%ifwdischarge, this%nmawwells,
'IFWDISCHARGE', &
359 call mem_allocate(this%strt, this%nmawwells,
'STRT', this%memoryPath)
360 call mem_allocate(this%radius, this%nmawwells,
'RADIUS', this%memoryPath)
361 call mem_allocate(this%area, this%nmawwells,
'AREA', this%memoryPath)
362 call mem_allocate(this%pumpelev, this%nmawwells,
'PUMPELEV', this%memoryPath)
363 call mem_allocate(this%bot, this%nmawwells,
'BOT', this%memoryPath)
364 call mem_allocate(this%ratesim, this%nmawwells,
'RATESIM', this%memoryPath)
365 call mem_allocate(this%reduction_length, this%nmawwells,
'REDUCTION_LENGTH', &
367 call mem_allocate(this%fwelev, this%nmawwells,
'FWELEV', this%memoryPath)
368 call mem_allocate(this%fwcond, this%nmawwells,
'FWCONDS', this%memoryPath)
369 call mem_allocate(this%fwrlen, this%nmawwells,
'FWRLEN', this%memoryPath)
370 call mem_allocate(this%fwcondsim, this%nmawwells,
'FWCONDSIM', &
372 call mem_allocate(this%xsto, this%nmawwells,
'XSTO', this%memoryPath)
373 call mem_allocate(this%xoldsto, this%nmawwells,
'XOLDSTO', this%memoryPath)
374 call mem_allocate(this%shutoffmin, this%nmawwells,
'SHUTOFFMIN', &
376 call mem_allocate(this%shutoffmax, this%nmawwells,
'SHUTOFFMAX', &
378 call mem_allocate(this%shutofflevel, this%nmawwells,
'SHUTOFFLEVEL', &
380 call mem_allocate(this%shutoffweight, this%nmawwells,
'SHUTOFFWEIGHT', &
382 call mem_allocate(this%shutoffdq, this%nmawwells,
'SHUTOFFDQ', &
384 call mem_allocate(this%shutoffqold, this%nmawwells,
'SHUTOFFQOLD', &
388 call mem_allocate(this%rate, this%nmawwells,
'RATE', this%memoryPath)
389 call mem_allocate(this%well_head, this%nmawwells,
'WELL_HEAD', &
391 if (this%naux > 0)
then
396 call mem_allocate(this%mauxvar, jj, this%nmawwells,
'MAUXVAR', &
400 if (this%iheadout > 0)
then
401 call mem_allocate(this%dbuff, this%nmawwells,
'DBUFF', this%memoryPath)
403 call mem_allocate(this%dbuff, 0,
'DBUFF', this%memoryPath)
407 call mem_allocate(this%iaconn, this%nmawwells + 1,
'IACONN', this%memoryPath)
410 call mem_allocate(this%imap, this%MAXBOUND,
'IMAP', this%memoryPath)
413 call mem_allocate(this%gwfnodes, this%maxbound,
'GWFNODES', this%memoryPath)
414 call mem_allocate(this%sradius, this%maxbound,
'SRADIUS', this%memoryPath)
415 call mem_allocate(this%hk, this%maxbound,
'HK', this%memoryPath)
416 call mem_allocate(this%satcond, this%maxbound,
'SATCOND', this%memoryPath)
417 call mem_allocate(this%simcond, this%maxbound,
'SIMCOND', this%memoryPath)
418 call mem_allocate(this%topscrn, this%maxbound,
'TOPSCRN', this%memoryPath)
419 call mem_allocate(this%botscrn, this%maxbound,
'BOTSCRN', this%memoryPath)
422 call mem_allocate(this%qleak, this%maxbound,
'QLEAK', this%memoryPath)
425 do n = 1, this%nmawwells
426 this%status(n) =
'ACTIVE'
427 this%ngwfnodes(n) = 0
430 this%ifwdischarge(n) = 0
432 this%radius(n) =
dep20
434 this%pumpelev(n) =
dep20
436 this%ratesim(n) =
dzero
437 this%reduction_length(n) =
dep20
438 this%fwelev(n) =
dzero
439 this%fwcond(n) =
dzero
440 this%fwrlen(n) =
dzero
441 this%fwcondsim(n) =
dzero
443 this%xoldsto(n) =
dzero
444 this%shutoffmin(n) =
dzero
445 this%shutoffmax(n) =
dzero
446 this%shutofflevel(n) =
dep20
447 this%shutoffweight(n) =
done
448 this%shutoffdq(n) =
done
449 this%shutoffqold(n) =
done
453 this%well_head(n) =
dzero
454 do jj = 1, max(1, this%naux)
455 this%mauxvar(jj, n) =
dzero
459 if (this%iheadout > 0)
then
460 this%dbuff(n) =
dzero
465 do n = 1, this%nmawwells + 1
474 call mem_allocate(this%qauxcbc, this%cbcauxitems,
'QAUXCBC', this%memoryPath)
475 do j = 1, this%cbcauxitems
476 this%qauxcbc(j) =
dzero
480 if (this%iflowingwells /= 0)
then
481 call mem_allocate(this%qfw, this%nmawwells,
'QFW', this%memoryPath)
485 call mem_allocate(this%qout, this%nmawwells,
'QOUT', this%memoryPath)
486 call mem_allocate(this%qsto, this%nmawwells,
'QSTO', this%memoryPath)
487 call mem_allocate(this%qconst, this%nmawwells,
'QCONST', this%memoryPath)
490 do n = 1, this%nmawwells
491 if (this%iflowingwells > 0)
then
495 this%qconst(n) =
dzero
499 do j = 1, this%maxbound
502 this%sradius(j) =
dzero
504 this%satcond(j) =
dzero
505 this%simcond(j) =
dzero
506 this%topscrn(j) =
dzero
507 this%botscrn(j) =
dzero
508 this%qleak(j) =
dzero
512 call mem_allocate(this%denseterms, 3, 0,
'DENSETERMS', this%memoryPath)
515 call mem_allocate(this%viscratios, 2, 0,
'VISCRATIOS', this%memoryPath)
524 class(
mawtype),
intent(inout) :: this
528 call this%BndType%allocate_arrays()
537 class(
mawtype),
intent(inout) :: this
539 character(len=LINELENGTH) :: text
540 character(len=LINELENGTH) :: keyword
541 character(len=LINELENGTH) :: cstr
542 character(len=LENBOUNDNAME) :: bndName
543 character(len=LENBOUNDNAME) :: bndNameTemp
544 character(len=9) :: cno
546 logical :: endOfBlock
557 real(DP),
pointer :: bndElem => null()
559 character(len=LINELENGTH),
dimension(:),
allocatable :: strttext
560 character(len=LENBOUNDNAME),
dimension(:),
allocatable :: nametxt
561 character(len=50),
dimension(:, :),
allocatable :: caux
562 integer(I4B),
dimension(:),
allocatable :: nboundchk
563 integer(I4B),
dimension(:),
allocatable :: wellieqn
564 integer(I4B),
dimension(:),
allocatable :: ngwfnodes
565 real(DP),
dimension(:),
allocatable :: radius
566 real(DP),
dimension(:),
allocatable :: bottom
568 character(len=*),
parameter :: fmthdbot = &
569 "('well head (', G0, ') must be greater than or equal to the &
570 &BOTTOM_ELEVATION (', G0, ').')"
573 allocate (strttext(this%nmawwells))
574 allocate (nametxt(this%nmawwells))
575 if (this%naux > 0)
then
576 allocate (caux(this%naux, this%nmawwells))
578 allocate (nboundchk(this%nmawwells))
579 allocate (wellieqn(this%nmawwells))
580 allocate (ngwfnodes(this%nmawwells))
581 allocate (radius(this%nmawwells))
582 allocate (bottom(this%nmawwells))
585 do n = 1, this%nmawwells
593 this%npakeq = this%nmawwells
597 call this%parser%GetBlock(
'PACKAGEDATA', isfound, ierr, &
598 supportopenclose=.true.)
602 write (this%iout,
'(/1x,a)') &
603 'PROCESSING '//trim(adjustl(this%text))//
' PACKAGEDATA'
605 call this%parser%GetNextLine(endofblock)
607 ival = this%parser%GetInteger()
610 if (n < 1 .or. n > this%nmawwells)
then
611 write (
errmsg,
'(a,1x,i0,a)') &
612 'IMAW must be greater than 0 and less than or equal to', &
619 nboundchk(n) = nboundchk(n) + 1
622 rval = this%parser%GetDouble()
623 if (rval <= dzero)
then
624 write (
errmsg,
'(a,1x,i0,1x,a)') &
625 'Radius for well', n,
'must be greater than zero.'
631 bottom(n) = this%parser%GetDouble()
634 call this%parser%GetString(strttext(n))
637 call this%parser%GetStringCaps(keyword)
638 if (keyword ==
'SPECIFIED')
then
640 else if (keyword ==
'THIEM')
then
642 else if (keyword ==
'THEIM')
then
644 write (
warnmsg,
'(a,a,a,a,a,a)') &
645 "CONDEQN in '", trim(this%packName),
"' should be ", &
646 "corrected from '", trim(keyword),
"' to 'THIEM'."
648 else if (keyword ==
'SKIN')
then
650 else if (keyword ==
'CUMULATIVE')
then
652 else if (keyword ==
'MEAN')
then
655 write (
errmsg,
'(a,1x,i0,1x,a)') &
656 'CONDEQN for well', n, &
657 "must be 'CUMULATIVE', 'THIEM', 'MEAN', or 'SKIN'."
662 ival = this%parser%GetInteger()
665 write (
errmsg,
'(a,1x,i0,1x,a)') &
666 'NGWFNODES for well', n,
'must be greater than zero.'
679 call this%parser%GetString(caux(jj, n))
683 write (cno,
'(i9.9)') n
684 bndname =
'MAWWELL'//cno
687 if (this%inamedbound /= 0)
then
688 call this%parser%GetStringCaps(bndnametemp)
689 if (bndnametemp /=
'')
then
690 bndname = bndnametemp
696 write (this%iout,
'(1x,a)') &
697 'END OF '//trim(adjustl(this%text))//
' PACKAGEDATA'
700 do n = 1, this%nmawwells
701 if (nboundchk(n) == 0)
then
702 write (
errmsg,
'(a,1x,i0,a)')
'No data specified for maw well', n,
'.'
704 else if (nboundchk(n) > 1)
then
705 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
706 'Data for maw well', n,
'specified', nboundchk(n),
'times.'
711 call store_error(
'Required packagedata block not found.')
716 call this%parser%StoreErrorUnit()
721 write (this%iout,
'(//4x,a,i7)')
'MAXBOUND = ', this%maxbound
724 call this%maw_allocate_well_conn_arrays()
727 do n = 1, this%nmawwells
729 this%radius(n) = rval
730 this%area(n) = dpi * rval**dtwo
731 this%bot(n) = bottom(n)
732 this%ieqn(n) = wellieqn(n)
733 this%ngwfnodes(n) = ngwfnodes(n)
734 this%cmawname(n) = nametxt(n)
740 bndelem => this%well_head(n)
742 this%packName,
'BND', this%tsManager, &
743 this%iprpak,
'WELL_HEAD')
746 this%strt(n) = this%well_head(n)
749 if (this%strt(n) < this%bot(n))
then
750 write (cstr, fmthdbot) this%strt(n), this%bot(n)
751 call this%maw_set_attribute_error(n,
'STRT', trim(cstr))
758 bndelem => this%mauxvar(jj, ii)
760 'AUX', this%tsManager, this%iprpak, &
768 do n = 1, this%nmawwells
769 do j = 1, this%ngwfnodes(n)
773 this%iaconn(n + 1) = idx + 1
777 deallocate (strttext)
779 if (this%naux > 0)
then
782 deallocate (nboundchk)
783 deallocate (wellieqn)
784 deallocate (ngwfnodes)
794 class(
mawtype),
intent(inout) :: this
796 character(len=LINELENGTH) :: cellid
797 character(len=30) :: nodestr
799 logical :: endOfBlock
809 integer(I4B) :: ireset_scrntop
810 integer(I4B) :: ireset_scrnbot
811 integer(I4B) :: ireset_wellbot
816 integer(I4B),
dimension(:),
pointer,
contiguous :: nboundchk
817 integer(I4B),
dimension(:),
pointer,
contiguous :: iachk
825 allocate (iachk(this%nmawwells + 1))
827 do n = 1, this%nmawwells
828 iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
830 allocate (nboundchk(this%maxbound))
831 do n = 1, this%maxbound
836 call this%parser%GetBlock(
'CONNECTIONDATA', isfound, ierr, &
837 supportopenclose=.true.)
841 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
844 call this%parser%GetNextLine(endofblock)
848 ival = this%parser%GetInteger()
852 if (n < 1 .or. n > this%nmawwells)
then
853 write (
errmsg,
'(a,1x,i0,a)') &
854 'IMAW must be greater than 0 and less than or equal to ', &
861 ival = this%parser%GetInteger()
862 if (ival < 1 .or. ival > this%ngwfnodes(n))
then
863 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
864 'JCONN for well ', n, &
865 'must be greater than 1 and less than or equal to ', &
866 this%ngwfnodes(n),
'.'
871 ipos = iachk(n) + ival - 1
872 nboundchk(ipos) = nboundchk(ipos) + 1
875 jpos = this%get_jpos(n, ival)
878 call this%parser%GetCellid(this%dis%ndim, cellid)
879 nn = this%dis%noder_from_cellid(cellid, this%inunit, this%iout)
880 topnn = this%dis%top(nn)
881 botnn = this%dis%bot(nn)
885 this%gwfnodes(jpos) = nn
888 rval = this%parser%GetDouble()
889 if (this%ieqn(n) /= 4)
then
892 if (rval > topnn)
then
893 ireset_scrntop = ireset_scrntop + 1
897 this%topscrn(jpos) = rval
900 rval = this%parser%GetDouble()
901 if (this%ieqn(n) /= 4)
then
904 if (rval < botnn)
then
905 ireset_scrnbot = ireset_scrnbot + 1
909 this%botscrn(jpos) = rval
913 if (rval < botw)
then
914 if (this%ieqn(n) /= 4)
then
915 ireset_wellbot = ireset_wellbot + 1
919 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
920 'Screen bottom for maw well', n,
'connection', j,
'(', &
921 this%botscrn(jpos),
') is less than the well bottom (', &
928 rval = this%parser%GetDouble()
929 if (this%ieqn(n) == 0)
then
930 this%satcond(jpos) = rval
931 else if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
932 this%ieqn(n) == 4)
then
937 rval = this%parser%GetDouble()
938 if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
939 this%ieqn(n) == 4)
then
940 this%sradius(jpos) = rval
941 if (this%sradius(jpos) <= this%radius(n))
then
942 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
943 'Screen radius for maw well', n,
'connection', j,
'(', &
944 this%sradius(jpos), &
945 ') is less than or equal to the well radius (', &
951 write (this%iout,
'(1x,a)') &
952 'END OF '//trim(adjustl(this%text))//
' CONNECTIONDATA'
955 do n = 1, this%nmawwells
956 do j = 1, this%ngwfnodes(n)
960 if (nboundchk(ipos) == 0)
then
961 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
962 'No data specified for maw well', n,
'connection', j,
'.'
964 else if (nboundchk(ipos) > 1)
then
965 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,1x,i0,1x,a)') &
966 'Data for maw well', n,
'connection', j, &
967 'specified', nboundchk(n),
'times.'
975 do n = 1, this%nmawwells
976 if (this%ieqn(n) /= 4)
then
977 do j = 1, this%ngwfnodes(n)
978 nn = this%get_gwfnode(n, j)
979 do jj = 1, this%ngwfnodes(n)
985 nn2 = this%get_gwfnode(n, jj)
987 call this%dis%noder_to_string(nn, nodestr)
988 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,3(1x,a))') &
989 'Only one connection can be specified for maw well', &
990 n,
'connection', j,
'to gwf cell', trim(adjustl(nodestr)), &
991 'unless the mean condeqn is specified.'
999 call store_error(
'Required connectiondata block not found.')
1004 deallocate (nboundchk)
1007 if (ireset_scrntop > 0)
then
1008 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1009 'The screen tops in multi-aquifer well package', trim(this%packName), &
1010 'were reset to the top of the connected cell', ireset_scrntop,
'times.'
1013 if (ireset_scrnbot > 0)
then
1014 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1015 'The screen bottoms in multi-aquifer well package', trim(this%packName), &
1016 'were reset to the bottom of the connected cell', ireset_scrnbot, &
1020 if (ireset_wellbot > 0)
then
1021 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1022 'The well bottoms in multi-aquifer well package', trim(this%packName), &
1023 'were reset to the bottom of the connected cell', ireset_wellbot, &
1030 call this%parser%StoreErrorUnit()
1039 class(
mawtype),
intent(inout) :: this
1041 character(len=LENBOUNDNAME) :: keyword
1042 integer(I4B) :: ierr
1043 logical :: isfound, endOfBlock
1051 call this%parser%GetBlock(
'DIMENSIONS', isfound, ierr, &
1052 supportopenclose=.true.)
1056 write (this%iout,
'(/1x,a)') &
1057 'PROCESSING '//trim(adjustl(this%text))//
' DIMENSIONS'
1059 call this%parser%GetNextLine(endofblock)
1060 if (endofblock)
exit
1061 call this%parser%GetStringCaps(keyword)
1062 select case (keyword)
1064 this%nmawwells = this%parser%GetInteger()
1065 write (this%iout,
'(4x,a,i0)')
'NMAWWELLS = ', this%nmawwells
1068 'Unknown '//trim(this%text)//
' dimension: ', trim(keyword),
'.'
1072 write (this%iout,
'(1x,a)') &
1073 'END OF '//trim(adjustl(this%text))//
' DIMENSIONS'
1075 call store_error(
'Required dimensions block not found.', terminate=.true.)
1079 if (this%nmawwells < 0)
then
1081 'NMAWWELLS was not specified or was specified incorrectly.'
1087 call this%parser%StoreErrorUnit()
1091 call this%maw_read_wells()
1094 call this%maw_read_well_connections()
1098 call this%define_listlabel()
1101 call this%maw_setup_budobj()
1104 call this%maw_setup_tableobj()
1114 class(
mawtype),
intent(inout) :: this
1116 character(len=LINELENGTH) :: title
1117 character(len=LINELENGTH) :: text
1118 integer(I4B) :: ntabcols
1122 integer(I4B) :: jpos
1123 integer(I4B) :: inode
1127 character(len=10),
dimension(0:4) :: ccond
1128 character(len=30) :: nodestr
1130 data ccond(0)/
'SPECIFIED '/
1131 data ccond(1)/
'THIEM '/
1132 data ccond(2)/
'SKIN '/
1133 data ccond(3)/
'CUMULATIVE'/
1134 data ccond(4)/
'MEAN '/
1136 character(len=*),
parameter :: fmtwelln = &
1137 "(1X,//43X,'MULTI-AQUIFER WELL DATA'&
1139 &/1X,7(A10,1X),A16)"
1140 character(len=*),
parameter :: fmtwelld = &
1141 &
"(1X,I10,1X,4(G10.3,1X),I10,1X,A10,1X,A16)"
1142 character(len=*),
parameter :: fmtline = &
1144 character(len=*),
parameter :: fmtwellcn = &
1145 "(1X,//37X,'MULTI-AQUIFER WELL CONNECTION DATA'&
1147 &/1X,2(A10,1X),A20,7(A10,1X))"
1148 character(len=*),
parameter :: fmtwellcd = &
1149 &
"(1X,2(I10,1X),A20,1X,2(G10.3,1X),2(A10,1X),3(G10.3,1X))"
1152 do n = 1, this%nmawwells
1153 this%xnewpak(n) = this%strt(n)
1154 this%xsto(n) = this%strt(n)
1158 do n = 1, this%nmawwells
1159 select case (this%status(n))
1161 this%iboundpak(n) = -1
1163 this%iboundpak(n) = 0
1165 this%iboundpak(n) = 1
1170 if (this%inamedbound /= 0)
then
1172 do n = 1, this%nmawwells
1173 do j = 1, this%ngwfnodes(n)
1175 this%boundname(idx) = this%cmawname(n)
1180 do n = 1, this%nmawwells
1181 this%cmawname(n) =
''
1186 call this%copy_boundname()
1196 call this%maw_check_attributes()
1199 do n = 1, this%nmawwells
1203 do j = 1, this%ngwfnodes(n)
1204 if (this%ieqn(n) /= 0)
then
1205 inode = this%get_gwfnode(n, j)
1206 call this%maw_calculate_satcond(n, j, inode)
1213 if (this%iprpak /= 0)
then
1215 if (this%inamedbound /= 0)
then
1216 ntabcols = ntabcols + 1
1218 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1219 trim(adjustl(this%packName))//
') STATIC WELL DATA'
1220 call table_cr(this%inputtab, this%packName, title)
1221 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1223 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1225 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1227 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1228 text =
'WELL BOTTOM'
1229 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1230 text =
'STARTING HEAD'
1231 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1232 text =
'NUMBER OF GWF NODES'
1233 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1234 text =
'CONDUCT. EQUATION'
1235 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1236 if (this%inamedbound /= 0)
then
1238 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1240 do n = 1, this%nmawwells
1241 call this%inputtab%add_term(n)
1242 call this%inputtab%add_term(this%radius(n))
1243 call this%inputtab%add_term(this%area(n))
1244 call this%inputtab%add_term(this%bot(n))
1245 call this%inputtab%add_term(this%strt(n))
1246 call this%inputtab%add_term(this%ngwfnodes(n))
1247 call this%inputtab%add_term(ccond(this%ieqn(n)))
1248 if (this%inamedbound /= 0)
then
1249 call this%inputtab%add_term(this%cmawname(n))
1255 if (this%iprpak /= 0)
then
1257 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1258 trim(adjustl(this%packName))//
') STATIC WELL CONNECTION DATA'
1259 call table_cr(this%inputtab, this%packName, title)
1260 call this%inputtab%table_df(this%maxbound, ntabcols, this%iout)
1262 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1263 text =
'WELL CONNECTION'
1264 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1266 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1267 text =
'TOP OF SCREEN'
1268 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1269 text =
'BOTTOM OF SCREEN'
1270 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1271 text =
'SKIN RADIUS'
1272 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1274 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1276 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1278 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1279 text =
'SATURATED WELL CONDUCT.'
1280 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1283 do n = 1, this%nmawwells
1284 do j = 1, this%ngwfnodes(n)
1285 call this%inputtab%add_term(n)
1286 call this%inputtab%add_term(j)
1287 jpos = this%get_jpos(n, j)
1288 nn = this%get_gwfnode(n, j)
1289 call this%dis%noder_to_string(nn, nodestr)
1290 call this%inputtab%add_term(nodestr)
1291 call this%inputtab%add_term(this%topscrn(jpos))
1292 call this%inputtab%add_term(this%botscrn(jpos))
1293 if (this%ieqn(n) == 2 .or. &
1294 this%ieqn(n) == 3 .or. &
1295 this%ieqn(n) == 4)
then
1296 call this%inputtab%add_term(this%sradius(jpos))
1297 call this%inputtab%add_term(this%hk(jpos))
1299 call this%inputtab%add_term(
' ')
1300 call this%inputtab%add_term(
' ')
1302 if (this%ieqn(n) == 1 .or. &
1303 this%ieqn(n) == 2 .or. &
1304 this%ieqn(n) == 3)
then
1305 k11 = this%gwfk11(nn)
1306 if (this%gwfik22 == 0)
then
1307 k22 = this%gwfk11(nn)
1309 k22 = this%gwfk22(nn)
1311 call this%inputtab%add_term(k11)
1312 call this%inputtab%add_term(k22)
1314 call this%inputtab%add_term(
' ')
1315 call this%inputtab%add_term(
' ')
1317 call this%inputtab%add_term(this%satcond(jpos))
1323 this%gwfk11 => null()
1324 this%gwfk22 => null()
1325 this%gwfik22 => null()
1326 this%gwfsat => null()
1340 class(
mawtype),
intent(inout) :: this
1341 integer(I4B),
intent(in) :: imaw
1342 integer(I4B),
intent(inout) :: iheadlimit_warning
1344 character(len=LINELENGTH) :: errmsgr
1345 character(len=LINELENGTH) :: text
1346 character(len=LINELENGTH) :: cstr
1347 character(len=LINELENGTH) :: caux
1348 character(len=LINELENGTH) :: keyword
1352 real(DP),
pointer :: bndElem => null()
1353 integer(I4B) :: istat
1355 character(len=*),
parameter :: fmthdbot = &
1356 &
"('well head (',G0,') must be >= BOTTOM_ELEVATION (',G0, ').')"
1359 call this%parser%GetStringCaps(keyword)
1360 select case (keyword)
1362 call this%parser%GetStringCaps(text)
1363 this%status(imaw) = text(1:8)
1366 this%iboundpak(imaw) = -1
1368 this%iboundpak(imaw) = 0
1370 this%iboundpak(imaw) = 1
1373 'Unknown '//trim(this%text)//
" maw status keyword: '", &
1378 call this%parser%GetString(text)
1380 bndelem => this%rate(imaw)
1382 this%packName,
'BND', this%tsManager, &
1383 this%iprpak,
'RATE')
1385 call this%parser%GetString(text)
1387 bndelem => this%well_head(imaw)
1389 this%packName,
'BND', this%tsManager, &
1390 this%iprpak,
'WELL_HEAD')
1393 this%xnewpak(imaw) = this%well_head(imaw)
1396 if (this%well_head(imaw) < this%bot(imaw))
then
1397 write (cstr, fmthdbot) &
1398 this%well_head(imaw), this%bot(imaw)
1399 call this%maw_set_attribute_error(imaw,
'WELL HEAD', trim(cstr))
1401 case (
'FLOWING_WELL')
1402 this%fwelev(imaw) = this%parser%GetDouble()
1403 this%fwcond(imaw) = this%parser%GetDouble()
1404 this%fwrlen(imaw) = this%parser%GetDouble()
1408 if (this%iflowingwells == 0)
then
1409 this%iflowingwells = -1
1410 text =
'Flowing well data is specified in the '//trim(this%packName)// &
1411 ' package but FLOWING_WELL was not specified in the '// &
1415 case (
'RATE_SCALING')
1416 rval = this%parser%GetDouble()
1417 this%pumpelev(imaw) = rval
1418 rval = this%parser%GetDouble()
1419 this%reduction_length(imaw) = rval
1420 if (rval <
dzero)
then
1421 call this%maw_set_attribute_error(imaw, trim(keyword), &
1422 'must be greater than or equal to 0.')
1425 call this%parser%GetString(text)
1426 if (trim(text) ==
'OFF')
then
1427 this%shutofflevel(imaw) =
dep20
1429 read (text, *, iostat=istat, iomsg=errmsgr) &
1430 this%shutofflevel(imaw)
1431 if (istat /= 0)
then
1432 errmsg =
'Could not read HEAD_LIMIT value. '//trim(errmsgr)
1435 if (this%shutofflevel(imaw) <= this%bot(imaw))
then
1436 iheadlimit_warning = iheadlimit_warning + 1
1440 rval = this%parser%GetDouble()
1441 this%shutoffmin(imaw) = rval
1442 rval = this%parser%GetDouble()
1443 this%shutoffmax(imaw) = rval
1445 call this%parser%GetStringCaps(caux)
1446 do jj = 1, this%naux
1447 if (trim(adjustl(caux)) /= trim(adjustl(this%auxname(jj)))) cycle
1448 call this%parser%GetString(text)
1450 bndelem => this%mauxvar(jj, ii)
1452 this%packName,
'AUX', &
1453 this%tsManager, this%iprpak, &
1459 'Unknown '//trim(this%text)//
" maw data keyword: '", &
1471 class(
mawtype),
intent(inout) :: this
1472 integer(I4B),
intent(in) :: imaw
1473 character(len=*),
intent(in) :: keyword
1474 character(len=*),
intent(in) :: msg
1478 if (len(msg) == 0)
then
1479 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1480 keyword,
' for MAW well', imaw,
'has already been set.'
1482 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1483 keyword,
' for MAW well', imaw, msg
1493 class(
mawtype),
intent(inout) :: this
1495 character(len=LINELENGTH) :: cgwfnode
1499 integer(I4B) :: jpos
1503 do n = 1, this%nmawwells
1504 if (this%ngwfnodes(n) < 1)
then
1505 call this%maw_set_attribute_error(n,
'NGWFNODES',
'must be greater '// &
1508 if (this%radius(n) ==
dep20)
then
1509 call this%maw_set_attribute_error(n,
'RADIUS',
'has not been specified.')
1511 if (this%shutoffmin(n) >
dzero)
then
1512 if (this%shutoffmin(n) >= this%shutoffmax(n))
then
1513 call this%maw_set_attribute_error(n,
'SHUT_OFF',
'shutoffmax must '// &
1514 'be greater than shutoffmin.')
1517 do j = 1, this%ngwfnodes(n)
1520 jpos = this%get_jpos(n, j)
1523 write (cgwfnode,
'(a,i0,a)')
'gwfnode(', j,
')'
1526 if (this%botscrn(jpos) >= this%topscrn(jpos))
then
1527 call this%maw_set_attribute_error(n,
'SCREEN_TOP',
'screen bottom '// &
1528 'must be less than screen top. '// &
1533 if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
1534 this%ieqn(n) == 4)
then
1535 if (this%hk(jpos) <=
dzero)
then
1536 call this%maw_set_attribute_error(n,
'HK_SKIN',
'skin hyraulic '// &
1537 'conductivity must be greater '// &
1538 'than zero. '//trim(cgwfnode))
1540 else if (this%ieqn(n) == 0)
then
1543 if (this%satcond(jpos) <
dzero)
then
1544 call this%maw_set_attribute_error(n,
'HK_SKIN', &
1545 'skin hyraulic conductivity '// &
1546 'must be greater than or '// &
1547 'equal to zero when using '// &
1548 'SPECIFIED condeqn. '// &
1564 class(
mawtype),
intent(inout) :: this
1565 integer(I4B),
intent(in) :: moffset
1571 integer(I4B) :: jglo
1572 integer(I4B) :: nglo
1576 do n = 1, this%nmawwells
1577 nglo = moffset + this%dis%nodes + this%ioffset + n
1578 call sparse%addconnection(nglo, nglo, 1)
1579 do j = 1, this%ngwfnodes(n)
1580 jj = this%get_gwfnode(n, j)
1582 call sparse%addconnection(nglo, jglo, 1)
1583 call sparse%addconnection(jglo, nglo, 1)
1595 class(
mawtype),
intent(inout) :: this
1596 integer(I4B),
intent(in) :: moffset
1602 integer(I4B) :: iglo
1603 integer(I4B) :: jglo
1604 integer(I4B) :: ipos
1608 call mem_allocate(this%idxlocnode, this%nmawwells,
'IDXLOCNODE', &
1610 call mem_allocate(this%idxdglo, this%maxbound,
'IDXDGLO', this%memoryPath)
1611 call mem_allocate(this%idxoffdglo, this%maxbound,
'IDXOFFDGLO', &
1613 call mem_allocate(this%idxsymdglo, this%maxbound,
'IDXSYMDGLO', &
1615 call mem_allocate(this%idxsymoffdglo, this%maxbound,
'IDXSYMOFFDGLO', &
1623 do n = 1, this%nmawwells
1624 iglo = moffset + this%dis%nodes + this%ioffset + n
1625 this%idxlocnode(n) = this%dis%nodes + this%ioffset + n
1626 do ii = 1, this%ngwfnodes(n)
1627 j = this%get_gwfnode(n, ii)
1629 this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
1630 this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
1636 do n = 1, this%nmawwells
1637 do ii = 1, this%ngwfnodes(n)
1638 iglo = this%get_gwfnode(n, ii) + moffset
1639 jglo = moffset + this%dis%nodes + this%ioffset + n
1640 this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
1641 this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
1656 class(
mawtype),
intent(inout) :: this
1657 character(len=*),
intent(inout) :: option
1658 logical,
intent(inout) :: found
1660 character(len=MAXCHARLEN) :: fname, keyword
1662 character(len=*),
parameter :: fmtflowingwells = &
1663 &
"(4x, 'FLOWING WELLS WILL BE SIMULATED.')"
1664 character(len=*),
parameter :: fmtshutdown = &
1665 &
"(4x, 'SHUTDOWN ', a, ' VALUE (',g15.7,') SPECIFIED.')"
1666 character(len=*),
parameter :: fmtnostoragewells = &
1667 &
"(4x, 'WELL STORAGE WILL NOT BE SIMULATED.')"
1668 character(len=*),
parameter :: fmtmawbin = &
1669 "(4x, 'MAW ', 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, /4x, &
1670 &'OPENED ON UNIT: ', I0)"
1674 select case (option)
1677 write (this%iout,
'(4x,a)') &
1678 trim(adjustl(this%text))//
' heads will be printed to listing file.'
1680 call this%parser%GetStringCaps(keyword)
1681 if (keyword ==
'FILEOUT')
then
1682 call this%parser%GetString(fname)
1683 call assign_iounit(this%iheadout, this%inunit,
"HEAD fileout")
1684 call openfile(this%iheadout, this%iout, fname,
'DATA(BINARY)', &
1686 write (this%iout, fmtmawbin)
'HEAD', trim(adjustl(fname)), &
1689 call store_error(
'Optional maw stage keyword must be '// &
1690 'followed by fileout.')
1693 call this%parser%GetStringCaps(keyword)
1694 if (keyword ==
'FILEOUT')
then
1695 call this%parser%GetString(fname)
1696 call assign_iounit(this%ibudgetout, this%inunit,
"BUDGET fileout")
1697 call openfile(this%ibudgetout, this%iout, fname,
'DATA(BINARY)', &
1699 write (this%iout, fmtmawbin)
'BUDGET', trim(adjustl(fname)), &
1702 call store_error(
'Optional maw budget keyword must be '// &
1703 'followed by fileout.')
1706 call this%parser%GetStringCaps(keyword)
1707 if (keyword ==
'FILEOUT')
then
1708 call this%parser%GetString(fname)
1709 call assign_iounit(this%ibudcsv, this%inunit,
"BUDGETCSV fileout")
1710 call openfile(this%ibudcsv, this%iout, fname,
'CSV', &
1711 filstat_opt=
'REPLACE')
1712 write (this%iout, fmtmawbin)
'BUDGET CSV', trim(adjustl(fname)), &
1715 call store_error(
'OPTIONAL BUDGETCSV KEYWORD MUST BE FOLLOWED BY &
1718 case (
'FLOWING_WELLS')
1719 this%iflowingwells = 1
1720 write (this%iout, fmtflowingwells)
1721 case (
'SHUTDOWN_THETA')
1722 this%theta = this%parser%GetDouble()
1723 write (this%iout, fmtshutdown)
'THETA', this%theta
1724 case (
'SHUTDOWN_KAPPA')
1725 this%kappa = this%parser%GetDouble()
1726 write (this%iout, fmtshutdown)
'KAPPA', this%kappa
1729 write (this%iout,
'(4x,A)')
'MOVER OPTION ENABLED'
1730 case (
'NO_WELL_STORAGE')
1732 write (this%iout, fmtnostoragewells)
1733 case (
'FLOW_CORRECTION')
1734 this%correct_flow = .true.
1735 write (this%iout,
'(4x,a,/,4x,a)') &
1736 'MAW-GWF FLOW CORRECTIONS WILL BE APPLIED WHEN MAW HEADS ARE BELOW', &
1737 'OR GWF HEADS IN CONNECTED CELLS ARE BELOW THE CELL BOTTOM.'
1738 case (
'MAW_FLOW_REDUCE_CSV')
1739 call this%parser%GetStringCaps(keyword)
1740 if (keyword ==
'FILEOUT')
then
1741 call this%parser%GetString(fname)
1742 call this%maw_redflow_csv_init(fname)
1744 call store_error(
'OPTIONAL MAW_FLOW_REDUCE_CSV KEYWORD MUST BE &
1745 &FOLLOWED BY FILEOUT')
1752 case (
'DEV_PEACEMAN_EFFECTIVE_RADIUS')
1753 call this%parser%DevOpt()
1755 write (this%iout,
'(4x,a)') &
1756 'EFFECTIVE RADIUS FOR STRUCTURED GRIDS WILL BE CALCULATED &
1757 &USING PEACEMAN 1983'
1771 class(
mawtype),
intent(inout) :: this
1775 call this%obs%obs_ar()
1778 if (this%inewton > 0)
then
1779 this%satomega =
dem6
1783 call this%maw_allocate_arrays()
1786 call this%read_initial_attr()
1789 if (this%imover /= 0)
then
1790 allocate (this%pakmvrobj)
1791 call this%pakmvrobj%ar(this%nmawwells, this%nmawwells, this%memoryPath)
1803 class(
mawtype),
intent(inout) :: this
1805 character(len=LINELENGTH) :: title
1806 character(len=LINELENGTH) :: line
1807 character(len=LINELENGTH) :: text
1808 character(len=16) :: csteady
1810 logical :: endOfBlock
1811 integer(I4B) :: ierr
1812 integer(I4B) :: node
1814 integer(I4B) :: ntabcols
1815 integer(I4B) :: ntabrows
1816 integer(I4B) :: imaw
1817 integer(I4B) :: ibnd
1819 integer(I4B) :: jpos
1820 integer(I4B) :: iheadlimit_warning
1822 character(len=*),
parameter :: fmtblkerr = &
1823 &
"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
1824 character(len=*),
parameter :: fmtlsp = &
1825 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
1828 iheadlimit_warning = 0
1831 this%imawiss = this%gwfiss
1834 if (this%imawissopt == 1)
then
1839 this%nbound = this%maxbound
1843 if (this%inunit == 0)
return
1846 if (this%ionper <
kper)
then
1849 call this%parser%GetBlock(
'PERIOD', isfound, ierr, &
1850 supportopenclose=.true., &
1851 blockrequired=.false.)
1855 call this%read_check_ionper()
1861 this%ionper =
nper + 1
1864 call this%parser%GetCurrentLine(line)
1865 write (
errmsg, fmtblkerr) adjustl(trim(line))
1872 if (this%ionper ==
kper)
then
1875 if (this%iprpak /= 0)
then
1878 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1879 trim(adjustl(this%packName))//
') DATA FOR PERIOD'
1880 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
1881 call table_cr(this%inputtab, this%packName, title)
1882 call this%inputtab%table_df(1, 5, this%iout, finalize=.false.)
1884 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1886 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1888 write (text,
'(a,1x,i6)')
'VALUE', n
1889 call this%inputtab%initialize_column(text, 15, alignment=tabcenter)
1896 call this%parser%GetNextLine(endofblock)
1897 if (endofblock)
exit
1899 imaw = this%parser%GetInteger()
1900 if (imaw < 1 .or. imaw > this%nmawwells)
then
1901 write (
errmsg,
'(2(a,1x),i0,a)') &
1902 'IMAW must be greater than 0 and', &
1903 'less than or equal to ', this%nmawwells,
'.'
1909 call this%maw_set_stressperiod(imaw, iheadlimit_warning)
1912 if (this%iprpak /= 0)
then
1913 call this%parser%GetCurrentLine(line)
1914 call this%inputtab%line_to_columns(line)
1917 if (this%iprpak /= 0)
then
1918 call this%inputtab%finalize_table()
1923 write (this%iout, fmtlsp) trim(this%filtyp)
1927 if (iheadlimit_warning > 0)
then
1928 write (
warnmsg,
'(a,a,a,1x,a,1x,a)') &
1929 "HEAD_LIMIT in '", trim(this%packName),
"' was below the well bottom", &
1930 "for one or more multi-aquifer well(s). This may result in", &
1931 "convergence failures for some models."
1937 call this%parser%StoreErrorUnit()
1941 if (this%check_attr /= 0)
then
1942 call this%maw_check_attributes()
1945 if (this%iprpak == 1)
then
1946 if (this%imawiss /= 0)
then
1947 csteady =
'STEADY-STATE '
1949 csteady =
'TRANSIENT '
1953 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1954 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
1955 ' RATE DATA FOR PERIOD'
1956 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
1958 call table_cr(this%inputtab, this%packName, title)
1959 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1961 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1963 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1965 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1966 text =
'SPECIFIED HEAD'
1967 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1968 text =
'PUMP ELEVATION'
1969 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1970 text =
'REDUCTION LENGTH'
1971 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1972 do n = 1, this%nmawwells
1973 call this%inputtab%add_term(n)
1974 call this%inputtab%add_term(this%status(n))
1975 call this%inputtab%add_term(this%rate(n))
1976 if (this%iboundpak(n) < 0)
then
1977 call this%inputtab%add_term(this%well_head(n))
1979 call this%inputtab%add_term(
' ')
1981 call this%inputtab%add_term(this%pumpelev(n))
1982 if (this%reduction_length(n) /= dep20)
then
1983 call this%inputtab%add_term(this%reduction_length(n))
1985 call this%inputtab%add_term(
' ')
1990 if (this%iflowingwells > 0)
then
1993 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1994 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
1995 ' FLOWING WELL DATA FOR PERIOD'
1996 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
1999 do n = 1, this%nmawwells
2000 if (this%fwcond(n) > dzero)
then
2001 ntabrows = ntabrows + 1
2004 if (ntabrows > 0)
then
2005 call table_cr(this%inputtab, this%packName, title)
2006 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2008 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2010 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2012 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2013 text =
'REDUCTION LENGTH'
2014 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2015 do n = 1, this%nmawwells
2016 if (this%fwcond(n) > dzero)
then
2017 call this%inputtab%add_term(n)
2018 call this%inputtab%add_term(this%fwelev(n))
2019 call this%inputtab%add_term(this%fwcond(n))
2020 call this%inputtab%add_term(this%fwrlen(n))
2027 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2028 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2029 ' WELL SHUTOFF DATA FOR PERIOD'
2030 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2033 do n = 1, this%nmawwells
2034 if (this%shutofflevel(n) /= dep20)
then
2035 ntabrows = ntabrows + 1
2038 if (ntabrows > 0)
then
2039 call table_cr(this%inputtab, this%packName, title)
2040 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2042 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2044 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2046 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2048 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2049 do n = 1, this%nmawwells
2050 if (this%shutofflevel(n) /= dep20)
then
2051 call this%inputtab%add_term(n)
2052 call this%inputtab%add_term(this%shutofflevel(n))
2053 call this%inputtab%add_term(this%shutoffmin(n))
2054 call this%inputtab%add_term(this%shutoffmax(n))
2063 do n = 1, this%nmawwells
2064 do j = 1, this%ngwfnodes(n)
2065 jpos = this%get_jpos(n, j)
2066 node = this%get_gwfnode(n, j)
2067 this%nodelist(ibnd) = node
2068 this%bound(1, ibnd) = this%xnewpak(n)
2069 this%bound(2, ibnd) = this%satcond(jpos)
2070 this%bound(3, ibnd) = this%botscrn(jpos)
2071 if (this%iboundpak(n) > 0)
then
2072 this%bound(4, ibnd) = this%rate(n)
2074 this%bound(4, ibnd) = dzero
2091 integer(I4B) :: ibnd
2094 call this%TsManager%ad()
2099 if (this%naux > 0)
then
2101 do n = 1, this%nmawwells
2102 do j = 1, this%ngwfnodes(n)
2103 do jj = 1, this%naux
2104 if (this%noupdateauxvar(jj) /= 0) cycle
2105 this%auxvar(jj, ibnd) = this%mauxvar(jj, n)
2113 do n = 1, this%nmawwells
2114 this%xoldpak(n) = this%xnewpak(n)
2115 this%xoldsto(n) = this%xsto(n)
2116 if (this%iboundpak(n) < 0)
then
2117 this%xnewpak(n) = this%well_head(n)
2123 if (
kper == 1 .and.
kstp == 1)
then
2124 do n = 1, this%nmawwells
2125 if (this%fwcond(n) >
dzero)
then
2126 if (this%xoldsto(n) > this%fwelev(n))
then
2127 this%xoldsto(n) = this%fwelev(n)
2134 this%ishutoffcnt = 0
2137 if (this%imover == 1)
then
2138 call this%pakmvrobj%ad()
2144 call this%obs%obs_ad()
2157 call this%maw_cfupdate()
2162 subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln)
2167 real(DP),
dimension(:),
intent(inout) :: rhs
2168 integer(I4B),
dimension(:),
intent(in) :: ia
2169 integer(I4B),
dimension(:),
intent(in) :: idxglo
2175 integer(I4B) :: iloc
2176 integer(I4B) :: isymloc
2177 integer(I4B) :: igwfnode
2178 integer(I4B) :: iposd
2179 integer(I4B) :: iposoffd
2180 integer(I4B) :: isymnode
2181 integer(I4B) :: ipossymd
2182 integer(I4B) :: ipossymoffd
2183 integer(I4B) :: jpos
2184 integer(I4B) :: icflow
2199 if (this%imover == 1)
then
2200 call this%pakmvrobj%fc()
2205 do n = 1, this%nmawwells
2206 iloc = this%idxlocnode(n)
2209 if (this%iboundpak(n) < 0)
then
2210 this%xnewpak(n) = this%well_head(n)
2212 hmaw = this%xnewpak(n)
2215 if (this%iboundpak(n) == 0)
then
2216 this%ratesim(n) =
dzero
2218 call this%maw_calculate_wellq(n, hmaw, rate)
2219 this%ratesim(n) = rate
2220 rhs(iloc) = rhs(iloc) - rate
2223 iposd = this%idxdglo(idx)
2228 if (this%iflowingwells > 0)
then
2229 if (this%fwcond(n) >
dzero)
then
2231 tp = bt + this%fwrlen(n)
2233 cfw = scale * this%fwcond(n)
2234 this%ifwdischarge(n) = 0
2235 if (cfw >
dzero)
then
2236 this%ifwdischarge(n) = 1
2239 this%fwcondsim(n) = cfw
2240 call matrix_sln%add_value_pos(iposd, -cfw)
2241 rhs(iloc) = rhs(iloc) - cfw * bt
2242 ratefw = cfw * (bt - hmaw)
2247 if (this%imawiss /= 1)
then
2248 if (this%ifwdischarge(n) /= 1)
then
2249 call matrix_sln%add_value_pos(iposd, -this%area(n) /
delt)
2250 rhs(iloc) = rhs(iloc) - (this%area(n) * this%xoldsto(n) /
delt)
2252 cterm = this%xoldsto(n) - this%fwelev(n)
2253 rhs(iloc) = rhs(iloc) - (this%area(n) * cterm /
delt)
2259 if (this%imover == 1)
then
2260 rhs(iloc) = rhs(iloc) - this%pakmvrobj%get_qfrommvr(n)
2264 call this%pakmvrobj%accumulate_qformvr(n, -rate)
2268 call this%pakmvrobj%accumulate_qformvr(n, -ratefw)
2274 do j = 1, this%ngwfnodes(n)
2275 if (this%iboundpak(n) /= 0)
then
2276 jpos = this%get_jpos(n, j)
2277 igwfnode = this%get_gwfnode(n, j)
2278 hgwf = this%xnew(igwfnode)
2281 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2283 this%simcond(jpos) = cmaw
2286 iposd = this%idxdglo(idx)
2287 iposoffd = this%idxoffdglo(idx)
2288 call matrix_sln%add_value_pos(iposd, -term)
2289 call matrix_sln%set_value_pos(iposoffd, term)
2292 rhs(iloc) = rhs(iloc) - cterm
2295 isymnode = this%get_gwfnode(n, j)
2296 isymloc = ia(isymnode)
2297 ipossymd = this%idxsymdglo(idx)
2298 ipossymoffd = this%idxsymoffdglo(idx)
2299 call matrix_sln%add_value_pos(ipossymd, -term)
2300 call matrix_sln%set_value_pos(ipossymoffd, term)
2303 rhs(isymnode) = rhs(isymnode) + cterm
2314 subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln)
2317 real(DP),
dimension(:),
intent(inout) :: rhs
2318 integer(I4B),
dimension(:),
intent(in) :: ia
2319 integer(I4B),
dimension(:),
intent(in) :: idxglo
2325 integer(I4B) :: iloc
2326 integer(I4B) :: isymloc
2327 integer(I4B) :: igwfnode
2328 integer(I4B) :: iposd
2329 integer(I4B) :: iposoffd
2330 integer(I4B) :: isymnode
2331 integer(I4B) :: ipossymd
2332 integer(I4B) :: ipossymoffd
2333 integer(I4B) :: jpos
2334 integer(I4B) :: icflow
2355 do n = 1, this%nmawwells
2356 iloc = this%idxlocnode(n)
2357 hmaw = this%xnewpak(n)
2360 if (this%iboundpak(n) /= 0)
then
2361 iposd = this%idxdglo(idx)
2364 rate = this%ratesim(n)
2367 call this%maw_calculate_wellq(n, hmaw +
dem4, rate2)
2368 drterm = (rate2 - rate) /
dem4
2371 call matrix_sln%add_value_pos(iposd, drterm)
2372 rhs(iloc) = rhs(iloc) + drterm * hmaw
2375 if (this%iflowingwells > 0)
then
2376 if (this%fwcond(n) >
dzero)
then
2378 tp = bt + this%fwrlen(n)
2380 cfw = scale * this%fwcond(n)
2381 this%ifwdischarge(n) = 0
2382 if (cfw >
dzero)
then
2383 this%ifwdischarge(n) = 1
2385 this%fwcondsim(n) = cfw
2386 rate = cfw * (bt - hmaw)
2392 drterm = -(cfw + this%fwcond(n) * derv * (hmaw - bt))
2395 call matrix_sln%add_value_pos(iposd, &
2396 -this%fwcond(n) * derv * (hmaw - bt))
2397 rhs(iloc) = rhs(iloc) - rterm + drterm * hmaw
2404 do j = 1, this%ngwfnodes(n)
2405 if (this%iboundpak(n) /= 0)
then
2406 jpos = this%get_jpos(n, j)
2407 igwfnode = this%get_gwfnode(n, j)
2408 hgwf = this%xnew(igwfnode)
2411 iposd = this%idxdglo(idx)
2412 iposoffd = this%idxoffdglo(idx)
2415 isymnode = this%get_gwfnode(n, j)
2416 isymloc = ia(isymnode)
2417 ipossymd = this%idxsymdglo(idx)
2418 ipossymoffd = this%idxsymoffdglo(idx)
2421 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2425 if (hmaw > hgwf)
then
2426 if (icflow /= 0)
then
2427 rhsterm = term2 * hgwf + term * hmaw
2428 rhs(iloc) = rhs(iloc) + rhsterm
2429 rhs(isymnode) = rhs(isymnode) - rhsterm
2430 if (this%iboundpak(n) > 0)
then
2431 call matrix_sln%add_value_pos(iposd, term)
2432 call matrix_sln%add_value_pos(iposoffd, term2)
2434 call matrix_sln%add_value_pos(ipossymd, -term2)
2435 call matrix_sln%add_value_pos(ipossymoffd, -term)
2437 rhs(iloc) = rhs(iloc) + term * hmaw
2438 rhs(isymnode) = rhs(isymnode) - term * hmaw
2439 call matrix_sln%add_value_pos(iposd, term)
2440 if (this%ibound(igwfnode) > 0)
then
2441 call matrix_sln%add_value_pos(ipossymoffd, -term)
2447 if (icflow /= 0)
then
2448 rhsterm = term2 * hmaw + term * hgwf
2449 rhs(iloc) = rhs(iloc) + rhsterm
2450 rhs(isymnode) = rhs(isymnode) - rhsterm
2451 if (this%iboundpak(n) > 0)
then
2452 call matrix_sln%add_value_pos(iposd, term2)
2453 call matrix_sln%add_value_pos(iposoffd, term)
2455 call matrix_sln%add_value_pos(ipossymd, -term)
2456 call matrix_sln%add_value_pos(ipossymoffd, -term2)
2458 rhs(iloc) = rhs(iloc) + term * hgwf
2459 rhs(isymnode) = rhs(isymnode) - term * hgwf
2460 if (this%iboundpak(n) > 0)
then
2461 call matrix_sln%add_value_pos(iposoffd, term)
2463 call matrix_sln%add_value_pos(ipossymd, -term)
2477 subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
2479 class(
mawtype),
intent(inout) :: this
2480 integer(I4B),
intent(in) :: neqpak
2481 real(DP),
dimension(neqpak),
intent(inout) :: x
2482 real(DP),
dimension(neqpak),
intent(in) :: xtemp
2483 real(DP),
dimension(neqpak),
intent(inout) :: dx
2484 integer(I4B),
intent(inout) :: inewtonur
2485 real(DP),
intent(inout) :: dxmax
2486 integer(I4B),
intent(inout) :: locmax
2494 do n = 1, this%nmawwells
2495 if (this%iboundpak(n) < 1) cycle
2500 if (x(n) < botw)
then
2504 if (abs(dxx) > abs(dxmax))
then
2522 class(
mawtype),
intent(inout) :: this
2523 real(DP),
dimension(:),
intent(in) :: x
2524 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
2525 integer(I4B),
optional,
intent(in) :: iadv
2531 integer(I4B) :: ibnd
2539 call this%maw_cfupdate()
2543 call this%BndType%bnd_cq(x, flowja, iadv=1)
2546 do n = 1, this%nmawwells
2547 this%qout(n) = dzero
2548 this%qsto(n) = dzero
2549 if (this%iflowingwells > 0)
then
2552 if (this%iboundpak(n) == 0)
then
2557 hmaw = this%xnewpak(n)
2561 rrate = this%ratesim(n)
2564 if (rrate < dzero)
then
2565 this%qout(n) = rrate
2569 if (this%iflowingwells > 0)
then
2570 if (this%fwcond(n) > dzero)
then
2571 cfw = this%fwcondsim(n)
2572 this%xsto(n) = this%fwelev(n)
2573 rrate = cfw * (this%fwelev(n) - hmaw)
2577 this%qout(n) = this%qout(n) + rrate
2582 if (this%imawiss /= 1)
then
2583 rrate = -this%area(n) * (this%xsto(n) - this%xoldsto(n)) /
delt
2584 this%qsto(n) = rrate
2590 do n = 1, this%nmawwells
2591 hmaw = this%xnewpak(n)
2592 this%qconst(n) = dzero
2593 do j = 1, this%ngwfnodes(n)
2594 rrate = -this%simvals(ibnd)
2595 this%qleak(ibnd) = rrate
2596 if (this%iboundpak(n) < 0)
then
2597 this%qconst(n) = this%qconst(n) - rrate
2600 if (-rrate < dzero)
then
2601 this%qout(n) = this%qout(n) - rrate
2610 if (this%iboundpak(n) < 0)
then
2613 this%qconst(n) = this%qconst(n) - this%ratesim(n)
2616 if (this%iflowingwells > 0)
then
2617 this%qconst(n) = this%qconst(n) - this%qfw(n)
2621 if (this%imawiss /= 1)
then
2622 this%qconst(n) = this%qconst(n) - this%qsto(n)
2628 call this%maw_fill_budobj()
2636 integer(I4B),
intent(in) :: icbcfl
2637 integer(I4B),
intent(in) :: ibudfl
2638 integer(I4B),
intent(in) :: icbcun
2639 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
2642 call this%BndType%bnd_ot_model_flows(icbcfl, ibudfl, icbcun, this%imap)
2650 integer(I4B),
intent(in) :: icbcfl
2651 integer(I4B),
intent(in) :: ibudfl
2652 integer(I4B) :: ibinun
2656 if (this%ibudgetout /= 0)
then
2657 ibinun = this%ibudgetout
2659 if (icbcfl == 0) ibinun = 0
2660 if (ibinun > 0)
then
2661 call this%budobj%save_flows(this%dis, ibinun,
kstp,
kper,
delt, &
2666 if (ibudfl /= 0 .and. this%iprflow /= 0)
then
2667 call this%budobj%write_flowtable(this%dis,
kstp,
kper)
2678 integer(I4B),
intent(in) :: idvsave
2679 integer(I4B),
intent(in) :: idvprint
2680 integer(I4B) :: ibinun
2687 if (this%iheadout /= 0)
then
2688 ibinun = this%iheadout
2690 if (idvsave == 0) ibinun = 0
2693 if (ibinun > 0)
then
2694 do n = 1, this%nmawwells
2697 if (this%iboundpak(n) == 0)
then
2699 else if (d <= dzero)
then
2704 call ulasav(this%dbuff,
' HEAD', &
2706 this%nmawwells, 1, 1, ibinun)
2710 if (idvprint /= 0 .and. this%iprhed /= 0)
then
2713 call this%headtab%set_kstpkper(
kstp,
kper)
2716 do n = 1, this%nmawwells
2717 if (this%inamedbound == 1)
then
2718 call this%headtab%add_term(this%cmawname(n))
2720 call this%headtab%add_term(n)
2721 call this%headtab%add_term(this%xnewpak(n))
2733 integer(I4B),
intent(in) :: kstp
2734 integer(I4B),
intent(in) :: kper
2735 integer(I4B),
intent(in) :: iout
2736 integer(I4B),
intent(in) :: ibudfl
2738 call this%budobj%write_budtable(kstp, kper, iout, ibudfl,
totim,
delt)
2751 call this%budobj%budgetobject_da()
2752 deallocate (this%budobj)
2753 nullify (this%budobj)
2756 if (this%iprhed > 0)
then
2757 call this%headtab%table_da()
2758 deallocate (this%headtab)
2759 nullify (this%headtab)
2763 call mem_deallocate(this%cmawbudget,
'CMAWBUDGET', this%memoryPath)
2851 nullify (this%gwfiss)
2854 call this%BndType%bnd_da()
2861 class(
mawtype),
intent(inout) :: this
2864 this%listlabel = trim(this%filtyp)//
' NO.'
2865 if (this%dis%ndim == 3)
then
2866 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
2867 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'ROW'
2868 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'COL'
2869 elseif (this%dis%ndim == 2)
then
2870 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
2871 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'CELL2D'
2873 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'NODE'
2875 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'STRESS RATE'
2876 if (this%inamedbound == 1)
then
2877 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
2889 integer(I4B),
pointer :: neq
2890 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
2891 real(DP),
dimension(:),
pointer,
contiguous :: xnew
2892 real(DP),
dimension(:),
pointer,
contiguous :: xold
2893 real(DP),
dimension(:),
pointer,
contiguous :: flowja
2896 integer(I4B) :: istart, iend
2899 call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja)
2904 istart = this%dis%nodes + this%ioffset + 1
2905 iend = istart + this%nmawwells - 1
2906 this%iboundpak => this%ibound(istart:iend)
2907 this%xnewpak => this%xnew(istart:iend)
2908 call mem_checkin(this%xnewpak,
'HEAD', this%memoryPath,
'X', &
2909 this%memoryPathModel)
2910 call mem_allocate(this%xoldpak, this%nmawwells,
'XOLDPAK', this%memoryPath)
2913 do n = 1, this%nmawwells
2914 this%xnewpak(n) =
dep20
2938 integer(I4B) :: indx
2942 call this%obs%StoreObsType(
'head', .false., indx)
2947 call this%obs%StoreObsType(
'from-mvr', .false., indx)
2952 call this%obs%StoreObsType(
'maw', .true., indx)
2957 call this%obs%StoreObsType(
'rate', .true., indx)
2962 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
2967 call this%obs%StoreObsType(
'fw-rate', .true., indx)
2972 call this%obs%StoreObsType(
'fw-to-mvr', .true., indx)
2977 call this%obs%StoreObsType(
'storage', .true., indx)
2982 call this%obs%StoreObsType(
'constant', .true., indx)
2987 call this%obs%StoreObsType(
'conductance', .true., indx)
2992 call this%obs%StoreObsType(
'fw-conductance', .true., indx)
3008 integer(I4B) :: jpos
3016 if (this%obs%npakobs > 0)
then
3017 call this%obs%obs_bd_clear()
3018 do i = 1, this%obs%npakobs
3019 obsrv => this%obs%pakobs(i)%obsrv
3020 do j = 1, obsrv%indxbnds_count
3022 jj = obsrv%indxbnds(j)
3023 select case (obsrv%ObsTypeId)
3025 if (this%iboundpak(jj) /= 0)
then
3026 v = this%xnewpak(jj)
3029 if (this%iboundpak(jj) /= 0)
then
3030 if (this%imover == 1)
then
3031 v = this%pakmvrobj%get_qfrommvr(jj)
3036 if (this%iboundpak(n) /= 0)
then
3040 if (this%iboundpak(jj) /= 0)
then
3041 v = this%ratesim(jj)
3042 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3043 qfact = v / this%qout(jj)
3044 if (this%imover == 1)
then
3045 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3049 case (
'RATE-TO-MVR')
3050 if (this%iboundpak(jj) /= 0)
then
3051 if (this%imover == 1)
then
3052 v = this%ratesim(jj)
3054 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3055 qfact = v / this%qout(jj)
3057 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3064 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3065 hmaw = this%xnewpak(jj)
3066 cmaw = this%fwcondsim(jj)
3067 v = cmaw * (this%fwelev(jj) - hmaw)
3068 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3069 qfact = v / this%qout(jj)
3070 if (this%imover == 1)
then
3071 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3076 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3077 if (this%imover == 1)
then
3078 hmaw = this%xnewpak(jj)
3079 cmaw = this%fwcondsim(jj)
3080 v = cmaw * (this%fwelev(jj) - hmaw)
3082 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3083 qfact = v / this%qout(jj)
3085 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3092 if (this%iboundpak(jj) /= 0 .and. this%imawissopt /= 1)
then
3096 if (this%iboundpak(jj) /= 0)
then
3099 case (
'CONDUCTANCE')
3101 if (this%iboundpak(n) /= 0)
then
3102 nn = jj - this%iaconn(n) + 1
3103 jpos = this%get_jpos(n, nn)
3104 v = this%simcond(jpos)
3106 case (
'FW-CONDUCTANCE')
3107 if (this%iboundpak(jj) /= 0)
then
3108 v = this%fwcondsim(jj)
3111 errmsg =
'Unrecognized observation type: '//trim(obsrv%ObsTypeId)
3114 call this%obs%SaveOneSimval(obsrv, v)
3125 if (this%ioutredflowcsv > 0)
then
3126 call this%maw_redflow_csv_write()
3138 class(
mawtype),
intent(inout) :: this
3146 character(len=LENBOUNDNAME) :: bname
3150 10
format(
'Boundary "', a,
'" for observation "', a, &
3151 '" is invalid in package "', a,
'"')
3154 do i = 1, this%obs%npakobs
3155 obsrv => this%obs%pakobs(i)%obsrv
3158 nn1 = obsrv%NodeNumber
3160 bname = obsrv%FeatureName
3161 if (bname /=
'')
then
3166 if (obsrv%ObsTypeId ==
'MAW' .or. &
3167 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3168 do j = 1, this%nmawwells
3169 do jj = this%iaconn(j), this%iaconn(j + 1) - 1
3170 if (this%boundname(jj) == bname)
then
3172 call obsrv%AddObsIndex(jj)
3177 do j = 1, this%nmawwells
3178 if (this%cmawname(j) == bname)
then
3180 call obsrv%AddObsIndex(j)
3184 if (.not. jfound)
then
3186 trim(bname), trim(obsrv%Name), trim(this%packName)
3191 if (obsrv%indxbnds_count == 0)
then
3192 if (obsrv%ObsTypeId ==
'MAW' .or. &
3193 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3194 nn2 = obsrv%NodeNumber2
3195 j = this%iaconn(nn1) + nn2 - 1
3196 call obsrv%AddObsIndex(j)
3198 call obsrv%AddObsIndex(nn1)
3201 errmsg =
'Programming error in maw_rp_obs'
3208 if (obsrv%ObsTypeId ==
'HEAD')
then
3209 if (obsrv%indxbnds_count > 1)
then
3210 write (
errmsg,
'(a,3(1x,a))') &
3211 trim(adjustl(obsrv%ObsTypeId)), &
3212 'for observation', trim(adjustl(obsrv%Name)), &
3213 'must be assigned to a multi-aquifer well with a unique boundname.'
3219 if (obsrv%ObsTypeId ==
'MAW' .or. &
3220 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3221 do j = 1, obsrv%indxbnds_count
3222 nn1 = obsrv%indxbnds(j)
3224 nn2 = nn1 - this%iaconn(n) + 1
3225 jj = this%iaconn(n + 1) - this%iaconn(n)
3226 if (nn1 < 1 .or. nn1 > this%maxbound)
then
3227 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3228 trim(adjustl(obsrv%ObsTypeId)), &
3229 'multi-aquifer well connection number must be greater than 0', &
3230 'and less than', jj,
'(specified value is ', nn2,
').'
3235 do j = 1, obsrv%indxbnds_count
3236 nn1 = obsrv%indxbnds(j)
3237 if (nn1 < 1 .or. nn1 > this%nmawwells)
then
3238 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3239 trim(adjustl(obsrv%ObsTypeId)), &
3240 'multi-aquifer well must be greater than 0 ', &
3241 'and less than or equal to', this%nmawwells, &
3242 '(specified value is ', nn1,
').'
3267 integer(I4B),
intent(in) :: inunitobs
3268 integer(I4B),
intent(in) :: iout
3270 integer(I4B) :: nn1, nn2
3271 integer(I4B) :: icol, istart, istop
3272 character(len=LINELENGTH) :: string
3273 character(len=LENBOUNDNAME) :: bndname
3276 string = obsrv%IDstring
3284 obsrv%FeatureName = bndname
3286 if (obsrv%ObsTypeId ==
'MAW' .or. &
3287 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3289 if (len_trim(bndname) < 1 .and. nn2 < 0)
then
3290 write (
errmsg,
'(a,1x,a,a,1x,a,1x,a)') &
3291 'For observation type', trim(adjustl(obsrv%ObsTypeId)), &
3292 ', ID given as an integer and not as boundname,', &
3293 'but ID2 (icon) is missing. Either change ID to valid', &
3294 'boundname or supply valid entry for ID2.'
3298 obsrv%FeatureName = bndname
3302 obsrv%NodeNumber2 = nn2
3307 obsrv%NodeNumber = nn1
3317 class(
mawtype),
intent(inout) :: this
3318 character(len=*),
intent(in) :: fname
3320 character(len=*),
parameter :: fmtredflowcsv = &
3321 "(4x, 'MAW REDUCED FLOW INFORMATION WILL BE SAVED TO FILE: ', a, /4x, &
3322 &'OPENED ON UNIT: ', I0)"
3324 this%ioutredflowcsv =
getunit()
3325 call openfile(this%ioutredflowcsv, this%iout, fname,
'CSV', &
3326 filstat_opt=
'REPLACE')
3327 write (this%iout, fmtredflowcsv) trim(adjustl(fname)), &
3329 write (this%ioutredflowcsv,
'(a)') &
3330 'time,period,step,MAWnumber,rate-requested,rate-actual,maw-reduction'
3339 class(
mawtype),
intent(inout) :: this
3346 do n = 1, this%nmawwells
3349 if (this%status(n) .ne.
'ACTIVE')
then
3352 v = this%rate(n) - this%ratesim(n)
3353 if (abs(v) >
dem9)
then
3354 write (this%ioutredflowcsv,
'(*(G0,:,","))') &
3365 class(
mawtype),
intent(inout) :: this
3366 integer(I4B),
intent(in) :: i
3367 integer(I4B),
intent(in) :: j
3368 integer(I4B),
intent(in) :: node
3370 integer(I4B) :: iTcontrastErr
3371 integer(I4B) :: jpos
3375 real(DP) :: sqrtk11k22
3383 real(DP) :: Tcontrast
3408 jpos = this%get_jpos(i, j)
3411 k11 = this%gwfk11(node)
3412 if (this%gwfik22 == 0)
then
3413 k22 = this%gwfk11(node)
3415 k22 = this%gwfk22(node)
3417 sqrtk11k22 = sqrt(k11 * k22)
3420 gwftop = this%dis%top(node)
3421 gwfbot = this%dis%bot(node)
3422 tthka = gwftop - gwfbot
3423 gwfsat = this%gwfsat(node)
3427 topw = this%topscrn(jpos)
3428 botw = this%botscrn(jpos)
3432 if (gwftop == topw .and. gwfbot == botw)
then
3433 if (this%icelltype(node) == 0)
then
3434 tthkw = tthkw * gwfsat
3435 tthka = tthka * gwfsat
3440 t2pi =
dtwopi * tthka * sqrtk11k22
3443 if (this%dis%ndim == 3 .and. this%ieffradopt /= 0)
then
3446 dx = sqrt(this%dis%area(node))
3450 eradius = 0.28_dp * ((yx4 * dx)**
dtwo + &
3453 area = this%dis%area(node)
3459 if (this%ieqn(i) == 1 .or. this%ieqn(i) == 3)
then
3460 lc1 = log(eradius / this%radius(i)) / t2pi
3464 if (this%ieqn(i) == 2 .or. this%ieqn(i) == 3)
then
3466 if (tthkw * hks >
dzero)
then
3467 tcontrast = (sqrtk11k22 * tthka) / (hks * tthkw)
3468 skin = (tcontrast -
done) * log(this%sradius(jpos) / this%radius(i))
3475 if (tcontrast <= 1 .and. this%ieqn(i) == 2)
then
3477 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
3478 'Invalid calculated transmissivity contrast (', tcontrast, &
3479 ') for maw well', i,
'connection', j,
'.',
'This happens when the', &
3480 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
3481 'Consider decreasing HK_SKIN for the connection or using the', &
3482 'CUMULATIVE or MEAN conductance equations.'
3491 if (this%ieqn(i) == 4)
then
3493 ravg =
dhalf * (this%radius(i) + this%sradius(jpos))
3494 slen = this%sradius(jpos) - this%radius(i)
3496 c = hks * pavg * tthkw / slen
3501 if (this%ieqn(i) < 4)
then
3502 if (lc1 + lc2 /=
dzero)
then
3503 c =
done / (lc1 + lc2)
3511 if (c <
dzero .and. itcontrasterr == 0)
then
3512 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
3513 'Invalid calculated negative conductance (', c, &
3514 ') for maw well', i,
'connection', j,
'.',
'this happens when the', &
3515 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
3516 'consider decreasing hk_skin for the connection or using the', &
3517 'mean conductance equation.'
3522 this%satcond(jpos) = c
3529 class(
mawtype),
intent(inout) :: this
3530 integer(I4B),
intent(in) :: n
3531 integer(I4B),
intent(in) :: j
3532 integer(I4B),
intent(in) :: node
3533 real(DP),
intent(inout) :: sat
3535 integer(I4B) :: jpos
3546 if (this%icelltype(node) /= 0)
then
3549 hwell = this%xnewpak(n)
3552 jpos = this%get_jpos(n, j)
3555 topw = this%topscrn(jpos)
3556 botw = this%botscrn(jpos)
3559 if (this%inewton /= 1)
then
3560 h_temp = this%xnew(node)
3561 if (h_temp < botw)
then
3564 if (hwell < botw)
then
3567 h_temp =
dhalf * (h_temp + hwell)
3569 h_temp = this%xnew(node)
3570 if (hwell > h_temp)
then
3573 if (h_temp < botw)
then
3600 integer(I4B),
intent(in) :: n
3601 integer(I4B),
intent(in) :: j
3602 integer(I4B),
intent(inout) :: icflow
3603 real(DP),
intent(inout) :: cmaw
3604 real(DP),
intent(inout) :: cterm
3605 real(DP),
intent(inout) :: term
3606 real(DP),
intent(inout) :: flow
3607 real(DP),
intent(inout),
optional :: term2
3609 logical(LGP) :: correct_flow
3610 integer(I4B) :: inewton
3611 integer(I4B) :: jpos
3612 integer(I4B) :: igwfnode
3623 real(DP) :: dhbarterm
3624 real(DP) :: vscratio
3630 if (
present(term2))
then
3637 jpos = this%get_jpos(n, j)
3638 igwfnode = this%get_gwfnode(n, j)
3639 hgwf = this%xnew(igwfnode)
3640 hmaw = this%xnewpak(n)
3641 tmaw = this%topscrn(jpos)
3642 bmaw = this%botscrn(jpos)
3645 if (this%ivsc == 1)
then
3648 vscratio = this%viscratios(1, igwfnode)
3650 vscratio = this%viscratios(2, igwfnode)
3655 call this%maw_calculate_saturation(n, j, igwfnode, sat)
3656 cmaw = this%satcond(jpos) * vscratio * sat
3659 if (inewton == 1)
then
3663 if (hgwf > hups)
then
3674 if (this%correct_flow)
then
3677 en = max(bmaw, this%dis%bot(igwfnode))
3678 correct_flow = .false.
3680 correct_flow = .true.
3682 if (hgwf < en .and. this%icelltype(igwfnode) /= 0)
then
3683 correct_flow = .true.
3688 if (correct_flow)
then
3690 hdowns = min(hmaw, hgwf)
3692 if (hgwf > hmaw)
then
3693 cterm = cmaw * (hmaw - hbar)
3695 cterm = cmaw * (hbar - hgwf)
3700 if (inewton /= 0)
then
3703 if (hmaw > hgwf)
then
3705 term = drterm * this%satcond(jpos) * vscratio * (hbar - hmaw)
3707 term2 = cmaw * (dhbarterm -
done)
3712 term = -drterm * this%satcond(jpos) * vscratio * (hgwf - hbar)
3714 term2 = cmaw * (
done - dhbarterm)
3720 if (inewton /= 0)
then
3721 term = drterm * this%satcond(jpos) * vscratio * (hgwf - hmaw)
3727 if (inewton == 0)
then
3728 flow = term * (hgwf - hmaw) + cterm
3732 if (this%idense /= 0 .and. inewton == 0)
then
3733 call this%maw_calculate_density_exchange(jpos, hmaw, hgwf, cmaw, &
3734 bmaw, flow, term, cterm)
3743 integer(I4B),
intent(in) :: n
3744 real(DP),
intent(in) :: hmaw
3745 real(DP),
intent(inout) :: q
3762 if (rate <
dzero)
then
3767 if (this%shutofflevel(n) /=
dep20)
then
3768 call this%maw_calculate_qpot(n, q)
3770 if (q > -rate) q = -rate
3772 if (this%ishutoffcnt == 1)
then
3773 this%shutoffweight(n) =
done
3774 this%shutoffdq(n) =
dzero
3775 this%shutoffqold(n) = q
3778 dq = q - this%shutoffqold(n)
3779 weight = this%shutoffweight(n)
3782 if (this%shutoffdq(n) * dq <
dzero)
then
3783 weight = this%theta * this%shutoffweight(n)
3787 weight = this%shutoffweight(n) + this%kappa
3791 q = this%shutoffqold(n) + weight * dq
3793 this%shutoffqold(n) = q
3794 this%shutoffdq(n) = dq
3795 this%shutoffweight(n) = weight
3799 if (this%shutoffmin(n) >
dzero)
then
3800 if (hmaw < this%shutofflevel(n))
then
3804 if (this%ishutoff(n) /= 0)
then
3811 if (q < this%shutoffmin(n))
then
3812 if (this%ishutoffcnt > 2)
then
3813 this%ishutoff(n) = 1
3824 if (q > this%shutoffmax(n))
then
3825 if (this%ishutoffcnt <= 2)
then
3826 this%ishutoff(n) = 0
3829 if (this%ishutoff(n) /= 0)
then
3835 if (q /=
dzero) q = -q
3844 if (this%reduction_length(n) /=
dep20)
then
3845 bt = this%pumpelev(n)
3846 tp = bt + this%reduction_length(n)
3856 if (this%shutofflevel(n) /=
dep20)
then
3857 call this%maw_calculate_qpot(n, q)
3860 if (q > rate) q = rate
3862 if (this%ishutoffcnt == 1)
then
3863 this%shutoffweight(n) =
done
3864 this%shutoffdq(n) =
dzero
3865 this%shutoffqold(n) = q
3868 dq = q - this%shutoffqold(n)
3869 weight = this%shutoffweight(n)
3872 if (this%shutoffdq(n) * dq <
dzero)
then
3873 weight = this%theta * this%shutoffweight(n)
3877 weight = this%shutoffweight(n) + this%kappa
3881 q = this%shutoffqold(n) + weight * dq
3883 this%shutoffqold(n) = q
3884 this%shutoffdq(n) = dq
3885 this%shutoffweight(n) = weight
3893 if (this%reduction_length(n) /=
dep20)
then
3894 bt = this%pumpelev(n)
3895 tp = bt + this%reduction_length(n)
3908 class(
mawtype),
intent(inout) :: this
3909 integer(I4B),
intent(in) :: n
3910 real(DP),
intent(inout) :: qnet
3913 integer(I4B) :: jpos
3914 integer(I4B) :: igwfnode
3926 real(DP) :: vscratio
3932 h_temp = this%shutofflevel(n)
3935 if (this%ivsc == 1)
then
3938 vscratio = this%viscratios(1, igwfnode)
3940 vscratio = this%viscratios(2, igwfnode)
3945 if (this%iflowingwells > 0)
then
3946 if (this%fwcond(n) >
dzero)
then
3948 tp = bt + this%fwrlen(n)
3950 cfw = scale * this%fwcond(n) * this%viscratios(2, n)
3951 this%ifwdischarge(n) = 0
3952 if (cfw >
dzero)
then
3953 this%ifwdischarge(n) = 1
3956 qnet = qnet + cfw * (bt - h_temp)
3961 if (this%imawiss /= 1)
then
3962 if (this%ifwdischarge(n) /= 1)
then
3963 hdterm = this%xoldsto(n) - h_temp
3965 hdterm = this%xoldsto(n) - this%fwelev(n)
3967 qnet = qnet - (this%area(n) * hdterm /
delt)
3971 do j = 1, this%ngwfnodes(n)
3972 jpos = this%get_jpos(n, j)
3973 igwfnode = this%get_gwfnode(n, j)
3974 call this%maw_calculate_saturation(n, j, igwfnode, sat)
3975 cmaw = this%satcond(jpos) * vscratio * sat
3976 hgwf = this%xnew(igwfnode)
3977 bmaw = this%botscrn(jpos)
3982 if (hgwf < bmaw)
then
3985 qnet = qnet + cmaw * (hgwf - hv)
3997 integer(I4B) :: jpos
3998 integer(I4B) :: icflow
3999 integer(I4B) :: ibnd
4007 if (this%nbound .eq. 0)
return
4010 this%ishutoffcnt = this%ishutoffcnt + 1
4014 do n = 1, this%nmawwells
4015 hmaw = this%xnewpak(n)
4016 do j = 1, this%ngwfnodes(n)
4017 jpos = this%get_jpos(n, j)
4018 this%hcof(ibnd) =
dzero
4019 this%rhs(ibnd) =
dzero
4025 if (this%iboundpak(n) == 0)
then
4030 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, &
4033 this%simcond(jpos) = cmaw
4034 this%bound(2, ibnd) = cmaw
4035 this%hcof(ibnd) = -term
4036 this%rhs(ibnd) = -term * hmaw + cterm
4054 integer(I4B) :: nbudterm
4055 integer(I4B) :: n, j, n2
4057 integer(I4B) :: maxlist, naux
4059 character(len=LENBUDTXT) :: text
4060 character(len=LENBUDTXT),
dimension(1) :: auxtxt
4066 if (this%iflowingwells > 0)
then
4067 nbudterm = nbudterm + 1
4069 if (this%imover == 1)
then
4070 nbudterm = nbudterm + 3
4071 if (this%iflowingwells > 0)
then
4072 nbudterm = nbudterm + 1
4075 if (this%naux > 0) nbudterm = nbudterm + 1
4079 call this%budobj%budgetobject_df(this%nmawwells, nbudterm, 0, 0, &
4080 ibudcsv=this%ibudcsv)
4088 maxlist = this%maxbound
4090 auxtxt(1) =
' FLOW-AREA'
4091 call this%budobj%budterm(idx)%initialize(text, &
4096 maxlist, .false., .true., &
4098 call this%budobj%budterm(idx)%reset(this%maxbound)
4100 do n = 1, this%nmawwells
4101 do j = 1, this%ngwfnodes(n)
4102 n2 = this%get_gwfnode(n, j)
4103 call this%budobj%budterm(idx)%update_term(n, n2, q)
4110 maxlist = this%nmawwells
4112 call this%budobj%budterm(idx)%initialize(text, &
4117 maxlist, .false., .false., &
4121 if (this%iflowingwells > 0)
then
4124 maxlist = this%nmawwells
4126 call this%budobj%budterm(idx)%initialize(text, &
4131 maxlist, .false., .false., &
4138 maxlist = this%nmawwells
4140 auxtxt(1) =
' VOLUME'
4141 call this%budobj%budterm(idx)%initialize(text, &
4146 maxlist, .false., .true., &
4152 maxlist = this%nmawwells
4154 call this%budobj%budterm(idx)%initialize(text, &
4159 maxlist, .false., .false., &
4163 if (this%imover == 1)
then
4168 maxlist = this%nmawwells
4170 call this%budobj%budterm(idx)%initialize(text, &
4175 maxlist, .false., .false., &
4179 text =
' RATE-TO-MVR'
4181 maxlist = this%nmawwells
4183 call this%budobj%budterm(idx)%initialize(text, &
4188 maxlist, .false., .false., &
4192 text =
' CONSTANT-TO-MVR'
4194 maxlist = this%nmawwells
4196 call this%budobj%budterm(idx)%initialize(text, &
4201 maxlist, .false., .false., &
4205 if (this%iflowingwells > 0)
then
4208 text =
' FW-RATE-TO-MVR'
4210 maxlist = this%nmawwells
4212 call this%budobj%budterm(idx)%initialize(text, &
4217 maxlist, .false., .false., &
4229 maxlist = this%maxbound
4230 call this%budobj%budterm(idx)%initialize(text, &
4235 maxlist, .false., .false., &
4240 if (this%iprflow /= 0)
then
4241 call this%budobj%flowtable_df(this%iout)
4255 integer(I4B) :: naux
4259 integer(I4B) :: jpos
4261 integer(I4B) :: ibnd
4277 call this%budobj%budterm(idx)%reset(this%maxbound)
4279 do n = 1, this%nmawwells
4280 do j = 1, this%ngwfnodes(n)
4281 jpos = this%get_jpos(n, j)
4282 n2 = this%get_gwfnode(n, j)
4283 tmaw = this%topscrn(jpos)
4284 bmaw = this%botscrn(jpos)
4285 call this%maw_calculate_saturation(n, j, n2, sat)
4286 this%qauxcbc(1) =
dtwo *
dpi * this%radius(n) * sat * (tmaw - bmaw)
4287 q = this%qleak(ibnd)
4288 call this%budobj%budterm(idx)%update_term(n, n2, q, this%qauxcbc)
4295 call this%budobj%budterm(idx)%reset(this%nmawwells)
4296 do n = 1, this%nmawwells
4300 if (this%imover == 1 .and. q <
dzero)
then
4302 if (this%qout(n) <
dzero)
then
4303 qfact = q / this%qout(n)
4305 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4307 call this%budobj%budterm(idx)%update_term(n, n, q)
4311 if (this%iflowingwells > 0)
then
4313 call this%budobj%budterm(idx)%reset(this%nmawwells)
4314 do n = 1, this%nmawwells
4316 if (this%imover == 1)
then
4320 if (this%qout(n) <
dzero)
then
4321 qfact = q / this%qout(n)
4323 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4325 call this%budobj%budterm(idx)%update_term(n, n, q)
4331 call this%budobj%budterm(idx)%reset(this%nmawwells)
4332 do n = 1, this%nmawwells
4333 b = this%xsto(n) - this%bot(n)
4337 v = this%area(n) * b
4338 if (this%imawissopt /= 1)
then
4344 call this%budobj%budterm(idx)%update_term(n, n, q, this%qauxcbc)
4349 call this%budobj%budterm(idx)%reset(this%nmawwells)
4350 do n = 1, this%nmawwells
4354 if (this%imover == 1 .and. q <
dzero)
then
4356 if (this%qout(n) <
dzero)
then
4357 qfact = q / this%qout(n)
4359 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4361 call this%budobj%budterm(idx)%update_term(n, n, q)
4365 if (this%imover == 1)
then
4369 call this%budobj%budterm(idx)%reset(this%nmawwells)
4370 do n = 1, this%nmawwells
4371 if (this%iboundpak(n) == 0)
then
4374 q = this%pakmvrobj%get_qfrommvr(n)
4376 call this%budobj%budterm(idx)%update_term(n, n, q)
4381 call this%budobj%budterm(idx)%reset(this%nmawwells)
4382 do n = 1, this%nmawwells
4383 q = this%pakmvrobj%get_qtomvr(n)
4386 q2 = this%ratesim(n)
4389 if (q2 <
dzero)
then
4390 qfact = q2 / this%qout(n)
4396 call this%budobj%budterm(idx)%update_term(n, n, q)
4401 call this%budobj%budterm(idx)%reset(this%nmawwells)
4402 do n = 1, this%nmawwells
4403 q = this%pakmvrobj%get_qtomvr(n)
4408 if (q2 <
dzero)
then
4409 qfact = q2 / this%qout(n)
4415 call this%budobj%budterm(idx)%update_term(n, n, q)
4419 if (this%iflowingwells > 0)
then
4421 call this%budobj%budterm(idx)%reset(this%nmawwells)
4422 do n = 1, this%nmawwells
4423 q = this%pakmvrobj%get_qtomvr(n)
4426 q2 = this%ratesim(n)
4430 if (this%qout(n) <
dzero)
then
4431 qfact = this%qfw(n) / this%qout(n)
4435 call this%budobj%budterm(idx)%update_term(n, n, q)
4445 call this%budobj%budterm(idx)%reset(this%nmawwells)
4446 do n = 1, this%nmawwells
4448 call this%budobj%budterm(idx)%update_term(n, n, q, this%auxvar(:, n))
4453 call this%budobj%accumulate_terms()
4467 integer(I4B) :: nterms
4468 character(len=LINELENGTH) :: title
4469 character(len=LINELENGTH) :: text
4472 if (this%iprhed > 0)
then
4476 if (this%inamedbound == 1) nterms = nterms + 1
4479 title = trim(adjustl(this%text))//
' PACKAGE ('// &
4480 trim(adjustl(this%packName))//
') HEADS FOR EACH CONTROL VOLUME'
4483 call table_cr(this%headtab, this%packName, title)
4484 call this%headtab%table_df(this%nmawwells, nterms, this%iout, &
4488 if (this%inamedbound == 1)
then
4490 call this%headtab%initialize_column(text, 20, alignment=tableft)
4495 call this%headtab%initialize_column(text, 10, alignment=tabcenter)
4499 call this%headtab%initialize_column(text, 12, alignment=tabcenter)
4507 integer(I4B) :: jpos
4510 integer(I4B),
intent(in) :: n
4511 integer(I4B),
intent(in) :: j
4515 jpos = this%iaconn(n) + j - 1
4522 integer(I4B) :: igwfnode
4525 integer(I4B),
intent(in) :: n
4526 integer(I4B),
intent(in) :: j
4528 integer(I4B) :: jpos
4531 jpos = this%get_jpos(n, j)
4532 igwfnode = this%gwfnodes(jpos)
4539 class(
mawtype),
intent(inout) :: this
4541 integer(I4B) :: i, j
4546 call mem_reallocate(this%denseterms, 3, this%MAXBOUND,
'DENSETERMS', &
4548 do i = 1, this%maxbound
4550 this%denseterms(j, i) =
dzero
4553 write (this%iout,
'(/1x,a)')
'DENSITY TERMS HAVE BEEN ACTIVATED FOR MAW &
4554 &PACKAGE: '//trim(adjustl(this%packName))
4565 class(
mawtype),
intent(inout) :: this
4572 call mem_reallocate(this%viscratios, 2, this%MAXBOUND,
'VISCRATIOS', &
4574 do i = 1, this%maxbound
4576 this%viscratios(j, i) =
done
4579 write (this%iout,
'(/1x,a)')
'VISCOSITY HAS BEEN ACTIVATED FOR MAW &
4580 &PACKAGE: '//trim(adjustl(this%packName))
4606 bmaw, flow, hcofterm, rhsterm)
4608 class(
mawtype),
intent(inout) :: this
4609 integer(I4B),
intent(in) :: iconn
4610 real(DP),
intent(in) :: hmaw
4611 real(DP),
intent(in) :: hgwf
4612 real(DP),
intent(in) :: cond
4613 real(DP),
intent(in) :: bmaw
4614 real(DP),
intent(inout) :: flow
4615 real(DP),
intent(inout) :: hcofterm
4616 real(DP),
intent(inout) :: rhsterm
4620 real(DP) :: rdensemaw
4621 real(DP) :: rdensegwf
4622 real(DP) :: rdenseavg
4627 rdensemaw = this%denseterms(1, iconn)
4628 rdensegwf = this%denseterms(2, iconn)
4629 if (rdensegwf ==
dzero)
return
4632 if (hmaw > bmaw .and. hgwf > bmaw)
then
4635 rdenseavg =
dhalf * (rdensemaw + rdensegwf)
4638 t = cond * (rdenseavg -
done) * (hgwf - hmaw)
4639 rhsterm = rhsterm + t
4643 havg =
dhalf * (hgwf + hmaw)
4644 elevavg = this%denseterms(3, iconn)
4645 t = cond * (havg - elevavg) * (rdensegwf - rdensemaw)
4646 rhsterm = rhsterm + t
4648 else if (hmaw > bmaw)
then
4651 t = (rdensemaw -
done) * rhsterm
4652 rhsterm = rhsterm + t
4654 else if (hgwf > bmaw)
then
4657 t = (rdensegwf -
done) * rhsterm
4658 rhsterm = rhsterm + t
This module contains block parser methods.
This module contains the base boundary package.
This module contains the BudgetModule.
subroutine, public budgetobject_cr(this, name)
Create a new budget object.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
real(dp), parameter dhdry
real dry cell constant
@ tabcenter
centered table column
@ tabright
right justified table column
@ tableft
left justified table column
@ mnormal
normal output mode
@ tabucstring
upper case string table data
@ tabstring
string table data
@ tabinteger
integer table data
integer(i4b), parameter lenpackagename
maximum length of the package name
real(dp), parameter dp9
real constant 9/10
real(dp), parameter deight
real constant 8
integer(i4b), parameter namedboundflag
named bound flag
real(dp), parameter dnodata
real no data constant
real(dp), parameter dhnoflo
real no flow constant
real(dp), parameter dhundred
real constant 100
integer(i4b), parameter lentimeseriesname
maximum length of a time series name
real(dp), parameter dtwopi
real constant
real(dp), parameter dep20
real constant 1e20
real(dp), parameter dhalf
real constant 1/2
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
integer(i4b), parameter lenauxname
maximum length of a aux variable
real(dp), parameter dpi
real constant
integer(i4b), parameter lenboundname
maximum length of a bound name
real(dp), parameter dem4
real constant 1e-4
real(dp), parameter dem6
real constant 1e-6
real(dp), parameter dzero
real constant zero
integer(i4b), parameter maxcharlen
maximum length of char string
real(dp), parameter dp7
real constant 7/10
real(dp), parameter dem9
real constant 1e-9
real(dp), parameter dem2
real constant 1e-2
real(dp), parameter dtwo
real constant 2
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
real(dp), parameter dquarter
real constant 1/3
real(dp), parameter done
real constant 1
integer(i4b) function, public get_node(ilay, irow, icol, nlay, nrow, ncol)
Get node number, given layer, row, and column indices for a structured grid. If any argument is inval...
This module defines variable data types.
subroutine maw_fill_budobj(this)
Copy flow terms into thisbudobj.
subroutine maw_rp(this)
Read and Prepare.
subroutine maw_set_stressperiod(this, imaw, iheadlimit_warning)
Set a stress period attribute for mawweslls(imaw) using keywords.
integer(i4b) function get_gwfnode(this, n, j)
Get the gwfnode for connection.
subroutine maw_cf(this)
Formulate the HCOF and RHS terms.
subroutine maw_ot_bdsummary(this, kstp, kper, iout, ibudfl)
Write MAW budget to listing file.
subroutine maw_activate_viscosity(this)
Activate viscosity terms.
subroutine maw_read_initial_attr(this)
Read the initial parameters for this package.
subroutine maw_bd_obs(this)
Calculate observations this time step and call ObsTypeSaveOneSimval for each MawType observation.
subroutine maw_ar(this)
Allocate and Read.
subroutine maw_set_attribute_error(this, imaw, keyword, msg)
Issue a parameter error for mawweslls(imaw)
subroutine maw_ad(this)
Add package connection to matrix.
subroutine maw_calculate_conn_terms(this, n, j, icflow, cmaw, cterm, term, flow, term2)
Calculate matrix terms for a multi-aquifer well connection. Terms for fc and fn methods are calculate...
subroutine maw_calculate_density_exchange(this, iconn, hmaw, hgwf, cond, bmaw, flow, hcofterm, rhsterm)
Calculate the groundwater-maw density exchange terms.
subroutine maw_calculate_wellq(this, n, hmaw, q)
Calculate well pumping rate based on constraints.
subroutine maw_rp_obs(this)
Process each observation.
character(len=lenpackagename) text
subroutine maw_allocate_scalars(this)
Allocate scalar members.
subroutine maw_calculate_qpot(this, n, qnet)
Calculate groundwater inflow to a maw well.
subroutine maw_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap)
Write flows to binary file and/or print flows to budget.
subroutine, public maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
Create a New Multi-Aquifer Well (MAW) Package.
subroutine maw_set_pointers(this, neq, ibound, xnew, xold, flowja)
Set pointers to model arrays and variables so that a package has has access to these things.
subroutine maw_activate_density(this)
Activate density terms.
integer(i4b) function get_jpos(this, n, j)
Get position of value in connection data.
subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln)
Fill newton terms.
subroutine maw_calculate_saturation(this, n, j, node, sat)
Calculate the saturation between the aquifer maw well_head.
subroutine maw_ot_package_flows(this, icbcfl, ibudfl)
Output MAW package flow terms.
subroutine maw_allocate_well_conn_arrays(this)
Allocate well arrays.
logical function maw_obs_supported(this)
Return true because MAW package supports observations.
subroutine maw_read_dimensions(this)
Read the dimensions for this package.
subroutine maw_read_options(this, option, found)
Set options specific to MawType.
subroutine maw_allocate_arrays(this)
Allocate arrays.
subroutine maw_cfupdate(this)
Update MAW satcond and package rhs and hcof.
subroutine maw_redflow_csv_write(this)
MAW reduced flows only when & where they occur.
subroutine maw_redflow_csv_init(this, fname)
Initialize the auto flow reduce csv output file.
subroutine maw_mc(this, moffset, matrix_sln)
Map package connection to matrix.
subroutine maw_read_wells(this)
Read the packagedata for this package.
subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
Calculate under-relaxation of groundwater flow model MAW Package heads for current outer iteration us...
subroutine maw_check_attributes(this)
Issue parameter errors for mawwells(imaw)
subroutine maw_ac(this, moffset, sparse)
Add package connection to matrix.
subroutine maw_ot_dv(this, idvsave, idvprint)
Save maw-calculated values to binary file.
subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln)
Copy rhs and hcof into solution rhs and amat.
character(len=lenftype) ftype
subroutine maw_read_well_connections(this)
Read the dimensions for this package.
subroutine define_listlabel(this)
Define the list heading that is written to iout when PRINT_INPUT option is used.
subroutine maw_setup_budobj(this)
Set up the budget object that stores all the maw flows The terms listed here must correspond in numbe...
subroutine maw_cq(this, x, flowja, iadv)
Calculate flows.
subroutine maw_df_obs(this)
Store observation type supported by MAW package.
subroutine maw_calculate_satcond(this, i, j, node)
Calculate the appropriate saturated conductance to use based on aquifer and multi-aquifer well charac...
subroutine maw_da(this)
Deallocate memory.
subroutine maw_process_obsid(obsrv, dis, inunitobs, iout)
This procedure is pointed to by ObsDataTypeProcesssIdPtr. It processes the ID string of an observatio...
subroutine maw_setup_tableobj(this)
Set up the table object that is used to write the maw head data.
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains the derived types ObserveType and ObsDataType.
This module contains the derived type ObsType.
This module contains simulation methods.
subroutine, public store_warning(msg, substring)
Store warning message.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
character(len=maxcharlen) warnmsg
warning message string
real(dp) function squadraticsaturation(top, bot, x, eps)
@ brief sQuadraticSaturation
real(dp) function squadraticsaturationderivative(top, bot, x, eps)
@ brief Derivative of the quadratic saturation function
real(dp) function sqsaturationderivative(top, bot, x, c1, c2)
@ brief sQSaturationDerivative
real(dp) function squadratic0spderivative(x, xi, tomega)
@ brief sQuadratic0spDerivative
real(dp) function sqsaturation(top, bot, x, c1, c2)
@ brief sQSaturation
real(dp) function squadratic0sp(x, xi, tomega)
@ brief sQuadratic0sp
subroutine, public table_cr(this, name, title)
real(dp), pointer, public pertim
time relative to start of stress period
real(dp), pointer, public totim
time relative to start of simulation
integer(i4b), pointer, public kstp
current time step number
integer(i4b), pointer, public kper
current stress period number
real(dp), pointer, public delt
length of the current time step
integer(i4b), pointer, public nper
number of stress period
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).
Derived type for the Budget object.