40 character(len=LENFTYPE) ::
ftype =
'MAW'
41 character(len=LENPACKAGENAME) ::
text =
' MAW'
53 character(len=LENBUDTXT),
dimension(:),
pointer, &
54 contiguous :: cmawbudget => null()
55 character(len=LENAUXNAME),
dimension(:),
pointer, &
56 contiguous :: cauxcbc => null()
59 logical(LGP),
pointer :: correct_flow => null()
62 integer(I4B),
pointer :: iprhed => null()
63 integer(I4B),
pointer :: iheadout => null()
64 integer(I4B),
pointer :: ibudgetout => null()
65 integer(I4B),
pointer :: ibudcsv => null()
66 integer(I4B),
pointer :: cbcauxitems => null()
67 integer(I4B),
pointer :: iflowingwells => null()
68 integer(I4B),
pointer :: imawiss => null()
69 integer(I4B),
pointer :: imawissopt => null()
70 integer(I4B),
pointer :: nmawwells => null()
71 integer(I4B),
pointer :: check_attr => null()
72 integer(I4B),
pointer :: ishutoffcnt => null()
73 integer(I4B),
pointer :: ieffradopt => null()
74 integer(I4B),
pointer :: inonvert => null()
75 integer(I4B),
pointer :: ioutredflowcsv => null()
76 real(dp),
pointer :: satomega => null()
79 real(dp),
pointer :: theta => null()
80 real(dp),
pointer :: kappa => null()
83 character(len=8),
dimension(:),
pointer,
contiguous :: status => null()
84 integer(I4B),
dimension(:),
pointer,
contiguous :: ngwfnodes => null()
85 integer(I4B),
dimension(:),
pointer,
contiguous :: ieqn => null()
86 integer(I4B),
dimension(:),
pointer,
contiguous :: ishutoff => null()
87 integer(I4B),
dimension(:),
pointer,
contiguous :: ifwdischarge => null()
88 real(dp),
dimension(:),
pointer,
contiguous :: strt => null()
89 real(dp),
dimension(:),
pointer,
contiguous :: radius => null()
90 real(dp),
dimension(:),
pointer,
contiguous :: area => null()
91 real(dp),
dimension(:),
pointer,
contiguous :: pumpelev => null()
92 real(dp),
dimension(:),
pointer,
contiguous :: bot => null()
93 real(dp),
dimension(:),
pointer,
contiguous :: ratesim => null()
94 real(dp),
dimension(:),
pointer,
contiguous :: qsim0 => null()
95 real(dp),
dimension(:),
pointer,
contiguous :: reduction_length => null()
96 real(dp),
dimension(:),
pointer,
contiguous :: fwelev => null()
97 real(dp),
dimension(:),
pointer,
contiguous :: fwcond => null()
98 real(dp),
dimension(:),
pointer,
contiguous :: fwrlen => null()
99 real(dp),
dimension(:),
pointer,
contiguous :: fwcondsim => null()
100 real(dp),
dimension(:),
pointer,
contiguous :: xsto => null()
101 real(dp),
dimension(:),
pointer,
contiguous :: xoldsto => null()
102 real(dp),
dimension(:),
pointer,
contiguous :: shutoffmin => null()
103 real(dp),
dimension(:),
pointer,
contiguous :: shutoffmax => null()
104 real(dp),
dimension(:),
pointer,
contiguous :: shutofflevel => null()
105 real(dp),
dimension(:),
pointer,
contiguous :: shutoffweight => null()
106 real(dp),
dimension(:),
pointer,
contiguous :: shutoffdq => null()
107 real(dp),
dimension(:),
pointer,
contiguous :: shutoffqold => null()
108 real(dp),
dimension(:),
pointer,
contiguous :: nurdxold => null()
109 real(dp),
dimension(:),
pointer,
contiguous :: nurweight => null()
110 character(len=LENBOUNDNAME),
dimension(:),
pointer, &
111 contiguous :: cmawname => null()
114 real(dp),
dimension(:),
pointer,
contiguous :: rate => null()
115 real(dp),
dimension(:),
pointer,
contiguous :: well_head => null()
116 real(dp),
dimension(:, :),
pointer,
contiguous :: mauxvar => null()
119 integer(I4B),
dimension(:),
pointer,
contiguous :: iaconn => null()
122 integer(I4B),
dimension(:),
pointer,
contiguous :: gwfnodes => null()
123 real(dp),
dimension(:),
pointer,
contiguous :: sradius => null()
124 real(dp),
dimension(:),
pointer,
contiguous :: hk => null()
125 real(dp),
dimension(:),
pointer,
contiguous :: satcond => null()
126 real(dp),
dimension(:),
pointer,
contiguous :: simcond => null()
127 real(dp),
dimension(:),
pointer,
contiguous :: topscrn => null()
128 real(dp),
dimension(:),
pointer,
contiguous :: botscrn => null()
129 real(dp),
dimension(:),
pointer,
contiguous :: angle => null()
130 real(dp),
dimension(:),
pointer,
contiguous :: connlen => null()
131 real(dp),
dimension(:),
pointer,
contiguous :: usrtopscrn => null()
132 real(dp),
dimension(:),
pointer,
contiguous :: usrbotscrn => null()
135 integer(I4B),
dimension(:),
pointer,
contiguous :: imap => null()
138 real(dp),
dimension(:),
pointer,
contiguous :: qauxcbc => null()
139 real(dp),
dimension(:),
pointer,
contiguous :: dbuff => null()
140 real(dp),
dimension(:),
pointer,
contiguous :: qleak => null()
141 real(dp),
dimension(:),
pointer,
contiguous :: qout => null()
142 real(dp),
dimension(:),
pointer,
contiguous :: qfw => null()
143 real(dp),
dimension(:),
pointer,
contiguous :: qsto => null()
144 real(dp),
dimension(:),
pointer,
contiguous :: qconst => null()
147 integer(I4B),
pointer :: bditems => null()
154 integer(I4B),
pointer :: gwfiss => null()
155 real(dp),
dimension(:),
pointer,
contiguous :: gwfk11 => null()
156 real(dp),
dimension(:),
pointer,
contiguous :: gwfk22 => null()
157 integer(I4B),
pointer :: gwfik22 => null()
158 real(dp),
dimension(:),
pointer,
contiguous :: gwfsat => null()
161 integer(I4B),
dimension(:),
pointer,
contiguous :: idxlocnode => null()
162 integer(I4B),
dimension(:),
pointer,
contiguous :: idxdglo => null()
163 integer(I4B),
dimension(:),
pointer,
contiguous :: idxoffdglo => null()
164 integer(I4B),
dimension(:),
pointer,
contiguous :: idxsymdglo => null()
165 integer(I4B),
dimension(:),
pointer,
contiguous :: idxsymoffdglo => null()
166 integer(I4B),
dimension(:),
pointer,
contiguous :: iboundpak => null()
167 real(dp),
dimension(:),
pointer,
contiguous :: xnewpak => null()
168 real(dp),
dimension(:),
pointer,
contiguous :: xoldpak => null()
171 integer(I4B),
pointer :: idense
172 real(dp),
dimension(:, :),
pointer,
contiguous :: denseterms => null()
175 real(dp),
dimension(:, :),
pointer,
contiguous :: viscratios => null()
248 subroutine maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
250 class(
bndtype),
pointer :: packobj
251 integer(I4B),
intent(in) :: id
252 integer(I4B),
intent(in) :: ibcnum
253 integer(I4B),
intent(in) :: inunit
254 integer(I4B),
intent(in) :: iout
255 character(len=*),
intent(in) :: namemodel
256 character(len=*),
intent(in) :: pakname
257 type(
mawtype),
pointer :: mawobj
264 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
268 call mawobj%maw_allocate_scalars()
271 call packobj%pack_initialize()
273 packobj%inunit = inunit
276 packobj%ibcnum = ibcnum
289 class(
mawtype),
intent(inout) :: this
292 call this%BndType%allocate_scalars()
295 call mem_allocate(this%correct_flow,
'CORRECT_FLOW', this%memoryPath)
296 call mem_allocate(this%iprhed,
'IPRHED', this%memoryPath)
297 call mem_allocate(this%iheadout,
'IHEADOUT', this%memoryPath)
298 call mem_allocate(this%ibudgetout,
'IBUDGETOUT', this%memoryPath)
299 call mem_allocate(this%ibudcsv,
'IBUDCSV', this%memoryPath)
300 call mem_allocate(this%iflowingwells,
'IFLOWINGWELLS', this%memoryPath)
301 call mem_allocate(this%imawiss,
'IMAWISS', this%memoryPath)
302 call mem_allocate(this%imawissopt,
'IMAWISSOPT', this%memoryPath)
303 call mem_allocate(this%nmawwells,
'NMAWWELLS', this%memoryPath)
304 call mem_allocate(this%check_attr,
'CHECK_ATTR', this%memoryPath)
305 call mem_allocate(this%ishutoffcnt,
'ISHUTOFFCNT', this%memoryPath)
306 call mem_allocate(this%ieffradopt,
'IEFFRADOPT', this%memoryPath)
307 call mem_allocate(this%inonvert,
'INONVERT', this%memoryPath)
308 call mem_allocate(this%ioutredflowcsv,
'IOUTREDFLOWCSV', this%memoryPath)
309 call mem_allocate(this%satomega,
'SATOMEGA', this%memoryPath)
310 call mem_allocate(this%bditems,
'BDITEMS', this%memoryPath)
313 call mem_allocate(this%cbcauxitems,
'CBCAUXITEMS', this%memoryPath)
314 call mem_allocate(this%idense,
'IDENSE', this%memoryPath)
317 this%correct_flow = .false.
323 this%iflowingwells = 0
328 this%ioutredflowcsv = 0
329 this%satomega =
dzero
344 class(
mawtype),
intent(inout) :: this
355 this%cmawbudget(1) =
' GWF'
356 this%cmawbudget(2) =
' RATE'
357 this%cmawbudget(3) =
' STORAGE'
358 this%cmawbudget(4) =
' CONSTANT'
359 this%cmawbudget(5) =
' FW-RATE'
360 this%cmawbudget(6) =
' FROM-MVR'
361 this%cmawbudget(7) =
' RATE-TO-MVR'
362 this%cmawbudget(8) =
' FW-RATE-TO-MVR'
367 call mem_allocate(this%status, 8, this%nmawwells,
'STATUS', this%memoryPath)
370 call mem_allocate(this%ngwfnodes, this%nmawwells,
'NGWFNODES', &
372 call mem_allocate(this%ieqn, this%nmawwells,
'IEQN', this%memoryPath)
373 call mem_allocate(this%ishutoff, this%nmawwells,
'ISHUTOFF', this%memoryPath)
374 call mem_allocate(this%ifwdischarge, this%nmawwells,
'IFWDISCHARGE', &
376 call mem_allocate(this%strt, this%nmawwells,
'STRT', this%memoryPath)
377 call mem_allocate(this%radius, this%nmawwells,
'RADIUS', this%memoryPath)
378 call mem_allocate(this%area, this%nmawwells,
'AREA', this%memoryPath)
379 call mem_allocate(this%pumpelev, this%nmawwells,
'PUMPELEV', this%memoryPath)
380 call mem_allocate(this%bot, this%nmawwells,
'BOT', this%memoryPath)
381 call mem_allocate(this%ratesim, this%nmawwells,
'RATESIM', this%memoryPath)
382 call mem_allocate(this%qsim0, this%nmawwells,
'QSIM0', this%memoryPath)
383 call mem_allocate(this%reduction_length, this%nmawwells,
'REDUCTION_LENGTH', &
385 call mem_allocate(this%fwelev, this%nmawwells,
'FWELEV', this%memoryPath)
386 call mem_allocate(this%fwcond, this%nmawwells,
'FWCONDS', this%memoryPath)
387 call mem_allocate(this%fwrlen, this%nmawwells,
'FWRLEN', this%memoryPath)
388 call mem_allocate(this%fwcondsim, this%nmawwells,
'FWCONDSIM', &
390 call mem_allocate(this%xsto, this%nmawwells,
'XSTO', this%memoryPath)
391 call mem_allocate(this%xoldsto, this%nmawwells,
'XOLDSTO', this%memoryPath)
392 call mem_allocate(this%shutoffmin, this%nmawwells,
'SHUTOFFMIN', &
394 call mem_allocate(this%shutoffmax, this%nmawwells,
'SHUTOFFMAX', &
396 call mem_allocate(this%shutofflevel, this%nmawwells,
'SHUTOFFLEVEL', &
398 call mem_allocate(this%shutoffweight, this%nmawwells,
'SHUTOFFWEIGHT', &
400 call mem_allocate(this%shutoffdq, this%nmawwells,
'SHUTOFFDQ', &
402 call mem_allocate(this%shutoffqold, this%nmawwells,
'SHUTOFFQOLD', &
404 call mem_allocate(this%nurdxold, this%nmawwells,
'NURDXOLD', &
406 call mem_allocate(this%nurweight, this%nmawwells,
'NURWEIGHT', &
410 call mem_allocate(this%rate, this%nmawwells,
'RATE', this%memoryPath)
411 call mem_allocate(this%well_head, this%nmawwells,
'WELL_HEAD', &
413 if (this%naux > 0)
then
418 call mem_allocate(this%mauxvar, jj, this%nmawwells,
'MAUXVAR', &
422 if (this%iheadout > 0)
then
423 call mem_allocate(this%dbuff, this%nmawwells,
'DBUFF', this%memoryPath)
425 call mem_allocate(this%dbuff, 0,
'DBUFF', this%memoryPath)
429 call mem_allocate(this%iaconn, this%nmawwells + 1,
'IACONN', this%memoryPath)
432 call mem_allocate(this%imap, this%MAXBOUND,
'IMAP', this%memoryPath)
435 call mem_allocate(this%gwfnodes, this%maxbound,
'GWFNODES', this%memoryPath)
436 call mem_allocate(this%sradius, this%maxbound,
'SRADIUS', this%memoryPath)
437 call mem_allocate(this%hk, this%maxbound,
'HK', this%memoryPath)
438 call mem_allocate(this%satcond, this%maxbound,
'SATCOND', this%memoryPath)
439 call mem_allocate(this%simcond, this%maxbound,
'SIMCOND', this%memoryPath)
440 call mem_allocate(this%topscrn, this%maxbound,
'TOPSCRN', this%memoryPath)
441 call mem_allocate(this%botscrn, this%maxbound,
'BOTSCRN', this%memoryPath)
442 call mem_allocate(this%angle, this%maxbound,
'ANGLE', this%memoryPath)
443 call mem_allocate(this%connlen, this%maxbound,
'CONNLEN', this%memoryPath)
444 call mem_allocate(this%usrtopscrn, this%maxbound,
'USRTOPSCRN', &
446 call mem_allocate(this%usrbotscrn, this%maxbound,
'USRBOTSCRN', &
450 call mem_allocate(this%qleak, this%maxbound,
'QLEAK', this%memoryPath)
453 do n = 1, this%nmawwells
454 this%status(n) =
'ACTIVE'
455 this%ngwfnodes(n) = 0
458 this%ifwdischarge(n) = 0
460 this%radius(n) =
dep20
462 this%pumpelev(n) =
dep20
464 this%ratesim(n) =
dzero
465 this%qsim0(n) =
dzero
466 this%reduction_length(n) =
dep20
467 this%fwelev(n) =
dzero
468 this%fwcond(n) =
dzero
469 this%fwrlen(n) =
dzero
470 this%fwcondsim(n) =
dzero
472 this%xoldsto(n) =
dzero
473 this%shutoffmin(n) =
dzero
474 this%shutoffmax(n) =
dzero
475 this%shutofflevel(n) =
dep20
476 this%shutoffweight(n) =
done
477 this%shutoffdq(n) =
done
478 this%shutoffqold(n) =
done
479 this%nurdxold(n) =
dzero
480 this%nurweight(n) =
done
484 this%well_head(n) =
dzero
485 do jj = 1, max(1, this%naux)
486 this%mauxvar(jj, n) =
dzero
490 if (this%iheadout > 0)
then
491 this%dbuff(n) =
dzero
496 do n = 1, this%nmawwells + 1
505 call mem_allocate(this%qauxcbc, this%cbcauxitems,
'QAUXCBC', this%memoryPath)
506 do j = 1, this%cbcauxitems
507 this%qauxcbc(j) =
dzero
511 if (this%iflowingwells /= 0)
then
512 call mem_allocate(this%qfw, this%nmawwells,
'QFW', this%memoryPath)
516 call mem_allocate(this%qout, this%nmawwells,
'QOUT', this%memoryPath)
517 call mem_allocate(this%qsto, this%nmawwells,
'QSTO', this%memoryPath)
518 call mem_allocate(this%qconst, this%nmawwells,
'QCONST', this%memoryPath)
521 do n = 1, this%nmawwells
522 if (this%iflowingwells > 0)
then
526 this%qconst(n) =
dzero
530 do j = 1, this%maxbound
533 this%sradius(j) =
dzero
535 this%satcond(j) =
dzero
536 this%simcond(j) =
dzero
537 this%topscrn(j) =
dzero
538 this%botscrn(j) =
dzero
539 this%angle(j) =
dzero
540 this%connlen(j) =
dzero
541 this%usrtopscrn(j) =
dzero
542 this%usrbotscrn(j) =
dzero
543 this%qleak(j) =
dzero
547 call mem_allocate(this%denseterms, 3, 0,
'DENSETERMS', this%memoryPath)
550 call mem_allocate(this%viscratios, 2, 0,
'VISCRATIOS', this%memoryPath)
559 class(
mawtype),
intent(inout) :: this
563 call this%BndType%allocate_arrays()
572 class(
mawtype),
intent(inout) :: this
574 character(len=LINELENGTH) :: text
575 character(len=LINELENGTH) :: keyword
576 character(len=LINELENGTH) :: cstr
577 character(len=LENBOUNDNAME) :: bndName
578 character(len=LENBOUNDNAME) :: bndNameTemp
579 character(len=9) :: cno
581 logical :: endOfBlock
592 real(DP),
pointer :: bndElem => null()
594 character(len=LINELENGTH),
dimension(:),
allocatable :: strttext
595 character(len=LENBOUNDNAME),
dimension(:),
allocatable :: nametxt
596 character(len=50),
dimension(:, :),
allocatable :: caux
597 integer(I4B),
dimension(:),
allocatable :: nboundchk
598 integer(I4B),
dimension(:),
allocatable :: wellieqn
599 integer(I4B),
dimension(:),
allocatable :: ngwfnodes
600 real(DP),
dimension(:),
allocatable :: radius
601 real(DP),
dimension(:),
allocatable :: bottom
603 character(len=*),
parameter :: fmthdbot = &
604 "('well head (', G0, ') must be greater than or equal to the &
605 &BOTTOM_ELEVATION (', G0, ').')"
608 allocate (strttext(this%nmawwells))
609 allocate (nametxt(this%nmawwells))
610 if (this%naux > 0)
then
611 allocate (caux(this%naux, this%nmawwells))
613 allocate (nboundchk(this%nmawwells))
614 allocate (wellieqn(this%nmawwells))
615 allocate (ngwfnodes(this%nmawwells))
616 allocate (radius(this%nmawwells))
617 allocate (bottom(this%nmawwells))
620 do n = 1, this%nmawwells
628 this%npakeq = this%nmawwells
632 call this%parser%GetBlock(
'PACKAGEDATA', isfound, ierr, &
633 supportopenclose=.true.)
637 write (this%iout,
'(/1x,a)') &
638 'PROCESSING '//trim(adjustl(this%text))//
' PACKAGEDATA'
640 call this%parser%GetNextLine(endofblock)
642 ival = this%parser%GetInteger()
645 if (n < 1 .or. n > this%nmawwells)
then
646 write (
errmsg,
'(a,1x,i0,a)') &
647 'IMAW must be greater than 0 and less than or equal to', &
654 nboundchk(n) = nboundchk(n) + 1
657 rval = this%parser%GetDouble()
658 if (rval <= dzero)
then
659 write (
errmsg,
'(a,1x,i0,1x,a)') &
660 'Radius for well', n,
'must be greater than zero.'
666 bottom(n) = this%parser%GetDouble()
669 call this%parser%GetString(strttext(n))
672 call this%parser%GetStringCaps(keyword)
673 if (keyword ==
'SPECIFIED')
then
675 else if (keyword ==
'THIEM')
then
677 else if (keyword ==
'THEIM')
then
679 write (
warnmsg,
'(a,a,a,a,a,a)') &
680 "CONDEQN in '", trim(this%packName),
"' should be ", &
681 "corrected from '", trim(keyword),
"' to 'THIEM'."
683 else if (keyword ==
'SKIN')
then
685 else if (keyword ==
'CUMULATIVE')
then
687 else if (keyword ==
'MEAN')
then
690 write (
errmsg,
'(a,1x,i0,1x,a)') &
691 'CONDEQN for well', n, &
692 "must be 'CUMULATIVE', 'THIEM', 'MEAN', or 'SKIN'."
697 ival = this%parser%GetInteger()
700 write (
errmsg,
'(a,1x,i0,1x,a)') &
701 'NGWFNODES for well', n,
'must be greater than zero.'
714 call this%parser%GetString(caux(jj, n))
718 write (cno,
'(i9.9)') n
719 bndname =
'MAWWELL'//cno
722 if (this%inamedbound /= 0)
then
723 call this%parser%GetStringCaps(bndnametemp)
724 if (bndnametemp /=
'')
then
725 bndname = bndnametemp
731 write (this%iout,
'(1x,a)') &
732 'END OF '//trim(adjustl(this%text))//
' PACKAGEDATA'
735 do n = 1, this%nmawwells
736 if (nboundchk(n) == 0)
then
737 write (
errmsg,
'(a,1x,i0,a)')
'No data specified for maw well', n,
'.'
739 else if (nboundchk(n) > 1)
then
740 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
741 'Data for maw well', n,
'specified', nboundchk(n),
'times.'
746 call store_error(
'Required packagedata block not found.')
751 call this%parser%StoreErrorUnit()
756 write (this%iout,
'(//4x,a,i7)')
'MAXBOUND = ', this%maxbound
759 call this%maw_allocate_well_conn_arrays()
762 do n = 1, this%nmawwells
764 this%radius(n) = rval
765 this%area(n) = dpi * rval**dtwo
766 this%bot(n) = bottom(n)
767 this%ieqn(n) = wellieqn(n)
768 this%ngwfnodes(n) = ngwfnodes(n)
769 this%cmawname(n) = nametxt(n)
775 bndelem => this%well_head(n)
777 this%packName,
'BND', this%tsManager, &
778 this%iprpak,
'WELL_HEAD')
781 this%strt(n) = this%well_head(n)
784 if (this%strt(n) < this%bot(n))
then
785 write (cstr, fmthdbot) this%strt(n), this%bot(n)
786 call this%maw_set_attribute_error(n,
'STRT', trim(cstr))
793 bndelem => this%mauxvar(jj, ii)
795 'AUX', this%tsManager, this%iprpak, &
803 do n = 1, this%nmawwells
804 do j = 1, this%ngwfnodes(n)
808 this%iaconn(n + 1) = idx + 1
812 deallocate (strttext)
814 if (this%naux > 0)
then
817 deallocate (nboundchk)
818 deallocate (wellieqn)
819 deallocate (ngwfnodes)
829 class(
mawtype),
intent(inout) :: this
831 character(len=LINELENGTH) :: cellid
832 character(len=30) :: nodestr
834 logical :: endOfBlock
844 integer(I4B) :: ireset_scrntop
845 integer(I4B) :: ireset_scrnbot
846 integer(I4B) :: ireset_wellbot
851 integer(I4B),
dimension(:),
pointer,
contiguous :: nboundchk
852 integer(I4B),
dimension(:),
pointer,
contiguous :: iachk
860 allocate (iachk(this%nmawwells + 1))
862 do n = 1, this%nmawwells
863 iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
865 allocate (nboundchk(this%maxbound))
866 do n = 1, this%maxbound
871 call this%parser%GetBlock(
'CONNECTIONDATA', isfound, ierr, &
872 supportopenclose=.true.)
876 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
879 call this%parser%GetNextLine(endofblock)
883 ival = this%parser%GetInteger()
887 if (n < 1 .or. n > this%nmawwells)
then
888 write (
errmsg,
'(a,1x,i0,a)') &
889 'IMAW must be greater than 0 and less than or equal to ', &
896 ival = this%parser%GetInteger()
897 if (ival < 1 .or. ival > this%ngwfnodes(n))
then
898 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
899 'JCONN for well ', n, &
900 'must be greater than 1 and less than or equal to ', &
901 this%ngwfnodes(n),
'.'
906 ipos = iachk(n) + ival - 1
907 nboundchk(ipos) = nboundchk(ipos) + 1
910 jpos = this%get_jpos(n, ival)
913 call this%parser%GetCellid(this%dis%ndim, cellid)
914 nn = this%dis%noder_from_cellid(cellid, this%inunit, this%iout)
915 topnn = this%dis%top(nn)
916 botnn = this%dis%bot(nn)
920 this%gwfnodes(jpos) = nn
923 rval = this%parser%GetDouble()
926 this%usrtopscrn(jpos) = rval
927 if (this%ieqn(n) /= 4)
then
930 if (rval > topnn)
then
931 ireset_scrntop = ireset_scrntop + 1
935 this%topscrn(jpos) = rval
938 rval = this%parser%GetDouble()
941 this%usrbotscrn(jpos) = rval
942 if (this%ieqn(n) /= 4)
then
945 if (rval < botnn)
then
946 ireset_scrnbot = ireset_scrnbot + 1
950 this%botscrn(jpos) = rval
954 if (rval < botw)
then
955 if (this%ieqn(n) /= 4)
then
956 ireset_wellbot = ireset_wellbot + 1
960 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
961 'Screen bottom for maw well', n,
'connection', j,
'(', &
962 this%botscrn(jpos),
') is less than the well bottom (', &
969 rval = this%parser%GetDouble()
970 if (this%ieqn(n) == 0)
then
971 this%satcond(jpos) = rval
972 else if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
973 this%ieqn(n) == 4)
then
978 rval = this%parser%GetDouble()
979 if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
980 this%ieqn(n) == 4)
then
981 this%sradius(jpos) = rval
982 if (this%sradius(jpos) <= this%radius(n))
then
983 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
984 'Screen radius for maw well', n,
'connection', j,
'(', &
985 this%sradius(jpos), &
986 ') is less than or equal to the well radius (', &
992 write (this%iout,
'(1x,a)') &
993 'END OF '//trim(adjustl(this%text))//
' CONNECTIONDATA'
996 do n = 1, this%nmawwells
997 do j = 1, this%ngwfnodes(n)
1001 if (nboundchk(ipos) == 0)
then
1002 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
1003 'No data specified for maw well', n,
'connection', j,
'.'
1005 else if (nboundchk(ipos) > 1)
then
1006 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,1x,i0,1x,a)') &
1007 'Data for maw well', n,
'connection', j, &
1008 'specified', nboundchk(n),
'times.'
1016 do n = 1, this%nmawwells
1017 if (this%ieqn(n) /= 4)
then
1018 do j = 1, this%ngwfnodes(n)
1019 nn = this%get_gwfnode(n, j)
1020 do jj = 1, this%ngwfnodes(n)
1026 nn2 = this%get_gwfnode(n, jj)
1028 call this%dis%noder_to_string(nn, nodestr)
1029 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,3(1x,a))') &
1030 'Only one connection can be specified for maw well', &
1031 n,
'connection', j,
'to gwf cell', trim(adjustl(nodestr)), &
1032 'unless the mean condeqn is specified.'
1040 call store_error(
'Required connectiondata block not found.')
1045 deallocate (nboundchk)
1048 if (ireset_scrntop > 0)
then
1049 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1050 'The screen tops in multi-aquifer well package', trim(this%packName), &
1051 'were reset to the top of the connected cell', ireset_scrntop,
'times.'
1054 if (ireset_scrnbot > 0)
then
1055 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1056 'The screen bottoms in multi-aquifer well package', trim(this%packName), &
1057 'were reset to the bottom of the connected cell', ireset_scrnbot, &
1061 if (ireset_wellbot > 0)
then
1062 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1063 'The well bottoms in multi-aquifer well package', trim(this%packName), &
1064 'were reset to the bottom of the connected cell', ireset_wellbot, &
1071 call this%parser%StoreErrorUnit()
1089 class(
mawtype),
intent(inout) :: this
1092 logical :: endOfBlock
1093 logical(LGP) :: success
1094 integer(I4B) :: ierr
1095 integer(I4B) :: ival
1098 integer(I4B) :: jpos
1099 integer(I4B) :: ipos
1100 integer(I4B) :: node
1102 real(DP) :: conn_len
1109 character(len=LINELENGTH) :: cndmsg
1110 character(len=LINELENGTH) :: extmsg
1111 logical(LGP) :: estimated
1112 integer(I4B),
dimension(:),
pointer,
contiguous :: nboundchk
1113 integer(I4B),
dimension(:),
pointer,
contiguous :: iachk
1118 real(DP),
parameter :: coszero =
dem6
1120 real(DP),
parameter :: dninety = 9.0d1
1123 call this%parser%GetBlock(
'ANGLEDATA', isfound, ierr, &
1124 supportopenclose=.true., blockrequired=.false.)
1131 if (this%inonvert == 0)
then
1132 call store_error(
'An ANGLEDATA block was specified but the '// &
1133 'NON_VERTICAL_WELLS option was not specified in the '// &
1135 call this%parser%StoreErrorUnit()
1140 allocate (iachk(this%nmawwells + 1))
1142 do n = 1, this%nmawwells
1143 iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
1145 allocate (nboundchk(this%maxbound))
1146 do n = 1, this%maxbound
1150 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1153 call this%parser%GetNextLine(endofblock)
1154 if (endofblock)
exit
1157 ival = this%parser%GetInteger()
1159 if (n < 1 .or. n > this%nmawwells)
then
1160 write (
errmsg,
'(a,1x,i0,a)') &
1161 'IFNO must be greater than 0 and less than or equal to ', &
1168 ival = this%parser%GetInteger()
1169 if (ival < 1 .or. ival > this%ngwfnodes(n))
then
1170 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
1171 'ICON for well ', n, &
1172 'must be greater than 0 and less than or equal to ', &
1173 this%ngwfnodes(n),
'.'
1178 jpos = this%get_jpos(n, j)
1181 ipos = iachk(n) + j - 1
1182 nboundchk(ipos) = nboundchk(ipos) + 1
1183 if (nboundchk(ipos) > 1)
then
1184 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1185 'ANGLEDATA for maw well', n,
'connection', j, &
1186 'is specified more than once.'
1191 angle = this%parser%GetDouble()
1194 call this%parser%TryGetDouble(conn_len, success)
1195 if (.not. success)
then
1200 this%angle(jpos) = angle
1201 this%connlen(jpos) = conn_len
1204 if (angle <
dzero .or. angle > dninety)
then
1205 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1206 'ANGLE for maw well', n,
'connection', j,
'(', angle, &
1207 ') must be greater than or equal to 0.0 and less than or '// &
1208 'equal to 90.0 degrees.'
1213 node = this%get_gwfnode(n, j)
1221 if (this%ieqn(n) == 0)
then
1222 this%topscrn(jpos) = min(this%usrtopscrn(jpos), this%dis%top(node))
1223 this%botscrn(jpos) = max(this%usrbotscrn(jpos), this%dis%bot(node))
1227 dz = this%topscrn(jpos) - this%botscrn(jpos)
1228 if (dz <=
dzero)
then
1229 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1230 'The screen top must be greater than the screen bottom for maw '// &
1231 'well', n,
'connection', j,
'listed in the ANGLEDATA block.'
1241 if (conn_len >
dzero)
then
1243 else if (cos(omega) > coszero)
then
1255 if (this%ieqn(n) /= 0)
then
1256 if (cos(omega) <= coszero .and. conn_len <=
dzero)
then
1257 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1258 'A connection length must be specified for the (near) '// &
1259 'horizontal maw well', n,
'connection', j, &
1260 'listed in the ANGLEDATA block.'
1264 if (lw <=
dzero)
then
1265 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1266 'The calculated in-cell screen length for maw well', n, &
1267 'connection', j,
'(', lw, &
1268 ') is not greater than zero. Specify a connection length in '// &
1269 'the ANGLEDATA block.'
1277 if (lw >
dzero)
then
1278 hlen = lw * sin(omega)
1279 extent = this%maw_cell_extent(node, estimated)
1280 if (hlen > extent)
then
1285 extmsg =
'estimated maximum horizontal extent'
1287 extmsg =
'maximum horizontal extent'
1293 if (this%ieqn(n) == 0)
then
1294 cndmsg =
'The specified saturated conductance is applied to a '// &
1295 'screen that is longer than the cell.'
1297 cndmsg =
'The calculated saturated conductance is '// &
1298 'correspondingly too large.'
1300 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
1301 'The horizontal distance spanned by maw well', n,
'connection', &
1303 ') is greater than the '//trim(extmsg)//
' of the '// &
1304 'connected cell (', extent, &
1305 '), so the screen extends beyond the cell it is connected '// &
1306 'to. '//trim(cndmsg)//
' Reduce ANGLE or CONN_LENGTH, or '// &
1307 'specify a separate connection to each cell the connection '// &
1316 if (cos(omega) <= coszero .and. &
1317 this%ieqn(n) /= 4 .and. this%ieqn(n) /= 0)
then
1318 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1319 'The (near) horizontal maw well', n,
'connection', j, &
1320 'uses a radial conductance equation (THIEM, SKIN, or '// &
1321 'CUMULATIVE). The calculated conductance is an approximation '// &
1322 'for horizontal connections; the MEAN conductance equation is '// &
1323 'recommended for horizontal connections.'
1333 if (cos(omega) <= coszero .and. &
1334 (this%ieqn(n) == 4 .or. this%ieqn(n) == 0))
then
1335 topexp = this%botscrn(jpos) +
dtwo * this%radius(n)
1336 if (
is_close(this%topscrn(jpos), topexp))
then
1337 this%topscrn(jpos) = topexp
1339 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1340 'The vertical screen extent (SCRN_TOP - SCRN_BOT) for the '// &
1341 '(near) horizontal maw well', n,
'connection', j, &
1342 'is not equal to the well diameter (2 * RADIUS = ', &
1343 dtwo * this%radius(n), &
1344 '). The vertical screen extent is used to determine the '// &
1345 'saturation of a connection and should equal the well '// &
1346 'diameter for a horizontal connection.'
1351 write (this%iout,
'(1x,a)') &
1352 'END OF '//trim(adjustl(this%text))//
' ANGLEDATA'
1356 deallocate (nboundchk)
1361 if (this%inonvert /= 0)
then
1363 'The NON_VERTICAL_WELLS option was specified but an ANGLEDATA '// &
1364 'block was not found. All multi-aquifer well connections will be '// &
1365 'treated as vertical.'
1372 call this%parser%StoreErrorUnit()
1384 real(dp),
intent(in) :: dz
1385 real(dp),
intent(in) :: radius
1386 real(dp),
intent(in) :: omega
1390 lw = (dz -
dtwo * radius * sin(omega)) / cos(omega)
1403 class(
mawtype),
intent(inout) :: this
1404 integer(I4B),
intent(in) :: node
1405 logical(LGP),
intent(out) :: estimated
1409 real(dp),
allocatable,
dimension(:, :) :: polyverts
1410 integer(I4B) :: nverts
1415 select case (this%dis%get_dis_enum())
1417 nverts = this%dis%get_npolyverts(node)
1420 estimated = nverts == 0
1422 extent = sqrt(
dtwo * this%dis%area(node))
1424 call this%dis%get_polyverts(node, polyverts)
1426 deallocate (polyverts)
1443 class(
mawtype),
intent(inout) :: this
1444 integer(I4B),
intent(in) :: i
1445 integer(I4B),
intent(in) :: jpos
1455 if (this%angle(jpos) ==
dzero .and. this%connlen(jpos) <=
dzero)
then
1460 dz = this%topscrn(jpos) - this%botscrn(jpos)
1461 if (dz <=
dzero)
then
1467 if (this%connlen(jpos) >
dzero)
then
1468 lw = this%connlen(jpos)
1470 omega = this%angle(jpos) *
dpio180
1482 class(
mawtype),
intent(inout) :: this
1484 character(len=LENBOUNDNAME) :: keyword
1485 integer(I4B) :: ierr
1486 logical :: isfound, endOfBlock
1494 call this%parser%GetBlock(
'DIMENSIONS', isfound, ierr, &
1495 supportopenclose=.true.)
1499 write (this%iout,
'(/1x,a)') &
1500 'PROCESSING '//trim(adjustl(this%text))//
' DIMENSIONS'
1502 call this%parser%GetNextLine(endofblock)
1503 if (endofblock)
exit
1504 call this%parser%GetStringCaps(keyword)
1505 select case (keyword)
1507 this%nmawwells = this%parser%GetInteger()
1508 write (this%iout,
'(4x,a,i0)')
'NMAWWELLS = ', this%nmawwells
1511 'Unknown '//trim(this%text)//
' dimension: ', trim(keyword),
'.'
1515 write (this%iout,
'(1x,a)') &
1516 'END OF '//trim(adjustl(this%text))//
' DIMENSIONS'
1518 call store_error(
'Required dimensions block not found.', terminate=.true.)
1522 if (this%nmawwells < 0)
then
1524 'NMAWWELLS was not specified or was specified incorrectly.'
1530 call this%parser%StoreErrorUnit()
1534 call this%maw_read_wells()
1537 call this%maw_read_well_connections()
1540 call this%maw_read_angledata()
1544 call this%define_listlabel()
1547 call this%maw_setup_budobj()
1550 call this%maw_setup_tableobj()
1560 class(
mawtype),
intent(inout) :: this
1562 character(len=LINELENGTH) :: title
1563 character(len=LINELENGTH) :: text
1564 integer(I4B) :: ntabcols
1568 integer(I4B) :: jpos
1569 integer(I4B) :: inode
1573 character(len=10),
dimension(0:4) :: ccond
1574 character(len=30) :: nodestr
1576 data ccond(0)/
'SPECIFIED '/
1577 data ccond(1)/
'THIEM '/
1578 data ccond(2)/
'SKIN '/
1579 data ccond(3)/
'CUMULATIVE'/
1580 data ccond(4)/
'MEAN '/
1582 character(len=*),
parameter :: fmtwelln = &
1583 "(1X,//43X,'MULTI-AQUIFER WELL DATA'&
1585 &/1X,7(A10,1X),A16)"
1586 character(len=*),
parameter :: fmtwelld = &
1587 &
"(1X,I10,1X,4(G10.3,1X),I10,1X,A10,1X,A16)"
1588 character(len=*),
parameter :: fmtline = &
1590 character(len=*),
parameter :: fmtwellcn = &
1591 "(1X,//37X,'MULTI-AQUIFER WELL CONNECTION DATA'&
1593 &/1X,2(A10,1X),A20,7(A10,1X))"
1594 character(len=*),
parameter :: fmtwellcd = &
1595 &
"(1X,2(I10,1X),A20,1X,2(G10.3,1X),2(A10,1X),3(G10.3,1X))"
1598 do n = 1, this%nmawwells
1599 this%xnewpak(n) = this%strt(n)
1600 this%xsto(n) = this%strt(n)
1604 do n = 1, this%nmawwells
1605 select case (this%status(n))
1607 this%iboundpak(n) = -1
1609 this%iboundpak(n) = 0
1611 this%iboundpak(n) = 1
1616 if (this%inamedbound /= 0)
then
1618 do n = 1, this%nmawwells
1619 do j = 1, this%ngwfnodes(n)
1621 this%boundname(idx) = this%cmawname(n)
1626 do n = 1, this%nmawwells
1627 this%cmawname(n) =
''
1632 call this%copy_boundname()
1642 call this%maw_check_attributes()
1645 do n = 1, this%nmawwells
1649 do j = 1, this%ngwfnodes(n)
1650 if (this%ieqn(n) /= 0)
then
1651 inode = this%get_gwfnode(n, j)
1652 call this%maw_calculate_satcond(n, j, inode)
1659 if (this%iprpak /= 0)
then
1661 if (this%inamedbound /= 0)
then
1662 ntabcols = ntabcols + 1
1664 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1665 trim(adjustl(this%packName))//
') STATIC WELL DATA'
1666 call table_cr(this%inputtab, this%packName, title)
1667 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1669 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1671 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1673 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1674 text =
'WELL BOTTOM'
1675 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1676 text =
'STARTING HEAD'
1677 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1678 text =
'NUMBER OF GWF NODES'
1679 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1680 text =
'CONDUCT. EQUATION'
1681 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1682 if (this%inamedbound /= 0)
then
1684 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1686 do n = 1, this%nmawwells
1687 call this%inputtab%add_term(n)
1688 call this%inputtab%add_term(this%radius(n))
1689 call this%inputtab%add_term(this%area(n))
1690 call this%inputtab%add_term(this%bot(n))
1691 call this%inputtab%add_term(this%strt(n))
1692 call this%inputtab%add_term(this%ngwfnodes(n))
1693 call this%inputtab%add_term(ccond(this%ieqn(n)))
1694 if (this%inamedbound /= 0)
then
1695 call this%inputtab%add_term(this%cmawname(n))
1701 if (this%iprpak /= 0)
then
1703 if (this%inonvert /= 0)
then
1704 ntabcols = ntabcols + 1
1706 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1707 trim(adjustl(this%packName))//
') STATIC WELL CONNECTION DATA'
1708 call table_cr(this%inputtab, this%packName, title)
1709 call this%inputtab%table_df(this%maxbound, ntabcols, this%iout)
1711 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1712 text =
'WELL CONNECTION'
1713 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1715 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1716 text =
'TOP OF SCREEN'
1717 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1718 text =
'BOTTOM OF SCREEN'
1719 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1720 text =
'SKIN RADIUS'
1721 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1723 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1725 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1727 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1728 text =
'SATURATED WELL CONDUCT.'
1729 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1730 if (this%inonvert /= 0)
then
1731 text =
'ANGLE (DEG)'
1732 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1736 do n = 1, this%nmawwells
1737 do j = 1, this%ngwfnodes(n)
1738 call this%inputtab%add_term(n)
1739 call this%inputtab%add_term(j)
1740 jpos = this%get_jpos(n, j)
1741 nn = this%get_gwfnode(n, j)
1742 call this%dis%noder_to_string(nn, nodestr)
1743 call this%inputtab%add_term(nodestr)
1744 call this%inputtab%add_term(this%topscrn(jpos))
1745 call this%inputtab%add_term(this%botscrn(jpos))
1746 if (this%ieqn(n) == 2 .or. &
1747 this%ieqn(n) == 3 .or. &
1748 this%ieqn(n) == 4)
then
1749 call this%inputtab%add_term(this%sradius(jpos))
1750 call this%inputtab%add_term(this%hk(jpos))
1752 call this%inputtab%add_term(
' ')
1753 call this%inputtab%add_term(
' ')
1755 if (this%ieqn(n) == 1 .or. &
1756 this%ieqn(n) == 2 .or. &
1757 this%ieqn(n) == 3)
then
1758 k11 = this%gwfk11(nn)
1759 if (this%gwfik22 == 0)
then
1760 k22 = this%gwfk11(nn)
1762 k22 = this%gwfk22(nn)
1764 call this%inputtab%add_term(k11)
1765 call this%inputtab%add_term(k22)
1767 call this%inputtab%add_term(
' ')
1768 call this%inputtab%add_term(
' ')
1770 call this%inputtab%add_term(this%satcond(jpos))
1771 if (this%inonvert /= 0)
then
1772 call this%inputtab%add_term(this%angle(jpos))
1779 this%gwfk11 => null()
1780 this%gwfk22 => null()
1781 this%gwfik22 => null()
1782 this%gwfsat => null()
1796 class(
mawtype),
intent(inout) :: this
1797 integer(I4B),
intent(in) :: imaw
1798 integer(I4B),
intent(inout) :: iheadlimit_warning
1800 character(len=LINELENGTH) :: errmsgr
1801 character(len=LINELENGTH) :: text
1802 character(len=LINELENGTH) :: cstr
1803 character(len=LINELENGTH) :: caux
1804 character(len=LINELENGTH) :: keyword
1808 real(DP),
pointer :: bndElem => null()
1809 integer(I4B) :: istat
1811 character(len=*),
parameter :: fmthdbot = &
1812 &
"('well head (',G0,') must be >= BOTTOM_ELEVATION (',G0, ').')"
1815 call this%parser%GetStringCaps(keyword)
1816 select case (keyword)
1818 call this%parser%GetStringCaps(text)
1819 this%status(imaw) = text(1:8)
1822 this%iboundpak(imaw) = -1
1824 this%iboundpak(imaw) = 0
1826 this%iboundpak(imaw) = 1
1829 'Unknown '//trim(this%text)//
" maw status keyword: '", &
1834 call this%parser%GetString(text)
1836 bndelem => this%rate(imaw)
1838 this%packName,
'BND', this%tsManager, &
1839 this%iprpak,
'RATE')
1841 call this%parser%GetString(text)
1843 bndelem => this%well_head(imaw)
1845 this%packName,
'BND', this%tsManager, &
1846 this%iprpak,
'WELL_HEAD')
1849 this%xnewpak(imaw) = this%well_head(imaw)
1852 if (this%well_head(imaw) < this%bot(imaw))
then
1853 write (cstr, fmthdbot) &
1854 this%well_head(imaw), this%bot(imaw)
1855 call this%maw_set_attribute_error(imaw,
'WELL HEAD', trim(cstr))
1857 case (
'FLOWING_WELL')
1858 this%fwelev(imaw) = this%parser%GetDouble()
1859 this%fwcond(imaw) = this%parser%GetDouble()
1860 this%fwrlen(imaw) = this%parser%GetDouble()
1864 if (this%iflowingwells == 0)
then
1865 this%iflowingwells = -1
1866 text =
'Flowing well data is specified in the '//trim(this%packName)// &
1867 ' package but FLOWING_WELL was not specified in the '// &
1871 case (
'RATE_SCALING')
1872 rval = this%parser%GetDouble()
1873 this%pumpelev(imaw) = rval
1874 rval = this%parser%GetDouble()
1875 this%reduction_length(imaw) = rval
1876 if (rval <
dzero)
then
1877 call this%maw_set_attribute_error(imaw, trim(keyword), &
1878 'must be greater than or equal to 0.')
1881 call this%parser%GetString(text)
1882 if (trim(text) ==
'OFF')
then
1883 this%shutofflevel(imaw) =
dep20
1885 read (text, *, iostat=istat, iomsg=errmsgr) &
1886 this%shutofflevel(imaw)
1887 if (istat /= 0)
then
1888 errmsg =
'Could not read HEAD_LIMIT value. '//trim(errmsgr)
1891 if (this%shutofflevel(imaw) <= this%bot(imaw))
then
1892 iheadlimit_warning = iheadlimit_warning + 1
1896 rval = this%parser%GetDouble()
1897 this%shutoffmin(imaw) = rval
1898 rval = this%parser%GetDouble()
1899 this%shutoffmax(imaw) = rval
1901 call this%parser%GetStringCaps(caux)
1902 do jj = 1, this%naux
1903 if (trim(adjustl(caux)) /= trim(adjustl(this%auxname(jj)))) cycle
1904 call this%parser%GetString(text)
1906 bndelem => this%mauxvar(jj, ii)
1908 this%packName,
'AUX', &
1909 this%tsManager, this%iprpak, &
1915 'Unknown '//trim(this%text)//
" maw data keyword: '", &
1927 class(
mawtype),
intent(inout) :: this
1928 integer(I4B),
intent(in) :: imaw
1929 character(len=*),
intent(in) :: keyword
1930 character(len=*),
intent(in) :: msg
1934 if (len(msg) == 0)
then
1935 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1936 keyword,
' for MAW well', imaw,
'has already been set.'
1938 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1939 keyword,
' for MAW well', imaw, msg
1949 class(
mawtype),
intent(inout) :: this
1951 character(len=LINELENGTH) :: cgwfnode
1955 integer(I4B) :: jpos
1959 do n = 1, this%nmawwells
1960 if (this%ngwfnodes(n) < 1)
then
1961 call this%maw_set_attribute_error(n,
'NGWFNODES',
'must be greater '// &
1964 if (this%radius(n) ==
dep20)
then
1965 call this%maw_set_attribute_error(n,
'RADIUS',
'has not been specified.')
1967 if (this%shutoffmin(n) >
dzero)
then
1968 if (this%shutoffmin(n) >= this%shutoffmax(n))
then
1969 call this%maw_set_attribute_error(n,
'SHUT_OFF',
'shutoffmax must '// &
1970 'be greater than shutoffmin.')
1973 do j = 1, this%ngwfnodes(n)
1976 jpos = this%get_jpos(n, j)
1979 write (cgwfnode,
'(a,i0,a)')
'gwfnode(', j,
')'
1982 if (this%botscrn(jpos) >= this%topscrn(jpos))
then
1983 call this%maw_set_attribute_error(n,
'SCREEN_TOP',
'screen bottom '// &
1984 'must be less than screen top. '// &
1989 if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
1990 this%ieqn(n) == 4)
then
1991 if (this%hk(jpos) <=
dzero)
then
1992 call this%maw_set_attribute_error(n,
'HK_SKIN',
'skin hyraulic '// &
1993 'conductivity must be greater '// &
1994 'than zero. '//trim(cgwfnode))
1996 else if (this%ieqn(n) == 0)
then
1999 if (this%satcond(jpos) <
dzero)
then
2000 call this%maw_set_attribute_error(n,
'HK_SKIN', &
2001 'skin hyraulic conductivity '// &
2002 'must be greater than or '// &
2003 'equal to zero when using '// &
2004 'SPECIFIED condeqn. '// &
2020 class(
mawtype),
intent(inout) :: this
2021 integer(I4B),
intent(in) :: moffset
2027 integer(I4B) :: jglo
2028 integer(I4B) :: nglo
2032 do n = 1, this%nmawwells
2033 nglo = moffset + this%dis%nodes + this%ioffset + n
2034 call sparse%addconnection(nglo, nglo, 1)
2035 do j = 1, this%ngwfnodes(n)
2036 jj = this%get_gwfnode(n, j)
2038 call sparse%addconnection(nglo, jglo, 1)
2039 call sparse%addconnection(jglo, nglo, 1)
2051 class(
mawtype),
intent(inout) :: this
2052 integer(I4B),
intent(in) :: moffset
2058 integer(I4B) :: iglo
2059 integer(I4B) :: jglo
2060 integer(I4B) :: ipos
2064 call mem_allocate(this%idxlocnode, this%nmawwells,
'IDXLOCNODE', &
2066 call mem_allocate(this%idxdglo, this%maxbound,
'IDXDGLO', this%memoryPath)
2067 call mem_allocate(this%idxoffdglo, this%maxbound,
'IDXOFFDGLO', &
2069 call mem_allocate(this%idxsymdglo, this%maxbound,
'IDXSYMDGLO', &
2071 call mem_allocate(this%idxsymoffdglo, this%maxbound,
'IDXSYMOFFDGLO', &
2079 do n = 1, this%nmawwells
2080 iglo = moffset + this%dis%nodes + this%ioffset + n
2081 this%idxlocnode(n) = this%dis%nodes + this%ioffset + n
2082 do ii = 1, this%ngwfnodes(n)
2083 j = this%get_gwfnode(n, ii)
2085 this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
2086 this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
2092 do n = 1, this%nmawwells
2093 do ii = 1, this%ngwfnodes(n)
2094 iglo = this%get_gwfnode(n, ii) + moffset
2095 jglo = moffset + this%dis%nodes + this%ioffset + n
2096 this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
2097 this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
2112 class(
mawtype),
intent(inout) :: this
2113 character(len=*),
intent(inout) :: option
2114 logical,
intent(inout) :: found
2116 character(len=MAXCHARLEN) :: fname, keyword
2118 character(len=*),
parameter :: fmtflowingwells = &
2119 &
"(4x, 'FLOWING WELLS WILL BE SIMULATED.')"
2120 character(len=*),
parameter :: fmtshutdown = &
2121 &
"(4x, 'SHUTDOWN ', a, ' VALUE (',g15.7,') SPECIFIED.')"
2122 character(len=*),
parameter :: fmtnostoragewells = &
2123 &
"(4x, 'WELL STORAGE WILL NOT BE SIMULATED.')"
2124 character(len=*),
parameter :: fmtmawbin = &
2125 "(4x, 'MAW ', 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, /4x, &
2126 &'OPENED ON UNIT: ', I0)"
2130 select case (option)
2133 write (this%iout,
'(4x,a)') &
2134 trim(adjustl(this%text))//
' heads will be printed to listing file.'
2136 call this%parser%GetStringCaps(keyword)
2137 if (keyword ==
'FILEOUT')
then
2138 call this%parser%GetString(fname)
2139 call assign_iounit(this%iheadout, this%inunit,
"HEAD fileout")
2140 call openfile(this%iheadout, this%iout, fname,
'DATA(BINARY)', &
2142 write (this%iout, fmtmawbin)
'HEAD', trim(adjustl(fname)), &
2145 call store_error(
'Optional maw stage keyword must be '// &
2146 'followed by fileout.')
2149 call this%parser%GetStringCaps(keyword)
2150 if (keyword ==
'FILEOUT')
then
2151 call this%parser%GetString(fname)
2152 call assign_iounit(this%ibudgetout, this%inunit,
"BUDGET fileout")
2153 call openfile(this%ibudgetout, this%iout, fname,
'DATA(BINARY)', &
2155 write (this%iout, fmtmawbin)
'BUDGET', trim(adjustl(fname)), &
2158 call store_error(
'Optional maw budget keyword must be '// &
2159 'followed by fileout.')
2162 call this%parser%GetStringCaps(keyword)
2163 if (keyword ==
'FILEOUT')
then
2164 call this%parser%GetString(fname)
2165 call assign_iounit(this%ibudcsv, this%inunit,
"BUDGETCSV fileout")
2166 call openfile(this%ibudcsv, this%iout, fname,
'CSV', &
2167 filstat_opt=
'REPLACE')
2168 write (this%iout, fmtmawbin)
'BUDGET CSV', trim(adjustl(fname)), &
2171 call store_error(
'OPTIONAL BUDGETCSV KEYWORD MUST BE FOLLOWED BY &
2174 case (
'FLOWING_WELLS')
2175 this%iflowingwells = 1
2176 write (this%iout, fmtflowingwells)
2177 case (
'SHUTDOWN_THETA')
2178 this%theta = this%parser%GetDouble()
2179 write (this%iout, fmtshutdown)
'THETA', this%theta
2180 case (
'SHUTDOWN_KAPPA')
2181 this%kappa = this%parser%GetDouble()
2182 write (this%iout, fmtshutdown)
'KAPPA', this%kappa
2185 write (this%iout,
'(4x,A)')
'MOVER OPTION ENABLED'
2186 case (
'NO_WELL_STORAGE')
2188 write (this%iout, fmtnostoragewells)
2189 case (
'NON_VERTICAL_WELLS')
2191 write (this%iout,
'(4x,a)') &
2192 'NON-VERTICAL (SLANTED) MULTI-AQUIFER WELL CONNECTIONS WILL BE '// &
2193 'SIMULATED. SCREEN LENGTHS FOR CONNECTIONS LISTED IN THE ANGLEDATA '// &
2194 'BLOCK WILL BE USED TO CALCULATE THE SATURATED CONDUCTANCE.'
2195 case (
'FLOW_CORRECTION')
2196 this%correct_flow = .true.
2197 write (this%iout,
'(4x,a,/,4x,a)') &
2198 'MAW-GWF FLOW CORRECTIONS WILL BE APPLIED WHEN MAW HEADS ARE BELOW', &
2199 'OR GWF HEADS IN CONNECTED CELLS ARE BELOW THE CELL BOTTOM.'
2200 case (
'MAW_FLOW_REDUCE_CSV')
2201 call this%parser%GetStringCaps(keyword)
2202 if (keyword ==
'FILEOUT')
then
2203 call this%parser%GetString(fname)
2204 call this%maw_redflow_csv_init(fname)
2206 call store_error(
'OPTIONAL MAW_FLOW_REDUCE_CSV KEYWORD MUST BE &
2207 &FOLLOWED BY FILEOUT')
2214 case (
'DEV_PEACEMAN_EFFECTIVE_RADIUS')
2215 call this%parser%DevOpt()
2217 write (this%iout,
'(4x,a)') &
2218 'EFFECTIVE RADIUS FOR STRUCTURED GRIDS WILL BE CALCULATED &
2219 &USING PEACEMAN 1983'
2233 class(
mawtype),
intent(inout) :: this
2237 call this%obs%obs_ar()
2240 if (this%inewton > 0)
then
2241 this%satomega =
dem6
2245 call this%maw_allocate_arrays()
2248 call this%read_initial_attr()
2251 if (this%imover /= 0)
then
2252 allocate (this%pakmvrobj)
2253 call this%pakmvrobj%ar(this%nmawwells, this%nmawwells, this%memoryPath)
2265 class(
mawtype),
intent(inout) :: this
2267 character(len=LINELENGTH) :: title
2268 character(len=LINELENGTH) :: line
2269 character(len=LINELENGTH) :: text
2270 character(len=16) :: csteady
2272 logical :: endOfBlock
2273 integer(I4B) :: ierr
2274 integer(I4B) :: node
2276 integer(I4B) :: ntabcols
2277 integer(I4B) :: ntabrows
2278 integer(I4B) :: imaw
2279 integer(I4B) :: ibnd
2281 integer(I4B) :: jpos
2282 integer(I4B) :: iheadlimit_warning
2284 character(len=*),
parameter :: fmtblkerr = &
2285 &
"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
2286 character(len=*),
parameter :: fmtlsp = &
2287 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
2290 iheadlimit_warning = 0
2293 this%imawiss = this%gwfiss
2296 if (this%imawissopt == 1)
then
2301 this%nbound = this%maxbound
2305 if (this%inunit == 0)
return
2308 if (this%ionper <
kper)
then
2311 call this%parser%GetBlock(
'PERIOD', isfound, ierr, &
2312 supportopenclose=.true., &
2313 blockrequired=.false.)
2317 call this%read_check_ionper()
2323 this%ionper =
nper + 1
2326 call this%parser%GetCurrentLine(line)
2327 write (
errmsg, fmtblkerr) adjustl(trim(line))
2334 if (this%ionper ==
kper)
then
2337 if (this%iprpak /= 0)
then
2340 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2341 trim(adjustl(this%packName))//
') DATA FOR PERIOD'
2342 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2343 call table_cr(this%inputtab, this%packName, title)
2344 call this%inputtab%table_df(1, 5, this%iout, finalize=.false.)
2346 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2348 call this%inputtab%initialize_column(text, 20, alignment=tableft)
2350 write (text,
'(a,1x,i6)')
'VALUE', n
2351 call this%inputtab%initialize_column(text, 15, alignment=tabcenter)
2358 call this%parser%GetNextLine(endofblock)
2359 if (endofblock)
exit
2361 imaw = this%parser%GetInteger()
2362 if (imaw < 1 .or. imaw > this%nmawwells)
then
2363 write (
errmsg,
'(2(a,1x),i0,a)') &
2364 'IMAW must be greater than 0 and', &
2365 'less than or equal to ', this%nmawwells,
'.'
2371 call this%maw_set_stressperiod(imaw, iheadlimit_warning)
2374 if (this%iprpak /= 0)
then
2375 call this%parser%GetCurrentLine(line)
2376 call this%inputtab%line_to_columns(line)
2379 if (this%iprpak /= 0)
then
2380 call this%inputtab%finalize_table()
2385 write (this%iout, fmtlsp) trim(this%filtyp)
2389 if (iheadlimit_warning > 0)
then
2390 write (
warnmsg,
'(a,a,a,1x,a,1x,a)') &
2391 "HEAD_LIMIT in '", trim(this%packName),
"' was below the well bottom", &
2392 "for one or more multi-aquifer well(s). This may result in", &
2393 "convergence failures for some models."
2399 call this%parser%StoreErrorUnit()
2403 if (this%check_attr /= 0)
then
2404 call this%maw_check_attributes()
2407 if (this%iprpak == 1)
then
2408 if (this%imawiss /= 0)
then
2409 csteady =
'STEADY-STATE '
2411 csteady =
'TRANSIENT '
2415 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2416 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2417 ' RATE DATA FOR PERIOD'
2418 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2420 call table_cr(this%inputtab, this%packName, title)
2421 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
2423 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2425 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2427 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2428 text =
'SPECIFIED HEAD'
2429 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2430 text =
'PUMP ELEVATION'
2431 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2432 text =
'REDUCTION LENGTH'
2433 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2434 do n = 1, this%nmawwells
2435 call this%inputtab%add_term(n)
2436 call this%inputtab%add_term(this%status(n))
2437 call this%inputtab%add_term(this%rate(n))
2438 if (this%iboundpak(n) < 0)
then
2439 call this%inputtab%add_term(this%well_head(n))
2441 call this%inputtab%add_term(
' ')
2443 call this%inputtab%add_term(this%pumpelev(n))
2444 if (this%reduction_length(n) /= dep20)
then
2445 call this%inputtab%add_term(this%reduction_length(n))
2447 call this%inputtab%add_term(
' ')
2452 if (this%iflowingwells > 0)
then
2455 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2456 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2457 ' FLOWING WELL DATA FOR PERIOD'
2458 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2461 do n = 1, this%nmawwells
2462 if (this%fwcond(n) > dzero)
then
2463 ntabrows = ntabrows + 1
2466 if (ntabrows > 0)
then
2467 call table_cr(this%inputtab, this%packName, title)
2468 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2470 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2472 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2474 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2475 text =
'REDUCTION LENGTH'
2476 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2477 do n = 1, this%nmawwells
2478 if (this%fwcond(n) > dzero)
then
2479 call this%inputtab%add_term(n)
2480 call this%inputtab%add_term(this%fwelev(n))
2481 call this%inputtab%add_term(this%fwcond(n))
2482 call this%inputtab%add_term(this%fwrlen(n))
2489 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2490 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2491 ' WELL SHUTOFF DATA FOR PERIOD'
2492 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2495 do n = 1, this%nmawwells
2496 if (this%shutofflevel(n) /= dep20)
then
2497 ntabrows = ntabrows + 1
2500 if (ntabrows > 0)
then
2501 call table_cr(this%inputtab, this%packName, title)
2502 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2504 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2506 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2508 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2510 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2511 do n = 1, this%nmawwells
2512 if (this%shutofflevel(n) /= dep20)
then
2513 call this%inputtab%add_term(n)
2514 call this%inputtab%add_term(this%shutofflevel(n))
2515 call this%inputtab%add_term(this%shutoffmin(n))
2516 call this%inputtab%add_term(this%shutoffmax(n))
2525 do n = 1, this%nmawwells
2526 do j = 1, this%ngwfnodes(n)
2527 jpos = this%get_jpos(n, j)
2528 node = this%get_gwfnode(n, j)
2529 this%nodelist(ibnd) = node
2530 this%bound(1, ibnd) = this%xnewpak(n)
2531 this%bound(2, ibnd) = this%satcond(jpos)
2532 this%bound(3, ibnd) = this%botscrn(jpos)
2533 if (this%iboundpak(n) > 0)
then
2534 this%bound(4, ibnd) = this%rate(n)
2536 this%bound(4, ibnd) = dzero
2553 integer(I4B) :: ibnd
2556 call this%TsManager%ad()
2561 if (this%naux > 0)
then
2563 do n = 1, this%nmawwells
2564 do j = 1, this%ngwfnodes(n)
2565 do jj = 1, this%naux
2566 if (this%noupdateauxvar(jj) /= 0) cycle
2567 this%auxvar(jj, ibnd) = this%mauxvar(jj, n)
2575 do n = 1, this%nmawwells
2576 this%xoldpak(n) = this%xnewpak(n)
2577 this%xoldsto(n) = this%xsto(n)
2578 if (this%iboundpak(n) < 0)
then
2579 this%xnewpak(n) = this%well_head(n)
2585 this%nurdxold(n) =
dzero
2586 this%nurweight(n) =
done
2591 if (
kper == 1 .and.
kstp == 1)
then
2592 do n = 1, this%nmawwells
2593 if (this%fwcond(n) >
dzero)
then
2594 if (this%xoldsto(n) > this%fwelev(n))
then
2595 this%xoldsto(n) = this%fwelev(n)
2602 this%ishutoffcnt = 0
2605 if (this%imover == 1)
then
2606 call this%pakmvrobj%ad()
2612 call this%obs%obs_ad()
2625 call this%maw_cfupdate()
2630 subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln)
2635 real(DP),
dimension(:),
intent(inout) :: rhs
2636 integer(I4B),
dimension(:),
intent(in) :: ia
2637 integer(I4B),
dimension(:),
intent(in) :: idxglo
2643 integer(I4B) :: iloc
2644 integer(I4B) :: isymloc
2645 integer(I4B) :: igwfnode
2646 integer(I4B) :: iposd
2647 integer(I4B) :: iposoffd
2648 integer(I4B) :: isymnode
2649 integer(I4B) :: ipossymd
2650 integer(I4B) :: ipossymoffd
2651 integer(I4B) :: jpos
2652 integer(I4B) :: icflow
2671 if (this%imover == 1)
then
2672 call this%pakmvrobj%fc()
2677 do n = 1, this%nmawwells
2678 iloc = this%idxlocnode(n)
2682 this%qsim0(n) = this%ratesim(n)
2685 if (this%iboundpak(n) < 0)
then
2686 this%xnewpak(n) = this%well_head(n)
2688 hmaw = this%xnewpak(n)
2691 if (this%iboundpak(n) == 0)
then
2692 this%ratesim(n) =
dzero
2694 call this%maw_calculate_wellq(n, hmaw, rate)
2695 this%ratesim(n) = rate
2696 rhs(iloc) = rhs(iloc) - rate
2699 iposd = this%idxdglo(idx)
2704 if (this%iflowingwells > 0)
then
2705 if (this%fwcond(n) >
dzero)
then
2707 tp = bt + this%fwrlen(n)
2709 cfw = scale * this%fwcond(n)
2710 this%ifwdischarge(n) = 0
2711 if (cfw >
dzero)
then
2712 this%ifwdischarge(n) = 1
2715 this%fwcondsim(n) = cfw
2716 call matrix_sln%add_value_pos(iposd, -cfw)
2717 rhs(iloc) = rhs(iloc) - cfw * bt
2718 ratefw = cfw * (bt - hmaw)
2723 if (this%imawiss /= 1)
then
2724 if (this%ifwdischarge(n) /= 1)
then
2731 tled = this%area(n) /
delt
2734 ssold =
squadratic0sp(this%xoldsto(n), this%bot(n), this%satomega)
2735 call matrix_sln%add_value_pos(iposd, -tled * sd)
2736 rhs(iloc) = rhs(iloc) - tled * (sd * hmaw - ss + ssold)
2738 cterm = this%xoldsto(n) - this%fwelev(n)
2739 rhs(iloc) = rhs(iloc) - (this%area(n) * cterm /
delt)
2745 if (this%imover == 1)
then
2746 rhs(iloc) = rhs(iloc) - this%pakmvrobj%get_qfrommvr(n)
2750 call this%pakmvrobj%accumulate_qformvr(n, -rate)
2754 call this%pakmvrobj%accumulate_qformvr(n, -ratefw)
2760 do j = 1, this%ngwfnodes(n)
2761 if (this%iboundpak(n) /= 0)
then
2762 jpos = this%get_jpos(n, j)
2763 igwfnode = this%get_gwfnode(n, j)
2764 hgwf = this%xnew(igwfnode)
2767 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2769 this%simcond(jpos) = cmaw
2772 iposd = this%idxdglo(idx)
2773 iposoffd = this%idxoffdglo(idx)
2774 call matrix_sln%add_value_pos(iposd, -term)
2775 call matrix_sln%set_value_pos(iposoffd, term)
2778 rhs(iloc) = rhs(iloc) - cterm
2781 isymnode = this%get_gwfnode(n, j)
2782 isymloc = ia(isymnode)
2783 ipossymd = this%idxsymdglo(idx)
2784 ipossymoffd = this%idxsymoffdglo(idx)
2785 call matrix_sln%add_value_pos(ipossymd, -term)
2786 call matrix_sln%set_value_pos(ipossymoffd, term)
2789 rhs(isymnode) = rhs(isymnode) + cterm
2800 subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln)
2803 real(DP),
dimension(:),
intent(inout) :: rhs
2804 integer(I4B),
dimension(:),
intent(in) :: ia
2805 integer(I4B),
dimension(:),
intent(in) :: idxglo
2811 integer(I4B) :: iloc
2812 integer(I4B) :: isymloc
2813 integer(I4B) :: igwfnode
2814 integer(I4B) :: iposd
2815 integer(I4B) :: iposoffd
2816 integer(I4B) :: isymnode
2817 integer(I4B) :: ipossymd
2818 integer(I4B) :: ipossymoffd
2819 integer(I4B) :: jpos
2820 integer(I4B) :: icflow
2841 do n = 1, this%nmawwells
2842 iloc = this%idxlocnode(n)
2843 hmaw = this%xnewpak(n)
2846 if (this%iboundpak(n) /= 0)
then
2847 iposd = this%idxdglo(idx)
2850 rate = this%ratesim(n)
2853 call this%maw_calculate_wellq(n, hmaw +
dem4, rate2)
2854 drterm = (rate2 - rate) /
dem4
2857 call matrix_sln%add_value_pos(iposd, drterm)
2858 rhs(iloc) = rhs(iloc) + drterm * hmaw
2861 if (this%iflowingwells > 0)
then
2862 if (this%fwcond(n) >
dzero)
then
2864 tp = bt + this%fwrlen(n)
2866 cfw = scale * this%fwcond(n)
2867 this%ifwdischarge(n) = 0
2868 if (cfw >
dzero)
then
2869 this%ifwdischarge(n) = 1
2871 this%fwcondsim(n) = cfw
2872 rate = cfw * (bt - hmaw)
2878 drterm = -(cfw + this%fwcond(n) * derv * (hmaw - bt))
2881 call matrix_sln%add_value_pos(iposd, &
2882 -this%fwcond(n) * derv * (hmaw - bt))
2883 rhs(iloc) = rhs(iloc) - rterm + drterm * hmaw
2890 do j = 1, this%ngwfnodes(n)
2891 if (this%iboundpak(n) /= 0)
then
2892 jpos = this%get_jpos(n, j)
2893 igwfnode = this%get_gwfnode(n, j)
2894 hgwf = this%xnew(igwfnode)
2897 iposd = this%idxdglo(idx)
2898 iposoffd = this%idxoffdglo(idx)
2901 isymnode = this%get_gwfnode(n, j)
2902 isymloc = ia(isymnode)
2903 ipossymd = this%idxsymdglo(idx)
2904 ipossymoffd = this%idxsymoffdglo(idx)
2907 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2911 if (hmaw > hgwf)
then
2912 if (icflow /= 0)
then
2913 rhsterm = term2 * hgwf + term * hmaw
2914 rhs(iloc) = rhs(iloc) + rhsterm
2915 rhs(isymnode) = rhs(isymnode) - rhsterm
2916 if (this%iboundpak(n) > 0)
then
2917 call matrix_sln%add_value_pos(iposd, term)
2918 call matrix_sln%add_value_pos(iposoffd, term2)
2920 call matrix_sln%add_value_pos(ipossymd, -term2)
2921 call matrix_sln%add_value_pos(ipossymoffd, -term)
2923 rhs(iloc) = rhs(iloc) + term * hmaw
2924 rhs(isymnode) = rhs(isymnode) - term * hmaw
2925 call matrix_sln%add_value_pos(iposd, term)
2926 if (this%ibound(igwfnode) > 0)
then
2927 call matrix_sln%add_value_pos(ipossymoffd, -term)
2933 if (icflow /= 0)
then
2934 rhsterm = term2 * hmaw + term * hgwf
2935 rhs(iloc) = rhs(iloc) + rhsterm
2936 rhs(isymnode) = rhs(isymnode) - rhsterm
2937 if (this%iboundpak(n) > 0)
then
2938 call matrix_sln%add_value_pos(iposd, term2)
2939 call matrix_sln%add_value_pos(iposoffd, term)
2941 call matrix_sln%add_value_pos(ipossymd, -term)
2942 call matrix_sln%add_value_pos(ipossymoffd, -term2)
2944 rhs(iloc) = rhs(iloc) + term * hgwf
2945 rhs(isymnode) = rhs(isymnode) - term * hgwf
2946 if (this%iboundpak(n) > 0)
then
2947 call matrix_sln%add_value_pos(iposoffd, term)
2949 call matrix_sln%add_value_pos(ipossymd, -term)
2972 subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
2974 class(
mawtype),
intent(inout) :: this
2975 integer(I4B),
intent(in) :: neqpak
2976 real(DP),
dimension(neqpak),
intent(inout) :: x
2977 real(DP),
dimension(neqpak),
intent(in) :: xtemp
2978 real(DP),
dimension(neqpak),
intent(inout) :: dx
2979 integer(I4B),
intent(inout) :: inewtonur
2980 real(DP),
intent(inout) :: dxmax
2981 integer(I4B),
intent(inout) :: locmax
2990 real(DP),
parameter :: damptheta =
dp7
2991 real(DP),
parameter :: damptol =
dhalf
2992 real(DP),
parameter :: weightmin =
dem2
2993 real(DP),
parameter :: recover = 0.2_dp
2996 do n = 1, this%nmawwells
2997 if (this%iboundpak(n) < 1) cycle
3001 dxprop = x(n) - xtemp(n)
3009 weight =
maw_damp_weight(dxprop, this%nurdxold(n), this%nurweight(n), &
3010 damptheta, damptol, weightmin, recover)
3011 this%nurweight(n) = weight
3014 if (weight <
done)
then
3016 xx = xtemp(n) + weight * dxprop
3018 if (abs(dxx) > abs(dxmax))
then
3023 dx(n) = weight * dxprop
3028 if (x(n) < botw)
then
3032 if (abs(dxx) > abs(dxmax))
then
3044 this%nurdxold(n) = x(n) - xtemp(n)
3057 weightmin, recover)
result(new_weight)
3059 real(dp),
intent(in) :: dxprop
3060 real(dp),
intent(in) :: dxold
3061 real(dp),
intent(in) :: weight
3062 real(dp),
intent(in) :: damptheta
3063 real(dp),
intent(in) :: damptol
3064 real(dp),
intent(in) :: weightmin
3065 real(dp),
intent(in) :: recover
3067 real(dp) :: new_weight
3069 if (dxprop * dxold <
dzero .and. abs(dxprop) > damptol * abs(dxold))
then
3070 new_weight = max(damptheta * weight, weightmin)
3072 new_weight = min(weight + recover,
done)
3087 subroutine maw_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
3091 class(
mawtype),
intent(inout) :: this
3092 integer(I4B),
intent(in) :: innertot
3093 integer(I4B),
intent(in) :: kiter
3094 integer(I4B),
intent(in) :: iend
3095 integer(I4B),
intent(in) :: icnvgmod
3096 character(len=LENPAKLOC),
intent(inout) :: cpak
3097 integer(I4B),
intent(inout) :: ipak
3098 real(DP),
intent(inout) :: dpak
3102 integer(I4B) :: jpos
3103 integer(I4B) :: igwfnode
3104 integer(I4B) :: locdpak
3113 real(DP) :: qtolfact
3116 character(len=LENPAKLOC) :: cloc
3118 real(DP),
parameter :: qtol = 1.001_dp
3120 character(len=*),
parameter :: fmtwarn = &
3121 "('MAW well ', a, ' requests an extraction rate (', g0.5, &
3122 &') larger than the maximum rate (', g0.5, ') the aquifer can supply &
3123 &with the well head at its bottom. This may be preventing convergence. &
3124 &Consider reducing the requested rate, applying or widening RATE_SCALING, &
3125 &or reviewing the connection conductance (e.g. aquifer K).')"
3135 do n = 1, this%nmawwells
3136 if (this%iboundpak(n) < 1) cycle
3137 if (this%nurweight(n) >=
done) cycle
3138 if (this%area(n) >
dzero)
then
3139 qtolfact =
delt / this%area(n)
3150 dq = (this%qsim0(n) - this%ratesim(n)) * qtolfact
3151 if (abs(dq) > abs(dpakmax))
then
3156 if (locdpak > 0 .and. abs(dpakmax) > abs(dpak))
then
3159 write (cloc,
"(a,'-',a)") trim(this%packName),
'rate'
3165 if (iend == 0)
return
3166 if (icnvgmod /= 0)
return
3169 do n = 1, this%nmawwells
3170 if (this%iboundpak(n) < 1) cycle
3171 if (this%rate(n) >=
dzero) cycle
3177 do j = 1, this%ngwfnodes(n)
3178 jpos = this%get_jpos(n, j)
3179 igwfnode = this%get_gwfnode(n, j)
3180 hgwf = this%xnew(igwfnode)
3181 bmaw = this%botscrn(jpos)
3182 hv = max(botw, bmaw)
3187 call this%maw_calculate_saturation(n, j, igwfnode, sat, hv)
3188 cmaw = this%satcond(jpos) * sat
3193 qmax = qmax + cmaw * max(hgwf - hv,
dzero)
3197 qreq = -this%rate(n)
3198 if (qmax >=
dzero .and. qreq > qtol * qmax)
then
3199 write (cloc,
'(a, a, a, a, i0, a, i0, a)') trim(this%name_model),
'-(', &
3200 trim(this%filtyp),
'_', this%ibcnum,
'-', n,
')'
3201 write (
warnmsg, fmtwarn) trim(cloc), qreq, qmax
3215 class(
mawtype),
intent(inout) :: this
3216 real(DP),
dimension(:),
intent(in) :: x
3217 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
3218 integer(I4B),
optional,
intent(in) :: iadv
3226 integer(I4B) :: ibnd
3234 call this%maw_cfupdate()
3238 call this%BndType%bnd_cq(x, flowja, iadv=1)
3241 do n = 1, this%nmawwells
3242 this%qout(n) = dzero
3243 this%qsto(n) = dzero
3244 if (this%iflowingwells > 0)
then
3247 if (this%iboundpak(n) == 0)
then
3252 hmaw = this%xnewpak(n)
3256 rrate = this%ratesim(n)
3259 if (rrate < dzero)
then
3260 this%qout(n) = rrate
3264 if (this%iflowingwells > 0)
then
3265 if (this%fwcond(n) > dzero)
then
3266 cfw = this%fwcondsim(n)
3270 if (this%ifwdischarge(n) == 1)
then
3271 this%xsto(n) = this%fwelev(n)
3273 rrate = cfw * (this%fwelev(n) - hmaw)
3277 this%qout(n) = this%qout(n) + rrate
3287 if (this%imawiss /= 1)
then
3288 if (this%iflowingwells > 0 .and. this%ifwdischarge(n) == 1)
then
3289 rrate = -this%area(n) * (this%xsto(n) - this%xoldsto(n)) /
delt
3292 ssold =
squadratic0sp(this%xoldsto(n), this%bot(n), this%satomega)
3293 rrate = -this%area(n) * (ss - ssold) /
delt
3295 this%qsto(n) = rrate
3301 do n = 1, this%nmawwells
3302 hmaw = this%xnewpak(n)
3303 this%qconst(n) = dzero
3304 do j = 1, this%ngwfnodes(n)
3305 rrate = -this%simvals(ibnd)
3306 this%qleak(ibnd) = rrate
3307 if (this%iboundpak(n) < 0)
then
3308 this%qconst(n) = this%qconst(n) - rrate
3311 if (-rrate < dzero)
then
3312 this%qout(n) = this%qout(n) - rrate
3321 if (this%iboundpak(n) < 0)
then
3324 this%qconst(n) = this%qconst(n) - this%ratesim(n)
3327 if (this%iflowingwells > 0)
then
3328 this%qconst(n) = this%qconst(n) - this%qfw(n)
3332 if (this%imawiss /= 1)
then
3333 this%qconst(n) = this%qconst(n) - this%qsto(n)
3339 call this%maw_fill_budobj()
3347 integer(I4B),
intent(in) :: icbcfl
3348 integer(I4B),
intent(in) :: ibudfl
3349 integer(I4B),
intent(in) :: icbcun
3350 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
3353 call this%BndType%bnd_ot_model_flows(icbcfl, ibudfl, icbcun, this%imap)
3361 integer(I4B),
intent(in) :: icbcfl
3362 integer(I4B),
intent(in) :: ibudfl
3363 integer(I4B) :: ibinun
3367 if (this%ibudgetout /= 0)
then
3368 ibinun = this%ibudgetout
3370 if (icbcfl == 0) ibinun = 0
3371 if (ibinun > 0)
then
3372 call this%budobj%save_flows(this%dis, ibinun,
kstp,
kper,
delt, &
3377 if (ibudfl /= 0 .and. this%iprflow /= 0)
then
3378 call this%budobj%write_flowtable(this%dis,
kstp,
kper)
3389 integer(I4B),
intent(in) :: idvsave
3390 integer(I4B),
intent(in) :: idvprint
3391 integer(I4B) :: ibinun
3398 if (this%iheadout /= 0)
then
3399 ibinun = this%iheadout
3401 if (idvsave == 0) ibinun = 0
3404 if (ibinun > 0)
then
3405 do n = 1, this%nmawwells
3408 if (this%iboundpak(n) == 0)
then
3410 else if (d <= dzero)
then
3415 call ulasav(this%dbuff,
' HEAD', &
3417 this%nmawwells, 1, 1, ibinun)
3421 if (idvprint /= 0 .and. this%iprhed /= 0)
then
3424 call this%headtab%set_kstpkper(
kstp,
kper)
3427 do n = 1, this%nmawwells
3428 if (this%inamedbound == 1)
then
3429 call this%headtab%add_term(this%cmawname(n))
3431 call this%headtab%add_term(n)
3432 call this%headtab%add_term(this%xnewpak(n))
3444 integer(I4B),
intent(in) :: kstp
3445 integer(I4B),
intent(in) :: kper
3446 integer(I4B),
intent(in) :: iout
3447 integer(I4B),
intent(in) :: ibudfl
3449 call this%budobj%write_budtable(kstp, kper, iout, ibudfl,
totim,
delt)
3462 call this%budobj%budgetobject_da()
3463 deallocate (this%budobj)
3464 nullify (this%budobj)
3467 if (this%iprhed > 0)
then
3468 call this%headtab%table_da()
3469 deallocate (this%headtab)
3470 nullify (this%headtab)
3474 call mem_deallocate(this%cmawbudget,
'CMAWBUDGET', this%memoryPath)
3570 nullify (this%gwfiss)
3573 call this%BndType%bnd_da()
3580 class(
mawtype),
intent(inout) :: this
3583 this%listlabel = trim(this%filtyp)//
' NO.'
3584 if (this%dis%ndim == 3)
then
3585 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
3586 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'ROW'
3587 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'COL'
3588 elseif (this%dis%ndim == 2)
then
3589 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
3590 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'CELL2D'
3592 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'NODE'
3594 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'STRESS RATE'
3595 if (this%inamedbound == 1)
then
3596 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
3608 integer(I4B),
pointer :: neq
3609 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
3610 real(DP),
dimension(:),
pointer,
contiguous :: xnew
3611 real(DP),
dimension(:),
pointer,
contiguous :: xold
3612 real(DP),
dimension(:),
pointer,
contiguous :: flowja
3615 integer(I4B) :: istart, iend
3618 call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja)
3623 istart = this%dis%nodes + this%ioffset + 1
3624 iend = istart + this%nmawwells - 1
3625 this%iboundpak => this%ibound(istart:iend)
3626 this%xnewpak => this%xnew(istart:iend)
3627 call mem_checkin(this%xnewpak,
'HEAD', this%memoryPath,
'X', &
3628 this%memoryPathModel)
3629 call mem_allocate(this%xoldpak, this%nmawwells,
'XOLDPAK', this%memoryPath)
3632 do n = 1, this%nmawwells
3633 this%xnewpak(n) =
dep20
3657 integer(I4B) :: indx
3661 call this%obs%StoreObsType(
'head', .false., indx)
3666 call this%obs%StoreObsType(
'from-mvr', .false., indx)
3671 call this%obs%StoreObsType(
'maw', .true., indx)
3676 call this%obs%StoreObsType(
'rate', .true., indx)
3681 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
3686 call this%obs%StoreObsType(
'fw-rate', .true., indx)
3691 call this%obs%StoreObsType(
'fw-to-mvr', .true., indx)
3696 call this%obs%StoreObsType(
'storage', .true., indx)
3701 call this%obs%StoreObsType(
'constant', .true., indx)
3706 call this%obs%StoreObsType(
'conductance', .true., indx)
3711 call this%obs%StoreObsType(
'fw-conductance', .true., indx)
3727 integer(I4B) :: jpos
3735 if (this%obs%npakobs > 0)
then
3736 call this%obs%obs_bd_clear()
3737 do i = 1, this%obs%npakobs
3738 obsrv => this%obs%pakobs(i)%obsrv
3739 do j = 1, obsrv%indxbnds_count
3741 jj = obsrv%indxbnds(j)
3742 select case (obsrv%ObsTypeId)
3744 if (this%iboundpak(jj) /= 0)
then
3745 v = this%xnewpak(jj)
3748 if (this%iboundpak(jj) /= 0)
then
3749 if (this%imover == 1)
then
3750 v = this%pakmvrobj%get_qfrommvr(jj)
3755 if (this%iboundpak(n) /= 0)
then
3759 if (this%iboundpak(jj) /= 0)
then
3760 v = this%ratesim(jj)
3761 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3762 qfact = v / this%qout(jj)
3763 if (this%imover == 1)
then
3764 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3768 case (
'RATE-TO-MVR')
3769 if (this%iboundpak(jj) /= 0)
then
3770 if (this%imover == 1)
then
3771 v = this%ratesim(jj)
3773 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3774 qfact = v / this%qout(jj)
3776 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3783 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3784 hmaw = this%xnewpak(jj)
3785 cmaw = this%fwcondsim(jj)
3786 v = cmaw * (this%fwelev(jj) - hmaw)
3787 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3788 qfact = v / this%qout(jj)
3789 if (this%imover == 1)
then
3790 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3795 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3796 if (this%imover == 1)
then
3797 hmaw = this%xnewpak(jj)
3798 cmaw = this%fwcondsim(jj)
3799 v = cmaw * (this%fwelev(jj) - hmaw)
3801 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3802 qfact = v / this%qout(jj)
3804 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3811 if (this%iboundpak(jj) /= 0 .and. this%imawissopt /= 1)
then
3815 if (this%iboundpak(jj) /= 0)
then
3818 case (
'CONDUCTANCE')
3820 if (this%iboundpak(n) /= 0)
then
3821 nn = jj - this%iaconn(n) + 1
3822 jpos = this%get_jpos(n, nn)
3823 v = this%simcond(jpos)
3825 case (
'FW-CONDUCTANCE')
3826 if (this%iboundpak(jj) /= 0)
then
3827 v = this%fwcondsim(jj)
3830 errmsg =
'Unrecognized observation type: '//trim(obsrv%ObsTypeId)
3833 call this%obs%SaveOneSimval(obsrv, v)
3844 if (this%ioutredflowcsv > 0)
then
3845 call this%maw_redflow_csv_write()
3857 class(
mawtype),
intent(inout) :: this
3865 character(len=LENBOUNDNAME) :: bname
3869 10
format(
'Boundary "', a,
'" for observation "', a, &
3870 '" is invalid in package "', a,
'"')
3873 do i = 1, this%obs%npakobs
3874 obsrv => this%obs%pakobs(i)%obsrv
3877 nn1 = obsrv%NodeNumber
3879 bname = obsrv%FeatureName
3880 if (bname /=
'')
then
3885 if (obsrv%ObsTypeId ==
'MAW' .or. &
3886 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3887 do j = 1, this%nmawwells
3888 do jj = this%iaconn(j), this%iaconn(j + 1) - 1
3889 if (this%boundname(jj) == bname)
then
3891 call obsrv%AddObsIndex(jj)
3896 do j = 1, this%nmawwells
3897 if (this%cmawname(j) == bname)
then
3899 call obsrv%AddObsIndex(j)
3903 if (.not. jfound)
then
3905 trim(bname), trim(obsrv%Name), trim(this%packName)
3910 if (obsrv%indxbnds_count == 0)
then
3911 if (obsrv%ObsTypeId ==
'MAW' .or. &
3912 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3913 nn2 = obsrv%NodeNumber2
3914 j = this%iaconn(nn1) + nn2 - 1
3915 call obsrv%AddObsIndex(j)
3917 call obsrv%AddObsIndex(nn1)
3920 errmsg =
'Programming error in maw_rp_obs'
3927 if (obsrv%ObsTypeId ==
'HEAD')
then
3928 if (obsrv%indxbnds_count > 1)
then
3929 write (
errmsg,
'(a,3(1x,a))') &
3930 trim(adjustl(obsrv%ObsTypeId)), &
3931 'for observation', trim(adjustl(obsrv%Name)), &
3932 'must be assigned to a multi-aquifer well with a unique boundname.'
3938 if (obsrv%ObsTypeId ==
'MAW' .or. &
3939 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3940 do j = 1, obsrv%indxbnds_count
3941 nn1 = obsrv%indxbnds(j)
3943 nn2 = nn1 - this%iaconn(n) + 1
3944 jj = this%iaconn(n + 1) - this%iaconn(n)
3945 if (nn1 < 1 .or. nn1 > this%maxbound)
then
3946 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3947 trim(adjustl(obsrv%ObsTypeId)), &
3948 'multi-aquifer well connection number must be greater than 0', &
3949 'and less than', jj,
'(specified value is ', nn2,
').'
3954 do j = 1, obsrv%indxbnds_count
3955 nn1 = obsrv%indxbnds(j)
3956 if (nn1 < 1 .or. nn1 > this%nmawwells)
then
3957 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3958 trim(adjustl(obsrv%ObsTypeId)), &
3959 'multi-aquifer well must be greater than 0 ', &
3960 'and less than or equal to', this%nmawwells, &
3961 '(specified value is ', nn1,
').'
3986 integer(I4B),
intent(in) :: inunitobs
3987 integer(I4B),
intent(in) :: iout
3989 integer(I4B) :: nn1, nn2
3990 integer(I4B) :: icol, istart, istop
3991 character(len=LINELENGTH) :: string
3992 character(len=LENBOUNDNAME) :: bndname
3995 string = obsrv%IDstring
4003 obsrv%FeatureName = bndname
4005 if (obsrv%ObsTypeId ==
'MAW' .or. &
4006 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
4008 if (len_trim(bndname) < 1 .and. nn2 < 0)
then
4009 write (
errmsg,
'(a,1x,a,a,1x,a,1x,a)') &
4010 'For observation type', trim(adjustl(obsrv%ObsTypeId)), &
4011 ', ID given as an integer and not as boundname,', &
4012 'but ID2 (icon) is missing. Either change ID to valid', &
4013 'boundname or supply valid entry for ID2.'
4017 obsrv%FeatureName = bndname
4021 obsrv%NodeNumber2 = nn2
4026 obsrv%NodeNumber = nn1
4036 class(
mawtype),
intent(inout) :: this
4037 character(len=*),
intent(in) :: fname
4039 character(len=*),
parameter :: fmtredflowcsv = &
4040 "(4x, 'MAW REDUCED FLOW INFORMATION WILL BE SAVED TO FILE: ', a, /4x, &
4041 &'OPENED ON UNIT: ', I0)"
4043 this%ioutredflowcsv =
getunit()
4044 call openfile(this%ioutredflowcsv, this%iout, fname,
'CSV', &
4045 filstat_opt=
'REPLACE')
4046 write (this%iout, fmtredflowcsv) trim(adjustl(fname)), &
4048 write (this%ioutredflowcsv,
'(a)') &
4049 'time,period,step,MAWnumber,rate-requested,rate-actual,maw-reduction'
4058 class(
mawtype),
intent(inout) :: this
4065 do n = 1, this%nmawwells
4068 if (this%status(n) .ne.
'ACTIVE')
then
4071 v = this%rate(n) - this%ratesim(n)
4072 if (abs(v) >
dem9)
then
4073 write (this%ioutredflowcsv,
'(*(G0,:,","))') &
4084 class(
mawtype),
intent(inout) :: this
4085 integer(I4B),
intent(in) :: i
4086 integer(I4B),
intent(in) :: j
4087 integer(I4B),
intent(in) :: node
4089 integer(I4B) :: iTcontrastErr
4090 integer(I4B) :: jpos
4094 real(DP) :: sqrtk11k22
4102 real(DP) :: Tcontrast
4127 jpos = this%get_jpos(i, j)
4130 k11 = this%gwfk11(node)
4131 if (this%gwfik22 == 0)
then
4132 k22 = this%gwfk11(node)
4134 k22 = this%gwfk22(node)
4136 sqrtk11k22 = sqrt(k11 * k22)
4139 gwftop = this%dis%top(node)
4140 gwfbot = this%dis%bot(node)
4141 tthka = gwftop - gwfbot
4142 gwfsat = this%gwfsat(node)
4146 topw = this%topscrn(jpos)
4147 botw = this%botscrn(jpos)
4151 if (gwftop == topw .and. gwfbot == botw)
then
4152 if (this%icelltype(node) == 0)
then
4153 tthkw = tthkw * gwfsat
4154 tthka = tthka * gwfsat
4159 t2pi =
dtwopi * tthka * sqrtk11k22
4162 if (this%dis%ndim == 3 .and. this%ieffradopt /= 0)
then
4165 dx = sqrt(this%dis%area(node))
4169 eradius = 0.28_dp * ((yx4 * dx)**
dtwo + &
4172 area = this%dis%area(node)
4178 if (this%ieqn(i) == 1 .or. this%ieqn(i) == 3)
then
4179 lc1 = log(eradius / this%radius(i)) / t2pi
4183 if (this%ieqn(i) == 2 .or. this%ieqn(i) == 3)
then
4185 if (tthkw * hks >
dzero)
then
4186 tcontrast = (sqrtk11k22 * tthka) / (hks * tthkw)
4187 skin = (tcontrast -
done) * log(this%sradius(jpos) / this%radius(i))
4194 if (tcontrast <= 1 .and. this%ieqn(i) == 2)
then
4196 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
4197 'Invalid calculated transmissivity contrast (', tcontrast, &
4198 ') for maw well', i,
'connection', j,
'.',
'This happens when the', &
4199 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
4200 'Consider decreasing HK_SKIN for the connection or using the', &
4201 'CUMULATIVE or MEAN conductance equations.'
4210 if (this%ieqn(i) == 4)
then
4212 ravg =
dhalf * (this%radius(i) + this%sradius(jpos))
4213 slen = this%sradius(jpos) - this%radius(i)
4215 c = hks * pavg * tthkw / slen
4220 if (this%ieqn(i) < 4)
then
4221 if (lc1 + lc2 /=
dzero)
then
4222 c =
done / (lc1 + lc2)
4230 if (c <
dzero .and. itcontrasterr == 0)
then
4231 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
4232 'Invalid calculated negative conductance (', c, &
4233 ') for maw well', i,
'connection', j,
'.',
'this happens when the', &
4234 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
4235 'consider decreasing hk_skin for the connection or using the', &
4236 'mean conductance equation.'
4243 if (this%inonvert /= 0)
then
4244 c = c * this%maw_calc_lcorr(i, jpos)
4248 this%satcond(jpos) = c
4255 class(
mawtype),
intent(inout) :: this
4256 integer(I4B),
intent(in) :: n
4257 integer(I4B),
intent(in) :: j
4258 integer(I4B),
intent(in) :: node
4259 real(DP),
intent(inout) :: sat
4260 real(DP),
intent(in),
optional :: hwell_in
4262 integer(I4B) :: jpos
4273 if (this%icelltype(node) /= 0)
then
4276 hwell = this%xnewpak(n)
4277 if (
present(hwell_in))
then
4282 jpos = this%get_jpos(n, j)
4285 topw = this%topscrn(jpos)
4286 botw = this%botscrn(jpos)
4289 if (this%inewton /= 1)
then
4290 h_temp = this%xnew(node)
4291 if (h_temp < botw)
then
4294 if (hwell < botw)
then
4297 h_temp =
dhalf * (h_temp + hwell)
4299 h_temp = this%xnew(node)
4300 if (hwell > h_temp)
then
4303 if (h_temp < botw)
then
4330 integer(I4B),
intent(in) :: n
4331 integer(I4B),
intent(in) :: j
4332 integer(I4B),
intent(inout) :: icflow
4333 real(DP),
intent(inout) :: cmaw
4334 real(DP),
intent(inout) :: cterm
4335 real(DP),
intent(inout) :: term
4336 real(DP),
intent(inout) :: flow
4337 real(DP),
intent(inout),
optional :: term2
4339 logical(LGP) :: correct_flow
4340 integer(I4B) :: inewton
4341 integer(I4B) :: jpos
4342 integer(I4B) :: igwfnode
4353 real(DP) :: dhbarterm
4354 real(DP) :: vscratio
4360 if (
present(term2))
then
4367 jpos = this%get_jpos(n, j)
4368 igwfnode = this%get_gwfnode(n, j)
4369 hgwf = this%xnew(igwfnode)
4370 hmaw = this%xnewpak(n)
4371 tmaw = this%topscrn(jpos)
4372 bmaw = this%botscrn(jpos)
4375 if (this%ivsc == 1)
then
4378 vscratio = this%viscratios(1, n)
4380 vscratio = this%viscratios(2, n)
4385 call this%maw_calculate_saturation(n, j, igwfnode, sat)
4386 cmaw = this%satcond(jpos) * vscratio * sat
4389 if (inewton == 1)
then
4393 if (hgwf > hups)
then
4401 if (this%icelltype(igwfnode) /= 0)
then
4411 if (this%correct_flow)
then
4414 en = max(bmaw, this%dis%bot(igwfnode))
4415 correct_flow = .false.
4417 correct_flow = .true.
4419 if (hgwf < en .and. this%icelltype(igwfnode) /= 0)
then
4420 correct_flow = .true.
4425 if (correct_flow)
then
4427 hdowns = min(hmaw, hgwf)
4429 if (hgwf > hmaw)
then
4430 cterm = cmaw * (hmaw - hbar)
4432 cterm = cmaw * (hbar - hgwf)
4437 if (inewton /= 0)
then
4440 if (hmaw > hgwf)
then
4442 term = drterm * this%satcond(jpos) * vscratio * (hbar - hmaw)
4444 term2 = cmaw * (dhbarterm -
done)
4449 term = -drterm * this%satcond(jpos) * vscratio * (hgwf - hbar)
4451 term2 = cmaw * (
done - dhbarterm)
4457 if (inewton /= 0)
then
4458 term = drterm * this%satcond(jpos) * vscratio * (hgwf - hmaw)
4464 if (inewton == 0)
then
4465 flow = term * (hgwf - hmaw) + cterm
4469 if (this%idense /= 0 .and. inewton == 0)
then
4470 call this%maw_calculate_density_exchange(jpos, hmaw, hgwf, cmaw, &
4471 bmaw, flow, term, cterm)
4480 integer(I4B),
intent(in) :: n
4481 real(DP),
intent(in) :: hmaw
4482 real(DP),
intent(inout) :: q
4499 if (rate <
dzero)
then
4504 if (this%shutofflevel(n) /=
dep20)
then
4505 call this%maw_calculate_qpot(n, q)
4507 if (q > -rate) q = -rate
4509 if (this%ishutoffcnt == 1)
then
4510 this%shutoffweight(n) =
done
4511 this%shutoffdq(n) =
dzero
4512 this%shutoffqold(n) = q
4515 dq = q - this%shutoffqold(n)
4516 weight = this%shutoffweight(n)
4519 if (this%shutoffdq(n) * dq <
dzero)
then
4520 weight = this%theta * this%shutoffweight(n)
4524 weight = this%shutoffweight(n) + this%kappa
4528 q = this%shutoffqold(n) + weight * dq
4530 this%shutoffqold(n) = q
4531 this%shutoffdq(n) = dq
4532 this%shutoffweight(n) = weight
4536 if (this%shutoffmin(n) >
dzero)
then
4537 if (hmaw < this%shutofflevel(n))
then
4541 if (this%ishutoff(n) /= 0)
then
4548 if (q < this%shutoffmin(n))
then
4549 if (this%ishutoffcnt > 2)
then
4550 this%ishutoff(n) = 1
4561 if (q > this%shutoffmax(n))
then
4562 if (this%ishutoffcnt <= 2)
then
4563 this%ishutoff(n) = 0
4566 if (this%ishutoff(n) /= 0)
then
4572 if (q /=
dzero) q = -q
4581 if (this%reduction_length(n) /=
dep20)
then
4582 bt = this%pumpelev(n)
4583 tp = bt + this%reduction_length(n)
4593 if (this%shutofflevel(n) /=
dep20)
then
4594 call this%maw_calculate_qpot(n, q)
4597 if (q > rate) q = rate
4599 if (this%ishutoffcnt == 1)
then
4600 this%shutoffweight(n) =
done
4601 this%shutoffdq(n) =
dzero
4602 this%shutoffqold(n) = q
4605 dq = q - this%shutoffqold(n)
4606 weight = this%shutoffweight(n)
4609 if (this%shutoffdq(n) * dq <
dzero)
then
4610 weight = this%theta * this%shutoffweight(n)
4614 weight = this%shutoffweight(n) + this%kappa
4618 q = this%shutoffqold(n) + weight * dq
4620 this%shutoffqold(n) = q
4621 this%shutoffdq(n) = dq
4622 this%shutoffweight(n) = weight
4630 if (this%reduction_length(n) /=
dep20)
then
4631 bt = this%pumpelev(n)
4632 tp = bt + this%reduction_length(n)
4645 class(
mawtype),
intent(inout) :: this
4646 integer(I4B),
intent(in) :: n
4647 real(DP),
intent(inout) :: qnet
4650 integer(I4B) :: jpos
4651 integer(I4B) :: igwfnode
4663 real(DP) :: vscratio
4669 h_temp = this%shutofflevel(n)
4672 if (this%ivsc == 1)
then
4675 vscratio = this%viscratios(1, n)
4677 vscratio = this%viscratios(2, n)
4682 if (this%iflowingwells > 0)
then
4683 if (this%fwcond(n) >
dzero)
then
4685 tp = bt + this%fwrlen(n)
4687 cfw = scale * this%fwcond(n) * this%viscratios(2, n)
4688 this%ifwdischarge(n) = 0
4689 if (cfw >
dzero)
then
4690 this%ifwdischarge(n) = 1
4693 qnet = qnet + cfw * (bt - h_temp)
4698 if (this%imawiss /= 1)
then
4699 if (this%ifwdischarge(n) /= 1)
then
4700 hdterm = this%xoldsto(n) - h_temp
4702 hdterm = this%xoldsto(n) - this%fwelev(n)
4704 qnet = qnet - (this%area(n) * hdterm /
delt)
4708 do j = 1, this%ngwfnodes(n)
4709 jpos = this%get_jpos(n, j)
4710 igwfnode = this%get_gwfnode(n, j)
4711 call this%maw_calculate_saturation(n, j, igwfnode, sat)
4712 cmaw = this%satcond(jpos) * vscratio * sat
4713 hgwf = this%xnew(igwfnode)
4714 bmaw = this%botscrn(jpos)
4719 if (hgwf < bmaw)
then
4722 qnet = qnet + cmaw * (hgwf - hv)
4734 integer(I4B) :: jpos
4735 integer(I4B) :: icflow
4736 integer(I4B) :: ibnd
4744 if (this%nbound .eq. 0)
return
4747 this%ishutoffcnt = this%ishutoffcnt + 1
4751 do n = 1, this%nmawwells
4752 hmaw = this%xnewpak(n)
4753 do j = 1, this%ngwfnodes(n)
4754 jpos = this%get_jpos(n, j)
4755 this%hcof(ibnd) =
dzero
4756 this%rhs(ibnd) =
dzero
4762 if (this%iboundpak(n) == 0)
then
4767 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, &
4770 this%simcond(jpos) = cmaw
4771 this%bound(2, ibnd) = cmaw
4772 this%hcof(ibnd) = -term
4773 this%rhs(ibnd) = -term * hmaw + cterm
4791 integer(I4B) :: nbudterm
4792 integer(I4B) :: n, j, n2
4794 integer(I4B) :: maxlist, naux
4796 character(len=LENBUDTXT) :: text
4797 character(len=LENBUDTXT),
dimension(1) :: auxtxt
4803 if (this%iflowingwells > 0)
then
4804 nbudterm = nbudterm + 1
4806 if (this%imover == 1)
then
4807 nbudterm = nbudterm + 3
4808 if (this%iflowingwells > 0)
then
4809 nbudterm = nbudterm + 1
4812 if (this%naux > 0) nbudterm = nbudterm + 1
4816 call this%budobj%budgetobject_df(this%nmawwells, nbudterm, 0, 0, &
4817 ibudcsv=this%ibudcsv)
4825 maxlist = this%maxbound
4827 auxtxt(1) =
' FLOW-AREA'
4828 call this%budobj%budterm(idx)%initialize(text, &
4833 maxlist, .false., .true., &
4835 call this%budobj%budterm(idx)%reset(this%maxbound)
4837 do n = 1, this%nmawwells
4838 do j = 1, this%ngwfnodes(n)
4839 n2 = this%get_gwfnode(n, j)
4840 call this%budobj%budterm(idx)%update_term(n, n2, q)
4847 maxlist = this%nmawwells
4849 call this%budobj%budterm(idx)%initialize(text, &
4854 maxlist, .false., .false., &
4858 if (this%iflowingwells > 0)
then
4861 maxlist = this%nmawwells
4863 call this%budobj%budterm(idx)%initialize(text, &
4868 maxlist, .false., .false., &
4875 maxlist = this%nmawwells
4877 auxtxt(1) =
' VOLUME'
4878 call this%budobj%budterm(idx)%initialize(text, &
4883 maxlist, .false., .true., &
4889 maxlist = this%nmawwells
4891 call this%budobj%budterm(idx)%initialize(text, &
4896 maxlist, .false., .false., &
4900 if (this%imover == 1)
then
4905 maxlist = this%nmawwells
4907 call this%budobj%budterm(idx)%initialize(text, &
4912 maxlist, .false., .false., &
4916 text =
' RATE-TO-MVR'
4918 maxlist = this%nmawwells
4920 call this%budobj%budterm(idx)%initialize(text, &
4925 maxlist, .false., .false., &
4929 text =
' CONSTANT-TO-MVR'
4931 maxlist = this%nmawwells
4933 call this%budobj%budterm(idx)%initialize(text, &
4938 maxlist, .false., .false., &
4942 if (this%iflowingwells > 0)
then
4945 text =
' FW-RATE-TO-MVR'
4947 maxlist = this%nmawwells
4949 call this%budobj%budterm(idx)%initialize(text, &
4954 maxlist, .false., .false., &
4966 maxlist = this%maxbound
4967 call this%budobj%budterm(idx)%initialize(text, &
4972 maxlist, .false., .false., &
4977 if (this%iprflow /= 0)
then
4978 call this%budobj%flowtable_df(this%iout)
4992 integer(I4B) :: naux
4996 integer(I4B) :: jpos
4998 integer(I4B) :: ibnd
5014 call this%budobj%budterm(idx)%reset(this%maxbound)
5016 do n = 1, this%nmawwells
5017 do j = 1, this%ngwfnodes(n)
5018 jpos = this%get_jpos(n, j)
5019 n2 = this%get_gwfnode(n, j)
5020 tmaw = this%topscrn(jpos)
5021 bmaw = this%botscrn(jpos)
5022 call this%maw_calculate_saturation(n, j, n2, sat)
5023 this%qauxcbc(1) =
dtwo *
dpi * this%radius(n) * sat * (tmaw - bmaw)
5024 q = this%qleak(ibnd)
5025 call this%budobj%budterm(idx)%update_term(n, n2, q, this%qauxcbc)
5032 call this%budobj%budterm(idx)%reset(this%nmawwells)
5033 do n = 1, this%nmawwells
5037 if (this%imover == 1 .and. q <
dzero)
then
5039 if (this%qout(n) <
dzero)
then
5040 qfact = q / this%qout(n)
5042 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
5044 call this%budobj%budterm(idx)%update_term(n, n, q)
5048 if (this%iflowingwells > 0)
then
5050 call this%budobj%budterm(idx)%reset(this%nmawwells)
5051 do n = 1, this%nmawwells
5053 if (this%imover == 1)
then
5057 if (this%qout(n) <
dzero)
then
5058 qfact = q / this%qout(n)
5060 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
5062 call this%budobj%budterm(idx)%update_term(n, n, q)
5068 call this%budobj%budterm(idx)%reset(this%nmawwells)
5069 do n = 1, this%nmawwells
5070 b = this%xsto(n) - this%bot(n)
5074 v = this%area(n) * b
5075 if (this%imawissopt /= 1)
then
5081 call this%budobj%budterm(idx)%update_term(n, n, q, this%qauxcbc)
5086 call this%budobj%budterm(idx)%reset(this%nmawwells)
5087 do n = 1, this%nmawwells
5091 if (this%imover == 1 .and. q <
dzero)
then
5093 if (this%qout(n) <
dzero)
then
5094 qfact = q / this%qout(n)
5096 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
5098 call this%budobj%budterm(idx)%update_term(n, n, q)
5102 if (this%imover == 1)
then
5106 call this%budobj%budterm(idx)%reset(this%nmawwells)
5107 do n = 1, this%nmawwells
5108 if (this%iboundpak(n) == 0)
then
5111 q = this%pakmvrobj%get_qfrommvr(n)
5113 call this%budobj%budterm(idx)%update_term(n, n, q)
5118 call this%budobj%budterm(idx)%reset(this%nmawwells)
5119 do n = 1, this%nmawwells
5120 q = this%pakmvrobj%get_qtomvr(n)
5123 q2 = this%ratesim(n)
5126 if (q2 <
dzero)
then
5127 qfact = q2 / this%qout(n)
5133 call this%budobj%budterm(idx)%update_term(n, n, q)
5138 call this%budobj%budterm(idx)%reset(this%nmawwells)
5139 do n = 1, this%nmawwells
5140 q = this%pakmvrobj%get_qtomvr(n)
5145 if (q2 <
dzero)
then
5146 qfact = q2 / this%qout(n)
5152 call this%budobj%budterm(idx)%update_term(n, n, q)
5156 if (this%iflowingwells > 0)
then
5158 call this%budobj%budterm(idx)%reset(this%nmawwells)
5159 do n = 1, this%nmawwells
5160 q = this%pakmvrobj%get_qtomvr(n)
5163 q2 = this%ratesim(n)
5167 if (this%qout(n) <
dzero)
then
5168 qfact = this%qfw(n) / this%qout(n)
5172 call this%budobj%budterm(idx)%update_term(n, n, q)
5182 call this%budobj%budterm(idx)%reset(this%nmawwells)
5183 do n = 1, this%nmawwells
5185 call this%budobj%budterm(idx)%update_term(n, n, q, this%auxvar(:, n))
5190 call this%budobj%accumulate_terms()
5204 integer(I4B) :: nterms
5205 character(len=LINELENGTH) :: title
5206 character(len=LINELENGTH) :: text
5209 if (this%iprhed > 0)
then
5213 if (this%inamedbound == 1) nterms = nterms + 1
5216 title = trim(adjustl(this%text))//
' PACKAGE ('// &
5217 trim(adjustl(this%packName))//
') HEADS FOR EACH CONTROL VOLUME'
5220 call table_cr(this%headtab, this%packName, title)
5221 call this%headtab%table_df(this%nmawwells, nterms, this%iout, &
5225 if (this%inamedbound == 1)
then
5227 call this%headtab%initialize_column(text, 20, alignment=tableft)
5232 call this%headtab%initialize_column(text, 10, alignment=tabcenter)
5236 call this%headtab%initialize_column(text, 12, alignment=tabcenter)
5244 integer(I4B) :: jpos
5247 integer(I4B),
intent(in) :: n
5248 integer(I4B),
intent(in) :: j
5252 jpos = this%iaconn(n) + j - 1
5259 integer(I4B) :: igwfnode
5262 integer(I4B),
intent(in) :: n
5263 integer(I4B),
intent(in) :: j
5265 integer(I4B) :: jpos
5268 jpos = this%get_jpos(n, j)
5269 igwfnode = this%gwfnodes(jpos)
5276 class(
mawtype),
intent(inout) :: this
5278 integer(I4B) :: i, j
5283 call mem_reallocate(this%denseterms, 3, this%MAXBOUND,
'DENSETERMS', &
5285 do i = 1, this%maxbound
5287 this%denseterms(j, i) =
dzero
5290 write (this%iout,
'(/1x,a)')
'DENSITY TERMS HAVE BEEN ACTIVATED FOR MAW &
5291 &PACKAGE: '//trim(adjustl(this%packName))
5302 class(
mawtype),
intent(inout) :: this
5309 call mem_reallocate(this%viscratios, 2, this%MAXBOUND,
'VISCRATIOS', &
5311 do i = 1, this%maxbound
5313 this%viscratios(j, i) =
done
5316 write (this%iout,
'(/1x,a)')
'VISCOSITY HAS BEEN ACTIVATED FOR MAW &
5317 &PACKAGE: '//trim(adjustl(this%packName))
5343 bmaw, flow, hcofterm, rhsterm)
5345 class(
mawtype),
intent(inout) :: this
5346 integer(I4B),
intent(in) :: iconn
5347 real(DP),
intent(in) :: hmaw
5348 real(DP),
intent(in) :: hgwf
5349 real(DP),
intent(in) :: cond
5350 real(DP),
intent(in) :: bmaw
5351 real(DP),
intent(inout) :: flow
5352 real(DP),
intent(inout) :: hcofterm
5353 real(DP),
intent(inout) :: rhsterm
5357 real(DP) :: rdensemaw
5358 real(DP) :: rdensegwf
5359 real(DP) :: rdenseavg
5364 rdensemaw = this%denseterms(1, iconn)
5365 rdensegwf = this%denseterms(2, iconn)
5366 if (rdensegwf ==
dzero)
return
5369 if (hmaw > bmaw .and. hgwf > bmaw)
then
5372 rdenseavg =
dhalf * (rdensemaw + rdensegwf)
5375 t = cond * (rdenseavg -
done) * (hgwf - hmaw)
5376 rhsterm = rhsterm + t
5380 havg =
dhalf * (hgwf + hmaw)
5381 elevavg = this%denseterms(3, iconn)
5382 t = cond * (havg - elevavg) * (rdensegwf - rdensemaw)
5383 rhsterm = rhsterm + t
5385 else if (hmaw > bmaw)
then
5388 t = (rdensemaw -
done) * rhsterm
5389 rhsterm = rhsterm + t
5391 else if (hgwf > bmaw)
then
5394 t = (rdensegwf -
done) * rhsterm
5395 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 lenpakloc
maximum length of a package location
@ disu
DISV6 discretization.
@ dis
DIS6 discretization.
@ disv
DISU6 discretization.
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 dpio180
real constant
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...
pure real(dp) function, public polygon_extent(xv, yv)
Calculate the maximum distance between two polygon vertices.
This module defines variable data types.
pure logical function, public is_close(a, b, rtol, atol, symmetric)
Check if a real value is approximately equal to another.
subroutine maw_fill_budobj(this)
Copy flow terms into thisbudobj.
subroutine maw_rp(this)
Read and Prepare.
subroutine maw_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
Extra convergence check for the MAW package.
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_read_angledata(this)
Read the optional ANGLEDATA block for non-vertical (slanted) MAW well connections.
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...
pure real(dp) function, public maw_screen_length(dz, radius, omega)
In-cell screen length of a non-vertical well connection.
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_saturation(this, n, j, node, sat, hwell_in)
Calculate the saturation between the aquifer maw well_head.
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_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.
pure real(dp) function, public maw_damp_weight(dxprop, dxold, weight, damptheta, damptol, weightmin, recover)
Update the oscillation-damping weight for a single MAW well head.
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.
real(dp) function maw_calc_lcorr(this, i, jpos)
Calculate the length correction factor for a multi-aquifer well connection.
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)
Apply Newton under-relaxation to the MAW Package well heads.
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.
real(dp) function maw_cell_extent(this, node, estimated)
Maximum horizontal extent of a cell.
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.