45 character(len=LENFTYPE) ::
ftype =
'MAW'
46 character(len=LENPACKAGENAME) ::
text =
' MAW'
60 real(dp),
dimension(:),
pointer,
contiguous :: strt => null()
62 integer(I4B),
pointer :: nbound => null()
63 integer(I4B),
dimension(:),
pointer,
contiguous :: ifno => null()
65 contiguous :: setting => null()
67 contiguous :: status => null()
68 integer(I4B),
dimension(:),
pointer,
contiguous :: period_icon => null()
70 contiguous :: connstatus => null()
71 real(dp),
dimension(:),
pointer,
contiguous :: period_bottom => null()
73 contiguous :: head_limit => null()
74 real(dp),
dimension(:),
pointer,
contiguous :: fwelev => null()
75 real(dp),
dimension(:),
pointer,
contiguous :: fwcond => null()
76 real(dp),
dimension(:),
pointer,
contiguous :: fwrlen => null()
77 real(dp),
dimension(:),
pointer,
contiguous :: minrate => null()
78 real(dp),
dimension(:),
pointer,
contiguous :: maxrate => null()
79 real(dp),
dimension(:),
pointer,
contiguous :: pump_elevation => null()
80 real(dp),
dimension(:),
pointer,
contiguous :: scaling_length => null()
82 contiguous :: auxname => null()
83 real(dp),
dimension(:),
pointer, &
84 contiguous :: auxval => null()
95 character(len=LENBUDTXT),
dimension(:),
pointer, &
96 contiguous :: cmawbudget => null()
97 character(len=LENAUXNAME),
dimension(:),
pointer, &
98 contiguous :: cauxcbc => null()
101 logical(LGP),
pointer :: correct_flow => null()
104 integer(I4B),
pointer :: iprhed => null()
105 integer(I4B),
pointer :: iheadout => null()
106 integer(I4B),
pointer :: ibudgetout => null()
107 integer(I4B),
pointer :: ibudcsv => null()
108 integer(I4B),
pointer :: cbcauxitems => null()
109 integer(I4B),
pointer :: iflowingwells => null()
110 integer(I4B),
pointer :: imawiss => null()
111 integer(I4B),
pointer :: imawissopt => null()
112 integer(I4B),
pointer :: nmawwells => null()
113 integer(I4B),
pointer :: check_attr => null()
114 integer(I4B),
pointer :: ishutoffcnt => null()
115 integer(I4B),
pointer :: ieffradopt => null()
116 integer(I4B),
pointer :: inonvert => null()
117 integer(I4B),
pointer :: ioutredflowcsv => null()
118 real(dp),
pointer :: satomega => null()
121 real(dp),
pointer :: theta => null()
122 real(dp),
pointer :: kappa => null()
125 character(len=8),
dimension(:),
pointer,
contiguous :: status => null()
126 integer(I4B),
dimension(:),
pointer,
contiguous :: ngwfnodes => null()
127 integer(I4B),
dimension(:),
pointer,
contiguous :: ieqn => null()
128 integer(I4B),
dimension(:),
pointer,
contiguous :: ishutoff => null()
129 integer(I4B),
dimension(:),
pointer,
contiguous :: ifwdischarge => null()
130 real(dp),
dimension(:),
pointer,
contiguous :: strt => null()
131 real(dp),
dimension(:),
pointer,
contiguous :: radius => null()
132 real(dp),
dimension(:),
pointer,
contiguous :: area => null()
133 real(dp),
dimension(:),
pointer,
contiguous :: pumpelev => null()
134 real(dp),
dimension(:),
pointer,
contiguous :: bot => null()
135 real(dp),
dimension(:),
pointer,
contiguous :: ratesim => null()
136 real(dp),
dimension(:),
pointer,
contiguous :: qsim0 => null()
137 real(dp),
dimension(:),
pointer,
contiguous :: reduction_length => null()
138 real(dp),
dimension(:),
pointer,
contiguous :: fwelev => null()
139 real(dp),
dimension(:),
pointer,
contiguous :: fwcond => null()
140 real(dp),
dimension(:),
pointer,
contiguous :: fwrlen => null()
141 real(dp),
dimension(:),
pointer,
contiguous :: fwcondsim => null()
142 real(dp),
dimension(:),
pointer,
contiguous :: xsto => null()
143 real(dp),
dimension(:),
pointer,
contiguous :: xoldsto => null()
144 real(dp),
dimension(:),
pointer,
contiguous :: shutoffmin => null()
145 real(dp),
dimension(:),
pointer,
contiguous :: shutoffmax => null()
146 real(dp),
dimension(:),
pointer,
contiguous :: shutofflevel => null()
147 real(dp),
dimension(:),
pointer,
contiguous :: shutoffweight => null()
148 real(dp),
dimension(:),
pointer,
contiguous :: shutoffdq => null()
149 real(dp),
dimension(:),
pointer,
contiguous :: shutoffqold => null()
150 real(dp),
dimension(:),
pointer,
contiguous :: nurdxold => null()
151 real(dp),
dimension(:),
pointer,
contiguous :: nurweight => null()
152 character(len=LENBOUNDNAME),
dimension(:),
pointer, &
153 contiguous :: cmawname => null()
156 real(dp),
dimension(:),
pointer,
contiguous :: rate => null()
157 real(dp),
dimension(:),
pointer,
contiguous :: well_head => null()
162 logical(LGP),
dimension(:),
pointer,
contiguous :: well_head_set => null()
168 integer(I4B),
dimension(:),
pointer,
contiguous :: iaconn => null()
171 integer(I4B),
dimension(:),
pointer,
contiguous :: gwfnodes => null()
172 integer(I4B),
dimension(:),
pointer,
contiguous :: iboundconn => null()
173 real(dp),
dimension(:),
pointer,
contiguous :: sradius => null()
174 real(dp),
dimension(:),
pointer,
contiguous :: hk => null()
175 real(dp),
dimension(:),
pointer,
contiguous :: satcond => null()
176 real(dp),
dimension(:),
pointer,
contiguous :: simcond => null()
177 real(dp),
dimension(:),
pointer,
contiguous :: topscrn => null()
178 real(dp),
dimension(:),
pointer,
contiguous :: botscrn => null()
179 real(dp),
dimension(:),
pointer,
contiguous :: angle => null()
180 real(dp),
dimension(:),
pointer,
contiguous :: connlen => null()
181 real(dp),
dimension(:),
pointer,
contiguous :: usrtopscrn => null()
182 real(dp),
dimension(:),
pointer,
contiguous :: usrbotscrn => null()
185 integer(I4B),
dimension(:),
pointer,
contiguous :: imap => null()
188 real(dp),
dimension(:),
pointer,
contiguous :: qauxcbc => null()
189 real(dp),
dimension(:),
pointer,
contiguous :: dbuff => null()
190 real(dp),
dimension(:),
pointer,
contiguous :: qleak => null()
191 real(dp),
dimension(:),
pointer,
contiguous :: qout => null()
192 real(dp),
dimension(:),
pointer,
contiguous :: qfw => null()
193 real(dp),
dimension(:),
pointer,
contiguous :: qsto => null()
194 real(dp),
dimension(:),
pointer,
contiguous :: qconst => null()
197 integer(I4B),
pointer :: bditems => null()
204 integer(I4B),
pointer :: gwfiss => null()
205 real(dp),
dimension(:),
pointer,
contiguous :: gwfk11 => null()
206 real(dp),
dimension(:),
pointer,
contiguous :: gwfk22 => null()
207 integer(I4B),
pointer :: gwfik22 => null()
208 real(dp),
dimension(:),
pointer,
contiguous :: gwfsat => null()
211 integer(I4B),
dimension(:),
pointer,
contiguous :: idxlocnode => null()
212 integer(I4B),
dimension(:),
pointer,
contiguous :: idxdglo => null()
213 integer(I4B),
dimension(:),
pointer,
contiguous :: idxoffdglo => null()
214 integer(I4B),
dimension(:),
pointer,
contiguous :: idxsymdglo => null()
215 integer(I4B),
dimension(:),
pointer,
contiguous :: idxsymoffdglo => null()
216 integer(I4B),
dimension(:),
pointer,
contiguous :: iboundpak => null()
217 real(dp),
dimension(:),
pointer,
contiguous :: xnewpak => null()
218 real(dp),
dimension(:),
pointer,
contiguous :: xoldpak => null()
221 integer(I4B),
pointer :: idense
222 real(dp),
dimension(:, :),
pointer,
contiguous :: denseterms => null()
225 real(dp),
dimension(:, :),
pointer,
contiguous :: viscratios => null()
298 subroutine maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
301 class(
bndtype),
pointer :: packobj
302 integer(I4B),
intent(in) :: id
303 integer(I4B),
intent(in) :: ibcnum
304 integer(I4B),
intent(in) :: inunit
305 integer(I4B),
intent(in) :: iout
306 character(len=*),
intent(in) :: namemodel
307 character(len=*),
intent(in) :: pakname
308 character(len=*),
intent(in) :: mempath
309 type(
mawtype),
pointer :: mawobj
316 call packobj%set_names(ibcnum, namemodel, pakname,
ftype, mempath)
320 call mawobj%maw_allocate_scalars()
323 call packobj%pack_initialize()
325 packobj%inunit = inunit
328 packobj%ibcnum = ibcnum
341 class(
mawtype),
intent(inout) :: this
344 call this%BndExtType%allocate_scalars()
347 call mem_allocate(this%correct_flow,
'CORRECT_FLOW', this%memoryPath)
348 call mem_allocate(this%iprhed,
'IPRHED', this%memoryPath)
349 call mem_allocate(this%iheadout,
'IHEADOUT', this%memoryPath)
350 call mem_allocate(this%ibudgetout,
'IBUDGETOUT', this%memoryPath)
351 call mem_allocate(this%ibudcsv,
'IBUDCSV', this%memoryPath)
352 call mem_allocate(this%iflowingwells,
'IFLOWINGWELLS', this%memoryPath)
353 call mem_allocate(this%imawiss,
'IMAWISS', this%memoryPath)
354 call mem_allocate(this%imawissopt,
'IMAWISSOPT', this%memoryPath)
355 call mem_allocate(this%nmawwells,
'NMAWWELLS', this%memoryPath)
356 call mem_allocate(this%check_attr,
'CHECK_ATTR', this%memoryPath)
357 call mem_allocate(this%ishutoffcnt,
'ISHUTOFFCNT', this%memoryPath)
358 call mem_allocate(this%ieffradopt,
'IEFFRADOPT', this%memoryPath)
359 call mem_allocate(this%inonvert,
'INONVERT', this%memoryPath)
360 call mem_allocate(this%ioutredflowcsv,
'IOUTREDFLOWCSV', this%memoryPath)
361 call mem_allocate(this%satomega,
'SATOMEGA', this%memoryPath)
362 call mem_allocate(this%bditems,
'BDITEMS', this%memoryPath)
365 call mem_allocate(this%cbcauxitems,
'CBCAUXITEMS', this%memoryPath)
366 call mem_allocate(this%idense,
'IDENSE', this%memoryPath)
369 this%correct_flow = .false.
375 this%iflowingwells = 0
380 this%ioutredflowcsv = 0
381 this%satomega =
dzero
396 class(
mawtype),
intent(inout) :: this
406 this%cmawbudget(1) =
' GWF'
407 this%cmawbudget(2) =
' RATE'
408 this%cmawbudget(3) =
' STORAGE'
409 this%cmawbudget(4) =
' CONSTANT'
410 this%cmawbudget(5) =
' FW-RATE'
411 this%cmawbudget(6) =
' FROM-MVR'
412 this%cmawbudget(7) =
' RATE-TO-MVR'
413 this%cmawbudget(8) =
' FW-RATE-TO-MVR'
418 call mem_allocate(this%status, 8, this%nmawwells,
'STATUS', this%memoryPath)
421 call mem_allocate(this%ngwfnodes, this%nmawwells,
'NGWFNODES', &
423 call mem_allocate(this%ieqn, this%nmawwells,
'IEQN', this%memoryPath)
424 call mem_allocate(this%ishutoff, this%nmawwells,
'ISHUTOFF', this%memoryPath)
425 call mem_allocate(this%ifwdischarge, this%nmawwells,
'IFWDISCHARGE', &
427 call mem_allocate(this%strt, this%nmawwells,
'STRT', this%memoryPath)
428 call mem_allocate(this%radius, this%nmawwells,
'RADIUS', this%memoryPath)
429 call mem_allocate(this%area, this%nmawwells,
'AREA', this%memoryPath)
430 call mem_allocate(this%pumpelev, this%nmawwells,
'PUMPELEV', this%memoryPath)
431 call mem_allocate(this%bot, this%nmawwells,
'BOT', this%memoryPath)
432 call mem_allocate(this%ratesim, this%nmawwells,
'RATESIM', this%memoryPath)
433 call mem_allocate(this%qsim0, this%nmawwells,
'QSIM0', this%memoryPath)
434 call mem_allocate(this%reduction_length, this%nmawwells,
'REDUCTION_LENGTH', &
436 call mem_allocate(this%fwelev, this%nmawwells,
'FWELEV', this%memoryPath)
437 call mem_allocate(this%fwcond, this%nmawwells,
'FWCONDS', this%memoryPath)
438 call mem_allocate(this%fwrlen, this%nmawwells,
'FWRLEN', this%memoryPath)
439 call mem_allocate(this%fwcondsim, this%nmawwells,
'FWCONDSIM', &
441 call mem_allocate(this%xsto, this%nmawwells,
'XSTO', this%memoryPath)
442 call mem_allocate(this%xoldsto, this%nmawwells,
'XOLDSTO', this%memoryPath)
443 call mem_allocate(this%shutoffmin, this%nmawwells,
'SHUTOFFMIN', &
445 call mem_allocate(this%shutoffmax, this%nmawwells,
'SHUTOFFMAX', &
447 call mem_allocate(this%shutofflevel, this%nmawwells,
'SHUTOFFLEVEL', &
449 call mem_allocate(this%shutoffweight, this%nmawwells,
'SHUTOFFWEIGHT', &
451 call mem_allocate(this%shutoffdq, this%nmawwells,
'SHUTOFFDQ', &
453 call mem_allocate(this%shutoffqold, this%nmawwells,
'SHUTOFFQOLD', &
455 call mem_allocate(this%nurdxold, this%nmawwells,
'NURDXOLD', &
457 call mem_allocate(this%nurweight, this%nmawwells,
'NURWEIGHT', &
462 call mem_setptr(this%rate,
'RATE', this%input_mempath)
463 call mem_setptr(this%well_head,
'WELL_HEAD', this%input_mempath)
464 call mem_allocate(this%well_head_set, this%nmawwells,
'WELL_HEAD_SET', &
466 this%well_head_set = .false.
469 if (this%iheadout > 0)
then
470 call mem_allocate(this%dbuff, this%nmawwells,
'DBUFF', this%memoryPath)
472 call mem_allocate(this%dbuff, 0,
'DBUFF', this%memoryPath)
476 call mem_allocate(this%iaconn, this%nmawwells + 1,
'IACONN', this%memoryPath)
479 call mem_allocate(this%imap, this%MAXBOUND,
'IMAP', this%memoryPath)
482 call mem_allocate(this%gwfnodes, this%maxbound,
'GWFNODES', this%memoryPath)
483 call mem_allocate(this%iboundconn, this%maxbound,
'IBOUNDCONN', &
485 call mem_allocate(this%sradius, this%maxbound,
'SRADIUS', this%memoryPath)
486 call mem_allocate(this%hk, this%maxbound,
'HK', this%memoryPath)
487 call mem_allocate(this%satcond, this%maxbound,
'SATCOND', this%memoryPath)
488 call mem_allocate(this%simcond, this%maxbound,
'SIMCOND', this%memoryPath)
489 call mem_allocate(this%topscrn, this%maxbound,
'TOPSCRN', this%memoryPath)
490 call mem_allocate(this%botscrn, this%maxbound,
'BOTSCRN', this%memoryPath)
491 call mem_allocate(this%angle, this%maxbound,
'ANGLE', this%memoryPath)
492 call mem_allocate(this%connlen, this%maxbound,
'CONNLEN', this%memoryPath)
493 call mem_allocate(this%usrtopscrn, this%maxbound,
'USRTOPSCRN', &
495 call mem_allocate(this%usrbotscrn, this%maxbound,
'USRBOTSCRN', &
499 call mem_allocate(this%qleak, this%maxbound,
'QLEAK', this%memoryPath)
502 do n = 1, this%nmawwells
503 this%status(n) =
'ACTIVE'
504 this%ngwfnodes(n) = 0
507 this%ifwdischarge(n) = 0
509 this%radius(n) =
dep20
511 this%pumpelev(n) =
dep20
513 this%ratesim(n) =
dzero
514 this%qsim0(n) =
dzero
515 this%reduction_length(n) =
dep20
516 this%fwelev(n) =
dzero
517 this%fwcond(n) =
dzero
518 this%fwrlen(n) =
dzero
519 this%fwcondsim(n) =
dzero
521 this%xoldsto(n) =
dzero
522 this%shutoffmin(n) =
dzero
523 this%shutoffmax(n) =
dzero
524 this%shutofflevel(n) =
dep20
525 this%shutoffweight(n) =
done
526 this%shutoffdq(n) =
done
527 this%shutoffqold(n) =
done
528 this%nurdxold(n) =
dzero
529 this%nurweight(n) =
done
533 this%well_head(n) =
dzero
536 if (this%iheadout > 0)
then
537 this%dbuff(n) =
dzero
542 do n = 1, this%nmawwells + 1
551 call mem_allocate(this%qauxcbc, this%cbcauxitems,
'QAUXCBC', this%memoryPath)
552 do j = 1, this%cbcauxitems
553 this%qauxcbc(j) =
dzero
557 if (this%iflowingwells /= 0)
then
558 call mem_allocate(this%qfw, this%nmawwells,
'QFW', this%memoryPath)
562 call mem_allocate(this%qout, this%nmawwells,
'QOUT', this%memoryPath)
563 call mem_allocate(this%qsto, this%nmawwells,
'QSTO', this%memoryPath)
564 call mem_allocate(this%qconst, this%nmawwells,
'QCONST', this%memoryPath)
567 do n = 1, this%nmawwells
568 if (this%iflowingwells > 0)
then
572 this%qconst(n) =
dzero
576 do j = 1, this%maxbound
579 this%iboundconn(j) = 1
580 this%sradius(j) =
dzero
582 this%satcond(j) =
dzero
583 this%simcond(j) =
dzero
584 this%topscrn(j) =
dzero
585 this%botscrn(j) =
dzero
586 this%angle(j) =
dzero
587 this%connlen(j) =
dzero
588 this%usrtopscrn(j) =
dzero
589 this%usrbotscrn(j) =
dzero
590 this%qleak(j) =
dzero
594 call mem_allocate(this%denseterms, 3, 0,
'DENSETERMS', this%memoryPath)
597 call mem_allocate(this%viscratios, 2, 0,
'VISCRATIOS', this%memoryPath)
606 class(
mawtype),
intent(inout) :: this
610 call this%BndExtType%allocate_arrays()
613 call this%BndExtType%allocate_featureauxvar()
620 class(
mawtype),
intent(inout) :: this
623 integer(I4B) :: isize
624 character(len=LINELENGTH) :: fname
626 character(len=*),
parameter :: fmtflowingwells = &
627 &
"(4x, 'FLOWING WELLS WILL BE SIMULATED.')"
628 character(len=*),
parameter :: fmtshutdown = &
629 &
"(4x, 'SHUTDOWN ', a, ' VALUE (',g15.7,') SPECIFIED.')"
630 character(len=*),
parameter :: fmtnostoragewells = &
631 &
"(4x, 'WELL STORAGE WILL NOT BE SIMULATED.')"
632 character(len=*),
parameter :: fmtmawbin = &
633 "(4x, 'MAW ', 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, /4x, &
634 &'OPENED ON UNIT: ', I0)"
638 call this%BndExtType%source_options()
640 write (this%iout,
'(1x,a)') &
641 'PROCESSING '//trim(adjustl(this%text))//
' OPTIONS'
644 call get_isize(
'PRINT_HEAD', this%input_mempath, isize)
647 write (this%iout,
'(4x,a)') &
648 trim(adjustl(this%text))//
' heads will be printed to listing file.'
652 call mem_set_value(fname,
'HEADFILE', this%input_mempath, found%headfile)
653 if (found%headfile)
then
654 call assign_iounit(this%iheadout, this%inunit,
"HEAD fileout")
655 call openfile(this%iheadout, this%iout, fname,
'DATA(BINARY)', &
657 write (this%iout, fmtmawbin)
'HEAD', trim(adjustl(fname)), this%iheadout
661 call mem_set_value(fname,
'BUDGETFILE', this%input_mempath, found%budgetfile)
662 if (found%budgetfile)
then
663 call assign_iounit(this%ibudgetout, this%inunit,
"BUDGET fileout")
664 call openfile(this%ibudgetout, this%iout, fname,
'DATA(BINARY)', &
666 write (this%iout, fmtmawbin)
'BUDGET', trim(adjustl(fname)), this%ibudgetout
670 call mem_set_value(fname,
'BUDGETCSVFILE', this%input_mempath, &
672 if (found%budgetcsvfile)
then
673 call assign_iounit(this%ibudcsv, this%inunit,
"BUDGETCSV fileout")
674 call openfile(this%ibudcsv, this%iout, fname,
'CSV', filstat_opt=
'REPLACE')
675 write (this%iout, fmtmawbin) &
676 'BUDGET CSV', trim(adjustl(fname)), this%ibudcsv
680 call get_isize(
'NO_WELL_STORAGE', this%input_mempath, isize)
683 write (this%iout, fmtnostoragewells)
687 call get_isize(
'FLOW_CORRECTION', this%input_mempath, isize)
689 this%correct_flow = .true.
690 write (this%iout,
'(4x,a,/,4x,a)') &
691 'MAW-GWF FLOW CORRECTIONS WILL BE APPLIED WHEN MAW HEADS ARE BELOW', &
692 'OR GWF HEADS IN CONNECTED CELLS ARE BELOW THE CELL BOTTOM.'
696 call get_isize(
'FLOWING_WELLS', this%input_mempath, isize)
698 this%iflowingwells = 1
699 write (this%iout, fmtflowingwells)
703 call mem_set_value(this%theta,
'SHUTDOWN_THETA', this%input_mempath, &
704 found%shutdown_theta)
705 if (found%shutdown_theta)
then
706 write (this%iout, fmtshutdown)
'THETA', this%theta
710 call mem_set_value(this%kappa,
'SHUTDOWN_KAPPA', this%input_mempath, &
711 found%shutdown_kappa)
712 if (found%shutdown_kappa)
then
713 write (this%iout, fmtshutdown)
'KAPPA', this%kappa
717 call mem_set_value(fname,
'MFRCSVFILE', this%input_mempath, found%mfrcsvfile)
718 if (found%mfrcsvfile)
then
719 call this%maw_redflow_csv_init(fname)
723 call get_isize(
'MOVER', this%input_mempath, isize)
726 write (this%iout,
'(4x,A)')
'MOVER OPTION ENABLED'
730 call get_isize(
'IEFFRADOPT', this%input_mempath, isize)
733 write (this%iout,
'(4x,a)') &
734 'EFFECTIVE RADIUS FOR STRUCTURED GRIDS WILL BE CALCULATED &
735 &USING PEACEMAN 1983'
739 call get_isize(
'INONVERT', this%input_mempath, isize)
742 write (this%iout,
'(4x,a)') &
743 'NON-VERTICAL (SLANTED) WELL CONNECTIONS ENABLED'
746 write (this%iout,
'(1x,a)')
'END OF '//trim(adjustl(this%text))//
' OPTIONS'
753 class(
mawtype),
intent(inout) :: this
761 write (this%iout,
'(/1x,a)') &
762 'PROCESSING '//trim(adjustl(this%text))//
' DIMENSIONS'
765 call mem_set_value(this%nmawwells,
'MAXBOUND', this%input_mempath, &
766 found%maxbound, release=.false.)
767 if (found%maxbound)
then
768 write (this%iout,
'(4x,a,i0)')
'NMAWWELLS = ', this%nmawwells
771 write (this%iout,
'(1x,a)') &
772 'END OF '//trim(adjustl(this%text))//
' DIMENSIONS'
774 if (this%nmawwells < 0)
then
776 'NMAWWELLS was not specified or was specified incorrectly.'
782 this%npakeq = this%nmawwells
785 call this%maw_source_packagedata()
788 call this%maw_source_connectiondata()
791 call this%maw_source_angledata()
794 call this%define_listlabel()
797 call this%maw_setup_budobj()
800 call this%maw_setup_tableobj()
810 character(len=*),
intent(in) :: mempath
811 integer(I4B),
intent(in) :: naux
812 call mem_setptr(this%nbound,
'NBOUND', mempath)
814 call mem_setptr(this%setting,
'SETTING', mempath)
815 call mem_setptr(this%status,
'STATUS', mempath)
816 call mem_setptr(this%period_icon,
'PERIOD_ICON', mempath)
817 call mem_setptr(this%connstatus,
'CONNSTATUS', mempath)
818 call mem_setptr(this%period_bottom,
'PERIOD_BOTTOM', mempath)
819 call mem_setptr(this%head_limit,
'HEAD_LIMIT', mempath)
820 call mem_setptr(this%fwelev,
'FWELEV', mempath)
821 call mem_setptr(this%fwcond,
'FWCOND', mempath)
822 call mem_setptr(this%fwrlen,
'FWRLEN', mempath)
823 call mem_setptr(this%minrate,
'MINRATE', mempath)
824 call mem_setptr(this%maxrate,
'MAXRATE', mempath)
825 call mem_setptr(this%pump_elevation,
'PUMP_ELEVATION', mempath)
826 call mem_setptr(this%scaling_length,
'SCALING_LENGTH', mempath)
828 call mem_setptr(this%auxname,
'AUXNAME', mempath)
829 call mem_setptr(this%auxval,
'AUXVAL', mempath)
838 nullify (this%nbound)
840 nullify (this%setting)
841 nullify (this%status)
842 nullify (this%period_icon)
843 nullify (this%connstatus)
844 nullify (this%period_bottom)
845 nullify (this%head_limit)
846 nullify (this%fwelev)
847 nullify (this%fwcond)
848 nullify (this%fwrlen)
849 nullify (this%minrate)
850 nullify (this%maxrate)
851 nullify (this%pump_elevation)
852 nullify (this%scaling_length)
853 nullify (this%auxname)
854 nullify (this%auxval)
861 class(
mawtype),
intent(inout) :: this
863 integer(I4B) :: n, jj, idx, imaw
864 character(len=9) :: cno9
865 character(len=LINELENGTH) :: keyword
867 integer(I4B),
dimension(:),
pointer,
contiguous :: ifno => null()
868 real(DP),
dimension(:),
pointer,
contiguous :: radius => null()
869 real(DP),
dimension(:),
pointer,
contiguous :: bottom => null()
871 contiguous :: condeqn => null()
872 integer(I4B),
dimension(:),
pointer,
contiguous :: ngwfnodes => null()
874 contiguous :: boundname => null()
875 integer(I4B),
allocatable :: nboundchk(:)
877 character(len=*),
parameter :: fmthdbot = &
878 "('well head (', G0, ') must be greater than or equal to the &
879 &BOTTOM_ELEVATION (', G0, ').')"
881 write (this%iout,
'(/1x,a)') &
882 'PROCESSING '//trim(adjustl(this%text))//
' PACKAGEDATA'
885 call mem_setptr(ifno,
'PACKAGEDATA_IFNO', this%input_mempath)
886 call mem_setptr(radius,
'RADIUS', this%input_mempath)
887 call mem_setptr(bottom,
'BOTTOM', this%input_mempath)
888 call mem_setptr(this%input%strt,
'STRT', this%input_mempath)
889 call mem_setptr(condeqn,
'CONDEQN', this%input_mempath)
890 call mem_setptr(ngwfnodes,
'NGWFNODES', this%input_mempath)
891 if (this%inamedbound /= 0)
then
892 call mem_setptr(boundname,
'BOUNDNAME', this%input_mempath)
897 this%maxbound = sum(ngwfnodes)
898 write (this%iout,
'(//4x,a,i7)')
'MAXBOUND = ', this%maxbound
899 call this%maw_allocate_well_conn_arrays()
902 allocate (nboundchk(this%nmawwells))
904 do n = 1, this%nmawwells
905 imaw = this%validate_ifno(ifno(n), this%nmawwells, nboundchk, &
906 'IMAW',
'PACKAGEDATA')
911 if (rval <=
dzero)
then
912 write (
errmsg,
'(a,1x,i0,1x,a)') &
913 'Radius for well', imaw,
'must be greater than zero.'
916 this%radius(imaw) = rval
917 this%area(imaw) =
dpi * rval**
dtwo
920 this%bot(imaw) = bottom(n)
924 select case (trim(keyword))
931 write (
warnmsg,
'(a,a,a,a,a,a)') &
932 "CONDEQN in '", trim(this%packName),
"' should be ", &
933 "corrected from '", trim(keyword),
"' to 'THIEM'."
942 write (
errmsg,
'(a,1x,i0,1x,a)') &
943 'CONDEQN for well', imaw, &
944 "must be 'CUMULATIVE', 'THIEM', 'MEAN', or 'SKIN'."
950 if (ngwfnodes(n) < 1)
then
951 write (
errmsg,
'(a,1x,i0,1x,a)') &
952 'NGWFNODES for well', imaw,
'must be greater than zero.'
955 this%ngwfnodes(imaw) = ngwfnodes(n)
958 this%well_head(imaw) = this%input%strt(n)
959 this%strt(imaw) = this%input%strt(n)
960 if (this%strt(imaw) < this%bot(imaw))
then
961 write (keyword, fmthdbot) this%strt(imaw), this%bot(imaw)
962 call this%maw_set_attribute_error(imaw,
'STRT', trim(keyword))
966 write (cno9,
'(i9.9)') imaw
967 this%cmawname(imaw) =
'MAWWELL'//cno9
968 if (this%inamedbound /= 0)
then
970 if (trim(
text) /=
'')
then
971 this%cmawname(imaw) = trim(
text)
977 call this%report_ifno_coverage(nboundchk, this%nmawwells,
'well', &
979 deallocate (nboundchk)
981 write (this%iout,
'(1x,a)') &
982 'END OF '//trim(adjustl(this%text))//
' PACKAGEDATA'
991 do n = 1, this%nmawwells
992 do jj = 1, this%ngwfnodes(n)
996 this%iaconn(n + 1) = idx + 1
1012 class(
mawtype),
intent(inout) :: this
1014 integer(I4B) :: n, nconn, imaw, iconn, ipos, jpos, j, jj
1015 integer(I4B) :: nn, nn2
1016 integer(I4B) :: ireset_scrntop, ireset_scrnbot, ireset_wellbot
1017 real(DP) :: rval, topnn, botnn, botw
1018 character(len=LINELENGTH) :: cellid_str
1019 character(len=30) :: nodestr
1020 integer(I4B),
dimension(:),
pointer,
contiguous :: ifno => null()
1021 integer(I4B),
dimension(:),
pointer,
contiguous :: icon => null()
1022 integer(I4B),
dimension(:, :),
pointer,
contiguous :: cellid => null()
1023 real(DP),
dimension(:),
pointer,
contiguous :: scrn_top => null()
1024 real(DP),
dimension(:),
pointer,
contiguous :: scrn_bot => null()
1025 real(DP),
dimension(:),
pointer,
contiguous :: hk_skin => null()
1026 real(DP),
dimension(:),
pointer,
contiguous :: radius_skin => null()
1027 integer(I4B),
allocatable :: iachk(:)
1028 integer(I4B),
allocatable :: nboundchk(:)
1034 write (this%iout,
'(/1x,a)') &
1035 'PROCESSING '//trim(adjustl(this%text))//
' CONNECTIONDATA'
1038 call mem_setptr(ifno,
'CONNDATA_IFNO', this%input_mempath)
1039 call mem_setptr(icon,
'ICON', this%input_mempath)
1040 call mem_setptr(cellid,
'CELLID', this%input_mempath)
1041 call mem_setptr(scrn_top,
'SCRN_TOP', this%input_mempath)
1042 call mem_setptr(scrn_bot,
'SCRN_BOT', this%input_mempath)
1043 call mem_setptr(hk_skin,
'HK_SKIN', this%input_mempath)
1044 call mem_setptr(radius_skin,
'RADIUS_SKIN', this%input_mempath)
1049 allocate (iachk(this%nmawwells + 1))
1051 do n = 1, this%nmawwells
1052 iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
1054 allocate (nboundchk(this%maxbound))
1062 if (imaw < 1 .or. imaw > this%nmawwells)
then
1063 write (
errmsg,
'(a,1x,i0,a)') &
1064 'IMAW must be greater than 0 and less than or equal to ', &
1069 if (iconn < 1 .or. iconn > this%ngwfnodes(imaw))
then
1070 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
1071 'JCONN for well ', imaw, &
1072 'must be greater than 1 and less than or equal to ', &
1073 this%ngwfnodes(imaw),
'.'
1078 ipos = iachk(imaw) + iconn - 1
1079 nboundchk(ipos) = nboundchk(ipos) + 1
1081 jpos = this%get_jpos(imaw, iconn)
1084 write (cellid_str,
'(10(i0,1x))') cellid(1:this%dis%ndim, n)
1085 nn = this%dis%noder_from_cellid(cellid_str, this%inunit, this%iout)
1086 topnn = this%dis%top(nn)
1087 botnn = this%dis%bot(nn)
1088 botw = this%bot(imaw)
1091 this%gwfnodes(jpos) = nn
1094 this%usrtopscrn(jpos) = scrn_top(n)
1096 if (this%ieqn(imaw) /= 4)
then
1099 if (rval > topnn)
then
1100 ireset_scrntop = ireset_scrntop + 1
1104 this%topscrn(jpos) = rval
1107 this%usrbotscrn(jpos) = scrn_bot(n)
1109 if (this%ieqn(imaw) /= 4)
then
1112 if (rval < botnn)
then
1113 ireset_scrnbot = ireset_scrnbot + 1
1117 this%botscrn(jpos) = rval
1121 if (rval < botw)
then
1122 if (this%ieqn(imaw) /= 4)
then
1123 ireset_wellbot = ireset_wellbot + 1
1125 this%bot(imaw) = rval
1127 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
1128 'Screen bottom for maw well', imaw,
'connection', j,
'(', &
1129 this%botscrn(jpos),
') is less than the well bottom (', &
1130 this%bot(imaw),
').'
1137 if (this%ieqn(imaw) == 0)
then
1138 this%satcond(jpos) = rval
1139 else if (this%ieqn(imaw) == 2 .OR. this%ieqn(imaw) == 3 .OR. &
1140 this%ieqn(imaw) == 4)
then
1141 this%hk(jpos) = rval
1145 rval = radius_skin(n)
1146 if (this%ieqn(imaw) == 2 .OR. this%ieqn(imaw) == 3 .OR. &
1147 this%ieqn(imaw) == 4)
then
1148 this%sradius(jpos) = rval
1149 if (this%sradius(jpos) <= this%radius(imaw))
then
1150 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
1151 'Screen radius for maw well', imaw,
'connection', j,
'(', &
1152 this%sradius(jpos), &
1153 ') is less than or equal to the well radius (', &
1154 this%radius(imaw),
').'
1160 write (this%iout,
'(1x,a)') &
1161 'END OF '//trim(adjustl(this%text))//
' CONNECTIONDATA'
1165 do n = 1, this%nmawwells
1166 do j = 1, this%ngwfnodes(n)
1168 if (nboundchk(ipos) == 0)
then
1169 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
1170 'No data specified for maw well', n,
'connection', j,
'.'
1172 else if (nboundchk(ipos) > 1)
then
1173 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,1x,i0,1x,a)') &
1174 'Data for maw well', n,
'connection', j, &
1175 'specified', nboundchk(ipos),
'times.'
1183 do n = 1, this%nmawwells
1184 if (this%ieqn(n) /= 4)
then
1185 do j = 1, this%ngwfnodes(n)
1186 nn = this%get_gwfnode(n, j)
1187 do jj = 1, this%ngwfnodes(n)
1189 nn2 = this%get_gwfnode(n, jj)
1191 call this%dis%noder_to_string(nn, nodestr)
1192 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,3(1x,a))') &
1193 'Only one connection can be specified for maw well', &
1194 n,
'connection', j,
'to gwf cell', trim(adjustl(nodestr)), &
1195 'unless the mean condeqn is specified.'
1205 deallocate (nboundchk)
1208 if (ireset_scrntop > 0)
then
1209 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1210 'The screen tops in multi-aquifer well package', trim(this%packName), &
1211 'were reset to the top of the connected cell', ireset_scrntop,
'times.'
1214 if (ireset_scrnbot > 0)
then
1215 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1216 'The screen bottoms in multi-aquifer well package', trim(this%packName), &
1217 'were reset to the bottom of the connected cell', ireset_scrnbot, &
1221 if (ireset_wellbot > 0)
then
1222 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1223 'The well bottoms in multi-aquifer well package', trim(this%packName), &
1224 'were reset to the bottom of the connected cell', ireset_wellbot, &
1250 class(
mawtype),
intent(inout) :: this
1252 integer(I4B) :: n, imaw, iconn, jpos, ichk, nangle, node
1253 real(DP) :: angle, dz, omega, lw, topexp
1256 character(len=LINELENGTH) :: cndmsg
1257 character(len=LINELENGTH) :: extmsg
1258 logical(LGP) :: estimated
1259 integer(I4B),
dimension(:),
pointer,
contiguous :: angledata_ifno => null()
1260 integer(I4B),
dimension(:),
pointer,
contiguous :: angledata_icon => null()
1261 real(DP),
dimension(:),
pointer,
contiguous :: angle_arr => null()
1262 real(DP),
dimension(:),
pointer,
contiguous :: connlen_arr => null()
1263 integer(I4B),
allocatable :: iachk(:)
1264 integer(I4B),
allocatable :: nboundchk(:)
1265 real(DP),
parameter :: coszero =
dem6
1266 real(DP),
parameter :: dninety = 9.0d1
1268 call get_isize(
'ANGLEDATA_IFNO', this%input_mempath, nangle)
1270 if (nangle > 0)
then
1272 if (this%inonvert == 0)
then
1273 call store_error(
'An ANGLEDATA block was specified but the '// &
1274 'NON_VERTICAL_WELLS option was not specified in the '// &
1279 call mem_setptr(angledata_ifno,
'ANGLEDATA_IFNO', this%input_mempath)
1280 call mem_setptr(angledata_icon,
'ANGLEDATA_ICON', this%input_mempath)
1281 call mem_setptr(angle_arr,
'ANGLE', this%input_mempath)
1282 call mem_setptr(connlen_arr,
'CONNLEN', this%input_mempath)
1284 allocate (iachk(this%nmawwells + 1))
1286 do n = 1, this%nmawwells
1287 iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
1289 allocate (nboundchk(this%maxbound))
1292 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1296 imaw = angledata_ifno(n)
1297 if (imaw < 1 .or. imaw > this%nmawwells)
then
1298 write (
errmsg,
'(a,1x,i0,a)') &
1299 'IFNO must be greater than 0 and less than or equal to ', &
1305 iconn = angledata_icon(n)
1306 if (iconn < 1 .or. iconn > this%ngwfnodes(imaw))
then
1307 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
1308 'ICON for well ', imaw, &
1309 'must be greater than 0 and less than or equal to ', &
1310 this%ngwfnodes(imaw),
'.'
1314 jpos = this%get_jpos(imaw, iconn)
1316 ichk = iachk(imaw) + iconn - 1
1317 nboundchk(ichk) = nboundchk(ichk) + 1
1318 if (nboundchk(ichk) > 1)
then
1319 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1320 'ANGLEDATA for maw well', imaw,
'connection', iconn, &
1321 'is specified more than once.'
1325 angle = angle_arr(n)
1326 this%angle(jpos) = angle
1327 if (connlen_arr(n) /=
dnodata)
then
1328 this%connlen(jpos) = max(connlen_arr(n),
dzero)
1331 if (angle <
dzero .or. angle > dninety)
then
1332 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1333 'ANGLE for maw well', imaw,
'connection', iconn,
'(', angle, &
1334 ') must be greater than or equal to 0.0 and less than or '// &
1335 'equal to 90.0 degrees.'
1340 node = this%get_gwfnode(imaw, iconn)
1348 if (this%ieqn(imaw) == 0)
then
1349 this%topscrn(jpos) = min(this%usrtopscrn(jpos), this%dis%top(node))
1350 this%botscrn(jpos) = max(this%usrbotscrn(jpos), this%dis%bot(node))
1353 dz = this%topscrn(jpos) - this%botscrn(jpos)
1354 if (dz <=
dzero)
then
1355 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1356 'The screen top must be greater than the screen bottom for maw '// &
1357 'well', imaw,
'connection', iconn,
'listed in the ANGLEDATA block.'
1367 if (this%connlen(jpos) >
dzero)
then
1368 lw = this%connlen(jpos)
1369 else if (cos(omega) > coszero)
then
1381 if (this%ieqn(imaw) /= 0)
then
1382 if (cos(omega) <= coszero .and. this%connlen(jpos) <=
dzero)
then
1383 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1384 'A connection length must be specified for the (near) '// &
1385 'horizontal maw well', imaw,
'connection', iconn, &
1386 'listed in the ANGLEDATA block.'
1390 if (lw <=
dzero)
then
1391 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1392 'The calculated in-cell screen length for maw well', imaw, &
1393 'connection', iconn,
'(', lw, &
1394 ') is not greater than zero. Specify a connection length in '// &
1395 'the ANGLEDATA block.'
1403 if (lw >
dzero)
then
1404 hlen = lw * sin(omega)
1405 extent = this%maw_cell_extent(node, estimated)
1406 if (hlen > extent)
then
1411 extmsg =
'estimated maximum horizontal extent'
1413 extmsg =
'maximum horizontal extent'
1419 if (this%ieqn(imaw) == 0)
then
1420 cndmsg =
'The specified saturated conductance is applied to a '// &
1421 'screen that is longer than the cell.'
1423 cndmsg =
'The calculated saturated conductance is '// &
1424 'correspondingly too large.'
1426 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
1427 'The horizontal distance spanned by maw well', imaw, &
1428 'connection', iconn,
'(', hlen, &
1429 ') is greater than the '//trim(extmsg)//
' of the '// &
1430 'connected cell (', extent, &
1431 '), so the screen extends beyond the cell it is connected '// &
1432 'to. '//trim(cndmsg)//
' Reduce ANGLE or CONN_LENGTH, or '// &
1433 'specify a separate connection to each cell the connection '// &
1442 if (cos(omega) <= coszero .and. &
1443 this%ieqn(imaw) /= 4 .and. this%ieqn(imaw) /= 0)
then
1444 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1445 'The (near) horizontal maw well', imaw,
'connection', iconn, &
1446 'uses a radial conductance equation (THIEM, SKIN, or '// &
1447 'CUMULATIVE). The calculated conductance is an approximation '// &
1448 'for horizontal connections; the MEAN conductance equation is '// &
1449 'recommended for horizontal connections.'
1453 if (cos(omega) <= coszero .and. &
1454 (this%ieqn(imaw) == 4 .or. this%ieqn(imaw) == 0))
then
1455 topexp = this%botscrn(jpos) +
dtwo * this%radius(imaw)
1456 if (
is_close(this%topscrn(jpos), topexp))
then
1457 this%topscrn(jpos) = topexp
1459 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1460 'The vertical screen extent (SCRN_TOP - SCRN_BOT) for the '// &
1461 '(near) horizontal maw well', imaw,
'connection', iconn, &
1462 'is not equal to the well diameter (2 * RADIUS = ', &
1463 dtwo * this%radius(imaw), &
1464 '). The vertical screen extent is used to determine the '// &
1465 'saturation of a connection and should equal the well '// &
1466 'diameter for a horizontal connection.'
1472 write (this%iout,
'(1x,a)') &
1473 'END OF '//trim(adjustl(this%text))//
' ANGLEDATA'
1476 deallocate (nboundchk)
1483 if (this%inonvert /= 0)
then
1485 'The NON_VERTICAL_WELLS option was specified but an ANGLEDATA '// &
1486 'block was not found. All multi-aquifer well connections will be '// &
1487 'treated as vertical.'
1503 real(dp),
intent(in) :: dz
1504 real(dp),
intent(in) :: radius
1505 real(dp),
intent(in) :: omega
1509 lw = (dz -
dtwo * radius * sin(omega)) / cos(omega)
1522 class(
mawtype),
intent(inout) :: this
1523 integer(I4B),
intent(in) :: node
1524 logical(LGP),
intent(out) :: estimated
1528 real(dp),
allocatable,
dimension(:, :) :: polyverts
1529 integer(I4B) :: nverts
1534 select case (this%dis%get_dis_enum())
1536 nverts = this%dis%get_npolyverts(node)
1539 estimated = nverts == 0
1541 extent = sqrt(
dtwo * this%dis%area(node))
1543 call this%dis%get_polyverts(node, polyverts)
1545 deallocate (polyverts)
1562 class(
mawtype),
intent(inout) :: this
1563 integer(I4B),
intent(in) :: i
1564 integer(I4B),
intent(in) :: jpos
1574 if (this%angle(jpos) ==
dzero .and. this%connlen(jpos) <=
dzero)
then
1579 dz = this%topscrn(jpos) - this%botscrn(jpos)
1580 if (dz <=
dzero)
then
1586 if (this%connlen(jpos) >
dzero)
then
1587 lw = this%connlen(jpos)
1589 omega = this%angle(jpos) *
dpio180
1603 class(
mawtype),
intent(inout) :: this
1605 character(len=LINELENGTH) :: title
1606 character(len=LINELENGTH) :: text
1607 integer(I4B) :: ntabcols
1611 integer(I4B) :: jpos
1612 integer(I4B) :: inode
1616 character(len=10),
dimension(0:4) :: ccond
1617 character(len=30) :: nodestr
1619 data ccond(0)/
'SPECIFIED '/
1620 data ccond(1)/
'THIEM '/
1621 data ccond(2)/
'SKIN '/
1622 data ccond(3)/
'CUMULATIVE'/
1623 data ccond(4)/
'MEAN '/
1625 character(len=*),
parameter :: fmtwelln = &
1626 "(1X,//43X,'MULTI-AQUIFER WELL DATA'&
1628 &/1X,7(A10,1X),A16)"
1629 character(len=*),
parameter :: fmtwelld = &
1630 &
"(1X,I10,1X,4(G10.3,1X),I10,1X,A10,1X,A16)"
1631 character(len=*),
parameter :: fmtline = &
1633 character(len=*),
parameter :: fmtwellcn = &
1634 "(1X,//37X,'MULTI-AQUIFER WELL CONNECTION DATA'&
1636 &/1X,2(A10,1X),A20,7(A10,1X))"
1637 character(len=*),
parameter :: fmtwellcd = &
1638 &
"(1X,2(I10,1X),A20,1X,2(G10.3,1X),2(A10,1X),3(G10.3,1X))"
1641 do n = 1, this%nmawwells
1642 this%xnewpak(n) = this%strt(n)
1643 this%xsto(n) = this%strt(n)
1647 do n = 1, this%nmawwells
1648 select case (this%status(n))
1650 this%iboundpak(n) = -1
1652 this%iboundpak(n) = 0
1654 this%iboundpak(n) = 1
1659 if (this%inamedbound /= 0)
then
1661 do n = 1, this%nmawwells
1662 do j = 1, this%ngwfnodes(n)
1664 this%boundname(idx) = this%cmawname(n)
1669 do n = 1, this%nmawwells
1670 this%cmawname(n) =
''
1675 call this%copy_boundname()
1685 call this%maw_check_attributes()
1688 do n = 1, this%nmawwells
1692 do j = 1, this%ngwfnodes(n)
1693 if (this%ieqn(n) /= 0)
then
1694 inode = this%get_gwfnode(n, j)
1695 call this%maw_calculate_satcond(n, j, inode)
1702 if (this%iprpak /= 0)
then
1704 if (this%inamedbound /= 0)
then
1705 ntabcols = ntabcols + 1
1707 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1708 trim(adjustl(this%packName))//
') STATIC WELL DATA'
1709 call table_cr(this%inputtab, this%packName, title)
1710 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1712 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1714 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1716 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1717 text =
'WELL BOTTOM'
1718 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1719 text =
'STARTING HEAD'
1720 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1721 text =
'NUMBER OF GWF NODES'
1722 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1723 text =
'CONDUCT. EQUATION'
1724 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1725 if (this%inamedbound /= 0)
then
1727 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1729 do n = 1, this%nmawwells
1730 call this%inputtab%add_term(n)
1731 call this%inputtab%add_term(this%radius(n))
1732 call this%inputtab%add_term(this%area(n))
1733 call this%inputtab%add_term(this%bot(n))
1734 call this%inputtab%add_term(this%strt(n))
1735 call this%inputtab%add_term(this%ngwfnodes(n))
1736 call this%inputtab%add_term(ccond(this%ieqn(n)))
1737 if (this%inamedbound /= 0)
then
1738 call this%inputtab%add_term(this%cmawname(n))
1744 if (this%iprpak /= 0)
then
1746 if (this%inonvert /= 0)
then
1747 ntabcols = ntabcols + 1
1749 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1750 trim(adjustl(this%packName))//
') STATIC WELL CONNECTION DATA'
1751 call table_cr(this%inputtab, this%packName, title)
1752 call this%inputtab%table_df(this%maxbound, ntabcols, this%iout)
1754 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1755 text =
'WELL CONNECTION'
1756 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1758 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1759 text =
'TOP OF SCREEN'
1760 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1761 text =
'BOTTOM OF SCREEN'
1762 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1763 text =
'SKIN RADIUS'
1764 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1766 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1768 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1770 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1771 text =
'SATURATED WELL CONDUCT.'
1772 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1773 if (this%inonvert /= 0)
then
1774 text =
'ANGLE (DEG)'
1775 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1779 do n = 1, this%nmawwells
1780 do j = 1, this%ngwfnodes(n)
1781 call this%inputtab%add_term(n)
1782 call this%inputtab%add_term(j)
1783 jpos = this%get_jpos(n, j)
1784 nn = this%get_gwfnode(n, j)
1785 call this%dis%noder_to_string(nn, nodestr)
1786 call this%inputtab%add_term(nodestr)
1787 call this%inputtab%add_term(this%topscrn(jpos))
1788 call this%inputtab%add_term(this%botscrn(jpos))
1789 if (this%ieqn(n) == 2 .or. &
1790 this%ieqn(n) == 3 .or. &
1791 this%ieqn(n) == 4)
then
1792 call this%inputtab%add_term(this%sradius(jpos))
1793 call this%inputtab%add_term(this%hk(jpos))
1795 call this%inputtab%add_term(
' ')
1796 call this%inputtab%add_term(
' ')
1798 if (this%ieqn(n) == 1 .or. &
1799 this%ieqn(n) == 2 .or. &
1800 this%ieqn(n) == 3)
then
1801 k11 = this%gwfk11(nn)
1802 if (this%gwfik22 == 0)
then
1803 k22 = this%gwfk11(nn)
1805 k22 = this%gwfk22(nn)
1807 call this%inputtab%add_term(k11)
1808 call this%inputtab%add_term(k22)
1810 call this%inputtab%add_term(
' ')
1811 call this%inputtab%add_term(
' ')
1813 call this%inputtab%add_term(this%satcond(jpos))
1814 if (this%inonvert /= 0)
then
1815 call this%inputtab%add_term(this%angle(jpos))
1822 this%gwfk11 => null()
1823 this%gwfk22 => null()
1824 this%gwfik22 => null()
1825 this%gwfsat => null()
1838 class(
mawtype),
intent(inout) :: this
1839 integer(I4B),
intent(in) :: imaw
1840 character(len=*),
intent(in) :: keyword
1841 character(len=*),
intent(in) :: msg
1845 if (len(msg) == 0)
then
1846 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1847 keyword,
' for MAW well', imaw,
'has already been set.'
1849 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1850 keyword,
' for MAW well', imaw, msg
1862 class(
mawtype),
intent(inout) :: this
1863 integer(I4B),
intent(in) :: n
1864 integer(I4B),
intent(in) :: imaw
1865 character(len=*),
intent(in) :: setting
1867 select case (trim(setting))
1869 this%well_head_set(imaw) = .true.
1870 this%xnewpak(imaw) = this%well_head(imaw)
1879 class(
mawtype),
intent(inout) :: this
1881 character(len=LINELENGTH) :: cgwfnode
1885 integer(I4B) :: jpos
1889 do n = 1, this%nmawwells
1890 if (this%ngwfnodes(n) < 1)
then
1891 call this%maw_set_attribute_error(n,
'NGWFNODES',
'must be greater '// &
1894 if (this%radius(n) ==
dep20)
then
1895 call this%maw_set_attribute_error(n,
'RADIUS',
'has not been specified.')
1897 if (this%shutoffmin(n) >
dzero)
then
1898 if (this%shutoffmin(n) >= this%shutoffmax(n))
then
1899 call this%maw_set_attribute_error(n,
'SHUT_OFF',
'shutoffmax must '// &
1900 'be greater than shutoffmin.')
1903 do j = 1, this%ngwfnodes(n)
1906 jpos = this%get_jpos(n, j)
1909 write (cgwfnode,
'(a,i0,a)')
'gwfnode(', j,
')'
1912 if (this%botscrn(jpos) >= this%topscrn(jpos))
then
1913 call this%maw_set_attribute_error(n,
'SCREEN_TOP',
'screen bottom '// &
1914 'must be less than screen top. '// &
1919 if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
1920 this%ieqn(n) == 4)
then
1921 if (this%hk(jpos) <=
dzero)
then
1922 call this%maw_set_attribute_error(n,
'HK_SKIN',
'skin hyraulic '// &
1923 'conductivity must be greater '// &
1924 'than zero. '//trim(cgwfnode))
1926 else if (this%ieqn(n) == 0)
then
1929 if (this%satcond(jpos) <
dzero)
then
1930 call this%maw_set_attribute_error(n,
'HK_SKIN', &
1931 'skin hyraulic conductivity '// &
1932 'must be greater than or '// &
1933 'equal to zero when using '// &
1934 'SPECIFIED condeqn. '// &
1950 class(
mawtype),
intent(inout) :: this
1951 integer(I4B),
intent(in) :: moffset
1957 integer(I4B) :: jglo
1958 integer(I4B) :: nglo
1962 do n = 1, this%nmawwells
1963 nglo = moffset + this%dis%nodes + this%ioffset + n
1964 call sparse%addconnection(nglo, nglo, 1)
1965 do j = 1, this%ngwfnodes(n)
1966 jj = this%get_gwfnode(n, j)
1968 call sparse%addconnection(nglo, jglo, 1)
1969 call sparse%addconnection(jglo, nglo, 1)
1981 class(
mawtype),
intent(inout) :: this
1982 integer(I4B),
intent(in) :: moffset
1988 integer(I4B) :: iglo
1989 integer(I4B) :: jglo
1990 integer(I4B) :: ipos
1994 call mem_allocate(this%idxlocnode, this%nmawwells,
'IDXLOCNODE', &
1996 call mem_allocate(this%idxdglo, this%maxbound,
'IDXDGLO', this%memoryPath)
1997 call mem_allocate(this%idxoffdglo, this%maxbound,
'IDXOFFDGLO', &
1999 call mem_allocate(this%idxsymdglo, this%maxbound,
'IDXSYMDGLO', &
2001 call mem_allocate(this%idxsymoffdglo, this%maxbound,
'IDXSYMOFFDGLO', &
2009 do n = 1, this%nmawwells
2010 iglo = moffset + this%dis%nodes + this%ioffset + n
2011 this%idxlocnode(n) = this%dis%nodes + this%ioffset + n
2012 do ii = 1, this%ngwfnodes(n)
2013 j = this%get_gwfnode(n, ii)
2015 this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
2016 this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
2022 do n = 1, this%nmawwells
2023 do ii = 1, this%ngwfnodes(n)
2024 iglo = this%get_gwfnode(n, ii) + moffset
2025 jglo = moffset + this%dis%nodes + this%ioffset + n
2026 this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
2027 this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
2039 class(
mawtype),
intent(inout) :: this
2043 call this%obs%obs_ar()
2046 if (this%inewton > 0)
then
2047 this%satomega =
dem6
2051 call this%maw_allocate_arrays()
2054 call this%read_initial_attr()
2057 call this%input%init(this%input_mempath, this%naux)
2060 if (this%imover /= 0)
then
2061 allocate (this%pakmvrobj)
2062 call this%pakmvrobj%ar(this%nmawwells, this%nmawwells, this%memoryPath)
2077 class(
mawtype),
intent(inout) :: this
2079 character(len=LINELENGTH) :: title
2080 character(len=LINELENGTH) :: text
2081 character(len=LINELENGTH) :: csteady
2082 character(len=LINELENGTH) :: str
2083 real(DP) :: auxvaldbl
2084 character(len=LENVARNAME) :: setting
2085 character(len=LINELENGTH) :: cstr
2086 character(len=LINELENGTH) :: errmsgr
2087 integer(I4B) :: node
2089 integer(I4B) :: ntabcols
2090 integer(I4B) :: ntabrows
2091 integer(I4B) :: imaw
2092 integer(I4B) :: ibnd
2094 integer(I4B) :: jpos
2096 integer(I4B) :: nactive
2097 integer(I4B) :: icon
2098 integer(I4B),
dimension(:),
allocatable :: ibotset
2099 integer(I4B),
dimension(:),
allocatable :: iheadset
2100 integer(I4B),
dimension(:),
allocatable :: ilimset
2101 integer(I4B) :: istat
2102 integer(I4B) :: iheadlimit_warning
2104 character(len=*),
parameter :: fmtlsp = &
2105 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
2106 character(len=*),
parameter :: fmthdbot = &
2107 &
"('well head (',G0,') must be >= BOTTOM_ELEVATION (',G0, ').')"
2110 iheadlimit_warning = 0
2113 this%imawiss = this%gwfiss
2116 if (this%imawissopt == 1)
then
2121 this%nbound = this%maxbound
2124 if (this%iper ==
kper)
then
2127 if (this%iprpak /= 0)
then
2128 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2129 trim(adjustl(this%packName))//
') DATA FOR PERIOD'
2130 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2131 call table_cr(this%inputtab, this%packName, title)
2132 call this%inputtab%table_df(1, 5, this%iout, finalize=.false.)
2134 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2136 call this%inputtab%initialize_column(text, 20, alignment=tableft)
2138 write (text,
'(a,1x,i6)')
'VALUE', jj
2139 call this%inputtab%initialize_column(text, 15, alignment=tabcenter)
2147 allocate (ibotset(this%nmawwells))
2148 allocate (iheadset(this%nmawwells))
2149 allocate (ilimset(this%nmawwells))
2150 do imaw = 1, this%nmawwells
2156 do n = 1, this%input%nbound
2157 imaw = this%input%ifno(n)
2158 if (imaw < 1 .or. imaw > this%nmawwells)
then
2159 write (
errmsg,
'(2(a,1x),i0,a)') &
2160 'IMAW must be greater than 0 and', &
2161 'less than or equal to ', this%nmawwells,
'.'
2167 setting = this%input%setting(n)
2170 if (trim(setting) ==
'STATUS')
then
2171 str = this%input%status(n)
2172 this%status(imaw) = str(1:8)
2173 select case (trim(str))
2175 this%iboundpak(imaw) = -1
2177 this%iboundpak(imaw) = 0
2179 this%iboundpak(imaw) = 1
2182 'Unknown '//trim(this%text)//
" maw status keyword: '", &
2189 if (trim(setting) ==
'CONN_STATUS')
then
2190 icon = this%input%period_icon(n)
2191 str = this%input%connstatus(n)
2192 if (icon < 1 .or. icon > this%ngwfnodes(imaw))
then
2193 write (
errmsg,
'(2(a,1x),i0,1x,a,1x,i0,a)') &
2194 'ICON must be greater than 0 and', &
2195 'less than or equal to ', this%ngwfnodes(imaw), &
2196 'for maw well', imaw,
'.'
2199 jpos = this%get_jpos(imaw, icon)
2200 select case (trim(str))
2202 this%iboundconn(jpos) = 0
2204 this%iboundconn(jpos) = 1
2207 'Unknown '//trim(this%text)//
" maw connection status "// &
2208 "keyword: '", trim(str)//
"'."
2215 if (trim(setting) ==
'PERIOD_BOTTOM')
then
2216 this%bot(imaw) = this%input%period_bottom(n)
2221 call this%maw_set_period_value(n, imaw, setting)
2224 if (trim(setting) ==
'WELL_HEAD')
then
2229 if (trim(setting) ==
'HEAD_LIMIT')
then
2230 str = this%input%head_limit(n)
2231 if (trim(str) ==
'OFF')
then
2232 this%shutofflevel(imaw) = dep20
2234 read (str, *, iostat=istat, iomsg=errmsgr) &
2235 this%shutofflevel(imaw)
2236 if (istat /= 0)
then
2237 errmsg =
'Could not read HEAD_LIMIT value. '//trim(errmsgr)
2245 if (trim(setting) ==
'FLOWING_WELL')
then
2246 this%fwelev(imaw) = this%input%fwelev(n)
2247 this%fwcond(imaw) = this%input%fwcond(n)
2248 this%fwrlen(imaw) = this%input%fwrlen(n)
2249 if (this%iflowingwells == 0)
then
2250 this%iflowingwells = -1
2251 text =
'Flowing well data is specified in the '// &
2252 trim(this%packName)//
' package but FLOWING_WELL was'// &
2253 ' not specified in the OPTIONS block.'
2254 call store_warning(text)
2259 if (trim(setting) ==
'SHUT_OFF')
then
2260 this%shutoffmin(imaw) = this%input%minrate(n)
2261 this%shutoffmax(imaw) = this%input%maxrate(n)
2265 if (trim(setting) ==
'RATE_SCALING')
then
2266 this%pumpelev(imaw) = this%input%pump_elevation(n)
2267 this%reduction_length(imaw) = this%input%scaling_length(n)
2268 if (this%reduction_length(imaw) < dzero)
then
2269 call this%maw_set_attribute_error(imaw,
'RATE_SCALING', &
2270 &
'must be greater than or equal to 0.')
2276 if (this%naux > 0)
then
2277 if (trim(setting) ==
'PERIOD_AUXILIARY')
then
2278 str = this%input%auxname(n)
2279 auxvaldbl = this%input%auxval(n)
2284 if (this%iprpak /= 0)
then
2285 call this%inputtab%add_term(imaw)
2286 if (trim(setting) ==
'PERIOD_AUXILIARY')
then
2287 call this%inputtab%add_term(
'AUXILIARY')
2289 call this%inputtab%add_term(trim(setting))
2291 select case (trim(setting))
2293 call this%inputtab%add_term(trim(str))
2294 call this%inputtab%add_term(
' ')
2295 call this%inputtab%add_term(
' ')
2296 case (
'CONN_STATUS')
2297 call this%inputtab%add_term(icon)
2298 call this%inputtab%add_term(trim(str))
2299 call this%inputtab%add_term(
' ')
2300 case (
'PERIOD_BOTTOM')
2301 call this%inputtab%add_term(this%bot(imaw))
2302 call this%inputtab%add_term(
' ')
2303 call this%inputtab%add_term(
' ')
2305 call this%inputtab%add_term(this%rate(imaw))
2306 call this%inputtab%add_term(
' ')
2307 call this%inputtab%add_term(
' ')
2309 call this%inputtab%add_term(this%well_head(imaw))
2310 call this%inputtab%add_term(
' ')
2311 call this%inputtab%add_term(
' ')
2313 call this%inputtab%add_term(trim(str))
2314 call this%inputtab%add_term(
' ')
2315 call this%inputtab%add_term(
' ')
2316 case (
'FLOWING_WELL')
2317 call this%inputtab%add_term(this%fwelev(imaw))
2318 call this%inputtab%add_term(this%fwcond(imaw))
2319 call this%inputtab%add_term(this%fwrlen(imaw))
2321 call this%inputtab%add_term(this%shutoffmin(imaw))
2322 call this%inputtab%add_term(this%shutoffmax(imaw))
2323 call this%inputtab%add_term(
' ')
2324 case (
'RATE_SCALING')
2325 call this%inputtab%add_term(this%pumpelev(imaw))
2326 call this%inputtab%add_term(this%reduction_length(imaw))
2327 call this%inputtab%add_term(
' ')
2328 case (
'PERIOD_AUXILIARY')
2329 call this%inputtab%add_term(trim(str))
2330 call this%inputtab%add_term(auxvaldbl)
2331 call this%inputtab%add_term(
' ')
2333 call this%inputtab%add_term(
' ')
2334 call this%inputtab%add_term(
' ')
2335 call this%inputtab%add_term(
' ')
2339 if (this%iprpak /= 0)
then
2340 call this%inputtab%finalize_table()
2346 do imaw = 1, this%nmawwells
2347 if (ibotset(imaw) /= 0 .and. this%iboundpak(imaw) >= 0)
then
2348 if (this%bot(imaw) > this%xnewpak(imaw))
then
2349 write (cstr, fmthdbot) this%xnewpak(imaw), this%bot(imaw)
2350 call this%maw_set_attribute_error(imaw,
'BOTTOM', trim(cstr))
2353 do jj = 1, this%ngwfnodes(imaw)
2354 jpos = this%get_jpos(imaw, jj)
2355 if (this%iboundconn(jpos) == 0) cycle
2356 if (this%bot(imaw) > this%botscrn(jpos))
then
2357 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
2358 'BOTTOM (', this%bot(imaw),
') for maw well', imaw, &
2359 'is above the screen bottom of active connection', jj,
'(', &
2360 this%botscrn(jpos),
').'
2365 if (iheadset(imaw) /= 0 .or. this%iboundpak(imaw) < 0)
then
2366 if (this%well_head(imaw) < this%bot(imaw))
then
2367 write (cstr, fmthdbot) this%well_head(imaw), this%bot(imaw)
2368 call this%maw_set_attribute_error(imaw,
'WELL HEAD', trim(cstr))
2371 if (ibotset(imaw) /= 0 .or. ilimset(imaw) /= 0)
then
2372 if (this%shutofflevel(imaw) <= this%bot(imaw))
then
2373 iheadlimit_warning = iheadlimit_warning + 1
2377 deallocate (ibotset)
2378 deallocate (iheadset)
2379 deallocate (ilimset)
2383 do imaw = 1, this%nmawwells
2385 do jj = 1, this%ngwfnodes(imaw)
2386 jpos = this%get_jpos(imaw, jj)
2387 if (this%iboundconn(jpos) /= 0) nactive = nactive + 1
2389 if (nactive == 0)
then
2390 write (
errmsg,
'(a,1x,i0,1x,a)') &
2391 'Every connection of maw well', imaw,
'is inactive. Use '// &
2392 'STATUS INACTIVE to deactivate all connections of a well.'
2399 write (this%iout, fmtlsp) trim(this%filtyp)
2403 if (iheadlimit_warning > 0)
then
2404 write (
warnmsg,
'(a,a,a,1x,a,1x,a)') &
2405 "HEAD_LIMIT in '", trim(this%packName),
"' was below the well bottom", &
2406 "for one or more multi-aquifer well(s). This may result in", &
2407 "convergence failures for some models."
2412 if (count_errors() > 0)
then
2417 if (this%check_attr /= 0)
then
2418 call this%maw_check_attributes()
2421 if (this%iprpak == 1)
then
2422 if (this%imawiss /= 0)
then
2423 csteady =
'STEADY-STATE '
2425 csteady =
'TRANSIENT '
2429 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2430 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2431 ' RATE DATA FOR PERIOD'
2432 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2434 call table_cr(this%inputtab, this%packName, title)
2435 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
2437 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2439 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2441 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2442 text =
'SPECIFIED HEAD'
2443 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2444 text =
'PUMP ELEVATION'
2445 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2446 text =
'REDUCTION LENGTH'
2447 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2448 do n = 1, this%nmawwells
2449 call this%inputtab%add_term(n)
2450 call this%inputtab%add_term(this%status(n))
2451 call this%inputtab%add_term(this%rate(n))
2452 if (this%iboundpak(n) < 0)
then
2453 call this%inputtab%add_term(this%well_head(n))
2455 call this%inputtab%add_term(
' ')
2457 call this%inputtab%add_term(this%pumpelev(n))
2458 if (this%reduction_length(n) /= dep20)
then
2459 call this%inputtab%add_term(this%reduction_length(n))
2461 call this%inputtab%add_term(
' ')
2466 if (this%iflowingwells > 0)
then
2469 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2470 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2471 ' FLOWING WELL DATA FOR PERIOD'
2472 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2475 do n = 1, this%nmawwells
2476 if (this%fwcond(n) > dzero)
then
2477 ntabrows = ntabrows + 1
2480 if (ntabrows > 0)
then
2481 call table_cr(this%inputtab, this%packName, title)
2482 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2484 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2486 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2488 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2489 text =
'REDUCTION LENGTH'
2490 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2491 do n = 1, this%nmawwells
2492 if (this%fwcond(n) > dzero)
then
2493 call this%inputtab%add_term(n)
2494 call this%inputtab%add_term(this%fwelev(n))
2495 call this%inputtab%add_term(this%fwcond(n))
2496 call this%inputtab%add_term(this%fwrlen(n))
2503 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2504 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2505 ' WELL SHUTOFF DATA FOR PERIOD'
2506 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2509 do n = 1, this%nmawwells
2510 if (this%shutofflevel(n) /= dep20)
then
2511 ntabrows = ntabrows + 1
2514 if (ntabrows > 0)
then
2515 call table_cr(this%inputtab, this%packName, title)
2516 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2518 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2520 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2522 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2524 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2525 do n = 1, this%nmawwells
2526 if (this%shutofflevel(n) /= dep20)
then
2527 call this%inputtab%add_term(n)
2528 call this%inputtab%add_term(this%shutofflevel(n))
2529 call this%inputtab%add_term(this%shutoffmin(n))
2530 call this%inputtab%add_term(this%shutoffmax(n))
2539 do n = 1, this%nmawwells
2540 do j = 1, this%ngwfnodes(n)
2541 jpos = this%get_jpos(n, j)
2542 node = this%get_gwfnode(n, j)
2543 this%nodelist(ibnd) = node
2544 this%bound(1, ibnd) = this%xnewpak(n)
2545 this%bound(2, ibnd) = this%satcond(jpos)
2546 this%bound(3, ibnd) = this%botscrn(jpos)
2547 if (this%iboundpak(n) > 0)
then
2548 this%bound(4, ibnd) = this%rate(n)
2550 this%bound(4, ibnd) = dzero
2569 integer(I4B) :: ibnd
2570 integer(I4B) :: imaw
2571 character(len=LENVARNAME) :: setting
2575 call this%BndExtType%bnd_ad()
2578 if (this%ts_active .and. this%input%nbound > 0)
then
2579 do n = 1, this%input%nbound
2580 imaw = this%input%ifno(n)
2581 if (imaw < 1 .or. imaw > this%nmawwells) cycle
2582 setting = this%input%setting(n)
2583 call this%maw_set_period_value(n, imaw, setting)
2588 if (this%naux > 0)
then
2590 do n = 1, this%nmawwells
2591 do j = 1, this%ngwfnodes(n)
2592 do jj = 1, this%naux
2593 if (this%noupdateauxvar(jj) /= 0) cycle
2594 this%auxvar(jj, ibnd) = this%featureauxvar(jj, n)
2603 do i = 1, this%nmawwells
2604 n = this%pkg_ifno(i)
2605 this%xoldpak(n) = this%xnewpak(n)
2606 this%xoldsto(n) = this%xsto(n)
2607 if (this%iboundpak(n) < 0)
then
2608 if (.not. this%well_head_set(n))
then
2609 this%well_head(n) = this%input%strt(i)
2611 this%xnewpak(n) = this%well_head(n)
2617 this%nurdxold(n) = dzero
2618 this%nurweight(n) = done
2623 if (
kper == 1 .and.
kstp == 1)
then
2624 do n = 1, this%nmawwells
2625 if (this%fwcond(n) > dzero)
then
2626 if (this%xoldsto(n) > this%fwelev(n))
then
2627 this%xoldsto(n) = this%fwelev(n)
2634 this%ishutoffcnt = 0
2637 if (this%imover == 1)
then
2638 call this%pakmvrobj%ad()
2652 call this%maw_cfupdate()
2657 subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln)
2662 real(DP),
dimension(:),
intent(inout) :: rhs
2663 integer(I4B),
dimension(:),
intent(in) :: ia
2664 integer(I4B),
dimension(:),
intent(in) :: idxglo
2670 integer(I4B) :: iloc
2671 integer(I4B) :: isymloc
2672 integer(I4B) :: igwfnode
2673 integer(I4B) :: iposd
2674 integer(I4B) :: iposoffd
2675 integer(I4B) :: isymnode
2676 integer(I4B) :: ipossymd
2677 integer(I4B) :: ipossymoffd
2678 integer(I4B) :: jpos
2679 integer(I4B) :: icflow
2698 if (this%imover == 1)
then
2699 call this%pakmvrobj%fc()
2704 do n = 1, this%nmawwells
2705 iloc = this%idxlocnode(n)
2709 this%qsim0(n) = this%ratesim(n)
2712 if (this%iboundpak(n) < 0)
then
2713 this%xnewpak(n) = this%well_head(n)
2715 hmaw = this%xnewpak(n)
2718 if (this%iboundpak(n) == 0)
then
2719 this%ratesim(n) =
dzero
2721 call this%maw_calculate_wellq(n, hmaw, rate)
2722 this%ratesim(n) = rate
2723 rhs(iloc) = rhs(iloc) - rate
2726 iposd = this%idxdglo(idx)
2731 if (this%iflowingwells > 0)
then
2732 if (this%fwcond(n) >
dzero)
then
2734 tp = bt + this%fwrlen(n)
2736 cfw = scale * this%fwcond(n)
2737 this%ifwdischarge(n) = 0
2738 if (cfw >
dzero)
then
2739 this%ifwdischarge(n) = 1
2742 this%fwcondsim(n) = cfw
2743 call matrix_sln%add_value_pos(iposd, -cfw)
2744 rhs(iloc) = rhs(iloc) - cfw * bt
2745 ratefw = cfw * (bt - hmaw)
2750 if (this%imawiss /= 1)
then
2751 if (this%ifwdischarge(n) /= 1)
then
2758 tled = this%area(n) /
delt
2761 ssold =
squadratic0sp(this%xoldsto(n), this%bot(n), this%satomega)
2762 call matrix_sln%add_value_pos(iposd, -tled * sd)
2763 rhs(iloc) = rhs(iloc) - tled * (sd * hmaw - ss + ssold)
2765 cterm = this%xoldsto(n) - this%fwelev(n)
2766 rhs(iloc) = rhs(iloc) - (this%area(n) * cterm /
delt)
2772 if (this%imover == 1)
then
2773 rhs(iloc) = rhs(iloc) - this%pakmvrobj%get_qfrommvr(n)
2777 call this%pakmvrobj%accumulate_qformvr(n, -rate)
2781 call this%pakmvrobj%accumulate_qformvr(n, -ratefw)
2787 do j = 1, this%ngwfnodes(n)
2788 jpos = this%get_jpos(n, j)
2789 if (this%iboundpak(n) /= 0 .and. this%iboundconn(jpos) /= 0)
then
2790 igwfnode = this%get_gwfnode(n, j)
2791 hgwf = this%xnew(igwfnode)
2794 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2796 this%simcond(jpos) = cmaw
2799 iposd = this%idxdglo(idx)
2800 iposoffd = this%idxoffdglo(idx)
2801 call matrix_sln%add_value_pos(iposd, -term)
2802 call matrix_sln%set_value_pos(iposoffd, term)
2805 rhs(iloc) = rhs(iloc) - cterm
2808 isymnode = this%get_gwfnode(n, j)
2809 isymloc = ia(isymnode)
2810 ipossymd = this%idxsymdglo(idx)
2811 ipossymoffd = this%idxsymoffdglo(idx)
2812 call matrix_sln%add_value_pos(ipossymd, -term)
2813 call matrix_sln%set_value_pos(ipossymoffd, term)
2816 rhs(isymnode) = rhs(isymnode) + cterm
2827 subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln)
2830 real(DP),
dimension(:),
intent(inout) :: rhs
2831 integer(I4B),
dimension(:),
intent(in) :: ia
2832 integer(I4B),
dimension(:),
intent(in) :: idxglo
2838 integer(I4B) :: iloc
2839 integer(I4B) :: isymloc
2840 integer(I4B) :: igwfnode
2841 integer(I4B) :: iposd
2842 integer(I4B) :: iposoffd
2843 integer(I4B) :: isymnode
2844 integer(I4B) :: ipossymd
2845 integer(I4B) :: ipossymoffd
2846 integer(I4B) :: jpos
2847 integer(I4B) :: icflow
2868 do n = 1, this%nmawwells
2869 iloc = this%idxlocnode(n)
2870 hmaw = this%xnewpak(n)
2873 if (this%iboundpak(n) /= 0)
then
2874 iposd = this%idxdglo(idx)
2877 rate = this%ratesim(n)
2880 call this%maw_calculate_wellq(n, hmaw +
dem4, rate2)
2881 drterm = (rate2 - rate) /
dem4
2884 call matrix_sln%add_value_pos(iposd, drterm)
2885 rhs(iloc) = rhs(iloc) + drterm * hmaw
2888 if (this%iflowingwells > 0)
then
2889 if (this%fwcond(n) >
dzero)
then
2891 tp = bt + this%fwrlen(n)
2893 cfw = scale * this%fwcond(n)
2894 this%ifwdischarge(n) = 0
2895 if (cfw >
dzero)
then
2896 this%ifwdischarge(n) = 1
2898 this%fwcondsim(n) = cfw
2899 rate = cfw * (bt - hmaw)
2905 drterm = -(cfw + this%fwcond(n) * derv * (hmaw - bt))
2908 call matrix_sln%add_value_pos(iposd, &
2909 -this%fwcond(n) * derv * (hmaw - bt))
2910 rhs(iloc) = rhs(iloc) - rterm + drterm * hmaw
2917 do j = 1, this%ngwfnodes(n)
2918 jpos = this%get_jpos(n, j)
2919 if (this%iboundpak(n) /= 0 .and. this%iboundconn(jpos) /= 0)
then
2920 igwfnode = this%get_gwfnode(n, j)
2921 hgwf = this%xnew(igwfnode)
2924 iposd = this%idxdglo(idx)
2925 iposoffd = this%idxoffdglo(idx)
2928 isymnode = this%get_gwfnode(n, j)
2929 isymloc = ia(isymnode)
2930 ipossymd = this%idxsymdglo(idx)
2931 ipossymoffd = this%idxsymoffdglo(idx)
2934 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2938 if (hmaw > hgwf)
then
2939 if (icflow /= 0)
then
2940 rhsterm = term2 * hgwf + term * hmaw
2941 rhs(iloc) = rhs(iloc) + rhsterm
2942 rhs(isymnode) = rhs(isymnode) - rhsterm
2943 if (this%iboundpak(n) > 0)
then
2944 call matrix_sln%add_value_pos(iposd, term)
2945 call matrix_sln%add_value_pos(iposoffd, term2)
2947 call matrix_sln%add_value_pos(ipossymd, -term2)
2948 call matrix_sln%add_value_pos(ipossymoffd, -term)
2950 rhs(iloc) = rhs(iloc) + term * hmaw
2951 rhs(isymnode) = rhs(isymnode) - term * hmaw
2952 call matrix_sln%add_value_pos(iposd, term)
2953 if (this%ibound(igwfnode) > 0)
then
2954 call matrix_sln%add_value_pos(ipossymoffd, -term)
2960 if (icflow /= 0)
then
2961 rhsterm = term2 * hmaw + term * hgwf
2962 rhs(iloc) = rhs(iloc) + rhsterm
2963 rhs(isymnode) = rhs(isymnode) - rhsterm
2964 if (this%iboundpak(n) > 0)
then
2965 call matrix_sln%add_value_pos(iposd, term2)
2966 call matrix_sln%add_value_pos(iposoffd, term)
2968 call matrix_sln%add_value_pos(ipossymd, -term)
2969 call matrix_sln%add_value_pos(ipossymoffd, -term2)
2971 rhs(iloc) = rhs(iloc) + term * hgwf
2972 rhs(isymnode) = rhs(isymnode) - term * hgwf
2973 if (this%iboundpak(n) > 0)
then
2974 call matrix_sln%add_value_pos(iposoffd, term)
2976 call matrix_sln%add_value_pos(ipossymd, -term)
2999 subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
3001 class(
mawtype),
intent(inout) :: this
3002 integer(I4B),
intent(in) :: neqpak
3003 real(DP),
dimension(neqpak),
intent(inout) :: x
3004 real(DP),
dimension(neqpak),
intent(in) :: xtemp
3005 real(DP),
dimension(neqpak),
intent(inout) :: dx
3006 integer(I4B),
intent(inout) :: inewtonur
3007 real(DP),
intent(inout) :: dxmax
3008 integer(I4B),
intent(inout) :: locmax
3017 real(DP),
parameter :: damptheta =
dp7
3018 real(DP),
parameter :: damptol =
dhalf
3019 real(DP),
parameter :: weightmin =
dem2
3020 real(DP),
parameter :: recover = 0.2_dp
3023 do n = 1, this%nmawwells
3024 if (this%iboundpak(n) < 1) cycle
3028 dxprop = x(n) - xtemp(n)
3036 weight =
maw_damp_weight(dxprop, this%nurdxold(n), this%nurweight(n), &
3037 damptheta, damptol, weightmin, recover)
3038 this%nurweight(n) = weight
3041 if (weight <
done)
then
3043 xx = xtemp(n) + weight * dxprop
3045 if (abs(dxx) > abs(dxmax))
then
3050 dx(n) = weight * dxprop
3055 if (x(n) < botw)
then
3059 if (abs(dxx) > abs(dxmax))
then
3071 this%nurdxold(n) = x(n) - xtemp(n)
3084 weightmin, recover)
result(new_weight)
3086 real(dp),
intent(in) :: dxprop
3087 real(dp),
intent(in) :: dxold
3088 real(dp),
intent(in) :: weight
3089 real(dp),
intent(in) :: damptheta
3090 real(dp),
intent(in) :: damptol
3091 real(dp),
intent(in) :: weightmin
3092 real(dp),
intent(in) :: recover
3094 real(dp) :: new_weight
3096 if (dxprop * dxold <
dzero .and. abs(dxprop) > damptol * abs(dxold))
then
3097 new_weight = max(damptheta * weight, weightmin)
3099 new_weight = min(weight + recover,
done)
3114 subroutine maw_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
3118 class(
mawtype),
intent(inout) :: this
3119 integer(I4B),
intent(in) :: innertot
3120 integer(I4B),
intent(in) :: kiter
3121 integer(I4B),
intent(in) :: iend
3122 integer(I4B),
intent(in) :: icnvgmod
3123 character(len=LENPAKLOC),
intent(inout) :: cpak
3124 integer(I4B),
intent(inout) :: ipak
3125 real(DP),
intent(inout) :: dpak
3129 integer(I4B) :: jpos
3130 integer(I4B) :: igwfnode
3131 integer(I4B) :: locdpak
3140 real(DP) :: qtolfact
3143 character(len=LENPAKLOC) :: cloc
3145 real(DP),
parameter :: qtol = 1.001_dp
3147 character(len=*),
parameter :: fmtwarn = &
3148 "('MAW well ', a, ' requests an extraction rate (', g0.5, &
3149 &') larger than the maximum rate (', g0.5, ') the aquifer can supply &
3150 &with the well head at its bottom. This may be preventing convergence. &
3151 &Consider reducing the requested rate, applying or widening RATE_SCALING, &
3152 &or reviewing the connection conductance (e.g. aquifer K).')"
3162 do n = 1, this%nmawwells
3163 if (this%iboundpak(n) < 1) cycle
3164 if (this%nurweight(n) >=
done) cycle
3165 if (this%area(n) >
dzero)
then
3166 qtolfact =
delt / this%area(n)
3177 dq = (this%qsim0(n) - this%ratesim(n)) * qtolfact
3178 if (abs(dq) > abs(dpakmax))
then
3183 if (locdpak > 0 .and. abs(dpakmax) > abs(dpak))
then
3186 write (cloc,
"(a,'-',a)") trim(this%packName),
'rate'
3192 if (iend == 0)
return
3193 if (icnvgmod /= 0)
return
3196 do n = 1, this%nmawwells
3197 if (this%iboundpak(n) < 1) cycle
3198 if (this%rate(n) >=
dzero) cycle
3204 do j = 1, this%ngwfnodes(n)
3205 jpos = this%get_jpos(n, j)
3206 if (this%iboundconn(jpos) == 0) cycle
3207 igwfnode = this%get_gwfnode(n, j)
3208 hgwf = this%xnew(igwfnode)
3209 bmaw = this%botscrn(jpos)
3210 hv = max(botw, bmaw)
3215 call this%maw_calculate_saturation(n, j, igwfnode, sat, hv)
3216 cmaw = this%satcond(jpos) * sat
3221 qmax = qmax + cmaw * max(hgwf - hv,
dzero)
3225 qreq = -this%rate(n)
3226 if (qmax >=
dzero .and. qreq > qtol * qmax)
then
3227 write (cloc,
'(a, a, a, a, i0, a, i0, a)') trim(this%name_model),
'-(', &
3228 trim(this%filtyp),
'_', this%ibcnum,
'-', n,
')'
3229 write (
warnmsg, fmtwarn) trim(cloc), qreq, qmax
3243 class(
mawtype),
intent(inout) :: this
3244 real(DP),
dimension(:),
intent(in) :: x
3245 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
3246 integer(I4B),
optional,
intent(in) :: iadv
3254 integer(I4B) :: ibnd
3262 call this%maw_cfupdate()
3266 call this%BndType%bnd_cq(x, flowja, iadv=1)
3269 do n = 1, this%nmawwells
3270 this%qout(n) = dzero
3271 this%qsto(n) = dzero
3272 if (this%iflowingwells > 0)
then
3275 if (this%iboundpak(n) == 0)
then
3280 hmaw = this%xnewpak(n)
3284 rrate = this%ratesim(n)
3287 if (rrate < dzero)
then
3288 this%qout(n) = rrate
3292 if (this%iflowingwells > 0)
then
3293 if (this%fwcond(n) > dzero)
then
3294 cfw = this%fwcondsim(n)
3298 if (this%ifwdischarge(n) == 1)
then
3299 this%xsto(n) = this%fwelev(n)
3301 rrate = cfw * (this%fwelev(n) - hmaw)
3305 this%qout(n) = this%qout(n) + rrate
3315 if (this%imawiss /= 1)
then
3316 if (this%iflowingwells > 0 .and. this%ifwdischarge(n) == 1)
then
3317 rrate = -this%area(n) * (this%xsto(n) - this%xoldsto(n)) /
delt
3320 ssold =
squadratic0sp(this%xoldsto(n), this%bot(n), this%satomega)
3321 rrate = -this%area(n) * (ss - ssold) /
delt
3323 this%qsto(n) = rrate
3329 do n = 1, this%nmawwells
3330 hmaw = this%xnewpak(n)
3331 this%qconst(n) = dzero
3332 do j = 1, this%ngwfnodes(n)
3333 rrate = -this%simvals(ibnd)
3334 this%qleak(ibnd) = rrate
3335 if (this%iboundpak(n) < 0)
then
3336 this%qconst(n) = this%qconst(n) - rrate
3339 if (-rrate < dzero)
then
3340 this%qout(n) = this%qout(n) - rrate
3349 if (this%iboundpak(n) < 0)
then
3352 this%qconst(n) = this%qconst(n) - this%ratesim(n)
3355 if (this%iflowingwells > 0)
then
3356 this%qconst(n) = this%qconst(n) - this%qfw(n)
3360 if (this%imawiss /= 1)
then
3361 this%qconst(n) = this%qconst(n) - this%qsto(n)
3367 call this%maw_fill_budobj()
3375 integer(I4B),
intent(in) :: icbcfl
3376 integer(I4B),
intent(in) :: ibudfl
3377 integer(I4B),
intent(in) :: icbcun
3378 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
3381 call this%BndType%bnd_ot_model_flows(icbcfl, ibudfl, icbcun, this%imap)
3389 integer(I4B),
intent(in) :: icbcfl
3390 integer(I4B),
intent(in) :: ibudfl
3391 integer(I4B) :: ibinun
3395 if (this%ibudgetout /= 0)
then
3396 ibinun = this%ibudgetout
3398 if (icbcfl == 0) ibinun = 0
3399 if (ibinun > 0)
then
3400 call this%budobj%save_flows(this%dis, ibinun,
kstp,
kper,
delt, &
3405 if (ibudfl /= 0 .and. this%iprflow /= 0)
then
3406 call this%budobj%write_flowtable(this%dis,
kstp,
kper)
3417 integer(I4B),
intent(in) :: idvsave
3418 integer(I4B),
intent(in) :: idvprint
3419 integer(I4B) :: ibinun
3426 if (this%iheadout /= 0)
then
3427 ibinun = this%iheadout
3429 if (idvsave == 0) ibinun = 0
3432 if (ibinun > 0)
then
3433 do n = 1, this%nmawwells
3436 if (this%iboundpak(n) == 0)
then
3438 else if (d <= dzero)
then
3443 call ulasav(this%dbuff,
' HEAD', &
3445 this%nmawwells, 1, 1, ibinun)
3449 if (idvprint /= 0 .and. this%iprhed /= 0)
then
3452 call this%headtab%set_kstpkper(
kstp,
kper)
3455 do n = 1, this%nmawwells
3456 if (this%inamedbound == 1)
then
3457 call this%headtab%add_term(this%cmawname(n))
3459 call this%headtab%add_term(n)
3460 call this%headtab%add_term(this%xnewpak(n))
3472 integer(I4B),
intent(in) :: kstp
3473 integer(I4B),
intent(in) :: kper
3474 integer(I4B),
intent(in) :: iout
3475 integer(I4B),
intent(in) :: ibudfl
3477 call this%budobj%write_budtable(kstp, kper, iout, ibudfl,
totim,
delt)
3490 call this%budobj%budgetobject_da()
3491 deallocate (this%budobj)
3492 nullify (this%budobj)
3495 if (this%iprhed > 0)
then
3496 call this%headtab%table_da()
3497 deallocate (this%headtab)
3498 nullify (this%headtab)
3502 call mem_deallocate(this%cmawbudget,
'CMAWBUDGET', this%memoryPath)
3536 nullify (this%well_head)
3599 nullify (this%gwfiss)
3602 call this%input%destroy()
3605 call this%BndExtType%bnd_da()
3612 class(
mawtype),
intent(inout) :: this
3615 this%listlabel = trim(this%filtyp)//
' NO.'
3616 if (this%dis%ndim == 3)
then
3617 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
3618 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'ROW'
3619 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'COL'
3620 elseif (this%dis%ndim == 2)
then
3621 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
3622 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'CELL2D'
3624 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'NODE'
3626 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'STRESS RATE'
3627 if (this%inamedbound == 1)
then
3628 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
3640 integer(I4B),
pointer :: neq
3641 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
3642 real(DP),
dimension(:),
pointer,
contiguous :: xnew
3643 real(DP),
dimension(:),
pointer,
contiguous :: xold
3644 real(DP),
dimension(:),
pointer,
contiguous :: flowja
3647 integer(I4B) :: istart, iend
3650 call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja)
3655 istart = this%dis%nodes + this%ioffset + 1
3656 iend = istart + this%nmawwells - 1
3657 this%iboundpak => this%ibound(istart:iend)
3658 this%xnewpak => this%xnew(istart:iend)
3659 call mem_checkin(this%xnewpak,
'HEAD', this%memoryPath,
'X', &
3660 this%memoryPathModel)
3661 call mem_allocate(this%xoldpak, this%nmawwells,
'XOLDPAK', this%memoryPath)
3664 do n = 1, this%nmawwells
3665 this%xnewpak(n) =
dep20
3689 integer(I4B) :: indx
3693 call this%obs%StoreObsType(
'head', .false., indx)
3698 call this%obs%StoreObsType(
'from-mvr', .false., indx)
3703 call this%obs%StoreObsType(
'maw', .true., indx)
3708 call this%obs%StoreObsType(
'rate', .true., indx)
3713 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
3718 call this%obs%StoreObsType(
'fw-rate', .true., indx)
3723 call this%obs%StoreObsType(
'fw-to-mvr', .true., indx)
3728 call this%obs%StoreObsType(
'storage', .true., indx)
3733 call this%obs%StoreObsType(
'constant', .true., indx)
3738 call this%obs%StoreObsType(
'conductance', .true., indx)
3743 call this%obs%StoreObsType(
'fw-conductance', .true., indx)
3759 integer(I4B) :: jpos
3767 if (this%obs%npakobs > 0)
then
3768 call this%obs%obs_bd_clear()
3769 do i = 1, this%obs%npakobs
3770 obsrv => this%obs%pakobs(i)%obsrv
3771 do j = 1, obsrv%indxbnds_count
3773 jj = obsrv%indxbnds(j)
3774 select case (obsrv%ObsTypeId)
3776 if (this%iboundpak(jj) /= 0)
then
3777 v = this%xnewpak(jj)
3780 if (this%iboundpak(jj) /= 0)
then
3781 if (this%imover == 1)
then
3782 v = this%pakmvrobj%get_qfrommvr(jj)
3788 nn = jj - this%iaconn(n) + 1
3789 jpos = this%get_jpos(n, nn)
3790 if (this%iboundpak(n) /= 0 .and. this%iboundconn(jpos) /= 0)
then
3794 if (this%iboundpak(jj) /= 0)
then
3795 v = this%ratesim(jj)
3796 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3797 qfact = v / this%qout(jj)
3798 if (this%imover == 1)
then
3799 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3803 case (
'RATE-TO-MVR')
3804 if (this%iboundpak(jj) /= 0)
then
3805 if (this%imover == 1)
then
3806 v = this%ratesim(jj)
3808 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3809 qfact = v / this%qout(jj)
3811 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3818 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3819 hmaw = this%xnewpak(jj)
3820 cmaw = this%fwcondsim(jj)
3821 v = cmaw * (this%fwelev(jj) - hmaw)
3822 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3823 qfact = v / this%qout(jj)
3824 if (this%imover == 1)
then
3825 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3830 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3831 if (this%imover == 1)
then
3832 hmaw = this%xnewpak(jj)
3833 cmaw = this%fwcondsim(jj)
3834 v = cmaw * (this%fwelev(jj) - hmaw)
3836 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3837 qfact = v / this%qout(jj)
3839 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3846 if (this%iboundpak(jj) /= 0 .and. this%imawissopt /= 1)
then
3850 if (this%iboundpak(jj) /= 0)
then
3853 case (
'CONDUCTANCE')
3855 nn = jj - this%iaconn(n) + 1
3856 jpos = this%get_jpos(n, nn)
3857 if (this%iboundpak(n) /= 0 .and. this%iboundconn(jpos) /= 0)
then
3858 v = this%simcond(jpos)
3860 case (
'FW-CONDUCTANCE')
3861 if (this%iboundpak(jj) /= 0)
then
3862 v = this%fwcondsim(jj)
3865 errmsg =
'Unrecognized observation type: '//trim(obsrv%ObsTypeId)
3868 call this%obs%SaveOneSimval(obsrv, v)
3879 if (this%ioutredflowcsv > 0)
then
3880 call this%maw_redflow_csv_write()
3892 class(
mawtype),
intent(inout) :: this
3900 character(len=LENBOUNDNAME) :: bname
3904 10
format(
'Boundary "', a,
'" for observation "', a, &
3905 '" is invalid in package "', a,
'"')
3908 do i = 1, this%obs%npakobs
3909 obsrv => this%obs%pakobs(i)%obsrv
3912 nn1 = obsrv%NodeNumber
3914 bname = obsrv%FeatureName
3915 if (bname /=
'')
then
3920 if (obsrv%ObsTypeId ==
'MAW' .or. &
3921 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3922 do j = 1, this%nmawwells
3923 do jj = this%iaconn(j), this%iaconn(j + 1) - 1
3924 if (this%boundname(jj) == bname)
then
3926 call obsrv%AddObsIndex(jj)
3931 do j = 1, this%nmawwells
3932 if (this%cmawname(j) == bname)
then
3934 call obsrv%AddObsIndex(j)
3938 if (.not. jfound)
then
3940 trim(bname), trim(obsrv%Name), trim(this%packName)
3945 if (obsrv%indxbnds_count == 0)
then
3946 if (obsrv%ObsTypeId ==
'MAW' .or. &
3947 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3948 nn2 = obsrv%NodeNumber2
3949 j = this%iaconn(nn1) + nn2 - 1
3950 call obsrv%AddObsIndex(j)
3952 call obsrv%AddObsIndex(nn1)
3955 errmsg =
'Programming error in maw_rp_obs'
3962 if (obsrv%ObsTypeId ==
'HEAD')
then
3963 if (obsrv%indxbnds_count > 1)
then
3964 write (
errmsg,
'(a,3(1x,a))') &
3965 trim(adjustl(obsrv%ObsTypeId)), &
3966 'for observation', trim(adjustl(obsrv%Name)), &
3967 'must be assigned to a multi-aquifer well with a unique boundname.'
3973 if (obsrv%ObsTypeId ==
'MAW' .or. &
3974 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3975 do j = 1, obsrv%indxbnds_count
3976 nn1 = obsrv%indxbnds(j)
3978 nn2 = nn1 - this%iaconn(n) + 1
3979 jj = this%iaconn(n + 1) - this%iaconn(n)
3980 if (nn1 < 1 .or. nn1 > this%maxbound)
then
3981 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3982 trim(adjustl(obsrv%ObsTypeId)), &
3983 'multi-aquifer well connection number must be greater than 0', &
3984 'and less than', jj,
'(specified value is ', nn2,
').'
3989 do j = 1, obsrv%indxbnds_count
3990 nn1 = obsrv%indxbnds(j)
3991 if (nn1 < 1 .or. nn1 > this%nmawwells)
then
3992 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3993 trim(adjustl(obsrv%ObsTypeId)), &
3994 'multi-aquifer well must be greater than 0 ', &
3995 'and less than or equal to', this%nmawwells, &
3996 '(specified value is ', nn1,
').'
4021 integer(I4B),
intent(in) :: inunitobs
4022 integer(I4B),
intent(in) :: iout
4024 integer(I4B) :: nn1, nn2
4025 integer(I4B) :: icol, istart, istop
4026 character(len=LINELENGTH) :: string
4027 character(len=LENBOUNDNAME) :: bndname
4030 string = obsrv%IDstring
4038 obsrv%FeatureName = bndname
4040 if (obsrv%ObsTypeId ==
'MAW' .or. &
4041 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
4043 if (len_trim(bndname) < 1 .and. nn2 < 0)
then
4044 write (
errmsg,
'(a,1x,a,a,1x,a,1x,a)') &
4045 'For observation type', trim(adjustl(obsrv%ObsTypeId)), &
4046 ', ID given as an integer and not as boundname,', &
4047 'but ID2 (icon) is missing. Either change ID to valid', &
4048 'boundname or supply valid entry for ID2.'
4052 obsrv%FeatureName = bndname
4056 obsrv%NodeNumber2 = nn2
4061 obsrv%NodeNumber = nn1
4071 class(
mawtype),
intent(inout) :: this
4072 character(len=*),
intent(in) :: fname
4074 character(len=*),
parameter :: fmtredflowcsv = &
4075 "(4x, 'MAW REDUCED FLOW INFORMATION WILL BE SAVED TO FILE: ', a, /4x, &
4076 &'OPENED ON UNIT: ', I0)"
4078 this%ioutredflowcsv =
getunit()
4079 call openfile(this%ioutredflowcsv, this%iout, fname,
'CSV', &
4080 filstat_opt=
'REPLACE')
4081 write (this%iout, fmtredflowcsv) trim(adjustl(fname)), &
4083 write (this%ioutredflowcsv,
'(a)') &
4084 'time,period,step,MAWnumber,rate-requested,rate-actual,maw-reduction'
4093 class(
mawtype),
intent(inout) :: this
4100 do n = 1, this%nmawwells
4103 if (this%status(n) .ne.
'ACTIVE')
then
4106 v = this%rate(n) - this%ratesim(n)
4107 if (abs(v) >
dem9)
then
4108 write (this%ioutredflowcsv,
'(*(G0,:,","))') &
4119 class(
mawtype),
intent(inout) :: this
4120 integer(I4B),
intent(in) :: i
4121 integer(I4B),
intent(in) :: j
4122 integer(I4B),
intent(in) :: node
4124 integer(I4B) :: iTcontrastErr
4125 integer(I4B) :: jpos
4129 real(DP) :: sqrtk11k22
4137 real(DP) :: Tcontrast
4162 jpos = this%get_jpos(i, j)
4165 k11 = this%gwfk11(node)
4166 if (this%gwfik22 == 0)
then
4167 k22 = this%gwfk11(node)
4169 k22 = this%gwfk22(node)
4171 sqrtk11k22 = sqrt(k11 * k22)
4174 gwftop = this%dis%top(node)
4175 gwfbot = this%dis%bot(node)
4176 tthka = gwftop - gwfbot
4177 gwfsat = this%gwfsat(node)
4181 topw = this%topscrn(jpos)
4182 botw = this%botscrn(jpos)
4186 if (gwftop == topw .and. gwfbot == botw)
then
4187 if (this%icelltype(node) == 0)
then
4188 tthkw = tthkw * gwfsat
4189 tthka = tthka * gwfsat
4194 t2pi =
dtwopi * tthka * sqrtk11k22
4197 if (this%dis%ndim == 3 .and. this%ieffradopt /= 0)
then
4200 dx = sqrt(this%dis%area(node))
4204 eradius = 0.28_dp * ((yx4 * dx)**
dtwo + &
4207 area = this%dis%area(node)
4213 if (this%ieqn(i) == 1 .or. this%ieqn(i) == 3)
then
4214 lc1 = log(eradius / this%radius(i)) / t2pi
4218 if (this%ieqn(i) == 2 .or. this%ieqn(i) == 3)
then
4220 if (tthkw * hks >
dzero)
then
4221 tcontrast = (sqrtk11k22 * tthka) / (hks * tthkw)
4222 skin = (tcontrast -
done) * log(this%sradius(jpos) / this%radius(i))
4229 if (tcontrast <= 1 .and. this%ieqn(i) == 2)
then
4231 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
4232 'Invalid calculated transmissivity contrast (', tcontrast, &
4233 ') for maw well', i,
'connection', j,
'.',
'This happens when the', &
4234 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
4235 'Consider decreasing HK_SKIN for the connection or using the', &
4236 'CUMULATIVE or MEAN conductance equations.'
4245 if (this%ieqn(i) == 4)
then
4247 ravg =
dhalf * (this%radius(i) + this%sradius(jpos))
4248 slen = this%sradius(jpos) - this%radius(i)
4250 c = hks * pavg * tthkw / slen
4255 if (this%ieqn(i) < 4)
then
4256 if (lc1 + lc2 /=
dzero)
then
4257 c =
done / (lc1 + lc2)
4265 if (c <
dzero .and. itcontrasterr == 0)
then
4266 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
4267 'Invalid calculated negative conductance (', c, &
4268 ') for maw well', i,
'connection', j,
'.',
'this happens when the', &
4269 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
4270 'consider decreasing hk_skin for the connection or using the', &
4271 'mean conductance equation.'
4278 if (this%inonvert /= 0)
then
4279 c = c * this%maw_calc_lcorr(i, jpos)
4283 this%satcond(jpos) = c
4290 class(
mawtype),
intent(inout) :: this
4291 integer(I4B),
intent(in) :: n
4292 integer(I4B),
intent(in) :: j
4293 integer(I4B),
intent(in) :: node
4294 real(DP),
intent(inout) :: sat
4295 real(DP),
intent(in),
optional :: hwell_in
4297 integer(I4B) :: jpos
4308 if (this%icelltype(node) /= 0)
then
4311 hwell = this%xnewpak(n)
4312 if (
present(hwell_in))
then
4317 jpos = this%get_jpos(n, j)
4320 topw = this%topscrn(jpos)
4321 botw = this%botscrn(jpos)
4324 if (this%inewton /= 1)
then
4325 h_temp = this%xnew(node)
4326 if (h_temp < botw)
then
4329 if (hwell < botw)
then
4332 h_temp =
dhalf * (h_temp + hwell)
4334 h_temp = this%xnew(node)
4335 if (hwell > h_temp)
then
4338 if (h_temp < botw)
then
4365 integer(I4B),
intent(in) :: n
4366 integer(I4B),
intent(in) :: j
4367 integer(I4B),
intent(inout) :: icflow
4368 real(DP),
intent(inout) :: cmaw
4369 real(DP),
intent(inout) :: cterm
4370 real(DP),
intent(inout) :: term
4371 real(DP),
intent(inout) :: flow
4372 real(DP),
intent(inout),
optional :: term2
4374 logical(LGP) :: correct_flow
4375 integer(I4B) :: inewton
4376 integer(I4B) :: jpos
4377 integer(I4B) :: igwfnode
4388 real(DP) :: dhbarterm
4389 real(DP) :: vscratio
4395 if (
present(term2))
then
4402 jpos = this%get_jpos(n, j)
4403 igwfnode = this%get_gwfnode(n, j)
4404 hgwf = this%xnew(igwfnode)
4405 hmaw = this%xnewpak(n)
4406 tmaw = this%topscrn(jpos)
4407 bmaw = this%botscrn(jpos)
4410 if (this%ivsc == 1)
then
4413 vscratio = this%viscratios(1, n)
4415 vscratio = this%viscratios(2, n)
4420 call this%maw_calculate_saturation(n, j, igwfnode, sat)
4421 cmaw = this%satcond(jpos) * vscratio * sat
4424 if (inewton == 1)
then
4428 if (hgwf > hups)
then
4436 if (this%icelltype(igwfnode) /= 0)
then
4446 if (this%correct_flow)
then
4449 en = max(bmaw, this%dis%bot(igwfnode))
4450 correct_flow = .false.
4452 correct_flow = .true.
4454 if (hgwf < en .and. this%icelltype(igwfnode) /= 0)
then
4455 correct_flow = .true.
4460 if (correct_flow)
then
4462 hdowns = min(hmaw, hgwf)
4464 if (hgwf > hmaw)
then
4465 cterm = cmaw * (hmaw - hbar)
4467 cterm = cmaw * (hbar - hgwf)
4472 if (inewton /= 0)
then
4475 if (hmaw > hgwf)
then
4477 term = drterm * this%satcond(jpos) * vscratio * (hbar - hmaw)
4479 term2 = cmaw * (dhbarterm -
done)
4484 term = -drterm * this%satcond(jpos) * vscratio * (hgwf - hbar)
4486 term2 = cmaw * (
done - dhbarterm)
4492 if (inewton /= 0)
then
4493 term = drterm * this%satcond(jpos) * vscratio * (hgwf - hmaw)
4499 if (inewton == 0)
then
4500 flow = term * (hgwf - hmaw) + cterm
4504 if (this%idense /= 0 .and. inewton == 0)
then
4505 call this%maw_calculate_density_exchange(jpos, hmaw, hgwf, cmaw, &
4506 bmaw, flow, term, cterm)
4515 integer(I4B),
intent(in) :: n
4516 real(DP),
intent(in) :: hmaw
4517 real(DP),
intent(inout) :: q
4534 if (rate <
dzero)
then
4539 if (this%shutofflevel(n) /=
dep20)
then
4540 call this%maw_calculate_qpot(n, q)
4542 if (q > -rate) q = -rate
4544 if (this%ishutoffcnt == 1)
then
4545 this%shutoffweight(n) =
done
4546 this%shutoffdq(n) =
dzero
4547 this%shutoffqold(n) = q
4550 dq = q - this%shutoffqold(n)
4551 weight = this%shutoffweight(n)
4554 if (this%shutoffdq(n) * dq <
dzero)
then
4555 weight = this%theta * this%shutoffweight(n)
4559 weight = this%shutoffweight(n) + this%kappa
4563 q = this%shutoffqold(n) + weight * dq
4565 this%shutoffqold(n) = q
4566 this%shutoffdq(n) = dq
4567 this%shutoffweight(n) = weight
4571 if (this%shutoffmin(n) >
dzero)
then
4572 if (hmaw < this%shutofflevel(n))
then
4576 if (this%ishutoff(n) /= 0)
then
4583 if (q < this%shutoffmin(n))
then
4584 if (this%ishutoffcnt > 2)
then
4585 this%ishutoff(n) = 1
4596 if (q > this%shutoffmax(n))
then
4597 if (this%ishutoffcnt <= 2)
then
4598 this%ishutoff(n) = 0
4601 if (this%ishutoff(n) /= 0)
then
4607 if (q /=
dzero) q = -q
4616 if (this%reduction_length(n) /=
dep20)
then
4617 bt = this%pumpelev(n)
4618 tp = bt + this%reduction_length(n)
4628 if (this%shutofflevel(n) /=
dep20)
then
4629 call this%maw_calculate_qpot(n, q)
4632 if (q > rate) q = rate
4634 if (this%ishutoffcnt == 1)
then
4635 this%shutoffweight(n) =
done
4636 this%shutoffdq(n) =
dzero
4637 this%shutoffqold(n) = q
4640 dq = q - this%shutoffqold(n)
4641 weight = this%shutoffweight(n)
4644 if (this%shutoffdq(n) * dq <
dzero)
then
4645 weight = this%theta * this%shutoffweight(n)
4649 weight = this%shutoffweight(n) + this%kappa
4653 q = this%shutoffqold(n) + weight * dq
4655 this%shutoffqold(n) = q
4656 this%shutoffdq(n) = dq
4657 this%shutoffweight(n) = weight
4665 if (this%reduction_length(n) /=
dep20)
then
4666 bt = this%pumpelev(n)
4667 tp = bt + this%reduction_length(n)
4680 class(
mawtype),
intent(inout) :: this
4681 integer(I4B),
intent(in) :: n
4682 real(DP),
intent(inout) :: qnet
4685 integer(I4B) :: jpos
4686 integer(I4B) :: igwfnode
4698 real(DP) :: vscratio
4704 h_temp = this%shutofflevel(n)
4707 if (this%ivsc == 1)
then
4710 vscratio = this%viscratios(1, n)
4712 vscratio = this%viscratios(2, n)
4717 if (this%iflowingwells > 0)
then
4718 if (this%fwcond(n) >
dzero)
then
4720 tp = bt + this%fwrlen(n)
4722 cfw = scale * this%fwcond(n) * this%viscratios(2, n)
4723 this%ifwdischarge(n) = 0
4724 if (cfw >
dzero)
then
4725 this%ifwdischarge(n) = 1
4728 qnet = qnet + cfw * (bt - h_temp)
4733 if (this%imawiss /= 1)
then
4734 if (this%ifwdischarge(n) /= 1)
then
4735 hdterm = this%xoldsto(n) - h_temp
4737 hdterm = this%xoldsto(n) - this%fwelev(n)
4739 qnet = qnet - (this%area(n) * hdterm /
delt)
4743 do j = 1, this%ngwfnodes(n)
4744 jpos = this%get_jpos(n, j)
4745 if (this%iboundconn(jpos) == 0) cycle
4746 igwfnode = this%get_gwfnode(n, j)
4747 call this%maw_calculate_saturation(n, j, igwfnode, sat)
4748 cmaw = this%satcond(jpos) * vscratio * sat
4749 hgwf = this%xnew(igwfnode)
4750 bmaw = this%botscrn(jpos)
4755 if (hgwf < bmaw)
then
4758 qnet = qnet + cmaw * (hgwf - hv)
4770 integer(I4B) :: jpos
4771 integer(I4B) :: icflow
4772 integer(I4B) :: ibnd
4780 if (this%nbound .eq. 0)
return
4783 this%ishutoffcnt = this%ishutoffcnt + 1
4787 do n = 1, this%nmawwells
4788 hmaw = this%xnewpak(n)
4789 do j = 1, this%ngwfnodes(n)
4790 jpos = this%get_jpos(n, j)
4791 this%hcof(ibnd) =
dzero
4792 this%rhs(ibnd) =
dzero
4798 if (this%iboundpak(n) == 0 .or. this%iboundconn(jpos) == 0)
then
4803 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, &
4806 this%simcond(jpos) = cmaw
4807 this%bound(2, ibnd) = cmaw
4808 this%hcof(ibnd) = -term
4809 this%rhs(ibnd) = -term * hmaw + cterm
4827 integer(I4B) :: nbudterm
4828 integer(I4B) :: n, j, n2
4830 integer(I4B) :: maxlist, naux
4832 character(len=LENBUDTXT) :: text
4833 character(len=LENBUDTXT),
dimension(1) :: auxtxt
4839 if (this%iflowingwells > 0)
then
4840 nbudterm = nbudterm + 1
4842 if (this%imover == 1)
then
4843 nbudterm = nbudterm + 3
4844 if (this%iflowingwells > 0)
then
4845 nbudterm = nbudterm + 1
4848 if (this%naux > 0) nbudterm = nbudterm + 1
4852 call this%budobj%budgetobject_df(this%nmawwells, nbudterm, 0, 0, &
4853 ibudcsv=this%ibudcsv)
4861 maxlist = this%maxbound
4863 auxtxt(1) =
' FLOW-AREA'
4864 call this%budobj%budterm(idx)%initialize(text, &
4869 maxlist, .false., .true., &
4871 call this%budobj%budterm(idx)%reset(this%maxbound)
4873 do n = 1, this%nmawwells
4874 do j = 1, this%ngwfnodes(n)
4875 n2 = this%get_gwfnode(n, j)
4876 call this%budobj%budterm(idx)%update_term(n, n2, q)
4883 maxlist = this%nmawwells
4885 call this%budobj%budterm(idx)%initialize(text, &
4890 maxlist, .false., .false., &
4894 if (this%iflowingwells > 0)
then
4897 maxlist = this%nmawwells
4899 call this%budobj%budterm(idx)%initialize(text, &
4904 maxlist, .false., .false., &
4911 maxlist = this%nmawwells
4913 auxtxt(1) =
' VOLUME'
4914 call this%budobj%budterm(idx)%initialize(text, &
4919 maxlist, .false., .true., &
4925 maxlist = this%nmawwells
4927 call this%budobj%budterm(idx)%initialize(text, &
4932 maxlist, .false., .false., &
4936 if (this%imover == 1)
then
4941 maxlist = this%nmawwells
4943 call this%budobj%budterm(idx)%initialize(text, &
4948 maxlist, .false., .false., &
4952 text =
' RATE-TO-MVR'
4954 maxlist = this%nmawwells
4956 call this%budobj%budterm(idx)%initialize(text, &
4961 maxlist, .false., .false., &
4965 text =
' CONSTANT-TO-MVR'
4967 maxlist = this%nmawwells
4969 call this%budobj%budterm(idx)%initialize(text, &
4974 maxlist, .false., .false., &
4978 if (this%iflowingwells > 0)
then
4981 text =
' FW-RATE-TO-MVR'
4983 maxlist = this%nmawwells
4985 call this%budobj%budterm(idx)%initialize(text, &
4990 maxlist, .false., .false., &
5002 maxlist = this%maxbound
5003 call this%budobj%budterm(idx)%initialize(text, &
5008 maxlist, .false., .false., &
5013 if (this%iprflow /= 0)
then
5014 call this%budobj%flowtable_df(this%iout)
5028 integer(I4B) :: naux
5032 integer(I4B) :: jpos
5034 integer(I4B) :: ibnd
5050 call this%budobj%budterm(idx)%reset(this%maxbound)
5052 do n = 1, this%nmawwells
5053 do j = 1, this%ngwfnodes(n)
5054 jpos = this%get_jpos(n, j)
5055 n2 = this%get_gwfnode(n, j)
5059 if (this%iboundpak(n) == 0 .or. this%iboundconn(jpos) == 0)
then
5060 this%qauxcbc(1) =
dzero
5062 tmaw = this%topscrn(jpos)
5063 bmaw = this%botscrn(jpos)
5064 call this%maw_calculate_saturation(n, j, n2, sat)
5065 this%qauxcbc(1) =
dtwo *
dpi * this%radius(n) * sat * (tmaw - bmaw)
5067 q = this%qleak(ibnd)
5068 call this%budobj%budterm(idx)%update_term(n, n2, q, this%qauxcbc)
5075 call this%budobj%budterm(idx)%reset(this%nmawwells)
5076 do n = 1, this%nmawwells
5080 if (this%imover == 1 .and. q <
dzero)
then
5082 if (this%qout(n) <
dzero)
then
5083 qfact = q / this%qout(n)
5085 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
5087 call this%budobj%budterm(idx)%update_term(n, n, q)
5091 if (this%iflowingwells > 0)
then
5093 call this%budobj%budterm(idx)%reset(this%nmawwells)
5094 do n = 1, this%nmawwells
5096 if (this%imover == 1)
then
5100 if (this%qout(n) <
dzero)
then
5101 qfact = q / this%qout(n)
5103 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
5105 call this%budobj%budterm(idx)%update_term(n, n, q)
5111 call this%budobj%budterm(idx)%reset(this%nmawwells)
5112 do n = 1, this%nmawwells
5113 b = this%xsto(n) - this%bot(n)
5117 v = this%area(n) * b
5118 if (this%imawissopt /= 1)
then
5124 call this%budobj%budterm(idx)%update_term(n, n, q, this%qauxcbc)
5129 call this%budobj%budterm(idx)%reset(this%nmawwells)
5130 do n = 1, this%nmawwells
5134 if (this%imover == 1 .and. q <
dzero)
then
5136 if (this%qout(n) <
dzero)
then
5137 qfact = q / this%qout(n)
5139 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
5141 call this%budobj%budterm(idx)%update_term(n, n, q)
5145 if (this%imover == 1)
then
5149 call this%budobj%budterm(idx)%reset(this%nmawwells)
5150 do n = 1, this%nmawwells
5151 if (this%iboundpak(n) == 0)
then
5154 q = this%pakmvrobj%get_qfrommvr(n)
5156 call this%budobj%budterm(idx)%update_term(n, n, q)
5161 call this%budobj%budterm(idx)%reset(this%nmawwells)
5162 do n = 1, this%nmawwells
5163 q = this%pakmvrobj%get_qtomvr(n)
5166 q2 = this%ratesim(n)
5169 if (q2 <
dzero)
then
5170 qfact = q2 / this%qout(n)
5176 call this%budobj%budterm(idx)%update_term(n, n, q)
5181 call this%budobj%budterm(idx)%reset(this%nmawwells)
5182 do n = 1, this%nmawwells
5183 q = this%pakmvrobj%get_qtomvr(n)
5188 if (q2 <
dzero)
then
5189 qfact = q2 / this%qout(n)
5195 call this%budobj%budterm(idx)%update_term(n, n, q)
5199 if (this%iflowingwells > 0)
then
5201 call this%budobj%budterm(idx)%reset(this%nmawwells)
5202 do n = 1, this%nmawwells
5203 q = this%pakmvrobj%get_qtomvr(n)
5206 q2 = this%ratesim(n)
5210 if (this%qout(n) <
dzero)
then
5211 qfact = this%qfw(n) / this%qout(n)
5215 call this%budobj%budterm(idx)%update_term(n, n, q)
5225 call this%budobj%budterm(idx)%reset(this%nmawwells)
5226 do n = 1, this%nmawwells
5228 call this%budobj%budterm(idx)%update_term(n, n, q, this%auxvar(:, n))
5233 call this%budobj%accumulate_terms()
5247 integer(I4B) :: nterms
5248 character(len=LINELENGTH) :: title
5249 character(len=LINELENGTH) :: text
5252 if (this%iprhed > 0)
then
5256 if (this%inamedbound == 1) nterms = nterms + 1
5259 title = trim(adjustl(this%text))//
' PACKAGE ('// &
5260 trim(adjustl(this%packName))//
') HEADS FOR EACH CONTROL VOLUME'
5263 call table_cr(this%headtab, this%packName, title)
5264 call this%headtab%table_df(this%nmawwells, nterms, this%iout, &
5268 if (this%inamedbound == 1)
then
5270 call this%headtab%initialize_column(text, 20, alignment=tableft)
5275 call this%headtab%initialize_column(text, 10, alignment=tabcenter)
5279 call this%headtab%initialize_column(text, 12, alignment=tabcenter)
5287 integer(I4B) :: jpos
5290 integer(I4B),
intent(in) :: n
5291 integer(I4B),
intent(in) :: j
5295 jpos = this%iaconn(n) + j - 1
5302 integer(I4B) :: igwfnode
5305 integer(I4B),
intent(in) :: n
5306 integer(I4B),
intent(in) :: j
5308 integer(I4B) :: jpos
5311 jpos = this%get_jpos(n, j)
5312 igwfnode = this%gwfnodes(jpos)
5319 class(
mawtype),
intent(inout) :: this
5321 integer(I4B) :: i, j
5326 call mem_reallocate(this%denseterms, 3, this%MAXBOUND,
'DENSETERMS', &
5328 do i = 1, this%maxbound
5330 this%denseterms(j, i) =
dzero
5333 write (this%iout,
'(/1x,a)')
'DENSITY TERMS HAVE BEEN ACTIVATED FOR MAW &
5334 &PACKAGE: '//trim(adjustl(this%packName))
5345 class(
mawtype),
intent(inout) :: this
5352 call mem_reallocate(this%viscratios, 2, this%MAXBOUND,
'VISCRATIOS', &
5354 do i = 1, this%maxbound
5356 this%viscratios(j, i) =
done
5359 write (this%iout,
'(/1x,a)')
'VISCOSITY HAS BEEN ACTIVATED FOR MAW &
5360 &PACKAGE: '//trim(adjustl(this%packName))
5386 bmaw, flow, hcofterm, rhsterm)
5388 class(
mawtype),
intent(inout) :: this
5389 integer(I4B),
intent(in) :: iconn
5390 real(DP),
intent(in) :: hmaw
5391 real(DP),
intent(in) :: hgwf
5392 real(DP),
intent(in) :: cond
5393 real(DP),
intent(in) :: bmaw
5394 real(DP),
intent(inout) :: flow
5395 real(DP),
intent(inout) :: hcofterm
5396 real(DP),
intent(inout) :: rhsterm
5400 real(DP) :: rdensemaw
5401 real(DP) :: rdensegwf
5402 real(DP) :: rdenseavg
5407 rdensemaw = this%denseterms(1, iconn)
5408 rdensegwf = this%denseterms(2, iconn)
5409 if (rdensegwf ==
dzero)
return
5412 if (hmaw > bmaw .and. hgwf > bmaw)
then
5415 rdenseavg =
dhalf * (rdensemaw + rdensegwf)
5418 t = cond * (rdenseavg -
done) * (hgwf - hmaw)
5419 rhsterm = rhsterm + t
5423 havg =
dhalf * (hgwf + hmaw)
5424 elevavg = this%denseterms(3, iconn)
5425 t = cond * (havg - elevavg) * (rdensegwf - rdensemaw)
5426 rhsterm = rhsterm + t
5428 else if (hmaw > bmaw)
then
5431 t = (rdensemaw -
done) * rhsterm
5432 rhsterm = rhsterm + t
5434 else if (hgwf > bmaw)
then
5437 t = (rdensegwf -
done) * rhsterm
5438 rhsterm = rhsterm + t
This module contains the extended boundary package.
This module contains the base boundary package.
This module contains the BudgetModule.
subroutine, public budgetobject_cr(this, name)
Create a new budget object.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
real(dp), parameter dhdry
real dry cell constant
@ tabcenter
centered table column
@ tabright
right justified table column
@ tableft
left justified table column
@ mnormal
normal output mode
@ tabucstring
upper case string table data
@ tabstring
string table data
@ tabinteger
integer table data
integer(i4b), parameter lenpackagename
maximum length of the package name
real(dp), parameter dp9
real constant 9/10
real(dp), parameter deight
real constant 8
integer(i4b), parameter namedboundflag
named bound flag
real(dp), parameter dnodata
real no data constant
real(dp), parameter dhnoflo
real no flow constant
real(dp), parameter dhundred
real constant 100
integer(i4b), parameter lenpakloc
maximum length of a package location
@ disu
DISV6 discretization.
@ dis
DIS6 discretization.
@ disv
DISU6 discretization.
real(dp), parameter dtwopi
real constant
real(dp), parameter dep20
real constant 1e20
integer(i4b), parameter lenvarname
maximum length of a variable name
real(dp), parameter dhalf
real constant 1/2
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
integer(i4b), parameter lenauxname
maximum length of a aux variable
real(dp), parameter dpi
real constant
integer(i4b), parameter lenboundname
maximum length of a bound name
real(dp), parameter dpio180
real constant
real(dp), parameter dem4
real constant 1e-4
real(dp), parameter dem6
real constant 1e-6
real(dp), parameter dzero
real constant zero
integer(i4b), parameter maxcharlen
maximum length of char string
real(dp), parameter dp7
real constant 7/10
real(dp), parameter dem9
real constant 1e-9
real(dp), parameter dem2
real constant 1e-2
real(dp), parameter dtwo
real constant 2
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
real(dp), parameter dquarter
real constant 1/3
real(dp), parameter done
real constant 1
integer(i4b) function, public get_node(ilay, irow, icol, nlay, nrow, ncol)
Get node number, given layer, row, and column indices for a structured grid. If any argument is inval...
pure real(dp) function, public polygon_extent(xv, yv)
Calculate the maximum distance between two polygon vertices.
This module defines variable data types.
pure logical function, public is_close(a, b, rtol, atol, symmetric)
Check if a real value is approximately equal to another.
subroutine maw_fill_budobj(this)
Copy flow terms into thisbudobj.
subroutine maw_source_dimensions(this)
Source DIMENSIONS block from input context.
subroutine maw_rp(this)
Read and Prepare.
subroutine maw_set_period_value(this, n, imaw, setting)
Apply a PERIOD setting value to well imaw.
subroutine maw_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
Extra convergence check for the MAW package.
integer(i4b) function get_gwfnode(this, n, j)
Get the gwfnode for connection.
subroutine maw_cf(this)
Formulate the HCOF and RHS terms.
subroutine maw_ot_bdsummary(this, kstp, kper, iout, ibudfl)
Write MAW budget to listing file.
subroutine maw_activate_viscosity(this)
Activate viscosity terms.
subroutine maw_read_initial_attr(this)
Read the initial parameters for this package.
subroutine maw_bd_obs(this)
Calculate observations this time step and call ObsTypeSaveOneSimval for each MawType observation.
subroutine maw_ar(this)
Allocate and Read.
subroutine maw_set_attribute_error(this, imaw, keyword, msg)
Issue a parameter error for mawweslls(imaw)
subroutine maw_ad(this)
Add package connection to matrix.
subroutine maw_calculate_conn_terms(this, n, j, icflow, cmaw, cterm, term, flow, term2)
Calculate matrix terms for a multi-aquifer well connection. Terms for fc and fn methods are calculate...
pure real(dp) function, public maw_screen_length(dz, radius, omega)
In-cell screen length of a non-vertical well connection.
subroutine maw_calculate_density_exchange(this, iconn, hmaw, hgwf, cond, bmaw, flow, hcofterm, rhsterm)
Calculate the groundwater-maw density exchange terms.
subroutine maw_calculate_wellq(this, n, hmaw, q)
Calculate well pumping rate based on constraints.
subroutine maw_source_connectiondata(this)
Source CONNECTIONDATA block from input context.
subroutine maw_rp_obs(this)
Process each observation.
character(len=lenpackagename) text
subroutine maw_allocate_scalars(this)
Allocate scalar members.
subroutine maw_source_angledata(this)
Source ANGLEDATA block from input context for non-vertical MAW connections.
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 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.
subroutine maw_source_options(this)
Source OPTIONS block from input context.
logical function maw_obs_supported(this)
Return true because MAW package supports observations.
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_allocate_arrays(this)
Allocate arrays.
subroutine maw_input_destroy(this)
Nullify all MawInputType pointers.
subroutine, public maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
Create a New Multi-Aquifer Well (MAW) Package.
subroutine maw_cfupdate(this)
Update MAW satcond and package rhs and hcof.
subroutine maw_redflow_csv_write(this)
MAW reduced flows only when & where they occur.
subroutine maw_redflow_csv_init(this, fname)
Initialize the auto flow reduce csv output file.
subroutine maw_input_init(this, mempath, naux)
Bind MawInputType pointers to input context arrays.
real(dp) function maw_calc_lcorr(this, i, jpos)
Calculate the length correction factor for a multi-aquifer well connection.
subroutine maw_source_packagedata(this)
Source PACKAGEDATA block from input context.
subroutine maw_mc(this, moffset, matrix_sln)
Map package connection to matrix.
subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
Apply Newton under-relaxation to the MAW Package well heads.
subroutine maw_check_attributes(this)
Issue parameter errors for mawwells(imaw)
subroutine maw_ac(this, moffset, sparse)
Add package connection to matrix.
subroutine maw_ot_dv(this, idvsave, idvprint)
Save maw-calculated values to binary file.
subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln)
Copy rhs and hcof into solution rhs and amat.
real(dp) function maw_cell_extent(this, node, estimated)
Maximum horizontal extent of a cell.
character(len=lenftype) ftype
subroutine 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
subroutine, public memorystore_release(varname, memory_path)
Release a single variable from the memory store.
subroutine, public get_isize(name, mem_path, isize)
@ brief Get the number of elements for this variable
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_filename(filename, terminate)
Store the erroring file name.
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
This module contains the SourceCommonModule.
logical(lgp) function, public filein_fname(filename, tagname, input_mempath, input_fname)
enforce and set a single input filename provided via FILEIN keyword
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
Derived type for the Budget object.
This class is used to store a single deferred-length character string. It was designed to work in an ...