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 ==
'THEIM' .or. keyword ==
'THIEM')
then
642 else if (keyword ==
'SKIN')
then
644 else if (keyword ==
'CUMULATIVE')
then
646 else if (keyword ==
'MEAN')
then
649 write (
errmsg,
'(a,1x,i0,1x,a)') &
650 'CONDEQN for well', n, &
651 "must be 'CUMULATIVE', 'THIEM', 'MEAN', or 'SKIN'."
656 ival = this%parser%GetInteger()
659 write (
errmsg,
'(a,1x,i0,1x,a)') &
660 'NGWFNODES for well', n,
'must be greater than zero.'
673 call this%parser%GetString(caux(jj, n))
677 write (cno,
'(i9.9)') n
678 bndname =
'MAWWELL'//cno
681 if (this%inamedbound /= 0)
then
682 call this%parser%GetStringCaps(bndnametemp)
683 if (bndnametemp /=
'')
then
684 bndname = bndnametemp
690 write (this%iout,
'(1x,a)') &
691 'END OF '//trim(adjustl(this%text))//
' PACKAGEDATA'
694 do n = 1, this%nmawwells
695 if (nboundchk(n) == 0)
then
696 write (
errmsg,
'(a,1x,i0,a)')
'No data specified for maw well', n,
'.'
698 else if (nboundchk(n) > 1)
then
699 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
700 'Data for maw well', n,
'specified', nboundchk(n),
'times.'
705 call store_error(
'Required packagedata block not found.')
710 call this%parser%StoreErrorUnit()
715 write (this%iout,
'(//4x,a,i7)')
'MAXBOUND = ', this%maxbound
718 call this%maw_allocate_well_conn_arrays()
721 do n = 1, this%nmawwells
723 this%radius(n) = rval
724 this%area(n) = dpi * rval**dtwo
725 this%bot(n) = bottom(n)
726 this%ieqn(n) = wellieqn(n)
727 this%ngwfnodes(n) = ngwfnodes(n)
728 this%cmawname(n) = nametxt(n)
734 bndelem => this%well_head(n)
736 this%packName,
'BND', this%tsManager, &
737 this%iprpak,
'WELL_HEAD')
740 this%strt(n) = this%well_head(n)
743 if (this%strt(n) < this%bot(n))
then
744 write (cstr, fmthdbot) this%strt(n), this%bot(n)
745 call this%maw_set_attribute_error(n,
'STRT', trim(cstr))
752 bndelem => this%mauxvar(jj, ii)
754 'AUX', this%tsManager, this%iprpak, &
762 do n = 1, this%nmawwells
763 do j = 1, this%ngwfnodes(n)
767 this%iaconn(n + 1) = idx + 1
771 deallocate (strttext)
773 if (this%naux > 0)
then
776 deallocate (nboundchk)
777 deallocate (wellieqn)
778 deallocate (ngwfnodes)
788 class(
mawtype),
intent(inout) :: this
790 character(len=LINELENGTH) :: cellid
791 character(len=30) :: nodestr
793 logical :: endOfBlock
803 integer(I4B) :: ireset_scrntop
804 integer(I4B) :: ireset_scrnbot
805 integer(I4B) :: ireset_wellbot
810 integer(I4B),
dimension(:),
pointer,
contiguous :: nboundchk
811 integer(I4B),
dimension(:),
pointer,
contiguous :: iachk
819 allocate (iachk(this%nmawwells + 1))
821 do n = 1, this%nmawwells
822 iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
824 allocate (nboundchk(this%maxbound))
825 do n = 1, this%maxbound
830 call this%parser%GetBlock(
'CONNECTIONDATA', isfound, ierr, &
831 supportopenclose=.true.)
835 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
838 call this%parser%GetNextLine(endofblock)
842 ival = this%parser%GetInteger()
846 if (n < 1 .or. n > this%nmawwells)
then
847 write (
errmsg,
'(a,1x,i0,a)') &
848 'IMAW must be greater than 0 and less than or equal to ', &
855 ival = this%parser%GetInteger()
856 if (ival < 1 .or. ival > this%ngwfnodes(n))
then
857 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
858 'JCONN for well ', n, &
859 'must be greater than 1 and less than or equal to ', &
860 this%ngwfnodes(n),
'.'
865 ipos = iachk(n) + ival - 1
866 nboundchk(ipos) = nboundchk(ipos) + 1
869 jpos = this%get_jpos(n, ival)
872 call this%parser%GetCellid(this%dis%ndim, cellid)
873 nn = this%dis%noder_from_cellid(cellid, this%inunit, this%iout)
874 topnn = this%dis%top(nn)
875 botnn = this%dis%bot(nn)
879 this%gwfnodes(jpos) = nn
882 rval = this%parser%GetDouble()
883 if (this%ieqn(n) /= 4)
then
886 if (rval > topnn)
then
887 ireset_scrntop = ireset_scrntop + 1
891 this%topscrn(jpos) = rval
894 rval = this%parser%GetDouble()
895 if (this%ieqn(n) /= 4)
then
898 if (rval < botnn)
then
899 ireset_scrnbot = ireset_scrnbot + 1
903 this%botscrn(jpos) = rval
907 if (rval < botw)
then
908 if (this%ieqn(n) /= 4)
then
909 ireset_wellbot = ireset_wellbot + 1
913 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
914 'Screen bottom for maw well', n,
'connection', j,
'(', &
915 this%botscrn(jpos),
') is less than the well bottom (', &
922 rval = this%parser%GetDouble()
923 if (this%ieqn(n) == 0)
then
924 this%satcond(jpos) = rval
925 else if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
926 this%ieqn(n) == 4)
then
931 rval = this%parser%GetDouble()
932 if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
933 this%ieqn(n) == 4)
then
934 this%sradius(jpos) = rval
935 if (this%sradius(jpos) <= this%radius(n))
then
936 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
937 'Screen radius for maw well', n,
'connection', j,
'(', &
938 this%sradius(jpos), &
939 ') is less than or equal to the well radius (', &
945 write (this%iout,
'(1x,a)') &
946 'END OF '//trim(adjustl(this%text))//
' CONNECTIONDATA'
949 do n = 1, this%nmawwells
950 do j = 1, this%ngwfnodes(n)
954 if (nboundchk(ipos) == 0)
then
955 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
956 'No data specified for maw well', n,
'connection', j,
'.'
958 else if (nboundchk(ipos) > 1)
then
959 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,1x,i0,1x,a)') &
960 'Data for maw well', n,
'connection', j, &
961 'specified', nboundchk(n),
'times.'
969 do n = 1, this%nmawwells
970 if (this%ieqn(n) /= 4)
then
971 do j = 1, this%ngwfnodes(n)
972 nn = this%get_gwfnode(n, j)
973 do jj = 1, this%ngwfnodes(n)
979 nn2 = this%get_gwfnode(n, jj)
981 call this%dis%noder_to_string(nn, nodestr)
982 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,3(1x,a))') &
983 'Only one connection can be specified for maw well', &
984 n,
'connection', j,
'to gwf cell', trim(adjustl(nodestr)), &
985 'unless the mean condeqn is specified.'
993 call store_error(
'Required connectiondata block not found.')
998 deallocate (nboundchk)
1001 if (ireset_scrntop > 0)
then
1002 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1003 'The screen tops in multi-aquifer well package', trim(this%packName), &
1004 'were reset to the top of the connected cell', ireset_scrntop,
'times.'
1007 if (ireset_scrnbot > 0)
then
1008 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1009 'The screen bottoms in multi-aquifer well package', trim(this%packName), &
1010 'were reset to the bottom of the connected cell', ireset_scrnbot, &
1014 if (ireset_wellbot > 0)
then
1015 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1016 'The well bottoms in multi-aquifer well package', trim(this%packName), &
1017 'were reset to the bottom of the connected cell', ireset_wellbot, &
1024 call this%parser%StoreErrorUnit()
1033 class(
mawtype),
intent(inout) :: this
1035 character(len=LENBOUNDNAME) :: keyword
1036 integer(I4B) :: ierr
1037 logical :: isfound, endOfBlock
1045 call this%parser%GetBlock(
'DIMENSIONS', isfound, ierr, &
1046 supportopenclose=.true.)
1050 write (this%iout,
'(/1x,a)') &
1051 'PROCESSING '//trim(adjustl(this%text))//
' DIMENSIONS'
1053 call this%parser%GetNextLine(endofblock)
1054 if (endofblock)
exit
1055 call this%parser%GetStringCaps(keyword)
1056 select case (keyword)
1058 this%nmawwells = this%parser%GetInteger()
1059 write (this%iout,
'(4x,a,i0)')
'NMAWWELLS = ', this%nmawwells
1062 'Unknown '//trim(this%text)//
' dimension: ', trim(keyword),
'.'
1066 write (this%iout,
'(1x,a)') &
1067 'END OF '//trim(adjustl(this%text))//
' DIMENSIONS'
1069 call store_error(
'Required dimensions block not found.', terminate=.true.)
1073 if (this%nmawwells < 0)
then
1075 'NMAWWELLS was not specified or was specified incorrectly.'
1081 call this%parser%StoreErrorUnit()
1085 call this%maw_read_wells()
1088 call this%maw_read_well_connections()
1092 call this%define_listlabel()
1095 call this%maw_setup_budobj()
1098 call this%maw_setup_tableobj()
1108 class(
mawtype),
intent(inout) :: this
1110 character(len=LINELENGTH) :: title
1111 character(len=LINELENGTH) :: text
1112 integer(I4B) :: ntabcols
1116 integer(I4B) :: jpos
1117 integer(I4B) :: inode
1121 character(len=10),
dimension(0:4) :: ccond
1122 character(len=30) :: nodestr
1124 data ccond(0)/
'SPECIFIED '/
1125 data ccond(1)/
'THIEM '/
1126 data ccond(2)/
'SKIN '/
1127 data ccond(3)/
'CUMULATIVE'/
1128 data ccond(4)/
'MEAN '/
1130 character(len=*),
parameter :: fmtwelln = &
1131 "(1X,//43X,'MULTI-AQUIFER WELL DATA'&
1133 &/1X,7(A10,1X),A16)"
1134 character(len=*),
parameter :: fmtwelld = &
1135 &
"(1X,I10,1X,4(G10.3,1X),I10,1X,A10,1X,A16)"
1136 character(len=*),
parameter :: fmtline = &
1138 character(len=*),
parameter :: fmtwellcn = &
1139 "(1X,//37X,'MULTI-AQUIFER WELL CONNECTION DATA'&
1141 &/1X,2(A10,1X),A20,7(A10,1X))"
1142 character(len=*),
parameter :: fmtwellcd = &
1143 &
"(1X,2(I10,1X),A20,1X,2(G10.3,1X),2(A10,1X),3(G10.3,1X))"
1146 do n = 1, this%nmawwells
1147 this%xnewpak(n) = this%strt(n)
1148 this%xsto(n) = this%strt(n)
1152 do n = 1, this%nmawwells
1153 select case (this%status(n))
1155 this%iboundpak(n) = -1
1157 this%iboundpak(n) = 0
1159 this%iboundpak(n) = 1
1164 if (this%inamedbound /= 0)
then
1166 do n = 1, this%nmawwells
1167 do j = 1, this%ngwfnodes(n)
1169 this%boundname(idx) = this%cmawname(n)
1174 do n = 1, this%nmawwells
1175 this%cmawname(n) =
''
1180 call this%copy_boundname()
1190 call this%maw_check_attributes()
1193 do n = 1, this%nmawwells
1197 do j = 1, this%ngwfnodes(n)
1198 if (this%ieqn(n) /= 0)
then
1199 inode = this%get_gwfnode(n, j)
1200 call this%maw_calculate_satcond(n, j, inode)
1207 if (this%iprpak /= 0)
then
1209 if (this%inamedbound /= 0)
then
1210 ntabcols = ntabcols + 1
1212 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1213 trim(adjustl(this%packName))//
') STATIC WELL DATA'
1214 call table_cr(this%inputtab, this%packName, title)
1215 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1217 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1219 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1221 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1222 text =
'WELL BOTTOM'
1223 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1224 text =
'STARTING HEAD'
1225 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1226 text =
'NUMBER OF GWF NODES'
1227 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1228 text =
'CONDUCT. EQUATION'
1229 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1230 if (this%inamedbound /= 0)
then
1232 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1234 do n = 1, this%nmawwells
1235 call this%inputtab%add_term(n)
1236 call this%inputtab%add_term(this%radius(n))
1237 call this%inputtab%add_term(this%area(n))
1238 call this%inputtab%add_term(this%bot(n))
1239 call this%inputtab%add_term(this%strt(n))
1240 call this%inputtab%add_term(this%ngwfnodes(n))
1241 call this%inputtab%add_term(ccond(this%ieqn(n)))
1242 if (this%inamedbound /= 0)
then
1243 call this%inputtab%add_term(this%cmawname(n))
1249 if (this%iprpak /= 0)
then
1251 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1252 trim(adjustl(this%packName))//
') STATIC WELL CONNECTION DATA'
1253 call table_cr(this%inputtab, this%packName, title)
1254 call this%inputtab%table_df(this%maxbound, ntabcols, this%iout)
1256 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1257 text =
'WELL CONNECTION'
1258 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1260 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1261 text =
'TOP OF SCREEN'
1262 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1263 text =
'BOTTOM OF SCREEN'
1264 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1265 text =
'SKIN RADIUS'
1266 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1268 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1270 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1272 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1273 text =
'SATURATED WELL CONDUCT.'
1274 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1277 do n = 1, this%nmawwells
1278 do j = 1, this%ngwfnodes(n)
1279 call this%inputtab%add_term(n)
1280 call this%inputtab%add_term(j)
1281 jpos = this%get_jpos(n, j)
1282 nn = this%get_gwfnode(n, j)
1283 call this%dis%noder_to_string(nn, nodestr)
1284 call this%inputtab%add_term(nodestr)
1285 call this%inputtab%add_term(this%topscrn(jpos))
1286 call this%inputtab%add_term(this%botscrn(jpos))
1287 if (this%ieqn(n) == 2 .or. &
1288 this%ieqn(n) == 3 .or. &
1289 this%ieqn(n) == 4)
then
1290 call this%inputtab%add_term(this%sradius(jpos))
1291 call this%inputtab%add_term(this%hk(jpos))
1293 call this%inputtab%add_term(
' ')
1294 call this%inputtab%add_term(
' ')
1296 if (this%ieqn(n) == 1 .or. &
1297 this%ieqn(n) == 2 .or. &
1298 this%ieqn(n) == 3)
then
1299 k11 = this%gwfk11(nn)
1300 if (this%gwfik22 == 0)
then
1301 k22 = this%gwfk11(nn)
1303 k22 = this%gwfk22(nn)
1305 call this%inputtab%add_term(k11)
1306 call this%inputtab%add_term(k22)
1308 call this%inputtab%add_term(
' ')
1309 call this%inputtab%add_term(
' ')
1311 call this%inputtab%add_term(this%satcond(jpos))
1317 this%gwfk11 => null()
1318 this%gwfk22 => null()
1319 this%gwfik22 => null()
1320 this%gwfsat => null()
1334 class(
mawtype),
intent(inout) :: this
1335 integer(I4B),
intent(in) :: imaw
1336 integer(I4B),
intent(inout) :: iheadlimit_warning
1338 character(len=LINELENGTH) :: errmsgr
1339 character(len=LINELENGTH) :: text
1340 character(len=LINELENGTH) :: cstr
1341 character(len=LINELENGTH) :: caux
1342 character(len=LINELENGTH) :: keyword
1346 real(DP),
pointer :: bndElem => null()
1347 integer(I4B) :: istat
1349 character(len=*),
parameter :: fmthdbot = &
1350 &
"('well head (',G0,') must be >= BOTTOM_ELEVATION (',G0, ').')"
1353 call this%parser%GetStringCaps(keyword)
1354 select case (keyword)
1356 call this%parser%GetStringCaps(text)
1357 this%status(imaw) = text(1:8)
1360 this%iboundpak(imaw) = -1
1362 this%iboundpak(imaw) = 0
1364 this%iboundpak(imaw) = 1
1367 'Unknown '//trim(this%text)//
" maw status keyword: '", &
1372 call this%parser%GetString(text)
1374 bndelem => this%rate(imaw)
1376 this%packName,
'BND', this%tsManager, &
1377 this%iprpak,
'RATE')
1379 call this%parser%GetString(text)
1381 bndelem => this%well_head(imaw)
1383 this%packName,
'BND', this%tsManager, &
1384 this%iprpak,
'WELL_HEAD')
1387 this%xnewpak(imaw) = this%well_head(imaw)
1390 if (this%well_head(imaw) < this%bot(imaw))
then
1391 write (cstr, fmthdbot) &
1392 this%well_head(imaw), this%bot(imaw)
1393 call this%maw_set_attribute_error(imaw,
'WELL HEAD', trim(cstr))
1395 case (
'FLOWING_WELL')
1396 this%fwelev(imaw) = this%parser%GetDouble()
1397 this%fwcond(imaw) = this%parser%GetDouble()
1398 this%fwrlen(imaw) = this%parser%GetDouble()
1402 if (this%iflowingwells == 0)
then
1403 this%iflowingwells = -1
1404 text =
'Flowing well data is specified in the '//trim(this%packName)// &
1405 ' package but FLOWING_WELL was not specified in the '// &
1409 case (
'RATE_SCALING')
1410 rval = this%parser%GetDouble()
1411 this%pumpelev(imaw) = rval
1412 rval = this%parser%GetDouble()
1413 this%reduction_length(imaw) = rval
1414 if (rval <
dzero)
then
1415 call this%maw_set_attribute_error(imaw, trim(keyword), &
1416 'must be greater than or equal to 0.')
1419 call this%parser%GetString(text)
1420 if (trim(text) ==
'OFF')
then
1421 this%shutofflevel(imaw) =
dep20
1423 read (text, *, iostat=istat, iomsg=errmsgr) &
1424 this%shutofflevel(imaw)
1425 if (istat /= 0)
then
1426 errmsg =
'Could not read HEAD_LIMIT value. '//trim(errmsgr)
1429 if (this%shutofflevel(imaw) <= this%bot(imaw))
then
1430 iheadlimit_warning = iheadlimit_warning + 1
1434 rval = this%parser%GetDouble()
1435 this%shutoffmin(imaw) = rval
1436 rval = this%parser%GetDouble()
1437 this%shutoffmax(imaw) = rval
1439 call this%parser%GetStringCaps(caux)
1440 do jj = 1, this%naux
1441 if (trim(adjustl(caux)) /= trim(adjustl(this%auxname(jj)))) cycle
1442 call this%parser%GetString(text)
1444 bndelem => this%mauxvar(jj, ii)
1446 this%packName,
'AUX', &
1447 this%tsManager, this%iprpak, &
1453 'Unknown '//trim(this%text)//
" maw data keyword: '", &
1465 class(
mawtype),
intent(inout) :: this
1466 integer(I4B),
intent(in) :: imaw
1467 character(len=*),
intent(in) :: keyword
1468 character(len=*),
intent(in) :: msg
1472 if (len(msg) == 0)
then
1473 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1474 keyword,
' for MAW well', imaw,
'has already been set.'
1476 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1477 keyword,
' for MAW well', imaw, msg
1487 class(
mawtype),
intent(inout) :: this
1489 character(len=LINELENGTH) :: cgwfnode
1493 integer(I4B) :: jpos
1497 do n = 1, this%nmawwells
1498 if (this%ngwfnodes(n) < 1)
then
1499 call this%maw_set_attribute_error(n,
'NGWFNODES',
'must be greater '// &
1502 if (this%radius(n) ==
dep20)
then
1503 call this%maw_set_attribute_error(n,
'RADIUS',
'has not been specified.')
1505 if (this%shutoffmin(n) >
dzero)
then
1506 if (this%shutoffmin(n) >= this%shutoffmax(n))
then
1507 call this%maw_set_attribute_error(n,
'SHUT_OFF',
'shutoffmax must '// &
1508 'be greater than shutoffmin.')
1511 do j = 1, this%ngwfnodes(n)
1514 jpos = this%get_jpos(n, j)
1517 write (cgwfnode,
'(a,i0,a)')
'gwfnode(', j,
')'
1520 if (this%botscrn(jpos) >= this%topscrn(jpos))
then
1521 call this%maw_set_attribute_error(n,
'SCREEN_TOP',
'screen bottom '// &
1522 'must be less than screen top. '// &
1527 if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
1528 this%ieqn(n) == 4)
then
1529 if (this%hk(jpos) <=
dzero)
then
1530 call this%maw_set_attribute_error(n,
'HK_SKIN',
'skin hyraulic '// &
1531 'conductivity must be greater '// &
1532 'than zero. '//trim(cgwfnode))
1534 else if (this%ieqn(n) == 0)
then
1537 if (this%satcond(jpos) <
dzero)
then
1538 call this%maw_set_attribute_error(n,
'HK_SKIN', &
1539 'skin hyraulic conductivity '// &
1540 'must be greater than or '// &
1541 'equal to zero when using '// &
1542 'SPECIFIED condeqn. '// &
1558 class(
mawtype),
intent(inout) :: this
1559 integer(I4B),
intent(in) :: moffset
1565 integer(I4B) :: jglo
1566 integer(I4B) :: nglo
1570 do n = 1, this%nmawwells
1571 nglo = moffset + this%dis%nodes + this%ioffset + n
1572 call sparse%addconnection(nglo, nglo, 1)
1573 do j = 1, this%ngwfnodes(n)
1574 jj = this%get_gwfnode(n, j)
1576 call sparse%addconnection(nglo, jglo, 1)
1577 call sparse%addconnection(jglo, nglo, 1)
1589 class(
mawtype),
intent(inout) :: this
1590 integer(I4B),
intent(in) :: moffset
1596 integer(I4B) :: iglo
1597 integer(I4B) :: jglo
1598 integer(I4B) :: ipos
1602 call mem_allocate(this%idxlocnode, this%nmawwells,
'IDXLOCNODE', &
1604 call mem_allocate(this%idxdglo, this%maxbound,
'IDXDGLO', this%memoryPath)
1605 call mem_allocate(this%idxoffdglo, this%maxbound,
'IDXOFFDGLO', &
1607 call mem_allocate(this%idxsymdglo, this%maxbound,
'IDXSYMDGLO', &
1609 call mem_allocate(this%idxsymoffdglo, this%maxbound,
'IDXSYMOFFDGLO', &
1617 do n = 1, this%nmawwells
1618 iglo = moffset + this%dis%nodes + this%ioffset + n
1619 this%idxlocnode(n) = this%dis%nodes + this%ioffset + n
1620 do ii = 1, this%ngwfnodes(n)
1621 j = this%get_gwfnode(n, ii)
1623 this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
1624 this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
1630 do n = 1, this%nmawwells
1631 do ii = 1, this%ngwfnodes(n)
1632 iglo = this%get_gwfnode(n, ii) + moffset
1633 jglo = moffset + this%dis%nodes + this%ioffset + n
1634 this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
1635 this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
1650 class(
mawtype),
intent(inout) :: this
1651 character(len=*),
intent(inout) :: option
1652 logical,
intent(inout) :: found
1654 character(len=MAXCHARLEN) :: fname, keyword
1656 character(len=*),
parameter :: fmtflowingwells = &
1657 &
"(4x, 'FLOWING WELLS WILL BE SIMULATED.')"
1658 character(len=*),
parameter :: fmtshutdown = &
1659 &
"(4x, 'SHUTDOWN ', a, ' VALUE (',g15.7,') SPECIFIED.')"
1660 character(len=*),
parameter :: fmtnostoragewells = &
1661 &
"(4x, 'WELL STORAGE WILL NOT BE SIMULATED.')"
1662 character(len=*),
parameter :: fmtmawbin = &
1663 "(4x, 'MAW ', 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, /4x, &
1664 &'OPENED ON UNIT: ', I0)"
1668 select case (option)
1671 write (this%iout,
'(4x,a)') &
1672 trim(adjustl(this%text))//
' heads will be printed to listing file.'
1674 call this%parser%GetStringCaps(keyword)
1675 if (keyword ==
'FILEOUT')
then
1676 call this%parser%GetString(fname)
1678 call openfile(this%iheadout, this%iout, fname,
'DATA(BINARY)', &
1680 write (this%iout, fmtmawbin)
'HEAD', trim(adjustl(fname)), &
1683 call store_error(
'Optional maw stage keyword must be '// &
1684 'followed by fileout.')
1687 call this%parser%GetStringCaps(keyword)
1688 if (keyword ==
'FILEOUT')
then
1689 call this%parser%GetString(fname)
1691 call openfile(this%ibudgetout, this%iout, fname,
'DATA(BINARY)', &
1693 write (this%iout, fmtmawbin)
'BUDGET', trim(adjustl(fname)), &
1696 call store_error(
'Optional maw budget keyword must be '// &
1697 'followed by fileout.')
1700 call this%parser%GetStringCaps(keyword)
1701 if (keyword ==
'FILEOUT')
then
1702 call this%parser%GetString(fname)
1704 call openfile(this%ibudcsv, this%iout, fname,
'CSV', &
1705 filstat_opt=
'REPLACE')
1706 write (this%iout, fmtmawbin)
'BUDGET CSV', trim(adjustl(fname)), &
1709 call store_error(
'OPTIONAL BUDGETCSV KEYWORD MUST BE FOLLOWED BY &
1712 case (
'FLOWING_WELLS')
1713 this%iflowingwells = 1
1714 write (this%iout, fmtflowingwells)
1715 case (
'SHUTDOWN_THETA')
1716 this%theta = this%parser%GetDouble()
1717 write (this%iout, fmtshutdown)
'THETA', this%theta
1718 case (
'SHUTDOWN_KAPPA')
1719 this%kappa = this%parser%GetDouble()
1720 write (this%iout, fmtshutdown)
'KAPPA', this%kappa
1723 write (this%iout,
'(4x,A)')
'MOVER OPTION ENABLED'
1724 case (
'NO_WELL_STORAGE')
1726 write (this%iout, fmtnostoragewells)
1727 case (
'FLOW_CORRECTION')
1728 this%correct_flow = .true.
1729 write (this%iout,
'(4x,a,/,4x,a)') &
1730 'MAW-GWF FLOW CORRECTIONS WILL BE APPLIED WHEN MAW HEADS ARE BELOW', &
1731 'OR GWF HEADS IN CONNECTED CELLS ARE BELOW THE CELL BOTTOM.'
1732 case (
'MAW_FLOW_REDUCE_CSV')
1733 call this%parser%GetStringCaps(keyword)
1734 if (keyword ==
'FILEOUT')
then
1735 call this%parser%GetString(fname)
1736 call this%maw_redflow_csv_init(fname)
1738 call store_error(
'OPTIONAL MAW_FLOW_REDUCE_CSV KEYWORD MUST BE &
1739 &FOLLOWED BY FILEOUT')
1746 case (
'DEV_PEACEMAN_EFFECTIVE_RADIUS')
1747 call this%parser%DevOpt()
1749 write (this%iout,
'(4x,a)') &
1750 'EFFECTIVE RADIUS FOR STRUCTURED GRIDS WILL BE CALCULATED &
1751 &USING PEACEMAN 1983'
1765 class(
mawtype),
intent(inout) :: this
1769 call this%obs%obs_ar()
1772 if (this%inewton > 0)
then
1773 this%satomega =
dem6
1777 call this%maw_allocate_arrays()
1780 call this%read_initial_attr()
1783 if (this%imover /= 0)
then
1784 allocate (this%pakmvrobj)
1785 call this%pakmvrobj%ar(this%nmawwells, this%nmawwells, this%memoryPath)
1797 class(
mawtype),
intent(inout) :: this
1799 character(len=LINELENGTH) :: title
1800 character(len=LINELENGTH) :: line
1801 character(len=LINELENGTH) :: text
1802 character(len=16) :: csteady
1804 logical :: endOfBlock
1805 integer(I4B) :: ierr
1806 integer(I4B) :: node
1808 integer(I4B) :: ntabcols
1809 integer(I4B) :: ntabrows
1810 integer(I4B) :: imaw
1811 integer(I4B) :: ibnd
1813 integer(I4B) :: jpos
1814 integer(I4B) :: iheadlimit_warning
1816 character(len=*),
parameter :: fmtblkerr = &
1817 &
"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
1818 character(len=*),
parameter :: fmtlsp = &
1819 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
1822 iheadlimit_warning = 0
1825 this%imawiss = this%gwfiss
1828 if (this%imawissopt == 1)
then
1833 this%nbound = this%maxbound
1837 if (this%inunit == 0)
return
1840 if (this%ionper <
kper)
then
1843 call this%parser%GetBlock(
'PERIOD', isfound, ierr, &
1844 supportopenclose=.true., &
1845 blockrequired=.false.)
1849 call this%read_check_ionper()
1855 this%ionper =
nper + 1
1858 call this%parser%GetCurrentLine(line)
1859 write (
errmsg, fmtblkerr) adjustl(trim(line))
1866 if (this%ionper ==
kper)
then
1869 if (this%iprpak /= 0)
then
1872 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1873 trim(adjustl(this%packName))//
') DATA FOR PERIOD'
1874 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
1875 call table_cr(this%inputtab, this%packName, title)
1876 call this%inputtab%table_df(1, 5, this%iout, finalize=.false.)
1878 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1880 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1882 write (text,
'(a,1x,i6)')
'VALUE', n
1883 call this%inputtab%initialize_column(text, 15, alignment=tabcenter)
1890 call this%parser%GetNextLine(endofblock)
1891 if (endofblock)
exit
1893 imaw = this%parser%GetInteger()
1894 if (imaw < 1 .or. imaw > this%nmawwells)
then
1895 write (
errmsg,
'(2(a,1x),i0,a)') &
1896 'IMAW must be greater than 0 and', &
1897 'less than or equal to ', this%nmawwells,
'.'
1903 call this%maw_set_stressperiod(imaw, iheadlimit_warning)
1906 if (this%iprpak /= 0)
then
1907 call this%parser%GetCurrentLine(line)
1908 call this%inputtab%line_to_columns(line)
1911 if (this%iprpak /= 0)
then
1912 call this%inputtab%finalize_table()
1917 write (this%iout, fmtlsp) trim(this%filtyp)
1921 if (iheadlimit_warning > 0)
then
1922 write (
warnmsg,
'(a,a,a,1x,a,1x,a)') &
1923 "HEAD_LIMIT in '", trim(this%packName),
"' was below the well bottom", &
1924 "for one or more multi-aquifer well(s). This may result in", &
1925 "convergence failures for some models."
1931 call this%parser%StoreErrorUnit()
1935 if (this%check_attr /= 0)
then
1936 call this%maw_check_attributes()
1939 if (this%iprpak == 1)
then
1940 if (this%imawiss /= 0)
then
1941 csteady =
'STEADY-STATE '
1943 csteady =
'TRANSIENT '
1947 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1948 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
1949 ' RATE DATA FOR PERIOD'
1950 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
1952 call table_cr(this%inputtab, this%packName, title)
1953 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1955 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1957 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1959 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1960 text =
'SPECIFIED HEAD'
1961 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1962 text =
'PUMP ELEVATION'
1963 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1964 text =
'REDUCTION LENGTH'
1965 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1966 do n = 1, this%nmawwells
1967 call this%inputtab%add_term(n)
1968 call this%inputtab%add_term(this%status(n))
1969 call this%inputtab%add_term(this%rate(n))
1970 if (this%iboundpak(n) < 0)
then
1971 call this%inputtab%add_term(this%well_head(n))
1973 call this%inputtab%add_term(
' ')
1975 call this%inputtab%add_term(this%pumpelev(n))
1976 if (this%reduction_length(n) /= dep20)
then
1977 call this%inputtab%add_term(this%reduction_length(n))
1979 call this%inputtab%add_term(
' ')
1984 if (this%iflowingwells > 0)
then
1987 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1988 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
1989 ' FLOWING WELL DATA FOR PERIOD'
1990 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
1993 do n = 1, this%nmawwells
1994 if (this%fwcond(n) > dzero)
then
1995 ntabrows = ntabrows + 1
1998 if (ntabrows > 0)
then
1999 call table_cr(this%inputtab, this%packName, title)
2000 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2002 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2004 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2006 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2007 text =
'REDUCTION LENGTH'
2008 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2009 do n = 1, this%nmawwells
2010 if (this%fwcond(n) > dzero)
then
2011 call this%inputtab%add_term(n)
2012 call this%inputtab%add_term(this%fwelev(n))
2013 call this%inputtab%add_term(this%fwcond(n))
2014 call this%inputtab%add_term(this%fwrlen(n))
2021 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2022 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2023 ' WELL SHUTOFF DATA FOR PERIOD'
2024 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2027 do n = 1, this%nmawwells
2028 if (this%shutofflevel(n) /= dep20)
then
2029 ntabrows = ntabrows + 1
2032 if (ntabrows > 0)
then
2033 call table_cr(this%inputtab, this%packName, title)
2034 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2036 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2038 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2040 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2042 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2043 do n = 1, this%nmawwells
2044 if (this%shutofflevel(n) /= dep20)
then
2045 call this%inputtab%add_term(n)
2046 call this%inputtab%add_term(this%shutofflevel(n))
2047 call this%inputtab%add_term(this%shutoffmin(n))
2048 call this%inputtab%add_term(this%shutoffmax(n))
2057 do n = 1, this%nmawwells
2058 do j = 1, this%ngwfnodes(n)
2059 jpos = this%get_jpos(n, j)
2060 node = this%get_gwfnode(n, j)
2061 this%nodelist(ibnd) = node
2062 this%bound(1, ibnd) = this%xnewpak(n)
2063 this%bound(2, ibnd) = this%satcond(jpos)
2064 this%bound(3, ibnd) = this%botscrn(jpos)
2065 if (this%iboundpak(n) > 0)
then
2066 this%bound(4, ibnd) = this%rate(n)
2068 this%bound(4, ibnd) = dzero
2085 integer(I4B) :: ibnd
2088 call this%TsManager%ad()
2093 if (this%naux > 0)
then
2095 do n = 1, this%nmawwells
2096 do j = 1, this%ngwfnodes(n)
2097 do jj = 1, this%naux
2098 if (this%noupdateauxvar(jj) /= 0) cycle
2099 this%auxvar(jj, ibnd) = this%mauxvar(jj, n)
2107 do n = 1, this%nmawwells
2108 this%xoldpak(n) = this%xnewpak(n)
2109 this%xoldsto(n) = this%xsto(n)
2110 if (this%iboundpak(n) < 0)
then
2111 this%xnewpak(n) = this%well_head(n)
2117 if (
kper == 1 .and.
kstp == 1)
then
2118 do n = 1, this%nmawwells
2119 if (this%fwcond(n) >
dzero)
then
2120 if (this%xoldsto(n) > this%fwelev(n))
then
2121 this%xoldsto(n) = this%fwelev(n)
2128 this%ishutoffcnt = 0
2131 if (this%imover == 1)
then
2132 call this%pakmvrobj%ad()
2138 call this%obs%obs_ad()
2151 call this%maw_cfupdate()
2156 subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln)
2161 real(DP),
dimension(:),
intent(inout) :: rhs
2162 integer(I4B),
dimension(:),
intent(in) :: ia
2163 integer(I4B),
dimension(:),
intent(in) :: idxglo
2169 integer(I4B) :: iloc
2170 integer(I4B) :: isymloc
2171 integer(I4B) :: igwfnode
2172 integer(I4B) :: iposd
2173 integer(I4B) :: iposoffd
2174 integer(I4B) :: isymnode
2175 integer(I4B) :: ipossymd
2176 integer(I4B) :: ipossymoffd
2177 integer(I4B) :: jpos
2178 integer(I4B) :: icflow
2193 if (this%imover == 1)
then
2194 call this%pakmvrobj%fc()
2199 do n = 1, this%nmawwells
2200 iloc = this%idxlocnode(n)
2203 if (this%iboundpak(n) < 0)
then
2204 this%xnewpak(n) = this%well_head(n)
2206 hmaw = this%xnewpak(n)
2209 if (this%iboundpak(n) == 0)
then
2210 this%ratesim(n) =
dzero
2212 call this%maw_calculate_wellq(n, hmaw, rate)
2213 this%ratesim(n) = rate
2214 rhs(iloc) = rhs(iloc) - rate
2217 iposd = this%idxdglo(idx)
2222 if (this%iflowingwells > 0)
then
2223 if (this%fwcond(n) >
dzero)
then
2225 tp = bt + this%fwrlen(n)
2227 cfw = scale * this%fwcond(n)
2228 this%ifwdischarge(n) = 0
2229 if (cfw >
dzero)
then
2230 this%ifwdischarge(n) = 1
2233 this%fwcondsim(n) = cfw
2234 call matrix_sln%add_value_pos(iposd, -cfw)
2235 rhs(iloc) = rhs(iloc) - cfw * bt
2236 ratefw = cfw * (bt - hmaw)
2241 if (this%imawiss /= 1)
then
2242 if (this%ifwdischarge(n) /= 1)
then
2243 call matrix_sln%add_value_pos(iposd, -this%area(n) /
delt)
2244 rhs(iloc) = rhs(iloc) - (this%area(n) * this%xoldsto(n) /
delt)
2246 cterm = this%xoldsto(n) - this%fwelev(n)
2247 rhs(iloc) = rhs(iloc) - (this%area(n) * cterm /
delt)
2253 if (this%imover == 1)
then
2254 rhs(iloc) = rhs(iloc) - this%pakmvrobj%get_qfrommvr(n)
2258 call this%pakmvrobj%accumulate_qformvr(n, -rate)
2262 call this%pakmvrobj%accumulate_qformvr(n, -ratefw)
2268 do j = 1, this%ngwfnodes(n)
2269 if (this%iboundpak(n) /= 0)
then
2270 jpos = this%get_jpos(n, j)
2271 igwfnode = this%get_gwfnode(n, j)
2272 hgwf = this%xnew(igwfnode)
2275 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2277 this%simcond(jpos) = cmaw
2280 iposd = this%idxdglo(idx)
2281 iposoffd = this%idxoffdglo(idx)
2282 call matrix_sln%add_value_pos(iposd, -term)
2283 call matrix_sln%set_value_pos(iposoffd, term)
2286 rhs(iloc) = rhs(iloc) - cterm
2289 isymnode = this%get_gwfnode(n, j)
2290 isymloc = ia(isymnode)
2291 ipossymd = this%idxsymdglo(idx)
2292 ipossymoffd = this%idxsymoffdglo(idx)
2293 call matrix_sln%add_value_pos(ipossymd, -term)
2294 call matrix_sln%set_value_pos(ipossymoffd, term)
2297 rhs(isymnode) = rhs(isymnode) + cterm
2308 subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln)
2311 real(DP),
dimension(:),
intent(inout) :: rhs
2312 integer(I4B),
dimension(:),
intent(in) :: ia
2313 integer(I4B),
dimension(:),
intent(in) :: idxglo
2319 integer(I4B) :: iloc
2320 integer(I4B) :: isymloc
2321 integer(I4B) :: igwfnode
2322 integer(I4B) :: iposd
2323 integer(I4B) :: iposoffd
2324 integer(I4B) :: isymnode
2325 integer(I4B) :: ipossymd
2326 integer(I4B) :: ipossymoffd
2327 integer(I4B) :: jpos
2328 integer(I4B) :: icflow
2349 do n = 1, this%nmawwells
2350 iloc = this%idxlocnode(n)
2351 hmaw = this%xnewpak(n)
2354 if (this%iboundpak(n) /= 0)
then
2355 iposd = this%idxdglo(idx)
2358 rate = this%ratesim(n)
2361 call this%maw_calculate_wellq(n, hmaw +
dem4, rate2)
2362 drterm = (rate2 - rate) /
dem4
2365 call matrix_sln%add_value_pos(iposd, drterm)
2366 rhs(iloc) = rhs(iloc) + drterm * hmaw
2369 if (this%iflowingwells > 0)
then
2370 if (this%fwcond(n) >
dzero)
then
2372 tp = bt + this%fwrlen(n)
2374 cfw = scale * this%fwcond(n)
2375 this%ifwdischarge(n) = 0
2376 if (cfw >
dzero)
then
2377 this%ifwdischarge(n) = 1
2379 this%fwcondsim(n) = cfw
2380 rate = cfw * (bt - hmaw)
2386 drterm = -(cfw + this%fwcond(n) * derv * (hmaw - bt))
2389 call matrix_sln%add_value_pos(iposd, &
2390 -this%fwcond(n) * derv * (hmaw - bt))
2391 rhs(iloc) = rhs(iloc) - rterm + drterm * hmaw
2398 do j = 1, this%ngwfnodes(n)
2399 if (this%iboundpak(n) /= 0)
then
2400 jpos = this%get_jpos(n, j)
2401 igwfnode = this%get_gwfnode(n, j)
2402 hgwf = this%xnew(igwfnode)
2405 iposd = this%idxdglo(idx)
2406 iposoffd = this%idxoffdglo(idx)
2409 isymnode = this%get_gwfnode(n, j)
2410 isymloc = ia(isymnode)
2411 ipossymd = this%idxsymdglo(idx)
2412 ipossymoffd = this%idxsymoffdglo(idx)
2415 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2419 if (hmaw > hgwf)
then
2420 if (icflow /= 0)
then
2421 rhsterm = term2 * hgwf + term * hmaw
2422 rhs(iloc) = rhs(iloc) + rhsterm
2423 rhs(isymnode) = rhs(isymnode) - rhsterm
2424 if (this%iboundpak(n) > 0)
then
2425 call matrix_sln%add_value_pos(iposd, term)
2426 call matrix_sln%add_value_pos(iposoffd, term2)
2428 call matrix_sln%add_value_pos(ipossymd, -term2)
2429 call matrix_sln%add_value_pos(ipossymoffd, -term)
2431 rhs(iloc) = rhs(iloc) + term * hmaw
2432 rhs(isymnode) = rhs(isymnode) - term * hmaw
2433 call matrix_sln%add_value_pos(iposd, term)
2434 if (this%ibound(igwfnode) > 0)
then
2435 call matrix_sln%add_value_pos(ipossymoffd, -term)
2441 if (icflow /= 0)
then
2442 rhsterm = term2 * hmaw + term * hgwf
2443 rhs(iloc) = rhs(iloc) + rhsterm
2444 rhs(isymnode) = rhs(isymnode) - rhsterm
2445 if (this%iboundpak(n) > 0)
then
2446 call matrix_sln%add_value_pos(iposd, term2)
2447 call matrix_sln%add_value_pos(iposoffd, term)
2449 call matrix_sln%add_value_pos(ipossymd, -term)
2450 call matrix_sln%add_value_pos(ipossymoffd, -term2)
2452 rhs(iloc) = rhs(iloc) + term * hgwf
2453 rhs(isymnode) = rhs(isymnode) - term * hgwf
2454 if (this%iboundpak(n) > 0)
then
2455 call matrix_sln%add_value_pos(iposoffd, term)
2457 call matrix_sln%add_value_pos(ipossymd, -term)
2471 subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
2473 class(
mawtype),
intent(inout) :: this
2474 integer(I4B),
intent(in) :: neqpak
2475 real(DP),
dimension(neqpak),
intent(inout) :: x
2476 real(DP),
dimension(neqpak),
intent(in) :: xtemp
2477 real(DP),
dimension(neqpak),
intent(inout) :: dx
2478 integer(I4B),
intent(inout) :: inewtonur
2479 real(DP),
intent(inout) :: dxmax
2480 integer(I4B),
intent(inout) :: locmax
2488 do n = 1, this%nmawwells
2489 if (this%iboundpak(n) < 1) cycle
2494 if (x(n) < botw)
then
2498 if (abs(dxx) > abs(dxmax))
then
2516 class(
mawtype),
intent(inout) :: this
2517 real(DP),
dimension(:),
intent(in) :: x
2518 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
2519 integer(I4B),
optional,
intent(in) :: iadv
2525 integer(I4B) :: ibnd
2533 call this%maw_cfupdate()
2537 call this%BndType%bnd_cq(x, flowja, iadv=1)
2540 do n = 1, this%nmawwells
2541 this%qout(n) = dzero
2542 this%qsto(n) = dzero
2543 if (this%iflowingwells > 0)
then
2546 if (this%iboundpak(n) == 0)
then
2551 hmaw = this%xnewpak(n)
2555 rrate = this%ratesim(n)
2558 if (rrate < dzero)
then
2559 this%qout(n) = rrate
2563 if (this%iflowingwells > 0)
then
2564 if (this%fwcond(n) > dzero)
then
2565 cfw = this%fwcondsim(n)
2566 this%xsto(n) = this%fwelev(n)
2567 rrate = cfw * (this%fwelev(n) - hmaw)
2571 this%qout(n) = this%qout(n) + rrate
2576 if (this%imawiss /= 1)
then
2577 rrate = -this%area(n) * (this%xsto(n) - this%xoldsto(n)) /
delt
2578 this%qsto(n) = rrate
2584 do n = 1, this%nmawwells
2585 hmaw = this%xnewpak(n)
2586 this%qconst(n) = dzero
2587 do j = 1, this%ngwfnodes(n)
2588 rrate = -this%simvals(ibnd)
2589 this%qleak(ibnd) = rrate
2590 if (this%iboundpak(n) < 0)
then
2591 this%qconst(n) = this%qconst(n) - rrate
2594 if (-rrate < dzero)
then
2595 this%qout(n) = this%qout(n) - rrate
2604 if (this%iboundpak(n) < 0)
then
2607 this%qconst(n) = this%qconst(n) - this%ratesim(n)
2610 if (this%iflowingwells > 0)
then
2611 this%qconst(n) = this%qconst(n) - this%qfw(n)
2615 if (this%imawiss /= 1)
then
2616 this%qconst(n) = this%qconst(n) - this%qsto(n)
2622 call this%maw_fill_budobj()
2630 integer(I4B),
intent(in) :: icbcfl
2631 integer(I4B),
intent(in) :: ibudfl
2632 integer(I4B),
intent(in) :: icbcun
2633 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
2636 call this%BndType%bnd_ot_model_flows(icbcfl, ibudfl, icbcun, this%imap)
2644 integer(I4B),
intent(in) :: icbcfl
2645 integer(I4B),
intent(in) :: ibudfl
2646 integer(I4B) :: ibinun
2650 if (this%ibudgetout /= 0)
then
2651 ibinun = this%ibudgetout
2653 if (icbcfl == 0) ibinun = 0
2654 if (ibinun > 0)
then
2655 call this%budobj%save_flows(this%dis, ibinun,
kstp,
kper,
delt, &
2660 if (ibudfl /= 0 .and. this%iprflow /= 0)
then
2661 call this%budobj%write_flowtable(this%dis,
kstp,
kper)
2672 integer(I4B),
intent(in) :: idvsave
2673 integer(I4B),
intent(in) :: idvprint
2674 integer(I4B) :: ibinun
2681 if (this%iheadout /= 0)
then
2682 ibinun = this%iheadout
2684 if (idvsave == 0) ibinun = 0
2687 if (ibinun > 0)
then
2688 do n = 1, this%nmawwells
2691 if (this%iboundpak(n) == 0)
then
2693 else if (d <= dzero)
then
2698 call ulasav(this%dbuff,
' HEAD', &
2700 this%nmawwells, 1, 1, ibinun)
2704 if (idvprint /= 0 .and. this%iprhed /= 0)
then
2707 call this%headtab%set_kstpkper(
kstp,
kper)
2710 do n = 1, this%nmawwells
2711 if (this%inamedbound == 1)
then
2712 call this%headtab%add_term(this%cmawname(n))
2714 call this%headtab%add_term(n)
2715 call this%headtab%add_term(this%xnewpak(n))
2727 integer(I4B),
intent(in) :: kstp
2728 integer(I4B),
intent(in) :: kper
2729 integer(I4B),
intent(in) :: iout
2730 integer(I4B),
intent(in) :: ibudfl
2732 call this%budobj%write_budtable(kstp, kper, iout, ibudfl,
totim,
delt)
2745 call this%budobj%budgetobject_da()
2746 deallocate (this%budobj)
2747 nullify (this%budobj)
2750 if (this%iprhed > 0)
then
2751 call this%headtab%table_da()
2752 deallocate (this%headtab)
2753 nullify (this%headtab)
2757 call mem_deallocate(this%cmawbudget,
'CMAWBUDGET', this%memoryPath)
2845 nullify (this%gwfiss)
2848 call this%BndType%bnd_da()
2855 class(
mawtype),
intent(inout) :: this
2858 this%listlabel = trim(this%filtyp)//
' NO.'
2859 if (this%dis%ndim == 3)
then
2860 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
2861 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'ROW'
2862 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'COL'
2863 elseif (this%dis%ndim == 2)
then
2864 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
2865 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'CELL2D'
2867 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'NODE'
2869 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'STRESS RATE'
2870 if (this%inamedbound == 1)
then
2871 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
2883 integer(I4B),
pointer :: neq
2884 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
2885 real(DP),
dimension(:),
pointer,
contiguous :: xnew
2886 real(DP),
dimension(:),
pointer,
contiguous :: xold
2887 real(DP),
dimension(:),
pointer,
contiguous :: flowja
2890 integer(I4B) :: istart, iend
2893 call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja)
2898 istart = this%dis%nodes + this%ioffset + 1
2899 iend = istart + this%nmawwells - 1
2900 this%iboundpak => this%ibound(istart:iend)
2901 this%xnewpak => this%xnew(istart:iend)
2902 call mem_checkin(this%xnewpak,
'HEAD', this%memoryPath,
'X', &
2903 this%memoryPathModel)
2904 call mem_allocate(this%xoldpak, this%nmawwells,
'XOLDPAK', this%memoryPath)
2907 do n = 1, this%nmawwells
2908 this%xnewpak(n) =
dep20
2932 integer(I4B) :: indx
2936 call this%obs%StoreObsType(
'head', .false., indx)
2941 call this%obs%StoreObsType(
'from-mvr', .false., indx)
2946 call this%obs%StoreObsType(
'maw', .true., indx)
2951 call this%obs%StoreObsType(
'rate', .true., indx)
2956 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
2961 call this%obs%StoreObsType(
'fw-rate', .true., indx)
2966 call this%obs%StoreObsType(
'fw-to-mvr', .true., indx)
2971 call this%obs%StoreObsType(
'storage', .true., indx)
2976 call this%obs%StoreObsType(
'constant', .true., indx)
2981 call this%obs%StoreObsType(
'conductance', .true., indx)
2986 call this%obs%StoreObsType(
'fw-conductance', .true., indx)
3002 integer(I4B) :: jpos
3010 if (this%obs%npakobs > 0)
then
3011 call this%obs%obs_bd_clear()
3012 do i = 1, this%obs%npakobs
3013 obsrv => this%obs%pakobs(i)%obsrv
3014 do j = 1, obsrv%indxbnds_count
3016 jj = obsrv%indxbnds(j)
3017 select case (obsrv%ObsTypeId)
3019 if (this%iboundpak(jj) /= 0)
then
3020 v = this%xnewpak(jj)
3023 if (this%iboundpak(jj) /= 0)
then
3024 if (this%imover == 1)
then
3025 v = this%pakmvrobj%get_qfrommvr(jj)
3030 if (this%iboundpak(n) /= 0)
then
3034 if (this%iboundpak(jj) /= 0)
then
3035 v = this%ratesim(jj)
3036 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3037 qfact = v / this%qout(jj)
3038 if (this%imover == 1)
then
3039 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3043 case (
'RATE-TO-MVR')
3044 if (this%iboundpak(jj) /= 0)
then
3045 if (this%imover == 1)
then
3046 v = this%ratesim(jj)
3048 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3049 qfact = v / this%qout(jj)
3051 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3058 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3059 hmaw = this%xnewpak(jj)
3060 cmaw = this%fwcondsim(jj)
3061 v = cmaw * (this%fwelev(jj) - hmaw)
3062 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3063 qfact = v / this%qout(jj)
3064 if (this%imover == 1)
then
3065 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3070 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3071 if (this%imover == 1)
then
3072 hmaw = this%xnewpak(jj)
3073 cmaw = this%fwcondsim(jj)
3074 v = cmaw * (this%fwelev(jj) - hmaw)
3076 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3077 qfact = v / this%qout(jj)
3079 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3086 if (this%iboundpak(jj) /= 0 .and. this%imawissopt /= 1)
then
3090 if (this%iboundpak(jj) /= 0)
then
3093 case (
'CONDUCTANCE')
3095 if (this%iboundpak(n) /= 0)
then
3096 nn = jj - this%iaconn(n) + 1
3097 jpos = this%get_jpos(n, nn)
3098 v = this%simcond(jpos)
3100 case (
'FW-CONDUCTANCE')
3101 if (this%iboundpak(jj) /= 0)
then
3102 v = this%fwcondsim(jj)
3105 errmsg =
'Unrecognized observation type: '//trim(obsrv%ObsTypeId)
3108 call this%obs%SaveOneSimval(obsrv, v)
3119 if (this%ioutredflowcsv > 0)
then
3120 call this%maw_redflow_csv_write()
3132 class(
mawtype),
intent(inout) :: this
3140 character(len=LENBOUNDNAME) :: bname
3144 10
format(
'Boundary "', a,
'" for observation "', a, &
3145 '" is invalid in package "', a,
'"')
3148 do i = 1, this%obs%npakobs
3149 obsrv => this%obs%pakobs(i)%obsrv
3152 nn1 = obsrv%NodeNumber
3154 bname = obsrv%FeatureName
3155 if (bname /=
'')
then
3160 if (obsrv%ObsTypeId ==
'MAW' .or. &
3161 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3162 do j = 1, this%nmawwells
3163 do jj = this%iaconn(j), this%iaconn(j + 1) - 1
3164 if (this%boundname(jj) == bname)
then
3166 call obsrv%AddObsIndex(jj)
3171 do j = 1, this%nmawwells
3172 if (this%cmawname(j) == bname)
then
3174 call obsrv%AddObsIndex(j)
3178 if (.not. jfound)
then
3180 trim(bname), trim(obsrv%Name), trim(this%packName)
3185 if (obsrv%indxbnds_count == 0)
then
3186 if (obsrv%ObsTypeId ==
'MAW' .or. &
3187 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3188 nn2 = obsrv%NodeNumber2
3189 j = this%iaconn(nn1) + nn2 - 1
3190 call obsrv%AddObsIndex(j)
3192 call obsrv%AddObsIndex(nn1)
3195 errmsg =
'Programming error in maw_rp_obs'
3202 if (obsrv%ObsTypeId ==
'HEAD')
then
3203 if (obsrv%indxbnds_count > 1)
then
3204 write (
errmsg,
'(a,3(1x,a))') &
3205 trim(adjustl(obsrv%ObsTypeId)), &
3206 'for observation', trim(adjustl(obsrv%Name)), &
3207 'must be assigned to a multi-aquifer well with a unique boundname.'
3213 if (obsrv%ObsTypeId ==
'MAW' .or. &
3214 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3215 do j = 1, obsrv%indxbnds_count
3216 nn1 = obsrv%indxbnds(j)
3218 nn2 = nn1 - this%iaconn(n) + 1
3219 jj = this%iaconn(n + 1) - this%iaconn(n)
3220 if (nn1 < 1 .or. nn1 > this%maxbound)
then
3221 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3222 trim(adjustl(obsrv%ObsTypeId)), &
3223 'multi-aquifer well connection number must be greater than 0', &
3224 'and less than', jj,
'(specified value is ', nn2,
').'
3229 do j = 1, obsrv%indxbnds_count
3230 nn1 = obsrv%indxbnds(j)
3231 if (nn1 < 1 .or. nn1 > this%nmawwells)
then
3232 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3233 trim(adjustl(obsrv%ObsTypeId)), &
3234 'multi-aquifer well must be greater than 0 ', &
3235 'and less than or equal to', this%nmawwells, &
3236 '(specified value is ', nn1,
').'
3261 integer(I4B),
intent(in) :: inunitobs
3262 integer(I4B),
intent(in) :: iout
3264 integer(I4B) :: nn1, nn2
3265 integer(I4B) :: icol, istart, istop
3266 character(len=LINELENGTH) :: string
3267 character(len=LENBOUNDNAME) :: bndname
3270 string = obsrv%IDstring
3278 obsrv%FeatureName = bndname
3280 if (obsrv%ObsTypeId ==
'MAW' .or. &
3281 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3283 if (len_trim(bndname) < 1 .and. nn2 < 0)
then
3284 write (
errmsg,
'(a,1x,a,a,1x,a,1x,a)') &
3285 'For observation type', trim(adjustl(obsrv%ObsTypeId)), &
3286 ', ID given as an integer and not as boundname,', &
3287 'but ID2 (icon) is missing. Either change ID to valid', &
3288 'boundname or supply valid entry for ID2.'
3292 obsrv%FeatureName = bndname
3296 obsrv%NodeNumber2 = nn2
3301 obsrv%NodeNumber = nn1
3311 class(
mawtype),
intent(inout) :: this
3312 character(len=*),
intent(in) :: fname
3314 character(len=*),
parameter :: fmtredflowcsv = &
3315 "(4x, 'MAW REDUCED FLOW INFORMATION WILL BE SAVED TO FILE: ', a, /4x, &
3316 &'OPENED ON UNIT: ', I0)"
3318 this%ioutredflowcsv =
getunit()
3319 call openfile(this%ioutredflowcsv, this%iout, fname,
'CSV', &
3320 filstat_opt=
'REPLACE')
3321 write (this%iout, fmtredflowcsv) trim(adjustl(fname)), &
3323 write (this%ioutredflowcsv,
'(a)') &
3324 'time,period,step,MAWnumber,rate-requested,rate-actual,maw-reduction'
3333 class(
mawtype),
intent(inout) :: this
3340 do n = 1, this%nmawwells
3343 if (this%status(n) .ne.
'ACTIVE')
then
3346 v = this%rate(n) - this%ratesim(n)
3347 if (abs(v) >
dem9)
then
3348 write (this%ioutredflowcsv,
'(*(G0,:,","))') &
3359 class(
mawtype),
intent(inout) :: this
3360 integer(I4B),
intent(in) :: i
3361 integer(I4B),
intent(in) :: j
3362 integer(I4B),
intent(in) :: node
3364 integer(I4B) :: iTcontrastErr
3365 integer(I4B) :: jpos
3369 real(DP) :: sqrtk11k22
3377 real(DP) :: Tcontrast
3402 jpos = this%get_jpos(i, j)
3405 k11 = this%gwfk11(node)
3406 if (this%gwfik22 == 0)
then
3407 k22 = this%gwfk11(node)
3409 k22 = this%gwfk22(node)
3411 sqrtk11k22 = sqrt(k11 * k22)
3414 gwftop = this%dis%top(node)
3415 gwfbot = this%dis%bot(node)
3416 tthka = gwftop - gwfbot
3417 gwfsat = this%gwfsat(node)
3421 topw = this%topscrn(jpos)
3422 botw = this%botscrn(jpos)
3426 if (gwftop == topw .and. gwfbot == botw)
then
3427 if (this%icelltype(node) == 0)
then
3428 tthkw = tthkw * gwfsat
3429 tthka = tthka * gwfsat
3434 t2pi =
dtwopi * tthka * sqrtk11k22
3437 if (this%dis%ndim == 3 .and. this%ieffradopt /= 0)
then
3440 dx = sqrt(this%dis%area(node))
3444 eradius = 0.28_dp * ((yx4 * dx)**
dtwo + &
3447 area = this%dis%area(node)
3453 if (this%ieqn(i) == 1 .or. this%ieqn(i) == 3)
then
3454 lc1 = log(eradius / this%radius(i)) / t2pi
3458 if (this%ieqn(i) == 2 .or. this%ieqn(i) == 3)
then
3460 if (tthkw * hks >
dzero)
then
3461 tcontrast = (sqrtk11k22 * tthka) / (hks * tthkw)
3462 skin = (tcontrast -
done) * log(this%sradius(jpos) / this%radius(i))
3469 if (tcontrast <= 1 .and. this%ieqn(i) == 2)
then
3471 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
3472 'Invalid calculated transmissivity contrast (', tcontrast, &
3473 ') for maw well', i,
'connection', j,
'.',
'This happens when the', &
3474 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
3475 'Consider decreasing HK_SKIN for the connection or using the', &
3476 'CUMULATIVE or MEAN conductance equations.'
3485 if (this%ieqn(i) == 4)
then
3487 ravg =
dhalf * (this%radius(i) + this%sradius(jpos))
3488 slen = this%sradius(jpos) - this%radius(i)
3490 c = hks * pavg * tthkw / slen
3495 if (this%ieqn(i) < 4)
then
3496 if (lc1 + lc2 /=
dzero)
then
3497 c =
done / (lc1 + lc2)
3505 if (c <
dzero .and. itcontrasterr == 0)
then
3506 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
3507 'Invalid calculated negative conductance (', c, &
3508 ') for maw well', i,
'connection', j,
'.',
'this happens when the', &
3509 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
3510 'consider decreasing hk_skin for the connection or using the', &
3511 'mean conductance equation.'
3516 this%satcond(jpos) = c
3523 class(
mawtype),
intent(inout) :: this
3524 integer(I4B),
intent(in) :: n
3525 integer(I4B),
intent(in) :: j
3526 integer(I4B),
intent(in) :: node
3527 real(DP),
intent(inout) :: sat
3529 integer(I4B) :: jpos
3540 if (this%icelltype(node) /= 0)
then
3543 hwell = this%xnewpak(n)
3546 jpos = this%get_jpos(n, j)
3549 topw = this%topscrn(jpos)
3550 botw = this%botscrn(jpos)
3553 if (this%inewton /= 1)
then
3554 h_temp = this%xnew(node)
3555 if (h_temp < botw)
then
3558 if (hwell < botw)
then
3561 h_temp =
dhalf * (h_temp + hwell)
3563 h_temp = this%xnew(node)
3564 if (hwell > h_temp)
then
3567 if (h_temp < botw)
then
3594 integer(I4B),
intent(in) :: n
3595 integer(I4B),
intent(in) :: j
3596 integer(I4B),
intent(inout) :: icflow
3597 real(DP),
intent(inout) :: cmaw
3598 real(DP),
intent(inout) :: cterm
3599 real(DP),
intent(inout) :: term
3600 real(DP),
intent(inout) :: flow
3601 real(DP),
intent(inout),
optional :: term2
3603 logical(LGP) :: correct_flow
3604 integer(I4B) :: inewton
3605 integer(I4B) :: jpos
3606 integer(I4B) :: igwfnode
3617 real(DP) :: dhbarterm
3618 real(DP) :: vscratio
3624 if (
present(term2))
then
3631 jpos = this%get_jpos(n, j)
3632 igwfnode = this%get_gwfnode(n, j)
3633 hgwf = this%xnew(igwfnode)
3634 hmaw = this%xnewpak(n)
3635 tmaw = this%topscrn(jpos)
3636 bmaw = this%botscrn(jpos)
3639 if (this%ivsc == 1)
then
3642 vscratio = this%viscratios(1, igwfnode)
3644 vscratio = this%viscratios(2, igwfnode)
3649 call this%maw_calculate_saturation(n, j, igwfnode, sat)
3650 cmaw = this%satcond(jpos) * vscratio * sat
3653 if (inewton == 1)
then
3657 if (hgwf > hups)
then
3668 if (this%correct_flow)
then
3671 en = max(bmaw, this%dis%bot(igwfnode))
3672 correct_flow = .false.
3674 correct_flow = .true.
3676 if (hgwf < en .and. this%icelltype(igwfnode) /= 0)
then
3677 correct_flow = .true.
3682 if (correct_flow)
then
3684 hdowns = min(hmaw, hgwf)
3686 if (hgwf > hmaw)
then
3687 cterm = cmaw * (hmaw - hbar)
3689 cterm = cmaw * (hbar - hgwf)
3694 if (inewton /= 0)
then
3697 if (hmaw > hgwf)
then
3699 term = drterm * this%satcond(jpos) * vscratio * (hbar - hmaw)
3701 term2 = cmaw * (dhbarterm -
done)
3706 term = -drterm * this%satcond(jpos) * vscratio * (hgwf - hbar)
3708 term2 = cmaw * (
done - dhbarterm)
3714 if (inewton /= 0)
then
3715 term = drterm * this%satcond(jpos) * vscratio * (hgwf - hmaw)
3721 if (inewton == 0)
then
3722 flow = term * (hgwf - hmaw) + cterm
3726 if (this%idense /= 0 .and. inewton == 0)
then
3727 call this%maw_calculate_density_exchange(jpos, hmaw, hgwf, cmaw, &
3728 bmaw, flow, term, cterm)
3737 integer(I4B),
intent(in) :: n
3738 real(DP),
intent(in) :: hmaw
3739 real(DP),
intent(inout) :: q
3756 if (rate <
dzero)
then
3761 if (this%shutofflevel(n) /=
dep20)
then
3762 call this%maw_calculate_qpot(n, q)
3764 if (q > -rate) q = -rate
3766 if (this%ishutoffcnt == 1)
then
3767 this%shutoffweight(n) =
done
3768 this%shutoffdq(n) =
dzero
3769 this%shutoffqold(n) = q
3772 dq = q - this%shutoffqold(n)
3773 weight = this%shutoffweight(n)
3776 if (this%shutoffdq(n) * dq <
dzero)
then
3777 weight = this%theta * this%shutoffweight(n)
3781 weight = this%shutoffweight(n) + this%kappa
3785 q = this%shutoffqold(n) + weight * dq
3787 this%shutoffqold(n) = q
3788 this%shutoffdq(n) = dq
3789 this%shutoffweight(n) = weight
3793 if (this%shutoffmin(n) >
dzero)
then
3794 if (hmaw < this%shutofflevel(n))
then
3798 if (this%ishutoff(n) /= 0)
then
3805 if (q < this%shutoffmin(n))
then
3806 if (this%ishutoffcnt > 2)
then
3807 this%ishutoff(n) = 1
3818 if (q > this%shutoffmax(n))
then
3819 if (this%ishutoffcnt <= 2)
then
3820 this%ishutoff(n) = 0
3823 if (this%ishutoff(n) /= 0)
then
3829 if (q /=
dzero) q = -q
3838 if (this%reduction_length(n) /=
dep20)
then
3839 bt = this%pumpelev(n)
3840 tp = bt + this%reduction_length(n)
3850 if (this%shutofflevel(n) /=
dep20)
then
3851 call this%maw_calculate_qpot(n, q)
3854 if (q > rate) q = rate
3856 if (this%ishutoffcnt == 1)
then
3857 this%shutoffweight(n) =
done
3858 this%shutoffdq(n) =
dzero
3859 this%shutoffqold(n) = q
3862 dq = q - this%shutoffqold(n)
3863 weight = this%shutoffweight(n)
3866 if (this%shutoffdq(n) * dq <
dzero)
then
3867 weight = this%theta * this%shutoffweight(n)
3871 weight = this%shutoffweight(n) + this%kappa
3875 q = this%shutoffqold(n) + weight * dq
3877 this%shutoffqold(n) = q
3878 this%shutoffdq(n) = dq
3879 this%shutoffweight(n) = weight
3887 if (this%reduction_length(n) /=
dep20)
then
3888 bt = this%pumpelev(n)
3889 tp = bt + this%reduction_length(n)
3902 class(
mawtype),
intent(inout) :: this
3903 integer(I4B),
intent(in) :: n
3904 real(DP),
intent(inout) :: qnet
3907 integer(I4B) :: jpos
3908 integer(I4B) :: igwfnode
3920 real(DP) :: vscratio
3926 h_temp = this%shutofflevel(n)
3929 if (this%ivsc == 1)
then
3932 vscratio = this%viscratios(1, igwfnode)
3934 vscratio = this%viscratios(2, igwfnode)
3939 if (this%iflowingwells > 0)
then
3940 if (this%fwcond(n) >
dzero)
then
3942 tp = bt + this%fwrlen(n)
3944 cfw = scale * this%fwcond(n) * this%viscratios(2, n)
3945 this%ifwdischarge(n) = 0
3946 if (cfw >
dzero)
then
3947 this%ifwdischarge(n) = 1
3950 qnet = qnet + cfw * (bt - h_temp)
3955 if (this%imawiss /= 1)
then
3956 if (this%ifwdischarge(n) /= 1)
then
3957 hdterm = this%xoldsto(n) - h_temp
3959 hdterm = this%xoldsto(n) - this%fwelev(n)
3961 qnet = qnet - (this%area(n) * hdterm /
delt)
3965 do j = 1, this%ngwfnodes(n)
3966 jpos = this%get_jpos(n, j)
3967 igwfnode = this%get_gwfnode(n, j)
3968 call this%maw_calculate_saturation(n, j, igwfnode, sat)
3969 cmaw = this%satcond(jpos) * vscratio * sat
3970 hgwf = this%xnew(igwfnode)
3971 bmaw = this%botscrn(jpos)
3976 if (hgwf < bmaw)
then
3979 qnet = qnet + cmaw * (hgwf - hv)
3991 integer(I4B) :: jpos
3992 integer(I4B) :: icflow
3993 integer(I4B) :: ibnd
4001 if (this%nbound .eq. 0)
return
4004 this%ishutoffcnt = this%ishutoffcnt + 1
4008 do n = 1, this%nmawwells
4009 hmaw = this%xnewpak(n)
4010 do j = 1, this%ngwfnodes(n)
4011 jpos = this%get_jpos(n, j)
4012 this%hcof(ibnd) =
dzero
4013 this%rhs(ibnd) =
dzero
4019 if (this%iboundpak(n) == 0)
then
4024 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, &
4027 this%simcond(jpos) = cmaw
4028 this%bound(2, ibnd) = cmaw
4029 this%hcof(ibnd) = -term
4030 this%rhs(ibnd) = -term * hmaw + cterm
4048 integer(I4B) :: nbudterm
4049 integer(I4B) :: n, j, n2
4051 integer(I4B) :: maxlist, naux
4053 character(len=LENBUDTXT) :: text
4054 character(len=LENBUDTXT),
dimension(1) :: auxtxt
4060 if (this%iflowingwells > 0)
then
4061 nbudterm = nbudterm + 1
4063 if (this%imover == 1)
then
4064 nbudterm = nbudterm + 3
4065 if (this%iflowingwells > 0)
then
4066 nbudterm = nbudterm + 1
4069 if (this%naux > 0) nbudterm = nbudterm + 1
4073 call this%budobj%budgetobject_df(this%nmawwells, nbudterm, 0, 0, &
4074 ibudcsv=this%ibudcsv)
4082 maxlist = this%maxbound
4084 auxtxt(1) =
' FLOW-AREA'
4085 call this%budobj%budterm(idx)%initialize(text, &
4090 maxlist, .false., .true., &
4092 call this%budobj%budterm(idx)%reset(this%maxbound)
4094 do n = 1, this%nmawwells
4095 do j = 1, this%ngwfnodes(n)
4096 n2 = this%get_gwfnode(n, j)
4097 call this%budobj%budterm(idx)%update_term(n, n2, q)
4104 maxlist = this%nmawwells
4106 call this%budobj%budterm(idx)%initialize(text, &
4111 maxlist, .false., .false., &
4115 if (this%iflowingwells > 0)
then
4118 maxlist = this%nmawwells
4120 call this%budobj%budterm(idx)%initialize(text, &
4125 maxlist, .false., .false., &
4132 maxlist = this%nmawwells
4134 auxtxt(1) =
' VOLUME'
4135 call this%budobj%budterm(idx)%initialize(text, &
4140 maxlist, .false., .true., &
4146 maxlist = this%nmawwells
4148 call this%budobj%budterm(idx)%initialize(text, &
4153 maxlist, .false., .false., &
4157 if (this%imover == 1)
then
4162 maxlist = this%nmawwells
4164 call this%budobj%budterm(idx)%initialize(text, &
4169 maxlist, .false., .false., &
4173 text =
' RATE-TO-MVR'
4175 maxlist = this%nmawwells
4177 call this%budobj%budterm(idx)%initialize(text, &
4182 maxlist, .false., .false., &
4186 text =
' CONSTANT-TO-MVR'
4188 maxlist = this%nmawwells
4190 call this%budobj%budterm(idx)%initialize(text, &
4195 maxlist, .false., .false., &
4199 if (this%iflowingwells > 0)
then
4202 text =
' FW-RATE-TO-MVR'
4204 maxlist = this%nmawwells
4206 call this%budobj%budterm(idx)%initialize(text, &
4211 maxlist, .false., .false., &
4223 maxlist = this%maxbound
4224 call this%budobj%budterm(idx)%initialize(text, &
4229 maxlist, .false., .false., &
4234 if (this%iprflow /= 0)
then
4235 call this%budobj%flowtable_df(this%iout)
4249 integer(I4B) :: naux
4253 integer(I4B) :: jpos
4255 integer(I4B) :: ibnd
4271 call this%budobj%budterm(idx)%reset(this%maxbound)
4273 do n = 1, this%nmawwells
4274 do j = 1, this%ngwfnodes(n)
4275 jpos = this%get_jpos(n, j)
4276 n2 = this%get_gwfnode(n, j)
4277 tmaw = this%topscrn(jpos)
4278 bmaw = this%botscrn(jpos)
4279 call this%maw_calculate_saturation(n, j, n2, sat)
4280 this%qauxcbc(1) =
dtwo *
dpi * this%radius(n) * sat * (tmaw - bmaw)
4281 q = this%qleak(ibnd)
4282 call this%budobj%budterm(idx)%update_term(n, n2, q, this%qauxcbc)
4289 call this%budobj%budterm(idx)%reset(this%nmawwells)
4290 do n = 1, this%nmawwells
4294 if (this%imover == 1 .and. q <
dzero)
then
4296 if (this%qout(n) <
dzero)
then
4297 qfact = q / this%qout(n)
4299 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4301 call this%budobj%budterm(idx)%update_term(n, n, q)
4305 if (this%iflowingwells > 0)
then
4307 call this%budobj%budterm(idx)%reset(this%nmawwells)
4308 do n = 1, this%nmawwells
4310 if (this%imover == 1)
then
4314 if (this%qout(n) <
dzero)
then
4315 qfact = q / this%qout(n)
4317 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4319 call this%budobj%budterm(idx)%update_term(n, n, q)
4325 call this%budobj%budterm(idx)%reset(this%nmawwells)
4326 do n = 1, this%nmawwells
4327 b = this%xsto(n) - this%bot(n)
4331 v = this%area(n) * b
4332 if (this%imawissopt /= 1)
then
4338 call this%budobj%budterm(idx)%update_term(n, n, q, this%qauxcbc)
4343 call this%budobj%budterm(idx)%reset(this%nmawwells)
4344 do n = 1, this%nmawwells
4348 if (this%imover == 1 .and. q <
dzero)
then
4350 if (this%qout(n) <
dzero)
then
4351 qfact = q / this%qout(n)
4353 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4355 call this%budobj%budterm(idx)%update_term(n, n, q)
4359 if (this%imover == 1)
then
4363 call this%budobj%budterm(idx)%reset(this%nmawwells)
4364 do n = 1, this%nmawwells
4365 if (this%iboundpak(n) == 0)
then
4368 q = this%pakmvrobj%get_qfrommvr(n)
4370 call this%budobj%budterm(idx)%update_term(n, n, q)
4375 call this%budobj%budterm(idx)%reset(this%nmawwells)
4376 do n = 1, this%nmawwells
4377 q = this%pakmvrobj%get_qtomvr(n)
4380 q2 = this%ratesim(n)
4383 if (q2 <
dzero)
then
4384 qfact = q2 / this%qout(n)
4390 call this%budobj%budterm(idx)%update_term(n, n, q)
4395 call this%budobj%budterm(idx)%reset(this%nmawwells)
4396 do n = 1, this%nmawwells
4397 q = this%pakmvrobj%get_qtomvr(n)
4402 if (q2 <
dzero)
then
4403 qfact = q2 / this%qout(n)
4409 call this%budobj%budterm(idx)%update_term(n, n, q)
4413 if (this%iflowingwells > 0)
then
4415 call this%budobj%budterm(idx)%reset(this%nmawwells)
4416 do n = 1, this%nmawwells
4417 q = this%pakmvrobj%get_qtomvr(n)
4420 q2 = this%ratesim(n)
4424 if (this%qout(n) <
dzero)
then
4425 qfact = this%qfw(n) / this%qout(n)
4429 call this%budobj%budterm(idx)%update_term(n, n, q)
4439 call this%budobj%budterm(idx)%reset(this%nmawwells)
4440 do n = 1, this%nmawwells
4442 call this%budobj%budterm(idx)%update_term(n, n, q, this%auxvar(:, n))
4447 call this%budobj%accumulate_terms()
4461 integer(I4B) :: nterms
4462 character(len=LINELENGTH) :: title
4463 character(len=LINELENGTH) :: text
4466 if (this%iprhed > 0)
then
4470 if (this%inamedbound == 1) nterms = nterms + 1
4473 title = trim(adjustl(this%text))//
' PACKAGE ('// &
4474 trim(adjustl(this%packName))//
') HEADS FOR EACH CONTROL VOLUME'
4477 call table_cr(this%headtab, this%packName, title)
4478 call this%headtab%table_df(this%nmawwells, nterms, this%iout, &
4482 if (this%inamedbound == 1)
then
4484 call this%headtab%initialize_column(text, 20, alignment=tableft)
4489 call this%headtab%initialize_column(text, 10, alignment=tabcenter)
4493 call this%headtab%initialize_column(text, 12, alignment=tabcenter)
4501 integer(I4B) :: jpos
4504 integer(I4B),
intent(in) :: n
4505 integer(I4B),
intent(in) :: j
4509 jpos = this%iaconn(n) + j - 1
4516 integer(I4B) :: igwfnode
4519 integer(I4B),
intent(in) :: n
4520 integer(I4B),
intent(in) :: j
4522 integer(I4B) :: jpos
4525 jpos = this%get_jpos(n, j)
4526 igwfnode = this%gwfnodes(jpos)
4533 class(
mawtype),
intent(inout) :: this
4535 integer(I4B) :: i, j
4540 call mem_reallocate(this%denseterms, 3, this%MAXBOUND,
'DENSETERMS', &
4542 do i = 1, this%maxbound
4544 this%denseterms(j, i) =
dzero
4547 write (this%iout,
'(/1x,a)')
'DENSITY TERMS HAVE BEEN ACTIVATED FOR MAW &
4548 &PACKAGE: '//trim(adjustl(this%packName))
4559 class(
mawtype),
intent(inout) :: this
4566 call mem_reallocate(this%viscratios, 2, this%MAXBOUND,
'VISCRATIOS', &
4568 do i = 1, this%maxbound
4570 this%viscratios(j, i) =
done
4573 write (this%iout,
'(/1x,a)')
'VISCOSITY HAS BEEN ACTIVATED FOR MAW &
4574 &PACKAGE: '//trim(adjustl(this%packName))
4600 bmaw, flow, hcofterm, rhsterm)
4602 class(
mawtype),
intent(inout) :: this
4603 integer(I4B),
intent(in) :: iconn
4604 real(DP),
intent(in) :: hmaw
4605 real(DP),
intent(in) :: hgwf
4606 real(DP),
intent(in) :: cond
4607 real(DP),
intent(in) :: bmaw
4608 real(DP),
intent(inout) :: flow
4609 real(DP),
intent(inout) :: hcofterm
4610 real(DP),
intent(inout) :: rhsterm
4614 real(DP) :: rdensemaw
4615 real(DP) :: rdensegwf
4616 real(DP) :: rdenseavg
4621 rdensemaw = this%denseterms(1, iconn)
4622 rdensegwf = this%denseterms(2, iconn)
4623 if (rdensegwf ==
dzero)
return
4626 if (hmaw > bmaw .and. hgwf > bmaw)
then
4629 rdenseavg =
dhalf * (rdensemaw + rdensegwf)
4632 t = cond * (rdenseavg -
done) * (hgwf - hmaw)
4633 rhsterm = rhsterm + t
4637 havg =
dhalf * (hgwf + hmaw)
4638 elevavg = this%denseterms(3, iconn)
4639 t = cond * (havg - elevavg) * (rdensegwf - rdensemaw)
4640 rhsterm = rhsterm + t
4642 else if (hmaw > bmaw)
then
4645 t = (rdensemaw -
done) * rhsterm
4646 rhsterm = rhsterm + t
4648 else if (hgwf > bmaw)
then
4651 t = (rdensegwf -
done) * rhsterm
4652 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.