45 character(len=LENFTYPE) ::
ftype =
'MAW'
46 character(len=LENPACKAGENAME) ::
text =
' MAW'
60 real(dp),
dimension(:),
pointer,
contiguous :: strt => null()
61 integer(I4B),
dimension(:),
pointer :: strt_tslink => null()
63 integer(I4B),
pointer :: nbound => null()
64 integer(I4B),
dimension(:),
pointer,
contiguous :: ifno => null()
66 contiguous :: setting => null()
68 contiguous :: status => null()
70 contiguous :: head_limit => null()
71 real(dp),
dimension(:),
pointer,
contiguous :: fwelev => null()
72 real(dp),
dimension(:),
pointer,
contiguous :: fwcond => null()
73 real(dp),
dimension(:),
pointer,
contiguous :: fwrlen => null()
74 real(dp),
dimension(:),
pointer,
contiguous :: minrate => null()
75 real(dp),
dimension(:),
pointer,
contiguous :: maxrate => null()
76 real(dp),
dimension(:),
pointer,
contiguous :: pump_elevation => null()
77 real(dp),
dimension(:),
pointer,
contiguous :: scaling_length => null()
79 contiguous :: auxname => null()
80 real(dp),
dimension(:),
pointer, &
81 contiguous :: auxval => null()
92 character(len=LENBUDTXT),
dimension(:),
pointer, &
93 contiguous :: cmawbudget => null()
94 character(len=LENAUXNAME),
dimension(:),
pointer, &
95 contiguous :: cauxcbc => null()
98 logical(LGP),
pointer :: correct_flow => null()
101 integer(I4B),
pointer :: iprhed => null()
102 integer(I4B),
pointer :: iheadout => null()
103 integer(I4B),
pointer :: ibudgetout => null()
104 integer(I4B),
pointer :: ibudcsv => null()
105 integer(I4B),
pointer :: cbcauxitems => null()
106 integer(I4B),
pointer :: iflowingwells => null()
107 integer(I4B),
pointer :: imawiss => null()
108 integer(I4B),
pointer :: imawissopt => null()
109 integer(I4B),
pointer :: nmawwells => null()
110 integer(I4B),
pointer :: check_attr => null()
111 integer(I4B),
pointer :: ishutoffcnt => null()
112 integer(I4B),
pointer :: ieffradopt => null()
113 integer(I4B),
pointer :: inonvert => null()
114 integer(I4B),
pointer :: ioutredflowcsv => null()
115 real(dp),
pointer :: satomega => null()
118 real(dp),
pointer :: theta => null()
119 real(dp),
pointer :: kappa => null()
122 character(len=8),
dimension(:),
pointer,
contiguous :: status => null()
123 integer(I4B),
dimension(:),
pointer,
contiguous :: ngwfnodes => null()
124 integer(I4B),
dimension(:),
pointer,
contiguous :: ieqn => null()
125 integer(I4B),
dimension(:),
pointer,
contiguous :: ishutoff => null()
126 integer(I4B),
dimension(:),
pointer,
contiguous :: ifwdischarge => null()
127 real(dp),
dimension(:),
pointer,
contiguous :: strt => null()
128 real(dp),
dimension(:),
pointer,
contiguous :: radius => null()
129 real(dp),
dimension(:),
pointer,
contiguous :: area => null()
130 real(dp),
dimension(:),
pointer,
contiguous :: pumpelev => null()
131 real(dp),
dimension(:),
pointer,
contiguous :: bot => null()
132 real(dp),
dimension(:),
pointer,
contiguous :: ratesim => null()
133 real(dp),
dimension(:),
pointer,
contiguous :: qsim0 => null()
134 real(dp),
dimension(:),
pointer,
contiguous :: reduction_length => null()
135 real(dp),
dimension(:),
pointer,
contiguous :: fwelev => null()
136 real(dp),
dimension(:),
pointer,
contiguous :: fwcond => null()
137 real(dp),
dimension(:),
pointer,
contiguous :: fwrlen => null()
138 real(dp),
dimension(:),
pointer,
contiguous :: fwcondsim => null()
139 real(dp),
dimension(:),
pointer,
contiguous :: xsto => null()
140 real(dp),
dimension(:),
pointer,
contiguous :: xoldsto => null()
141 real(dp),
dimension(:),
pointer,
contiguous :: shutoffmin => null()
142 real(dp),
dimension(:),
pointer,
contiguous :: shutoffmax => null()
143 real(dp),
dimension(:),
pointer,
contiguous :: shutofflevel => null()
144 real(dp),
dimension(:),
pointer,
contiguous :: shutoffweight => null()
145 real(dp),
dimension(:),
pointer,
contiguous :: shutoffdq => null()
146 real(dp),
dimension(:),
pointer,
contiguous :: shutoffqold => null()
147 real(dp),
dimension(:),
pointer,
contiguous :: nurdxold => null()
148 real(dp),
dimension(:),
pointer,
contiguous :: nurweight => null()
149 character(len=LENBOUNDNAME),
dimension(:),
pointer, &
150 contiguous :: cmawname => null()
153 real(dp),
dimension(:),
pointer,
contiguous :: rate => null()
154 real(dp),
dimension(:),
pointer,
contiguous :: well_head => null()
159 logical(LGP),
dimension(:),
pointer,
contiguous :: well_head_set => null()
165 integer(I4B),
dimension(:),
pointer,
contiguous :: iaconn => null()
168 integer(I4B),
dimension(:),
pointer,
contiguous :: gwfnodes => null()
169 real(dp),
dimension(:),
pointer,
contiguous :: sradius => null()
170 real(dp),
dimension(:),
pointer,
contiguous :: hk => null()
171 real(dp),
dimension(:),
pointer,
contiguous :: satcond => null()
172 real(dp),
dimension(:),
pointer,
contiguous :: simcond => null()
173 real(dp),
dimension(:),
pointer,
contiguous :: topscrn => null()
174 real(dp),
dimension(:),
pointer,
contiguous :: botscrn => null()
175 real(dp),
dimension(:),
pointer,
contiguous :: angle => null()
176 real(dp),
dimension(:),
pointer,
contiguous :: connlen => null()
177 real(dp),
dimension(:),
pointer,
contiguous :: usrtopscrn => null()
178 real(dp),
dimension(:),
pointer,
contiguous :: usrbotscrn => null()
181 integer(I4B),
dimension(:),
pointer,
contiguous :: imap => null()
184 real(dp),
dimension(:),
pointer,
contiguous :: qauxcbc => null()
185 real(dp),
dimension(:),
pointer,
contiguous :: dbuff => null()
186 real(dp),
dimension(:),
pointer,
contiguous :: qleak => null()
187 real(dp),
dimension(:),
pointer,
contiguous :: qout => null()
188 real(dp),
dimension(:),
pointer,
contiguous :: qfw => null()
189 real(dp),
dimension(:),
pointer,
contiguous :: qsto => null()
190 real(dp),
dimension(:),
pointer,
contiguous :: qconst => null()
193 integer(I4B),
pointer :: bditems => null()
200 integer(I4B),
pointer :: gwfiss => null()
201 real(dp),
dimension(:),
pointer,
contiguous :: gwfk11 => null()
202 real(dp),
dimension(:),
pointer,
contiguous :: gwfk22 => null()
203 integer(I4B),
pointer :: gwfik22 => null()
204 real(dp),
dimension(:),
pointer,
contiguous :: gwfsat => null()
207 integer(I4B),
dimension(:),
pointer,
contiguous :: idxlocnode => null()
208 integer(I4B),
dimension(:),
pointer,
contiguous :: idxdglo => null()
209 integer(I4B),
dimension(:),
pointer,
contiguous :: idxoffdglo => null()
210 integer(I4B),
dimension(:),
pointer,
contiguous :: idxsymdglo => null()
211 integer(I4B),
dimension(:),
pointer,
contiguous :: idxsymoffdglo => null()
212 integer(I4B),
dimension(:),
pointer,
contiguous :: iboundpak => null()
213 real(dp),
dimension(:),
pointer,
contiguous :: xnewpak => null()
214 real(dp),
dimension(:),
pointer,
contiguous :: xoldpak => null()
217 integer(I4B),
pointer :: idense
218 real(dp),
dimension(:, :),
pointer,
contiguous :: denseterms => null()
221 real(dp),
dimension(:, :),
pointer,
contiguous :: viscratios => null()
295 subroutine maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
298 class(
bndtype),
pointer :: packobj
299 integer(I4B),
intent(in) :: id
300 integer(I4B),
intent(in) :: ibcnum
301 integer(I4B),
intent(in) :: inunit
302 integer(I4B),
intent(in) :: iout
303 character(len=*),
intent(in) :: namemodel
304 character(len=*),
intent(in) :: pakname
305 character(len=*),
intent(in) :: mempath
306 type(
mawtype),
pointer :: mawobj
313 call packobj%set_names(ibcnum, namemodel, pakname,
ftype, mempath)
317 call mawobj%maw_allocate_scalars()
320 call packobj%pack_initialize()
322 packobj%inunit = inunit
325 packobj%ibcnum = ibcnum
338 class(
mawtype),
intent(inout) :: this
341 call this%BndExtType%allocate_scalars()
344 call mem_allocate(this%correct_flow,
'CORRECT_FLOW', this%memoryPath)
345 call mem_allocate(this%iprhed,
'IPRHED', this%memoryPath)
346 call mem_allocate(this%iheadout,
'IHEADOUT', this%memoryPath)
347 call mem_allocate(this%ibudgetout,
'IBUDGETOUT', this%memoryPath)
348 call mem_allocate(this%ibudcsv,
'IBUDCSV', this%memoryPath)
349 call mem_allocate(this%iflowingwells,
'IFLOWINGWELLS', this%memoryPath)
350 call mem_allocate(this%imawiss,
'IMAWISS', this%memoryPath)
351 call mem_allocate(this%imawissopt,
'IMAWISSOPT', this%memoryPath)
352 call mem_allocate(this%nmawwells,
'NMAWWELLS', this%memoryPath)
353 call mem_allocate(this%check_attr,
'CHECK_ATTR', this%memoryPath)
354 call mem_allocate(this%ishutoffcnt,
'ISHUTOFFCNT', this%memoryPath)
355 call mem_allocate(this%ieffradopt,
'IEFFRADOPT', this%memoryPath)
356 call mem_allocate(this%inonvert,
'INONVERT', this%memoryPath)
357 call mem_allocate(this%ioutredflowcsv,
'IOUTREDFLOWCSV', this%memoryPath)
358 call mem_allocate(this%satomega,
'SATOMEGA', this%memoryPath)
359 call mem_allocate(this%bditems,
'BDITEMS', this%memoryPath)
362 call mem_allocate(this%cbcauxitems,
'CBCAUXITEMS', this%memoryPath)
363 call mem_allocate(this%idense,
'IDENSE', this%memoryPath)
366 this%correct_flow = .false.
372 this%iflowingwells = 0
377 this%ioutredflowcsv = 0
378 this%satomega =
dzero
393 class(
mawtype),
intent(inout) :: this
403 this%cmawbudget(1) =
' GWF'
404 this%cmawbudget(2) =
' RATE'
405 this%cmawbudget(3) =
' STORAGE'
406 this%cmawbudget(4) =
' CONSTANT'
407 this%cmawbudget(5) =
' FW-RATE'
408 this%cmawbudget(6) =
' FROM-MVR'
409 this%cmawbudget(7) =
' RATE-TO-MVR'
410 this%cmawbudget(8) =
' FW-RATE-TO-MVR'
415 call mem_allocate(this%status, 8, this%nmawwells,
'STATUS', this%memoryPath)
418 call mem_allocate(this%ngwfnodes, this%nmawwells,
'NGWFNODES', &
420 call mem_allocate(this%ieqn, this%nmawwells,
'IEQN', this%memoryPath)
421 call mem_allocate(this%ishutoff, this%nmawwells,
'ISHUTOFF', this%memoryPath)
422 call mem_allocate(this%ifwdischarge, this%nmawwells,
'IFWDISCHARGE', &
424 call mem_allocate(this%strt, this%nmawwells,
'STRT', this%memoryPath)
425 call mem_allocate(this%radius, this%nmawwells,
'RADIUS', this%memoryPath)
426 call mem_allocate(this%area, this%nmawwells,
'AREA', this%memoryPath)
427 call mem_allocate(this%pumpelev, this%nmawwells,
'PUMPELEV', this%memoryPath)
428 call mem_allocate(this%bot, this%nmawwells,
'BOT', this%memoryPath)
429 call mem_allocate(this%ratesim, this%nmawwells,
'RATESIM', this%memoryPath)
430 call mem_allocate(this%qsim0, this%nmawwells,
'QSIM0', this%memoryPath)
431 call mem_allocate(this%reduction_length, this%nmawwells,
'REDUCTION_LENGTH', &
433 call mem_allocate(this%fwelev, this%nmawwells,
'FWELEV', this%memoryPath)
434 call mem_allocate(this%fwcond, this%nmawwells,
'FWCONDS', this%memoryPath)
435 call mem_allocate(this%fwrlen, this%nmawwells,
'FWRLEN', this%memoryPath)
436 call mem_allocate(this%fwcondsim, this%nmawwells,
'FWCONDSIM', &
438 call mem_allocate(this%xsto, this%nmawwells,
'XSTO', this%memoryPath)
439 call mem_allocate(this%xoldsto, this%nmawwells,
'XOLDSTO', this%memoryPath)
440 call mem_allocate(this%shutoffmin, this%nmawwells,
'SHUTOFFMIN', &
442 call mem_allocate(this%shutoffmax, this%nmawwells,
'SHUTOFFMAX', &
444 call mem_allocate(this%shutofflevel, this%nmawwells,
'SHUTOFFLEVEL', &
446 call mem_allocate(this%shutoffweight, this%nmawwells,
'SHUTOFFWEIGHT', &
448 call mem_allocate(this%shutoffdq, this%nmawwells,
'SHUTOFFDQ', &
450 call mem_allocate(this%shutoffqold, this%nmawwells,
'SHUTOFFQOLD', &
452 call mem_allocate(this%nurdxold, this%nmawwells,
'NURDXOLD', &
454 call mem_allocate(this%nurweight, this%nmawwells,
'NURWEIGHT', &
459 call mem_setptr(this%rate,
'RATE', this%input_mempath)
460 call mem_setptr(this%well_head,
'WELL_HEAD', this%input_mempath)
461 call mem_allocate(this%well_head_set, this%nmawwells,
'WELL_HEAD_SET', &
463 this%well_head_set = .false.
466 if (this%iheadout > 0)
then
467 call mem_allocate(this%dbuff, this%nmawwells,
'DBUFF', this%memoryPath)
469 call mem_allocate(this%dbuff, 0,
'DBUFF', this%memoryPath)
473 call mem_allocate(this%iaconn, this%nmawwells + 1,
'IACONN', this%memoryPath)
476 call mem_allocate(this%imap, this%MAXBOUND,
'IMAP', this%memoryPath)
479 call mem_allocate(this%gwfnodes, this%maxbound,
'GWFNODES', this%memoryPath)
480 call mem_allocate(this%sradius, this%maxbound,
'SRADIUS', this%memoryPath)
481 call mem_allocate(this%hk, this%maxbound,
'HK', this%memoryPath)
482 call mem_allocate(this%satcond, this%maxbound,
'SATCOND', this%memoryPath)
483 call mem_allocate(this%simcond, this%maxbound,
'SIMCOND', this%memoryPath)
484 call mem_allocate(this%topscrn, this%maxbound,
'TOPSCRN', this%memoryPath)
485 call mem_allocate(this%botscrn, this%maxbound,
'BOTSCRN', this%memoryPath)
486 call mem_allocate(this%angle, this%maxbound,
'ANGLE', this%memoryPath)
487 call mem_allocate(this%connlen, this%maxbound,
'CONNLEN', this%memoryPath)
488 call mem_allocate(this%usrtopscrn, this%maxbound,
'USRTOPSCRN', &
490 call mem_allocate(this%usrbotscrn, this%maxbound,
'USRBOTSCRN', &
494 call mem_allocate(this%qleak, this%maxbound,
'QLEAK', this%memoryPath)
497 do n = 1, this%nmawwells
498 this%status(n) =
'ACTIVE'
499 this%ngwfnodes(n) = 0
502 this%ifwdischarge(n) = 0
504 this%radius(n) =
dep20
506 this%pumpelev(n) =
dep20
508 this%ratesim(n) =
dzero
509 this%qsim0(n) =
dzero
510 this%reduction_length(n) =
dep20
511 this%fwelev(n) =
dzero
512 this%fwcond(n) =
dzero
513 this%fwrlen(n) =
dzero
514 this%fwcondsim(n) =
dzero
516 this%xoldsto(n) =
dzero
517 this%shutoffmin(n) =
dzero
518 this%shutoffmax(n) =
dzero
519 this%shutofflevel(n) =
dep20
520 this%shutoffweight(n) =
done
521 this%shutoffdq(n) =
done
522 this%shutoffqold(n) =
done
523 this%nurdxold(n) =
dzero
524 this%nurweight(n) =
done
528 this%well_head(n) =
dzero
531 if (this%iheadout > 0)
then
532 this%dbuff(n) =
dzero
537 do n = 1, this%nmawwells + 1
546 call mem_allocate(this%qauxcbc, this%cbcauxitems,
'QAUXCBC', this%memoryPath)
547 do j = 1, this%cbcauxitems
548 this%qauxcbc(j) =
dzero
552 if (this%iflowingwells /= 0)
then
553 call mem_allocate(this%qfw, this%nmawwells,
'QFW', this%memoryPath)
557 call mem_allocate(this%qout, this%nmawwells,
'QOUT', this%memoryPath)
558 call mem_allocate(this%qsto, this%nmawwells,
'QSTO', this%memoryPath)
559 call mem_allocate(this%qconst, this%nmawwells,
'QCONST', this%memoryPath)
562 do n = 1, this%nmawwells
563 if (this%iflowingwells > 0)
then
567 this%qconst(n) =
dzero
571 do j = 1, this%maxbound
574 this%sradius(j) =
dzero
576 this%satcond(j) =
dzero
577 this%simcond(j) =
dzero
578 this%topscrn(j) =
dzero
579 this%botscrn(j) =
dzero
580 this%angle(j) =
dzero
581 this%connlen(j) =
dzero
582 this%usrtopscrn(j) =
dzero
583 this%usrbotscrn(j) =
dzero
584 this%qleak(j) =
dzero
588 call mem_allocate(this%denseterms, 3, 0,
'DENSETERMS', this%memoryPath)
591 call mem_allocate(this%viscratios, 2, 0,
'VISCRATIOS', this%memoryPath)
600 class(
mawtype),
intent(inout) :: this
604 call this%BndExtType%allocate_arrays()
607 call this%BndExtType%allocate_featureauxvar()
622 class(
mawtype),
intent(inout) :: this
624 real(DP),
dimension(:, :),
pointer,
contiguous :: aux => null()
625 integer(I4B) :: isize
629 'RATE', this%input_mempath,
'6.8.2')
631 'WELL_HEAD', this%input_mempath,
'6.8.2')
636 call get_isize(
'AUX', this%input_mempath, isize)
638 call mem_setptr(aux,
'AUX', this%input_mempath)
640 'AUX', this%input_mempath,
'6.8.2')
648 class(
mawtype),
intent(inout) :: this
651 integer(I4B) :: isize
652 character(len=LINELENGTH) :: fname
654 character(len=*),
parameter :: fmtflowingwells = &
655 &
"(4x, 'FLOWING WELLS WILL BE SIMULATED.')"
656 character(len=*),
parameter :: fmtshutdown = &
657 &
"(4x, 'SHUTDOWN ', a, ' VALUE (',g15.7,') SPECIFIED.')"
658 character(len=*),
parameter :: fmtnostoragewells = &
659 &
"(4x, 'WELL STORAGE WILL NOT BE SIMULATED.')"
660 character(len=*),
parameter :: fmtmawbin = &
661 "(4x, 'MAW ', 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, /4x, &
662 &'OPENED ON UNIT: ', I0)"
666 call this%BndExtType%source_options()
668 write (this%iout,
'(1x,a)') &
669 'PROCESSING '//trim(adjustl(this%text))//
' OPTIONS'
672 call get_isize(
'PRINT_HEAD', this%input_mempath, isize)
675 write (this%iout,
'(4x,a)') &
676 trim(adjustl(this%text))//
' heads will be printed to listing file.'
680 call mem_set_value(fname,
'HEADFILE', this%input_mempath, found%headfile)
681 if (found%headfile)
then
682 call assign_iounit(this%iheadout, this%inunit,
"HEAD fileout")
683 call openfile(this%iheadout, this%iout, fname,
'DATA(BINARY)', &
685 write (this%iout, fmtmawbin)
'HEAD', trim(adjustl(fname)), this%iheadout
689 call mem_set_value(fname,
'BUDGETFILE', this%input_mempath, found%budgetfile)
690 if (found%budgetfile)
then
691 call assign_iounit(this%ibudgetout, this%inunit,
"BUDGET fileout")
692 call openfile(this%ibudgetout, this%iout, fname,
'DATA(BINARY)', &
694 write (this%iout, fmtmawbin)
'BUDGET', trim(adjustl(fname)), this%ibudgetout
698 call mem_set_value(fname,
'BUDGETCSVFILE', this%input_mempath, &
700 if (found%budgetcsvfile)
then
701 call assign_iounit(this%ibudcsv, this%inunit,
"BUDGETCSV fileout")
702 call openfile(this%ibudcsv, this%iout, fname,
'CSV', filstat_opt=
'REPLACE')
703 write (this%iout, fmtmawbin) &
704 'BUDGET CSV', trim(adjustl(fname)), this%ibudcsv
708 call get_isize(
'NO_WELL_STORAGE', this%input_mempath, isize)
711 write (this%iout, fmtnostoragewells)
715 call get_isize(
'FLOW_CORRECTION', this%input_mempath, isize)
717 this%correct_flow = .true.
718 write (this%iout,
'(4x,a,/,4x,a)') &
719 'MAW-GWF FLOW CORRECTIONS WILL BE APPLIED WHEN MAW HEADS ARE BELOW', &
720 'OR GWF HEADS IN CONNECTED CELLS ARE BELOW THE CELL BOTTOM.'
724 call get_isize(
'FLOWING_WELLS', this%input_mempath, isize)
726 this%iflowingwells = 1
727 write (this%iout, fmtflowingwells)
731 call mem_set_value(this%theta,
'SHUTDOWN_THETA', this%input_mempath, &
732 found%shutdown_theta)
733 if (found%shutdown_theta)
then
734 write (this%iout, fmtshutdown)
'THETA', this%theta
738 call mem_set_value(this%kappa,
'SHUTDOWN_KAPPA', this%input_mempath, &
739 found%shutdown_kappa)
740 if (found%shutdown_kappa)
then
741 write (this%iout, fmtshutdown)
'KAPPA', this%kappa
745 call mem_set_value(fname,
'MFRCSVFILE', this%input_mempath, found%mfrcsvfile)
746 if (found%mfrcsvfile)
then
747 call this%maw_redflow_csv_init(fname)
751 call get_isize(
'MOVER', this%input_mempath, isize)
754 write (this%iout,
'(4x,A)')
'MOVER OPTION ENABLED'
758 call get_isize(
'IEFFRADOPT', this%input_mempath, isize)
761 write (this%iout,
'(4x,a)') &
762 'EFFECTIVE RADIUS FOR STRUCTURED GRIDS WILL BE CALCULATED &
763 &USING PEACEMAN 1983'
767 call get_isize(
'INONVERT', this%input_mempath, isize)
770 write (this%iout,
'(4x,a)') &
771 'NON-VERTICAL (SLANTED) WELL CONNECTIONS ENABLED'
774 write (this%iout,
'(1x,a)')
'END OF '//trim(adjustl(this%text))//
' OPTIONS'
781 class(
mawtype),
intent(inout) :: this
789 write (this%iout,
'(/1x,a)') &
790 'PROCESSING '//trim(adjustl(this%text))//
' DIMENSIONS'
793 call mem_set_value(this%nmawwells,
'MAXBOUND', this%input_mempath, &
794 found%maxbound, release=.false.)
795 if (found%maxbound)
then
796 write (this%iout,
'(4x,a,i0)')
'NMAWWELLS = ', this%nmawwells
799 write (this%iout,
'(1x,a)') &
800 'END OF '//trim(adjustl(this%text))//
' DIMENSIONS'
802 if (this%nmawwells < 0)
then
804 'NMAWWELLS was not specified or was specified incorrectly.'
810 this%npakeq = this%nmawwells
813 call this%maw_source_packagedata()
816 call this%maw_source_connectiondata()
819 call this%maw_source_angledata()
822 call this%maw_checkin_deprecated_names()
825 call this%define_listlabel()
828 call this%maw_setup_budobj()
831 call this%maw_setup_tableobj()
841 character(len=*),
intent(in) :: mempath
842 integer(I4B),
intent(in) :: naux
843 call mem_setptr(this%nbound,
'NBOUND', mempath)
845 call mem_setptr(this%setting,
'SETTING', mempath)
846 call mem_setptr(this%status,
'STATUS', mempath)
847 call mem_setptr(this%head_limit,
'HEAD_LIMIT', mempath)
848 call mem_setptr(this%fwelev,
'FWELEV', mempath)
849 call mem_setptr(this%fwcond,
'FWCOND', mempath)
850 call mem_setptr(this%fwrlen,
'FWRLEN', mempath)
851 call mem_setptr(this%minrate,
'MINRATE', mempath)
852 call mem_setptr(this%maxrate,
'MAXRATE', mempath)
853 call mem_setptr(this%pump_elevation,
'PUMP_ELEVATION', mempath)
854 call mem_setptr(this%scaling_length,
'SCALING_LENGTH', mempath)
856 call mem_setptr(this%auxname,
'AUXNAME', mempath)
857 call mem_setptr(this%auxval,
'AUXVAL', mempath)
866 nullify (this%strt_tslink)
867 nullify (this%nbound)
869 nullify (this%setting)
870 nullify (this%status)
871 nullify (this%head_limit)
872 nullify (this%fwelev)
873 nullify (this%fwcond)
874 nullify (this%fwrlen)
875 nullify (this%minrate)
876 nullify (this%maxrate)
877 nullify (this%pump_elevation)
878 nullify (this%scaling_length)
879 nullify (this%auxname)
880 nullify (this%auxval)
887 class(
mawtype),
intent(inout) :: this
889 integer(I4B) :: n, jj, idx, imaw
890 character(len=9) :: cno9
891 character(len=LINELENGTH) :: keyword
893 integer(I4B),
dimension(:),
pointer,
contiguous :: ifno => null()
894 real(DP),
dimension(:),
pointer,
contiguous :: radius => null()
895 real(DP),
dimension(:),
pointer,
contiguous :: bottom => null()
897 contiguous :: condeqn => null()
898 integer(I4B),
dimension(:),
pointer,
contiguous :: ngwfnodes => null()
900 contiguous :: boundname => null()
901 integer(I4B),
dimension(:, :),
pointer,
contiguous :: tslink => null()
903 contiguous :: tslinkvars => null()
904 integer(I4B),
allocatable :: nboundchk(:)
906 character(len=*),
parameter :: fmthdbot = &
907 "('well head (', G0, ') must be greater than or equal to the &
908 &BOTTOM_ELEVATION (', G0, ').')"
910 write (this%iout,
'(/1x,a)') &
911 'PROCESSING '//trim(adjustl(this%text))//
' PACKAGEDATA'
914 call mem_setptr(ifno,
'PACKAGEDATA_IFNO', this%input_mempath)
915 call mem_setptr(radius,
'RADIUS', this%input_mempath)
916 call mem_setptr(bottom,
'BOTTOM', this%input_mempath)
917 call mem_setptr(this%input%strt,
'STRT', this%input_mempath)
918 call mem_setptr(tslink,
'TSLINK_PD', this%input_mempath)
919 call mem_setptr(tslinkvars,
'TSLINKVARS_PD', this%input_mempath)
920 do n = 1,
size(tslinkvars)
921 if (tslinkvars(n) ==
'STRT') this%input%strt_tslink => tslink(n, :)
923 if (.not.
associated(this%input%strt_tslink))
then
924 call store_error(
'Time series links for STRT not found in input.')
927 call mem_setptr(condeqn,
'CONDEQN', this%input_mempath)
928 call mem_setptr(ngwfnodes,
'NGWFNODES', this%input_mempath)
929 if (this%inamedbound /= 0)
then
930 call mem_setptr(boundname,
'BOUNDNAME', this%input_mempath)
935 this%maxbound = sum(ngwfnodes)
936 write (this%iout,
'(//4x,a,i7)')
'MAXBOUND = ', this%maxbound
937 call this%maw_allocate_well_conn_arrays()
940 allocate (nboundchk(this%nmawwells))
942 do n = 1, this%nmawwells
943 imaw = this%validate_ifno(ifno(n), this%nmawwells, nboundchk, &
944 'IMAW',
'PACKAGEDATA')
949 if (rval <=
dzero)
then
950 write (
errmsg,
'(a,1x,i0,1x,a)') &
951 'Radius for well', imaw,
'must be greater than zero.'
954 this%radius(imaw) = rval
955 this%area(imaw) =
dpi * rval**
dtwo
958 this%bot(imaw) = bottom(n)
962 select case (trim(keyword))
969 write (
warnmsg,
'(a,a,a,a,a,a)') &
970 "CONDEQN in '", trim(this%packName),
"' should be ", &
971 "corrected from '", trim(keyword),
"' to 'THIEM'."
980 write (
errmsg,
'(a,1x,i0,1x,a)') &
981 'CONDEQN for well', imaw, &
982 "must be 'CUMULATIVE', 'THIEM', 'MEAN', or 'SKIN'."
988 if (ngwfnodes(n) < 1)
then
989 write (
errmsg,
'(a,1x,i0,1x,a)') &
990 'NGWFNODES for well', imaw,
'must be greater than zero.'
993 this%ngwfnodes(imaw) = ngwfnodes(n)
996 this%well_head(imaw) = this%input%strt(n)
997 this%strt(imaw) = this%input%strt(n)
998 if (this%strt(imaw) < this%bot(imaw))
then
999 write (keyword, fmthdbot) this%strt(imaw), this%bot(imaw)
1000 call this%maw_set_attribute_error(imaw,
'STRT', trim(keyword))
1004 write (cno9,
'(i9.9)') imaw
1005 this%cmawname(imaw) =
'MAWWELL'//cno9
1006 if (this%inamedbound /= 0)
then
1008 if (trim(
text) /=
'')
then
1009 this%cmawname(imaw) = trim(
text)
1015 call this%report_ifno_coverage(nboundchk, this%nmawwells,
'well', &
1017 deallocate (nboundchk)
1019 write (this%iout,
'(1x,a)') &
1020 'END OF '//trim(adjustl(this%text))//
' PACKAGEDATA'
1029 do n = 1, this%nmawwells
1030 do jj = 1, this%ngwfnodes(n)
1034 this%iaconn(n + 1) = idx + 1
1050 class(
mawtype),
intent(inout) :: this
1052 integer(I4B) :: n, nconn, imaw, iconn, ipos, jpos, j, jj
1053 integer(I4B) :: nn, nn2
1054 integer(I4B) :: ireset_scrntop, ireset_scrnbot, ireset_wellbot
1055 real(DP) :: rval, topnn, botnn, botw
1056 character(len=LINELENGTH) :: cellid_str
1057 character(len=30) :: nodestr
1058 integer(I4B),
dimension(:),
pointer,
contiguous :: ifno => null()
1059 integer(I4B),
dimension(:),
pointer,
contiguous :: icon => null()
1060 integer(I4B),
dimension(:, :),
pointer,
contiguous :: cellid => null()
1061 real(DP),
dimension(:),
pointer,
contiguous :: scrn_top => null()
1062 real(DP),
dimension(:),
pointer,
contiguous :: scrn_bot => null()
1063 real(DP),
dimension(:),
pointer,
contiguous :: hk_skin => null()
1064 real(DP),
dimension(:),
pointer,
contiguous :: radius_skin => null()
1065 integer(I4B),
allocatable :: iachk(:)
1066 integer(I4B),
allocatable :: nboundchk(:)
1072 write (this%iout,
'(/1x,a)') &
1073 'PROCESSING '//trim(adjustl(this%text))//
' CONNECTIONDATA'
1076 call mem_setptr(ifno,
'CONNDATA_IFNO', this%input_mempath)
1077 call mem_setptr(icon,
'ICON', this%input_mempath)
1078 call mem_setptr(cellid,
'CELLID', this%input_mempath)
1079 call mem_setptr(scrn_top,
'SCRN_TOP', this%input_mempath)
1080 call mem_setptr(scrn_bot,
'SCRN_BOT', this%input_mempath)
1081 call mem_setptr(hk_skin,
'HK_SKIN', this%input_mempath)
1082 call mem_setptr(radius_skin,
'RADIUS_SKIN', this%input_mempath)
1087 allocate (iachk(this%nmawwells + 1))
1089 do n = 1, this%nmawwells
1090 iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
1092 allocate (nboundchk(this%maxbound))
1100 if (imaw < 1 .or. imaw > this%nmawwells)
then
1101 write (
errmsg,
'(a,1x,i0,a)') &
1102 'IMAW must be greater than 0 and less than or equal to ', &
1107 if (iconn < 1 .or. iconn > this%ngwfnodes(imaw))
then
1108 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
1109 'JCONN for well ', imaw, &
1110 'must be greater than 1 and less than or equal to ', &
1111 this%ngwfnodes(imaw),
'.'
1116 ipos = iachk(imaw) + iconn - 1
1117 nboundchk(ipos) = nboundchk(ipos) + 1
1119 jpos = this%get_jpos(imaw, iconn)
1122 write (cellid_str,
'(10(i0,1x))') cellid(1:this%dis%ndim, n)
1123 nn = this%dis%noder_from_cellid(cellid_str, this%inunit, this%iout)
1124 topnn = this%dis%top(nn)
1125 botnn = this%dis%bot(nn)
1126 botw = this%bot(imaw)
1129 this%gwfnodes(jpos) = nn
1132 this%usrtopscrn(jpos) = scrn_top(n)
1134 if (this%ieqn(imaw) /= 4)
then
1137 if (rval > topnn)
then
1138 ireset_scrntop = ireset_scrntop + 1
1142 this%topscrn(jpos) = rval
1145 this%usrbotscrn(jpos) = scrn_bot(n)
1147 if (this%ieqn(imaw) /= 4)
then
1150 if (rval < botnn)
then
1151 ireset_scrnbot = ireset_scrnbot + 1
1155 this%botscrn(jpos) = rval
1159 if (rval < botw)
then
1160 if (this%ieqn(imaw) /= 4)
then
1161 ireset_wellbot = ireset_wellbot + 1
1163 this%bot(imaw) = rval
1165 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
1166 'Screen bottom for maw well', imaw,
'connection', j,
'(', &
1167 this%botscrn(jpos),
') is less than the well bottom (', &
1168 this%bot(imaw),
').'
1175 if (this%ieqn(imaw) == 0)
then
1176 this%satcond(jpos) = rval
1177 else if (this%ieqn(imaw) == 2 .OR. this%ieqn(imaw) == 3 .OR. &
1178 this%ieqn(imaw) == 4)
then
1179 this%hk(jpos) = rval
1183 rval = radius_skin(n)
1184 if (this%ieqn(imaw) == 2 .OR. this%ieqn(imaw) == 3 .OR. &
1185 this%ieqn(imaw) == 4)
then
1186 this%sradius(jpos) = rval
1187 if (this%sradius(jpos) <= this%radius(imaw))
then
1188 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
1189 'Screen radius for maw well', imaw,
'connection', j,
'(', &
1190 this%sradius(jpos), &
1191 ') is less than or equal to the well radius (', &
1192 this%radius(imaw),
').'
1198 write (this%iout,
'(1x,a)') &
1199 'END OF '//trim(adjustl(this%text))//
' CONNECTIONDATA'
1203 do n = 1, this%nmawwells
1204 do j = 1, this%ngwfnodes(n)
1206 if (nboundchk(ipos) == 0)
then
1207 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
1208 'No data specified for maw well', n,
'connection', j,
'.'
1210 else if (nboundchk(ipos) > 1)
then
1211 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,1x,i0,1x,a)') &
1212 'Data for maw well', n,
'connection', j, &
1213 'specified', nboundchk(ipos),
'times.'
1221 do n = 1, this%nmawwells
1222 if (this%ieqn(n) /= 4)
then
1223 do j = 1, this%ngwfnodes(n)
1224 nn = this%get_gwfnode(n, j)
1225 do jj = 1, this%ngwfnodes(n)
1227 nn2 = this%get_gwfnode(n, jj)
1229 call this%dis%noder_to_string(nn, nodestr)
1230 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,3(1x,a))') &
1231 'Only one connection can be specified for maw well', &
1232 n,
'connection', j,
'to gwf cell', trim(adjustl(nodestr)), &
1233 'unless the mean condeqn is specified.'
1243 deallocate (nboundchk)
1246 if (ireset_scrntop > 0)
then
1247 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1248 'The screen tops in multi-aquifer well package', trim(this%packName), &
1249 'were reset to the top of the connected cell', ireset_scrntop,
'times.'
1252 if (ireset_scrnbot > 0)
then
1253 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1254 'The screen bottoms in multi-aquifer well package', trim(this%packName), &
1255 'were reset to the bottom of the connected cell', ireset_scrnbot, &
1259 if (ireset_wellbot > 0)
then
1260 write (
warnmsg,
'(a,1x,a,1x,a,1x,i0,1x,a)') &
1261 'The well bottoms in multi-aquifer well package', trim(this%packName), &
1262 'were reset to the bottom of the connected cell', ireset_wellbot, &
1288 class(
mawtype),
intent(inout) :: this
1290 integer(I4B) :: n, imaw, iconn, jpos, ichk, nangle, node
1291 real(DP) :: angle, dz, omega, lw, topexp
1294 character(len=LINELENGTH) :: cndmsg
1295 character(len=LINELENGTH) :: extmsg
1296 logical(LGP) :: estimated
1297 integer(I4B),
dimension(:),
pointer,
contiguous :: angledata_ifno => null()
1298 integer(I4B),
dimension(:),
pointer,
contiguous :: angledata_icon => null()
1299 real(DP),
dimension(:),
pointer,
contiguous :: angle_arr => null()
1300 real(DP),
dimension(:),
pointer,
contiguous :: connlen_arr => null()
1301 integer(I4B),
allocatable :: iachk(:)
1302 integer(I4B),
allocatable :: nboundchk(:)
1303 real(DP),
parameter :: coszero =
dem6
1304 real(DP),
parameter :: dninety = 9.0d1
1306 call get_isize(
'ANGLEDATA_IFNO', this%input_mempath, nangle)
1308 if (nangle > 0)
then
1310 if (this%inonvert == 0)
then
1311 call store_error(
'An ANGLEDATA block was specified but the '// &
1312 'NON_VERTICAL_WELLS option was not specified in the '// &
1317 call mem_setptr(angledata_ifno,
'ANGLEDATA_IFNO', this%input_mempath)
1318 call mem_setptr(angledata_icon,
'ANGLEDATA_ICON', this%input_mempath)
1319 call mem_setptr(angle_arr,
'ANGLE', this%input_mempath)
1320 call mem_setptr(connlen_arr,
'CONNLEN', this%input_mempath)
1322 allocate (iachk(this%nmawwells + 1))
1324 do n = 1, this%nmawwells
1325 iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
1327 allocate (nboundchk(this%maxbound))
1330 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1334 imaw = angledata_ifno(n)
1335 if (imaw < 1 .or. imaw > this%nmawwells)
then
1336 write (
errmsg,
'(a,1x,i0,a)') &
1337 'IFNO must be greater than 0 and less than or equal to ', &
1343 iconn = angledata_icon(n)
1344 if (iconn < 1 .or. iconn > this%ngwfnodes(imaw))
then
1345 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,a)') &
1346 'ICON for well ', imaw, &
1347 'must be greater than 0 and less than or equal to ', &
1348 this%ngwfnodes(imaw),
'.'
1352 jpos = this%get_jpos(imaw, iconn)
1354 ichk = iachk(imaw) + iconn - 1
1355 nboundchk(ichk) = nboundchk(ichk) + 1
1356 if (nboundchk(ichk) > 1)
then
1357 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1358 'ANGLEDATA for maw well', imaw,
'connection', iconn, &
1359 'is specified more than once.'
1363 angle = angle_arr(n)
1364 this%angle(jpos) = angle
1365 if (connlen_arr(n) /=
dnodata)
then
1366 this%connlen(jpos) = max(connlen_arr(n),
dzero)
1369 if (angle <
dzero .or. angle > dninety)
then
1370 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1371 'ANGLE for maw well', imaw,
'connection', iconn,
'(', angle, &
1372 ') must be greater than or equal to 0.0 and less than or '// &
1373 'equal to 90.0 degrees.'
1378 node = this%get_gwfnode(imaw, iconn)
1386 if (this%ieqn(imaw) == 0)
then
1387 this%topscrn(jpos) = min(this%usrtopscrn(jpos), this%dis%top(node))
1388 this%botscrn(jpos) = max(this%usrbotscrn(jpos), this%dis%bot(node))
1391 dz = this%topscrn(jpos) - this%botscrn(jpos)
1392 if (dz <=
dzero)
then
1393 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1394 'The screen top must be greater than the screen bottom for maw '// &
1395 'well', imaw,
'connection', iconn,
'listed in the ANGLEDATA block.'
1405 if (this%connlen(jpos) >
dzero)
then
1406 lw = this%connlen(jpos)
1407 else if (cos(omega) > coszero)
then
1419 if (this%ieqn(imaw) /= 0)
then
1420 if (cos(omega) <= coszero .and. this%connlen(jpos) <=
dzero)
then
1421 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1422 'A connection length must be specified for the (near) '// &
1423 'horizontal maw well', imaw,
'connection', iconn, &
1424 'listed in the ANGLEDATA block.'
1428 if (lw <=
dzero)
then
1429 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1430 'The calculated in-cell screen length for maw well', imaw, &
1431 'connection', iconn,
'(', lw, &
1432 ') is not greater than zero. Specify a connection length in '// &
1433 'the ANGLEDATA block.'
1441 if (lw >
dzero)
then
1442 hlen = lw * sin(omega)
1443 extent = this%maw_cell_extent(node, estimated)
1444 if (hlen > extent)
then
1449 extmsg =
'estimated maximum horizontal extent'
1451 extmsg =
'maximum horizontal extent'
1457 if (this%ieqn(imaw) == 0)
then
1458 cndmsg =
'The specified saturated conductance is applied to a '// &
1459 'screen that is longer than the cell.'
1461 cndmsg =
'The calculated saturated conductance is '// &
1462 'correspondingly too large.'
1464 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
1465 'The horizontal distance spanned by maw well', imaw, &
1466 'connection', iconn,
'(', hlen, &
1467 ') is greater than the '//trim(extmsg)//
' of the '// &
1468 'connected cell (', extent, &
1469 '), so the screen extends beyond the cell it is connected '// &
1470 'to. '//trim(cndmsg)//
' Reduce ANGLE or CONN_LENGTH, or '// &
1471 'specify a separate connection to each cell the connection '// &
1480 if (cos(omega) <= coszero .and. &
1481 this%ieqn(imaw) /= 4 .and. this%ieqn(imaw) /= 0)
then
1482 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1483 'The (near) horizontal maw well', imaw,
'connection', iconn, &
1484 'uses a radial conductance equation (THIEM, SKIN, or '// &
1485 'CUMULATIVE). The calculated conductance is an approximation '// &
1486 'for horizontal connections; the MEAN conductance equation is '// &
1487 'recommended for horizontal connections.'
1491 if (cos(omega) <= coszero .and. &
1492 (this%ieqn(imaw) == 4 .or. this%ieqn(imaw) == 0))
then
1493 topexp = this%botscrn(jpos) +
dtwo * this%radius(imaw)
1494 if (
is_close(this%topscrn(jpos), topexp))
then
1495 this%topscrn(jpos) = topexp
1497 write (
warnmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1498 'The vertical screen extent (SCRN_TOP - SCRN_BOT) for the '// &
1499 '(near) horizontal maw well', imaw,
'connection', iconn, &
1500 'is not equal to the well diameter (2 * RADIUS = ', &
1501 dtwo * this%radius(imaw), &
1502 '). The vertical screen extent is used to determine the '// &
1503 'saturation of a connection and should equal the well '// &
1504 'diameter for a horizontal connection.'
1510 write (this%iout,
'(1x,a)') &
1511 'END OF '//trim(adjustl(this%text))//
' ANGLEDATA'
1514 deallocate (nboundchk)
1521 if (this%inonvert /= 0)
then
1523 'The NON_VERTICAL_WELLS option was specified but an ANGLEDATA '// &
1524 'block was not found. All multi-aquifer well connections will be '// &
1525 'treated as vertical.'
1541 real(dp),
intent(in) :: dz
1542 real(dp),
intent(in) :: radius
1543 real(dp),
intent(in) :: omega
1547 lw = (dz -
dtwo * radius * sin(omega)) / cos(omega)
1560 class(
mawtype),
intent(inout) :: this
1561 integer(I4B),
intent(in) :: node
1562 logical(LGP),
intent(out) :: estimated
1566 real(dp),
allocatable,
dimension(:, :) :: polyverts
1567 integer(I4B) :: nverts
1572 select case (this%dis%get_dis_enum())
1574 nverts = this%dis%get_npolyverts(node)
1577 estimated = nverts == 0
1579 extent = sqrt(
dtwo * this%dis%area(node))
1581 call this%dis%get_polyverts(node, polyverts)
1583 deallocate (polyverts)
1600 class(
mawtype),
intent(inout) :: this
1601 integer(I4B),
intent(in) :: i
1602 integer(I4B),
intent(in) :: jpos
1612 if (this%angle(jpos) ==
dzero .and. this%connlen(jpos) <=
dzero)
then
1617 dz = this%topscrn(jpos) - this%botscrn(jpos)
1618 if (dz <=
dzero)
then
1624 if (this%connlen(jpos) >
dzero)
then
1625 lw = this%connlen(jpos)
1627 omega = this%angle(jpos) *
dpio180
1641 class(
mawtype),
intent(inout) :: this
1643 character(len=LINELENGTH) :: title
1644 character(len=LINELENGTH) :: text
1645 integer(I4B) :: ntabcols
1649 integer(I4B) :: jpos
1650 integer(I4B) :: inode
1654 character(len=10),
dimension(0:4) :: ccond
1655 character(len=30) :: nodestr
1657 data ccond(0)/
'SPECIFIED '/
1658 data ccond(1)/
'THIEM '/
1659 data ccond(2)/
'SKIN '/
1660 data ccond(3)/
'CUMULATIVE'/
1661 data ccond(4)/
'MEAN '/
1663 character(len=*),
parameter :: fmtwelln = &
1664 "(1X,//43X,'MULTI-AQUIFER WELL DATA'&
1666 &/1X,7(A10,1X),A16)"
1667 character(len=*),
parameter :: fmtwelld = &
1668 &
"(1X,I10,1X,4(G10.3,1X),I10,1X,A10,1X,A16)"
1669 character(len=*),
parameter :: fmtline = &
1671 character(len=*),
parameter :: fmtwellcn = &
1672 "(1X,//37X,'MULTI-AQUIFER WELL CONNECTION DATA'&
1674 &/1X,2(A10,1X),A20,7(A10,1X))"
1675 character(len=*),
parameter :: fmtwellcd = &
1676 &
"(1X,2(I10,1X),A20,1X,2(G10.3,1X),2(A10,1X),3(G10.3,1X))"
1679 do n = 1, this%nmawwells
1680 this%xnewpak(n) = this%strt(n)
1681 this%xsto(n) = this%strt(n)
1685 do n = 1, this%nmawwells
1686 select case (this%status(n))
1688 this%iboundpak(n) = -1
1690 this%iboundpak(n) = 0
1692 this%iboundpak(n) = 1
1697 if (this%inamedbound /= 0)
then
1699 do n = 1, this%nmawwells
1700 do j = 1, this%ngwfnodes(n)
1702 this%boundname(idx) = this%cmawname(n)
1707 do n = 1, this%nmawwells
1708 this%cmawname(n) =
''
1713 call this%copy_boundname()
1723 call this%maw_check_attributes()
1726 do n = 1, this%nmawwells
1730 do j = 1, this%ngwfnodes(n)
1731 if (this%ieqn(n) /= 0)
then
1732 inode = this%get_gwfnode(n, j)
1733 call this%maw_calculate_satcond(n, j, inode)
1740 if (this%iprpak /= 0)
then
1742 if (this%inamedbound /= 0)
then
1743 ntabcols = ntabcols + 1
1745 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1746 trim(adjustl(this%packName))//
') STATIC WELL DATA'
1747 call table_cr(this%inputtab, this%packName, title)
1748 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1750 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1752 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1754 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1755 text =
'WELL BOTTOM'
1756 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1757 text =
'STARTING HEAD'
1758 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1759 text =
'NUMBER OF GWF NODES'
1760 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1761 text =
'CONDUCT. EQUATION'
1762 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1763 if (this%inamedbound /= 0)
then
1765 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1767 do n = 1, this%nmawwells
1768 call this%inputtab%add_term(n)
1769 call this%inputtab%add_term(this%radius(n))
1770 call this%inputtab%add_term(this%area(n))
1771 call this%inputtab%add_term(this%bot(n))
1772 call this%inputtab%add_term(this%strt(n))
1773 call this%inputtab%add_term(this%ngwfnodes(n))
1774 call this%inputtab%add_term(ccond(this%ieqn(n)))
1775 if (this%inamedbound /= 0)
then
1776 call this%inputtab%add_term(this%cmawname(n))
1782 if (this%iprpak /= 0)
then
1784 if (this%inonvert /= 0)
then
1785 ntabcols = ntabcols + 1
1787 title = trim(adjustl(this%text))//
' PACKAGE ('// &
1788 trim(adjustl(this%packName))//
') STATIC WELL CONNECTION DATA'
1789 call table_cr(this%inputtab, this%packName, title)
1790 call this%inputtab%table_df(this%maxbound, ntabcols, this%iout)
1792 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1793 text =
'WELL CONNECTION'
1794 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1796 call this%inputtab%initialize_column(text, 20, alignment=tableft)
1797 text =
'TOP OF SCREEN'
1798 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1799 text =
'BOTTOM OF SCREEN'
1800 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1801 text =
'SKIN RADIUS'
1802 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1804 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1806 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1808 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1809 text =
'SATURATED WELL CONDUCT.'
1810 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1811 if (this%inonvert /= 0)
then
1812 text =
'ANGLE (DEG)'
1813 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1817 do n = 1, this%nmawwells
1818 do j = 1, this%ngwfnodes(n)
1819 call this%inputtab%add_term(n)
1820 call this%inputtab%add_term(j)
1821 jpos = this%get_jpos(n, j)
1822 nn = this%get_gwfnode(n, j)
1823 call this%dis%noder_to_string(nn, nodestr)
1824 call this%inputtab%add_term(nodestr)
1825 call this%inputtab%add_term(this%topscrn(jpos))
1826 call this%inputtab%add_term(this%botscrn(jpos))
1827 if (this%ieqn(n) == 2 .or. &
1828 this%ieqn(n) == 3 .or. &
1829 this%ieqn(n) == 4)
then
1830 call this%inputtab%add_term(this%sradius(jpos))
1831 call this%inputtab%add_term(this%hk(jpos))
1833 call this%inputtab%add_term(
' ')
1834 call this%inputtab%add_term(
' ')
1836 if (this%ieqn(n) == 1 .or. &
1837 this%ieqn(n) == 2 .or. &
1838 this%ieqn(n) == 3)
then
1839 k11 = this%gwfk11(nn)
1840 if (this%gwfik22 == 0)
then
1841 k22 = this%gwfk11(nn)
1843 k22 = this%gwfk22(nn)
1845 call this%inputtab%add_term(k11)
1846 call this%inputtab%add_term(k22)
1848 call this%inputtab%add_term(
' ')
1849 call this%inputtab%add_term(
' ')
1851 call this%inputtab%add_term(this%satcond(jpos))
1852 if (this%inonvert /= 0)
then
1853 call this%inputtab%add_term(this%angle(jpos))
1860 this%gwfk11 => null()
1861 this%gwfk22 => null()
1862 this%gwfik22 => null()
1863 this%gwfsat => null()
1876 class(
mawtype),
intent(inout) :: this
1877 integer(I4B),
intent(in) :: imaw
1878 character(len=*),
intent(in) :: keyword
1879 character(len=*),
intent(in) :: msg
1883 if (len(msg) == 0)
then
1884 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1885 keyword,
' for MAW well', imaw,
'has already been set.'
1887 write (
errmsg,
'(a,1x,a,1x,i0,1x,a)') &
1888 keyword,
' for MAW well', imaw, msg
1900 class(
mawtype),
intent(inout) :: this
1901 integer(I4B),
intent(in) :: n
1902 integer(I4B),
intent(in) :: imaw
1903 character(len=*),
intent(in) :: setting
1905 select case (trim(setting))
1907 this%well_head_set(imaw) = .true.
1908 this%xnewpak(imaw) = this%well_head(imaw)
1917 class(
mawtype),
intent(inout) :: this
1919 character(len=LINELENGTH) :: cgwfnode
1923 integer(I4B) :: jpos
1927 do n = 1, this%nmawwells
1928 if (this%ngwfnodes(n) < 1)
then
1929 call this%maw_set_attribute_error(n,
'NGWFNODES',
'must be greater '// &
1932 if (this%radius(n) ==
dep20)
then
1933 call this%maw_set_attribute_error(n,
'RADIUS',
'has not been specified.')
1935 if (this%shutoffmin(n) >
dzero)
then
1936 if (this%shutoffmin(n) >= this%shutoffmax(n))
then
1937 call this%maw_set_attribute_error(n,
'SHUT_OFF',
'shutoffmax must '// &
1938 'be greater than shutoffmin.')
1941 do j = 1, this%ngwfnodes(n)
1944 jpos = this%get_jpos(n, j)
1947 write (cgwfnode,
'(a,i0,a)')
'gwfnode(', j,
')'
1950 if (this%botscrn(jpos) >= this%topscrn(jpos))
then
1951 call this%maw_set_attribute_error(n,
'SCREEN_TOP',
'screen bottom '// &
1952 'must be less than screen top. '// &
1957 if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
1958 this%ieqn(n) == 4)
then
1959 if (this%hk(jpos) <=
dzero)
then
1960 call this%maw_set_attribute_error(n,
'HK_SKIN',
'skin hyraulic '// &
1961 'conductivity must be greater '// &
1962 'than zero. '//trim(cgwfnode))
1964 else if (this%ieqn(n) == 0)
then
1967 if (this%satcond(jpos) <
dzero)
then
1968 call this%maw_set_attribute_error(n,
'HK_SKIN', &
1969 'skin hyraulic conductivity '// &
1970 'must be greater than or '// &
1971 'equal to zero when using '// &
1972 'SPECIFIED condeqn. '// &
1988 class(
mawtype),
intent(inout) :: this
1989 integer(I4B),
intent(in) :: moffset
1995 integer(I4B) :: jglo
1996 integer(I4B) :: nglo
2000 do n = 1, this%nmawwells
2001 nglo = moffset + this%dis%nodes + this%ioffset + n
2002 call sparse%addconnection(nglo, nglo, 1)
2003 do j = 1, this%ngwfnodes(n)
2004 jj = this%get_gwfnode(n, j)
2006 call sparse%addconnection(nglo, jglo, 1)
2007 call sparse%addconnection(jglo, nglo, 1)
2019 class(
mawtype),
intent(inout) :: this
2020 integer(I4B),
intent(in) :: moffset
2026 integer(I4B) :: iglo
2027 integer(I4B) :: jglo
2028 integer(I4B) :: ipos
2032 call mem_allocate(this%idxlocnode, this%nmawwells,
'IDXLOCNODE', &
2034 call mem_allocate(this%idxdglo, this%maxbound,
'IDXDGLO', this%memoryPath)
2035 call mem_allocate(this%idxoffdglo, this%maxbound,
'IDXOFFDGLO', &
2037 call mem_allocate(this%idxsymdglo, this%maxbound,
'IDXSYMDGLO', &
2039 call mem_allocate(this%idxsymoffdglo, this%maxbound,
'IDXSYMOFFDGLO', &
2047 do n = 1, this%nmawwells
2048 iglo = moffset + this%dis%nodes + this%ioffset + n
2049 this%idxlocnode(n) = this%dis%nodes + this%ioffset + n
2050 do ii = 1, this%ngwfnodes(n)
2051 j = this%get_gwfnode(n, ii)
2053 this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
2054 this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
2060 do n = 1, this%nmawwells
2061 do ii = 1, this%ngwfnodes(n)
2062 iglo = this%get_gwfnode(n, ii) + moffset
2063 jglo = moffset + this%dis%nodes + this%ioffset + n
2064 this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
2065 this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
2077 class(
mawtype),
intent(inout) :: this
2081 call this%obs%obs_ar()
2084 if (this%inewton > 0)
then
2085 this%satomega =
dem6
2089 call this%maw_allocate_arrays()
2092 call this%read_initial_attr()
2095 call this%input%init(this%input_mempath, this%naux)
2098 if (this%imover /= 0)
then
2099 allocate (this%pakmvrobj)
2100 call this%pakmvrobj%ar(this%nmawwells, this%nmawwells, this%memoryPath)
2115 class(
mawtype),
intent(inout) :: this
2117 character(len=LINELENGTH) :: title
2118 character(len=LINELENGTH) :: text
2119 character(len=LINELENGTH) :: csteady
2120 character(len=LINELENGTH) :: str
2121 real(DP) :: auxvaldbl
2122 character(len=LENVARNAME) :: setting
2123 character(len=LINELENGTH) :: cstr
2124 character(len=LINELENGTH) :: errmsgr
2125 integer(I4B) :: node
2127 integer(I4B) :: ntabcols
2128 integer(I4B) :: ntabrows
2129 integer(I4B) :: imaw
2130 integer(I4B) :: ibnd
2132 integer(I4B) :: jpos
2134 integer(I4B) :: istat
2135 integer(I4B) :: iheadlimit_warning
2137 character(len=*),
parameter :: fmtlsp = &
2138 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
2139 character(len=*),
parameter :: fmthdbot = &
2140 &
"('well head (',G0,') must be >= BOTTOM_ELEVATION (',G0, ').')"
2143 iheadlimit_warning = 0
2146 this%imawiss = this%gwfiss
2149 if (this%imawissopt == 1)
then
2154 this%nbound = this%maxbound
2157 if (this%iper ==
kper)
then
2160 if (this%iprpak /= 0)
then
2161 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2162 trim(adjustl(this%packName))//
') DATA FOR PERIOD'
2163 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2164 call table_cr(this%inputtab, this%packName, title)
2165 call this%inputtab%table_df(1, 5, this%iout, finalize=.false.)
2167 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2169 call this%inputtab%initialize_column(text, 20, alignment=tableft)
2171 write (text,
'(a,1x,i6)')
'VALUE', jj
2172 call this%inputtab%initialize_column(text, 15, alignment=tabcenter)
2178 do n = 1, this%input%nbound
2179 imaw = this%input%ifno(n)
2180 if (imaw < 1 .or. imaw > this%nmawwells)
then
2181 write (
errmsg,
'(2(a,1x),i0,a)') &
2182 'IMAW must be greater than 0 and', &
2183 'less than or equal to ', this%nmawwells,
'.'
2189 setting = this%input%setting(n)
2192 if (trim(setting) ==
'STATUS')
then
2193 str = this%input%status(n)
2194 this%status(imaw) = str(1:8)
2195 select case (trim(str))
2197 this%iboundpak(imaw) = -1
2199 this%iboundpak(imaw) = 0
2201 this%iboundpak(imaw) = 1
2204 'Unknown '//trim(this%text)//
" maw status keyword: '", &
2211 call this%maw_set_period_value(n, imaw, setting)
2212 if (trim(setting) ==
'WELL_HEAD')
then
2213 if (this%well_head(imaw) < this%bot(imaw))
then
2214 write (cstr, fmthdbot) this%well_head(imaw), this%bot(imaw)
2215 call this%maw_set_attribute_error(imaw,
'WELL HEAD', trim(cstr))
2220 if (trim(setting) ==
'HEAD_LIMIT')
then
2221 str = this%input%head_limit(n)
2222 if (trim(str) ==
'OFF')
then
2223 this%shutofflevel(imaw) = dep20
2225 read (str, *, iostat=istat, iomsg=errmsgr) &
2226 this%shutofflevel(imaw)
2227 if (istat /= 0)
then
2228 errmsg =
'Could not read HEAD_LIMIT value. '//trim(errmsgr)
2231 if (this%shutofflevel(imaw) <= this%bot(imaw))
then
2232 iheadlimit_warning = iheadlimit_warning + 1
2238 if (trim(setting) ==
'FLOWING_WELL')
then
2239 this%fwelev(imaw) = this%input%fwelev(n)
2240 this%fwcond(imaw) = this%input%fwcond(n)
2241 this%fwrlen(imaw) = this%input%fwrlen(n)
2242 if (this%iflowingwells == 0)
then
2243 this%iflowingwells = -1
2244 text =
'Flowing well data is specified in the '// &
2245 trim(this%packName)//
' package but FLOWING_WELL was'// &
2246 ' not specified in the OPTIONS block.'
2247 call store_warning(text)
2252 if (trim(setting) ==
'SHUT_OFF')
then
2253 this%shutoffmin(imaw) = this%input%minrate(n)
2254 this%shutoffmax(imaw) = this%input%maxrate(n)
2258 if (trim(setting) ==
'RATE_SCALING')
then
2259 this%pumpelev(imaw) = this%input%pump_elevation(n)
2260 this%reduction_length(imaw) = this%input%scaling_length(n)
2261 if (this%reduction_length(imaw) < dzero)
then
2262 call this%maw_set_attribute_error(imaw,
'RATE_SCALING', &
2263 &
'must be greater than or equal to 0.')
2269 if (this%naux > 0)
then
2270 if (trim(setting) ==
'PERIOD_AUXILIARY')
then
2271 str = this%input%auxname(n)
2272 auxvaldbl = this%input%auxval(n)
2277 if (this%iprpak /= 0)
then
2278 call this%inputtab%add_term(imaw)
2279 if (trim(setting) ==
'PERIOD_AUXILIARY')
then
2280 call this%inputtab%add_term(
'AUXILIARY')
2282 call this%inputtab%add_term(trim(setting))
2284 select case (trim(setting))
2286 call this%inputtab%add_term(trim(str))
2287 call this%inputtab%add_term(
' ')
2288 call this%inputtab%add_term(
' ')
2290 call this%inputtab%add_term(this%rate(imaw))
2291 call this%inputtab%add_term(
' ')
2292 call this%inputtab%add_term(
' ')
2294 call this%inputtab%add_term(this%well_head(imaw))
2295 call this%inputtab%add_term(
' ')
2296 call this%inputtab%add_term(
' ')
2298 call this%inputtab%add_term(trim(str))
2299 call this%inputtab%add_term(
' ')
2300 call this%inputtab%add_term(
' ')
2301 case (
'FLOWING_WELL')
2302 call this%inputtab%add_term(this%fwelev(imaw))
2303 call this%inputtab%add_term(this%fwcond(imaw))
2304 call this%inputtab%add_term(this%fwrlen(imaw))
2306 call this%inputtab%add_term(this%shutoffmin(imaw))
2307 call this%inputtab%add_term(this%shutoffmax(imaw))
2308 call this%inputtab%add_term(
' ')
2309 case (
'RATE_SCALING')
2310 call this%inputtab%add_term(this%pumpelev(imaw))
2311 call this%inputtab%add_term(this%reduction_length(imaw))
2312 call this%inputtab%add_term(
' ')
2313 case (
'PERIOD_AUXILIARY')
2314 call this%inputtab%add_term(trim(str))
2315 call this%inputtab%add_term(auxvaldbl)
2316 call this%inputtab%add_term(
' ')
2318 call this%inputtab%add_term(
' ')
2319 call this%inputtab%add_term(
' ')
2320 call this%inputtab%add_term(
' ')
2324 if (this%iprpak /= 0)
then
2325 call this%inputtab%finalize_table()
2330 write (this%iout, fmtlsp) trim(this%filtyp)
2334 if (iheadlimit_warning > 0)
then
2335 write (
warnmsg,
'(a,a,a,1x,a,1x,a)') &
2336 "HEAD_LIMIT in '", trim(this%packName),
"' was below the well bottom", &
2337 "for one or more multi-aquifer well(s). This may result in", &
2338 "convergence failures for some models."
2343 if (count_errors() > 0)
then
2348 if (this%check_attr /= 0)
then
2349 call this%maw_check_attributes()
2352 if (this%iprpak == 1)
then
2353 if (this%imawiss /= 0)
then
2354 csteady =
'STEADY-STATE '
2356 csteady =
'TRANSIENT '
2360 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2361 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2362 ' RATE DATA FOR PERIOD'
2363 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2365 call table_cr(this%inputtab, this%packName, title)
2366 call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
2368 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2370 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2372 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2373 text =
'SPECIFIED HEAD'
2374 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2375 text =
'PUMP ELEVATION'
2376 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2377 text =
'REDUCTION LENGTH'
2378 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2379 do n = 1, this%nmawwells
2380 call this%inputtab%add_term(n)
2381 call this%inputtab%add_term(this%status(n))
2382 call this%inputtab%add_term(this%rate(n))
2383 if (this%iboundpak(n) < 0)
then
2384 call this%inputtab%add_term(this%well_head(n))
2386 call this%inputtab%add_term(
' ')
2388 call this%inputtab%add_term(this%pumpelev(n))
2389 if (this%reduction_length(n) /= dep20)
then
2390 call this%inputtab%add_term(this%reduction_length(n))
2392 call this%inputtab%add_term(
' ')
2397 if (this%iflowingwells > 0)
then
2400 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2401 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2402 ' FLOWING WELL DATA FOR PERIOD'
2403 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2406 do n = 1, this%nmawwells
2407 if (this%fwcond(n) > dzero)
then
2408 ntabrows = ntabrows + 1
2411 if (ntabrows > 0)
then
2412 call table_cr(this%inputtab, this%packName, title)
2413 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2415 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2417 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2419 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2420 text =
'REDUCTION LENGTH'
2421 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2422 do n = 1, this%nmawwells
2423 if (this%fwcond(n) > dzero)
then
2424 call this%inputtab%add_term(n)
2425 call this%inputtab%add_term(this%fwelev(n))
2426 call this%inputtab%add_term(this%fwcond(n))
2427 call this%inputtab%add_term(this%fwrlen(n))
2434 title = trim(adjustl(this%text))//
' PACKAGE ('// &
2435 trim(adjustl(this%packName))//
') '//trim(adjustl(csteady))// &
2436 ' WELL SHUTOFF DATA FOR PERIOD'
2437 write (title,
'(a,1x,i6)') trim(adjustl(title)),
kper
2440 do n = 1, this%nmawwells
2441 if (this%shutofflevel(n) /= dep20)
then
2442 ntabrows = ntabrows + 1
2445 if (ntabrows > 0)
then
2446 call table_cr(this%inputtab, this%packName, title)
2447 call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2449 call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2451 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2453 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2455 call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2456 do n = 1, this%nmawwells
2457 if (this%shutofflevel(n) /= dep20)
then
2458 call this%inputtab%add_term(n)
2459 call this%inputtab%add_term(this%shutofflevel(n))
2460 call this%inputtab%add_term(this%shutoffmin(n))
2461 call this%inputtab%add_term(this%shutoffmax(n))
2470 do n = 1, this%nmawwells
2471 do j = 1, this%ngwfnodes(n)
2472 jpos = this%get_jpos(n, j)
2473 node = this%get_gwfnode(n, j)
2474 this%nodelist(ibnd) = node
2475 this%bound(1, ibnd) = this%xnewpak(n)
2476 this%bound(2, ibnd) = this%satcond(jpos)
2477 this%bound(3, ibnd) = this%botscrn(jpos)
2478 if (this%iboundpak(n) > 0)
then
2479 this%bound(4, ibnd) = this%rate(n)
2481 this%bound(4, ibnd) = dzero
2500 integer(I4B) :: ibnd
2501 integer(I4B) :: imaw
2502 character(len=LENVARNAME) :: setting
2506 call this%BndExtType%bnd_ad()
2509 if (this%ts_active .and. this%input%nbound > 0)
then
2510 do n = 1, this%input%nbound
2511 imaw = this%input%ifno(n)
2512 if (imaw < 1 .or. imaw > this%nmawwells) cycle
2513 setting = this%input%setting(n)
2514 call this%maw_set_period_value(n, imaw, setting)
2519 if (this%naux > 0)
then
2521 do n = 1, this%nmawwells
2522 do j = 1, this%ngwfnodes(n)
2523 do jj = 1, this%naux
2524 if (this%noupdateauxvar(jj) /= 0) cycle
2525 this%auxvar(jj, ibnd) = this%featureauxvar(jj, n)
2534 do i = 1, this%nmawwells
2535 n = this%pkg_ifno(i)
2536 this%xoldpak(n) = this%xnewpak(n)
2537 this%xoldsto(n) = this%xsto(n)
2538 if (this%iboundpak(n) < 0)
then
2539 if (.not. this%well_head_set(n) .and. &
2540 this%input%strt_tslink(i) /= 0)
then
2541 this%well_head(n) = this%input%strt(i)
2543 this%xnewpak(n) = this%well_head(n)
2549 this%nurdxold(n) = dzero
2550 this%nurweight(n) = done
2555 if (
kper == 1 .and.
kstp == 1)
then
2556 do n = 1, this%nmawwells
2557 if (this%fwcond(n) > dzero)
then
2558 if (this%xoldsto(n) > this%fwelev(n))
then
2559 this%xoldsto(n) = this%fwelev(n)
2566 this%ishutoffcnt = 0
2569 if (this%imover == 1)
then
2570 call this%pakmvrobj%ad()
2584 call this%maw_cfupdate()
2589 subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln)
2594 real(DP),
dimension(:),
intent(inout) :: rhs
2595 integer(I4B),
dimension(:),
intent(in) :: ia
2596 integer(I4B),
dimension(:),
intent(in) :: idxglo
2602 integer(I4B) :: iloc
2603 integer(I4B) :: isymloc
2604 integer(I4B) :: igwfnode
2605 integer(I4B) :: iposd
2606 integer(I4B) :: iposoffd
2607 integer(I4B) :: isymnode
2608 integer(I4B) :: ipossymd
2609 integer(I4B) :: ipossymoffd
2610 integer(I4B) :: jpos
2611 integer(I4B) :: icflow
2630 if (this%imover == 1)
then
2631 call this%pakmvrobj%fc()
2636 do n = 1, this%nmawwells
2637 iloc = this%idxlocnode(n)
2641 this%qsim0(n) = this%ratesim(n)
2644 if (this%iboundpak(n) < 0)
then
2645 this%xnewpak(n) = this%well_head(n)
2647 hmaw = this%xnewpak(n)
2650 if (this%iboundpak(n) == 0)
then
2651 this%ratesim(n) =
dzero
2653 call this%maw_calculate_wellq(n, hmaw, rate)
2654 this%ratesim(n) = rate
2655 rhs(iloc) = rhs(iloc) - rate
2658 iposd = this%idxdglo(idx)
2663 if (this%iflowingwells > 0)
then
2664 if (this%fwcond(n) >
dzero)
then
2666 tp = bt + this%fwrlen(n)
2668 cfw = scale * this%fwcond(n)
2669 this%ifwdischarge(n) = 0
2670 if (cfw >
dzero)
then
2671 this%ifwdischarge(n) = 1
2674 this%fwcondsim(n) = cfw
2675 call matrix_sln%add_value_pos(iposd, -cfw)
2676 rhs(iloc) = rhs(iloc) - cfw * bt
2677 ratefw = cfw * (bt - hmaw)
2682 if (this%imawiss /= 1)
then
2683 if (this%ifwdischarge(n) /= 1)
then
2690 tled = this%area(n) /
delt
2693 ssold =
squadratic0sp(this%xoldsto(n), this%bot(n), this%satomega)
2694 call matrix_sln%add_value_pos(iposd, -tled * sd)
2695 rhs(iloc) = rhs(iloc) - tled * (sd * hmaw - ss + ssold)
2697 cterm = this%xoldsto(n) - this%fwelev(n)
2698 rhs(iloc) = rhs(iloc) - (this%area(n) * cterm /
delt)
2704 if (this%imover == 1)
then
2705 rhs(iloc) = rhs(iloc) - this%pakmvrobj%get_qfrommvr(n)
2709 call this%pakmvrobj%accumulate_qformvr(n, -rate)
2713 call this%pakmvrobj%accumulate_qformvr(n, -ratefw)
2719 do j = 1, this%ngwfnodes(n)
2720 if (this%iboundpak(n) /= 0)
then
2721 jpos = this%get_jpos(n, j)
2722 igwfnode = this%get_gwfnode(n, j)
2723 hgwf = this%xnew(igwfnode)
2726 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2728 this%simcond(jpos) = cmaw
2731 iposd = this%idxdglo(idx)
2732 iposoffd = this%idxoffdglo(idx)
2733 call matrix_sln%add_value_pos(iposd, -term)
2734 call matrix_sln%set_value_pos(iposoffd, term)
2737 rhs(iloc) = rhs(iloc) - cterm
2740 isymnode = this%get_gwfnode(n, j)
2741 isymloc = ia(isymnode)
2742 ipossymd = this%idxsymdglo(idx)
2743 ipossymoffd = this%idxsymoffdglo(idx)
2744 call matrix_sln%add_value_pos(ipossymd, -term)
2745 call matrix_sln%set_value_pos(ipossymoffd, term)
2748 rhs(isymnode) = rhs(isymnode) + cterm
2759 subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln)
2762 real(DP),
dimension(:),
intent(inout) :: rhs
2763 integer(I4B),
dimension(:),
intent(in) :: ia
2764 integer(I4B),
dimension(:),
intent(in) :: idxglo
2770 integer(I4B) :: iloc
2771 integer(I4B) :: isymloc
2772 integer(I4B) :: igwfnode
2773 integer(I4B) :: iposd
2774 integer(I4B) :: iposoffd
2775 integer(I4B) :: isymnode
2776 integer(I4B) :: ipossymd
2777 integer(I4B) :: ipossymoffd
2778 integer(I4B) :: jpos
2779 integer(I4B) :: icflow
2800 do n = 1, this%nmawwells
2801 iloc = this%idxlocnode(n)
2802 hmaw = this%xnewpak(n)
2805 if (this%iboundpak(n) /= 0)
then
2806 iposd = this%idxdglo(idx)
2809 rate = this%ratesim(n)
2812 call this%maw_calculate_wellq(n, hmaw +
dem4, rate2)
2813 drterm = (rate2 - rate) /
dem4
2816 call matrix_sln%add_value_pos(iposd, drterm)
2817 rhs(iloc) = rhs(iloc) + drterm * hmaw
2820 if (this%iflowingwells > 0)
then
2821 if (this%fwcond(n) >
dzero)
then
2823 tp = bt + this%fwrlen(n)
2825 cfw = scale * this%fwcond(n)
2826 this%ifwdischarge(n) = 0
2827 if (cfw >
dzero)
then
2828 this%ifwdischarge(n) = 1
2830 this%fwcondsim(n) = cfw
2831 rate = cfw * (bt - hmaw)
2837 drterm = -(cfw + this%fwcond(n) * derv * (hmaw - bt))
2840 call matrix_sln%add_value_pos(iposd, &
2841 -this%fwcond(n) * derv * (hmaw - bt))
2842 rhs(iloc) = rhs(iloc) - rterm + drterm * hmaw
2849 do j = 1, this%ngwfnodes(n)
2850 if (this%iboundpak(n) /= 0)
then
2851 jpos = this%get_jpos(n, j)
2852 igwfnode = this%get_gwfnode(n, j)
2853 hgwf = this%xnew(igwfnode)
2856 iposd = this%idxdglo(idx)
2857 iposoffd = this%idxoffdglo(idx)
2860 isymnode = this%get_gwfnode(n, j)
2861 isymloc = ia(isymnode)
2862 ipossymd = this%idxsymdglo(idx)
2863 ipossymoffd = this%idxsymoffdglo(idx)
2866 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2870 if (hmaw > hgwf)
then
2871 if (icflow /= 0)
then
2872 rhsterm = term2 * hgwf + term * hmaw
2873 rhs(iloc) = rhs(iloc) + rhsterm
2874 rhs(isymnode) = rhs(isymnode) - rhsterm
2875 if (this%iboundpak(n) > 0)
then
2876 call matrix_sln%add_value_pos(iposd, term)
2877 call matrix_sln%add_value_pos(iposoffd, term2)
2879 call matrix_sln%add_value_pos(ipossymd, -term2)
2880 call matrix_sln%add_value_pos(ipossymoffd, -term)
2882 rhs(iloc) = rhs(iloc) + term * hmaw
2883 rhs(isymnode) = rhs(isymnode) - term * hmaw
2884 call matrix_sln%add_value_pos(iposd, term)
2885 if (this%ibound(igwfnode) > 0)
then
2886 call matrix_sln%add_value_pos(ipossymoffd, -term)
2892 if (icflow /= 0)
then
2893 rhsterm = term2 * hmaw + term * hgwf
2894 rhs(iloc) = rhs(iloc) + rhsterm
2895 rhs(isymnode) = rhs(isymnode) - rhsterm
2896 if (this%iboundpak(n) > 0)
then
2897 call matrix_sln%add_value_pos(iposd, term2)
2898 call matrix_sln%add_value_pos(iposoffd, term)
2900 call matrix_sln%add_value_pos(ipossymd, -term)
2901 call matrix_sln%add_value_pos(ipossymoffd, -term2)
2903 rhs(iloc) = rhs(iloc) + term * hgwf
2904 rhs(isymnode) = rhs(isymnode) - term * hgwf
2905 if (this%iboundpak(n) > 0)
then
2906 call matrix_sln%add_value_pos(iposoffd, term)
2908 call matrix_sln%add_value_pos(ipossymd, -term)
2931 subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
2933 class(
mawtype),
intent(inout) :: this
2934 integer(I4B),
intent(in) :: neqpak
2935 real(DP),
dimension(neqpak),
intent(inout) :: x
2936 real(DP),
dimension(neqpak),
intent(in) :: xtemp
2937 real(DP),
dimension(neqpak),
intent(inout) :: dx
2938 integer(I4B),
intent(inout) :: inewtonur
2939 real(DP),
intent(inout) :: dxmax
2940 integer(I4B),
intent(inout) :: locmax
2949 real(DP),
parameter :: damptheta =
dp7
2950 real(DP),
parameter :: damptol =
dhalf
2951 real(DP),
parameter :: weightmin =
dem2
2952 real(DP),
parameter :: recover = 0.2_dp
2955 do n = 1, this%nmawwells
2956 if (this%iboundpak(n) < 1) cycle
2960 dxprop = x(n) - xtemp(n)
2968 weight =
maw_damp_weight(dxprop, this%nurdxold(n), this%nurweight(n), &
2969 damptheta, damptol, weightmin, recover)
2970 this%nurweight(n) = weight
2973 if (weight <
done)
then
2975 xx = xtemp(n) + weight * dxprop
2977 if (abs(dxx) > abs(dxmax))
then
2982 dx(n) = weight * dxprop
2987 if (x(n) < botw)
then
2991 if (abs(dxx) > abs(dxmax))
then
3003 this%nurdxold(n) = x(n) - xtemp(n)
3016 weightmin, recover)
result(new_weight)
3018 real(dp),
intent(in) :: dxprop
3019 real(dp),
intent(in) :: dxold
3020 real(dp),
intent(in) :: weight
3021 real(dp),
intent(in) :: damptheta
3022 real(dp),
intent(in) :: damptol
3023 real(dp),
intent(in) :: weightmin
3024 real(dp),
intent(in) :: recover
3026 real(dp) :: new_weight
3028 if (dxprop * dxold <
dzero .and. abs(dxprop) > damptol * abs(dxold))
then
3029 new_weight = max(damptheta * weight, weightmin)
3031 new_weight = min(weight + recover,
done)
3046 subroutine maw_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
3050 class(
mawtype),
intent(inout) :: this
3051 integer(I4B),
intent(in) :: innertot
3052 integer(I4B),
intent(in) :: kiter
3053 integer(I4B),
intent(in) :: iend
3054 integer(I4B),
intent(in) :: icnvgmod
3055 character(len=LENPAKLOC),
intent(inout) :: cpak
3056 integer(I4B),
intent(inout) :: ipak
3057 real(DP),
intent(inout) :: dpak
3061 integer(I4B) :: jpos
3062 integer(I4B) :: igwfnode
3063 integer(I4B) :: locdpak
3072 real(DP) :: qtolfact
3075 character(len=LENPAKLOC) :: cloc
3077 real(DP),
parameter :: qtol = 1.001_dp
3079 character(len=*),
parameter :: fmtwarn = &
3080 "('MAW well ', a, ' requests an extraction rate (', g0.5, &
3081 &') larger than the maximum rate (', g0.5, ') the aquifer can supply &
3082 &with the well head at its bottom. This may be preventing convergence. &
3083 &Consider reducing the requested rate, applying or widening RATE_SCALING, &
3084 &or reviewing the connection conductance (e.g. aquifer K).')"
3094 do n = 1, this%nmawwells
3095 if (this%iboundpak(n) < 1) cycle
3096 if (this%nurweight(n) >=
done) cycle
3097 if (this%area(n) >
dzero)
then
3098 qtolfact =
delt / this%area(n)
3109 dq = (this%qsim0(n) - this%ratesim(n)) * qtolfact
3110 if (abs(dq) > abs(dpakmax))
then
3115 if (locdpak > 0 .and. abs(dpakmax) > abs(dpak))
then
3118 write (cloc,
"(a,'-',a)") trim(this%packName),
'rate'
3124 if (iend == 0)
return
3125 if (icnvgmod /= 0)
return
3128 do n = 1, this%nmawwells
3129 if (this%iboundpak(n) < 1) cycle
3130 if (this%rate(n) >=
dzero) cycle
3136 do j = 1, this%ngwfnodes(n)
3137 jpos = this%get_jpos(n, j)
3138 igwfnode = this%get_gwfnode(n, j)
3139 hgwf = this%xnew(igwfnode)
3140 bmaw = this%botscrn(jpos)
3141 hv = max(botw, bmaw)
3146 call this%maw_calculate_saturation(n, j, igwfnode, sat, hv)
3147 cmaw = this%satcond(jpos) * sat
3152 qmax = qmax + cmaw * max(hgwf - hv,
dzero)
3156 qreq = -this%rate(n)
3157 if (qmax >=
dzero .and. qreq > qtol * qmax)
then
3158 write (cloc,
'(a, a, a, a, i0, a, i0, a)') trim(this%name_model),
'-(', &
3159 trim(this%filtyp),
'_', this%ibcnum,
'-', n,
')'
3160 write (
warnmsg, fmtwarn) trim(cloc), qreq, qmax
3174 class(
mawtype),
intent(inout) :: this
3175 real(DP),
dimension(:),
intent(in) :: x
3176 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
3177 integer(I4B),
optional,
intent(in) :: iadv
3185 integer(I4B) :: ibnd
3193 call this%maw_cfupdate()
3197 call this%BndType%bnd_cq(x, flowja, iadv=1)
3200 do n = 1, this%nmawwells
3201 this%qout(n) = dzero
3202 this%qsto(n) = dzero
3203 if (this%iflowingwells > 0)
then
3206 if (this%iboundpak(n) == 0)
then
3211 hmaw = this%xnewpak(n)
3215 rrate = this%ratesim(n)
3218 if (rrate < dzero)
then
3219 this%qout(n) = rrate
3223 if (this%iflowingwells > 0)
then
3224 if (this%fwcond(n) > dzero)
then
3225 cfw = this%fwcondsim(n)
3229 if (this%ifwdischarge(n) == 1)
then
3230 this%xsto(n) = this%fwelev(n)
3232 rrate = cfw * (this%fwelev(n) - hmaw)
3236 this%qout(n) = this%qout(n) + rrate
3246 if (this%imawiss /= 1)
then
3247 if (this%iflowingwells > 0 .and. this%ifwdischarge(n) == 1)
then
3248 rrate = -this%area(n) * (this%xsto(n) - this%xoldsto(n)) /
delt
3251 ssold =
squadratic0sp(this%xoldsto(n), this%bot(n), this%satomega)
3252 rrate = -this%area(n) * (ss - ssold) /
delt
3254 this%qsto(n) = rrate
3260 do n = 1, this%nmawwells
3261 hmaw = this%xnewpak(n)
3262 this%qconst(n) = dzero
3263 do j = 1, this%ngwfnodes(n)
3264 rrate = -this%simvals(ibnd)
3265 this%qleak(ibnd) = rrate
3266 if (this%iboundpak(n) < 0)
then
3267 this%qconst(n) = this%qconst(n) - rrate
3270 if (-rrate < dzero)
then
3271 this%qout(n) = this%qout(n) - rrate
3280 if (this%iboundpak(n) < 0)
then
3283 this%qconst(n) = this%qconst(n) - this%ratesim(n)
3286 if (this%iflowingwells > 0)
then
3287 this%qconst(n) = this%qconst(n) - this%qfw(n)
3291 if (this%imawiss /= 1)
then
3292 this%qconst(n) = this%qconst(n) - this%qsto(n)
3298 call this%maw_fill_budobj()
3306 integer(I4B),
intent(in) :: icbcfl
3307 integer(I4B),
intent(in) :: ibudfl
3308 integer(I4B),
intent(in) :: icbcun
3309 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
3312 call this%BndType%bnd_ot_model_flows(icbcfl, ibudfl, icbcun, this%imap)
3320 integer(I4B),
intent(in) :: icbcfl
3321 integer(I4B),
intent(in) :: ibudfl
3322 integer(I4B) :: ibinun
3326 if (this%ibudgetout /= 0)
then
3327 ibinun = this%ibudgetout
3329 if (icbcfl == 0) ibinun = 0
3330 if (ibinun > 0)
then
3331 call this%budobj%save_flows(this%dis, ibinun,
kstp,
kper,
delt, &
3336 if (ibudfl /= 0 .and. this%iprflow /= 0)
then
3337 call this%budobj%write_flowtable(this%dis,
kstp,
kper)
3348 integer(I4B),
intent(in) :: idvsave
3349 integer(I4B),
intent(in) :: idvprint
3350 integer(I4B) :: ibinun
3357 if (this%iheadout /= 0)
then
3358 ibinun = this%iheadout
3360 if (idvsave == 0) ibinun = 0
3363 if (ibinun > 0)
then
3364 do n = 1, this%nmawwells
3367 if (this%iboundpak(n) == 0)
then
3369 else if (d <= dzero)
then
3374 call ulasav(this%dbuff,
' HEAD', &
3376 this%nmawwells, 1, 1, ibinun)
3380 if (idvprint /= 0 .and. this%iprhed /= 0)
then
3383 call this%headtab%set_kstpkper(
kstp,
kper)
3386 do n = 1, this%nmawwells
3387 if (this%inamedbound == 1)
then
3388 call this%headtab%add_term(this%cmawname(n))
3390 call this%headtab%add_term(n)
3391 call this%headtab%add_term(this%xnewpak(n))
3403 integer(I4B),
intent(in) :: kstp
3404 integer(I4B),
intent(in) :: kper
3405 integer(I4B),
intent(in) :: iout
3406 integer(I4B),
intent(in) :: ibudfl
3408 call this%budobj%write_budtable(kstp, kper, iout, ibudfl,
totim,
delt)
3421 call this%budobj%budgetobject_da()
3422 deallocate (this%budobj)
3423 nullify (this%budobj)
3426 if (this%iprhed > 0)
then
3427 call this%headtab%table_da()
3428 deallocate (this%headtab)
3429 nullify (this%headtab)
3433 call mem_deallocate(this%cmawbudget,
'CMAWBUDGET', this%memoryPath)
3467 nullify (this%well_head)
3529 nullify (this%gwfiss)
3532 call this%input%destroy()
3535 call this%BndExtType%bnd_da()
3542 class(
mawtype),
intent(inout) :: this
3545 this%listlabel = trim(this%filtyp)//
' NO.'
3546 if (this%dis%ndim == 3)
then
3547 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
3548 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'ROW'
3549 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'COL'
3550 elseif (this%dis%ndim == 2)
then
3551 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'LAYER'
3552 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'CELL2D'
3554 write (this%listlabel,
'(a, a7)') trim(this%listlabel),
'NODE'
3556 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'STRESS RATE'
3557 if (this%inamedbound == 1)
then
3558 write (this%listlabel,
'(a, a16)') trim(this%listlabel),
'BOUNDARY NAME'
3570 integer(I4B),
pointer :: neq
3571 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
3572 real(DP),
dimension(:),
pointer,
contiguous :: xnew
3573 real(DP),
dimension(:),
pointer,
contiguous :: xold
3574 real(DP),
dimension(:),
pointer,
contiguous :: flowja
3577 integer(I4B) :: istart, iend
3580 call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja)
3585 istart = this%dis%nodes + this%ioffset + 1
3586 iend = istart + this%nmawwells - 1
3587 this%iboundpak => this%ibound(istart:iend)
3588 this%xnewpak => this%xnew(istart:iend)
3589 call mem_checkin(this%xnewpak,
'HEAD', this%memoryPath,
'X', &
3590 this%memoryPathModel)
3591 call mem_allocate(this%xoldpak, this%nmawwells,
'XOLDPAK', this%memoryPath)
3594 do n = 1, this%nmawwells
3595 this%xnewpak(n) =
dep20
3619 integer(I4B) :: indx
3623 call this%obs%StoreObsType(
'head', .false., indx)
3628 call this%obs%StoreObsType(
'from-mvr', .false., indx)
3633 call this%obs%StoreObsType(
'maw', .true., indx)
3638 call this%obs%StoreObsType(
'rate', .true., indx)
3643 call this%obs%StoreObsType(
'rate-to-mvr', .true., indx)
3648 call this%obs%StoreObsType(
'fw-rate', .true., indx)
3653 call this%obs%StoreObsType(
'fw-to-mvr', .true., indx)
3658 call this%obs%StoreObsType(
'storage', .true., indx)
3663 call this%obs%StoreObsType(
'constant', .true., indx)
3668 call this%obs%StoreObsType(
'conductance', .true., indx)
3673 call this%obs%StoreObsType(
'fw-conductance', .true., indx)
3689 integer(I4B) :: jpos
3697 if (this%obs%npakobs > 0)
then
3698 call this%obs%obs_bd_clear()
3699 do i = 1, this%obs%npakobs
3700 obsrv => this%obs%pakobs(i)%obsrv
3701 do j = 1, obsrv%indxbnds_count
3703 jj = obsrv%indxbnds(j)
3704 select case (obsrv%ObsTypeId)
3706 if (this%iboundpak(jj) /= 0)
then
3707 v = this%xnewpak(jj)
3710 if (this%iboundpak(jj) /= 0)
then
3711 if (this%imover == 1)
then
3712 v = this%pakmvrobj%get_qfrommvr(jj)
3717 if (this%iboundpak(n) /= 0)
then
3721 if (this%iboundpak(jj) /= 0)
then
3722 v = this%ratesim(jj)
3723 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3724 qfact = v / this%qout(jj)
3725 if (this%imover == 1)
then
3726 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3730 case (
'RATE-TO-MVR')
3731 if (this%iboundpak(jj) /= 0)
then
3732 if (this%imover == 1)
then
3733 v = this%ratesim(jj)
3735 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3736 qfact = v / this%qout(jj)
3738 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3745 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3746 hmaw = this%xnewpak(jj)
3747 cmaw = this%fwcondsim(jj)
3748 v = cmaw * (this%fwelev(jj) - hmaw)
3749 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3750 qfact = v / this%qout(jj)
3751 if (this%imover == 1)
then
3752 v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3757 if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0)
then
3758 if (this%imover == 1)
then
3759 hmaw = this%xnewpak(jj)
3760 cmaw = this%fwcondsim(jj)
3761 v = cmaw * (this%fwelev(jj) - hmaw)
3763 if (v <
dzero .and. this%qout(jj) <
dzero)
then
3764 qfact = v / this%qout(jj)
3766 v = this%pakmvrobj%get_qtomvr(jj) * qfact
3773 if (this%iboundpak(jj) /= 0 .and. this%imawissopt /= 1)
then
3777 if (this%iboundpak(jj) /= 0)
then
3780 case (
'CONDUCTANCE')
3782 if (this%iboundpak(n) /= 0)
then
3783 nn = jj - this%iaconn(n) + 1
3784 jpos = this%get_jpos(n, nn)
3785 v = this%simcond(jpos)
3787 case (
'FW-CONDUCTANCE')
3788 if (this%iboundpak(jj) /= 0)
then
3789 v = this%fwcondsim(jj)
3792 errmsg =
'Unrecognized observation type: '//trim(obsrv%ObsTypeId)
3795 call this%obs%SaveOneSimval(obsrv, v)
3806 if (this%ioutredflowcsv > 0)
then
3807 call this%maw_redflow_csv_write()
3819 class(
mawtype),
intent(inout) :: this
3827 character(len=LENBOUNDNAME) :: bname
3831 10
format(
'Boundary "', a,
'" for observation "', a, &
3832 '" is invalid in package "', a,
'"')
3835 do i = 1, this%obs%npakobs
3836 obsrv => this%obs%pakobs(i)%obsrv
3839 nn1 = obsrv%NodeNumber
3841 bname = obsrv%FeatureName
3842 if (bname /=
'')
then
3847 if (obsrv%ObsTypeId ==
'MAW' .or. &
3848 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3849 if (this%inamedbound /= 0)
then
3850 do j = 1, this%nmawwells
3851 do jj = this%iaconn(j), this%iaconn(j + 1) - 1
3852 if (this%boundname(jj) == bname)
then
3854 call obsrv%AddObsIndex(jj)
3860 do j = 1, this%nmawwells
3861 if (this%cmawname(j) == bname)
then
3863 call obsrv%AddObsIndex(j)
3867 if (.not. jfound)
then
3869 trim(bname), trim(obsrv%Name), trim(this%packName)
3874 if (obsrv%indxbnds_count == 0)
then
3875 if (obsrv%ObsTypeId ==
'MAW' .or. &
3876 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3877 nn2 = obsrv%NodeNumber2
3878 j = this%iaconn(nn1) + nn2 - 1
3879 call obsrv%AddObsIndex(j)
3881 call obsrv%AddObsIndex(nn1)
3884 errmsg =
'Programming error in maw_rp_obs'
3891 if (obsrv%ObsTypeId ==
'HEAD')
then
3892 if (obsrv%indxbnds_count > 1)
then
3893 write (
errmsg,
'(a,3(1x,a))') &
3894 trim(adjustl(obsrv%ObsTypeId)), &
3895 'for observation', trim(adjustl(obsrv%Name)), &
3896 'must be assigned to a multi-aquifer well with a unique boundname.'
3902 if (obsrv%ObsTypeId ==
'MAW' .or. &
3903 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3904 do j = 1, obsrv%indxbnds_count
3905 nn1 = obsrv%indxbnds(j)
3907 nn2 = nn1 - this%iaconn(n) + 1
3908 jj = this%iaconn(n + 1) - this%iaconn(n)
3909 if (nn1 < 1 .or. nn1 > this%maxbound)
then
3910 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3911 trim(adjustl(obsrv%ObsTypeId)), &
3912 'multi-aquifer well connection number must be greater than 0', &
3913 'and less than', jj,
'(specified value is ', nn2,
').'
3918 do j = 1, obsrv%indxbnds_count
3919 nn1 = obsrv%indxbnds(j)
3920 if (nn1 < 1 .or. nn1 > this%nmawwells)
then
3921 write (
errmsg,
'(3(a,1x),i0,1x,a,i0,a)') &
3922 trim(adjustl(obsrv%ObsTypeId)), &
3923 'multi-aquifer well must be greater than 0 ', &
3924 'and less than or equal to', this%nmawwells, &
3925 '(specified value is ', nn1,
').'
3950 integer(I4B),
intent(in) :: inunitobs
3951 integer(I4B),
intent(in) :: iout
3953 integer(I4B) :: nn1, nn2
3954 integer(I4B) :: icol, istart, istop
3955 character(len=LINELENGTH) :: string
3956 character(len=LENBOUNDNAME) :: bndname
3959 string = obsrv%IDstring
3967 obsrv%FeatureName = bndname
3969 if (obsrv%ObsTypeId ==
'MAW' .or. &
3970 obsrv%ObsTypeId ==
'CONDUCTANCE')
then
3972 if (len_trim(bndname) < 1 .and. nn2 < 0)
then
3973 write (
errmsg,
'(a,1x,a,a,1x,a,1x,a)') &
3974 'For observation type', trim(adjustl(obsrv%ObsTypeId)), &
3975 ', ID given as an integer and not as boundname,', &
3976 'but ID2 (icon) is missing. Either change ID to valid', &
3977 'boundname or supply valid entry for ID2.'
3981 obsrv%FeatureName = bndname
3985 obsrv%NodeNumber2 = nn2
3990 obsrv%NodeNumber = nn1
4000 class(
mawtype),
intent(inout) :: this
4001 character(len=*),
intent(in) :: fname
4003 character(len=*),
parameter :: fmtredflowcsv = &
4004 "(4x, 'MAW REDUCED FLOW INFORMATION WILL BE SAVED TO FILE: ', a, /4x, &
4005 &'OPENED ON UNIT: ', I0)"
4007 this%ioutredflowcsv =
getunit()
4008 call openfile(this%ioutredflowcsv, this%iout, fname,
'CSV', &
4009 filstat_opt=
'REPLACE')
4010 write (this%iout, fmtredflowcsv) trim(adjustl(fname)), &
4012 write (this%ioutredflowcsv,
'(a)') &
4013 'time,period,step,MAWnumber,rate-requested,rate-actual,maw-reduction'
4022 class(
mawtype),
intent(inout) :: this
4029 do n = 1, this%nmawwells
4032 if (this%status(n) .ne.
'ACTIVE')
then
4035 v = this%rate(n) - this%ratesim(n)
4036 if (abs(v) >
dem9)
then
4037 write (this%ioutredflowcsv,
'(*(G0,:,","))') &
4048 class(
mawtype),
intent(inout) :: this
4049 integer(I4B),
intent(in) :: i
4050 integer(I4B),
intent(in) :: j
4051 integer(I4B),
intent(in) :: node
4053 integer(I4B) :: iTcontrastErr
4054 integer(I4B) :: jpos
4058 real(DP) :: sqrtk11k22
4066 real(DP) :: Tcontrast
4091 jpos = this%get_jpos(i, j)
4094 k11 = this%gwfk11(node)
4095 if (this%gwfik22 == 0)
then
4096 k22 = this%gwfk11(node)
4098 k22 = this%gwfk22(node)
4100 sqrtk11k22 = sqrt(k11 * k22)
4103 gwftop = this%dis%top(node)
4104 gwfbot = this%dis%bot(node)
4105 tthka = gwftop - gwfbot
4106 gwfsat = this%gwfsat(node)
4110 topw = this%topscrn(jpos)
4111 botw = this%botscrn(jpos)
4115 if (gwftop == topw .and. gwfbot == botw)
then
4116 if (this%icelltype(node) == 0)
then
4117 tthkw = tthkw * gwfsat
4118 tthka = tthka * gwfsat
4123 t2pi =
dtwopi * tthka * sqrtk11k22
4126 if (this%dis%ndim == 3 .and. this%ieffradopt /= 0)
then
4129 dx = sqrt(this%dis%area(node))
4133 eradius = 0.28_dp * ((yx4 * dx)**
dtwo + &
4136 area = this%dis%area(node)
4142 if (this%ieqn(i) == 1 .or. this%ieqn(i) == 3)
then
4143 lc1 = log(eradius / this%radius(i)) / t2pi
4147 if (this%ieqn(i) == 2 .or. this%ieqn(i) == 3)
then
4149 if (tthkw * hks >
dzero)
then
4150 tcontrast = (sqrtk11k22 * tthka) / (hks * tthkw)
4151 skin = (tcontrast -
done) * log(this%sradius(jpos) / this%radius(i))
4158 if (tcontrast <= 1 .and. this%ieqn(i) == 2)
then
4160 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
4161 'Invalid calculated transmissivity contrast (', tcontrast, &
4162 ') for maw well', i,
'connection', j,
'.',
'This happens when the', &
4163 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
4164 'Consider decreasing HK_SKIN for the connection or using the', &
4165 'CUMULATIVE or MEAN conductance equations.'
4174 if (this%ieqn(i) == 4)
then
4176 ravg =
dhalf * (this%radius(i) + this%sradius(jpos))
4177 slen = this%sradius(jpos) - this%radius(i)
4179 c = hks * pavg * tthkw / slen
4184 if (this%ieqn(i) < 4)
then
4185 if (lc1 + lc2 /=
dzero)
then
4186 c =
done / (lc1 + lc2)
4194 if (c <
dzero .and. itcontrasterr == 0)
then
4195 write (
errmsg,
'(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
4196 'Invalid calculated negative conductance (', c, &
4197 ') for maw well', i,
'connection', j,
'.',
'this happens when the', &
4198 'skin transmissivity equals or exceeds the aquifer transmissivity.', &
4199 'consider decreasing hk_skin for the connection or using the', &
4200 'mean conductance equation.'
4207 if (this%inonvert /= 0)
then
4208 c = c * this%maw_calc_lcorr(i, jpos)
4212 this%satcond(jpos) = c
4219 class(
mawtype),
intent(inout) :: this
4220 integer(I4B),
intent(in) :: n
4221 integer(I4B),
intent(in) :: j
4222 integer(I4B),
intent(in) :: node
4223 real(DP),
intent(inout) :: sat
4224 real(DP),
intent(in),
optional :: hwell_in
4226 integer(I4B) :: jpos
4237 if (this%icelltype(node) /= 0)
then
4240 hwell = this%xnewpak(n)
4241 if (
present(hwell_in))
then
4246 jpos = this%get_jpos(n, j)
4249 topw = this%topscrn(jpos)
4250 botw = this%botscrn(jpos)
4253 if (this%inewton /= 1)
then
4254 h_temp = this%xnew(node)
4255 if (h_temp < botw)
then
4258 if (hwell < botw)
then
4261 h_temp =
dhalf * (h_temp + hwell)
4263 h_temp = this%xnew(node)
4264 if (hwell > h_temp)
then
4267 if (h_temp < botw)
then
4294 integer(I4B),
intent(in) :: n
4295 integer(I4B),
intent(in) :: j
4296 integer(I4B),
intent(inout) :: icflow
4297 real(DP),
intent(inout) :: cmaw
4298 real(DP),
intent(inout) :: cterm
4299 real(DP),
intent(inout) :: term
4300 real(DP),
intent(inout) :: flow
4301 real(DP),
intent(inout),
optional :: term2
4303 logical(LGP) :: correct_flow
4304 integer(I4B) :: inewton
4305 integer(I4B) :: jpos
4306 integer(I4B) :: igwfnode
4317 real(DP) :: dhbarterm
4318 real(DP) :: vscratio
4324 if (
present(term2))
then
4331 jpos = this%get_jpos(n, j)
4332 igwfnode = this%get_gwfnode(n, j)
4333 hgwf = this%xnew(igwfnode)
4334 hmaw = this%xnewpak(n)
4335 tmaw = this%topscrn(jpos)
4336 bmaw = this%botscrn(jpos)
4339 if (this%ivsc == 1)
then
4342 vscratio = this%viscratios(1, n)
4344 vscratio = this%viscratios(2, n)
4349 call this%maw_calculate_saturation(n, j, igwfnode, sat)
4350 cmaw = this%satcond(jpos) * vscratio * sat
4353 if (inewton == 1)
then
4357 if (hgwf > hups)
then
4365 if (this%icelltype(igwfnode) /= 0)
then
4375 if (this%correct_flow)
then
4378 en = max(bmaw, this%dis%bot(igwfnode))
4379 correct_flow = .false.
4381 correct_flow = .true.
4383 if (hgwf < en .and. this%icelltype(igwfnode) /= 0)
then
4384 correct_flow = .true.
4389 if (correct_flow)
then
4391 hdowns = min(hmaw, hgwf)
4393 if (hgwf > hmaw)
then
4394 cterm = cmaw * (hmaw - hbar)
4396 cterm = cmaw * (hbar - hgwf)
4401 if (inewton /= 0)
then
4404 if (hmaw > hgwf)
then
4406 term = drterm * this%satcond(jpos) * vscratio * (hbar - hmaw)
4408 term2 = cmaw * (dhbarterm -
done)
4413 term = -drterm * this%satcond(jpos) * vscratio * (hgwf - hbar)
4415 term2 = cmaw * (
done - dhbarterm)
4421 if (inewton /= 0)
then
4422 term = drterm * this%satcond(jpos) * vscratio * (hgwf - hmaw)
4428 if (inewton == 0)
then
4429 flow = term * (hgwf - hmaw) + cterm
4433 if (this%idense /= 0 .and. inewton == 0)
then
4434 call this%maw_calculate_density_exchange(jpos, hmaw, hgwf, cmaw, &
4435 bmaw, flow, term, cterm)
4444 integer(I4B),
intent(in) :: n
4445 real(DP),
intent(in) :: hmaw
4446 real(DP),
intent(inout) :: q
4463 if (rate <
dzero)
then
4468 if (this%shutofflevel(n) /=
dep20)
then
4469 call this%maw_calculate_qpot(n, q)
4471 if (q > -rate) q = -rate
4473 if (this%ishutoffcnt == 1)
then
4474 this%shutoffweight(n) =
done
4475 this%shutoffdq(n) =
dzero
4476 this%shutoffqold(n) = q
4479 dq = q - this%shutoffqold(n)
4480 weight = this%shutoffweight(n)
4483 if (this%shutoffdq(n) * dq <
dzero)
then
4484 weight = this%theta * this%shutoffweight(n)
4488 weight = this%shutoffweight(n) + this%kappa
4492 q = this%shutoffqold(n) + weight * dq
4494 this%shutoffqold(n) = q
4495 this%shutoffdq(n) = dq
4496 this%shutoffweight(n) = weight
4500 if (this%shutoffmin(n) >
dzero)
then
4501 if (hmaw < this%shutofflevel(n))
then
4505 if (this%ishutoff(n) /= 0)
then
4512 if (q < this%shutoffmin(n))
then
4513 if (this%ishutoffcnt > 2)
then
4514 this%ishutoff(n) = 1
4525 if (q > this%shutoffmax(n))
then
4526 if (this%ishutoffcnt <= 2)
then
4527 this%ishutoff(n) = 0
4530 if (this%ishutoff(n) /= 0)
then
4536 if (q /=
dzero) q = -q
4545 if (this%reduction_length(n) /=
dep20)
then
4546 bt = this%pumpelev(n)
4547 tp = bt + this%reduction_length(n)
4557 if (this%shutofflevel(n) /=
dep20)
then
4558 call this%maw_calculate_qpot(n, q)
4561 if (q > rate) q = rate
4563 if (this%ishutoffcnt == 1)
then
4564 this%shutoffweight(n) =
done
4565 this%shutoffdq(n) =
dzero
4566 this%shutoffqold(n) = q
4569 dq = q - this%shutoffqold(n)
4570 weight = this%shutoffweight(n)
4573 if (this%shutoffdq(n) * dq <
dzero)
then
4574 weight = this%theta * this%shutoffweight(n)
4578 weight = this%shutoffweight(n) + this%kappa
4582 q = this%shutoffqold(n) + weight * dq
4584 this%shutoffqold(n) = q
4585 this%shutoffdq(n) = dq
4586 this%shutoffweight(n) = weight
4594 if (this%reduction_length(n) /=
dep20)
then
4595 bt = this%pumpelev(n)
4596 tp = bt + this%reduction_length(n)
4609 class(
mawtype),
intent(inout) :: this
4610 integer(I4B),
intent(in) :: n
4611 real(DP),
intent(inout) :: qnet
4614 integer(I4B) :: jpos
4615 integer(I4B) :: igwfnode
4627 real(DP) :: vscratio
4633 h_temp = this%shutofflevel(n)
4636 if (this%ivsc == 1)
then
4639 vscratio = this%viscratios(1, n)
4641 vscratio = this%viscratios(2, n)
4646 if (this%iflowingwells > 0)
then
4647 if (this%fwcond(n) >
dzero)
then
4649 tp = bt + this%fwrlen(n)
4651 cfw = scale * this%fwcond(n) * this%viscratios(2, n)
4652 this%ifwdischarge(n) = 0
4653 if (cfw >
dzero)
then
4654 this%ifwdischarge(n) = 1
4657 qnet = qnet + cfw * (bt - h_temp)
4662 if (this%imawiss /= 1)
then
4663 if (this%ifwdischarge(n) /= 1)
then
4664 hdterm = this%xoldsto(n) - h_temp
4666 hdterm = this%xoldsto(n) - this%fwelev(n)
4668 qnet = qnet - (this%area(n) * hdterm /
delt)
4672 do j = 1, this%ngwfnodes(n)
4673 jpos = this%get_jpos(n, j)
4674 igwfnode = this%get_gwfnode(n, j)
4675 call this%maw_calculate_saturation(n, j, igwfnode, sat)
4676 cmaw = this%satcond(jpos) * vscratio * sat
4677 hgwf = this%xnew(igwfnode)
4678 bmaw = this%botscrn(jpos)
4683 if (hgwf < bmaw)
then
4686 qnet = qnet + cmaw * (hgwf - hv)
4698 integer(I4B) :: jpos
4699 integer(I4B) :: icflow
4700 integer(I4B) :: ibnd
4708 if (this%nbound .eq. 0)
return
4711 this%ishutoffcnt = this%ishutoffcnt + 1
4715 do n = 1, this%nmawwells
4716 hmaw = this%xnewpak(n)
4717 do j = 1, this%ngwfnodes(n)
4718 jpos = this%get_jpos(n, j)
4719 this%hcof(ibnd) =
dzero
4720 this%rhs(ibnd) =
dzero
4726 if (this%iboundpak(n) == 0)
then
4731 call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, &
4734 this%simcond(jpos) = cmaw
4735 this%bound(2, ibnd) = cmaw
4736 this%hcof(ibnd) = -term
4737 this%rhs(ibnd) = -term * hmaw + cterm
4755 integer(I4B) :: nbudterm
4756 integer(I4B) :: n, j, n2
4758 integer(I4B) :: maxlist, naux
4760 character(len=LENBUDTXT) :: text
4761 character(len=LENBUDTXT),
dimension(1) :: auxtxt
4767 if (this%iflowingwells > 0)
then
4768 nbudterm = nbudterm + 1
4770 if (this%imover == 1)
then
4771 nbudterm = nbudterm + 3
4772 if (this%iflowingwells > 0)
then
4773 nbudterm = nbudterm + 1
4776 if (this%naux > 0) nbudterm = nbudterm + 1
4780 call this%budobj%budgetobject_df(this%nmawwells, nbudterm, 0, 0, &
4781 ibudcsv=this%ibudcsv)
4789 maxlist = this%maxbound
4791 auxtxt(1) =
' FLOW-AREA'
4792 call this%budobj%budterm(idx)%initialize(text, &
4797 maxlist, .false., .true., &
4799 call this%budobj%budterm(idx)%reset(this%maxbound)
4801 do n = 1, this%nmawwells
4802 do j = 1, this%ngwfnodes(n)
4803 n2 = this%get_gwfnode(n, j)
4804 call this%budobj%budterm(idx)%update_term(n, n2, q)
4811 maxlist = this%nmawwells
4813 call this%budobj%budterm(idx)%initialize(text, &
4818 maxlist, .false., .false., &
4822 if (this%iflowingwells > 0)
then
4825 maxlist = this%nmawwells
4827 call this%budobj%budterm(idx)%initialize(text, &
4832 maxlist, .false., .false., &
4839 maxlist = this%nmawwells
4841 auxtxt(1) =
' VOLUME'
4842 call this%budobj%budterm(idx)%initialize(text, &
4847 maxlist, .false., .true., &
4853 maxlist = this%nmawwells
4855 call this%budobj%budterm(idx)%initialize(text, &
4860 maxlist, .false., .false., &
4864 if (this%imover == 1)
then
4869 maxlist = this%nmawwells
4871 call this%budobj%budterm(idx)%initialize(text, &
4876 maxlist, .false., .false., &
4880 text =
' RATE-TO-MVR'
4882 maxlist = this%nmawwells
4884 call this%budobj%budterm(idx)%initialize(text, &
4889 maxlist, .false., .false., &
4893 text =
' CONSTANT-TO-MVR'
4895 maxlist = this%nmawwells
4897 call this%budobj%budterm(idx)%initialize(text, &
4902 maxlist, .false., .false., &
4906 if (this%iflowingwells > 0)
then
4909 text =
' FW-RATE-TO-MVR'
4911 maxlist = this%nmawwells
4913 call this%budobj%budterm(idx)%initialize(text, &
4918 maxlist, .false., .false., &
4930 maxlist = this%maxbound
4931 call this%budobj%budterm(idx)%initialize(text, &
4936 maxlist, .false., .false., &
4941 if (this%iprflow /= 0)
then
4942 call this%budobj%flowtable_df(this%iout)
4956 integer(I4B) :: naux
4960 integer(I4B) :: jpos
4962 integer(I4B) :: ibnd
4978 call this%budobj%budterm(idx)%reset(this%maxbound)
4980 do n = 1, this%nmawwells
4981 do j = 1, this%ngwfnodes(n)
4982 jpos = this%get_jpos(n, j)
4983 n2 = this%get_gwfnode(n, j)
4987 if (this%iboundpak(n) == 0)
then
4988 this%qauxcbc(1) =
dzero
4990 tmaw = this%topscrn(jpos)
4991 bmaw = this%botscrn(jpos)
4992 call this%maw_calculate_saturation(n, j, n2, sat)
4993 this%qauxcbc(1) =
dtwo *
dpi * this%radius(n) * sat * (tmaw - bmaw)
4995 q = this%qleak(ibnd)
4996 call this%budobj%budterm(idx)%update_term(n, n2, q, this%qauxcbc)
5003 call this%budobj%budterm(idx)%reset(this%nmawwells)
5004 do n = 1, this%nmawwells
5008 if (this%imover == 1 .and. q <
dzero)
then
5010 if (this%qout(n) <
dzero)
then
5011 qfact = q / this%qout(n)
5013 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
5015 call this%budobj%budterm(idx)%update_term(n, n, q)
5019 if (this%iflowingwells > 0)
then
5021 call this%budobj%budterm(idx)%reset(this%nmawwells)
5022 do n = 1, this%nmawwells
5024 if (this%imover == 1)
then
5028 if (this%qout(n) <
dzero)
then
5029 qfact = q / this%qout(n)
5031 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
5033 call this%budobj%budterm(idx)%update_term(n, n, q)
5039 call this%budobj%budterm(idx)%reset(this%nmawwells)
5040 do n = 1, this%nmawwells
5041 b = this%xsto(n) - this%bot(n)
5045 v = this%area(n) * b
5046 if (this%imawissopt /= 1)
then
5052 call this%budobj%budterm(idx)%update_term(n, n, q, this%qauxcbc)
5057 call this%budobj%budterm(idx)%reset(this%nmawwells)
5058 do n = 1, this%nmawwells
5062 if (this%imover == 1 .and. q <
dzero)
then
5064 if (this%qout(n) <
dzero)
then
5065 qfact = q / this%qout(n)
5067 q = q + qfact * this%pakmvrobj%get_qtomvr(n)
5069 call this%budobj%budterm(idx)%update_term(n, n, q)
5073 if (this%imover == 1)
then
5077 call this%budobj%budterm(idx)%reset(this%nmawwells)
5078 do n = 1, this%nmawwells
5079 if (this%iboundpak(n) == 0)
then
5082 q = this%pakmvrobj%get_qfrommvr(n)
5084 call this%budobj%budterm(idx)%update_term(n, n, q)
5089 call this%budobj%budterm(idx)%reset(this%nmawwells)
5090 do n = 1, this%nmawwells
5091 q = this%pakmvrobj%get_qtomvr(n)
5094 q2 = this%ratesim(n)
5097 if (q2 <
dzero)
then
5098 qfact = q2 / this%qout(n)
5104 call this%budobj%budterm(idx)%update_term(n, n, q)
5109 call this%budobj%budterm(idx)%reset(this%nmawwells)
5110 do n = 1, this%nmawwells
5111 q = this%pakmvrobj%get_qtomvr(n)
5116 if (q2 <
dzero)
then
5117 qfact = q2 / this%qout(n)
5123 call this%budobj%budterm(idx)%update_term(n, n, q)
5127 if (this%iflowingwells > 0)
then
5129 call this%budobj%budterm(idx)%reset(this%nmawwells)
5130 do n = 1, this%nmawwells
5131 q = this%pakmvrobj%get_qtomvr(n)
5134 q2 = this%ratesim(n)
5138 if (this%qout(n) <
dzero)
then
5139 qfact = this%qfw(n) / this%qout(n)
5143 call this%budobj%budterm(idx)%update_term(n, n, q)
5153 call this%budobj%budterm(idx)%reset(this%nmawwells)
5154 do n = 1, this%nmawwells
5156 call this%budobj%budterm(idx)%update_term(n, n, q, this%auxvar(:, n))
5161 call this%budobj%accumulate_terms()
5175 integer(I4B) :: nterms
5176 character(len=LINELENGTH) :: title
5177 character(len=LINELENGTH) :: text
5180 if (this%iprhed > 0)
then
5184 if (this%inamedbound == 1) nterms = nterms + 1
5187 title = trim(adjustl(this%text))//
' PACKAGE ('// &
5188 trim(adjustl(this%packName))//
') HEADS FOR EACH CONTROL VOLUME'
5191 call table_cr(this%headtab, this%packName, title)
5192 call this%headtab%table_df(this%nmawwells, nterms, this%iout, &
5196 if (this%inamedbound == 1)
then
5198 call this%headtab%initialize_column(text, 20, alignment=tableft)
5203 call this%headtab%initialize_column(text, 10, alignment=tabcenter)
5207 call this%headtab%initialize_column(text, 12, alignment=tabcenter)
5215 integer(I4B) :: jpos
5218 integer(I4B),
intent(in) :: n
5219 integer(I4B),
intent(in) :: j
5223 jpos = this%iaconn(n) + j - 1
5230 integer(I4B) :: igwfnode
5233 integer(I4B),
intent(in) :: n
5234 integer(I4B),
intent(in) :: j
5236 integer(I4B) :: jpos
5239 jpos = this%get_jpos(n, j)
5240 igwfnode = this%gwfnodes(jpos)
5247 class(
mawtype),
intent(inout) :: this
5249 integer(I4B) :: i, j
5254 call mem_reallocate(this%denseterms, 3, this%MAXBOUND,
'DENSETERMS', &
5256 do i = 1, this%maxbound
5258 this%denseterms(j, i) =
dzero
5261 write (this%iout,
'(/1x,a)')
'DENSITY TERMS HAVE BEEN ACTIVATED FOR MAW &
5262 &PACKAGE: '//trim(adjustl(this%packName))
5273 class(
mawtype),
intent(inout) :: this
5280 call mem_reallocate(this%viscratios, 2, this%MAXBOUND,
'VISCRATIOS', &
5282 do i = 1, this%maxbound
5284 this%viscratios(j, i) =
done
5287 write (this%iout,
'(/1x,a)')
'VISCOSITY HAS BEEN ACTIVATED FOR MAW &
5288 &PACKAGE: '//trim(adjustl(this%packName))
5314 bmaw, flow, hcofterm, rhsterm)
5316 class(
mawtype),
intent(inout) :: this
5317 integer(I4B),
intent(in) :: iconn
5318 real(DP),
intent(in) :: hmaw
5319 real(DP),
intent(in) :: hgwf
5320 real(DP),
intent(in) :: cond
5321 real(DP),
intent(in) :: bmaw
5322 real(DP),
intent(inout) :: flow
5323 real(DP),
intent(inout) :: hcofterm
5324 real(DP),
intent(inout) :: rhsterm
5328 real(DP) :: rdensemaw
5329 real(DP) :: rdensegwf
5330 real(DP) :: rdenseavg
5335 rdensemaw = this%denseterms(1, iconn)
5336 rdensegwf = this%denseterms(2, iconn)
5337 if (rdensegwf ==
dzero)
return
5340 if (hmaw > bmaw .and. hgwf > bmaw)
then
5343 rdenseavg =
dhalf * (rdensemaw + rdensegwf)
5346 t = cond * (rdenseavg -
done) * (hgwf - hmaw)
5347 rhsterm = rhsterm + t
5351 havg =
dhalf * (hgwf + hmaw)
5352 elevavg = this%denseterms(3, iconn)
5353 t = cond * (havg - elevavg) * (rdensegwf - rdensemaw)
5354 rhsterm = rhsterm + t
5356 else if (hmaw > bmaw)
then
5359 t = (rdensemaw -
done) * rhsterm
5360 rhsterm = rhsterm + t
5362 else if (hgwf > bmaw)
then
5365 t = (rdensegwf -
done) * rhsterm
5366 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 maw_checkin_deprecated_names(this)
Alias deprecated MAW variable names to their current storage.
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.
Previous variable names checked in as deprecated aliases.
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 ...