40 character(len=LENFTYPE) ::
ftype =
'MAW'
41 character(len=LENPACKAGENAME) ::
text =
' MAW'
52 character(len=LENBUDTXT),
dimension(:),
pointer, &
53 contiguous :: cmawbudget => null()
54 character(len=LENAUXNAME),
dimension(:),
pointer, &
55 contiguous :: cauxcbc => null()
58 logical(LGP),
pointer :: correct_flow => null()
61 integer(I4B),
pointer :: iprhed => null()
62 integer(I4B),
pointer :: iheadout => null()
63 integer(I4B),
pointer :: ibudgetout => null()
64 integer(I4B),
pointer :: ibudcsv => null()
65 integer(I4B),
pointer :: cbcauxitems => null()
66 integer(I4B),
pointer :: iflowingwells => null()
67 integer(I4B),
pointer :: imawiss => null()
68 integer(I4B),
pointer :: imawissopt => null()
69 integer(I4B),
pointer :: nmawwells => null()
70 integer(I4B),
pointer :: check_attr => null()
71 integer(I4B),
pointer :: ishutoffcnt => null()
72 integer(I4B),
pointer :: ieffradopt => null()
73 integer(I4B),
pointer :: inonvert => null()
74 integer(I4B),
pointer :: ioutredflowcsv => null()
75 real(dp),
pointer :: satomega => null()
78 real(dp),
pointer :: theta => null()
79 real(dp),
pointer :: kappa => null()
82 character(len=8),
dimension(:),
pointer,
contiguous :: status => null()
83 integer(I4B),
dimension(:),
pointer,
contiguous :: ngwfnodes => null()
84 integer(I4B),
dimension(:),
pointer,
contiguous :: ieqn => null()
85 integer(I4B),
dimension(:),
pointer,
contiguous :: ishutoff => null()
86 integer(I4B),
dimension(:),
pointer,
contiguous :: ifwdischarge => null()
87 real(dp),
dimension(:),
pointer,
contiguous :: strt => null()
88 real(dp),
dimension(:),
pointer,
contiguous :: radius => null()
89 real(dp),
dimension(:),
pointer,
contiguous :: area => null()
90 real(dp),
dimension(:),
pointer,
contiguous :: pumpelev => null()
91 real(dp),
dimension(:),
pointer,
contiguous :: bot => null()
92 real(dp),
dimension(:),
pointer,
contiguous :: ratesim => null()
93 real(dp),
dimension(:),
pointer,
contiguous :: qsim0 => null()
94 real(dp),
dimension(:),
pointer,
contiguous :: reduction_length => null()
95 real(dp),
dimension(:),
pointer,
contiguous :: fwelev => null()
96 real(dp),
dimension(:),
pointer,
contiguous :: fwcond => null()
97 real(dp),
dimension(:),
pointer,
contiguous :: fwrlen => null()
98 real(dp),
dimension(:),
pointer,
contiguous :: fwcondsim => null()
99 real(dp),
dimension(:),
pointer,
contiguous :: xsto => null()
100 real(dp),
dimension(:),
pointer,
contiguous :: xoldsto => null()
101 real(dp),
dimension(:),
pointer,
contiguous :: shutoffmin => null()
102 real(dp),
dimension(:),
pointer,
contiguous :: shutoffmax => null()
103 real(dp),
dimension(:),
pointer,
contiguous :: shutofflevel => null()
104 real(dp),
dimension(:),
pointer,
contiguous :: shutoffweight => null()
105 real(dp),
dimension(:),
pointer,
contiguous :: shutoffdq => null()
106 real(dp),
dimension(:),
pointer,
contiguous :: shutoffqold => null()
107 real(dp),
dimension(:),
pointer,
contiguous :: nurdxold => null()
108 real(dp),
dimension(:),
pointer,
contiguous :: nurweight => null()
109 character(len=LENBOUNDNAME),
dimension(:),
pointer, &
110 contiguous :: cmawname => null()
113 real(dp),
dimension(:),
pointer,
contiguous :: rate => null()
114 real(dp),
dimension(:),
pointer,
contiguous :: well_head => null()
115 real(dp),
dimension(:, :),
pointer,
contiguous :: mauxvar => null()
118 integer(I4B),
dimension(:),
pointer,
contiguous :: iaconn => null()
121 integer(I4B),
dimension(:),
pointer,
contiguous :: gwfnodes => null()
122 real(dp),
dimension(:),
pointer,
contiguous :: sradius => null()
123 real(dp),
dimension(:),
pointer,
contiguous :: hk => null()
124 real(dp),
dimension(:),
pointer,
contiguous :: satcond => null()
125 real(dp),
dimension(:),
pointer,
contiguous :: simcond => null()
126 real(dp),
dimension(:),
pointer,
contiguous :: topscrn => null()
127 real(dp),
dimension(:),
pointer,
contiguous :: botscrn => null()
128 real(dp),
dimension(:),
pointer,
contiguous :: angle => null()
129 real(dp),
dimension(:),
pointer,
contiguous :: connlen => null()
130 real(dp),
dimension(:),
pointer,
contiguous :: usrtopscrn => null()
131 real(dp),
dimension(:),
pointer,
contiguous :: usrbotscrn => null()
134 integer(I4B),
dimension(:),
pointer,
contiguous :: imap => null()
137 real(dp),
dimension(:),
pointer,
contiguous :: qauxcbc => null()
138 real(dp),
dimension(:),
pointer,
contiguous :: dbuff => null()
139 real(dp),
dimension(:),
pointer,
contiguous :: qleak => null()
140 real(dp),
dimension(:),
pointer,
contiguous :: qout => null()
141 real(dp),
dimension(:),
pointer,
contiguous :: qfw => null()
142 real(dp),
dimension(:),
pointer,
contiguous :: qsto => null()
143 real(dp),
dimension(:),
pointer,
contiguous :: qconst => null()
146 integer(I4B),
pointer :: bditems => null()
153 integer(I4B),
pointer :: gwfiss => null()
154 real(dp),
dimension(:),
pointer,
contiguous :: gwfk11 => null()
155 real(dp),
dimension(:),
pointer,
contiguous :: gwfk22 => null()
156 integer(I4B),
pointer :: gwfik22 => null()
157 real(dp),
dimension(:),
pointer,
contiguous :: gwfsat => null()
160 integer(I4B),
dimension(:),
pointer,
contiguous :: idxlocnode => null()
161 integer(I4B),
dimension(:),
pointer,
contiguous :: idxdglo => null()
162 integer(I4B),
dimension(:),
pointer,
contiguous :: idxoffdglo => null()
163 integer(I4B),
dimension(:),
pointer,
contiguous :: idxsymdglo => null()
164 integer(I4B),
dimension(:),
pointer,
contiguous :: idxsymoffdglo => null()
165 integer(I4B),
dimension(:),
pointer,
contiguous :: iboundpak => null()
166 real(dp),
dimension(:),
pointer,
contiguous :: xnewpak => null()
167 real(dp),
dimension(:),
pointer,
contiguous :: xoldpak => null()
170 integer(I4B),
pointer :: idense
171 real(dp),
dimension(:, :),
pointer,
contiguous :: denseterms => null()
174 real(dp),
dimension(:, :),
pointer,
contiguous :: viscratios => null()
246 subroutine maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
248 class(
bndtype),
pointer :: packobj
249 integer(I4B),
intent(in) :: id
250 integer(I4B),
intent(in) :: ibcnum
251 integer(I4B),
intent(in) :: inunit
252 integer(I4B),
intent(in) :: iout
253 character(len=*),
intent(in) :: namemodel
254 character(len=*),
intent(in) :: pakname
255 type(
mawtype),
pointer :: mawobj
262 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
266 call mawobj%maw_allocate_scalars()
269 call packobj%pack_initialize()
271 packobj%inunit = inunit
274 packobj%ibcnum = ibcnum
287 class(
mawtype),
intent(inout) :: this
290 call this%BndType%allocate_scalars()
293 call mem_allocate(this%correct_flow,
'CORRECT_FLOW', this%memoryPath)
294 call mem_allocate(this%iprhed,
'IPRHED', this%memoryPath)
295 call mem_allocate(this%iheadout,
'IHEADOUT', this%memoryPath)
296 call mem_allocate(this%ibudgetout,
'IBUDGETOUT', this%memoryPath)
297 call mem_allocate(this%ibudcsv,
'IBUDCSV', this%memoryPath)
298 call mem_allocate(this%iflowingwells,
'IFLOWINGWELLS', this%memoryPath)
299 call mem_allocate(this%imawiss,
'IMAWISS', this%memoryPath)
300 call mem_allocate(this%imawissopt,
'IMAWISSOPT', this%memoryPath)
301 call mem_allocate(this%nmawwells,
'NMAWWELLS', this%memoryPath)
302 call mem_allocate(this%check_attr,
'CHECK_ATTR', this%memoryPath)
303 call mem_allocate(this%ishutoffcnt,
'ISHUTOFFCNT', this%memoryPath)
304 call mem_allocate(this%ieffradopt,
'IEFFRADOPT', this%memoryPath)
305 call mem_allocate(this%inonvert,
'INONVERT', this%memoryPath)
306 call mem_allocate(this%ioutredflowcsv,
'IOUTREDFLOWCSV', this%memoryPath)
307 call mem_allocate(this%satomega,
'SATOMEGA', this%memoryPath)
308 call mem_allocate(this%bditems,
'BDITEMS', this%memoryPath)
311 call mem_allocate(this%cbcauxitems,
'CBCAUXITEMS', this%memoryPath)
312 call mem_allocate(this%idense,
'IDENSE', this%memoryPath)
315 this%correct_flow = .false.
321 this%iflowingwells = 0
326 this%ioutredflowcsv = 0
327 this%satomega =
dzero
342 class(
mawtype),
intent(inout) :: this
353 this%cmawbudget(1) =
' GWF'
354 this%cmawbudget(2) =
' RATE'
355 this%cmawbudget(3) =
' STORAGE'
356 this%cmawbudget(4) =
' CONSTANT'
357 this%cmawbudget(5) =
' FW-RATE'
358 this%cmawbudget(6) =
' FROM-MVR'
359 this%cmawbudget(7) =
' RATE-TO-MVR'
360 this%cmawbudget(8) =
' FW-RATE-TO-MVR'
365 call mem_allocate(this%status, 8, this%nmawwells,
'STATUS', this%memoryPath)
368 call mem_allocate(this%ngwfnodes, this%nmawwells,
'NGWFNODES', &
370 call mem_allocate(this%ieqn, this%nmawwells,
'IEQN', this%memoryPath)
371 call mem_allocate(this%ishutoff, this%nmawwells,
'ISHUTOFF', this%memoryPath)
372 call mem_allocate(this%ifwdischarge, this%nmawwells,
'IFWDISCHARGE', &
374 call mem_allocate(this%strt, this%nmawwells,
'STRT', this%memoryPath)
375 call mem_allocate(this%radius, this%nmawwells,
'RADIUS', this%memoryPath)
376 call mem_allocate(this%area, this%nmawwells,
'AREA', this%memoryPath)
377 call mem_allocate(this%pumpelev, this%nmawwells,
'PUMPELEV', this%memoryPath)
378 call mem_allocate(this%bot, this%nmawwells,
'BOT', this%memoryPath)
379 call mem_allocate(this%ratesim, this%nmawwells,
'RATESIM', this%memoryPath)
380 call mem_allocate(this%qsim0, this%nmawwells,
'QSIM0', this%memoryPath)
381 call mem_allocate(this%reduction_length, this%nmawwells,
'REDUCTION_LENGTH', &
383 call mem_allocate(this%fwelev, this%nmawwells,
'FWELEV', this%memoryPath)
384 call mem_allocate(this%fwcond, this%nmawwells,
'FWCONDS', this%memoryPath)
385 call mem_allocate(this%fwrlen, this%nmawwells,
'FWRLEN', this%memoryPath)
386 call mem_allocate(this%fwcondsim, this%nmawwells,
'FWCONDSIM', &
388 call mem_allocate(this%xsto, this%nmawwells,
'XSTO', this%memoryPath)
389 call mem_allocate(this%xoldsto, this%nmawwells,
'XOLDSTO', this%memoryPath)
390 call mem_allocate(this%shutoffmin, this%nmawwells,
'SHUTOFFMIN', &
392 call mem_allocate(this%shutoffmax, this%nmawwells,
'SHUTOFFMAX', &
394 call mem_allocate(this%shutofflevel, this%nmawwells,
'SHUTOFFLEVEL', &
396 call mem_allocate(this%shutoffweight, this%nmawwells,
'SHUTOFFWEIGHT', &
398 call mem_allocate(this%shutoffdq, this%nmawwells,
'SHUTOFFDQ', &
400 call mem_allocate(this%shutoffqold, this%nmawwells,
'SHUTOFFQOLD', &
402 call mem_allocate(this%nurdxold, this%nmawwells,
'NURDXOLD', &
404 call mem_allocate(this%nurweight, this%nmawwells,
'NURWEIGHT', &
408 call mem_allocate(this%rate, this%nmawwells,
'RATE', this%memoryPath)
409 call mem_allocate(this%well_head, this%nmawwells,
'WELL_HEAD', &
411 if (this%naux > 0)
then
416 call mem_allocate(this%mauxvar, jj, this%nmawwells,
'MAUXVAR', &
420 if (this%iheadout > 0)
then
421 call mem_allocate(this%dbuff, this%nmawwells,
'DBUFF', this%memoryPath)
423 call mem_allocate(this%dbuff, 0,
'DBUFF', this%memoryPath)
427 call mem_allocate(this%iaconn, this%nmawwells + 1,
'IACONN', this%memoryPath)
430 call mem_allocate(this%imap, this%MAXBOUND,
'IMAP', this%memoryPath)
433 call mem_allocate(this%gwfnodes, this%maxbound,
'GWFNODES', this%memoryPath)
434 call mem_allocate(this%sradius, this%maxbound,
'SRADIUS', this%memoryPath)
435 call mem_allocate(this%hk, this%maxbound,
'HK', this%memoryPath)
436 call mem_allocate(this%satcond, this%maxbound,
'SATCOND', this%memoryPath)
437 call mem_allocate(this%simcond, this%maxbound,
'SIMCOND', this%memoryPath)
438 call mem_allocate(this%topscrn, this%maxbound,
'TOPSCRN', this%memoryPath)
439 call mem_allocate(this%botscrn, this%maxbound,
'BOTSCRN', this%memoryPath)
440 call mem_allocate(this%angle, this%maxbound,
'ANGLE', this%memoryPath)
441 call mem_allocate(this%connlen, this%maxbound,
'CONNLEN', this%memoryPath)
442 call mem_allocate(this%usrtopscrn, this%maxbound,
'USRTOPSCRN', &
444 call mem_allocate(this%usrbotscrn, this%maxbound,
'USRBOTSCRN', &
448 call mem_allocate(this%qleak, this%maxbound,
'QLEAK', this%memoryPath)
451 do n = 1, this%nmawwells
452 this%status(n) =
'ACTIVE'
453 this%ngwfnodes(n) = 0
456 this%ifwdischarge(n) = 0
458 this%radius(n) =
dep20
460 this%pumpelev(n) =
dep20
462 this%ratesim(n) =
dzero
463 this%qsim0(n) =
dzero
464 this%reduction_length(n) =
dep20
465 this%fwelev(n) =
dzero
466 this%fwcond(n) =
dzero
467 this%fwrlen(n) =
dzero
468 this%fwcondsim(n) =
dzero
470 this%xoldsto(n) =
dzero
471 this%shutoffmin(n) =
dzero
472 this%shutoffmax(n) =
dzero
473 this%shutofflevel(n) =
dep20
474 this%shutoffweight(n) =
done
475 this%shutoffdq(n) =
done
476 this%shutoffqold(n) =
done
477 this%nurdxold(n) =
dzero
478 this%nurweight(n) =
done
482 this%well_head(n) =
dzero
483 do jj = 1, max(1, this%naux)
484 this%mauxvar(jj, n) =
dzero
488 if (this%iheadout > 0)
then
489 this%dbuff(n) =
dzero
494 do n = 1, this%nmawwells + 1
503 call mem_allocate(this%qauxcbc, this%cbcauxitems,
'QAUXCBC', this%memoryPath)
504 do j = 1, this%cbcauxitems
505 this%qauxcbc(j) =
dzero
509 if (this%iflowingwells /= 0)
then
510 call mem_allocate(this%qfw, this%nmawwells,
'QFW', this%memoryPath)
514 call mem_allocate(this%qout, this%nmawwells,
'QOUT', this%memoryPath)
515 call mem_allocate(this%qsto, this%nmawwells,
'QSTO', this%memoryPath)
516 call mem_allocate(this%qconst, this%nmawwells,
'QCONST', this%memoryPath)
519 do n = 1, this%nmawwells
520 if (this%iflowingwells > 0)
then
524 this%qconst(n) =
dzero
528 do j = 1, this%maxbound
531 this%sradius(j) =
dzero
533 this%satcond(j) =
dzero
534 this%simcond(j) =
dzero
535 this%topscrn(j) =
dzero
536 this%botscrn(j) =
dzero
537 this%angle(j) =
dzero
538 this%connlen(j) =
dzero
539 this%usrtopscrn(j) =
dzero
540 this%usrbotscrn(j) =
dzero
541 this%qleak(j) =
dzero
545 call mem_allocate(this%denseterms, 3, 0,
'DENSETERMS', this%memoryPath)
548 call mem_allocate(this%viscratios, 2, 0,
'VISCRATIOS', this%memoryPath)
557 class(
mawtype),
intent(inout) :: this
561 call this%BndType%allocate_arrays()
570 class(
mawtype),
intent(inout) :: this
572 character(len=LINELENGTH) :: text
573 character(len=LINELENGTH) :: keyword
574 character(len=LINELENGTH) :: cstr
575 character(len=LENBOUNDNAME) :: bndName
576 character(len=LENBOUNDNAME) :: bndNameTemp
577 character(len=9) :: cno
579 logical :: endOfBlock
590 real(DP),
pointer :: bndElem => null()
592 character(len=LINELENGTH),
dimension(:),
allocatable :: strttext
593 character(len=LENBOUNDNAME),
dimension(:),
allocatable :: nametxt
594 character(len=50),
dimension(:, :),
allocatable :: caux
595 integer(I4B),
dimension(:),
allocatable :: nboundchk
596 integer(I4B),
dimension(:),
allocatable :: wellieqn
597 integer(I4B),
dimension(:),
allocatable :: ngwfnodes
598 real(DP),
dimension(:),
allocatable :: radius
599 real(DP),
dimension(:),
allocatable :: bottom
601 character(len=*),
parameter :: fmthdbot = &
602 "('well head (', G0, ') must be greater than or equal to the &
603 &BOTTOM_ELEVATION (', G0, ').')"
606 allocate (strttext(this%nmawwells))
607 allocate (nametxt(this%nmawwells))
608 if (this%naux > 0)
then
609 allocate (caux(this%naux, this%nmawwells))
611 allocate (nboundchk(this%nmawwells))
612 allocate (wellieqn(this%nmawwells))
613 allocate (ngwfnodes(this%nmawwells))
614 allocate (radius(this%nmawwells))
615 allocate (bottom(this%nmawwells))
618 do n = 1, this%nmawwells
626 this%npakeq = this%nmawwells
630 call this%parser%GetBlock(
'PACKAGEDATA', isfound, ierr, &
631 supportopenclose=.true.)
635 write (this%iout,
'(/1x,a)') &
636 'PROCESSING '//trim(adjustl(this%text))//
' PACKAGEDATA'
638 call this%parser%GetNextLine(endofblock)
640 ival = this%parser%GetInteger()
643 if (n < 1 .or. n > this%nmawwells)
then
644 write (
errmsg,
'(a,1x,i0,a)') &
645 'IMAW must be greater than 0 and less than or equal to', &
652 nboundchk(n) = nboundchk(n) + 1
655 rval = this%parser%GetDouble()
656 if (rval <= dzero)
then
657 write (
errmsg,
'(a,1x,i0,1x,a)') &
658 'Radius for well', n,
'must be greater than zero.'
664 bottom(n) = this%parser%GetDouble()
667 call this%parser%GetString(strttext(n))
670 call this%parser%GetStringCaps(keyword)
671 if (keyword ==
'SPECIFIED')
then
673 else if (keyword ==
'THIEM')
then
675 else if (keyword ==
'THEIM')
then
677 write (
warnmsg,
'(a,a,a,a,a,a)') &
678 "CONDEQN in '", trim(this%packName),
"' should be ", &
679 "corrected from '", trim(keyword),
"' to 'THIEM'."
681 else if (keyword ==
'SKIN')
then
683 else if (keyword ==
'CUMULATIVE')
then
685 else if (keyword ==
'MEAN')
then
688 write (
errmsg,
'(a,1x,i0,1x,a)') &
689 'CONDEQN for well', n, &
690 "must be 'CUMULATIVE', 'THIEM', 'MEAN', or 'SKIN'."
695 ival = this%parser%GetInteger()
698 write (
errmsg,
'(a,1x,i0,1x,a)') &
699 'NGWFNODES for well', n,
'must be greater than zero.'
712 call this%parser%GetString(caux(jj, n))
716 write (cno,
'(i9.9)') n
717 bndname =
'MAWWELL'//cno
720 if (this%inamedbound /= 0)
then
721 call this%parser%GetStringCaps(bndnametemp)
722 if (bndnametemp /=
'')
then
723 bndname = bndnametemp
729 write (this%iout,
'(1x,a)') &
730 'END OF '//trim(adjustl(this%text))//
' PACKAGEDATA'
733 do n = 1, this%nmawwells
734 if (nboundchk(n) == 0)
then
735 write (
errmsg,
'(a,1x,i0,a)')
'No data specified for maw well', n,
'.'
737 else if (nboundchk(n) > 1)
then
738 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
739 'Data for maw well', n,
'specified', nboundchk(n),
'times.'
744 call store_error(
'Required packagedata block not found.')
749 call this%parser%StoreErrorUnit()
754 write (this%iout,
'(//4x,a,i7)')
'MAXBOUND = ', this%maxbound
757 call this%maw_allocate_well_conn_arrays()
760 do n = 1, this%nmawwells
762 this%radius(n) = rval
763 this%area(n) = dpi * rval**dtwo
764 this%bot(n) = bottom(n)
765 this%ieqn(n) = wellieqn(n)
766 this%ngwfnodes(n) = ngwfnodes(n)
767 this%cmawname(n) = nametxt(n)
773 bndelem => this%well_head(n)
775 this%packName,
'BND', this%tsManager, &
776 this%iprpak,
'WELL_HEAD')
779 this%strt(n) = this%well_head(n)
782 if (this%strt(n) < this%bot(n))
then
783 write (cstr, fmthdbot) this%strt(n), this%bot(n)
784 call this%maw_set_attribute_error(n,
'STRT', trim(cstr))
791 bndelem => this%mauxvar(jj, ii)
793 'AUX', this%tsManager, this%iprpak, &
801 do n = 1, this%nmawwells
802 do j = 1, this%ngwfnodes(n)
806 this%iaconn(n + 1) = idx + 1
810 deallocate (strttext)
812 if (this%naux > 0)
then
815 deallocate (nboundchk)
816 deallocate (wellieqn)
817 deallocate (ngwfnodes)
827 class(
mawtype),
intent(inout) :: this
829 character(len=LINELENGTH) :: cellid
830 character(len=30) :: nodestr
832 logical :: endOfBlock
842 integer(I4B) :: ireset_scrntop
843 integer(I4B) :: ireset_scrnbot
844 integer(I4B) :: ireset_wellbot
849 integer(I4B),
dimension(:),
pointer,
contiguous :: nboundchk
850 integer(I4B),
dimension(:),
pointer,
contiguous :: iachk
858 allocate (iachk(this%nmawwells + 1))
860 do n = 1, this%nmawwells
861 iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
863 allocate (nboundchk(this%maxbound))
864 do n = 1, this%maxbound
869 call this%parser%GetBlock(
'CONNECTIONDATA', isfound, ierr, &
870 supportopenclose=.true.)
874 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
877 call this%parser%GetNextLine(endofblock)
881 ival = this%parser%GetInteger()
885 if (n < 1 .or. n > this%nmawwells)
then
886 write (
errmsg,
'(a,1x,i0,a)') &
887 'IMAW must be greater than 0 and less than or equal to ', &
894 ival = this%parser%GetInteger()
895 if (ival < 1 .or. ival > this%ngwfnodes(n))
then
896 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
897 'JCONN for well ', n, &
898 'must be greater than 1 and less than or equal to ', &
899 this%ngwfnodes(n),
'.'
904 ipos = iachk(n) + ival - 1
905 nboundchk(ipos) = nboundchk(ipos) + 1
908 jpos = this%get_jpos(n, ival)
911 call this%parser%GetCellid(this%dis%ndim, cellid)
912 nn = this%dis%noder_from_cellid(cellid, this%inunit, this%iout)
913 topnn = this%dis%top(nn)
914 botnn = this%dis%bot(nn)
918 this%gwfnodes(jpos) = nn
921 rval = this%parser%GetDouble()
924 this%usrtopscrn(jpos) = rval
925 if (this%ieqn(n) /= 4)
then
928 if (rval > topnn)
then
929 ireset_scrntop = ireset_scrntop + 1
933 this%topscrn(jpos) = rval
936 rval = this%parser%GetDouble()
939 this%usrbotscrn(jpos) = rval
940 if (this%ieqn(n) /= 4)
then
943 if (rval < botnn)
then
944 ireset_scrnbot = ireset_scrnbot + 1
948 this%botscrn(jpos) = rval
952 if (rval < botw)
then
953 if (this%ieqn(n) /= 4)
then
954 ireset_wellbot = ireset_wellbot + 1
958 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
959 'Screen bottom for maw well', n,
'connection', j,
'(', &
960 this%botscrn(jpos),
') is less than the well bottom (', &
967 rval = this%parser%GetDouble()
968 if (this%ieqn(n) == 0)
then
969 this%satcond(jpos) = rval
970 else if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
971 this%ieqn(n) == 4)
then
976 rval = this%parser%GetDouble()
977 if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
978 this%ieqn(n) == 4)
then
979 this%sradius(jpos) = rval
980 if (this%sradius(jpos) <= this%radius(n))
then
981 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
982 'Screen radius for maw well', n,
'connection', j,
'(', &
983 this%sradius(jpos), &
984 ') is less than or equal to the well radius (', &
990 write (this%iout,
'(1x,a)') &
991 'END OF '//trim(adjustl(this%text))//
' CONNECTIONDATA'
994 do n = 1, this%nmawwells
995 do j = 1, this%ngwfnodes(n)
999 if (nboundchk(ipos) == 0)
then
1000 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
1001 'No data specified for maw well', n,
'connection', j,
'.'
1003 else if (nboundchk(ipos) > 1)
then
1004 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,1x,i0,1x,a)') &
1005 'Data for maw well', n,
'connection', j, &
1006 'specified', nboundchk(n),
'times.'
1014 do n = 1, this%nmawwells
1015 if (this%ieqn(n) /= 4)
then
1016 do j = 1, this%ngwfnodes(n)
1017 nn = this%get_gwfnode(n, j)
1018 do jj = 1, this%ngwfnodes(n)
1024 nn2 = this%get_gwfnode(n, jj)
1026 call this%dis%noder_to_string(nn, nodestr)
1027 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,3(1x,a))') &
1028 'Only one connection can be specified for maw well', &
1029 n,
'connection', j,
'to gwf cell', trim(adjustl(nodestr)), &
1030 'unless the mean condeqn is specified.'
1038 call store_error(
'Required connectiondata block not found.')
1043 deallocate (nboundchk)
1046 if (ireset_scrntop > 0)
then
1047 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1048 'The screen tops in multi-aquifer well package', trim(this%packName), &
1049 'were reset to the top of the connected cell', ireset_scrntop,
'times.'
1052 if (ireset_scrnbot > 0)
then
1053 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1054 'The screen bottoms in multi-aquifer well package', trim(this%packName), &
1055 'were reset to the bottom of the connected cell', ireset_scrnbot, &
1059 if (ireset_wellbot > 0)
then
1060 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1061 'The well bottoms in multi-aquifer well package', trim(this%packName), &
1062 'were reset to the bottom of the connected cell', ireset_wellbot, &
1069 call this%parser%StoreErrorUnit()
1087 class(
mawtype),
intent(inout) :: this
1090 logical :: endOfBlock
1091 logical(LGP) :: success
1092 integer(I4B) :: ierr
1093 integer(I4B) :: ival
1096 integer(I4B) :: jpos
1097 integer(I4B) :: ipos
1098 integer(I4B) :: node
1100 real(DP) :: conn_len
1105 integer(I4B),
dimension(:),
pointer,
contiguous :: nboundchk
1106 integer(I4B),
dimension(:),
pointer,
contiguous :: iachk
1111 real(DP),
parameter :: coszero =
dem6
1113 real(DP),
parameter :: dninety = 9.0d1
1116 call this%parser%GetBlock(
'ANGLEDATA', isfound, ierr, &
1117 supportopenclose=.true., blockrequired=.false.)
1124 if (this%inonvert == 0)
then
1125 call store_error(
'An ANGLEDATA block was specified but the '// &
1126 'NON_VERTICAL_WELLS option was not specified in the '// &
1128 call this%parser%StoreErrorUnit()
1133 allocate (iachk(this%nmawwells + 1))
1135 do n = 1, this%nmawwells
1136 iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
1138 allocate (nboundchk(this%maxbound))
1139 do n = 1, this%maxbound
1143 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1146 call this%parser%GetNextLine(endofblock)
1147 if (endofblock)
exit
1150 ival = this%parser%GetInteger()
1152 if (n < 1 .or. n > this%nmawwells)
then
1153 write (
errmsg,
'(a,1x,i0,a)') &
1154 'IFNO must be greater than 0 and less than or equal to ', &
1161 ival = this%parser%GetInteger()
1162 if (ival < 1 .or. ival > this%ngwfnodes(n))
then
1163 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
1164 'ICON for well ', n, &
1165 'must be greater than 0 and less than or equal to ', &
1166 this%ngwfnodes(n),
'.'
1171 jpos = this%get_jpos(n, j)
1174 ipos = iachk(n) + j - 1
1175 nboundchk(ipos) = nboundchk(ipos) + 1
1176 if (nboundchk(ipos) > 1)
then
1177 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1178 'ANGLEDATA for maw well', n,
'connection', j, &
1179 'is specified more than once.'
1184 angle = this%parser%GetDouble()
1187 call this%parser%TryGetDouble(conn_len, success)
1188 if (.not. success)
then
1193 this%angle(jpos) = angle
1194 this%connlen(jpos) = conn_len
1197 if (angle <
dzero .or. angle > dninety)
then
1198 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1199 'ANGLE for maw well', n,
'connection', j,
'(', angle, &
1200 ') must be greater than or equal to 0.0 and less than or '// &
1201 'equal to 90.0 degrees.'
1212 if (this%ieqn(n) == 0)
then
1213 node = this%get_gwfnode(n, j)
1214 this%topscrn(jpos) = min(this%usrtopscrn(jpos), this%dis%top(node))
1215 this%botscrn(jpos) = max(this%usrbotscrn(jpos), this%dis%bot(node))
1219 dz = this%topscrn(jpos) - this%botscrn(jpos)
1220 if (dz <=
dzero)
then
1221 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1222 'The screen top must be greater than the screen bottom for maw '// &
1223 'well', n,
'connection', j,
'listed in the ANGLEDATA block.'
1236 if (this%ieqn(n) /= 0)
then
1237 if (cos(omega) <= coszero .and. conn_len <=
dzero)
then
1238 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1239 'A connection length must be specified for the (near) '// &
1240 'horizontal maw well', n,
'connection', j, &
1241 'listed in the ANGLEDATA block.'
1245 if (conn_len >
dzero)
then
1248 lw = (dz -
dtwo * this%radius(n) * sin(omega)) / cos(omega)
1250 if (lw <=
dzero)
then
1251 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1252 'The calculated in-cell screen length for maw well', n, &
1253 'connection', j,
'(', lw, &
1254 ') is not greater than zero. Specify a connection length in '// &
1255 'the ANGLEDATA block.'
1264 if (cos(omega) <= coszero .and. &
1265 this%ieqn(n) /= 4 .and. this%ieqn(n) /= 0)
then
1266 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1267 'The (near) horizontal maw well', n,
'connection', j, &
1268 'uses a radial conductance equation (THIEM, SKIN, or '// &
1269 'CUMULATIVE). The calculated conductance is an approximation '// &
1270 'for horizontal connections; the MEAN conductance equation is '// &
1271 'recommended for horizontal connections.'
1281 if (cos(omega) <= coszero .and. &
1282 (this%ieqn(n) == 4 .or. this%ieqn(n) == 0))
then
1283 topexp = this%botscrn(jpos) +
dtwo * this%radius(n)
1284 if (
is_close(this%topscrn(jpos), topexp))
then
1285 this%topscrn(jpos) = topexp
1287 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1288 'The vertical screen extent (SCRN_TOP - SCRN_BOT) for the '// &
1289 '(near) horizontal maw well', n,
'connection', j, &
1290 'is not equal to the well diameter (2 * RADIUS = ', &
1291 dtwo * this%radius(n), &
1292 '). The vertical screen extent is used to determine the '// &
1293 'saturation of a connection and should equal the well '// &
1294 'diameter for a horizontal connection.'
1299 write (this%iout,
'(1x,a)') &
1300 'END OF '//trim(adjustl(this%text))//
' ANGLEDATA'
1304 deallocate (nboundchk)
1309 if (this%inonvert /= 0)
then
1311 'The NON_VERTICAL_WELLS option was specified but an ANGLEDATA '// &
1312 'block was not found. All multi-aquifer well connections will be '// &
1313 'treated as vertical.'
1320 call this%parser%StoreErrorUnit()
1337 class(
mawtype),
intent(inout) :: this
1338 integer(I4B),
intent(in) :: i
1339 integer(I4B),
intent(in) :: jpos
1349 if (this%angle(jpos) ==
dzero .and. this%connlen(jpos) <=
dzero)
then
1354 dz = this%topscrn(jpos) - this%botscrn(jpos)
1355 if (dz <=
dzero)
then
1361 if (this%connlen(jpos) >
dzero)
then
1362 lw = this%connlen(jpos)
1364 omega = this%angle(jpos) *
dpio180
1365 lw = (dz -
dtwo * this%radius(i) * sin(omega)) / cos(omega)
1376 class(
mawtype),
intent(inout) :: this
1378 character(len=LENBOUNDNAME) :: keyword
1379 integer(I4B) :: ierr
1380 logical :: isfound, endOfBlock
1388 call this%parser%GetBlock(
'DIMENSIONS', isfound, ierr, &
1389 supportopenclose=.true.)
1393 write (this%iout,
'(/1x,a)') &
1394 'PROCESSING '//trim(adjustl(this%text))//
' DIMENSIONS'
1396 call this%parser%GetNextLine(endofblock)
1397 if (endofblock)
exit
1398 call this%parser%GetStringCaps(keyword)
1399 select case (keyword)
1401 this%nmawwells = this%parser%GetInteger()
1402 write (this%iout,
'(4x,a,i0)')
'NMAWWELLS = ', this%nmawwells
1405 'Unknown '//trim(this%text)//
' dimension: ', trim(keyword),
'.'
1409 write (this%iout,
'(1x,a)') &
1410 'END OF '//trim(adjustl(this%text))//
' DIMENSIONS'
1412 call store_error(
'Required dimensions block not found.', terminate=.true.)
1416 if (this%nmawwells < 0)
then
1418 'NMAWWELLS was not specified or was specified incorrectly.'
1424 call this%parser%StoreErrorUnit()
1428 call this%maw_read_wells()
1431 call this%maw_read_well_connections()
1434 call this%maw_read_angledata()
1438 call this%define_listlabel()
1441 call this%maw_setup_budobj()
1444 call this%maw_setup_tableobj()
1454 class(
mawtype),
intent(inout) :: this
1456 character(len=LINELENGTH) :: title
1457 character(len=LINELENGTH) :: text
1458 integer(I4B) :: ntabcols
1462 integer(I4B) :: jpos
1463 integer(I4B) :: inode
1467 character(len=10),
dimension(0:4) :: ccond
1468 character(len=30) :: nodestr
1470 data ccond(0)/
'SPECIFIED '/
1471 data ccond(1)/
'THIEM '/
1472 data ccond(2)/
'SKIN '/
1473 data ccond(3)/
'CUMULATIVE'/
1474 data ccond(4)/
'MEAN '/
1476 character(len=*),
parameter :: fmtwelln = &
1477 "(1X,//43X,'MULTI-AQUIFER WELL DATA'&
1479 &/1X,7(A10,1X),A16)"
1480 character(len=*),
parameter :: fmtwelld = &
1481 &
"(1X,I10,1X,4(G10.3,1X),I10,1X,A10,1X,A16)"
1482 character(len=*),
parameter :: fmtline = &
1484 character(len=*),
parameter :: fmtwellcn = &
1485 "(1X,//37X,'MULTI-AQUIFER WELL CONNECTION DATA'&
1487 &/1X,2(A10,1X),A20,7(A10,1X))"
1488 character(len=*),
parameter :: fmtwellcd = &
1489 &
"(1X,2(I10,1X),A20,1X,2(G10.3,1X),2(A10,1X),3(G10.3,1X))"
1492 do n = 1, this%nmawwells
1493 this%xnewpak(n) = this%strt(n)
1494 this%xsto(n) = this%strt(n)
1498 do n = 1, this%nmawwells
1499 select case (this%status(n))
1501 this%iboundpak(n) = -1
1503 this%iboundpak(n) = 0
1505 this%iboundpak(n) = 1
1510 if (this%inamedbound /= 0)
then
1512 do n = 1, this%nmawwells
1513 do j = 1, this%ngwfnodes(n)
1515 this%boundname(idx) = this%cmawname(n)
1520 do n = 1, this%nmawwells
1521 this%cmawname(n) =
''
1526 call this%copy_boundname()
1536 call this%maw_check_attributes()
1539 do n = 1, this%nmawwells
1543 do j = 1, this%ngwfnodes(n)
1544 if (this%ieqn(n) /= 0)
then
1545 inode = this%get_gwfnode(n, j)
1546 call this%maw_calculate_satcond(n, j, inode)
1553 if (this%iprpak /= 0)
then
1555 if (this%inamedbound /= 0)
then
1556 ntabcols = ntabcols + 1
1558 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1559 trim(adjustl(this%packName))//
') STATIC WELL DATA'
1560 call table_cr(this%inputtab, this%packName, title)
1561 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1563 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1565 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1567 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1568 text =
'WELL BOTTOM'
1569 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1570 text =
'STARTING HEAD'
1571 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1572 text =
'NUMBER OF GWF NODES'
1573 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1574 text =
'CONDUCT. EQUATION'
1575 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1576 if (this%inamedbound /= 0)
then
1578 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1580 do n = 1, this%nmawwells
1581 call this%inputtab%add_term(n)
1582 call this%inputtab%add_term(this%radius(n))
1583 call this%inputtab%add_term(this%area(n))
1584 call this%inputtab%add_term(this%bot(n))
1585 call this%inputtab%add_term(this%strt(n))
1586 call this%inputtab%add_term(this%ngwfnodes(n))
1587 call this%inputtab%add_term(ccond(this%ieqn(n)))
1588 if (this%inamedbound /= 0)
then
1589 call this%inputtab%add_term(this%cmawname(n))
1595 if (this%iprpak /= 0)
then
1597 if (this%inonvert /= 0)
then
1598 ntabcols = ntabcols + 1
1600 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1601 trim(adjustl(this%packName))//
') STATIC WELL CONNECTION DATA'
1602 call table_cr(this%inputtab, this%packName, title)
1603 call this%inputtab%table_df(this%maxbound, ntabcols, this%iout)
1605 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1606 text =
'WELL CONNECTION'
1607 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1609 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1610 text =
'TOP OF SCREEN'
1611 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1612 text =
'BOTTOM OF SCREEN'
1613 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1614 text =
'SKIN RADIUS'
1615 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1617 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1619 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1621 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1622 text =
'SATURATED WELL CONDUCT.'
1623 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1624 if (this%inonvert /= 0)
then
1625 text =
'ANGLE (DEG)'
1626 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1630 do n = 1, this%nmawwells
1631 do j = 1, this%ngwfnodes(n)
1632 call this%inputtab%add_term(n)
1633 call this%inputtab%add_term(j)
1634 jpos = this%get_jpos(n, j)
1635 nn = this%get_gwfnode(n, j)
1636 call this%dis%noder_to_string(nn, nodestr)
1637 call this%inputtab%add_term(nodestr)
1638 call this%inputtab%add_term(this%topscrn(jpos))
1639 call this%inputtab%add_term(this%botscrn(jpos))
1640 if (this%ieqn(n) == 2 .or. &
1641 this%ieqn(n) == 3 .or. &
1642 this%ieqn(n) == 4)
then
1643 call this%inputtab%add_term(this%sradius(jpos))
1644 call this%inputtab%add_term(this%hk(jpos))
1646 call this%inputtab%add_term(
' ')
1647 call this%inputtab%add_term(
' ')
1649 if (this%ieqn(n) == 1 .or. &
1650 this%ieqn(n) == 2 .or. &
1651 this%ieqn(n) == 3)
then
1652 k11 = this%gwfk11(nn)
1653 if (this%gwfik22 == 0)
then
1654 k22 = this%gwfk11(nn)
1656 k22 = this%gwfk22(nn)
1658 call this%inputtab%add_term(k11)
1659 call this%inputtab%add_term(k22)
1661 call this%inputtab%add_term(
' ')
1662 call this%inputtab%add_term(
' ')
1664 call this%inputtab%add_term(this%satcond(jpos))
1665 if (this%inonvert /= 0)
then
1666 call this%inputtab%add_term(this%angle(jpos))
1673 this%gwfk11 => null()
1674 this%gwfk22 => null()
1675 this%gwfik22 => null()
1676 this%gwfsat => null()
1690 class(
mawtype),
intent(inout) :: this
1691 integer(I4B),
intent(in) :: imaw
1692 integer(I4B),
intent(inout) :: iheadlimit_warning
1694 character(len=LINELENGTH) :: errmsgr
1695 character(len=LINELENGTH) :: text
1696 character(len=LINELENGTH) :: cstr
1697 character(len=LINELENGTH) :: caux
1698 character(len=LINELENGTH) :: keyword
1702 real(DP),
pointer :: bndElem => null()
1703 integer(I4B) :: istat
1705 character(len=*),
parameter :: fmthdbot = &
1706 &
"('well head (',G0,') must be >= BOTTOM_ELEVATION (',G0, ').')"
1709 call this%parser%GetStringCaps(keyword)
1710 select case (keyword)
1712 call this%parser%GetStringCaps(text)
1713 this%status(imaw) = text(1:8)
1716 this%iboundpak(imaw) = -1
1718 this%iboundpak(imaw) = 0
1720 this%iboundpak(imaw) = 1
1723 'Unknown '//trim(this%text)//
" maw status keyword: '", &
1728 call this%parser%GetString(text)
1730 bndelem => this%rate(imaw)
1732 this%packName,
'BND', this%tsManager, &
1733 this%iprpak,
'RATE')
1735 call this%parser%GetString(text)
1737 bndelem => this%well_head(imaw)
1739 this%packName,
'BND', this%tsManager, &
1740 this%iprpak,
'WELL_HEAD')
1743 this%xnewpak(imaw) = this%well_head(imaw)
1746 if (this%well_head(imaw) < this%bot(imaw))
then
1747 write (cstr, fmthdbot) &
1748 this%well_head(imaw), this%bot(imaw)
1749 call this%maw_set_attribute_error(imaw,
'WELL HEAD', trim(cstr))
1751 case (
'FLOWING_WELL')
1752 this%fwelev(imaw) = this%parser%GetDouble()
1753 this%fwcond(imaw) = this%parser%GetDouble()
1754 this%fwrlen(imaw) = this%parser%GetDouble()
1758 if (this%iflowingwells == 0)
then
1759 this%iflowingwells = -1
1760 text =
'Flowing well data is specified in the '//trim(this%packName)// &
1761 ' package but FLOWING_WELL was not specified in the '// &
1765 case (
'RATE_SCALING')
1766 rval = this%parser%GetDouble()
1767 this%pumpelev(imaw) = rval
1768 rval = this%parser%GetDouble()
1769 this%reduction_length(imaw) = rval
1770 if (rval <
dzero)
then
1771 call this%maw_set_attribute_error(imaw, trim(keyword), &
1772 'must be greater than or equal to 0.')
1775 call this%parser%GetString(text)
1776 if (trim(text) ==
'OFF')
then
1777 this%shutofflevel(imaw) =
dep20
1779 read (text, *, iostat=istat, iomsg=errmsgr) &
1780 this%shutofflevel(imaw)
1781 if (istat /= 0)
then
1782 errmsg =
'Could not read HEAD_LIMIT value. '//trim(errmsgr)
1785 if (this%shutofflevel(imaw) <= this%bot(imaw))
then
1786 iheadlimit_warning = iheadlimit_warning + 1
1790 rval = this%parser%GetDouble()
1791 this%shutoffmin(imaw) = rval
1792 rval = this%parser%GetDouble()
1793 this%shutoffmax(imaw) = rval
1795 call this%parser%GetStringCaps(caux)
1796 do jj = 1, this%naux
1797 if (trim(adjustl(caux)) /= trim(adjustl(this%auxname(jj)))) cycle
1798 call this%parser%GetString(text)
1800 bndelem => this%mauxvar(jj, ii)
1802 this%packName,
'AUX', &
1803 this%tsManager, this%iprpak, &
1809 'Unknown '//trim(this%text)//
" maw data keyword: '", &
1821 class(
mawtype),
intent(inout) :: this
1822 integer(I4B),
intent(in) :: imaw
1823 character(len=*),
intent(in) :: keyword
1824 character(len=*),
intent(in) :: msg
1828 if (len(msg) == 0)
then
1829 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1830 keyword,
' for MAW well', imaw,
'has already been set.'
1832 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1833 keyword,
' for MAW well', imaw, msg
1843 class(
mawtype),
intent(inout) :: this
1845 character(len=LINELENGTH) :: cgwfnode
1849 integer(I4B) :: jpos
1853 do n = 1, this%nmawwells
1854 if (this%ngwfnodes(n) < 1)
then
1855 call this%maw_set_attribute_error(n,
'NGWFNODES',
'must be greater '// &
1858 if (this%radius(n) ==
dep20)
then
1859 call this%maw_set_attribute_error(n,
'RADIUS',
'has not been specified.')
1861 if (this%shutoffmin(n) >
dzero)
then
1862 if (this%shutoffmin(n) >= this%shutoffmax(n))
then
1863 call this%maw_set_attribute_error(n,
'SHUT_OFF',
'shutoffmax must '// &
1864 'be greater than shutoffmin.')
1867 do j = 1, this%ngwfnodes(n)
1870 jpos = this%get_jpos(n, j)
1873 write (cgwfnode,
'(a,i0,a)')
'gwfnode(', j,
')'
1876 if (this%botscrn(jpos) >= this%topscrn(jpos))
then
1877 call this%maw_set_attribute_error(n,
'SCREEN_TOP',
'screen bottom '// &
1878 'must be less than screen top. '// &
1883 if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
1884 this%ieqn(n) == 4)
then
1885 if (this%hk(jpos) <=
dzero)
then
1886 call this%maw_set_attribute_error(n,
'HK_SKIN',
'skin hyraulic '// &
1887 'conductivity must be greater '// &
1888 'than zero. '//trim(cgwfnode))
1890 else if (this%ieqn(n) == 0)
then
1893 if (this%satcond(jpos) <
dzero)
then
1894 call this%maw_set_attribute_error(n,
'HK_SKIN', &
1895 'skin hyraulic conductivity '// &
1896 'must be greater than or '// &
1897 'equal to zero when using '// &
1898 'SPECIFIED condeqn. '// &
1914 class(
mawtype),
intent(inout) :: this
1915 integer(I4B),
intent(in) :: moffset
1921 integer(I4B) :: jglo
1922 integer(I4B) :: nglo
1926 do n = 1, this%nmawwells
1927 nglo = moffset + this%dis%nodes + this%ioffset + n
1928 call sparse%addconnection(nglo, nglo, 1)
1929 do j = 1, this%ngwfnodes(n)
1930 jj = this%get_gwfnode(n, j)
1932 call sparse%addconnection(nglo, jglo, 1)
1933 call sparse%addconnection(jglo, nglo, 1)
1945 class(
mawtype),
intent(inout) :: this
1946 integer(I4B),
intent(in) :: moffset
1952 integer(I4B) :: iglo
1953 integer(I4B) :: jglo
1954 integer(I4B) :: ipos
1958 call mem_allocate(this%idxlocnode, this%nmawwells,
'IDXLOCNODE', &
1960 call mem_allocate(this%idxdglo, this%maxbound,
'IDXDGLO', this%memoryPath)
1961 call mem_allocate(this%idxoffdglo, this%maxbound,
'IDXOFFDGLO', &
1963 call mem_allocate(this%idxsymdglo, this%maxbound,
'IDXSYMDGLO', &
1965 call mem_allocate(this%idxsymoffdglo, this%maxbound,
'IDXSYMOFFDGLO', &
1973 do n = 1, this%nmawwells
1974 iglo = moffset + this%dis%nodes + this%ioffset + n
1975 this%idxlocnode(n) = this%dis%nodes + this%ioffset + n
1976 do ii = 1, this%ngwfnodes(n)
1977 j = this%get_gwfnode(n, ii)
1979 this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
1980 this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
1986 do n = 1, this%nmawwells
1987 do ii = 1, this%ngwfnodes(n)
1988 iglo = this%get_gwfnode(n, ii) + moffset
1989 jglo = moffset + this%dis%nodes + this%ioffset + n
1990 this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
1991 this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
2006 class(
mawtype),
intent(inout) :: this
2007 character(len=*),
intent(inout) :: option
2008 logical,
intent(inout) :: found
2010 character(len=MAXCHARLEN) :: fname, keyword
2012 character(len=*),
parameter :: fmtflowingwells = &
2013 &
"(4x, 'FLOWING WELLS WILL BE SIMULATED.')"
2014 character(len=*),
parameter :: fmtshutdown = &
2015 &
"(4x, 'SHUTDOWN ', a, ' VALUE (',g15.7,') SPECIFIED.')"
2016 character(len=*),
parameter :: fmtnostoragewells = &
2017 &
"(4x, 'WELL STORAGE WILL NOT BE SIMULATED.')"
2018 character(len=*),
parameter :: fmtmawbin = &
2019 "(4x, 'MAW ', 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, /4x, &
2020 &'OPENED ON UNIT: ', I0)"
2024 select case (option)
2027 write (this%iout,
'(4x,a)') &
2028 trim(adjustl(this%text))//
' heads will be printed to listing file.'
2030 call this%parser%GetStringCaps(keyword)
2031 if (keyword ==
'FILEOUT')
then
2032 call this%parser%GetString(fname)
2033 call assign_iounit(this%iheadout, this%inunit,
"HEAD fileout")
2034 call openfile(this%iheadout, this%iout, fname,
'DATA(BINARY)', &
2036 write (this%iout, fmtmawbin)
'HEAD', trim(adjustl(fname)), &
2039 call store_error(
'Optional maw stage keyword must be '// &
2040 'followed by fileout.')
2043 call this%parser%GetStringCaps(keyword)
2044 if (keyword ==
'FILEOUT')
then
2045 call this%parser%GetString(fname)
2046 call assign_iounit(this%ibudgetout, this%inunit,
"BUDGET fileout")
2047 call openfile(this%ibudgetout, this%iout, fname,
'DATA(BINARY)', &
2049 write (this%iout, fmtmawbin)
'BUDGET', trim(adjustl(fname)), &
2052 call store_error(
'Optional maw budget keyword must be '// &
2053 'followed by fileout.')
2056 call this%parser%GetStringCaps(keyword)
2057 if (keyword ==
'FILEOUT')
then
2058 call this%parser%GetString(fname)
2059 call assign_iounit(this%ibudcsv, this%inunit,
"BUDGETCSV fileout")
2060 call openfile(this%ibudcsv, this%iout, fname,
'CSV', &
2061 filstat_opt=
'REPLACE')
2062 write (this%iout, fmtmawbin)
'BUDGET CSV', trim(adjustl(fname)), &
2065 call store_error(
'OPTIONAL BUDGETCSV KEYWORD MUST BE FOLLOWED BY &
2068 case (
'FLOWING_WELLS')
2069 this%iflowingwells = 1
2070 write (this%iout, fmtflowingwells)
2071 case (
'SHUTDOWN_THETA')
2072 this%theta = this%parser%GetDouble()
2073 write (this%iout, fmtshutdown)
'THETA', this%theta
2074 case (
'SHUTDOWN_KAPPA')
2075 this%kappa = this%parser%GetDouble()
2076 write (this%iout, fmtshutdown)
'KAPPA', this%kappa
2079 write (this%iout,
'(4x,A)')
'MOVER OPTION ENABLED'
2080 case (
'NO_WELL_STORAGE')
2082 write (this%iout, fmtnostoragewells)
2083 case (
'NON_VERTICAL_WELLS')
2085 write (this%iout,
'(4x,a)') &
2086 'NON-VERTICAL (SLANTED) MULTI-AQUIFER WELL CONNECTIONS WILL BE '// &
2087 'SIMULATED. SCREEN LENGTHS FOR CONNECTIONS LISTED IN THE ANGLEDATA '// &
2088 'BLOCK WILL BE USED TO CALCULATE THE SATURATED CONDUCTANCE.'
2089 case (
'FLOW_CORRECTION')
2090 this%correct_flow = .true.
2091 write (this%iout,
'(4x,a,/,4x,a)') &
2092 'MAW-GWF FLOW CORRECTIONS WILL BE APPLIED WHEN MAW HEADS ARE BELOW', &
2093 'OR GWF HEADS IN CONNECTED CELLS ARE BELOW THE CELL BOTTOM.'
2094 case (
'MAW_FLOW_REDUCE_CSV')
2095 call this%parser%GetStringCaps(keyword)
2096 if (keyword ==
'FILEOUT')
then
2097 call this%parser%GetString(fname)
2098 call this%maw_redflow_csv_init(fname)
2100 call store_error(
'OPTIONAL MAW_FLOW_REDUCE_CSV KEYWORD MUST BE &
2101 &FOLLOWED BY FILEOUT')
2108 case (
'DEV_PEACEMAN_EFFECTIVE_RADIUS')
2109 call this%parser%DevOpt()
2111 write (this%iout,
'(4x,a)') &
2112 'EFFECTIVE RADIUS FOR STRUCTURED GRIDS WILL BE CALCULATED &
2113 &USING PEACEMAN 1983'
2127 class(
mawtype),
intent(inout) :: this
2131 call this%obs%obs_ar()
2134 if (this%inewton > 0)
then
2135 this%satomega =
dem6
2139 call this%maw_allocate_arrays()
2142 call this%read_initial_attr()
2145 if (this%imover /= 0)
then
2146 allocate (this%pakmvrobj)
2147 call this%pakmvrobj%ar(this%nmawwells, this%nmawwells, this%memoryPath)
2159 class(
mawtype),
intent(inout) :: this
2161 character(len=LINELENGTH) :: title
2162 character(len=LINELENGTH) :: line
2163 character(len=LINELENGTH) :: text
2164 character(len=16) :: csteady
2166 logical :: endOfBlock
2167 integer(I4B) :: ierr
2168 integer(I4B) :: node
2170 integer(I4B) :: ntabcols
2171 integer(I4B) :: ntabrows
2172 integer(I4B) :: imaw
2173 integer(I4B) :: ibnd
2175 integer(I4B) :: jpos
2176 integer(I4B) :: iheadlimit_warning
2178 character(len=*),
parameter :: fmtblkerr = &
2179 &
"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
2180 character(len=*),
parameter :: fmtlsp = &
2181 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
2184 iheadlimit_warning = 0
2187 this%imawiss = this%gwfiss
2190 if (this%imawissopt == 1)
then
2195 this%nbound = this%maxbound
2199 if (this%inunit == 0)
return
2202 if (this%ionper <
kper)
then
2205 call this%parser%GetBlock(
'PERIOD', isfound, ierr, &
2206 supportopenclose=.true., &
2207 blockrequired=.false.)
2211 call this%read_check_ionper()
2217 this%ionper =
nper + 1
2220 call this%parser%GetCurrentLine(line)
2221 write (
errmsg, fmtblkerr) adjustl(trim(line))
2228 if (this%ionper ==
kper)
then
2231 if (this%iprpak /= 0)
then
2234 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2235 trim(adjustl(this%packName))//
') DATA FOR PERIOD'
2236 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2237 call table_cr(this%inputtab, this%packName, title)
2238 call this%inputtab%table_df(1, 5, this%iout, finalize=.false.)
2240 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2242 call this%inputtab%initialize_column(text, 20, alignment=tableft)
2244 write (text,
'(a,1x,i6)')
'VALUE', n
2245 call this%inputtab%initialize_column(text, 15, alignment=tabcenter)
2252 call this%parser%GetNextLine(endofblock)
2253 if (endofblock)
exit
2255 imaw = this%parser%GetInteger()
2256 if (imaw < 1 .or. imaw > this%nmawwells)
then
2257 write (
errmsg,
'(2(a,1x),i0,a)') &
2258 'IMAW must be greater than 0 and', &
2259 'less than or equal to ', this%nmawwells,
'.'
2265 call this%maw_set_stressperiod(imaw, iheadlimit_warning)
2268 if (this%iprpak /= 0)
then
2269 call this%parser%GetCurrentLine(line)
2270 call this%inputtab%line_to_columns(line)
2273 if (this%iprpak /= 0)
then
2274 call this%inputtab%finalize_table()
2279 write (this%iout, fmtlsp) trim(this%filtyp)
2283 if (iheadlimit_warning > 0)
then
2284 write (
warnmsg,
'(a,a,a,1x,a,1x,a)') &
2285 "HEAD_LIMIT in '", trim(this%packName),
"' was below the well bottom", &
2286 "for one or more multi-aquifer well(s). This may result in", &
2287 "convergence failures for some models."
2293 call this%parser%StoreErrorUnit()
2297 if (this%check_attr /= 0)
then
2298 call this%maw_check_attributes()
2301 if (this%iprpak == 1)
then
2302 if (this%imawiss /= 0)
then
2303 csteady =
'STEADY-STATE '
2305 csteady =
'TRANSIENT '
2309 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2310 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2311 ' RATE DATA FOR PERIOD'
2312 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2314 call table_cr(this%inputtab, this%packName, title)
2315 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
2317 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2319 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2321 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2322 text =
'SPECIFIED HEAD'
2323 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2324 text =
'PUMP ELEVATION'
2325 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2326 text =
'REDUCTION LENGTH'
2327 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2328 do n = 1, this%nmawwells
2329 call this%inputtab%add_term(n)
2330 call this%inputtab%add_term(this%status(n))
2331 call this%inputtab%add_term(this%rate(n))
2332 if (this%iboundpak(n) < 0)
then
2333 call this%inputtab%add_term(this%well_head(n))
2335 call this%inputtab%add_term(
' ')
2337 call this%inputtab%add_term(this%pumpelev(n))
2338 if (this%reduction_length(n) /= dep20)
then
2339 call this%inputtab%add_term(this%reduction_length(n))
2341 call this%inputtab%add_term(
' ')
2346 if (this%iflowingwells > 0)
then
2349 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2350 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2351 ' FLOWING WELL DATA FOR PERIOD'
2352 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2355 do n = 1, this%nmawwells
2356 if (this%fwcond(n) > dzero)
then
2357 ntabrows = ntabrows + 1
2360 if (ntabrows > 0)
then
2361 call table_cr(this%inputtab, this%packName, title)
2362 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2364 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2366 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2368 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2369 text =
'REDUCTION LENGTH'
2370 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2371 do n = 1, this%nmawwells
2372 if (this%fwcond(n) > dzero)
then
2373 call this%inputtab%add_term(n)
2374 call this%inputtab%add_term(this%fwelev(n))
2375 call this%inputtab%add_term(this%fwcond(n))
2376 call this%inputtab%add_term(this%fwrlen(n))
2383 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2384 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2385 ' WELL SHUTOFF DATA FOR PERIOD'
2386 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2389 do n = 1, this%nmawwells
2390 if (this%shutofflevel(n) /= dep20)
then
2391 ntabrows = ntabrows + 1
2394 if (ntabrows > 0)
then
2395 call table_cr(this%inputtab, this%packName, title)
2396 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2398 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2400 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2402 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2404 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2405 do n = 1, this%nmawwells
2406 if (this%shutofflevel(n) /= dep20)
then
2407 call this%inputtab%add_term(n)
2408 call this%inputtab%add_term(this%shutofflevel(n))
2409 call this%inputtab%add_term(this%shutoffmin(n))
2410 call this%inputtab%add_term(this%shutoffmax(n))
2419 do n = 1, this%nmawwells
2420 do j = 1, this%ngwfnodes(n)
2421 jpos = this%get_jpos(n, j)
2422 node = this%get_gwfnode(n, j)
2423 this%nodelist(ibnd) = node
2424 this%bound(1, ibnd) = this%xnewpak(n)
2425 this%bound(2, ibnd) = this%satcond(jpos)
2426 this%bound(3, ibnd) = this%botscrn(jpos)
2427 if (this%iboundpak(n) > 0)
then
2428 this%bound(4, ibnd) = this%rate(n)
2430 this%bound(4, ibnd) = dzero
2447 integer(I4B) :: ibnd
2450 call this%TsManager%ad()
2455 if (this%naux > 0)
then
2457 do n = 1, this%nmawwells
2458 do j = 1, this%ngwfnodes(n)
2459 do jj = 1, this%naux
2460 if (this%noupdateauxvar(jj) /= 0) cycle
2461 this%auxvar(jj, ibnd) = this%mauxvar(jj, n)
2469 do n = 1, this%nmawwells
2470 this%xoldpak(n) = this%xnewpak(n)
2471 this%xoldsto(n) = this%xsto(n)
2472 if (this%iboundpak(n) < 0)
then
2473 this%xnewpak(n) = this%well_head(n)
2479 this%nurdxold(n) =
dzero
2480 this%nurweight(n) =
done
2485 if (
kper == 1 .and.
kstp == 1)
then
2486 do n = 1, this%nmawwells
2487 if (this%fwcond(n) >
dzero)
then
2488 if (this%xoldsto(n) > this%fwelev(n))
then
2489 this%xoldsto(n) = this%fwelev(n)
2496 this%ishutoffcnt = 0
2499 if (this%imover == 1)
then
2500 call this%pakmvrobj%ad()
2506 call this%obs%obs_ad()
2519 call this%maw_cfupdate()
2524 subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln)
2529 real(DP),
dimension(:),
intent(inout) :: rhs
2530 integer(I4B),
dimension(:),
intent(in) :: ia
2531 integer(I4B),
dimension(:),
intent(in) :: idxglo
2537 integer(I4B) :: iloc
2538 integer(I4B) :: isymloc
2539 integer(I4B) :: igwfnode
2540 integer(I4B) :: iposd
2541 integer(I4B) :: iposoffd
2542 integer(I4B) :: isymnode
2543 integer(I4B) :: ipossymd
2544 integer(I4B) :: ipossymoffd
2545 integer(I4B) :: jpos
2546 integer(I4B) :: icflow
2565 if (this%imover == 1)
then
2566 call this%pakmvrobj%fc()
2571 do n = 1, this%nmawwells
2572 iloc = this%idxlocnode(n)
2576 this%qsim0(n) = this%ratesim(n)
2579 if (this%iboundpak(n) < 0)
then
2580 this%xnewpak(n) = this%well_head(n)
2582 hmaw = this%xnewpak(n)
2585 if (this%iboundpak(n) == 0)
then
2586 this%ratesim(n) =
dzero
2588 call this%maw_calculate_wellq(n, hmaw, rate)
2589 this%ratesim(n) = rate
2590 rhs(iloc) = rhs(iloc) - rate
2593 iposd = this%idxdglo(idx)
2598 if (this%iflowingwells > 0)
then
2599 if (this%fwcond(n) >
dzero)
then
2601 tp = bt + this%fwrlen(n)
2603 cfw = scale * this%fwcond(n)
2604 this%ifwdischarge(n) = 0
2605 if (cfw >
dzero)
then
2606 this%ifwdischarge(n) = 1
2609 this%fwcondsim(n) = cfw
2610 call matrix_sln%add_value_pos(iposd, -cfw)
2611 rhs(iloc) = rhs(iloc) - cfw * bt
2612 ratefw = cfw * (bt - hmaw)
2617 if (this%imawiss /= 1)
then
2618 if (this%ifwdischarge(n) /= 1)
then
2625 tled = this%area(n) /
delt
2628 ssold =
squadratic0sp(this%xoldsto(n), this%bot(n), this%satomega)
2629 call matrix_sln%add_value_pos(iposd, -tled * sd)
2630 rhs(iloc) = rhs(iloc) - tled * (sd * hmaw - ss + ssold)
2632 cterm = this%xoldsto(n) - this%fwelev(n)
2633 rhs(iloc) = rhs(iloc) - (this%area(n) * cterm /
delt)
2639 if (this%imover == 1)
then
2640 rhs(iloc) = rhs(iloc) - this%pakmvrobj%get_qfrommvr(n)
2644 call this%pakmvrobj%accumulate_qformvr(n, -rate)
2648 call this%pakmvrobj%accumulate_qformvr(n, -ratefw)
2654 do j = 1, this%ngwfnodes(n)
2655 if (this%iboundpak(n) /= 0)
then
2656 jpos = this%get_jpos(n, j)
2657 igwfnode = this%get_gwfnode(n, j)
2658 hgwf = this%xnew(igwfnode)
2661 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2663 this%simcond(jpos) = cmaw
2666 iposd = this%idxdglo(idx)
2667 iposoffd = this%idxoffdglo(idx)
2668 call matrix_sln%add_value_pos(iposd, -term)
2669 call matrix_sln%set_value_pos(iposoffd, term)
2672 rhs(iloc) = rhs(iloc) - cterm
2675 isymnode = this%get_gwfnode(n, j)
2676 isymloc = ia(isymnode)
2677 ipossymd = this%idxsymdglo(idx)
2678 ipossymoffd = this%idxsymoffdglo(idx)
2679 call matrix_sln%add_value_pos(ipossymd, -term)
2680 call matrix_sln%set_value_pos(ipossymoffd, term)
2683 rhs(isymnode) = rhs(isymnode) + cterm
2694 subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln)
2697 real(DP),
dimension(:),
intent(inout) :: rhs
2698 integer(I4B),
dimension(:),
intent(in) :: ia
2699 integer(I4B),
dimension(:),
intent(in) :: idxglo
2705 integer(I4B) :: iloc
2706 integer(I4B) :: isymloc
2707 integer(I4B) :: igwfnode
2708 integer(I4B) :: iposd
2709 integer(I4B) :: iposoffd
2710 integer(I4B) :: isymnode
2711 integer(I4B) :: ipossymd
2712 integer(I4B) :: ipossymoffd
2713 integer(I4B) :: jpos
2714 integer(I4B) :: icflow
2735 do n = 1, this%nmawwells
2736 iloc = this%idxlocnode(n)
2737 hmaw = this%xnewpak(n)
2740 if (this%iboundpak(n) /= 0)
then
2741 iposd = this%idxdglo(idx)
2744 rate = this%ratesim(n)
2747 call this%maw_calculate_wellq(n, hmaw +
dem4, rate2)
2748 drterm = (rate2 - rate) /
dem4
2751 call matrix_sln%add_value_pos(iposd, drterm)
2752 rhs(iloc) = rhs(iloc) + drterm * hmaw
2755 if (this%iflowingwells > 0)
then
2756 if (this%fwcond(n) >
dzero)
then
2758 tp = bt + this%fwrlen(n)
2760 cfw = scale * this%fwcond(n)
2761 this%ifwdischarge(n) = 0
2762 if (cfw >
dzero)
then
2763 this%ifwdischarge(n) = 1
2765 this%fwcondsim(n) = cfw
2766 rate = cfw * (bt - hmaw)
2772 drterm = -(cfw + this%fwcond(n) * derv * (hmaw - bt))
2775 call matrix_sln%add_value_pos(iposd, &
2776 -this%fwcond(n) * derv * (hmaw - bt))
2777 rhs(iloc) = rhs(iloc) - rterm + drterm * hmaw
2784 do j = 1, this%ngwfnodes(n)
2785 if (this%iboundpak(n) /= 0)
then
2786 jpos = this%get_jpos(n, j)
2787 igwfnode = this%get_gwfnode(n, j)
2788 hgwf = this%xnew(igwfnode)
2791 iposd = this%idxdglo(idx)
2792 iposoffd = this%idxoffdglo(idx)
2795 isymnode = this%get_gwfnode(n, j)
2796 isymloc = ia(isymnode)
2797 ipossymd = this%idxsymdglo(idx)
2798 ipossymoffd = this%idxsymoffdglo(idx)
2801 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2805 if (hmaw > hgwf)
then
2806 if (icflow /= 0)
then
2807 rhsterm = term2 * hgwf + term * hmaw
2808 rhs(iloc) = rhs(iloc) + rhsterm
2809 rhs(isymnode) = rhs(isymnode) - rhsterm
2810 if (this%iboundpak(n) > 0)
then
2811 call matrix_sln%add_value_pos(iposd, term)
2812 call matrix_sln%add_value_pos(iposoffd, term2)
2814 call matrix_sln%add_value_pos(ipossymd, -term2)
2815 call matrix_sln%add_value_pos(ipossymoffd, -term)
2817 rhs(iloc) = rhs(iloc) + term * hmaw
2818 rhs(isymnode) = rhs(isymnode) - term * hmaw
2819 call matrix_sln%add_value_pos(iposd, term)
2820 if (this%ibound(igwfnode) > 0)
then
2821 call matrix_sln%add_value_pos(ipossymoffd, -term)
2827 if (icflow /= 0)
then
2828 rhsterm = term2 * hmaw + term * hgwf
2829 rhs(iloc) = rhs(iloc) + rhsterm
2830 rhs(isymnode) = rhs(isymnode) - rhsterm
2831 if (this%iboundpak(n) > 0)
then
2832 call matrix_sln%add_value_pos(iposd, term2)
2833 call matrix_sln%add_value_pos(iposoffd, term)
2835 call matrix_sln%add_value_pos(ipossymd, -term)
2836 call matrix_sln%add_value_pos(ipossymoffd, -term2)
2838 rhs(iloc) = rhs(iloc) + term * hgwf
2839 rhs(isymnode) = rhs(isymnode) - term * hgwf
2840 if (this%iboundpak(n) > 0)
then
2841 call matrix_sln%add_value_pos(iposoffd, term)
2843 call matrix_sln%add_value_pos(ipossymd, -term)
2866 subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
2868 class(
mawtype),
intent(inout) :: this
2869 integer(I4B),
intent(in) :: neqpak
2870 real(DP),
dimension(neqpak),
intent(inout) :: x
2871 real(DP),
dimension(neqpak),
intent(in) :: xtemp
2872 real(DP),
dimension(neqpak),
intent(inout) :: dx
2873 integer(I4B),
intent(inout) :: inewtonur
2874 real(DP),
intent(inout) :: dxmax
2875 integer(I4B),
intent(inout) :: locmax
2884 real(DP),
parameter :: damptheta =
dp7
2885 real(DP),
parameter :: damptol =
dhalf
2886 real(DP),
parameter :: weightmin =
dem2
2887 real(DP),
parameter :: recover = 0.2_dp
2890 do n = 1, this%nmawwells
2891 if (this%iboundpak(n) < 1) cycle
2895 dxprop = x(n) - xtemp(n)
2903 weight =
maw_damp_weight(dxprop, this%nurdxold(n), this%nurweight(n), &
2904 damptheta, damptol, weightmin, recover)
2905 this%nurweight(n) = weight
2908 if (weight <
done)
then
2910 xx = xtemp(n) + weight * dxprop
2912 if (abs(dxx) > abs(dxmax))
then
2917 dx(n) = weight * dxprop
2922 if (x(n) < botw)
then
2926 if (abs(dxx) > abs(dxmax))
then
2938 this%nurdxold(n) = x(n) - xtemp(n)
2951 weightmin, recover)
result(new_weight)
2953 real(dp),
intent(in) :: dxprop
2954 real(dp),
intent(in) :: dxold
2955 real(dp),
intent(in) :: weight
2956 real(dp),
intent(in) :: damptheta
2957 real(dp),
intent(in) :: damptol
2958 real(dp),
intent(in) :: weightmin
2959 real(dp),
intent(in) :: recover
2961 real(dp) :: new_weight
2963 if (dxprop * dxold <
dzero .and. abs(dxprop) > damptol * abs(dxold))
then
2964 new_weight = max(damptheta * weight, weightmin)
2966 new_weight = min(weight + recover,
done)
2981 subroutine maw_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
2985 class(
mawtype),
intent(inout) :: this
2986 integer(I4B),
intent(in) :: innertot
2987 integer(I4B),
intent(in) :: kiter
2988 integer(I4B),
intent(in) :: iend
2989 integer(I4B),
intent(in) :: icnvgmod
2990 character(len=LENPAKLOC),
intent(inout) :: cpak
2991 integer(I4B),
intent(inout) :: ipak
2992 real(DP),
intent(inout) :: dpak
2996 integer(I4B) :: jpos
2997 integer(I4B) :: igwfnode
2998 integer(I4B) :: locdpak
3007 real(DP) :: qtolfact
3010 character(len=LENPAKLOC) :: cloc
3012 real(DP),
parameter :: qtol = 1.001_dp
3014 character(len=*),
parameter :: fmtwarn = &
3015 "('MAW well ', a, ' requests an extraction rate (', g0.5, &
3016 &') larger than the maximum rate (', g0.5, ') the aquifer can supply &
3017 &with the well head at its bottom. This may be preventing convergence. &
3018 &Consider reducing the requested rate, applying or widening RATE_SCALING, &
3019 &or reviewing the connection conductance (e.g. aquifer K).')"
3029 do n = 1, this%nmawwells
3030 if (this%iboundpak(n) < 1) cycle
3031 if (this%nurweight(n) >=
done) cycle
3032 if (this%area(n) >
dzero)
then
3033 qtolfact =
delt / this%area(n)
3044 dq = (this%qsim0(n) - this%ratesim(n)) * qtolfact
3045 if (abs(dq) > abs(dpakmax))
then
3050 if (locdpak > 0 .and. abs(dpakmax) > abs(dpak))
then
3053 write (cloc,
"(a,'-',a)") trim(this%packName),
'rate'
3059 if (iend == 0)
return
3060 if (icnvgmod /= 0)
return
3063 do n = 1, this%nmawwells
3064 if (this%iboundpak(n) < 1) cycle
3065 if (this%rate(n) >=
dzero) cycle
3071 do j = 1, this%ngwfnodes(n)
3072 jpos = this%get_jpos(n, j)
3073 igwfnode = this%get_gwfnode(n, j)
3074 hgwf = this%xnew(igwfnode)
3075 bmaw = this%botscrn(jpos)
3076 hv = max(botw, bmaw)
3081 call this%maw_calculate_saturation(n, j, igwfnode, sat, hv)
3082 cmaw = this%satcond(jpos) * sat
3087 qmax = qmax + cmaw * max(hgwf - hv,
dzero)
3091 qreq = -this%rate(n)
3092 if (qmax >=
dzero .and. qreq > qtol * qmax)
then
3093 write (cloc,
'(a, a, a, a, i0, a, i0, a)') trim(this%name_model),
'-(', &
3094 trim(this%filtyp),
'_', this%ibcnum,
'-', n,
')'
3095 write (
warnmsg, fmtwarn) trim(cloc), qreq, qmax
3109 class(
mawtype),
intent(inout) :: this
3110 real(DP),
dimension(:),
intent(in) :: x
3111 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
3112 integer(I4B),
optional,
intent(in) :: iadv
3120 integer(I4B) :: ibnd
3128 call this%maw_cfupdate()
3132 call this%BndType%bnd_cq(x, flowja, iadv=1)
3135 do n = 1, this%nmawwells
3136 this%qout(n) = dzero
3137 this%qsto(n) = dzero
3138 if (this%iflowingwells > 0)
then
3141 if (this%iboundpak(n) == 0)
then
3146 hmaw = this%xnewpak(n)
3150 rrate = this%ratesim(n)
3153 if (rrate < dzero)
then
3154 this%qout(n) = rrate
3158 if (this%iflowingwells > 0)
then
3159 if (this%fwcond(n) > dzero)
then
3160 cfw = this%fwcondsim(n)
3164 if (this%ifwdischarge(n) == 1)
then
3165 this%xsto(n) = this%fwelev(n)
3167 rrate = cfw * (this%fwelev(n) - hmaw)
3171 this%qout(n) = this%qout(n) + rrate
3181 if (this%imawiss /= 1)
then
3182 if (this%iflowingwells > 0 .and. this%ifwdischarge(n) == 1)
then
3183 rrate = -this%area(n) * (this%xsto(n) - this%xoldsto(n)) /
delt
3186 ssold =
squadratic0sp(this%xoldsto(n), this%bot(n), this%satomega)
3187 rrate = -this%area(n) * (ss - ssold) /
delt
3189 this%qsto(n) = rrate
3195 do n = 1, this%nmawwells
3196 hmaw = this%xnewpak(n)
3197 this%qconst(n) = dzero
3198 do j = 1, this%ngwfnodes(n)
3199 rrate = -this%simvals(ibnd)
3200 this%qleak(ibnd) = rrate
3201 if (this%iboundpak(n) < 0)
then
3202 this%qconst(n) = this%qconst(n) - rrate
3205 if (-rrate < dzero)
then
3206 this%qout(n) = this%qout(n) - rrate
3215 if (this%iboundpak(n) < 0)
then
3218 this%qconst(n) = this%qconst(n) - this%ratesim(n)
3221 if (this%iflowingwells > 0)
then
3222 this%qconst(n) = this%qconst(n) - this%qfw(n)
3226 if (this%imawiss /= 1)
then
3227 this%qconst(n) = this%qconst(n) - this%qsto(n)
3233 call this%maw_fill_budobj()
3241 integer(I4B),
intent(in) :: icbcfl
3242 integer(I4B),
intent(in) :: ibudfl
3243 integer(I4B),
intent(in) :: icbcun
3244 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
3247 call this%BndType%bnd_ot_model_flows(icbcfl, ibudfl, icbcun, this%imap)
3255 integer(I4B),
intent(in) :: icbcfl
3256 integer(I4B),
intent(in) :: ibudfl
3257 integer(I4B) :: ibinun
3261 if (this%ibudgetout /= 0)
then
3262 ibinun = this%ibudgetout
3264 if (icbcfl == 0) ibinun = 0
3265 if (ibinun > 0)
then
3266 call this%budobj%save_flows(this%dis, ibinun,
kstp,
kper,
delt, &
3271 if (ibudfl /= 0 .and. this%iprflow /= 0)
then
3272 call this%budobj%write_flowtable(this%dis,
kstp,
kper)
3283 integer(I4B),
intent(in) :: idvsave
3284 integer(I4B),
intent(in) :: idvprint
3285 integer(I4B) :: ibinun
3292 if (this%iheadout /= 0)
then
3293 ibinun = this%iheadout
3295 if (idvsave == 0) ibinun = 0
3298 if (ibinun > 0)
then
3299 do n = 1, this%nmawwells
3302 if (this%iboundpak(n) == 0)
then
3304 else if (d <= dzero)
then
3309 call ulasav(this%dbuff,
' HEAD', &
3311 this%nmawwells, 1, 1, ibinun)
3315 if (idvprint /= 0 .and. this%iprhed /= 0)
then
3318 call this%headtab%set_kstpkper(
kstp,
kper)
3321 do n = 1, this%nmawwells
3322 if (this%inamedbound == 1)
then
3323 call this%headtab%add_term(this%cmawname(n))
3325 call this%headtab%add_term(n)
3326 call this%headtab%add_term(this%xnewpak(n))
3338 integer(I4B),
intent(in) :: kstp
3339 integer(I4B),
intent(in) :: kper
3340 integer(I4B),
intent(in) :: iout
3341 integer(I4B),
intent(in) :: ibudfl
3343 call this%budobj%write_budtable(kstp, kper, iout, ibudfl,
totim,
delt)
3356 call this%budobj%budgetobject_da()
3357 deallocate (this%budobj)
3358 nullify (this%budobj)
3361 if (this%iprhed > 0)
then
3362 call this%headtab%table_da()
3363 deallocate (this%headtab)
3364 nullify (this%headtab)
3368 call mem_deallocate(this%cmawbudget,
'CMAWBUDGET', this%memoryPath)
3464 nullify (this%gwfiss)
3467 call this%BndType%bnd_da()
3474 class(
mawtype),
intent(inout) :: this
3477 this%listlabel = trim(this%filtyp)//
' NO.'
3478 if (this%dis%ndim == 3)
then
3479 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
3480 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'ROW'
3481 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'COL'
3482 elseif (this%dis%ndim == 2)
then
3483 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
3484 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'CELL2D'
3486 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'NODE'
3488 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'STRESS RATE'
3489 if (this%inamedbound == 1)
then
3490 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
3502 integer(I4B),
pointer :: neq
3503 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
3504 real(DP),
dimension(:),
pointer,
contiguous :: xnew
3505 real(DP),
dimension(:),
pointer,
contiguous :: xold
3506 real(DP),
dimension(:),
pointer,
contiguous :: flowja
3509 integer(I4B) :: istart, iend
3512 call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja)
3517 istart = this%dis%nodes + this%ioffset + 1
3518 iend = istart + this%nmawwells - 1
3519 this%iboundpak => this%ibound(istart:iend)
3520 this%xnewpak => this%xnew(istart:iend)
3521 call mem_checkin(this%xnewpak,
'HEAD', this%memoryPath,
'X', &
3522 this%memoryPathModel)
3523 call mem_allocate(this%xoldpak, this%nmawwells,
'XOLDPAK', this%memoryPath)
3526 do n = 1, this%nmawwells
3527 this%xnewpak(n) =
dep20
3551 integer(I4B) :: indx
3555 call this%obs%StoreObsType(
'head', .false., indx)
3560 call this%obs%StoreObsType(
'from-mvr', .false., indx)
3565 call this%obs%StoreObsType(
'maw', .true., indx)
3570 call this%obs%StoreObsType(
'rate', .true., indx)
3575 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
3580 call this%obs%StoreObsType(
'fw-rate', .true., indx)
3585 call this%obs%StoreObsType(
'fw-to-mvr', .true., indx)
3590 call this%obs%StoreObsType(
'storage', .true., indx)
3595 call this%obs%StoreObsType(
'constant', .true., indx)
3600 call this%obs%StoreObsType(
'conductance', .true., indx)
3605 call this%obs%StoreObsType(
'fw-conductance', .true., indx)
3621 integer(I4B) :: jpos
3629 if (this%obs%npakobs > 0)
then
3630 call this%obs%obs_bd_clear()
3631 do i = 1, this%obs%npakobs
3632 obsrv => this%obs%pakobs(i)%obsrv
3633 do j = 1, obsrv%indxbnds_count
3635 jj = obsrv%indxbnds(j)
3636 select case (obsrv%ObsTypeId)
3638 if (this%iboundpak(jj) /= 0)
then
3639 v = this%xnewpak(jj)
3642 if (this%iboundpak(jj) /= 0)
then
3643 if (this%imover == 1)
then
3644 v = this%pakmvrobj%get_qfrommvr(jj)
3649 if (this%iboundpak(n) /= 0)
then
3653 if (this%iboundpak(jj) /= 0)
then
3654 v = this%ratesim(jj)
3655 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3656 qfact = v / this%qout(jj)
3657 if (this%imover == 1)
then
3658 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3662 case (
'RATE-TO-MVR')
3663 if (this%iboundpak(jj) /= 0)
then
3664 if (this%imover == 1)
then
3665 v = this%ratesim(jj)
3667 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3668 qfact = v / this%qout(jj)
3670 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3677 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3678 hmaw = this%xnewpak(jj)
3679 cmaw = this%fwcondsim(jj)
3680 v = cmaw * (this%fwelev(jj) - hmaw)
3681 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3682 qfact = v / this%qout(jj)
3683 if (this%imover == 1)
then
3684 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3689 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3690 if (this%imover == 1)
then
3691 hmaw = this%xnewpak(jj)
3692 cmaw = this%fwcondsim(jj)
3693 v = cmaw * (this%fwelev(jj) - hmaw)
3695 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3696 qfact = v / this%qout(jj)
3698 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3705 if (this%iboundpak(jj) /= 0 .and. this%imawissopt /= 1)
then
3709 if (this%iboundpak(jj) /= 0)
then
3712 case (
'CONDUCTANCE')
3714 if (this%iboundpak(n) /= 0)
then
3715 nn = jj - this%iaconn(n) + 1
3716 jpos = this%get_jpos(n, nn)
3717 v = this%simcond(jpos)
3719 case (
'FW-CONDUCTANCE')
3720 if (this%iboundpak(jj) /= 0)
then
3721 v = this%fwcondsim(jj)
3724 errmsg =
'Unrecognized observation type: '//trim(obsrv%ObsTypeId)
3727 call this%obs%SaveOneSimval(obsrv, v)
3738 if (this%ioutredflowcsv > 0)
then
3739 call this%maw_redflow_csv_write()
3751 class(
mawtype),
intent(inout) :: this
3759 character(len=LENBOUNDNAME) :: bname
3763 10
format(
'Boundary "', a,
'" for observation "', a, &
3764 '" is invalid in package "', a,
'"')
3767 do i = 1, this%obs%npakobs
3768 obsrv => this%obs%pakobs(i)%obsrv
3771 nn1 = obsrv%NodeNumber
3773 bname = obsrv%FeatureName
3774 if (bname /=
'')
then
3779 if (obsrv%ObsTypeId ==
'MAW' .or. &
3780 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3781 do j = 1, this%nmawwells
3782 do jj = this%iaconn(j), this%iaconn(j + 1) - 1
3783 if (this%boundname(jj) == bname)
then
3785 call obsrv%AddObsIndex(jj)
3790 do j = 1, this%nmawwells
3791 if (this%cmawname(j) == bname)
then
3793 call obsrv%AddObsIndex(j)
3797 if (.not. jfound)
then
3799 trim(bname), trim(obsrv%Name), trim(this%packName)
3804 if (obsrv%indxbnds_count == 0)
then
3805 if (obsrv%ObsTypeId ==
'MAW' .or. &
3806 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3807 nn2 = obsrv%NodeNumber2
3808 j = this%iaconn(nn1) + nn2 - 1
3809 call obsrv%AddObsIndex(j)
3811 call obsrv%AddObsIndex(nn1)
3814 errmsg =
'Programming error in maw_rp_obs'
3821 if (obsrv%ObsTypeId ==
'HEAD')
then
3822 if (obsrv%indxbnds_count > 1)
then
3823 write (
errmsg,
'(a,3(1x,a))') &
3824 trim(adjustl(obsrv%ObsTypeId)), &
3825 'for observation', trim(adjustl(obsrv%Name)), &
3826 'must be assigned to a multi-aquifer well with a unique boundname.'
3832 if (obsrv%ObsTypeId ==
'MAW' .or. &
3833 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3834 do j = 1, obsrv%indxbnds_count
3835 nn1 = obsrv%indxbnds(j)
3837 nn2 = nn1 - this%iaconn(n) + 1
3838 jj = this%iaconn(n + 1) - this%iaconn(n)
3839 if (nn1 < 1 .or. nn1 > this%maxbound)
then
3840 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3841 trim(adjustl(obsrv%ObsTypeId)), &
3842 'multi-aquifer well connection number must be greater than 0', &
3843 'and less than', jj,
'(specified value is ', nn2,
').'
3848 do j = 1, obsrv%indxbnds_count
3849 nn1 = obsrv%indxbnds(j)
3850 if (nn1 < 1 .or. nn1 > this%nmawwells)
then
3851 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3852 trim(adjustl(obsrv%ObsTypeId)), &
3853 'multi-aquifer well must be greater than 0 ', &
3854 'and less than or equal to', this%nmawwells, &
3855 '(specified value is ', nn1,
').'
3880 integer(I4B),
intent(in) :: inunitobs
3881 integer(I4B),
intent(in) :: iout
3883 integer(I4B) :: nn1, nn2
3884 integer(I4B) :: icol, istart, istop
3885 character(len=LINELENGTH) :: string
3886 character(len=LENBOUNDNAME) :: bndname
3889 string = obsrv%IDstring
3897 obsrv%FeatureName = bndname
3899 if (obsrv%ObsTypeId ==
'MAW' .or. &
3900 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3902 if (len_trim(bndname) < 1 .and. nn2 < 0)
then
3903 write (
errmsg,
'(a,1x,a,a,1x,a,1x,a)') &
3904 'For observation type', trim(adjustl(obsrv%ObsTypeId)), &
3905 ', ID given as an integer and not as boundname,', &
3906 'but ID2 (icon) is missing. Either change ID to valid', &
3907 'boundname or supply valid entry for ID2.'
3911 obsrv%FeatureName = bndname
3915 obsrv%NodeNumber2 = nn2
3920 obsrv%NodeNumber = nn1
3930 class(
mawtype),
intent(inout) :: this
3931 character(len=*),
intent(in) :: fname
3933 character(len=*),
parameter :: fmtredflowcsv = &
3934 "(4x, 'MAW REDUCED FLOW INFORMATION WILL BE SAVED TO FILE: ', a, /4x, &
3935 &'OPENED ON UNIT: ', I0)"
3937 this%ioutredflowcsv =
getunit()
3938 call openfile(this%ioutredflowcsv, this%iout, fname,
'CSV', &
3939 filstat_opt=
'REPLACE')
3940 write (this%iout, fmtredflowcsv) trim(adjustl(fname)), &
3942 write (this%ioutredflowcsv,
'(a)') &
3943 'time,period,step,MAWnumber,rate-requested,rate-actual,maw-reduction'
3952 class(
mawtype),
intent(inout) :: this
3959 do n = 1, this%nmawwells
3962 if (this%status(n) .ne.
'ACTIVE')
then
3965 v = this%rate(n) - this%ratesim(n)
3966 if (abs(v) >
dem9)
then
3967 write (this%ioutredflowcsv,
'(*(G0,:,","))') &
3978 class(
mawtype),
intent(inout) :: this
3979 integer(I4B),
intent(in) :: i
3980 integer(I4B),
intent(in) :: j
3981 integer(I4B),
intent(in) :: node
3983 integer(I4B) :: iTcontrastErr
3984 integer(I4B) :: jpos
3988 real(DP) :: sqrtk11k22
3996 real(DP) :: Tcontrast
4021 jpos = this%get_jpos(i, j)
4024 k11 = this%gwfk11(node)
4025 if (this%gwfik22 == 0)
then
4026 k22 = this%gwfk11(node)
4028 k22 = this%gwfk22(node)
4030 sqrtk11k22 = sqrt(k11 * k22)
4033 gwftop = this%dis%top(node)
4034 gwfbot = this%dis%bot(node)
4035 tthka = gwftop - gwfbot
4036 gwfsat = this%gwfsat(node)
4040 topw = this%topscrn(jpos)
4041 botw = this%botscrn(jpos)
4045 if (gwftop == topw .and. gwfbot == botw)
then
4046 if (this%icelltype(node) == 0)
then
4047 tthkw = tthkw * gwfsat
4048 tthka = tthka * gwfsat
4053 t2pi =
dtwopi * tthka * sqrtk11k22
4056 if (this%dis%ndim == 3 .and. this%ieffradopt /= 0)
then
4059 dx = sqrt(this%dis%area(node))
4063 eradius = 0.28_dp * ((yx4 * dx)**
dtwo + &
4066 area = this%dis%area(node)
4072 if (this%ieqn(i) == 1 .or. this%ieqn(i) == 3)
then
4073 lc1 = log(eradius / this%radius(i)) / t2pi
4077 if (this%ieqn(i) == 2 .or. this%ieqn(i) == 3)
then
4079 if (tthkw * hks >
dzero)
then
4080 tcontrast = (sqrtk11k22 * tthka) / (hks * tthkw)
4081 skin = (tcontrast -
done) * log(this%sradius(jpos) / this%radius(i))
4088 if (tcontrast <= 1 .and. this%ieqn(i) == 2)
then
4090 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
4091 'Invalid calculated transmissivity contrast (', tcontrast, &
4092 ') for maw well', i,
'connection', j,
'.',
'This happens when the', &
4093 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
4094 'Consider decreasing HK_SKIN for the connection or using the', &
4095 'CUMULATIVE or MEAN conductance equations.'
4104 if (this%ieqn(i) == 4)
then
4106 ravg =
dhalf * (this%radius(i) + this%sradius(jpos))
4107 slen = this%sradius(jpos) - this%radius(i)
4109 c = hks * pavg * tthkw / slen
4114 if (this%ieqn(i) < 4)
then
4115 if (lc1 + lc2 /=
dzero)
then
4116 c =
done / (lc1 + lc2)
4124 if (c <
dzero .and. itcontrasterr == 0)
then
4125 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
4126 'Invalid calculated negative conductance (', c, &
4127 ') for maw well', i,
'connection', j,
'.',
'this happens when the', &
4128 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
4129 'consider decreasing hk_skin for the connection or using the', &
4130 'mean conductance equation.'
4137 if (this%inonvert /= 0)
then
4138 c = c * this%maw_calc_lcorr(i, jpos)
4142 this%satcond(jpos) = c
4149 class(
mawtype),
intent(inout) :: this
4150 integer(I4B),
intent(in) :: n
4151 integer(I4B),
intent(in) :: j
4152 integer(I4B),
intent(in) :: node
4153 real(DP),
intent(inout) :: sat
4154 real(DP),
intent(in),
optional :: hwell_in
4156 integer(I4B) :: jpos
4167 if (this%icelltype(node) /= 0)
then
4170 hwell = this%xnewpak(n)
4171 if (
present(hwell_in))
then
4176 jpos = this%get_jpos(n, j)
4179 topw = this%topscrn(jpos)
4180 botw = this%botscrn(jpos)
4183 if (this%inewton /= 1)
then
4184 h_temp = this%xnew(node)
4185 if (h_temp < botw)
then
4188 if (hwell < botw)
then
4191 h_temp =
dhalf * (h_temp + hwell)
4193 h_temp = this%xnew(node)
4194 if (hwell > h_temp)
then
4197 if (h_temp < botw)
then
4224 integer(I4B),
intent(in) :: n
4225 integer(I4B),
intent(in) :: j
4226 integer(I4B),
intent(inout) :: icflow
4227 real(DP),
intent(inout) :: cmaw
4228 real(DP),
intent(inout) :: cterm
4229 real(DP),
intent(inout) :: term
4230 real(DP),
intent(inout) :: flow
4231 real(DP),
intent(inout),
optional :: term2
4233 logical(LGP) :: correct_flow
4234 integer(I4B) :: inewton
4235 integer(I4B) :: jpos
4236 integer(I4B) :: igwfnode
4247 real(DP) :: dhbarterm
4248 real(DP) :: vscratio
4254 if (
present(term2))
then
4261 jpos = this%get_jpos(n, j)
4262 igwfnode = this%get_gwfnode(n, j)
4263 hgwf = this%xnew(igwfnode)
4264 hmaw = this%xnewpak(n)
4265 tmaw = this%topscrn(jpos)
4266 bmaw = this%botscrn(jpos)
4269 if (this%ivsc == 1)
then
4272 vscratio = this%viscratios(1, n)
4274 vscratio = this%viscratios(2, n)
4279 call this%maw_calculate_saturation(n, j, igwfnode, sat)
4280 cmaw = this%satcond(jpos) * vscratio * sat
4283 if (inewton == 1)
then
4287 if (hgwf > hups)
then
4295 if (this%icelltype(igwfnode) /= 0)
then
4305 if (this%correct_flow)
then
4308 en = max(bmaw, this%dis%bot(igwfnode))
4309 correct_flow = .false.
4311 correct_flow = .true.
4313 if (hgwf < en .and. this%icelltype(igwfnode) /= 0)
then
4314 correct_flow = .true.
4319 if (correct_flow)
then
4321 hdowns = min(hmaw, hgwf)
4323 if (hgwf > hmaw)
then
4324 cterm = cmaw * (hmaw - hbar)
4326 cterm = cmaw * (hbar - hgwf)
4331 if (inewton /= 0)
then
4334 if (hmaw > hgwf)
then
4336 term = drterm * this%satcond(jpos) * vscratio * (hbar - hmaw)
4338 term2 = cmaw * (dhbarterm -
done)
4343 term = -drterm * this%satcond(jpos) * vscratio * (hgwf - hbar)
4345 term2 = cmaw * (
done - dhbarterm)
4351 if (inewton /= 0)
then
4352 term = drterm * this%satcond(jpos) * vscratio * (hgwf - hmaw)
4358 if (inewton == 0)
then
4359 flow = term * (hgwf - hmaw) + cterm
4363 if (this%idense /= 0 .and. inewton == 0)
then
4364 call this%maw_calculate_density_exchange(jpos, hmaw, hgwf, cmaw, &
4365 bmaw, flow, term, cterm)
4374 integer(I4B),
intent(in) :: n
4375 real(DP),
intent(in) :: hmaw
4376 real(DP),
intent(inout) :: q
4393 if (rate <
dzero)
then
4398 if (this%shutofflevel(n) /=
dep20)
then
4399 call this%maw_calculate_qpot(n, q)
4401 if (q > -rate) q = -rate
4403 if (this%ishutoffcnt == 1)
then
4404 this%shutoffweight(n) =
done
4405 this%shutoffdq(n) =
dzero
4406 this%shutoffqold(n) = q
4409 dq = q - this%shutoffqold(n)
4410 weight = this%shutoffweight(n)
4413 if (this%shutoffdq(n) * dq <
dzero)
then
4414 weight = this%theta * this%shutoffweight(n)
4418 weight = this%shutoffweight(n) + this%kappa
4422 q = this%shutoffqold(n) + weight * dq
4424 this%shutoffqold(n) = q
4425 this%shutoffdq(n) = dq
4426 this%shutoffweight(n) = weight
4430 if (this%shutoffmin(n) >
dzero)
then
4431 if (hmaw < this%shutofflevel(n))
then
4435 if (this%ishutoff(n) /= 0)
then
4442 if (q < this%shutoffmin(n))
then
4443 if (this%ishutoffcnt > 2)
then
4444 this%ishutoff(n) = 1
4455 if (q > this%shutoffmax(n))
then
4456 if (this%ishutoffcnt <= 2)
then
4457 this%ishutoff(n) = 0
4460 if (this%ishutoff(n) /= 0)
then
4466 if (q /=
dzero) q = -q
4475 if (this%reduction_length(n) /=
dep20)
then
4476 bt = this%pumpelev(n)
4477 tp = bt + this%reduction_length(n)
4487 if (this%shutofflevel(n) /=
dep20)
then
4488 call this%maw_calculate_qpot(n, q)
4491 if (q > rate) q = rate
4493 if (this%ishutoffcnt == 1)
then
4494 this%shutoffweight(n) =
done
4495 this%shutoffdq(n) =
dzero
4496 this%shutoffqold(n) = q
4499 dq = q - this%shutoffqold(n)
4500 weight = this%shutoffweight(n)
4503 if (this%shutoffdq(n) * dq <
dzero)
then
4504 weight = this%theta * this%shutoffweight(n)
4508 weight = this%shutoffweight(n) + this%kappa
4512 q = this%shutoffqold(n) + weight * dq
4514 this%shutoffqold(n) = q
4515 this%shutoffdq(n) = dq
4516 this%shutoffweight(n) = weight
4524 if (this%reduction_length(n) /=
dep20)
then
4525 bt = this%pumpelev(n)
4526 tp = bt + this%reduction_length(n)
4539 class(
mawtype),
intent(inout) :: this
4540 integer(I4B),
intent(in) :: n
4541 real(DP),
intent(inout) :: qnet
4544 integer(I4B) :: jpos
4545 integer(I4B) :: igwfnode
4557 real(DP) :: vscratio
4563 h_temp = this%shutofflevel(n)
4566 if (this%ivsc == 1)
then
4569 vscratio = this%viscratios(1, n)
4571 vscratio = this%viscratios(2, n)
4576 if (this%iflowingwells > 0)
then
4577 if (this%fwcond(n) >
dzero)
then
4579 tp = bt + this%fwrlen(n)
4581 cfw = scale * this%fwcond(n) * this%viscratios(2, n)
4582 this%ifwdischarge(n) = 0
4583 if (cfw >
dzero)
then
4584 this%ifwdischarge(n) = 1
4587 qnet = qnet + cfw * (bt - h_temp)
4592 if (this%imawiss /= 1)
then
4593 if (this%ifwdischarge(n) /= 1)
then
4594 hdterm = this%xoldsto(n) - h_temp
4596 hdterm = this%xoldsto(n) - this%fwelev(n)
4598 qnet = qnet - (this%area(n) * hdterm /
delt)
4602 do j = 1, this%ngwfnodes(n)
4603 jpos = this%get_jpos(n, j)
4604 igwfnode = this%get_gwfnode(n, j)
4605 call this%maw_calculate_saturation(n, j, igwfnode, sat)
4606 cmaw = this%satcond(jpos) * vscratio * sat
4607 hgwf = this%xnew(igwfnode)
4608 bmaw = this%botscrn(jpos)
4613 if (hgwf < bmaw)
then
4616 qnet = qnet + cmaw * (hgwf - hv)
4628 integer(I4B) :: jpos
4629 integer(I4B) :: icflow
4630 integer(I4B) :: ibnd
4638 if (this%nbound .eq. 0)
return
4641 this%ishutoffcnt = this%ishutoffcnt + 1
4645 do n = 1, this%nmawwells
4646 hmaw = this%xnewpak(n)
4647 do j = 1, this%ngwfnodes(n)
4648 jpos = this%get_jpos(n, j)
4649 this%hcof(ibnd) =
dzero
4650 this%rhs(ibnd) =
dzero
4656 if (this%iboundpak(n) == 0)
then
4661 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, &
4664 this%simcond(jpos) = cmaw
4665 this%bound(2, ibnd) = cmaw
4666 this%hcof(ibnd) = -term
4667 this%rhs(ibnd) = -term * hmaw + cterm
4685 integer(I4B) :: nbudterm
4686 integer(I4B) :: n, j, n2
4688 integer(I4B) :: maxlist, naux
4690 character(len=LENBUDTXT) :: text
4691 character(len=LENBUDTXT),
dimension(1) :: auxtxt
4697 if (this%iflowingwells > 0)
then
4698 nbudterm = nbudterm + 1
4700 if (this%imover == 1)
then
4701 nbudterm = nbudterm + 3
4702 if (this%iflowingwells > 0)
then
4703 nbudterm = nbudterm + 1
4706 if (this%naux > 0) nbudterm = nbudterm + 1
4710 call this%budobj%budgetobject_df(this%nmawwells, nbudterm, 0, 0, &
4711 ibudcsv=this%ibudcsv)
4719 maxlist = this%maxbound
4721 auxtxt(1) =
' FLOW-AREA'
4722 call this%budobj%budterm(idx)%initialize(text, &
4727 maxlist, .false., .true., &
4729 call this%budobj%budterm(idx)%reset(this%maxbound)
4731 do n = 1, this%nmawwells
4732 do j = 1, this%ngwfnodes(n)
4733 n2 = this%get_gwfnode(n, j)
4734 call this%budobj%budterm(idx)%update_term(n, n2, q)
4741 maxlist = this%nmawwells
4743 call this%budobj%budterm(idx)%initialize(text, &
4748 maxlist, .false., .false., &
4752 if (this%iflowingwells > 0)
then
4755 maxlist = this%nmawwells
4757 call this%budobj%budterm(idx)%initialize(text, &
4762 maxlist, .false., .false., &
4769 maxlist = this%nmawwells
4771 auxtxt(1) =
' VOLUME'
4772 call this%budobj%budterm(idx)%initialize(text, &
4777 maxlist, .false., .true., &
4783 maxlist = this%nmawwells
4785 call this%budobj%budterm(idx)%initialize(text, &
4790 maxlist, .false., .false., &
4794 if (this%imover == 1)
then
4799 maxlist = this%nmawwells
4801 call this%budobj%budterm(idx)%initialize(text, &
4806 maxlist, .false., .false., &
4810 text =
' RATE-TO-MVR'
4812 maxlist = this%nmawwells
4814 call this%budobj%budterm(idx)%initialize(text, &
4819 maxlist, .false., .false., &
4823 text =
' CONSTANT-TO-MVR'
4825 maxlist = this%nmawwells
4827 call this%budobj%budterm(idx)%initialize(text, &
4832 maxlist, .false., .false., &
4836 if (this%iflowingwells > 0)
then
4839 text =
' FW-RATE-TO-MVR'
4841 maxlist = this%nmawwells
4843 call this%budobj%budterm(idx)%initialize(text, &
4848 maxlist, .false., .false., &
4860 maxlist = this%maxbound
4861 call this%budobj%budterm(idx)%initialize(text, &
4866 maxlist, .false., .false., &
4871 if (this%iprflow /= 0)
then
4872 call this%budobj%flowtable_df(this%iout)
4886 integer(I4B) :: naux
4890 integer(I4B) :: jpos
4892 integer(I4B) :: ibnd
4908 call this%budobj%budterm(idx)%reset(this%maxbound)
4910 do n = 1, this%nmawwells
4911 do j = 1, this%ngwfnodes(n)
4912 jpos = this%get_jpos(n, j)
4913 n2 = this%get_gwfnode(n, j)
4914 tmaw = this%topscrn(jpos)
4915 bmaw = this%botscrn(jpos)
4916 call this%maw_calculate_saturation(n, j, n2, sat)
4917 this%qauxcbc(1) =
dtwo *
dpi * this%radius(n) * sat * (tmaw - bmaw)
4918 q = this%qleak(ibnd)
4919 call this%budobj%budterm(idx)%update_term(n, n2, q, this%qauxcbc)
4926 call this%budobj%budterm(idx)%reset(this%nmawwells)
4927 do n = 1, this%nmawwells
4931 if (this%imover == 1 .and. q <
dzero)
then
4933 if (this%qout(n) <
dzero)
then
4934 qfact = q / this%qout(n)
4936 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4938 call this%budobj%budterm(idx)%update_term(n, n, q)
4942 if (this%iflowingwells > 0)
then
4944 call this%budobj%budterm(idx)%reset(this%nmawwells)
4945 do n = 1, this%nmawwells
4947 if (this%imover == 1)
then
4951 if (this%qout(n) <
dzero)
then
4952 qfact = q / this%qout(n)
4954 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4956 call this%budobj%budterm(idx)%update_term(n, n, q)
4962 call this%budobj%budterm(idx)%reset(this%nmawwells)
4963 do n = 1, this%nmawwells
4964 b = this%xsto(n) - this%bot(n)
4968 v = this%area(n) * b
4969 if (this%imawissopt /= 1)
then
4975 call this%budobj%budterm(idx)%update_term(n, n, q, this%qauxcbc)
4980 call this%budobj%budterm(idx)%reset(this%nmawwells)
4981 do n = 1, this%nmawwells
4985 if (this%imover == 1 .and. q <
dzero)
then
4987 if (this%qout(n) <
dzero)
then
4988 qfact = q / this%qout(n)
4990 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4992 call this%budobj%budterm(idx)%update_term(n, n, q)
4996 if (this%imover == 1)
then
5000 call this%budobj%budterm(idx)%reset(this%nmawwells)
5001 do n = 1, this%nmawwells
5002 if (this%iboundpak(n) == 0)
then
5005 q = this%pakmvrobj%get_qfrommvr(n)
5007 call this%budobj%budterm(idx)%update_term(n, n, q)
5012 call this%budobj%budterm(idx)%reset(this%nmawwells)
5013 do n = 1, this%nmawwells
5014 q = this%pakmvrobj%get_qtomvr(n)
5017 q2 = this%ratesim(n)
5020 if (q2 <
dzero)
then
5021 qfact = q2 / this%qout(n)
5027 call this%budobj%budterm(idx)%update_term(n, n, q)
5032 call this%budobj%budterm(idx)%reset(this%nmawwells)
5033 do n = 1, this%nmawwells
5034 q = this%pakmvrobj%get_qtomvr(n)
5039 if (q2 <
dzero)
then
5040 qfact = q2 / this%qout(n)
5046 call this%budobj%budterm(idx)%update_term(n, n, q)
5050 if (this%iflowingwells > 0)
then
5052 call this%budobj%budterm(idx)%reset(this%nmawwells)
5053 do n = 1, this%nmawwells
5054 q = this%pakmvrobj%get_qtomvr(n)
5057 q2 = this%ratesim(n)
5061 if (this%qout(n) <
dzero)
then
5062 qfact = this%qfw(n) / this%qout(n)
5066 call this%budobj%budterm(idx)%update_term(n, n, q)
5076 call this%budobj%budterm(idx)%reset(this%nmawwells)
5077 do n = 1, this%nmawwells
5079 call this%budobj%budterm(idx)%update_term(n, n, q, this%auxvar(:, n))
5084 call this%budobj%accumulate_terms()
5098 integer(I4B) :: nterms
5099 character(len=LINELENGTH) :: title
5100 character(len=LINELENGTH) :: text
5103 if (this%iprhed > 0)
then
5107 if (this%inamedbound == 1) nterms = nterms + 1
5110 title = trim(adjustl(this%text))//
' PACKAGE ('// &
5111 trim(adjustl(this%packName))//
') HEADS FOR EACH CONTROL VOLUME'
5114 call table_cr(this%headtab, this%packName, title)
5115 call this%headtab%table_df(this%nmawwells, nterms, this%iout, &
5119 if (this%inamedbound == 1)
then
5121 call this%headtab%initialize_column(text, 20, alignment=tableft)
5126 call this%headtab%initialize_column(text, 10, alignment=tabcenter)
5130 call this%headtab%initialize_column(text, 12, alignment=tabcenter)
5138 integer(I4B) :: jpos
5141 integer(I4B),
intent(in) :: n
5142 integer(I4B),
intent(in) :: j
5146 jpos = this%iaconn(n) + j - 1
5153 integer(I4B) :: igwfnode
5156 integer(I4B),
intent(in) :: n
5157 integer(I4B),
intent(in) :: j
5159 integer(I4B) :: jpos
5162 jpos = this%get_jpos(n, j)
5163 igwfnode = this%gwfnodes(jpos)
5170 class(
mawtype),
intent(inout) :: this
5172 integer(I4B) :: i, j
5177 call mem_reallocate(this%denseterms, 3, this%MAXBOUND,
'DENSETERMS', &
5179 do i = 1, this%maxbound
5181 this%denseterms(j, i) =
dzero
5184 write (this%iout,
'(/1x,a)')
'DENSITY TERMS HAVE BEEN ACTIVATED FOR MAW &
5185 &PACKAGE: '//trim(adjustl(this%packName))
5196 class(
mawtype),
intent(inout) :: this
5203 call mem_reallocate(this%viscratios, 2, this%MAXBOUND,
'VISCRATIOS', &
5205 do i = 1, this%maxbound
5207 this%viscratios(j, i) =
done
5210 write (this%iout,
'(/1x,a)')
'VISCOSITY HAS BEEN ACTIVATED FOR MAW &
5211 &PACKAGE: '//trim(adjustl(this%packName))
5237 bmaw, flow, hcofterm, rhsterm)
5239 class(
mawtype),
intent(inout) :: this
5240 integer(I4B),
intent(in) :: iconn
5241 real(DP),
intent(in) :: hmaw
5242 real(DP),
intent(in) :: hgwf
5243 real(DP),
intent(in) :: cond
5244 real(DP),
intent(in) :: bmaw
5245 real(DP),
intent(inout) :: flow
5246 real(DP),
intent(inout) :: hcofterm
5247 real(DP),
intent(inout) :: rhsterm
5251 real(DP) :: rdensemaw
5252 real(DP) :: rdensegwf
5253 real(DP) :: rdenseavg
5258 rdensemaw = this%denseterms(1, iconn)
5259 rdensegwf = this%denseterms(2, iconn)
5260 if (rdensegwf ==
dzero)
return
5263 if (hmaw > bmaw .and. hgwf > bmaw)
then
5266 rdenseavg =
dhalf * (rdensemaw + rdensegwf)
5269 t = cond * (rdenseavg -
done) * (hgwf - hmaw)
5270 rhsterm = rhsterm + t
5274 havg =
dhalf * (hgwf + hmaw)
5275 elevavg = this%denseterms(3, iconn)
5276 t = cond * (havg - elevavg) * (rdensegwf - rdensemaw)
5277 rhsterm = rhsterm + t
5279 else if (hmaw > bmaw)
then
5282 t = (rdensemaw -
done) * rhsterm
5283 rhsterm = rhsterm + t
5285 else if (hgwf > bmaw)
then
5288 t = (rdensegwf -
done) * rhsterm
5289 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
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...
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...
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.
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.