MODFLOW 6  version 6.7.0.dev0
USGS Modular Hydrologic Model
gwf-maw.f90
Go to the documentation of this file.
1 module mawmodule
2  !
3  use kindmodule, only: dp, i4b, lgp
14  squadratic0sp, &
16  use bndmodule, only: bndtype
18  use tablemodule, only: tabletype, table_cr
19  use observemodule, only: observetype
20  use obsmodule, only: obstype
21  use geomutilmodule, only: get_node
24  use basedismodule, only: disbasetype
33  !
34  implicit none
35 
36  public :: mawtype
37 
38  !
39  character(len=LENFTYPE) :: ftype = 'MAW'
40  character(len=LENPACKAGENAME) :: text = ' MAW'
41 
42  private
43  public :: maw_create
44  !
45  type, extends(bndtype) :: mawtype
46  !
47  ! -- scalars
48  ! -- characters
49  !
50  character(len=LENBUDTXT), dimension(:), pointer, &
51  contiguous :: cmawbudget => null()
52  character(len=LENAUXNAME), dimension(:), pointer, &
53  contiguous :: cauxcbc => null()
54  !
55  ! -- logical
56  logical(LGP), pointer :: correct_flow => null()
57  !
58  ! -- integers
59  integer(I4B), pointer :: iprhed => null()
60  integer(I4B), pointer :: iheadout => null()
61  integer(I4B), pointer :: ibudgetout => null()
62  integer(I4B), pointer :: ibudcsv => null()
63  integer(I4B), pointer :: cbcauxitems => null()
64  integer(I4B), pointer :: iflowingwells => null()
65  integer(I4B), pointer :: imawiss => null()
66  integer(I4B), pointer :: imawissopt => null()
67  integer(I4B), pointer :: nmawwells => null()
68  integer(I4B), pointer :: check_attr => null()
69  integer(I4B), pointer :: ishutoffcnt => null()
70  integer(I4B), pointer :: ieffradopt => null()
71  integer(I4B), pointer :: ioutredflowcsv => null() !< unit number for CSV output file containing MAWs with reduced extraction/injection rates
72  real(dp), pointer :: satomega => null()
73  !
74  ! -- for underrelaxation of estimated well q if using shutoff
75  real(dp), pointer :: theta => null()
76  real(dp), pointer :: kappa => null()
77  !
78  ! -- vector data for each well
79  character(len=8), dimension(:), pointer, contiguous :: status => null()
80  integer(I4B), dimension(:), pointer, contiguous :: ngwfnodes => null()
81  integer(I4B), dimension(:), pointer, contiguous :: ieqn => null()
82  integer(I4B), dimension(:), pointer, contiguous :: ishutoff => null()
83  integer(I4B), dimension(:), pointer, contiguous :: ifwdischarge => null()
84  real(dp), dimension(:), pointer, contiguous :: strt => null()
85  real(dp), dimension(:), pointer, contiguous :: radius => null()
86  real(dp), dimension(:), pointer, contiguous :: area => null()
87  real(dp), dimension(:), pointer, contiguous :: pumpelev => null()
88  real(dp), dimension(:), pointer, contiguous :: bot => null()
89  real(dp), dimension(:), pointer, contiguous :: ratesim => null()
90  real(dp), dimension(:), pointer, contiguous :: reduction_length => null()
91  real(dp), dimension(:), pointer, contiguous :: fwelev => null()
92  real(dp), dimension(:), pointer, contiguous :: fwcond => null()
93  real(dp), dimension(:), pointer, contiguous :: fwrlen => null()
94  real(dp), dimension(:), pointer, contiguous :: fwcondsim => null()
95  real(dp), dimension(:), pointer, contiguous :: xsto => null()
96  real(dp), dimension(:), pointer, contiguous :: xoldsto => null()
97  real(dp), dimension(:), pointer, contiguous :: shutoffmin => null()
98  real(dp), dimension(:), pointer, contiguous :: shutoffmax => null()
99  real(dp), dimension(:), pointer, contiguous :: shutofflevel => null()
100  real(dp), dimension(:), pointer, contiguous :: shutoffweight => null()
101  real(dp), dimension(:), pointer, contiguous :: shutoffdq => null()
102  real(dp), dimension(:), pointer, contiguous :: shutoffqold => null()
103  character(len=LENBOUNDNAME), dimension(:), pointer, &
104  contiguous :: cmawname => null()
105  !
106  ! -- time-series aware data
107  real(dp), dimension(:), pointer, contiguous :: rate => null()
108  real(dp), dimension(:), pointer, contiguous :: well_head => null()
109  real(dp), dimension(:, :), pointer, contiguous :: mauxvar => null()
110  !
111  ! -- ia vector for connections
112  integer(I4B), dimension(:), pointer, contiguous :: iaconn => null()
113  !
114  ! -- vector data for each connections
115  integer(I4B), dimension(:), pointer, contiguous :: gwfnodes => null()
116  real(dp), dimension(:), pointer, contiguous :: sradius => null()
117  real(dp), dimension(:), pointer, contiguous :: hk => null()
118  real(dp), dimension(:), pointer, contiguous :: satcond => null()
119  real(dp), dimension(:), pointer, contiguous :: simcond => null()
120  real(dp), dimension(:), pointer, contiguous :: topscrn => null()
121  real(dp), dimension(:), pointer, contiguous :: botscrn => null()
122  !
123  ! -- imap vector
124  integer(I4B), dimension(:), pointer, contiguous :: imap => null()
125  !
126  ! -- maw output data
127  real(dp), dimension(:), pointer, contiguous :: qauxcbc => null()
128  real(dp), dimension(:), pointer, contiguous :: dbuff => null()
129  real(dp), dimension(:), pointer, contiguous :: qleak => null()
130  real(dp), dimension(:), pointer, contiguous :: qout => null()
131  real(dp), dimension(:), pointer, contiguous :: qfw => null()
132  real(dp), dimension(:), pointer, contiguous :: qsto => null()
133  real(dp), dimension(:), pointer, contiguous :: qconst => null()
134  !
135  ! -- for budgets
136  integer(I4B), pointer :: bditems => null()
137  type(budgetobjecttype), pointer :: budobj => null()
138  !
139  ! -- table objects
140  type(tabletype), pointer :: headtab => null()
141  !
142  ! -- pointer to gwf iss, k11, k22.
143  integer(I4B), pointer :: gwfiss => null()
144  real(dp), dimension(:), pointer, contiguous :: gwfk11 => null()
145  real(dp), dimension(:), pointer, contiguous :: gwfk22 => null()
146  integer(I4B), pointer :: gwfik22 => null()
147  real(dp), dimension(:), pointer, contiguous :: gwfsat => null()
148  !
149  ! -- arrays for handling the rows added to the solution matrix
150  integer(I4B), dimension(:), pointer, contiguous :: idxlocnode => null() !map position in global rhs and x array of pack entry
151  integer(I4B), dimension(:), pointer, contiguous :: idxdglo => null() !map position in global array of package diagonal row entries
152  integer(I4B), dimension(:), pointer, contiguous :: idxoffdglo => null() !map position in global array of package off diagonal row entries
153  integer(I4B), dimension(:), pointer, contiguous :: idxsymdglo => null() !map position in global array of package diagonal entries to model rows
154  integer(I4B), dimension(:), pointer, contiguous :: idxsymoffdglo => null() !map position in global array of package off diagonal entries to model rows
155  integer(I4B), dimension(:), pointer, contiguous :: iboundpak => null() !package ibound
156  real(dp), dimension(:), pointer, contiguous :: xnewpak => null() !package x vector
157  real(dp), dimension(:), pointer, contiguous :: xoldpak => null() !package xold vector
158  !
159  ! -- density variables
160  integer(I4B), pointer :: idense
161  real(dp), dimension(:, :), pointer, contiguous :: denseterms => null()
162  !
163  ! -- viscosity variables
164  real(dp), dimension(:, :), pointer, contiguous :: viscratios => null() !< viscosity ratios (1: maw vsc ratio; 2: gwf vsc ratio)
165  !
166  ! -- type bound procedures
167 
168  contains
169 
170  procedure :: maw_allocate_scalars
172  procedure :: maw_allocate_arrays
173  procedure :: bnd_options => maw_read_options
174  procedure :: read_dimensions => maw_read_dimensions
175  procedure :: read_initial_attr => maw_read_initial_attr
176  procedure :: set_pointers => maw_set_pointers
177  procedure :: bnd_ac => maw_ac
178  procedure :: bnd_mc => maw_mc
179  procedure :: bnd_ar => maw_ar
180  procedure :: bnd_rp => maw_rp
181  procedure :: bnd_ad => maw_ad
182  procedure :: bnd_cf => maw_cf
183  procedure :: bnd_fc => maw_fc
184  procedure :: bnd_fn => maw_fn
185  procedure :: bnd_nur => maw_nur
186  procedure :: bnd_cq => maw_cq
187  procedure :: bnd_ot_model_flows => maw_ot_model_flows
188  procedure :: bnd_ot_package_flows => maw_ot_package_flows
189  procedure :: bnd_ot_dv => maw_ot_dv
190  procedure :: bnd_ot_bdsummary => maw_ot_bdsummary
191  procedure :: bnd_da => maw_da
192  procedure :: define_listlabel
193  ! -- methods for observations
194  procedure, public :: bnd_obs_supported => maw_obs_supported
195  procedure, public :: bnd_df_obs => maw_df_obs
196  procedure, public :: bnd_rp_obs => maw_rp_obs
197  procedure, public :: bnd_bd_obs => maw_bd_obs
198  ! -- private procedures
199  procedure, private :: maw_read_wells
200  procedure, private :: maw_read_well_connections
201  procedure, private :: maw_check_attributes
202  procedure, private :: maw_set_stressperiod
203  procedure, private :: maw_set_attribute_error
204  procedure, private :: maw_calculate_saturation
205  procedure, private :: maw_calculate_satcond
206  procedure, private :: maw_calculate_conn_terms
207  procedure, private :: maw_calculate_wellq
208  procedure, private :: maw_calculate_qpot
209  procedure, private :: maw_cfupdate
210  procedure, private :: get_jpos
211  procedure, private :: get_gwfnode
212  ! -- budget
213  procedure, private :: maw_setup_budobj
214  procedure, private :: maw_fill_budobj
215  ! -- table
216  procedure, private :: maw_setup_tableobj
217  ! -- density
218  procedure :: maw_activate_density
219  procedure, private :: maw_calculate_density_exchange
220  ! -- MAW reduced flow outputs
221  procedure, private :: maw_redflow_csv_init
222  procedure, private :: maw_redflow_csv_write
223  ! -- viscosity
225  end type mawtype
226 
227 contains
228 
229 !> @brief Create a New Multi-Aquifer Well (MAW) Package
230 !!
231 !! After creating the package object point bndobj to the new package
232 !<
233  subroutine maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
234  ! -- dummy
235  class(bndtype), pointer :: packobj
236  integer(I4B), intent(in) :: id
237  integer(I4B), intent(in) :: ibcnum
238  integer(I4B), intent(in) :: inunit
239  integer(I4B), intent(in) :: iout
240  character(len=*), intent(in) :: namemodel
241  character(len=*), intent(in) :: pakname
242  type(mawtype), pointer :: mawobj
243  !
244  ! -- allocate the object and assign values to object variables
245  allocate (mawobj)
246  packobj => mawobj
247  !
248  ! -- create name and memory path
249  call packobj%set_names(ibcnum, namemodel, pakname, ftype)
250  packobj%text = text
251  !
252  ! -- allocate scalars
253  call mawobj%maw_allocate_scalars()
254  !
255  ! -- initialize package
256  call packobj%pack_initialize()
257  !
258  packobj%inunit = inunit
259  packobj%iout = iout
260  packobj%id = id
261  packobj%ibcnum = ibcnum
262  packobj%ncolbnd = 4
263  packobj%iscloc = 0 ! not supported
264  packobj%isadvpak = 1
265  packobj%ictMemPath = create_mem_path(namemodel, 'NPF')
266  end subroutine maw_create
267 
268  !> @brief Allocate scalar members
269  !<
270  subroutine maw_allocate_scalars(this)
271  ! -- modules
273  ! -- dummy
274  class(mawtype), intent(inout) :: this
275  !
276  ! -- call standard BndType allocate scalars
277  call this%BndType%allocate_scalars()
278  !
279  ! -- allocate the object and assign values to object variables
280  call mem_allocate(this%correct_flow, 'CORRECT_FLOW', this%memoryPath)
281  call mem_allocate(this%iprhed, 'IPRHED', this%memoryPath)
282  call mem_allocate(this%iheadout, 'IHEADOUT', this%memoryPath)
283  call mem_allocate(this%ibudgetout, 'IBUDGETOUT', this%memoryPath)
284  call mem_allocate(this%ibudcsv, 'IBUDCSV', this%memoryPath)
285  call mem_allocate(this%iflowingwells, 'IFLOWINGWELLS', this%memoryPath)
286  call mem_allocate(this%imawiss, 'IMAWISS', this%memoryPath)
287  call mem_allocate(this%imawissopt, 'IMAWISSOPT', this%memoryPath)
288  call mem_allocate(this%nmawwells, 'NMAWWELLS', this%memoryPath)
289  call mem_allocate(this%check_attr, 'CHECK_ATTR', this%memoryPath)
290  call mem_allocate(this%ishutoffcnt, 'ISHUTOFFCNT', this%memoryPath)
291  call mem_allocate(this%ieffradopt, 'IEFFRADOPT', this%memoryPath)
292  call mem_allocate(this%ioutredflowcsv, 'IOUTREDFLOWCSV', this%memoryPath) !for writing reduced MAW flows to csv file
293  call mem_allocate(this%satomega, 'SATOMEGA', this%memoryPath)
294  call mem_allocate(this%bditems, 'BDITEMS', this%memoryPath)
295  call mem_allocate(this%theta, 'THETA', this%memoryPath)
296  call mem_allocate(this%kappa, 'KAPPA', this%memoryPath)
297  call mem_allocate(this%cbcauxitems, 'CBCAUXITEMS', this%memoryPath)
298  call mem_allocate(this%idense, 'IDENSE', this%memoryPath)
299  !
300  ! -- Set values
301  this%correct_flow = .false.
302  this%nmawwells = 0
303  this%iprhed = 0
304  this%iheadout = 0
305  this%ibudgetout = 0
306  this%ibudcsv = 0
307  this%iflowingwells = 0
308  this%imawiss = 0
309  this%imawissopt = 0
310  this%ieffradopt = 0
311  this%ioutredflowcsv = 0
312  this%satomega = dzero
313  this%bditems = 8
314  this%theta = dp7
315  this%kappa = dem4
316  this%cbcauxitems = 1
317  this%idense = 0
318  this%ivsc = 0
319  end subroutine maw_allocate_scalars
320 
321  !> @brief Allocate well arrays
322  !<
324  ! -- modules
326  ! -- dummy
327  class(mawtype), intent(inout) :: this
328  ! -- local
329  integer(I4B) :: j
330  integer(I4B) :: n
331  integer(I4B) :: jj
332  !
333  ! -- allocate character array for budget text
334  call mem_allocate(this%cmawbudget, lenbudtxt, this%bditems, 'CMAWBUDGET', &
335  this%memoryPath)
336  !
337  !-- fill cmawbudget
338  this%cmawbudget(1) = ' GWF'
339  this%cmawbudget(2) = ' RATE'
340  this%cmawbudget(3) = ' STORAGE'
341  this%cmawbudget(4) = ' CONSTANT'
342  this%cmawbudget(5) = ' FW-RATE'
343  this%cmawbudget(6) = ' FROM-MVR'
344  this%cmawbudget(7) = ' RATE-TO-MVR'
345  this%cmawbudget(8) = ' FW-RATE-TO-MVR'
346  !
347  ! -- allocate character arrays
348  call mem_allocate(this%cmawname, lenboundname, this%nmawwells, 'CMAWNAME', &
349  this%memoryPath)
350  call mem_allocate(this%status, 8, this%nmawwells, 'STATUS', this%memoryPath)
351  !
352  ! -- allocate well data pointers in memory manager
353  call mem_allocate(this%ngwfnodes, this%nmawwells, 'NGWFNODES', &
354  this%memoryPath)
355  call mem_allocate(this%ieqn, this%nmawwells, 'IEQN', this%memoryPath)
356  call mem_allocate(this%ishutoff, this%nmawwells, 'ISHUTOFF', this%memoryPath)
357  call mem_allocate(this%ifwdischarge, this%nmawwells, 'IFWDISCHARGE', &
358  this%memoryPath)
359  call mem_allocate(this%strt, this%nmawwells, 'STRT', this%memoryPath)
360  call mem_allocate(this%radius, this%nmawwells, 'RADIUS', this%memoryPath)
361  call mem_allocate(this%area, this%nmawwells, 'AREA', this%memoryPath)
362  call mem_allocate(this%pumpelev, this%nmawwells, 'PUMPELEV', this%memoryPath)
363  call mem_allocate(this%bot, this%nmawwells, 'BOT', this%memoryPath)
364  call mem_allocate(this%ratesim, this%nmawwells, 'RATESIM', this%memoryPath)
365  call mem_allocate(this%reduction_length, this%nmawwells, 'REDUCTION_LENGTH', &
366  this%memoryPath)
367  call mem_allocate(this%fwelev, this%nmawwells, 'FWELEV', this%memoryPath)
368  call mem_allocate(this%fwcond, this%nmawwells, 'FWCONDS', this%memoryPath)
369  call mem_allocate(this%fwrlen, this%nmawwells, 'FWRLEN', this%memoryPath)
370  call mem_allocate(this%fwcondsim, this%nmawwells, 'FWCONDSIM', &
371  this%memoryPath)
372  call mem_allocate(this%xsto, this%nmawwells, 'XSTO', this%memoryPath)
373  call mem_allocate(this%xoldsto, this%nmawwells, 'XOLDSTO', this%memoryPath)
374  call mem_allocate(this%shutoffmin, this%nmawwells, 'SHUTOFFMIN', &
375  this%memoryPath)
376  call mem_allocate(this%shutoffmax, this%nmawwells, 'SHUTOFFMAX', &
377  this%memoryPath)
378  call mem_allocate(this%shutofflevel, this%nmawwells, 'SHUTOFFLEVEL', &
379  this%memoryPath)
380  call mem_allocate(this%shutoffweight, this%nmawwells, 'SHUTOFFWEIGHT', &
381  this%memoryPath)
382  call mem_allocate(this%shutoffdq, this%nmawwells, 'SHUTOFFDQ', &
383  this%memoryPath)
384  call mem_allocate(this%shutoffqold, this%nmawwells, 'SHUTOFFQOLD', &
385  this%memoryPath)
386  !
387  ! -- timeseries aware variables
388  call mem_allocate(this%rate, this%nmawwells, 'RATE', this%memoryPath)
389  call mem_allocate(this%well_head, this%nmawwells, 'WELL_HEAD', &
390  this%memoryPath)
391  if (this%naux > 0) then
392  jj = this%naux
393  else
394  jj = 1
395  end if
396  call mem_allocate(this%mauxvar, jj, this%nmawwells, 'MAUXVAR', &
397  this%memoryPath)
398  !
399  ! -- allocate and initialize dbuff
400  if (this%iheadout > 0) then
401  call mem_allocate(this%dbuff, this%nmawwells, 'DBUFF', this%memoryPath)
402  else
403  call mem_allocate(this%dbuff, 0, 'DBUFF', this%memoryPath)
404  end if
405  !
406  ! -- allocate iaconn
407  call mem_allocate(this%iaconn, this%nmawwells + 1, 'IACONN', this%memoryPath)
408  !
409  ! -- allocate imap
410  call mem_allocate(this%imap, this%MAXBOUND, 'IMAP', this%memoryPath)
411  !
412  ! -- allocate connection data
413  call mem_allocate(this%gwfnodes, this%maxbound, 'GWFNODES', this%memoryPath)
414  call mem_allocate(this%sradius, this%maxbound, 'SRADIUS', this%memoryPath)
415  call mem_allocate(this%hk, this%maxbound, 'HK', this%memoryPath)
416  call mem_allocate(this%satcond, this%maxbound, 'SATCOND', this%memoryPath)
417  call mem_allocate(this%simcond, this%maxbound, 'SIMCOND', this%memoryPath)
418  call mem_allocate(this%topscrn, this%maxbound, 'TOPSCRN', this%memoryPath)
419  call mem_allocate(this%botscrn, this%maxbound, 'BOTSCRN', this%memoryPath)
420  !
421  ! -- allocate qleak
422  call mem_allocate(this%qleak, this%maxbound, 'QLEAK', this%memoryPath)
423  !
424  ! -- initialize well data
425  do n = 1, this%nmawwells
426  this%status(n) = 'ACTIVE'
427  this%ngwfnodes(n) = 0
428  this%ieqn(n) = 0
429  this%ishutoff(n) = 0
430  this%ifwdischarge(n) = 0
431  this%strt(n) = dep20
432  this%radius(n) = dep20
433  this%area(n) = dzero
434  this%pumpelev(n) = dep20
435  this%bot(n) = dep20
436  this%ratesim(n) = dzero
437  this%reduction_length(n) = dep20
438  this%fwelev(n) = dzero
439  this%fwcond(n) = dzero
440  this%fwrlen(n) = dzero
441  this%fwcondsim(n) = dzero
442  this%xsto(n) = dzero
443  this%xoldsto(n) = dzero
444  this%shutoffmin(n) = dzero
445  this%shutoffmax(n) = dzero
446  this%shutofflevel(n) = dep20
447  this%shutoffweight(n) = done
448  this%shutoffdq(n) = done
449  this%shutoffqold(n) = done
450  !
451  ! -- timeseries aware variables
452  this%rate(n) = dzero
453  this%well_head(n) = dzero
454  do jj = 1, max(1, this%naux)
455  this%mauxvar(jj, n) = dzero
456  end do
457  !
458  ! -- dbuff
459  if (this%iheadout > 0) then
460  this%dbuff(n) = dzero
461  end if
462  end do
463  !
464  ! -- initialize iaconn
465  do n = 1, this%nmawwells + 1
466  this%iaconn(n) = 0
467  end do
468  !
469  ! -- allocate character array for budget text
470  call mem_allocate(this%cauxcbc, lenauxname, this%cbcauxitems, 'CAUXCBC', &
471  this%memoryPath)
472  !
473  ! -- allocate and initialize qauxcbc
474  call mem_allocate(this%qauxcbc, this%cbcauxitems, 'QAUXCBC', this%memoryPath)
475  do j = 1, this%cbcauxitems
476  this%qauxcbc(j) = dzero
477  end do
478  !
479  ! -- allocate flowing well data
480  if (this%iflowingwells /= 0) then
481  call mem_allocate(this%qfw, this%nmawwells, 'QFW', this%memoryPath)
482  else
483  call mem_allocate(this%qfw, 1, 'QFW', this%memoryPath)
484  end if
485  call mem_allocate(this%qout, this%nmawwells, 'QOUT', this%memoryPath)
486  call mem_allocate(this%qsto, this%nmawwells, 'QSTO', this%memoryPath)
487  call mem_allocate(this%qconst, this%nmawwells, 'QCONST', this%memoryPath)
488  !
489  ! -- initialize flowing well, storage, and constant flow terms
490  do n = 1, this%nmawwells
491  if (this%iflowingwells > 0) then
492  this%qfw(n) = dzero
493  end if
494  this%qsto(n) = dzero
495  this%qconst(n) = dzero
496  end do
497  !
498  ! -- initialize connection data
499  do j = 1, this%maxbound
500  this%imap(j) = 0
501  this%gwfnodes(j) = 0
502  this%sradius(j) = dzero
503  this%hk(j) = dzero
504  this%satcond(j) = dzero
505  this%simcond(j) = dzero
506  this%topscrn(j) = dzero
507  this%botscrn(j) = dzero
508  this%qleak(j) = dzero
509  end do
510  !
511  ! -- allocate denseterms to size 0
512  call mem_allocate(this%denseterms, 3, 0, 'DENSETERMS', this%memoryPath)
513  !
514  ! -- allocate viscratios to size 0
515  call mem_allocate(this%viscratios, 2, 0, 'VISCRATIOS', this%memoryPath)
516  end subroutine maw_allocate_well_conn_arrays
517 
518  !> @brief Allocate arrays
519  !<
520  subroutine maw_allocate_arrays(this)
521  ! -- modules
523  ! -- dummy
524  class(mawtype), intent(inout) :: this
525  ! -- local
526  !
527  ! -- call standard BndType allocate scalars
528  call this%BndType%allocate_arrays()
529  end subroutine maw_allocate_arrays
530 
531  !> @brief Read the packagedata for this package
532  !<
533  subroutine maw_read_wells(this)
534  use constantsmodule, only: linelength
536  ! -- dummy
537  class(mawtype), intent(inout) :: this
538  ! -- local
539  character(len=LINELENGTH) :: text
540  character(len=LINELENGTH) :: keyword
541  character(len=LINELENGTH) :: cstr
542  character(len=LENBOUNDNAME) :: bndName
543  character(len=LENBOUNDNAME) :: bndNameTemp
544  character(len=9) :: cno
545  logical :: isfound
546  logical :: endOfBlock
547  integer(I4B) :: ival
548  integer(I4B) :: n
549  integer(I4B) :: j
550  integer(I4B) :: ii
551  integer(I4B) :: jj
552  integer(I4B) :: ieqn
553  integer(I4B) :: itmp
554  integer(I4B) :: ierr
555  integer(I4B) :: idx
556  real(DP) :: rval
557  real(DP), pointer :: bndElem => null()
558  ! -- local allocatable arrays
559  character(len=LINELENGTH), dimension(:), allocatable :: strttext
560  character(len=LENBOUNDNAME), dimension(:), allocatable :: nametxt
561  character(len=50), dimension(:, :), allocatable :: caux
562  integer(I4B), dimension(:), allocatable :: nboundchk
563  integer(I4B), dimension(:), allocatable :: wellieqn
564  integer(I4B), dimension(:), allocatable :: ngwfnodes
565  real(DP), dimension(:), allocatable :: radius
566  real(DP), dimension(:), allocatable :: bottom
567  ! -- format
568  character(len=*), parameter :: fmthdbot = &
569  "('well head (', G0, ') must be greater than or equal to the &
570  &BOTTOM_ELEVATION (', G0, ').')"
571  !
572  ! -- allocate and initialize temporary variables
573  allocate (strttext(this%nmawwells))
574  allocate (nametxt(this%nmawwells))
575  if (this%naux > 0) then
576  allocate (caux(this%naux, this%nmawwells))
577  end if
578  allocate (nboundchk(this%nmawwells))
579  allocate (wellieqn(this%nmawwells))
580  allocate (ngwfnodes(this%nmawwells))
581  allocate (radius(this%nmawwells))
582  allocate (bottom(this%nmawwells))
583  !
584  ! -- initialize temporary variables
585  do n = 1, this%nmawwells
586  nboundchk(n) = 0
587  end do
588  !
589  ! -- initialize itmp
590  itmp = 0
591  !
592  ! -- set npakeq to nmawwells
593  this%npakeq = this%nmawwells
594  !
595  ! -- read maw well data
596  ! -- get wells block
597  call this%parser%GetBlock('PACKAGEDATA', isfound, ierr, &
598  supportopenclose=.true.)
599  !
600  ! -- parse locations block if detected
601  if (isfound) then
602  write (this%iout, '(/1x,a)') &
603  'PROCESSING '//trim(adjustl(this%text))//' PACKAGEDATA'
604  do
605  call this%parser%GetNextLine(endofblock)
606  if (endofblock) exit
607  ival = this%parser%GetInteger()
608  n = ival
609 
610  if (n < 1 .or. n > this%nmawwells) then
611  write (errmsg, '(a,1x,i0,a)') &
612  'IMAW must be greater than 0 and less than or equal to', &
613  this%nmawwells, '.'
614  call store_error(errmsg)
615  cycle
616  end if
617  !
618  ! -- increment nboundchk
619  nboundchk(n) = nboundchk(n) + 1
620  !
621  ! -- radius
622  rval = this%parser%GetDouble()
623  if (rval <= dzero) then
624  write (errmsg, '(a,1x,i0,1x,a)') &
625  'Radius for well', n, 'must be greater than zero.'
626  call store_error(errmsg)
627  end if
628  radius(n) = rval
629  !
630  ! -- well bottom
631  bottom(n) = this%parser%GetDouble()
632  !
633  ! -- strt
634  call this%parser%GetString(strttext(n))
635  !
636  ! -- ieqn
637  call this%parser%GetStringCaps(keyword)
638  if (keyword == 'SPECIFIED') then
639  ieqn = 0
640  else if (keyword == 'THIEM') then
641  ieqn = 1
642  else if (keyword == 'THEIM') then ! # codespell:ignore
643  ieqn = 1
644  write (warnmsg, '(a,a,a,a,a,a)') &
645  "CONDEQN in '", trim(this%packName), "' should be ", &
646  "corrected from '", trim(keyword), "' to 'THIEM'."
647  call store_warning(warnmsg)
648  else if (keyword == 'SKIN') then
649  ieqn = 2
650  else if (keyword == 'CUMULATIVE') then
651  ieqn = 3
652  else if (keyword == 'MEAN') then
653  ieqn = 4
654  else
655  write (errmsg, '(a,1x,i0,1x,a)') &
656  'CONDEQN for well', n, &
657  "must be 'CUMULATIVE', 'THIEM', 'MEAN', or 'SKIN'."
658  end if
659  wellieqn(n) = ieqn
660  !
661  ! -- ngwnodes
662  ival = this%parser%GetInteger()
663  if (ival < 1) then
664  ival = 0
665  write (errmsg, '(a,1x,i0,1x,a)') &
666  'NGWFNODES for well', n, 'must be greater than zero.'
667  call store_error(errmsg)
668  end if
669 
670  if (ival > 0) then
671  ngwfnodes(n) = ival
672  end if
673  !
674  ! -- increment maxbound
675  itmp = itmp + ival
676  !
677  ! -- get aux data
678  do jj = 1, this%naux
679  call this%parser%GetString(caux(jj, n))
680  end do
681  !
682  ! -- set default bndName
683  write (cno, '(i9.9)') n
684  bndname = 'MAWWELL'//cno
685  !
686  ! -- read well name
687  if (this%inamedbound /= 0) then
688  call this%parser%GetStringCaps(bndnametemp)
689  if (bndnametemp /= '') then
690  bndname = bndnametemp
691  end if
692  end if
693  nametxt(n) = bndname
694  end do
695 
696  write (this%iout, '(1x,a)') &
697  'END OF '//trim(adjustl(this%text))//' PACKAGEDATA'
698  !
699  ! -- check for duplicate or missing wells
700  do n = 1, this%nmawwells
701  if (nboundchk(n) == 0) then
702  write (errmsg, '(a,1x,i0,a)') 'No data specified for maw well', n, '.'
703  call store_error(errmsg)
704  else if (nboundchk(n) > 1) then
705  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') &
706  'Data for maw well', n, 'specified', nboundchk(n), 'times.'
707  call store_error(errmsg)
708  end if
709  end do
710  else
711  call store_error('Required packagedata block not found.')
712  end if
713  !
714  ! -- terminate if any errors were detected
715  if (count_errors() > 0) then
716  call this%parser%StoreErrorUnit()
717  end if
718  !
719  ! -- set MAXBOUND
720  this%maxbound = itmp
721  write (this%iout, '(//4x,a,i7)') 'MAXBOUND = ', this%maxbound
722  !
723  ! -- allocate well and connection data
724  call this%maw_allocate_well_conn_arrays()
725  !
726  ! -- fill well data with data stored in temporary local arrays
727  do n = 1, this%nmawwells
728  rval = radius(n)
729  this%radius(n) = rval
730  this%area(n) = dpi * rval**dtwo
731  this%bot(n) = bottom(n)
732  this%ieqn(n) = wellieqn(n)
733  this%ngwfnodes(n) = ngwfnodes(n)
734  this%cmawname(n) = nametxt(n)
735  !
736  ! fill timeseries aware data
737  !
738  ! -- well_head and strt
739  jj = 1 ! For WELL_HEAD
740  bndelem => this%well_head(n)
741  call read_value_or_time_series_adv(strttext(n), n, jj, bndelem, &
742  this%packName, 'BND', this%tsManager, &
743  this%iprpak, 'WELL_HEAD')
744  !
745  ! -- set starting head value
746  this%strt(n) = this%well_head(n)
747  !
748  ! -- check for error condition
749  if (this%strt(n) < this%bot(n)) then
750  write (cstr, fmthdbot) this%strt(n), this%bot(n)
751  call this%maw_set_attribute_error(n, 'STRT', trim(cstr))
752  end if
753  !
754  ! -- fill aux data
755  do jj = 1, this%naux
756  text = caux(jj, n)
757  ii = n
758  bndelem => this%mauxvar(jj, ii)
759  call read_value_or_time_series_adv(text, ii, jj, bndelem, this%packName, &
760  'AUX', this%tsManager, this%iprpak, &
761  this%auxname(jj))
762  end do
763  end do
764  !
765  ! -- set iaconn and imap for each connection
766  idx = 0
767  this%iaconn(1) = 1
768  do n = 1, this%nmawwells
769  do j = 1, this%ngwfnodes(n)
770  idx = idx + 1
771  this%imap(idx) = n
772  end do
773  this%iaconn(n + 1) = idx + 1
774  end do
775  !
776  ! -- deallocate local storage
777  deallocate (strttext)
778  deallocate (nametxt)
779  if (this%naux > 0) then
780  deallocate (caux)
781  end if
782  deallocate (nboundchk)
783  deallocate (wellieqn)
784  deallocate (ngwfnodes)
785  deallocate (radius)
786  deallocate (bottom)
787  end subroutine maw_read_wells
788 
789  !> @brief Read the dimensions for this package
790  !<
791  subroutine maw_read_well_connections(this)
792  use constantsmodule, only: linelength
793  ! -- dummy
794  class(mawtype), intent(inout) :: this
795  ! -- local
796  character(len=LINELENGTH) :: cellid
797  character(len=30) :: nodestr
798  logical :: isfound
799  logical :: endOfBlock
800  integer(I4B) :: ierr
801  integer(I4B) :: ival
802  integer(I4B) :: j
803  integer(I4B) :: jj
804  integer(I4B) :: n
805  integer(I4B) :: nn
806  integer(I4B) :: nn2
807  integer(I4B) :: ipos
808  integer(I4B) :: jpos
809  integer(I4B) :: ireset_scrntop
810  integer(I4B) :: ireset_scrnbot
811  integer(I4B) :: ireset_wellbot
812  real(DP) :: rval
813  real(DP) :: topnn
814  real(DP) :: botnn
815  real(DP) :: botw
816  integer(I4B), dimension(:), pointer, contiguous :: nboundchk
817  integer(I4B), dimension(:), pointer, contiguous :: iachk
818  !
819  ! -- initialize counters
820  ireset_scrntop = 0
821  ireset_scrnbot = 0
822  ireset_wellbot = 0
823  !
824  ! -- allocate and initialize local storage
825  allocate (iachk(this%nmawwells + 1))
826  iachk(1) = 1
827  do n = 1, this%nmawwells
828  iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
829  end do
830  allocate (nboundchk(this%maxbound))
831  do n = 1, this%maxbound
832  nboundchk(n) = 0
833  end do
834  !
835  ! -- get well_connections block
836  call this%parser%GetBlock('CONNECTIONDATA', isfound, ierr, &
837  supportopenclose=.true.)
838  !
839  ! -- parse well_connections block if detected
840  if (isfound) then
841  write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// &
842  ' CONNECTIONDATA'
843  do
844  call this%parser%GetNextLine(endofblock)
845  if (endofblock) exit
846  !
847  ! -- well number
848  ival = this%parser%GetInteger()
849  n = ival
850  !
851  ! -- check for error condition
852  if (n < 1 .or. n > this%nmawwells) then
853  write (errmsg, '(a,1x,i0,a)') &
854  'IMAW must be greater than 0 and less than or equal to ', &
855  this%nmawwells, '.'
856  call store_error(errmsg)
857  cycle
858  end if
859  !
860  ! -- read connection number
861  ival = this%parser%GetInteger()
862  if (ival < 1 .or. ival > this%ngwfnodes(n)) then
863  write (errmsg, '(a,1x,i0,1x,a,1x,i0,a)') &
864  'JCONN for well ', n, &
865  'must be greater than 1 and less than or equal to ', &
866  this%ngwfnodes(n), '.'
867  call store_error(errmsg)
868  cycle
869  end if
870 
871  ipos = iachk(n) + ival - 1
872  nboundchk(ipos) = nboundchk(ipos) + 1
873 
874  j = ival
875  jpos = this%get_jpos(n, ival)
876  !
877  ! -- read gwfnodes from the line
878  call this%parser%GetCellid(this%dis%ndim, cellid)
879  nn = this%dis%noder_from_cellid(cellid, this%inunit, this%iout)
880  topnn = this%dis%top(nn)
881  botnn = this%dis%bot(nn)
882  botw = this%bot(n)
883  !
884  ! -- set gwf node number for connection
885  this%gwfnodes(jpos) = nn
886  !
887  ! -- top of screen
888  rval = this%parser%GetDouble()
889  if (this%ieqn(n) /= 4) then
890  rval = topnn
891  else
892  if (rval > topnn) then
893  ireset_scrntop = ireset_scrntop + 1
894  rval = topnn
895  end if
896  end if
897  this%topscrn(jpos) = rval
898  !
899  ! -- bottom of screen
900  rval = this%parser%GetDouble()
901  if (this%ieqn(n) /= 4) then
902  rval = botnn
903  else
904  if (rval < botnn) then
905  ireset_scrnbot = ireset_scrnbot + 1
906  rval = botnn
907  end if
908  end if
909  this%botscrn(jpos) = rval
910  !
911  ! -- adjust the bottom of the well for all conductance approaches
912  ! except for "mean"
913  if (rval < botw) then
914  if (this%ieqn(n) /= 4) then
915  ireset_wellbot = ireset_wellbot + 1
916  botw = rval
917  this%bot(n) = rval
918  else
919  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
920  'Screen bottom for maw well', n, 'connection', j, '(', &
921  this%botscrn(jpos), ') is less than the well bottom (', &
922  this%bot(n), ').'
923  call store_error(errmsg)
924  end if
925  end if
926  !
927  ! -- hydraulic conductivity or conductance
928  rval = this%parser%GetDouble()
929  if (this%ieqn(n) == 0) then
930  this%satcond(jpos) = rval
931  else if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
932  this%ieqn(n) == 4) then
933  this%hk(jpos) = rval
934  end if
935  !
936  ! -- skin radius
937  rval = this%parser%GetDouble()
938  if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
939  this%ieqn(n) == 4) then
940  this%sradius(jpos) = rval
941  if (this%sradius(jpos) <= this%radius(n)) then
942  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
943  'Screen radius for maw well', n, 'connection', j, '(', &
944  this%sradius(jpos), &
945  ') is less than or equal to the well radius (', &
946  this%radius(n), ').'
947  call store_error(errmsg)
948  end if
949  end if
950  end do
951  write (this%iout, '(1x,a)') &
952  'END OF '//trim(adjustl(this%text))//' CONNECTIONDATA'
953 
954  ipos = 0
955  do n = 1, this%nmawwells
956  do j = 1, this%ngwfnodes(n)
957  ipos = ipos + 1
958  !
959  ! -- check for missing or duplicate maw well connections
960  if (nboundchk(ipos) == 0) then
961  write (errmsg, '(a,1x,i0,1x,a,1x,i0,a)') &
962  'No data specified for maw well', n, 'connection', j, '.'
963  call store_error(errmsg)
964  else if (nboundchk(ipos) > 1) then
965  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a,1x,i0,1x,a)') &
966  'Data for maw well', n, 'connection', j, &
967  'specified', nboundchk(n), 'times.'
968  call store_error(errmsg)
969  end if
970  end do
971  end do
972  !
973  ! -- make sure that more than one connection per cell is only specified
974  ! wells using the mean conducance type
975  do n = 1, this%nmawwells
976  if (this%ieqn(n) /= 4) then
977  do j = 1, this%ngwfnodes(n)
978  nn = this%get_gwfnode(n, j)
979  do jj = 1, this%ngwfnodes(n)
980  !
981  ! -- skip current maw node
982  if (jj == j) then
983  cycle
984  end if
985  nn2 = this%get_gwfnode(n, jj)
986  if (nn2 == nn) then
987  call this%dis%noder_to_string(nn, nodestr)
988  write (errmsg, '(a,1x,i0,1x,a,1x,i0,3(1x,a))') &
989  'Only one connection can be specified for maw well', &
990  n, 'connection', j, 'to gwf cell', trim(adjustl(nodestr)), &
991  'unless the mean condeqn is specified.'
992  call store_error(errmsg)
993  end if
994  end do
995  end do
996  end if
997  end do
998  else
999  call store_error('Required connectiondata block not found.')
1000  end if
1001  !
1002  ! -- deallocate local variable
1003  deallocate (iachk)
1004  deallocate (nboundchk)
1005  !
1006  ! -- add warning messages
1007  if (ireset_scrntop > 0) then
1008  write (warnmsg, '(a,1x,a,1x,a,1x,i0,1x,a)') &
1009  'The screen tops in multi-aquifer well package', trim(this%packName), &
1010  'were reset to the top of the connected cell', ireset_scrntop, 'times.'
1011  call store_warning(warnmsg)
1012  end if
1013  if (ireset_scrnbot > 0) then
1014  write (warnmsg, '(a,1x,a,1x,a,1x,i0,1x,a)') &
1015  'The screen bottoms in multi-aquifer well package', trim(this%packName), &
1016  'were reset to the bottom of the connected cell', ireset_scrnbot, &
1017  'times.'
1018  call store_warning(warnmsg)
1019  end if
1020  if (ireset_wellbot > 0) then
1021  write (warnmsg, '(a,1x,a,1x,a,1x,i0,1x,a)') &
1022  'The well bottoms in multi-aquifer well package', trim(this%packName), &
1023  'were reset to the bottom of the connected cell', ireset_wellbot, &
1024  'times.'
1025  call store_warning(warnmsg)
1026  end if
1027  !
1028  ! -- write summary of maw well_connection error messages
1029  if (count_errors() > 0) then
1030  call this%parser%StoreErrorUnit()
1031  end if
1032  end subroutine maw_read_well_connections
1033 
1034  !> @brief Read the dimensions for this package
1035  !<
1036  subroutine maw_read_dimensions(this)
1037  use constantsmodule, only: linelength
1038  ! -- dummy
1039  class(mawtype), intent(inout) :: this
1040  ! -- local
1041  character(len=LENBOUNDNAME) :: keyword
1042  integer(I4B) :: ierr
1043  logical :: isfound, endOfBlock
1044  ! -- format
1045  !
1046  ! -- initialize dimensions to -1
1047  this%nmawwells = -1
1048  this%maxbound = -1
1049  !
1050  ! -- get dimensions block
1051  call this%parser%GetBlock('DIMENSIONS', isfound, ierr, &
1052  supportopenclose=.true.)
1053  !
1054  ! -- parse dimensions block if detected
1055  if (isfound) then
1056  write (this%iout, '(/1x,a)') &
1057  'PROCESSING '//trim(adjustl(this%text))//' DIMENSIONS'
1058  do
1059  call this%parser%GetNextLine(endofblock)
1060  if (endofblock) exit
1061  call this%parser%GetStringCaps(keyword)
1062  select case (keyword)
1063  case ('NMAWWELLS')
1064  this%nmawwells = this%parser%GetInteger()
1065  write (this%iout, '(4x,a,i0)') 'NMAWWELLS = ', this%nmawwells
1066  case default
1067  write (errmsg, '(3a)') &
1068  'Unknown '//trim(this%text)//' dimension: ', trim(keyword), '.'
1069  call store_error(errmsg)
1070  end select
1071  end do
1072  write (this%iout, '(1x,a)') &
1073  'END OF '//trim(adjustl(this%text))//' DIMENSIONS'
1074  else
1075  call store_error('Required dimensions block not found.', terminate=.true.)
1076  end if
1077  !
1078  ! -- verify dimensions were set correctly
1079  if (this%nmawwells < 0) then
1080  write (errmsg, '(a)') &
1081  'NMAWWELLS was not specified or was specified incorrectly.'
1082  call store_error(errmsg)
1083  end if
1084  !
1085  ! -- stop if errors were encountered in the DIMENSIONS block
1086  if (count_errors() > 0) then
1087  call this%parser%StoreErrorUnit()
1088  end if
1089  !
1090  ! -- read wells block
1091  call this%maw_read_wells()
1092  !
1093  ! -- read well_connections block
1094  call this%maw_read_well_connections()
1095  !
1096  ! -- Call define_listlabel to construct the list label that is written
1097  ! when PRINT_INPUT option is used.
1098  call this%define_listlabel()
1099  !
1100  ! -- setup the budget object
1101  call this%maw_setup_budobj()
1102  !
1103  ! -- setup the head table object
1104  call this%maw_setup_tableobj()
1105  end subroutine maw_read_dimensions
1106 
1107  !> @brief Read the initial parameters for this package
1108  !<
1109  subroutine maw_read_initial_attr(this)
1110  ! -- modules
1111  use constantsmodule, only: linelength
1112  use memorymanagermodule, only: mem_setptr
1113  ! -- dummy
1114  class(mawtype), intent(inout) :: this
1115  ! -- local
1116  character(len=LINELENGTH) :: title
1117  character(len=LINELENGTH) :: text
1118  integer(I4B) :: ntabcols
1119  integer(I4B) :: j
1120  integer(I4B) :: n
1121  integer(I4B) :: nn
1122  integer(I4B) :: jpos
1123  integer(I4B) :: inode
1124  integer(I4B) :: idx
1125  real(DP) :: k11
1126  real(DP) :: k22
1127  character(len=10), dimension(0:4) :: ccond
1128  character(len=30) :: nodestr
1129  ! -- data
1130  data ccond(0)/'SPECIFIED '/
1131  data ccond(1)/'THIEM '/
1132  data ccond(2)/'SKIN '/
1133  data ccond(3)/'CUMULATIVE'/
1134  data ccond(4)/'MEAN '/
1135  ! -- format
1136  character(len=*), parameter :: fmtwelln = &
1137  "(1X,//43X,'MULTI-AQUIFER WELL DATA'&
1138  &/1X,109('-'),&
1139  &/1X,7(A10,1X),A16)"
1140  character(len=*), parameter :: fmtwelld = &
1141  &"(1X,I10,1X,4(G10.3,1X),I10,1X,A10,1X,A16)"
1142  character(len=*), parameter :: fmtline = &
1143  &"(1X,119('-'),//)"
1144  character(len=*), parameter :: fmtwellcn = &
1145  "(1X,//37X,'MULTI-AQUIFER WELL CONNECTION DATA'&
1146  &/1X,119('-'),&
1147  &/1X,2(A10,1X),A20,7(A10,1X))"
1148  character(len=*), parameter :: fmtwellcd = &
1149  &"(1X,2(I10,1X),A20,1X,2(G10.3,1X),2(A10,1X),3(G10.3,1X))"
1150  !
1151  ! -- initialize xnewpak
1152  do n = 1, this%nmawwells
1153  this%xnewpak(n) = this%strt(n)
1154  this%xsto(n) = this%strt(n)
1155  end do
1156  !
1157  ! -- initialize status (iboundpak) of maw wells to active
1158  do n = 1, this%nmawwells
1159  select case (this%status(n))
1160  case ('CONSTANT')
1161  this%iboundpak(n) = -1
1162  case ('INACTIVE')
1163  this%iboundpak(n) = 0
1164  case ('ACTIVE')
1165  this%iboundpak(n) = 1
1166  end select
1167  end do
1168  !
1169  ! -- set imap and boundname for each connection
1170  if (this%inamedbound /= 0) then
1171  idx = 0
1172  do n = 1, this%nmawwells
1173  do j = 1, this%ngwfnodes(n)
1174  idx = idx + 1
1175  this%boundname(idx) = this%cmawname(n)
1176  this%imap(idx) = n
1177  end do
1178  end do
1179  else
1180  do n = 1, this%nmawwells
1181  this%cmawname(n) = ''
1182  end do
1183  end if
1184  !
1185  ! -- copy boundname into boundname_cst
1186  call this%copy_boundname()
1187  !
1188  ! -- set pointer to gwf iss and gwf hk
1189  call mem_setptr(this%gwfiss, 'ISS', create_mem_path(this%name_model))
1190  call mem_setptr(this%gwfk11, 'K11', create_mem_path(this%name_model, 'NPF'))
1191  call mem_setptr(this%gwfk22, 'K22', create_mem_path(this%name_model, 'NPF'))
1192  call mem_setptr(this%gwfik22, 'IK22', create_mem_path(this%name_model, 'NPF'))
1193  call mem_setptr(this%gwfsat, 'SAT', create_mem_path(this%name_model, 'NPF'))
1194  !
1195  ! -- qa data
1196  call this%maw_check_attributes()
1197  !
1198  ! -- Calculate the saturated conductance
1199  do n = 1, this%nmawwells
1200  !
1201  ! -- calculate saturated conductance only if CONDUCTANCE was not
1202  ! specified for each maw-gwf connection (CONDUCTANCE keyword).
1203  do j = 1, this%ngwfnodes(n)
1204  if (this%ieqn(n) /= 0) then
1205  inode = this%get_gwfnode(n, j)
1206  call this%maw_calculate_satcond(n, j, inode)
1207  end if
1208  end do
1209  end do
1210  !
1211  ! -- write summary of static well data
1212  ! -- write well data
1213  if (this%iprpak /= 0) then
1214  ntabcols = 7
1215  if (this%inamedbound /= 0) then
1216  ntabcols = ntabcols + 1
1217  end if
1218  title = trim(adjustl(this%text))//' PACKAGE ('// &
1219  trim(adjustl(this%packName))//') STATIC WELL DATA'
1220  call table_cr(this%inputtab, this%packName, title)
1221  call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1222  text = 'NUMBER'
1223  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1224  text = 'RADIUS'
1225  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1226  text = 'AREA'
1227  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1228  text = 'WELL BOTTOM'
1229  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1230  text = 'STARTING HEAD'
1231  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1232  text = 'NUMBER OF GWF NODES'
1233  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1234  text = 'CONDUCT. EQUATION'
1235  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1236  if (this%inamedbound /= 0) then
1237  text = 'NAME'
1238  call this%inputtab%initialize_column(text, 20, alignment=tableft)
1239  end if
1240  do n = 1, this%nmawwells
1241  call this%inputtab%add_term(n)
1242  call this%inputtab%add_term(this%radius(n))
1243  call this%inputtab%add_term(this%area(n))
1244  call this%inputtab%add_term(this%bot(n))
1245  call this%inputtab%add_term(this%strt(n))
1246  call this%inputtab%add_term(this%ngwfnodes(n))
1247  call this%inputtab%add_term(ccond(this%ieqn(n)))
1248  if (this%inamedbound /= 0) then
1249  call this%inputtab%add_term(this%cmawname(n))
1250  end if
1251  end do
1252  end if
1253  !
1254  ! -- write well connection data
1255  if (this%iprpak /= 0) then
1256  ntabcols = 10
1257  title = trim(adjustl(this%text))//' PACKAGE ('// &
1258  trim(adjustl(this%packName))//') STATIC WELL CONNECTION DATA'
1259  call table_cr(this%inputtab, this%packName, title)
1260  call this%inputtab%table_df(this%maxbound, ntabcols, this%iout)
1261  text = 'NUMBER'
1262  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1263  text = 'WELL CONNECTION'
1264  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1265  text = 'CELLID'
1266  call this%inputtab%initialize_column(text, 20, alignment=tableft)
1267  text = 'TOP OF SCREEN'
1268  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1269  text = 'BOTTOM OF SCREEN'
1270  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1271  text = 'SKIN RADIUS'
1272  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1273  text = 'SKIN K'
1274  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1275  text = 'K11'
1276  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1277  text = 'K22'
1278  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1279  text = 'SATURATED WELL CONDUCT.'
1280  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1281  !
1282  ! -- write the data to the table
1283  do n = 1, this%nmawwells
1284  do j = 1, this%ngwfnodes(n)
1285  call this%inputtab%add_term(n)
1286  call this%inputtab%add_term(j)
1287  jpos = this%get_jpos(n, j)
1288  nn = this%get_gwfnode(n, j)
1289  call this%dis%noder_to_string(nn, nodestr)
1290  call this%inputtab%add_term(nodestr)
1291  call this%inputtab%add_term(this%topscrn(jpos))
1292  call this%inputtab%add_term(this%botscrn(jpos))
1293  if (this%ieqn(n) == 2 .or. &
1294  this%ieqn(n) == 3 .or. &
1295  this%ieqn(n) == 4) then
1296  call this%inputtab%add_term(this%sradius(jpos))
1297  call this%inputtab%add_term(this%hk(jpos))
1298  else
1299  call this%inputtab%add_term(' ')
1300  call this%inputtab%add_term(' ')
1301  end if
1302  if (this%ieqn(n) == 1 .or. &
1303  this%ieqn(n) == 2 .or. &
1304  this%ieqn(n) == 3) then
1305  k11 = this%gwfk11(nn)
1306  if (this%gwfik22 == 0) then
1307  k22 = this%gwfk11(nn)
1308  else
1309  k22 = this%gwfk22(nn)
1310  end if
1311  call this%inputtab%add_term(k11)
1312  call this%inputtab%add_term(k22)
1313  else
1314  call this%inputtab%add_term(' ')
1315  call this%inputtab%add_term(' ')
1316  end if
1317  call this%inputtab%add_term(this%satcond(jpos))
1318  end do
1319  end do
1320  end if
1321  !
1322  ! -- finished with pointer to gwf hydraulic conductivity
1323  this%gwfk11 => null()
1324  this%gwfk22 => null()
1325  this%gwfik22 => null()
1326  this%gwfsat => null()
1327  !
1328  ! -- check for any error conditions
1329  if (count_errors() > 0) then
1330  call store_error_unit(this%inunit)
1331  end if
1332  end subroutine maw_read_initial_attr
1333 
1334  !> @brief Set a stress period attribute for mawweslls(imaw) using keywords
1335  !<
1336  subroutine maw_set_stressperiod(this, imaw, iheadlimit_warning)
1337  ! -- modules
1339  ! -- dummy
1340  class(mawtype), intent(inout) :: this
1341  integer(I4B), intent(in) :: imaw
1342  integer(I4B), intent(inout) :: iheadlimit_warning
1343  ! -- local
1344  character(len=LINELENGTH) :: errmsgr
1345  character(len=LINELENGTH) :: text
1346  character(len=LINELENGTH) :: cstr
1347  character(len=LINELENGTH) :: caux
1348  character(len=LINELENGTH) :: keyword
1349  integer(I4B) :: ii
1350  integer(I4B) :: jj
1351  real(DP) :: rval
1352  real(DP), pointer :: bndElem => null()
1353  integer(I4B) :: istat
1354  ! -- formats
1355  character(len=*), parameter :: fmthdbot = &
1356  &"('well head (',G0,') must be >= BOTTOM_ELEVATION (',G0, ').')"
1357  !
1358  ! -- read remainder of variables on the line
1359  call this%parser%GetStringCaps(keyword)
1360  select case (keyword)
1361  case ('STATUS')
1362  call this%parser%GetStringCaps(text)
1363  this%status(imaw) = text(1:8)
1364  select case (text)
1365  case ('CONSTANT')
1366  this%iboundpak(imaw) = -1
1367  case ('INACTIVE')
1368  this%iboundpak(imaw) = 0
1369  case ('ACTIVE')
1370  this%iboundpak(imaw) = 1
1371  case default
1372  write (errmsg, '(2a)') &
1373  'Unknown '//trim(this%text)//" maw status keyword: '", &
1374  trim(text)//"'."
1375  call store_error(errmsg)
1376  end select
1377  case ('RATE')
1378  call this%parser%GetString(text)
1379  jj = 1 ! For RATE
1380  bndelem => this%rate(imaw)
1381  call read_value_or_time_series_adv(text, imaw, jj, bndelem, &
1382  this%packName, 'BND', this%tsManager, &
1383  this%iprpak, 'RATE')
1384  case ('WELL_HEAD')
1385  call this%parser%GetString(text)
1386  jj = 1 ! For WELL_HEAD
1387  bndelem => this%well_head(imaw)
1388  call read_value_or_time_series_adv(text, imaw, jj, bndelem, &
1389  this%packName, 'BND', this%tsManager, &
1390  this%iprpak, 'WELL_HEAD')
1391  !
1392  ! -- set xnewpak to well_head
1393  this%xnewpak(imaw) = this%well_head(imaw)
1394  !
1395  ! -- check for error condition
1396  if (this%well_head(imaw) < this%bot(imaw)) then
1397  write (cstr, fmthdbot) &
1398  this%well_head(imaw), this%bot(imaw)
1399  call this%maw_set_attribute_error(imaw, 'WELL HEAD', trim(cstr))
1400  end if
1401  case ('FLOWING_WELL')
1402  this%fwelev(imaw) = this%parser%GetDouble()
1403  this%fwcond(imaw) = this%parser%GetDouble()
1404  this%fwrlen(imaw) = this%parser%GetDouble()
1405  !
1406  ! -- test for condition where flowing well data is specified but
1407  ! flowing_wells is not specified in the options block
1408  if (this%iflowingwells == 0) then
1409  this%iflowingwells = -1
1410  text = 'Flowing well data is specified in the '//trim(this%packName)// &
1411  ' package but FLOWING_WELL was not specified in the '// &
1412  'OPTIONS block.'
1413  call store_warning(text)
1414  end if
1415  case ('RATE_SCALING')
1416  rval = this%parser%GetDouble()
1417  this%pumpelev(imaw) = rval
1418  rval = this%parser%GetDouble()
1419  this%reduction_length(imaw) = rval
1420  if (rval < dzero) then
1421  call this%maw_set_attribute_error(imaw, trim(keyword), &
1422  'must be greater than or equal to 0.')
1423  end if
1424  case ('HEAD_LIMIT')
1425  call this%parser%GetString(text)
1426  if (trim(text) == 'OFF') then
1427  this%shutofflevel(imaw) = dep20
1428  else
1429  read (text, *, iostat=istat, iomsg=errmsgr) &
1430  this%shutofflevel(imaw)
1431  if (istat /= 0) then
1432  errmsg = 'Could not read HEAD_LIMIT value. '//trim(errmsgr)
1433  call store_error(errmsg)
1434  end if
1435  if (this%shutofflevel(imaw) <= this%bot(imaw)) then
1436  iheadlimit_warning = iheadlimit_warning + 1
1437  end if
1438  end if
1439  case ('SHUT_OFF')
1440  rval = this%parser%GetDouble()
1441  this%shutoffmin(imaw) = rval
1442  rval = this%parser%GetDouble()
1443  this%shutoffmax(imaw) = rval
1444  case ('AUXILIARY')
1445  call this%parser%GetStringCaps(caux)
1446  do jj = 1, this%naux
1447  if (trim(adjustl(caux)) /= trim(adjustl(this%auxname(jj)))) cycle
1448  call this%parser%GetString(text)
1449  ii = imaw
1450  bndelem => this%mauxvar(jj, ii)
1451  call read_value_or_time_series_adv(text, ii, jj, bndelem, &
1452  this%packName, 'AUX', &
1453  this%tsManager, this%iprpak, &
1454  this%auxname(jj))
1455  exit
1456  end do
1457  case default
1458  write (errmsg, '(2a)') &
1459  'Unknown '//trim(this%text)//" maw data keyword: '", &
1460  trim(keyword)//"'."
1461  call store_error(errmsg)
1462  end select
1463 
1464  end subroutine maw_set_stressperiod
1465 
1466  !> @brief Issue a parameter error for mawweslls(imaw)
1467  !<
1468  subroutine maw_set_attribute_error(this, imaw, keyword, msg)
1469  use simmodule, only: store_error
1470  ! -- dummy
1471  class(mawtype), intent(inout) :: this
1472  integer(I4B), intent(in) :: imaw
1473  character(len=*), intent(in) :: keyword
1474  character(len=*), intent(in) :: msg
1475  ! -- local
1476  ! -- formats
1477  !
1478  if (len(msg) == 0) then
1479  write (errmsg, '(a,1x,a,1x,i0,1x,a)') &
1480  keyword, ' for MAW well', imaw, 'has already been set.'
1481  else
1482  write (errmsg, '(a,1x,a,1x,i0,1x,a)') &
1483  keyword, ' for MAW well', imaw, msg
1484  end if
1485  call store_error(errmsg)
1486  end subroutine maw_set_attribute_error
1487 
1488  !> @brief Issue parameter errors for mawwells(imaw)
1489  !<
1490  subroutine maw_check_attributes(this)
1491  use simmodule, only: store_error
1492  ! -- dummy
1493  class(mawtype), intent(inout) :: this
1494  ! -- local
1495  character(len=LINELENGTH) :: cgwfnode
1496  integer(I4B) :: idx
1497  integer(I4B) :: n
1498  integer(I4B) :: j
1499  integer(I4B) :: jpos
1500  ! -- formats
1501  !
1502  idx = 1
1503  do n = 1, this%nmawwells
1504  if (this%ngwfnodes(n) < 1) then
1505  call this%maw_set_attribute_error(n, 'NGWFNODES', 'must be greater '// &
1506  'than 0.')
1507  end if
1508  if (this%radius(n) == dep20) then
1509  call this%maw_set_attribute_error(n, 'RADIUS', 'has not been specified.')
1510  end if
1511  if (this%shutoffmin(n) > dzero) then
1512  if (this%shutoffmin(n) >= this%shutoffmax(n)) then
1513  call this%maw_set_attribute_error(n, 'SHUT_OFF', 'shutoffmax must '// &
1514  'be greater than shutoffmin.')
1515  end if
1516  end if
1517  do j = 1, this%ngwfnodes(n)
1518  !
1519  ! -- calculate jpos
1520  jpos = this%get_jpos(n, j)
1521  !
1522  ! -- write gwfnode number
1523  write (cgwfnode, '(a,i0,a)') 'gwfnode(', j, ')'
1524  !
1525  ! -- connection screen data
1526  if (this%botscrn(jpos) >= this%topscrn(jpos)) then
1527  call this%maw_set_attribute_error(n, 'SCREEN_TOP', 'screen bottom '// &
1528  'must be less than screen top. '// &
1529  trim(cgwfnode))
1530  end if
1531  !
1532  ! -- connection skin hydraulic conductivity
1533  if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
1534  this%ieqn(n) == 4) then
1535  if (this%hk(jpos) <= dzero) then
1536  call this%maw_set_attribute_error(n, 'HK_SKIN', 'skin hyraulic '// &
1537  'conductivity must be greater '// &
1538  'than zero. '//trim(cgwfnode))
1539  end if
1540  else if (this%ieqn(n) == 0) then
1541  !
1542  ! -- saturated conductance
1543  if (this%satcond(jpos) < dzero) then
1544  call this%maw_set_attribute_error(n, 'HK_SKIN', &
1545  'skin hyraulic conductivity '// &
1546  'must be greater than or '// &
1547  'equal to zero when using '// &
1548  'SPECIFIED condeqn. '// &
1549  trim(cgwfnode))
1550  end if
1551  end if
1552  idx = idx + 1
1553  end do
1554  end do
1555  ! -- reset check_attr
1556  this%check_attr = 0
1557  end subroutine maw_check_attributes
1558 
1559  !> @brief Add package connection to matrix
1560  !<
1561  subroutine maw_ac(this, moffset, sparse)
1562  use sparsemodule, only: sparsematrix
1563  ! -- dummy
1564  class(mawtype), intent(inout) :: this
1565  integer(I4B), intent(in) :: moffset
1566  type(sparsematrix), intent(inout) :: sparse
1567  ! -- local
1568  integer(I4B) :: j
1569  integer(I4B) :: n
1570  integer(I4B) :: jj
1571  integer(I4B) :: jglo
1572  integer(I4B) :: nglo
1573  ! -- format
1574  !
1575  ! -- Add package rows to sparse
1576  do n = 1, this%nmawwells
1577  nglo = moffset + this%dis%nodes + this%ioffset + n
1578  call sparse%addconnection(nglo, nglo, 1)
1579  do j = 1, this%ngwfnodes(n)
1580  jj = this%get_gwfnode(n, j)
1581  jglo = jj + moffset
1582  call sparse%addconnection(nglo, jglo, 1)
1583  call sparse%addconnection(jglo, nglo, 1)
1584  end do
1585 
1586  end do
1587  end subroutine maw_ac
1588 
1589  !> @brief Map package connection to matrix
1590  !<
1591  subroutine maw_mc(this, moffset, matrix_sln)
1592  use sparsemodule, only: sparsematrix
1594  ! -- dummy
1595  class(mawtype), intent(inout) :: this
1596  integer(I4B), intent(in) :: moffset
1597  class(matrixbasetype), pointer :: matrix_sln
1598  ! -- local
1599  integer(I4B) :: n
1600  integer(I4B) :: j
1601  integer(I4B) :: ii
1602  integer(I4B) :: iglo
1603  integer(I4B) :: jglo
1604  integer(I4B) :: ipos
1605  ! -- format
1606  !
1607  ! -- allocate connection mapping vectors
1608  call mem_allocate(this%idxlocnode, this%nmawwells, 'IDXLOCNODE', &
1609  this%memoryPath)
1610  call mem_allocate(this%idxdglo, this%maxbound, 'IDXDGLO', this%memoryPath)
1611  call mem_allocate(this%idxoffdglo, this%maxbound, 'IDXOFFDGLO', &
1612  this%memoryPath)
1613  call mem_allocate(this%idxsymdglo, this%maxbound, 'IDXSYMDGLO', &
1614  this%memoryPath)
1615  call mem_allocate(this%idxsymoffdglo, this%maxbound, 'IDXSYMOFFDGLO', &
1616  this%memoryPath)
1617  !
1618  ! -- Find the position of each connection in the global ia, ja structure
1619  ! and store them in idxglo. idxglo allows this model to insert or
1620  ! retrieve values into or from the global A matrix
1621  ! -- maw rows
1622  ipos = 1
1623  do n = 1, this%nmawwells
1624  iglo = moffset + this%dis%nodes + this%ioffset + n
1625  this%idxlocnode(n) = this%dis%nodes + this%ioffset + n
1626  do ii = 1, this%ngwfnodes(n)
1627  j = this%get_gwfnode(n, ii)
1628  jglo = j + moffset
1629  this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
1630  this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
1631  ipos = ipos + 1
1632  end do
1633  end do
1634  ! -- maw contributions gwf portion of global matrix
1635  ipos = 1
1636  do n = 1, this%nmawwells
1637  do ii = 1, this%ngwfnodes(n)
1638  iglo = this%get_gwfnode(n, ii) + moffset
1639  jglo = moffset + this%dis%nodes + this%ioffset + n
1640  this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
1641  this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
1642  ipos = ipos + 1
1643  end do
1644  end do
1645  end subroutine maw_mc
1646 
1647  !> @brief Set options specific to MawType.
1648  !!
1649  !! Overrides BndType%bnd_options
1650  !<
1651  subroutine maw_read_options(this, option, found)
1653  use openspecmodule, only: access, form
1655  ! -- dummy
1656  class(mawtype), intent(inout) :: this
1657  character(len=*), intent(inout) :: option
1658  logical, intent(inout) :: found
1659  ! -- local
1660  character(len=MAXCHARLEN) :: fname, keyword
1661  ! -- formats
1662  character(len=*), parameter :: fmtflowingwells = &
1663  &"(4x, 'FLOWING WELLS WILL BE SIMULATED.')"
1664  character(len=*), parameter :: fmtshutdown = &
1665  &"(4x, 'SHUTDOWN ', a, ' VALUE (',g15.7,') SPECIFIED.')"
1666  character(len=*), parameter :: fmtnostoragewells = &
1667  &"(4x, 'WELL STORAGE WILL NOT BE SIMULATED.')"
1668  character(len=*), parameter :: fmtmawbin = &
1669  "(4x, 'MAW ', 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, /4x, &
1670  &'OPENED ON UNIT: ', I0)"
1671  !
1672  ! -- Check for 'FLOWING_WELLS' and set this%iflowingwells
1673  found = .true.
1674  select case (option)
1675  case ('PRINT_HEAD')
1676  this%iprhed = 1
1677  write (this%iout, '(4x,a)') &
1678  trim(adjustl(this%text))//' heads will be printed to listing file.'
1679  case ('HEAD')
1680  call this%parser%GetStringCaps(keyword)
1681  if (keyword == 'FILEOUT') then
1682  call this%parser%GetString(fname)
1683  call assign_iounit(this%iheadout, this%inunit, "HEAD fileout")
1684  call openfile(this%iheadout, this%iout, fname, 'DATA(BINARY)', &
1685  form, access, 'REPLACE', mode_opt=mnormal)
1686  write (this%iout, fmtmawbin) 'HEAD', trim(adjustl(fname)), &
1687  this%iheadout
1688  else
1689  call store_error('Optional maw stage keyword must be '// &
1690  'followed by fileout.')
1691  end if
1692  case ('BUDGET')
1693  call this%parser%GetStringCaps(keyword)
1694  if (keyword == 'FILEOUT') then
1695  call this%parser%GetString(fname)
1696  call assign_iounit(this%ibudgetout, this%inunit, "BUDGET fileout")
1697  call openfile(this%ibudgetout, this%iout, fname, 'DATA(BINARY)', &
1698  form, access, 'REPLACE', mode_opt=mnormal)
1699  write (this%iout, fmtmawbin) 'BUDGET', trim(adjustl(fname)), &
1700  this%ibudgetout
1701  else
1702  call store_error('Optional maw budget keyword must be '// &
1703  'followed by fileout.')
1704  end if
1705  case ('BUDGETCSV')
1706  call this%parser%GetStringCaps(keyword)
1707  if (keyword == 'FILEOUT') then
1708  call this%parser%GetString(fname)
1709  call assign_iounit(this%ibudcsv, this%inunit, "BUDGETCSV fileout")
1710  call openfile(this%ibudcsv, this%iout, fname, 'CSV', &
1711  filstat_opt='REPLACE')
1712  write (this%iout, fmtmawbin) 'BUDGET CSV', trim(adjustl(fname)), &
1713  this%ibudcsv
1714  else
1715  call store_error('OPTIONAL BUDGETCSV KEYWORD MUST BE FOLLOWED BY &
1716  &FILEOUT')
1717  end if
1718  case ('FLOWING_WELLS')
1719  this%iflowingwells = 1
1720  write (this%iout, fmtflowingwells)
1721  case ('SHUTDOWN_THETA')
1722  this%theta = this%parser%GetDouble()
1723  write (this%iout, fmtshutdown) 'THETA', this%theta
1724  case ('SHUTDOWN_KAPPA')
1725  this%kappa = this%parser%GetDouble()
1726  write (this%iout, fmtshutdown) 'KAPPA', this%kappa
1727  case ('MOVER')
1728  this%imover = 1
1729  write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED'
1730  case ('NO_WELL_STORAGE')
1731  this%imawissopt = 1
1732  write (this%iout, fmtnostoragewells)
1733  case ('FLOW_CORRECTION')
1734  this%correct_flow = .true.
1735  write (this%iout, '(4x,a,/,4x,a)') &
1736  'MAW-GWF FLOW CORRECTIONS WILL BE APPLIED WHEN MAW HEADS ARE BELOW', &
1737  'OR GWF HEADS IN CONNECTED CELLS ARE BELOW THE CELL BOTTOM.'
1738  case ('MAW_FLOW_REDUCE_CSV')
1739  call this%parser%GetStringCaps(keyword)
1740  if (keyword == 'FILEOUT') then
1741  call this%parser%GetString(fname)
1742  call this%maw_redflow_csv_init(fname)
1743  else
1744  call store_error('OPTIONAL MAW_FLOW_REDUCE_CSV KEYWORD MUST BE &
1745  &FOLLOWED BY FILEOUT')
1746  end if
1747  !
1748  ! -- right now these are options that are only available in the
1749  ! development version and are not included in the documentation.
1750  ! These options are only available when IDEVELOPMODE in
1751  ! constants module is set to 1
1752  case ('DEV_PEACEMAN_EFFECTIVE_RADIUS')
1753  call this%parser%DevOpt()
1754  this%ieffradopt = 1
1755  write (this%iout, '(4x,a)') &
1756  'EFFECTIVE RADIUS FOR STRUCTURED GRIDS WILL BE CALCULATED &
1757  &USING PEACEMAN 1983'
1758  case default
1759  !
1760  ! -- No options found
1761  found = .false.
1762  end select
1763  end subroutine maw_read_options
1764 
1765  !> @brief Allocate and Read
1766  !!
1767  !! Create new MAW package and point bndobj to the new package
1768  !<
1769  subroutine maw_ar(this)
1770  ! -- dummy
1771  class(mawtype), intent(inout) :: this
1772  ! -- local
1773  ! -- format
1774  !
1775  call this%obs%obs_ar()
1776  !
1777  ! -- set omega value used for saturation calculations
1778  if (this%inewton > 0) then
1779  this%satomega = dem6
1780  end if
1781  !
1782  ! -- Allocate connection arrays in MAW and in package superclass
1783  call this%maw_allocate_arrays()
1784  !
1785  ! -- read optional initial package parameters
1786  call this%read_initial_attr()
1787  !
1788  ! -- setup pakmvrobj
1789  if (this%imover /= 0) then
1790  allocate (this%pakmvrobj)
1791  call this%pakmvrobj%ar(this%nmawwells, this%nmawwells, this%memoryPath)
1792  end if
1793  end subroutine maw_ar
1794 
1795  !> @brief Read and Prepare
1796  !!
1797  !! Read itmp and new boundaries if itmp > 0
1798  !<
1799  subroutine maw_rp(this)
1800  use constantsmodule, only: linelength
1801  use tdismodule, only: kper, nper
1802  ! -- dummy
1803  class(mawtype), intent(inout) :: this
1804  ! -- local
1805  character(len=LINELENGTH) :: title
1806  character(len=LINELENGTH) :: line
1807  character(len=LINELENGTH) :: text
1808  character(len=16) :: csteady
1809  logical :: isfound
1810  logical :: endOfBlock
1811  integer(I4B) :: ierr
1812  integer(I4B) :: node
1813  integer(I4B) :: n
1814  integer(I4B) :: ntabcols
1815  integer(I4B) :: ntabrows
1816  integer(I4B) :: imaw
1817  integer(I4B) :: ibnd
1818  integer(I4B) :: j
1819  integer(I4B) :: jpos
1820  integer(I4B) :: iheadlimit_warning
1821  ! -- formats
1822  character(len=*), parameter :: fmtblkerr = &
1823  &"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
1824  character(len=*), parameter :: fmtlsp = &
1825  &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
1826  !
1827  ! -- initialize counters
1828  iheadlimit_warning = 0
1829  !
1830  ! -- set steady-state flag based on gwfiss
1831  this%imawiss = this%gwfiss
1832  !
1833  ! -- reset maw steady flag if 'STEADY-STATE' specified in the OPTIONS block
1834  if (this%imawissopt == 1) then
1835  this%imawiss = 1
1836  end if
1837  !
1838  ! -- set nbound to maxbound
1839  this%nbound = this%maxbound
1840  !
1841  ! -- Set ionper to the stress period number for which a new block of data
1842  ! will be read.
1843  if (this%inunit == 0) return
1844  !
1845  ! -- get stress period data
1846  if (this%ionper < kper) then
1847  !
1848  ! -- get period block
1849  call this%parser%GetBlock('PERIOD', isfound, ierr, &
1850  supportopenclose=.true., &
1851  blockrequired=.false.)
1852  if (isfound) then
1853  !
1854  ! -- read ionper and check for increasing period numbers
1855  call this%read_check_ionper()
1856  else
1857  !
1858  ! -- PERIOD block not found
1859  if (ierr < 0) then
1860  ! -- End of file found; data applies for remainder of simulation.
1861  this%ionper = nper + 1
1862  else
1863  ! -- Found invalid block
1864  call this%parser%GetCurrentLine(line)
1865  write (errmsg, fmtblkerr) adjustl(trim(line))
1866  call store_error(errmsg, terminate=.true.)
1867  end if
1868  end if
1869  end if
1870  !
1871  ! -- Read data if ionper == kper
1872  if (this%ionper == kper) then
1873  !
1874  ! -- setup table for period data
1875  if (this%iprpak /= 0) then
1876  !
1877  ! -- reset the input table object
1878  title = trim(adjustl(this%text))//' PACKAGE ('// &
1879  trim(adjustl(this%packName))//') DATA FOR PERIOD'
1880  write (title, '(a,1x,i6)') trim(adjustl(title)), kper
1881  call table_cr(this%inputtab, this%packName, title)
1882  call this%inputtab%table_df(1, 5, this%iout, finalize=.false.)
1883  text = 'NUMBER'
1884  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1885  text = 'KEYWORD'
1886  call this%inputtab%initialize_column(text, 20, alignment=tableft)
1887  do n = 1, 3
1888  write (text, '(a,1x,i6)') 'VALUE', n
1889  call this%inputtab%initialize_column(text, 15, alignment=tabcenter)
1890  end do
1891  end if
1892  !
1893  ! -- set flag to check attributes
1894  this%check_attr = 1
1895  do
1896  call this%parser%GetNextLine(endofblock)
1897  if (endofblock) exit
1898 
1899  imaw = this%parser%GetInteger()
1900  if (imaw < 1 .or. imaw > this%nmawwells) then
1901  write (errmsg, '(2(a,1x),i0,a)') &
1902  'IMAW must be greater than 0 and', &
1903  'less than or equal to ', this%nmawwells, '.'
1904  call store_error(errmsg)
1905  cycle
1906  end if
1907  !
1908  ! -- set stress period data
1909  call this%maw_set_stressperiod(imaw, iheadlimit_warning)
1910  !
1911  ! -- write line to table
1912  if (this%iprpak /= 0) then
1913  call this%parser%GetCurrentLine(line)
1914  call this%inputtab%line_to_columns(line)
1915  end if
1916  end do
1917  if (this%iprpak /= 0) then
1918  call this%inputtab%finalize_table()
1919  end if
1920  !
1921  ! -- using data from the last stress period
1922  else
1923  write (this%iout, fmtlsp) trim(this%filtyp)
1924  end if
1925  !
1926  ! -- issue warning messages
1927  if (iheadlimit_warning > 0) then
1928  write (warnmsg, '(a,a,a,1x,a,1x,a)') &
1929  "HEAD_LIMIT in '", trim(this%packName), "' was below the well bottom", &
1930  "for one or more multi-aquifer well(s). This may result in", &
1931  "convergence failures for some models."
1932  call store_warning(warnmsg, substring=warnmsg(:50))
1933  end if
1934  !
1935  ! -- write summary of maw well stress period error messages
1936  if (count_errors() > 0) then
1937  call this%parser%StoreErrorUnit()
1938  end if
1939  !
1940  ! -- qa data if necessary
1941  if (this%check_attr /= 0) then
1942  call this%maw_check_attributes()
1943 
1944  ! -- write summary of stress period data for MAW
1945  if (this%iprpak == 1) then
1946  if (this%imawiss /= 0) then
1947  csteady = 'STEADY-STATE '
1948  else
1949  csteady = 'TRANSIENT '
1950  end if
1951  !
1952  ! -- reset the input table object for rate data
1953  title = trim(adjustl(this%text))//' PACKAGE ('// &
1954  trim(adjustl(this%packName))//') '//trim(adjustl(csteady))// &
1955  ' RATE DATA FOR PERIOD'
1956  write (title, '(a,1x,i6)') trim(adjustl(title)), kper
1957  ntabcols = 6
1958  call table_cr(this%inputtab, this%packName, title)
1959  call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1960  text = 'NUMBER'
1961  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1962  text = 'STATUS'
1963  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1964  text = 'RATE'
1965  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1966  text = 'SPECIFIED HEAD'
1967  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1968  text = 'PUMP ELEVATION'
1969  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1970  text = 'REDUCTION LENGTH'
1971  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
1972  do n = 1, this%nmawwells
1973  call this%inputtab%add_term(n)
1974  call this%inputtab%add_term(this%status(n))
1975  call this%inputtab%add_term(this%rate(n))
1976  if (this%iboundpak(n) < 0) then
1977  call this%inputtab%add_term(this%well_head(n))
1978  else
1979  call this%inputtab%add_term(' ')
1980  end if
1981  call this%inputtab%add_term(this%pumpelev(n))
1982  if (this%reduction_length(n) /= dep20) then
1983  call this%inputtab%add_term(this%reduction_length(n))
1984  else
1985  call this%inputtab%add_term(' ')
1986  end if
1987  end do
1988  !
1989  ! -- flowing wells
1990  if (this%iflowingwells > 0) then
1991  !
1992  ! -- reset the input table object for flowing well data
1993  title = trim(adjustl(this%text))//' PACKAGE ('// &
1994  trim(adjustl(this%packName))//') '//trim(adjustl(csteady))// &
1995  ' FLOWING WELL DATA FOR PERIOD'
1996  write (title, '(a,1x,i6)') trim(adjustl(title)), kper
1997  ntabcols = 4
1998  ntabrows = 0
1999  do n = 1, this%nmawwells
2000  if (this%fwcond(n) > dzero) then
2001  ntabrows = ntabrows + 1
2002  end if
2003  end do
2004  if (ntabrows > 0) then
2005  call table_cr(this%inputtab, this%packName, title)
2006  call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2007  text = 'NUMBER'
2008  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2009  text = 'ELEVATION'
2010  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2011  text = 'CONDUCT.'
2012  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2013  text = 'REDUCTION LENGTH'
2014  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2015  do n = 1, this%nmawwells
2016  if (this%fwcond(n) > dzero) then
2017  call this%inputtab%add_term(n)
2018  call this%inputtab%add_term(this%fwelev(n))
2019  call this%inputtab%add_term(this%fwcond(n))
2020  call this%inputtab%add_term(this%fwrlen(n))
2021  end if
2022  end do
2023  end if
2024  end if
2025  !
2026  ! -- reset the input table object for shutoff data
2027  title = trim(adjustl(this%text))//' PACKAGE ('// &
2028  trim(adjustl(this%packName))//') '//trim(adjustl(csteady))// &
2029  ' WELL SHUTOFF DATA FOR PERIOD'
2030  write (title, '(a,1x,i6)') trim(adjustl(title)), kper
2031  ntabcols = 4
2032  ntabrows = 0
2033  do n = 1, this%nmawwells
2034  if (this%shutofflevel(n) /= dep20) then
2035  ntabrows = ntabrows + 1
2036  end if
2037  end do
2038  if (ntabrows > 0) then
2039  call table_cr(this%inputtab, this%packName, title)
2040  call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2041  text = 'NUMBER'
2042  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2043  text = 'ELEVATION'
2044  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2045  text = 'MINIMUM. Q'
2046  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2047  text = 'MAXIMUM Q'
2048  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2049  do n = 1, this%nmawwells
2050  if (this%shutofflevel(n) /= dep20) then
2051  call this%inputtab%add_term(n)
2052  call this%inputtab%add_term(this%shutofflevel(n))
2053  call this%inputtab%add_term(this%shutoffmin(n))
2054  call this%inputtab%add_term(this%shutoffmax(n))
2055  end if
2056  end do
2057  end if
2058  end if
2059  end if
2060  !
2061  ! -- fill arrays
2062  ibnd = 1
2063  do n = 1, this%nmawwells
2064  do j = 1, this%ngwfnodes(n)
2065  jpos = this%get_jpos(n, j)
2066  node = this%get_gwfnode(n, j)
2067  this%nodelist(ibnd) = node
2068  this%bound(1, ibnd) = this%xnewpak(n)
2069  this%bound(2, ibnd) = this%satcond(jpos)
2070  this%bound(3, ibnd) = this%botscrn(jpos)
2071  if (this%iboundpak(n) > 0) then
2072  this%bound(4, ibnd) = this%rate(n)
2073  else
2074  this%bound(4, ibnd) = dzero
2075  end if
2076  ibnd = ibnd + 1
2077  end do
2078  end do
2079  end subroutine maw_rp
2080 
2081  !> @brief Add package connection to matrix
2082  !<
2083  subroutine maw_ad(this)
2084  use tdismodule, only: kper, kstp
2085  ! -- dummy
2086  class(mawtype) :: this
2087  ! -- local
2088  integer(I4B) :: n
2089  integer(I4B) :: j
2090  integer(I4B) :: jj
2091  integer(I4B) :: ibnd
2092  !
2093  ! -- Advance the time series
2094  call this%TsManager%ad()
2095  !
2096  ! -- update auxiliary variables by copying from the derived-type time
2097  ! series variable into the bndpackage auxvar variable so that this
2098  ! information is properly written to the GWF budget file
2099  if (this%naux > 0) then
2100  ibnd = 1
2101  do n = 1, this%nmawwells
2102  do j = 1, this%ngwfnodes(n)
2103  do jj = 1, this%naux
2104  if (this%noupdateauxvar(jj) /= 0) cycle
2105  this%auxvar(jj, ibnd) = this%mauxvar(jj, n)
2106  end do
2107  ibnd = ibnd + 1
2108  end do
2109  end do
2110  end if
2111  !
2112  ! -- copy xnew into xold
2113  do n = 1, this%nmawwells
2114  this%xoldpak(n) = this%xnewpak(n)
2115  this%xoldsto(n) = this%xsto(n)
2116  if (this%iboundpak(n) < 0) then
2117  this%xnewpak(n) = this%well_head(n)
2118  end if
2119  end do
2120  !
2121  !--use the appropriate xoldsto if initial heads are above the
2122  ! specified flowing well discharge elevation
2123  if (kper == 1 .and. kstp == 1) then
2124  do n = 1, this%nmawwells
2125  if (this%fwcond(n) > dzero) then
2126  if (this%xoldsto(n) > this%fwelev(n)) then
2127  this%xoldsto(n) = this%fwelev(n)
2128  end if
2129  end if
2130  end do
2131  end if
2132  !
2133  ! -- reset ishutoffcnt (equivalent to kiter) to zero
2134  this%ishutoffcnt = 0
2135  !
2136  ! -- pakmvrobj ad
2137  if (this%imover == 1) then
2138  call this%pakmvrobj%ad()
2139  end if
2140  !
2141  ! -- For each observation, push simulated value and corresponding
2142  ! simulation time from "current" to "preceding" and reset
2143  ! "current" value.
2144  call this%obs%obs_ad()
2145  end subroutine maw_ad
2146 
2147  !> @brief Formulate the HCOF and RHS terms
2148  !!
2149  !! Skip if no multi-aquifer wells, otherwise, calculate hcof and rhs
2150  !<
2151  subroutine maw_cf(this)
2152  ! -- dummy
2153  class(mawtype) :: this
2154  ! -- local
2155  !
2156  ! -- Calculate maw conductance and update package RHS and HCOF
2157  call this%maw_cfupdate()
2158  end subroutine maw_cf
2159 
2160  !> @brief Copy rhs and hcof into solution rhs and amat
2161  !<
2162  subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln)
2163  ! -- modules
2164  use tdismodule, only: delt
2165  ! -- dummy
2166  class(mawtype) :: this
2167  real(DP), dimension(:), intent(inout) :: rhs
2168  integer(I4B), dimension(:), intent(in) :: ia
2169  integer(I4B), dimension(:), intent(in) :: idxglo
2170  class(matrixbasetype), pointer :: matrix_sln
2171  ! -- local
2172  integer(I4B) :: j
2173  integer(I4B) :: n
2174  integer(I4B) :: idx
2175  integer(I4B) :: iloc
2176  integer(I4B) :: isymloc
2177  integer(I4B) :: igwfnode
2178  integer(I4B) :: iposd
2179  integer(I4B) :: iposoffd
2180  integer(I4B) :: isymnode
2181  integer(I4B) :: ipossymd
2182  integer(I4B) :: ipossymoffd
2183  integer(I4B) :: jpos
2184  integer(I4B) :: icflow
2185  real(DP) :: hmaw
2186  real(DP) :: hgwf
2187  real(DP) :: cfw
2188  real(DP) :: cmaw
2189  real(DP) :: cterm
2190  real(DP) :: term
2191  real(DP) :: scale
2192  real(DP) :: tp
2193  real(DP) :: bt
2194  real(DP) :: rate
2195  real(DP) :: ratefw
2196  real(DP) :: flow
2197  !
2198  ! -- pakmvrobj fc
2199  if (this%imover == 1) then
2200  call this%pakmvrobj%fc()
2201  end if
2202  !
2203  ! -- Copy package rhs and hcof into solution rhs and amat
2204  idx = 1
2205  do n = 1, this%nmawwells
2206  iloc = this%idxlocnode(n)
2207  !
2208  ! -- update head value for constant head maw wells
2209  if (this%iboundpak(n) < 0) then
2210  this%xnewpak(n) = this%well_head(n)
2211  end if
2212  hmaw = this%xnewpak(n)
2213  !
2214  ! -- add pumping rate to active or constant maw well
2215  if (this%iboundpak(n) == 0) then
2216  this%ratesim(n) = dzero
2217  else
2218  call this%maw_calculate_wellq(n, hmaw, rate)
2219  this%ratesim(n) = rate
2220  rhs(iloc) = rhs(iloc) - rate
2221  !
2222  ! -- location of diagonal for maw row
2223  iposd = this%idxdglo(idx)
2224  !
2225  ! -- add flowing well
2226  this%xsto(n) = hmaw
2227  ratefw = dzero
2228  if (this%iflowingwells > 0) then
2229  if (this%fwcond(n) > dzero) then
2230  bt = this%fwelev(n)
2231  tp = bt + this%fwrlen(n)
2232  scale = sqsaturation(tp, bt, hmaw)
2233  cfw = scale * this%fwcond(n)
2234  this%ifwdischarge(n) = 0
2235  if (cfw > dzero) then
2236  this%ifwdischarge(n) = 1
2237  this%xsto(n) = bt
2238  end if
2239  this%fwcondsim(n) = cfw
2240  call matrix_sln%add_value_pos(iposd, -cfw)
2241  rhs(iloc) = rhs(iloc) - cfw * bt
2242  ratefw = cfw * (bt - hmaw)
2243  end if
2244  end if
2245  !
2246  ! -- add maw storage changes
2247  if (this%imawiss /= 1) then
2248  if (this%ifwdischarge(n) /= 1) then
2249  call matrix_sln%add_value_pos(iposd, -this%area(n) / delt)
2250  rhs(iloc) = rhs(iloc) - (this%area(n) * this%xoldsto(n) / delt)
2251  else
2252  cterm = this%xoldsto(n) - this%fwelev(n)
2253  rhs(iloc) = rhs(iloc) - (this%area(n) * cterm / delt)
2254  end if
2255  end if
2256  !
2257  ! -- If mover is active, add receiver water to rhs and
2258  ! store available water (as positive value)
2259  if (this%imover == 1) then
2260  rhs(iloc) = rhs(iloc) - this%pakmvrobj%get_qfrommvr(n)
2261  !
2262  ! -- add pumping rate to mover if not injection
2263  if (rate < 0) then
2264  call this%pakmvrobj%accumulate_qformvr(n, -rate) !pumped water
2265  end if
2266  !
2267  ! -- add flowing well flow to mover
2268  call this%pakmvrobj%accumulate_qformvr(n, -ratefw) !flowing water
2269  end if
2270  !
2271  end if
2272  !
2273  ! -- process each maw/gwf connection
2274  do j = 1, this%ngwfnodes(n)
2275  if (this%iboundpak(n) /= 0) then
2276  jpos = this%get_jpos(n, j)
2277  igwfnode = this%get_gwfnode(n, j)
2278  hgwf = this%xnew(igwfnode)
2279  !
2280  ! -- calculate connection terms
2281  call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2282  flow)
2283  this%simcond(jpos) = cmaw
2284  !
2285  ! -- add to maw row
2286  iposd = this%idxdglo(idx)
2287  iposoffd = this%idxoffdglo(idx)
2288  call matrix_sln%add_value_pos(iposd, -term)
2289  call matrix_sln%set_value_pos(iposoffd, term)
2290  !
2291  ! -- add correction term
2292  rhs(iloc) = rhs(iloc) - cterm
2293  !
2294  ! -- add to gwf row for maw connection
2295  isymnode = this%get_gwfnode(n, j)
2296  isymloc = ia(isymnode)
2297  ipossymd = this%idxsymdglo(idx)
2298  ipossymoffd = this%idxsymoffdglo(idx)
2299  call matrix_sln%add_value_pos(ipossymd, -term)
2300  call matrix_sln%set_value_pos(ipossymoffd, term)
2301  !
2302  ! -- add correction term to gwf row
2303  rhs(isymnode) = rhs(isymnode) + cterm
2304  end if
2305  !
2306  ! -- increment maw connection counter
2307  idx = idx + 1
2308  end do
2309  end do
2310  end subroutine maw_fc
2311 
2312  !> @brief Fill newton terms
2313  !<
2314  subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln)
2315  ! -- dummy
2316  class(mawtype) :: this
2317  real(DP), dimension(:), intent(inout) :: rhs
2318  integer(I4B), dimension(:), intent(in) :: ia
2319  integer(I4B), dimension(:), intent(in) :: idxglo
2320  class(matrixbasetype), pointer :: matrix_sln
2321  ! -- local
2322  integer(I4B) :: j
2323  integer(I4B) :: n
2324  integer(I4B) :: idx
2325  integer(I4B) :: iloc
2326  integer(I4B) :: isymloc
2327  integer(I4B) :: igwfnode
2328  integer(I4B) :: iposd
2329  integer(I4B) :: iposoffd
2330  integer(I4B) :: isymnode
2331  integer(I4B) :: ipossymd
2332  integer(I4B) :: ipossymoffd
2333  integer(I4B) :: jpos
2334  integer(I4B) :: icflow
2335  real(DP) :: hmaw
2336  real(DP) :: hgwf
2337  real(DP) :: scale
2338  real(DP) :: tp
2339  real(DP) :: bt
2340  real(DP) :: cfw
2341  real(DP) :: rate
2342  real(DP) :: rate2
2343  real(DP) :: rterm
2344  real(DP) :: derv
2345  real(DP) :: drterm
2346  real(DP) :: cmaw
2347  real(DP) :: cterm
2348  real(DP) :: term
2349  real(DP) :: flow
2350  real(DP) :: term2
2351  real(DP) :: rhsterm
2352  !
2353  ! -- Calculate Newton-Raphson corrections
2354  idx = 1
2355  do n = 1, this%nmawwells
2356  iloc = this%idxlocnode(n)
2357  hmaw = this%xnewpak(n)
2358  !
2359  ! -- add pumping rate to active or constant maw well
2360  if (this%iboundpak(n) /= 0) then
2361  iposd = this%idxdglo(idx)
2362  scale = done
2363  drterm = dzero
2364  rate = this%ratesim(n)
2365  !
2366  !-- calculate final derivative for pumping rate
2367  call this%maw_calculate_wellq(n, hmaw + dem4, rate2)
2368  drterm = (rate2 - rate) / dem4
2369  !
2370  !-- fill amat and rhs with newton-raphson terms
2371  call matrix_sln%add_value_pos(iposd, drterm)
2372  rhs(iloc) = rhs(iloc) + drterm * hmaw
2373  !
2374  ! -- add flowing well
2375  if (this%iflowingwells > 0) then
2376  if (this%fwcond(n) > dzero) then
2377  bt = this%fwelev(n)
2378  tp = bt + this%fwrlen(n)
2379  scale = sqsaturation(tp, bt, hmaw)
2380  cfw = scale * this%fwcond(n)
2381  this%ifwdischarge(n) = 0
2382  if (cfw > dzero) then
2383  this%ifwdischarge(n) = 1
2384  end if
2385  this%fwcondsim(n) = cfw
2386  rate = cfw * (bt - hmaw)
2387  rterm = -cfw * hmaw
2388  !
2389  ! --calculate derivative for flowing well
2390  if (hmaw < tp) then
2391  derv = sqsaturationderivative(tp, bt, hmaw)
2392  drterm = -(cfw + this%fwcond(n) * derv * (hmaw - bt))
2393  !
2394  ! -- fill amat and rhs with newton-raphson terms
2395  call matrix_sln%add_value_pos(iposd, &
2396  -this%fwcond(n) * derv * (hmaw - bt))
2397  rhs(iloc) = rhs(iloc) - rterm + drterm * hmaw
2398  end if
2399  end if
2400  end if
2401  end if
2402  !
2403  ! -- process each maw/gwf connection
2404  do j = 1, this%ngwfnodes(n)
2405  if (this%iboundpak(n) /= 0) then
2406  jpos = this%get_jpos(n, j)
2407  igwfnode = this%get_gwfnode(n, j)
2408  hgwf = this%xnew(igwfnode)
2409  !
2410  ! -- add to maw row
2411  iposd = this%idxdglo(idx)
2412  iposoffd = this%idxoffdglo(idx)
2413  !
2414  ! -- add to gwf row for maw connection
2415  isymnode = this%get_gwfnode(n, j)
2416  isymloc = ia(isymnode)
2417  ipossymd = this%idxsymdglo(idx)
2418  ipossymoffd = this%idxsymoffdglo(idx)
2419  !
2420  ! -- calculate newton terms
2421  call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2422  flow, term2)
2423  !
2424  ! -- maw is upstream
2425  if (hmaw > hgwf) then
2426  if (icflow /= 0) then
2427  rhsterm = term2 * hgwf + term * hmaw
2428  rhs(iloc) = rhs(iloc) + rhsterm
2429  rhs(isymnode) = rhs(isymnode) - rhsterm
2430  if (this%iboundpak(n) > 0) then
2431  call matrix_sln%add_value_pos(iposd, term)
2432  call matrix_sln%add_value_pos(iposoffd, term2)
2433  end if
2434  call matrix_sln%add_value_pos(ipossymd, -term2)
2435  call matrix_sln%add_value_pos(ipossymoffd, -term)
2436  else
2437  rhs(iloc) = rhs(iloc) + term * hmaw
2438  rhs(isymnode) = rhs(isymnode) - term * hmaw
2439  call matrix_sln%add_value_pos(iposd, term)
2440  if (this%ibound(igwfnode) > 0) then
2441  call matrix_sln%add_value_pos(ipossymoffd, -term)
2442  end if
2443  end if
2444  !
2445  ! -- gwf is upstream
2446  else
2447  if (icflow /= 0) then
2448  rhsterm = term2 * hmaw + term * hgwf
2449  rhs(iloc) = rhs(iloc) + rhsterm
2450  rhs(isymnode) = rhs(isymnode) - rhsterm
2451  if (this%iboundpak(n) > 0) then
2452  call matrix_sln%add_value_pos(iposd, term2)
2453  call matrix_sln%add_value_pos(iposoffd, term)
2454  end if
2455  call matrix_sln%add_value_pos(ipossymd, -term)
2456  call matrix_sln%add_value_pos(ipossymoffd, -term2)
2457  else
2458  rhs(iloc) = rhs(iloc) + term * hgwf
2459  rhs(isymnode) = rhs(isymnode) - term * hgwf
2460  if (this%iboundpak(n) > 0) then
2461  call matrix_sln%add_value_pos(iposoffd, term)
2462  end if
2463  call matrix_sln%add_value_pos(ipossymd, -term)
2464  end if
2465  end if
2466  end if
2467  !
2468  ! -- increment maw connection counter
2469  idx = idx + 1
2470  end do
2471  end do
2472  end subroutine maw_fn
2473 
2474  !> @brief Calculate under-relaxation of groundwater flow model MAW Package heads
2475  !! for current outer iteration using the well bottom
2476  !<
2477  subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
2478  ! -- dummy
2479  class(mawtype), intent(inout) :: this
2480  integer(I4B), intent(in) :: neqpak
2481  real(DP), dimension(neqpak), intent(inout) :: x
2482  real(DP), dimension(neqpak), intent(in) :: xtemp
2483  real(DP), dimension(neqpak), intent(inout) :: dx
2484  integer(I4B), intent(inout) :: inewtonur
2485  real(DP), intent(inout) :: dxmax
2486  integer(I4B), intent(inout) :: locmax
2487  ! -- local
2488  integer(I4B) :: n
2489  real(DP) :: botw
2490  real(DP) :: xx
2491  real(DP) :: dxx
2492  !
2493  ! -- Newton-Raphson under-relaxation
2494  do n = 1, this%nmawwells
2495  if (this%iboundpak(n) < 1) cycle
2496  botw = this%bot(n)
2497  !
2498  ! -- only apply Newton-Raphson under-relaxation if
2499  ! solution head is below the bottom of the well
2500  if (x(n) < botw) then
2501  inewtonur = 1
2502  xx = xtemp(n) * (done - dp9) + botw * dp9
2503  dxx = x(n) - xx
2504  if (abs(dxx) > abs(dxmax)) then
2505  locmax = n
2506  dxmax = dxx
2507  end if
2508  x(n) = xx
2509  dx(n) = dzero
2510  end if
2511  end do
2512  end subroutine maw_nur
2513 
2514  !> @brief Calculate flows
2515  !<
2516  subroutine maw_cq(this, x, flowja, iadv)
2517  ! -- modules
2518  use tdismodule, only: delt
2519  use constantsmodule, only: lenboundname
2520  use budgetmodule, only: budgettype
2521  ! -- dummy
2522  class(mawtype), intent(inout) :: this
2523  real(DP), dimension(:), intent(in) :: x
2524  real(DP), dimension(:), contiguous, intent(inout) :: flowja
2525  integer(I4B), optional, intent(in) :: iadv
2526  ! -- local
2527  real(DP) :: rrate
2528  ! -- for budget
2529  integer(I4B) :: j
2530  integer(I4B) :: n
2531  integer(I4B) :: ibnd
2532  real(DP) :: hmaw
2533  real(DP) :: cfw
2534  ! -- for observations
2535  ! -- formats
2536  !
2537  ! -- recalculate package HCOF and RHS terms with latest groundwater and
2538  ! maw heads prior to calling base budget functionality
2539  call this%maw_cfupdate()
2540  !
2541  ! -- call base functionality in bnd_cq. This will calculate maw-gwf flows
2542  ! and put them into this%simvals
2543  call this%BndType%bnd_cq(x, flowja, iadv=1)
2544  !
2545  ! -- calculate maw budget flow and storage terms
2546  do n = 1, this%nmawwells
2547  this%qout(n) = dzero
2548  this%qsto(n) = dzero
2549  if (this%iflowingwells > 0) then
2550  this%qfw(n) = dzero
2551  end if
2552  if (this%iboundpak(n) == 0) then
2553  cycle
2554  end if
2555  !
2556  ! -- set hmaw and xsto
2557  hmaw = this%xnewpak(n)
2558  this%xsto(n) = hmaw
2559  !
2560  ! -- add pumping rate to active maw well
2561  rrate = this%ratesim(n)
2562  !
2563  ! -- If flow is out of maw set qout to rrate.
2564  if (rrate < dzero) then
2565  this%qout(n) = rrate
2566  end if
2567  !
2568  ! -- add flowing well
2569  if (this%iflowingwells > 0) then
2570  if (this%fwcond(n) > dzero) then
2571  cfw = this%fwcondsim(n)
2572  this%xsto(n) = this%fwelev(n)
2573  rrate = cfw * (this%fwelev(n) - hmaw)
2574  this%qfw(n) = rrate
2575  !
2576  ! -- Subtract flowing well rrate from qout.
2577  this%qout(n) = this%qout(n) + rrate
2578  end if
2579  end if
2580  !
2581  ! -- Calculate qsto
2582  if (this%imawiss /= 1) then
2583  rrate = -this%area(n) * (this%xsto(n) - this%xoldsto(n)) / delt
2584  this%qsto(n) = rrate
2585  end if
2586  end do
2587  !
2588  ! -- gwf and constant flow
2589  ibnd = 1
2590  do n = 1, this%nmawwells
2591  hmaw = this%xnewpak(n)
2592  this%qconst(n) = dzero
2593  do j = 1, this%ngwfnodes(n)
2594  rrate = -this%simvals(ibnd)
2595  this%qleak(ibnd) = rrate
2596  if (this%iboundpak(n) < 0) then
2597  this%qconst(n) = this%qconst(n) - rrate
2598  !
2599  ! -- If flow is out increment qout by -rrate.
2600  if (-rrate < dzero) then
2601  this%qout(n) = this%qout(n) - rrate
2602  end if
2603  end if
2604  !
2605  ! -- increment ibnd counter
2606  ibnd = ibnd + 1
2607  end do
2608  !
2609  ! -- add additional flow terms to constant head term
2610  if (this%iboundpak(n) < 0) then
2611  !
2612  ! -- add well pumping rate
2613  this%qconst(n) = this%qconst(n) - this%ratesim(n)
2614  !
2615  ! -- add flowing well rate
2616  if (this%iflowingwells > 0) then
2617  this%qconst(n) = this%qconst(n) - this%qfw(n)
2618  end if
2619  !
2620  ! -- add storage term
2621  if (this%imawiss /= 1) then
2622  this%qconst(n) = this%qconst(n) - this%qsto(n)
2623  end if
2624  end if
2625  end do
2626  !
2627  ! -- fill the budget object
2628  call this%maw_fill_budobj()
2629  end subroutine maw_cq
2630 
2631  !> @brief Write flows to binary file and/or print flows to budget
2632  !<
2633  subroutine maw_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap)
2634  ! -- dummy
2635  class(mawtype) :: this
2636  integer(I4B), intent(in) :: icbcfl
2637  integer(I4B), intent(in) :: ibudfl
2638  integer(I4B), intent(in) :: icbcun
2639  integer(I4B), dimension(:), optional, intent(in) :: imap
2640  !
2641  ! -- write the flows from the budobj
2642  call this%BndType%bnd_ot_model_flows(icbcfl, ibudfl, icbcun, this%imap)
2643  end subroutine maw_ot_model_flows
2644 
2645  !> @brief Output MAW package flow terms.
2646  !<
2647  subroutine maw_ot_package_flows(this, icbcfl, ibudfl)
2648  use tdismodule, only: kstp, kper, delt, pertim, totim
2649  class(mawtype) :: this
2650  integer(I4B), intent(in) :: icbcfl
2651  integer(I4B), intent(in) :: ibudfl
2652  integer(I4B) :: ibinun
2653  !
2654  ! -- write the flows from the budobj
2655  ibinun = 0
2656  if (this%ibudgetout /= 0) then
2657  ibinun = this%ibudgetout
2658  end if
2659  if (icbcfl == 0) ibinun = 0
2660  if (ibinun > 0) then
2661  call this%budobj%save_flows(this%dis, ibinun, kstp, kper, delt, &
2662  pertim, totim, this%iout)
2663  end if
2664  !
2665  ! -- Print maw flows table
2666  if (ibudfl /= 0 .and. this%iprflow /= 0) then
2667  call this%budobj%write_flowtable(this%dis, kstp, kper)
2668  end if
2669  end subroutine maw_ot_package_flows
2670 
2671  !> @brief Save maw-calculated values to binary file
2672  !<
2673  subroutine maw_ot_dv(this, idvsave, idvprint)
2674  use tdismodule, only: kstp, kper, pertim, totim
2675  use constantsmodule, only: dhnoflo, dhdry
2676  use inputoutputmodule, only: ulasav
2677  class(mawtype) :: this
2678  integer(I4B), intent(in) :: idvsave
2679  integer(I4B), intent(in) :: idvprint
2680  integer(I4B) :: ibinun
2681  integer(I4B) :: n
2682  real(DP) :: v
2683  real(DP) :: d
2684  !
2685  ! -- set unit number for binary dependent variable output
2686  ibinun = 0
2687  if (this%iheadout /= 0) then
2688  ibinun = this%iheadout
2689  end if
2690  if (idvsave == 0) ibinun = 0
2691  !
2692  ! -- write maw binary output
2693  if (ibinun > 0) then
2694  do n = 1, this%nmawwells
2695  v = this%xnewpak(n)
2696  d = v - this%bot(n)
2697  if (this%iboundpak(n) == 0) then
2698  v = dhnoflo
2699  else if (d <= dzero) then
2700  v = dhdry
2701  end if
2702  this%dbuff(n) = v
2703  end do
2704  call ulasav(this%dbuff, ' HEAD', &
2705  kstp, kper, pertim, totim, &
2706  this%nmawwells, 1, 1, ibinun)
2707  end if
2708  !
2709  ! -- write maw head table
2710  if (idvprint /= 0 .and. this%iprhed /= 0) then
2711  !
2712  ! -- set table kstp and kper
2713  call this%headtab%set_kstpkper(kstp, kper)
2714  !
2715  ! -- fill stage data
2716  do n = 1, this%nmawwells
2717  if (this%inamedbound == 1) then
2718  call this%headtab%add_term(this%cmawname(n))
2719  end if
2720  call this%headtab%add_term(n)
2721  call this%headtab%add_term(this%xnewpak(n))
2722  end do
2723  end if
2724  end subroutine maw_ot_dv
2725 
2726  !> @brief Write MAW budget to listing file
2727  !<
2728  subroutine maw_ot_bdsummary(this, kstp, kper, iout, ibudfl)
2729  ! -- module
2730  use tdismodule, only: totim, delt
2731  ! -- dummy
2732  class(mawtype) :: this !< MawType object
2733  integer(I4B), intent(in) :: kstp !< time step number
2734  integer(I4B), intent(in) :: kper !< period number
2735  integer(I4B), intent(in) :: iout !< flag and unit number for the model listing file
2736  integer(I4B), intent(in) :: ibudfl !< flag indicating budget should be written
2737  !
2738  call this%budobj%write_budtable(kstp, kper, iout, ibudfl, totim, delt)
2739  end subroutine maw_ot_bdsummary
2740 
2741  !> @brief Deallocate memory
2742  !<
2743  subroutine maw_da(this)
2744  ! -- modules
2746  ! -- dummy
2747  class(mawtype) :: this
2748  ! -- local
2749  !
2750  ! -- budobj
2751  call this%budobj%budgetobject_da()
2752  deallocate (this%budobj)
2753  nullify (this%budobj)
2754  !
2755  ! -- head table
2756  if (this%iprhed > 0) then
2757  call this%headtab%table_da()
2758  deallocate (this%headtab)
2759  nullify (this%headtab)
2760  end if
2761  !
2762  ! -- character arrays
2763  call mem_deallocate(this%cmawbudget, 'CMAWBUDGET', this%memoryPath)
2764  call mem_deallocate(this%cmawname, 'CMAWNAME', this%memoryPath)
2765  call mem_deallocate(this%status, 'STATUS', this%memoryPath)
2766  !
2767  ! -- deallocate well data pointers in memory manager
2768  call mem_deallocate(this%ngwfnodes)
2769  call mem_deallocate(this%ieqn)
2770  call mem_deallocate(this%ishutoff)
2771  call mem_deallocate(this%ifwdischarge)
2772  call mem_deallocate(this%strt)
2773  call mem_deallocate(this%radius)
2774  call mem_deallocate(this%area)
2775  call mem_deallocate(this%pumpelev)
2776  call mem_deallocate(this%bot)
2777  call mem_deallocate(this%ratesim)
2778  call mem_deallocate(this%reduction_length)
2779  call mem_deallocate(this%fwelev)
2780  call mem_deallocate(this%fwcond)
2781  call mem_deallocate(this%fwrlen)
2782  call mem_deallocate(this%fwcondsim)
2783  call mem_deallocate(this%xsto)
2784  call mem_deallocate(this%xoldsto)
2785  call mem_deallocate(this%shutoffmin)
2786  call mem_deallocate(this%shutoffmax)
2787  call mem_deallocate(this%shutofflevel)
2788  call mem_deallocate(this%shutoffweight)
2789  call mem_deallocate(this%shutoffdq)
2790  call mem_deallocate(this%shutoffqold)
2791  !
2792  ! -- timeseries aware variables
2793  call mem_deallocate(this%mauxvar)
2794  call mem_deallocate(this%rate)
2795  call mem_deallocate(this%well_head)
2796  !
2797  ! -- connection data
2798  call mem_deallocate(this%iaconn)
2799  call mem_deallocate(this%gwfnodes)
2800  call mem_deallocate(this%sradius)
2801  call mem_deallocate(this%hk)
2802  call mem_deallocate(this%satcond)
2803  call mem_deallocate(this%simcond)
2804  call mem_deallocate(this%topscrn)
2805  call mem_deallocate(this%botscrn)
2806  !
2807  ! -- imap vector
2808  call mem_deallocate(this%imap)
2809  call mem_deallocate(this%dbuff)
2810  call mem_deallocate(this%cauxcbc, 'CAUXCBC', this%memoryPath)
2811  call mem_deallocate(this%qauxcbc)
2812  call mem_deallocate(this%qleak)
2813  call mem_deallocate(this%qfw)
2814  call mem_deallocate(this%qout)
2815  call mem_deallocate(this%qsto)
2816  call mem_deallocate(this%qconst)
2817  call mem_deallocate(this%denseterms)
2818  call mem_deallocate(this%viscratios)
2819  call mem_deallocate(this%idxlocnode)
2820  call mem_deallocate(this%idxdglo)
2821  call mem_deallocate(this%idxoffdglo)
2822  call mem_deallocate(this%idxsymdglo)
2823  call mem_deallocate(this%idxsymoffdglo)
2824  call mem_deallocate(this%xoldpak)
2825  !
2826  ! -- nullify pointers
2827  call mem_deallocate(this%xnewpak, 'HEAD', this%memoryPath)
2828  !
2829  ! -- scalars
2830  call mem_deallocate(this%correct_flow)
2831  call mem_deallocate(this%iprhed)
2832  call mem_deallocate(this%iheadout)
2833  call mem_deallocate(this%ibudgetout)
2834  call mem_deallocate(this%ibudcsv)
2835  call mem_deallocate(this%iflowingwells)
2836  call mem_deallocate(this%imawiss)
2837  call mem_deallocate(this%imawissopt)
2838  call mem_deallocate(this%nmawwells)
2839  call mem_deallocate(this%check_attr)
2840  call mem_deallocate(this%ishutoffcnt)
2841  call mem_deallocate(this%ieffradopt)
2842  call mem_deallocate(this%ioutredflowcsv)
2843  call mem_deallocate(this%satomega)
2844  call mem_deallocate(this%bditems)
2845  call mem_deallocate(this%theta)
2846  call mem_deallocate(this%kappa)
2847  call mem_deallocate(this%cbcauxitems)
2848  call mem_deallocate(this%idense)
2849  !
2850  ! -- pointers to gwf variables
2851  nullify (this%gwfiss)
2852  !
2853  ! -- call standard BndType deallocate
2854  call this%BndType%bnd_da()
2855  end subroutine maw_da
2856 
2857  !> @brief Define the list heading that is written to iout when PRINT_INPUT
2858  !! option is used.
2859  !<
2860  subroutine define_listlabel(this)
2861  class(mawtype), intent(inout) :: this
2862  !
2863  ! -- create the header list label
2864  this%listlabel = trim(this%filtyp)//' NO.'
2865  if (this%dis%ndim == 3) then
2866  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER'
2867  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'ROW'
2868  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'COL'
2869  elseif (this%dis%ndim == 2) then
2870  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER'
2871  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'CELL2D'
2872  else
2873  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'NODE'
2874  end if
2875  write (this%listlabel, '(a, a16)') trim(this%listlabel), 'STRESS RATE'
2876  if (this%inamedbound == 1) then
2877  write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
2878  end if
2879  end subroutine define_listlabel
2880 
2881  !> @brief Set pointers to model arrays and variables so that a package has
2882  !! has access to these things.
2883  !<
2884  subroutine maw_set_pointers(this, neq, ibound, xnew, xold, flowja)
2885  ! -- modules
2887  ! -- dummy
2888  class(mawtype) :: this
2889  integer(I4B), pointer :: neq
2890  integer(I4B), dimension(:), pointer, contiguous :: ibound
2891  real(DP), dimension(:), pointer, contiguous :: xnew
2892  real(DP), dimension(:), pointer, contiguous :: xold
2893  real(DP), dimension(:), pointer, contiguous :: flowja
2894  ! -- local
2895  integer(I4B) :: n
2896  integer(I4B) :: istart, iend
2897  !
2898  ! -- call base BndType set_pointers
2899  call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja)
2900  !
2901  ! -- Set the MAW pointers
2902  !
2903  ! -- set package pointers
2904  istart = this%dis%nodes + this%ioffset + 1
2905  iend = istart + this%nmawwells - 1
2906  this%iboundpak => this%ibound(istart:iend)
2907  this%xnewpak => this%xnew(istart:iend)
2908  call mem_checkin(this%xnewpak, 'HEAD', this%memoryPath, 'X', &
2909  this%memoryPathModel)
2910  call mem_allocate(this%xoldpak, this%nmawwells, 'XOLDPAK', this%memoryPath)
2911  !
2912  ! -- initialize xnewpak
2913  do n = 1, this%nmawwells
2914  this%xnewpak(n) = dep20
2915  end do
2916  end subroutine maw_set_pointers
2917 
2918  ! -- Procedures related to observations (type-bound)
2919 
2920  !> @brief Return true because MAW package supports observations
2921  !!
2922  !! Overrides BndType%bnd_obs_supported()
2923  !<
2924  logical function maw_obs_supported(this)
2925  class(mawtype) :: this
2926  !
2927  maw_obs_supported = .true.
2928  end function maw_obs_supported
2929 
2930  !> @brief Store observation type supported by MAW package
2931  !!
2932  !! Overrides BndType%bnd_df_obs
2933  !<
2934  subroutine maw_df_obs(this)
2935  ! -- dummy
2936  class(mawtype) :: this
2937  ! -- local
2938  integer(I4B) :: indx
2939  !
2940  ! -- Store obs type and assign procedure pointer
2941  ! for head observation type.
2942  call this%obs%StoreObsType('head', .false., indx)
2943  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2944  !
2945  ! -- Store obs type and assign procedure pointer
2946  ! for frommvr observation type.
2947  call this%obs%StoreObsType('from-mvr', .false., indx)
2948  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2949  !
2950  ! -- Store obs type and assign procedure pointer
2951  ! for conn-rate observation type.
2952  call this%obs%StoreObsType('maw', .true., indx)
2953  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2954  !
2955  ! -- Store obs type and assign procedure pointer
2956  ! for rate observation type.
2957  call this%obs%StoreObsType('rate', .true., indx)
2958  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2959  !
2960  ! -- Store obs type and assign procedure pointer
2961  ! for rate-to-mvr observation type.
2962  call this%obs%StoreObsType('rate-to-mvr', .true., indx)
2963  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2964  !
2965  ! -- Store obs type and assign procedure pointer
2966  ! for fw-rate observation type.
2967  call this%obs%StoreObsType('fw-rate', .true., indx)
2968  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2969  !
2970  ! -- Store obs type and assign procedure pointer
2971  ! for rate-to-mvr observation type.
2972  call this%obs%StoreObsType('fw-to-mvr', .true., indx)
2973  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2974  !
2975  ! -- Store obs type and assign procedure pointer
2976  ! for storage observation type.
2977  call this%obs%StoreObsType('storage', .true., indx)
2978  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2979  !
2980  ! -- Store obs type and assign procedure pointer
2981  ! for constant observation type.
2982  call this%obs%StoreObsType('constant', .true., indx)
2983  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2984  !
2985  ! -- Store obs type and assign procedure pointer
2986  ! for cond observation type.
2987  call this%obs%StoreObsType('conductance', .true., indx)
2988  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2989  !
2990  ! -- Store obs type and assign procedure pointer
2991  ! for fw-conductance observation type.
2992  call this%obs%StoreObsType('fw-conductance', .true., indx)
2993  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
2994  end subroutine maw_df_obs
2995 
2996  !> @brief Calculate observations this time step and call
2997  !! ObsType%SaveOneSimval for each MawType observation.
2998  !<
2999  subroutine maw_bd_obs(this)
3000  ! -- dummy
3001  class(mawtype) :: this
3002  ! -- local
3003  integer(I4B) :: i
3004  integer(I4B) :: j
3005  integer(I4B) :: jj
3006  integer(I4B) :: n
3007  integer(I4B) :: nn
3008  integer(I4B) :: jpos
3009  real(DP) :: cmaw
3010  real(DP) :: hmaw
3011  real(DP) :: v
3012  real(DP) :: qfact
3013  type(observetype), pointer :: obsrv => null()
3014  !
3015  ! Calculate, save, and write simulated values for all MAW observations
3016  if (this%obs%npakobs > 0) then
3017  call this%obs%obs_bd_clear()
3018  do i = 1, this%obs%npakobs
3019  obsrv => this%obs%pakobs(i)%obsrv
3020  do j = 1, obsrv%indxbnds_count
3021  v = dnodata
3022  jj = obsrv%indxbnds(j)
3023  select case (obsrv%ObsTypeId)
3024  case ('HEAD')
3025  if (this%iboundpak(jj) /= 0) then
3026  v = this%xnewpak(jj)
3027  end if
3028  case ('FROM-MVR')
3029  if (this%iboundpak(jj) /= 0) then
3030  if (this%imover == 1) then
3031  v = this%pakmvrobj%get_qfrommvr(jj)
3032  end if
3033  end if
3034  case ('MAW')
3035  n = this%imap(jj)
3036  if (this%iboundpak(n) /= 0) then
3037  v = this%qleak(jj)
3038  end if
3039  case ('RATE')
3040  if (this%iboundpak(jj) /= 0) then
3041  v = this%ratesim(jj)
3042  if (v < dzero .and. this%qout(jj) < dzero) then
3043  qfact = v / this%qout(jj)
3044  if (this%imover == 1) then
3045  v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3046  end if
3047  end if
3048  end if
3049  case ('RATE-TO-MVR')
3050  if (this%iboundpak(jj) /= 0) then
3051  if (this%imover == 1) then
3052  v = this%ratesim(jj)
3053  qfact = dzero
3054  if (v < dzero .and. this%qout(jj) < dzero) then
3055  qfact = v / this%qout(jj)
3056  end if
3057  v = this%pakmvrobj%get_qtomvr(jj) * qfact
3058  if (v > dzero) then
3059  v = -v
3060  end if
3061  end if
3062  end if
3063  case ('FW-RATE')
3064  if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0) then
3065  hmaw = this%xnewpak(jj)
3066  cmaw = this%fwcondsim(jj)
3067  v = cmaw * (this%fwelev(jj) - hmaw)
3068  if (v < dzero .and. this%qout(jj) < dzero) then
3069  qfact = v / this%qout(jj)
3070  if (this%imover == 1) then
3071  v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3072  end if
3073  end if
3074  end if
3075  case ('FW-TO-MVR')
3076  if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0) then
3077  if (this%imover == 1) then
3078  hmaw = this%xnewpak(jj)
3079  cmaw = this%fwcondsim(jj)
3080  v = cmaw * (this%fwelev(jj) - hmaw)
3081  qfact = dzero
3082  if (v < dzero .and. this%qout(jj) < dzero) then
3083  qfact = v / this%qout(jj)
3084  end if
3085  v = this%pakmvrobj%get_qtomvr(jj) * qfact
3086  if (v > dzero) then
3087  v = -v
3088  end if
3089  end if
3090  end if
3091  case ('STORAGE')
3092  if (this%iboundpak(jj) /= 0 .and. this%imawissopt /= 1) then
3093  v = this%qsto(jj)
3094  end if
3095  case ('CONSTANT')
3096  if (this%iboundpak(jj) /= 0) then
3097  v = this%qconst(jj)
3098  end if
3099  case ('CONDUCTANCE')
3100  n = this%imap(jj)
3101  if (this%iboundpak(n) /= 0) then
3102  nn = jj - this%iaconn(n) + 1
3103  jpos = this%get_jpos(n, nn)
3104  v = this%simcond(jpos)
3105  end if
3106  case ('FW-CONDUCTANCE')
3107  if (this%iboundpak(jj) /= 0) then
3108  v = this%fwcondsim(jj)
3109  end if
3110  case default
3111  errmsg = 'Unrecognized observation type: '//trim(obsrv%ObsTypeId)
3112  call store_error(errmsg)
3113  end select
3114  call this%obs%SaveOneSimval(obsrv, v)
3115  end do
3116  end do
3117  !
3118  ! -- write summary of error messages
3119  if (count_errors() > 0) then
3120  call store_error_unit(this%inunit)
3121  end if
3122  end if
3123  !
3124  ! -- Write the MAW reduced flows to csv file entries for this step
3125  if (this%ioutredflowcsv > 0) then
3126  call this%maw_redflow_csv_write()
3127  end if
3128  end subroutine maw_bd_obs
3129 
3130  !> @brief Process each observation
3131  !!
3132  !! Only done the first stress period since boundaries are fixed for the
3133  !! simulation
3134  !<
3135  subroutine maw_rp_obs(this)
3136  use tdismodule, only: kper
3137  ! -- dummy
3138  class(mawtype), intent(inout) :: this
3139  ! -- local
3140  integer(I4B) :: i
3141  integer(I4B) :: j
3142  integer(I4B) :: n
3143  integer(I4B) :: nn1
3144  integer(I4B) :: nn2
3145  integer(I4B) :: jj
3146  character(len=LENBOUNDNAME) :: bname
3147  logical :: jfound
3148  class(observetype), pointer :: obsrv => null()
3149  ! -- formats
3150 10 format('Boundary "', a, '" for observation "', a, &
3151  '" is invalid in package "', a, '"')
3152  !
3153  if (kper == 1) then
3154  do i = 1, this%obs%npakobs
3155  obsrv => this%obs%pakobs(i)%obsrv
3156  !
3157  ! -- get node number 1
3158  nn1 = obsrv%NodeNumber
3159  if (nn1 == namedboundflag) then
3160  bname = obsrv%FeatureName
3161  if (bname /= '') then
3162  ! -- Observation maw is based on a boundary name.
3163  ! Iterate through all multi-aquifer wells to identify and store
3164  ! corresponding index in bound array.
3165  jfound = .false.
3166  if (obsrv%ObsTypeId == 'MAW' .or. &
3167  obsrv%ObsTypeId == 'CONDUCTANCE') then
3168  do j = 1, this%nmawwells
3169  do jj = this%iaconn(j), this%iaconn(j + 1) - 1
3170  if (this%boundname(jj) == bname) then
3171  jfound = .true.
3172  call obsrv%AddObsIndex(jj)
3173  end if
3174  end do
3175  end do
3176  else
3177  do j = 1, this%nmawwells
3178  if (this%cmawname(j) == bname) then
3179  jfound = .true.
3180  call obsrv%AddObsIndex(j)
3181  end if
3182  end do
3183  end if
3184  if (.not. jfound) then
3185  write (errmsg, 10) &
3186  trim(bname), trim(obsrv%Name), trim(this%packName)
3187  call store_error(errmsg)
3188  end if
3189  end if
3190  else
3191  if (obsrv%indxbnds_count == 0) then
3192  if (obsrv%ObsTypeId == 'MAW' .or. &
3193  obsrv%ObsTypeId == 'CONDUCTANCE') then
3194  nn2 = obsrv%NodeNumber2
3195  j = this%iaconn(nn1) + nn2 - 1
3196  call obsrv%AddObsIndex(j)
3197  else
3198  call obsrv%AddObsIndex(nn1)
3199  end if
3200  else
3201  errmsg = 'Programming error in maw_rp_obs'
3202  call store_error(errmsg)
3203  end if
3204  end if
3205  !
3206  ! -- catch non-cumulative observation assigned to observation defined
3207  ! by a boundname that is assigned to more than one element
3208  if (obsrv%ObsTypeId == 'HEAD') then
3209  if (obsrv%indxbnds_count > 1) then
3210  write (errmsg, '(a,3(1x,a))') &
3211  trim(adjustl(obsrv%ObsTypeId)), &
3212  'for observation', trim(adjustl(obsrv%Name)), &
3213  'must be assigned to a multi-aquifer well with a unique boundname.'
3214  call store_error(errmsg)
3215  end if
3216  end if
3217  !
3218  ! -- check that index values are valid
3219  if (obsrv%ObsTypeId == 'MAW' .or. &
3220  obsrv%ObsTypeId == 'CONDUCTANCE') then
3221  do j = 1, obsrv%indxbnds_count
3222  nn1 = obsrv%indxbnds(j)
3223  n = this%imap(nn1)
3224  nn2 = nn1 - this%iaconn(n) + 1
3225  jj = this%iaconn(n + 1) - this%iaconn(n)
3226  if (nn1 < 1 .or. nn1 > this%maxbound) then
3227  write (errmsg, '(3(a,1x),i0,1x,a,i0,a)') &
3228  trim(adjustl(obsrv%ObsTypeId)), &
3229  'multi-aquifer well connection number must be greater than 0', &
3230  'and less than', jj, '(specified value is ', nn2, ').'
3231  call store_error(errmsg)
3232  end if
3233  end do
3234  else
3235  do j = 1, obsrv%indxbnds_count
3236  nn1 = obsrv%indxbnds(j)
3237  if (nn1 < 1 .or. nn1 > this%nmawwells) then
3238  write (errmsg, '(3(a,1x),i0,1x,a,i0,a)') &
3239  trim(adjustl(obsrv%ObsTypeId)), &
3240  'multi-aquifer well must be greater than 0 ', &
3241  'and less than or equal to', this%nmawwells, &
3242  '(specified value is ', nn1, ').'
3243  call store_error(errmsg)
3244  end if
3245  end do
3246  end if
3247  end do
3248  !
3249  ! -- evaluate if there are any observation errors
3250  if (count_errors() > 0) then
3251  call store_error_unit(this%inunit)
3252  end if
3253  end if
3254  end subroutine maw_rp_obs
3255 
3256  !
3257  ! -- Procedures related to observations (NOT type-bound)
3258 
3259  !> @brief This procedure is pointed to by ObsDataType%ProcesssIdPtr. It
3260  !! processes the ID string of an observation definition for MAW package
3261  !! observations.
3262  !<
3263  subroutine maw_process_obsid(obsrv, dis, inunitobs, iout)
3264  ! -- dummy
3265  type(observetype), intent(inout) :: obsrv
3266  class(disbasetype), intent(in) :: dis
3267  integer(I4B), intent(in) :: inunitobs
3268  integer(I4B), intent(in) :: iout
3269  ! -- local
3270  integer(I4B) :: nn1, nn2
3271  integer(I4B) :: icol, istart, istop
3272  character(len=LINELENGTH) :: string
3273  character(len=LENBOUNDNAME) :: bndname
3274  ! formats
3275  !
3276  string = obsrv%IDstring
3277  ! -- Extract multi-aquifer well number from string and store it.
3278  ! If 1st item is not an integer(I4B), it should be a
3279  ! maw name--deal with it.
3280  icol = 1
3281  ! -- get multi-aquifer well number or boundary name
3282  call extract_idnum_or_bndname(string, icol, istart, istop, nn1, bndname)
3283  if (nn1 == namedboundflag) then
3284  obsrv%FeatureName = bndname
3285  else
3286  if (obsrv%ObsTypeId == 'MAW' .or. &
3287  obsrv%ObsTypeId == 'CONDUCTANCE') then
3288  call extract_idnum_or_bndname(string, icol, istart, istop, nn2, bndname)
3289  if (len_trim(bndname) < 1 .and. nn2 < 0) then
3290  write (errmsg, '(a,1x,a,a,1x,a,1x,a)') &
3291  'For observation type', trim(adjustl(obsrv%ObsTypeId)), &
3292  ', ID given as an integer and not as boundname,', &
3293  'but ID2 (icon) is missing. Either change ID to valid', &
3294  'boundname or supply valid entry for ID2.'
3295  call store_error(errmsg)
3296  end if
3297  if (nn2 == namedboundflag) then
3298  obsrv%FeatureName = bndname
3299  ! -- reset nn1
3300  nn1 = nn2
3301  else
3302  obsrv%NodeNumber2 = nn2
3303  end if
3304  end if
3305  end if
3306  ! -- store multi-aquifer well number (NodeNumber)
3307  obsrv%NodeNumber = nn1
3308  end subroutine maw_process_obsid
3309 
3310  !
3311  ! -- private MAW methods
3312 
3313  !> @brief Initialize the auto flow reduce csv output file
3314  !<
3315  subroutine maw_redflow_csv_init(this, fname)
3316  ! -- dummy variables
3317  class(mawtype), intent(inout) :: this !< MawType object
3318  character(len=*), intent(in) :: fname
3319  ! -- format
3320  character(len=*), parameter :: fmtredflowcsv = &
3321  "(4x, 'MAW REDUCED FLOW INFORMATION WILL BE SAVED TO FILE: ', a, /4x, &
3322  &'OPENED ON UNIT: ', I0)"
3323 
3324  this%ioutredflowcsv = getunit()
3325  call openfile(this%ioutredflowcsv, this%iout, fname, 'CSV', &
3326  filstat_opt='REPLACE')
3327  write (this%iout, fmtredflowcsv) trim(adjustl(fname)), &
3328  this%ioutredflowcsv
3329  write (this%ioutredflowcsv, '(a)') &
3330  'time,period,step,MAWnumber,rate-requested,rate-actual,maw-reduction'
3331  end subroutine maw_redflow_csv_init
3332 
3333  !> @brief MAW reduced flows only when & where they occur
3334  !<
3335  subroutine maw_redflow_csv_write(this)
3336  ! -- modules
3337  use tdismodule, only: totim, kstp, kper
3338  ! -- dummy variables
3339  class(mawtype), intent(inout) :: this !< MawType object
3340  ! -- local
3341  integer(I4B) :: n
3342  !integer(I4B) :: nodereduced
3343  !integer(I4B) :: nodeuser
3344  real(DP) :: v
3345  ! -- format
3346  do n = 1, this%nmawwells
3347  !
3348  ! -- test if node is constant or inactive
3349  if (this%status(n) .ne. 'ACTIVE') then
3350  cycle
3351  end if
3352  v = this%rate(n) - this%ratesim(n) !reductions in extraction will be negative and reductions in injection will be positive; follows convention of WEL AUTO_FLOW_REDUCE_CSV
3353  if (abs(v) > dem9) then !need to check absolute value of difference for both extraction and injection; using 1e-9 as epsilon value but could be tweaked
3354  write (this%ioutredflowcsv, '(*(G0,:,","))') &
3355  totim, kper, kstp, n, this%rate(n), this%ratesim(n), v
3356  end if
3357  end do
3358  end subroutine maw_redflow_csv_write
3359 
3360  !> @brief Calculate the appropriate saturated conductance to use based on
3361  !! aquifer and multi-aquifer well characteristics
3362  !<
3363  subroutine maw_calculate_satcond(this, i, j, node)
3364  ! -- dummy
3365  class(mawtype), intent(inout) :: this
3366  integer(I4B), intent(in) :: i
3367  integer(I4B), intent(in) :: j
3368  integer(I4B), intent(in) :: node
3369  ! -- local
3370  integer(I4B) :: iTcontrastErr
3371  integer(I4B) :: jpos
3372  real(DP) :: c
3373  real(DP) :: k11
3374  real(DP) :: k22
3375  real(DP) :: sqrtk11k22
3376  real(DP) :: hks
3377  real(DP) :: area
3378  real(DP) :: eradius
3379  real(DP) :: topw
3380  real(DP) :: botw
3381  real(DP) :: tthkw
3382  real(DP) :: tthka
3383  real(DP) :: Tcontrast
3384  real(DP) :: skin
3385  real(DP) :: ravg
3386  real(DP) :: slen
3387  real(DP) :: pavg
3388  real(DP) :: gwfsat
3389  real(DP) :: gwftop
3390  real(DP) :: gwfbot
3391  real(DP) :: lc1
3392  real(DP) :: lc2
3393  real(DP) :: dx
3394  real(DP) :: dy
3395  real(DP) :: Txx
3396  real(DP) :: Tyy
3397  real(DP) :: T2pi
3398  real(DP) :: yx4
3399  real(DP) :: xy4
3400  ! -- formats
3401  !
3402  ! -- initialize conductance variables
3403  itcontrasterr = 0
3404  lc1 = dzero
3405  lc2 = dzero
3406  !
3407  ! -- calculate connection position
3408  jpos = this%get_jpos(i, j)
3409  !
3410  ! -- set K11 and K22
3411  k11 = this%gwfk11(node)
3412  if (this%gwfik22 == 0) then
3413  k22 = this%gwfk11(node)
3414  else
3415  k22 = this%gwfk22(node)
3416  end if
3417  sqrtk11k22 = sqrt(k11 * k22)
3418  !
3419  ! -- set gwftop, gwfbot, and gwfsat
3420  gwftop = this%dis%top(node)
3421  gwfbot = this%dis%bot(node)
3422  tthka = gwftop - gwfbot
3423  gwfsat = this%gwfsat(node)
3424  !
3425  ! -- set top and bottom of well screen
3426  c = dzero
3427  topw = this%topscrn(jpos)
3428  botw = this%botscrn(jpos)
3429  tthkw = topw - botw
3430  !
3431  ! -- scale screen thickness using gwfsat (for NPF Package THICKSTRT)
3432  if (gwftop == topw .and. gwfbot == botw) then
3433  if (this%icelltype(node) == 0) then
3434  tthkw = tthkw * gwfsat
3435  tthka = tthka * gwfsat
3436  end if
3437  end if
3438  !
3439  ! -- calculate the aquifer transmissivity (T2pi)
3440  t2pi = dtwopi * tthka * sqrtk11k22
3441  !
3442  ! -- calculate effective radius
3443  if (this%dis%ndim == 3 .and. this%ieffradopt /= 0) then
3444  txx = k11 * tthka
3445  tyy = k22 * tthka
3446  dx = sqrt(this%dis%area(node))
3447  dy = dx
3448  yx4 = (tyy / txx)**dquarter
3449  xy4 = (txx / tyy)**dquarter
3450  eradius = 0.28_dp * ((yx4 * dx)**dtwo + &
3451  (xy4 * dy)**dtwo)**dhalf / (yx4 + xy4)
3452  else
3453  area = this%dis%area(node)
3454  eradius = sqrt(area / (deight * dpi))
3455  end if
3456  !
3457  ! -- conductance calculations
3458  ! -- Thiem equation (1) and cumulative Thiem and skin equations (3)
3459  if (this%ieqn(i) == 1 .or. this%ieqn(i) == 3) then
3460  lc1 = log(eradius / this%radius(i)) / t2pi
3461  end if
3462  !
3463  ! -- skin equation (2) and cumulative Thiem and skin equations (3)
3464  if (this%ieqn(i) == 2 .or. this%ieqn(i) == 3) then
3465  hks = this%hk(jpos)
3466  if (tthkw * hks > dzero) then
3467  tcontrast = (sqrtk11k22 * tthka) / (hks * tthkw)
3468  skin = (tcontrast - done) * log(this%sradius(jpos) / this%radius(i))
3469  !
3470  ! -- trap invalid transmissvity contrast if using skin equation (2).
3471  ! Not trapped for cumulative Thiem and skin equations (3)
3472  ! because the MNW2 package allowed this condition (for
3473  ! backward compatibility with the MNW2 package for
3474  ! MODFLOW-2005, MODFLOW-NWT, and MODFLOW-USG).
3475  if (tcontrast <= 1 .and. this%ieqn(i) == 2) then
3476  itcontrasterr = 1
3477  write (errmsg, '(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
3478  'Invalid calculated transmissivity contrast (', tcontrast, &
3479  ') for maw well', i, 'connection', j, '.', 'This happens when the', &
3480  'skin transmissivity equals or exceeds the aquifer transmissivity.', &
3481  'Consider decreasing HK_SKIN for the connection or using the', &
3482  'CUMULATIVE or MEAN conductance equations.'
3483  call store_error(errmsg)
3484  else
3485  lc2 = skin / t2pi
3486  end if
3487  end if
3488  end if
3489  ! -- conductance using screen elevations, hk, well radius,
3490  ! and screen radius
3491  if (this%ieqn(i) == 4) then
3492  hks = this%hk(jpos)
3493  ravg = dhalf * (this%radius(i) + this%sradius(jpos))
3494  slen = this%sradius(jpos) - this%radius(i)
3495  pavg = dtwopi * ravg
3496  c = hks * pavg * tthkw / slen
3497  end if
3498  !
3499  ! -- calculate final conductance for Thiem (1), Skin (2), and
3500  ! and cumulative Thiem and skin equations (3)
3501  if (this%ieqn(i) < 4) then
3502  if (lc1 + lc2 /= dzero) then
3503  c = done / (lc1 + lc2)
3504  else
3505  c = -dnodata
3506  end if
3507  end if
3508  !
3509  ! -- ensure that the conductance is not negative. Only write error message
3510  ! if error condition has not occurred for skin calculations (LC2)
3511  if (c < dzero .and. itcontrasterr == 0) then
3512  write (errmsg, '(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
3513  'Invalid calculated negative conductance (', c, &
3514  ') for maw well', i, 'connection', j, '.', 'this happens when the', &
3515  'skin transmissivity equals or exceeds the aquifer transmissivity.', &
3516  'consider decreasing hk_skin for the connection or using the', &
3517  'mean conductance equation.'
3518  call store_error(errmsg)
3519  end if
3520  !
3521  ! -- set saturated conductance
3522  this%satcond(jpos) = c
3523  end subroutine maw_calculate_satcond
3524 
3525  !> @brief Calculate the saturation between the aquifer maw well_head
3526  !<
3527  subroutine maw_calculate_saturation(this, n, j, node, sat)
3528  ! -- dummy
3529  class(mawtype), intent(inout) :: this
3530  integer(I4B), intent(in) :: n
3531  integer(I4B), intent(in) :: j
3532  integer(I4B), intent(in) :: node
3533  real(DP), intent(inout) :: sat
3534  ! -- local
3535  integer(I4B) :: jpos
3536  real(DP) :: h_temp
3537  real(DP) :: hwell
3538  real(DP) :: topw
3539  real(DP) :: botw
3540  ! -- formats
3541  !
3542  ! -- initialize saturation
3543  sat = dzero
3544  !
3545  ! -- calculate current saturation for convertible cells
3546  if (this%icelltype(node) /= 0) then
3547  !
3548  ! -- set hwell
3549  hwell = this%xnewpak(n)
3550  !
3551  ! -- set connection position
3552  jpos = this%get_jpos(n, j)
3553  !
3554  ! -- set top and bottom of the well connection
3555  topw = this%topscrn(jpos)
3556  botw = this%botscrn(jpos)
3557  !
3558  ! -- calculate appropriate saturation
3559  if (this%inewton /= 1) then
3560  h_temp = this%xnew(node)
3561  if (h_temp < botw) then
3562  h_temp = botw
3563  end if
3564  if (hwell < botw) then
3565  hwell = botw
3566  end if
3567  h_temp = dhalf * (h_temp + hwell)
3568  else
3569  h_temp = this%xnew(node)
3570  if (hwell > h_temp) then
3571  h_temp = hwell
3572  end if
3573  if (h_temp < botw) then
3574  h_temp = botw
3575  end if
3576  end if
3577  ! -- calculate saturation
3578  sat = squadraticsaturation(topw, botw, h_temp, this%satomega)
3579  else
3580  sat = done
3581  end if
3582  end subroutine maw_calculate_saturation
3583 
3584  !> @brief Calculate matrix terms for a multi-aquifer well connection. Terms
3585  !! for fc and fn methods are calculated based on whether term2 is passed
3586  !! Arguments are as follows:
3587  !! n : maw well number
3588  !! j : connection number for well n
3589  !! icflow : flag indicating that flow should be corrected
3590  !! cmaw : maw-gwf conducance
3591  !! cterm : correction term for flow to dry cell
3592  !! term : xxx
3593  !! flow : calculated flow for this connection, positive into well
3594  !! term2 : xxx
3595  !<
3596  subroutine maw_calculate_conn_terms(this, n, j, icflow, cmaw, cterm, term, &
3597  flow, term2)
3598  ! -- dummy
3599  class(mawtype) :: this
3600  integer(I4B), intent(in) :: n
3601  integer(I4B), intent(in) :: j
3602  integer(I4B), intent(inout) :: icflow
3603  real(DP), intent(inout) :: cmaw
3604  real(DP), intent(inout) :: cterm
3605  real(DP), intent(inout) :: term
3606  real(DP), intent(inout) :: flow
3607  real(DP), intent(inout), optional :: term2
3608  ! -- local
3609  logical(LGP) :: correct_flow
3610  integer(I4B) :: inewton
3611  integer(I4B) :: jpos
3612  integer(I4B) :: igwfnode
3613  real(DP) :: hmaw
3614  real(DP) :: hgwf
3615  real(DP) :: hups
3616  real(DP) :: hdowns
3617  real(DP) :: sat
3618  real(DP) :: tmaw
3619  real(DP) :: bmaw
3620  real(DP) :: en
3621  real(DP) :: hbar
3622  real(DP) :: drterm
3623  real(DP) :: dhbarterm
3624  real(DP) :: vscratio
3625  !
3626  ! -- initialize terms
3627  cterm = dzero
3628  vscratio = done
3629  icflow = 0
3630  if (present(term2)) then
3631  inewton = 1
3632  else
3633  inewton = 0
3634  end if
3635  !
3636  ! -- set common terms
3637  jpos = this%get_jpos(n, j)
3638  igwfnode = this%get_gwfnode(n, j)
3639  hgwf = this%xnew(igwfnode)
3640  hmaw = this%xnewpak(n)
3641  tmaw = this%topscrn(jpos)
3642  bmaw = this%botscrn(jpos)
3643  !
3644  ! -- if vsc active, select appropriate viscosity ratio
3645  if (this%ivsc == 1) then
3646  ! flow out of well (flow is negative)
3647  if (flow < 0) then
3648  vscratio = this%viscratios(1, igwfnode)
3649  else
3650  vscratio = this%viscratios(2, igwfnode)
3651  end if
3652  end if
3653  !
3654  ! -- calculate saturation
3655  call this%maw_calculate_saturation(n, j, igwfnode, sat)
3656  cmaw = this%satcond(jpos) * vscratio * sat
3657  !
3658  ! -- set upstream head, term, and term2 if returning newton terms
3659  if (inewton == 1) then
3660  term = dzero
3661  term2 = dzero
3662  hups = hmaw
3663  if (hgwf > hups) then
3664  hups = hgwf
3665  end if
3666  !
3667  ! -- calculate the derivative of saturation
3668  drterm = squadraticsaturationderivative(tmaw, bmaw, hups, this%satomega)
3669  else
3670  term = cmaw
3671  end if
3672  !
3673  ! -- calculate correction term if flow_correction option specified
3674  if (this%correct_flow) then
3675  !
3676  ! -- set bmaw, determine en, and set correct_flow flag
3677  en = max(bmaw, this%dis%bot(igwfnode))
3678  correct_flow = .false.
3679  if (hmaw < en) then
3680  correct_flow = .true.
3681  end if
3682  if (hgwf < en .and. this%icelltype(igwfnode) /= 0) then
3683  correct_flow = .true.
3684  end if
3685  !
3686  ! -- if flow should be corrected because hgwf or hmaw is below bottom
3687  ! then calculate correction term (cterm)
3688  if (correct_flow) then
3689  icflow = 1
3690  hdowns = min(hmaw, hgwf)
3691  hbar = squadratic0sp(hdowns, en, this%satomega)
3692  if (hgwf > hmaw) then
3693  cterm = cmaw * (hmaw - hbar)
3694  else
3695  cterm = cmaw * (hbar - hgwf)
3696  end if
3697  end if
3698  !
3699  ! -- if newton formulation then calculate newton terms
3700  if (inewton /= 0) then
3701  !
3702  ! -- maw is upstream
3703  if (hmaw > hgwf) then
3704  hbar = squadratic0sp(hgwf, en, this%satomega)
3705  term = drterm * this%satcond(jpos) * vscratio * (hbar - hmaw)
3706  dhbarterm = squadratic0spderivative(hgwf, en, this%satomega)
3707  term2 = cmaw * (dhbarterm - done)
3708  !
3709  ! -- gwf is upstream
3710  else
3711  hbar = squadratic0sp(hmaw, en, this%satomega)
3712  term = -drterm * this%satcond(jpos) * vscratio * (hgwf - hbar)
3713  dhbarterm = squadratic0spderivative(hmaw, en, this%satomega)
3714  term2 = cmaw * (done - dhbarterm)
3715  end if
3716  end if
3717  else
3718  !
3719  ! -- flow is not corrected, so calculate term for newton formulation
3720  if (inewton /= 0) then
3721  term = drterm * this%satcond(jpos) * vscratio * (hgwf - hmaw)
3722  end if
3723  end if
3724  !
3725  ! -- calculate flow relative to maw for fc and bd
3726  flow = dzero
3727  if (inewton == 0) then
3728  flow = term * (hgwf - hmaw) + cterm
3729  end if
3730  !
3731  ! -- add density part here
3732  if (this%idense /= 0 .and. inewton == 0) then
3733  call this%maw_calculate_density_exchange(jpos, hmaw, hgwf, cmaw, &
3734  bmaw, flow, term, cterm)
3735  end if
3736  end subroutine maw_calculate_conn_terms
3737 
3738  !> @brief Calculate well pumping rate based on constraints
3739  !<
3740  subroutine maw_calculate_wellq(this, n, hmaw, q)
3741  ! -- dummy
3742  class(mawtype) :: this
3743  integer(I4B), intent(in) :: n
3744  real(DP), intent(in) :: hmaw
3745  real(DP), intent(inout) :: q
3746  ! -- local
3747  real(DP) :: scale
3748  real(DP) :: tp
3749  real(DP) :: bt
3750  real(DP) :: rate
3751  real(DP) :: weight
3752  real(DP) :: dq
3753  !
3754  ! -- Initialize q
3755  q = dzero
3756  !
3757  ! -- Assign rate as the user-provided base pumping rate
3758  rate = this%rate(n)
3759  !
3760  ! -- Assign q differently depending on whether this is an extraction well
3761  ! (rate < 0) or an injection well (rate > 0).
3762  if (rate < dzero) then
3763  !
3764  ! -- If well shut off is activated, then turn off well if necessary,
3765  ! or if shut off is not activated then check to see if rate scaling
3766  ! is on.
3767  if (this%shutofflevel(n) /= dep20) then
3768  call this%maw_calculate_qpot(n, q)
3769  if (q < dzero) q = dzero
3770  if (q > -rate) q = -rate
3771 
3772  if (this%ishutoffcnt == 1) then
3773  this%shutoffweight(n) = done
3774  this%shutoffdq(n) = dzero
3775  this%shutoffqold(n) = q
3776  end if
3777 
3778  dq = q - this%shutoffqold(n)
3779  weight = this%shutoffweight(n)
3780  !
3781  ! -- for flip-flop condition, decrease factor
3782  if (this%shutoffdq(n) * dq < dzero) then
3783  weight = this%theta * this%shutoffweight(n)
3784  !
3785  ! -- when change is of same sign, increase factor
3786  else
3787  weight = this%shutoffweight(n) + this%kappa
3788  end if
3789  if (weight > done) weight = done
3790 
3791  q = this%shutoffqold(n) + weight * dq
3792 
3793  this%shutoffqold(n) = q
3794  this%shutoffdq(n) = dq
3795  this%shutoffweight(n) = weight
3796  !
3797  ! -- If shutoffmin and shutoffmax are specified then apply
3798  ! additional checks for when to shut off the well.
3799  if (this%shutoffmin(n) > dzero) then
3800  if (hmaw < this%shutofflevel(n)) then
3801  !
3802  ! -- calculate adjusted well rate subject to constraints
3803  ! -- well is shutoff
3804  if (this%ishutoff(n) /= 0) then
3805  q = dzero
3806  !
3807  ! --- well is not shut off
3808  else
3809  ! -- turn off well if q is less than the minimum rate and
3810  ! reset the ishutoff flag if at least on iteration 3
3811  if (q < this%shutoffmin(n)) then
3812  if (this%ishutoffcnt > 2) then
3813  this%ishutoff(n) = 1
3814  end if
3815  q = dzero
3816  !
3817  ! -- leave well on and use the specified rate
3818  ! or the potential rate
3819  end if
3820  end if
3821  !
3822  ! -- try to use the specified rate or the potential rate
3823  else
3824  if (q > this%shutoffmax(n)) then
3825  if (this%ishutoffcnt <= 2) then
3826  this%ishutoff(n) = 0
3827  end if
3828  end if
3829  if (this%ishutoff(n) /= 0) then
3830  q = dzero
3831  end if
3832  end if
3833  end if
3834 
3835  if (q /= dzero) q = -q
3836 
3837  else
3838  scale = done
3839  !
3840  ! -- Apply rate scaling by reducing pumpage when hmaw is less than the
3841  ! sum of maw pump elevation (pumpelev) and the specified reduction
3842  ! length. The rate will go to zero as hmaw drops to the pump
3843  ! elevation.
3844  if (this%reduction_length(n) /= dep20) then
3845  bt = this%pumpelev(n)
3846  tp = bt + this%reduction_length(n)
3847  scale = sqsaturation(tp, bt, hmaw)
3848  end if
3849  q = scale * rate
3850  end if
3851  !
3852  else
3853  !
3854  ! -- Handle the injection case (rate > 0) differently than extraction.
3855  q = rate
3856  if (this%shutofflevel(n) /= dep20) then
3857  call this%maw_calculate_qpot(n, q)
3858  q = -q
3859  if (q < dzero) q = dzero
3860  if (q > rate) q = rate
3861 
3862  if (this%ishutoffcnt == 1) then
3863  this%shutoffweight(n) = done
3864  this%shutoffdq(n) = dzero
3865  this%shutoffqold(n) = q
3866  end if
3867 
3868  dq = q - this%shutoffqold(n)
3869  weight = this%shutoffweight(n)
3870  !
3871  ! -- for flip-flop condition, decrease factor
3872  if (this%shutoffdq(n) * dq < dzero) then
3873  weight = this%theta * this%shutoffweight(n)
3874  !
3875  ! -- when change is of same sign, increase factor
3876  else
3877  weight = this%shutoffweight(n) + this%kappa
3878  end if
3879  if (weight > done) weight = done
3880 
3881  q = this%shutoffqold(n) + weight * dq
3882 
3883  this%shutoffqold(n) = q
3884  this%shutoffdq(n) = dq
3885  this%shutoffweight(n) = weight
3886 
3887  else
3888  scale = done
3889  !
3890  ! -- Apply rate scaling for an injection well by reducing the
3891  ! injection rate as hmaw rises above the pump elevation. The rate
3892  ! will approach zero as hmaw approaches pumpelev + reduction_length.
3893  if (this%reduction_length(n) /= dep20) then
3894  bt = this%pumpelev(n)
3895  tp = bt + this%reduction_length(n)
3896  scale = done - sqsaturation(tp, bt, hmaw)
3897  end if
3898  q = scale * rate
3899  end if
3900  end if
3901  end subroutine maw_calculate_wellq
3902 
3903  !> @brief Calculate groundwater inflow to a maw well
3904  !<
3905  subroutine maw_calculate_qpot(this, n, qnet)
3906  use tdismodule, only: delt
3907  ! -- dummy
3908  class(mawtype), intent(inout) :: this
3909  integer(I4B), intent(in) :: n
3910  real(DP), intent(inout) :: qnet
3911  ! -- local
3912  integer(I4B) :: j
3913  integer(I4B) :: jpos
3914  integer(I4B) :: igwfnode
3915  real(DP) :: bt
3916  real(DP) :: tp
3917  real(DP) :: scale
3918  real(DP) :: cfw
3919  real(DP) :: hdterm
3920  real(DP) :: sat
3921  real(DP) :: cmaw
3922  real(DP) :: hgwf
3923  real(DP) :: bmaw
3924  real(DP) :: h_temp
3925  real(DP) :: hv
3926  real(DP) :: vscratio
3927  ! -- format
3928  !
3929  ! -- initialize qnet and h_temp
3930  qnet = dzero
3931  vscratio = done
3932  h_temp = this%shutofflevel(n)
3933  !
3934  ! -- if vsc active, select appropriate viscosity ratio
3935  if (this%ivsc == 1) then
3936  ! flow out of well (flow is negative)
3937  if (qnet < 0) then
3938  vscratio = this%viscratios(1, igwfnode)
3939  else
3940  vscratio = this%viscratios(2, igwfnode)
3941  end if
3942  end if
3943  !
3944  ! -- calculate discharge to flowing wells
3945  if (this%iflowingwells > 0) then
3946  if (this%fwcond(n) > dzero) then
3947  bt = this%fwelev(n)
3948  tp = bt + this%fwrlen(n)
3949  scale = sqsaturation(tp, bt, h_temp)
3950  cfw = scale * this%fwcond(n) * this%viscratios(2, n)
3951  this%ifwdischarge(n) = 0
3952  if (cfw > dzero) then
3953  this%ifwdischarge(n) = 1
3954  this%xsto(n) = bt
3955  end if
3956  qnet = qnet + cfw * (bt - h_temp)
3957  end if
3958  end if
3959  !
3960  ! -- calculate maw storage changes
3961  if (this%imawiss /= 1) then
3962  if (this%ifwdischarge(n) /= 1) then
3963  hdterm = this%xoldsto(n) - h_temp
3964  else
3965  hdterm = this%xoldsto(n) - this%fwelev(n)
3966  end if
3967  qnet = qnet - (this%area(n) * hdterm / delt)
3968  end if
3969  !
3970  ! -- calculate inflow from aquifer
3971  do j = 1, this%ngwfnodes(n)
3972  jpos = this%get_jpos(n, j)
3973  igwfnode = this%get_gwfnode(n, j)
3974  call this%maw_calculate_saturation(n, j, igwfnode, sat)
3975  cmaw = this%satcond(jpos) * vscratio * sat
3976  hgwf = this%xnew(igwfnode)
3977  bmaw = this%botscrn(jpos)
3978  hv = h_temp
3979  if (hv < bmaw) then
3980  hv = bmaw
3981  end if
3982  if (hgwf < bmaw) then
3983  hgwf = bmaw
3984  end if
3985  qnet = qnet + cmaw * (hgwf - hv)
3986  end do
3987  end subroutine maw_calculate_qpot
3988 
3989  !> @brief Update MAW satcond and package rhs and hcof
3990  !<
3991  subroutine maw_cfupdate(this)
3992  class(mawtype) :: this
3993  ! -- dummy
3994  ! -- local
3995  integer(I4B) :: j
3996  integer(I4B) :: n
3997  integer(I4B) :: jpos
3998  integer(I4B) :: icflow
3999  integer(I4B) :: ibnd
4000  real(DP) :: flow
4001  real(DP) :: cmaw
4002  real(DP) :: hmaw
4003  real(DP) :: cterm
4004  real(DP) :: term
4005  !
4006  ! -- Return if no maw wells
4007  if (this%nbound .eq. 0) return
4008  !
4009  ! -- Update shutoff count
4010  this%ishutoffcnt = this%ishutoffcnt + 1
4011  !
4012  ! -- Calculate hcof and rhs for each maw entry
4013  ibnd = 1
4014  do n = 1, this%nmawwells
4015  hmaw = this%xnewpak(n)
4016  do j = 1, this%ngwfnodes(n)
4017  jpos = this%get_jpos(n, j)
4018  this%hcof(ibnd) = dzero
4019  this%rhs(ibnd) = dzero
4020  !
4021  ! -- set bound, hcof, and rhs components
4022  !
4023  ! -- use connection method so the gwf-maw budget flows
4024  ! are consistent with the maw-gwf budget flows
4025  if (this%iboundpak(n) == 0) then
4026  cmaw = dzero
4027  term = dzero
4028  cterm = dzero
4029  else
4030  call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, &
4031  term, flow)
4032  end if
4033  this%simcond(jpos) = cmaw
4034  this%bound(2, ibnd) = cmaw
4035  this%hcof(ibnd) = -term
4036  this%rhs(ibnd) = -term * hmaw + cterm
4037  !
4038  ! -- increment boundary number
4039  ibnd = ibnd + 1
4040  end do
4041  end do
4042  end subroutine maw_cfupdate
4043 
4044  !> @brief Set up the budget object that stores all the maw flows
4045  !! The terms listed here must correspond in number and order to the ones
4046  !! listed in the maw_fill_budobj routine.
4047  !<
4048  subroutine maw_setup_budobj(this)
4049  ! -- modules
4050  use constantsmodule, only: lenbudtxt
4051  ! -- dummy
4052  class(mawtype) :: this
4053  ! -- local
4054  integer(I4B) :: nbudterm
4055  integer(I4B) :: n, j, n2
4056  real(DP) :: q
4057  integer(I4B) :: maxlist, naux
4058  integer(I4B) :: idx
4059  character(len=LENBUDTXT) :: text
4060  character(len=LENBUDTXT), dimension(1) :: auxtxt
4061  !
4062  ! -- Determine the number of maw budget terms. These are fixed for
4063  ! the simulation and cannot change.
4064  ! gwf rate [flowing_well] storage constant_flow [frommvr tomvr tomvrcf [tomvrfw]] [aux]
4065  nbudterm = 4
4066  if (this%iflowingwells > 0) then
4067  nbudterm = nbudterm + 1
4068  end if
4069  if (this%imover == 1) then
4070  nbudterm = nbudterm + 3
4071  if (this%iflowingwells > 0) then
4072  nbudterm = nbudterm + 1
4073  end if
4074  end if
4075  if (this%naux > 0) nbudterm = nbudterm + 1
4076  !
4077  ! -- set up budobj
4078  call budgetobject_cr(this%budobj, this%packName)
4079  call this%budobj%budgetobject_df(this%nmawwells, nbudterm, 0, 0, &
4080  ibudcsv=this%ibudcsv)
4081  idx = 0
4082  !
4083  ! -- Go through and set up each budget term
4084  !
4085  ! --
4086  text = ' GWF'
4087  idx = idx + 1
4088  maxlist = this%maxbound
4089  naux = 1
4090  auxtxt(1) = ' FLOW-AREA'
4091  call this%budobj%budterm(idx)%initialize(text, &
4092  this%name_model, &
4093  this%packName, &
4094  this%name_model, &
4095  this%name_model, &
4096  maxlist, .false., .true., &
4097  naux, auxtxt)
4098  call this%budobj%budterm(idx)%reset(this%maxbound)
4099  q = dzero
4100  do n = 1, this%nmawwells
4101  do j = 1, this%ngwfnodes(n)
4102  n2 = this%get_gwfnode(n, j)
4103  call this%budobj%budterm(idx)%update_term(n, n2, q)
4104  end do
4105  end do
4106  !
4107  ! --
4108  text = ' RATE'
4109  idx = idx + 1
4110  maxlist = this%nmawwells
4111  naux = 0
4112  call this%budobj%budterm(idx)%initialize(text, &
4113  this%name_model, &
4114  this%packName, &
4115  this%name_model, &
4116  this%packName, &
4117  maxlist, .false., .false., &
4118  naux)
4119  !
4120  ! --
4121  if (this%iflowingwells > 0) then
4122  text = ' FW-RATE'
4123  idx = idx + 1
4124  maxlist = this%nmawwells
4125  naux = 0
4126  call this%budobj%budterm(idx)%initialize(text, &
4127  this%name_model, &
4128  this%packName, &
4129  this%name_model, &
4130  this%packName, &
4131  maxlist, .false., .false., &
4132  naux)
4133  end if
4134  !
4135  ! --
4136  text = ' STORAGE'
4137  idx = idx + 1
4138  maxlist = this%nmawwells
4139  naux = 1
4140  auxtxt(1) = ' VOLUME'
4141  call this%budobj%budterm(idx)%initialize(text, &
4142  this%name_model, &
4143  this%packName, &
4144  this%name_model, &
4145  this%name_model, &
4146  maxlist, .false., .true., &
4147  naux, auxtxt)
4148  !
4149  ! --
4150  text = ' CONSTANT'
4151  idx = idx + 1
4152  maxlist = this%nmawwells
4153  naux = 0
4154  call this%budobj%budterm(idx)%initialize(text, &
4155  this%name_model, &
4156  this%packName, &
4157  this%name_model, &
4158  this%packName, &
4159  maxlist, .false., .false., &
4160  naux)
4161  !
4162  ! --
4163  if (this%imover == 1) then
4164  !
4165  ! --
4166  text = ' FROM-MVR'
4167  idx = idx + 1
4168  maxlist = this%nmawwells
4169  naux = 0
4170  call this%budobj%budterm(idx)%initialize(text, &
4171  this%name_model, &
4172  this%packName, &
4173  this%name_model, &
4174  this%packName, &
4175  maxlist, .false., .false., &
4176  naux)
4177  !
4178  ! --
4179  text = ' RATE-TO-MVR'
4180  idx = idx + 1
4181  maxlist = this%nmawwells
4182  naux = 0
4183  call this%budobj%budterm(idx)%initialize(text, &
4184  this%name_model, &
4185  this%packName, &
4186  this%name_model, &
4187  this%packName, &
4188  maxlist, .false., .false., &
4189  naux)
4190  !
4191  ! -- constant-head flow to mover
4192  text = ' CONSTANT-TO-MVR'
4193  idx = idx + 1
4194  maxlist = this%nmawwells
4195  naux = 0
4196  call this%budobj%budterm(idx)%initialize(text, &
4197  this%name_model, &
4198  this%packName, &
4199  this%name_model, &
4200  this%packName, &
4201  maxlist, .false., .false., &
4202  naux)
4203  !
4204  ! -- flowing-well flow to mover
4205  if (this%iflowingwells > 0) then
4206  !
4207  ! --
4208  text = ' FW-RATE-TO-MVR'
4209  idx = idx + 1
4210  maxlist = this%nmawwells
4211  naux = 0
4212  call this%budobj%budterm(idx)%initialize(text, &
4213  this%name_model, &
4214  this%packName, &
4215  this%name_model, &
4216  this%packName, &
4217  maxlist, .false., .false., &
4218  naux)
4219  end if
4220  end if
4221  !
4222  ! -- auxiliary variable
4223  naux = this%naux
4224  if (naux > 0) then
4225  !
4226  ! --
4227  text = ' AUXILIARY'
4228  idx = idx + 1
4229  maxlist = this%maxbound
4230  call this%budobj%budterm(idx)%initialize(text, &
4231  this%name_model, &
4232  this%packName, &
4233  this%name_model, &
4234  this%packName, &
4235  maxlist, .false., .false., &
4236  naux, this%auxname)
4237  end if
4238  !
4239  ! -- if maw flow for each reach are written to the listing file
4240  if (this%iprflow /= 0) then
4241  call this%budobj%flowtable_df(this%iout)
4242  end if
4243  end subroutine maw_setup_budobj
4244 
4245  !> @brief Copy flow terms into this%budobj
4246  !!
4247  !! terms include a combination of the following:
4248  !! gwf rate [flowing_well] [storage] constant_flow [frommvr tomvr tomvrcf [tomvrfw]] [aux]
4249  !<
4250  subroutine maw_fill_budobj(this)
4251  ! -- modules
4252  ! -- dummy
4253  class(mawtype) :: this
4254  ! -- local
4255  integer(I4B) :: naux
4256  integer(I4B) :: j
4257  integer(I4B) :: n
4258  integer(I4B) :: n2
4259  integer(I4B) :: jpos
4260  integer(I4B) :: idx
4261  integer(I4B) :: ibnd
4262  real(DP) :: q
4263  real(DP) :: tmaw
4264  real(DP) :: bmaw
4265  real(DP) :: sat
4266  real(DP) :: qfact
4267  real(DP) :: q2
4268  real(DP) :: b
4269  real(DP) :: v
4270  ! -- formats
4271  !
4272  ! -- initialize counter
4273  idx = 0
4274  !
4275  ! -- GWF (LEAKAGE) and connection surface area (aux)
4276  idx = idx + 1
4277  call this%budobj%budterm(idx)%reset(this%maxbound)
4278  ibnd = 1
4279  do n = 1, this%nmawwells
4280  do j = 1, this%ngwfnodes(n)
4281  jpos = this%get_jpos(n, j)
4282  n2 = this%get_gwfnode(n, j)
4283  tmaw = this%topscrn(jpos)
4284  bmaw = this%botscrn(jpos)
4285  call this%maw_calculate_saturation(n, j, n2, sat)
4286  this%qauxcbc(1) = dtwo * dpi * this%radius(n) * sat * (tmaw - bmaw)
4287  q = this%qleak(ibnd)
4288  call this%budobj%budterm(idx)%update_term(n, n2, q, this%qauxcbc)
4289  ibnd = ibnd + 1
4290  end do
4291  end do
4292  !
4293  ! -- RATE (WITHDRAWAL RATE)
4294  idx = idx + 1
4295  call this%budobj%budterm(idx)%reset(this%nmawwells)
4296  do n = 1, this%nmawwells
4297  q = this%ratesim(n)
4298  !
4299  ! -- adjust if well rate is an outflow
4300  if (this%imover == 1 .and. q < dzero) then
4301  qfact = done
4302  if (this%qout(n) < dzero) then
4303  qfact = q / this%qout(n)
4304  end if
4305  q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4306  end if
4307  call this%budobj%budterm(idx)%update_term(n, n, q)
4308  end do
4309  !
4310  ! -- FLOWING WELL
4311  if (this%iflowingwells > 0) then
4312  idx = idx + 1
4313  call this%budobj%budterm(idx)%reset(this%nmawwells)
4314  do n = 1, this%nmawwells
4315  q = this%qfw(n)
4316  if (this%imover == 1) then
4317  qfact = done
4318  !
4319  ! -- adjust if well rate is an outflow
4320  if (this%qout(n) < dzero) then
4321  qfact = q / this%qout(n)
4322  end if
4323  q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4324  end if
4325  call this%budobj%budterm(idx)%update_term(n, n, q)
4326  end do
4327  end if
4328  !
4329  ! -- STORAGE (AND VOLUME AS AUX)
4330  idx = idx + 1
4331  call this%budobj%budterm(idx)%reset(this%nmawwells)
4332  do n = 1, this%nmawwells
4333  b = this%xsto(n) - this%bot(n)
4334  if (b < dzero) then
4335  b = dzero
4336  end if
4337  v = this%area(n) * b
4338  if (this%imawissopt /= 1) then
4339  q = this%qsto(n)
4340  else
4341  q = dzero
4342  end if
4343  this%qauxcbc(1) = v
4344  call this%budobj%budterm(idx)%update_term(n, n, q, this%qauxcbc)
4345  end do
4346  !
4347  ! -- CONSTANT FLOW
4348  idx = idx + 1
4349  call this%budobj%budterm(idx)%reset(this%nmawwells)
4350  do n = 1, this%nmawwells
4351  q = this%qconst(n)
4352  !
4353  ! -- adjust if constant-flow rate is an outflow
4354  if (this%imover == 1 .and. q < dzero) then
4355  qfact = done
4356  if (this%qout(n) < dzero) then
4357  qfact = q / this%qout(n)
4358  end if
4359  q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4360  end if
4361  call this%budobj%budterm(idx)%update_term(n, n, q)
4362  end do
4363  !
4364  ! -- MOVER
4365  if (this%imover == 1) then
4366  !
4367  ! -- FROM MOVER
4368  idx = idx + 1
4369  call this%budobj%budterm(idx)%reset(this%nmawwells)
4370  do n = 1, this%nmawwells
4371  if (this%iboundpak(n) == 0) then
4372  q = dzero
4373  else
4374  q = this%pakmvrobj%get_qfrommvr(n)
4375  end if
4376  call this%budobj%budterm(idx)%update_term(n, n, q)
4377  end do
4378  !
4379  ! -- RATE TO MOVER
4380  idx = idx + 1
4381  call this%budobj%budterm(idx)%reset(this%nmawwells)
4382  do n = 1, this%nmawwells
4383  q = this%pakmvrobj%get_qtomvr(n)
4384  if (q > dzero) then
4385  q = -q
4386  q2 = this%ratesim(n)
4387  !
4388  ! -- adjust TO MOVER if well rate is outflow
4389  if (q2 < dzero) then
4390  qfact = q2 / this%qout(n)
4391  q = q * qfact
4392  else
4393  q = dzero
4394  end if
4395  end if
4396  call this%budobj%budterm(idx)%update_term(n, n, q)
4397  end do
4398  !
4399  ! -- CONSTANT TO MOVER
4400  idx = idx + 1
4401  call this%budobj%budterm(idx)%reset(this%nmawwells)
4402  do n = 1, this%nmawwells
4403  q = this%pakmvrobj%get_qtomvr(n)
4404  if (q > dzero) then
4405  q = -q
4406  q2 = this%qconst(n)
4407  ! -- adjust TO MOVER if well rate is outflow
4408  if (q2 < dzero) then
4409  qfact = q2 / this%qout(n)
4410  q = q * qfact
4411  else
4412  q = dzero
4413  end if
4414  end if
4415  call this%budobj%budterm(idx)%update_term(n, n, q)
4416  end do
4417  !
4418  ! -- FLOWING WELL TO MOVER
4419  if (this%iflowingwells > 0) then
4420  idx = idx + 1
4421  call this%budobj%budterm(idx)%reset(this%nmawwells)
4422  do n = 1, this%nmawwells
4423  q = this%pakmvrobj%get_qtomvr(n)
4424  if (q > dzero) then
4425  q = -q
4426  q2 = this%ratesim(n)
4427  !
4428  ! -- adjust TO MOVER if well rate is outflow
4429  qfact = done
4430  if (this%qout(n) < dzero) then
4431  qfact = this%qfw(n) / this%qout(n)
4432  end if
4433  q = q * qfact
4434  end if
4435  call this%budobj%budterm(idx)%update_term(n, n, q)
4436  end do
4437  end if
4438 
4439  end if
4440  !
4441  ! -- AUXILIARY VARIABLES
4442  naux = this%naux
4443  if (naux > 0) then
4444  idx = idx + 1
4445  call this%budobj%budterm(idx)%reset(this%nmawwells)
4446  do n = 1, this%nmawwells
4447  q = dzero
4448  call this%budobj%budterm(idx)%update_term(n, n, q, this%auxvar(:, n))
4449  end do
4450  end if
4451  !
4452  ! --Terms are filled, now accumulate them for this time step
4453  call this%budobj%accumulate_terms()
4454  end subroutine maw_fill_budobj
4455 
4456  !> @brief Set up the table object that is used to write the maw head data
4457  !!
4458  !! The terms listed here must correspond in number and order to the ones
4459  !! written to the head table in the maw_ot method.
4460  !<
4461  subroutine maw_setup_tableobj(this)
4462  ! -- modules
4464  ! -- dummy
4465  class(mawtype) :: this
4466  ! -- local
4467  integer(I4B) :: nterms
4468  character(len=LINELENGTH) :: title
4469  character(len=LINELENGTH) :: text
4470  !
4471  ! -- setup well head table
4472  if (this%iprhed > 0) then
4473  !
4474  ! -- Determine the number of head table columns
4475  nterms = 2
4476  if (this%inamedbound == 1) nterms = nterms + 1
4477  !
4478  ! -- set up table title
4479  title = trim(adjustl(this%text))//' PACKAGE ('// &
4480  trim(adjustl(this%packName))//') HEADS FOR EACH CONTROL VOLUME'
4481  !
4482  ! -- set up head tableobj
4483  call table_cr(this%headtab, this%packName, title)
4484  call this%headtab%table_df(this%nmawwells, nterms, this%iout, &
4485  transient=.true.)
4486  !
4487  ! -- Go through and set up table budget term
4488  if (this%inamedbound == 1) then
4489  text = 'NAME'
4490  call this%headtab%initialize_column(text, 20, alignment=tableft)
4491  end if
4492  !
4493  ! -- reach number
4494  text = 'NUMBER'
4495  call this%headtab%initialize_column(text, 10, alignment=tabcenter)
4496  !
4497  ! -- reach stage
4498  text = 'HEAD'
4499  call this%headtab%initialize_column(text, 12, alignment=tabcenter)
4500  end if
4501  end subroutine maw_setup_tableobj
4502 
4503  !> @brief Get position of value in connection data
4504  !<
4505  function get_jpos(this, n, j) result(jpos)
4506  ! -- return variable
4507  integer(I4B) :: jpos
4508  ! -- dummy
4509  class(mawtype) :: this
4510  integer(I4B), intent(in) :: n
4511  integer(I4B), intent(in) :: j
4512  ! -- local
4513  !
4514  ! -- set jpos
4515  jpos = this%iaconn(n) + j - 1
4516  end function get_jpos
4517 
4518  !> @brief Get the gwfnode for connection
4519  !<
4520  function get_gwfnode(this, n, j) result(igwfnode)
4521  ! -- return variable
4522  integer(I4B) :: igwfnode
4523  ! -- dummy
4524  class(mawtype) :: this
4525  integer(I4B), intent(in) :: n
4526  integer(I4B), intent(in) :: j
4527  ! -- local
4528  integer(I4B) :: jpos
4529  !
4530  ! -- set jpos
4531  jpos = this%get_jpos(n, j)
4532  igwfnode = this%gwfnodes(jpos)
4533  end function get_gwfnode
4534 
4535  !> @brief Activate density terms
4536  !<
4537  subroutine maw_activate_density(this)
4538  ! -- dummy
4539  class(mawtype), intent(inout) :: this
4540  ! -- local
4541  integer(I4B) :: i, j
4542  ! -- formats
4543  !
4544  ! -- Set idense and reallocate denseterms to be of size MAXBOUND
4545  this%idense = 1
4546  call mem_reallocate(this%denseterms, 3, this%MAXBOUND, 'DENSETERMS', &
4547  this%memoryPath)
4548  do i = 1, this%maxbound
4549  do j = 1, 3
4550  this%denseterms(j, i) = dzero
4551  end do
4552  end do
4553  write (this%iout, '(/1x,a)') 'DENSITY TERMS HAVE BEEN ACTIVATED FOR MAW &
4554  &PACKAGE: '//trim(adjustl(this%packName))
4555  end subroutine maw_activate_density
4556 
4557  !> @brief Activate viscosity terms
4558  !!
4559  !! Method to activate addition of viscosity terms for a MAW package reach.
4560  !<
4561  subroutine maw_activate_viscosity(this)
4562  ! -- modules
4564  ! -- dummy variables
4565  class(mawtype), intent(inout) :: this !< MawType object
4566  ! -- local variables
4567  integer(I4B) :: i
4568  integer(I4B) :: j
4569  !
4570  ! -- Set ivsc and reallocate viscratios to be of size MAXBOUND
4571  this%ivsc = 1
4572  call mem_reallocate(this%viscratios, 2, this%MAXBOUND, 'VISCRATIOS', &
4573  this%memoryPath)
4574  do i = 1, this%maxbound
4575  do j = 1, 2
4576  this%viscratios(j, i) = done
4577  end do
4578  end do
4579  write (this%iout, '(/1x,a)') 'VISCOSITY HAS BEEN ACTIVATED FOR MAW &
4580  &PACKAGE: '//trim(adjustl(this%packName))
4581  end subroutine maw_activate_viscosity
4582 
4583  !> @brief Calculate the groundwater-maw density exchange terms
4584  !!
4585  !! Arguments are as follows:
4586  !! iconn : maw-gwf connection number
4587  !! hmaw : maw head
4588  !! hgwf : gwf head
4589  !! cond : conductance
4590  !! bmaw : bottom elevation of this connection
4591  !! flow : calculated flow, updated here with density terms, + into maw
4592  !! hcofterm : head coefficient term
4593  !! rhsterm : right-hand-side value, updated here with density terms
4594  !!
4595  !! Member variable used here
4596  !! denseterms : shape (3, MAXBOUND), filled by buoyancy package
4597  !! col 1 is relative density of maw (densemaw / denseref)
4598  !! col 2 is relative density of gwf cell (densegwf / denseref)
4599  !! col 3 is elevation of gwf cell
4600  !!
4601  !! Upon return, amat and rhs for maw row should be updated as:
4602  !! amat(idiag) = amat(idiag) - hcofterm
4603  !! rhs(n) = rhs(n) + rhsterm
4604  !<
4605  subroutine maw_calculate_density_exchange(this, iconn, hmaw, hgwf, cond, &
4606  bmaw, flow, hcofterm, rhsterm)
4607  ! -- dummy
4608  class(mawtype), intent(inout) :: this
4609  integer(I4B), intent(in) :: iconn
4610  real(DP), intent(in) :: hmaw
4611  real(DP), intent(in) :: hgwf
4612  real(DP), intent(in) :: cond
4613  real(DP), intent(in) :: bmaw
4614  real(DP), intent(inout) :: flow
4615  real(DP), intent(inout) :: hcofterm
4616  real(DP), intent(inout) :: rhsterm
4617  ! -- local
4618  real(DP) :: t
4619  real(DP) :: havg
4620  real(DP) :: rdensemaw
4621  real(DP) :: rdensegwf
4622  real(DP) :: rdenseavg
4623  real(DP) :: elevavg
4624  ! -- formats
4625  !
4626  ! -- assign relative density terms, return if zero which means not avail yet
4627  rdensemaw = this%denseterms(1, iconn)
4628  rdensegwf = this%denseterms(2, iconn)
4629  if (rdensegwf == dzero) return
4630  !
4631  ! -- update rhsterm with density contribution
4632  if (hmaw > bmaw .and. hgwf > bmaw) then
4633  !
4634  ! -- hmaw and hgwf both above bmaw
4635  rdenseavg = dhalf * (rdensemaw + rdensegwf)
4636  !
4637  ! -- update rhsterm with first density term
4638  t = cond * (rdenseavg - done) * (hgwf - hmaw)
4639  rhsterm = rhsterm + t
4640  flow = flow + t
4641  !
4642  ! -- update rhterm with second density term
4643  havg = dhalf * (hgwf + hmaw)
4644  elevavg = this%denseterms(3, iconn)
4645  t = cond * (havg - elevavg) * (rdensegwf - rdensemaw)
4646  rhsterm = rhsterm + t
4647  flow = flow + t
4648  else if (hmaw > bmaw) then
4649  !
4650  ! -- if only hmaw is above bmaw, then increase correction term by density
4651  t = (rdensemaw - done) * rhsterm
4652  rhsterm = rhsterm + t
4653  !
4654  else if (hgwf > bmaw) then
4655  !
4656  ! -- if only hgwf is above bmaw, then increase correction term by density
4657  t = (rdensegwf - done) * rhsterm
4658  rhsterm = rhsterm + t
4659  !
4660  else
4661  !
4662  ! -- Flow should be zero so do nothing
4663  end if
4664  end subroutine maw_calculate_density_exchange
4665 
4666 end module mawmodule
This module contains block parser methods.
Definition: BlockParser.f90:7
This module contains the base boundary package.
This module contains the BudgetModule.
Definition: Budget.f90:20
subroutine, public budgetobject_cr(this, name)
Create a new budget object.
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
real(dp), parameter dhdry
real dry cell constant
Definition: Constants.f90:94
@ tabcenter
centered table column
Definition: Constants.f90:172
@ tabright
right justified table column
Definition: Constants.f90:173
@ tableft
left justified table column
Definition: Constants.f90:171
@ mnormal
normal output mode
Definition: Constants.f90:206
@ tabucstring
upper case string table data
Definition: Constants.f90:180
@ tabstring
string table data
Definition: Constants.f90:179
@ tabreal
real table data
Definition: Constants.f90:182
@ tabinteger
integer table data
Definition: Constants.f90:181
integer(i4b), parameter lenpackagename
maximum length of the package name
Definition: Constants.f90:23
real(dp), parameter dp9
real constant 9/10
Definition: Constants.f90:72
real(dp), parameter deight
real constant 8
Definition: Constants.f90:83
integer(i4b), parameter namedboundflag
named bound flag
Definition: Constants.f90:49
real(dp), parameter dnodata
real no data constant
Definition: Constants.f90:95
real(dp), parameter dhnoflo
real no flow constant
Definition: Constants.f90:93
real(dp), parameter dhundred
real constant 100
Definition: Constants.f90:86
integer(i4b), parameter lentimeseriesname
maximum length of a time series name
Definition: Constants.f90:42
real(dp), parameter dtwopi
real constant
Definition: Constants.f90:129
real(dp), parameter dep20
real constant 1e20
Definition: Constants.f90:91
real(dp), parameter dhalf
real constant 1/2
Definition: Constants.f90:68
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
Definition: Constants.f90:39
integer(i4b), parameter lenauxname
maximum length of a aux variable
Definition: Constants.f90:35
real(dp), parameter dpi
real constant
Definition: Constants.f90:128
integer(i4b), parameter lenboundname
maximum length of a bound name
Definition: Constants.f90:36
real(dp), parameter dem4
real constant 1e-4
Definition: Constants.f90:107
real(dp), parameter dem6
real constant 1e-6
Definition: Constants.f90:109
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
integer(i4b), parameter maxcharlen
maximum length of char string
Definition: Constants.f90:47
real(dp), parameter dp7
real constant 7/10
Definition: Constants.f90:71
real(dp), parameter dem9
real constant 1e-9
Definition: Constants.f90:112
real(dp), parameter dem2
real constant 1e-2
Definition: Constants.f90:105
real(dp), parameter dtwo
real constant 2
Definition: Constants.f90:79
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:37
real(dp), parameter dquarter
real constant 1/3
Definition: Constants.f90:66
real(dp), parameter done
real constant 1
Definition: Constants.f90:76
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...
Definition: GeomUtil.f90:83
subroutine, public assign_iounit(iounit, errunit, description)
@ brief assign io unit number
subroutine, public extract_idnum_or_bndname(line, icol, istart, istop, idnum, bndname)
Starting at position icol, define string as line(istart:istop).
integer(i4b) function, public getunit()
Get a free unit number.
subroutine, public ulasav(buf, text, kstp, kper, pertim, totim, ncol, nrow, ilay, ichn)
Save 1 layer array on disk.
subroutine, public openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, filstat_opt, mode_opt)
Open a file.
Definition: InputOutput.f90:30
subroutine, public urword(line, icol, istart, istop, ncode, n, r, iout, in)
Extract a word from a string.
This module defines variable data types.
Definition: kind.f90:8
subroutine maw_fill_budobj(this)
Copy flow terms into thisbudobj.
Definition: gwf-maw.f90:4251
subroutine maw_rp(this)
Read and Prepare.
Definition: gwf-maw.f90:1800
subroutine maw_set_stressperiod(this, imaw, iheadlimit_warning)
Set a stress period attribute for mawweslls(imaw) using keywords.
Definition: gwf-maw.f90:1337
integer(i4b) function get_gwfnode(this, n, j)
Get the gwfnode for connection.
Definition: gwf-maw.f90:4521
subroutine maw_cf(this)
Formulate the HCOF and RHS terms.
Definition: gwf-maw.f90:2152
subroutine maw_ot_bdsummary(this, kstp, kper, iout, ibudfl)
Write MAW budget to listing file.
Definition: gwf-maw.f90:2729
subroutine maw_activate_viscosity(this)
Activate viscosity terms.
Definition: gwf-maw.f90:4562
subroutine maw_read_initial_attr(this)
Read the initial parameters for this package.
Definition: gwf-maw.f90:1110
subroutine maw_bd_obs(this)
Calculate observations this time step and call ObsTypeSaveOneSimval for each MawType observation.
Definition: gwf-maw.f90:3000
subroutine maw_ar(this)
Allocate and Read.
Definition: gwf-maw.f90:1770
subroutine maw_set_attribute_error(this, imaw, keyword, msg)
Issue a parameter error for mawweslls(imaw)
Definition: gwf-maw.f90:1469
subroutine maw_ad(this)
Add package connection to matrix.
Definition: gwf-maw.f90:2084
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...
Definition: gwf-maw.f90:3598
subroutine maw_calculate_density_exchange(this, iconn, hmaw, hgwf, cond, bmaw, flow, hcofterm, rhsterm)
Calculate the groundwater-maw density exchange terms.
Definition: gwf-maw.f90:4607
subroutine maw_calculate_wellq(this, n, hmaw, q)
Calculate well pumping rate based on constraints.
Definition: gwf-maw.f90:3741
subroutine maw_rp_obs(this)
Process each observation.
Definition: gwf-maw.f90:3136
character(len=lenpackagename) text
Definition: gwf-maw.f90:40
subroutine maw_allocate_scalars(this)
Allocate scalar members.
Definition: gwf-maw.f90:271
subroutine maw_calculate_qpot(this, n, qnet)
Calculate groundwater inflow to a maw well.
Definition: gwf-maw.f90:3906
subroutine maw_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap)
Write flows to binary file and/or print flows to budget.
Definition: gwf-maw.f90:2634
subroutine, public maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
Create a New Multi-Aquifer Well (MAW) Package.
Definition: gwf-maw.f90:234
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.
Definition: gwf-maw.f90:2885
subroutine maw_activate_density(this)
Activate density terms.
Definition: gwf-maw.f90:4538
integer(i4b) function get_jpos(this, n, j)
Get position of value in connection data.
Definition: gwf-maw.f90:4506
subroutine maw_fn(this, rhs, ia, idxglo, matrix_sln)
Fill newton terms.
Definition: gwf-maw.f90:2315
subroutine maw_calculate_saturation(this, n, j, node, sat)
Calculate the saturation between the aquifer maw well_head.
Definition: gwf-maw.f90:3528
subroutine maw_ot_package_flows(this, icbcfl, ibudfl)
Output MAW package flow terms.
Definition: gwf-maw.f90:2648
subroutine maw_allocate_well_conn_arrays(this)
Allocate well arrays.
Definition: gwf-maw.f90:324
logical function maw_obs_supported(this)
Return true because MAW package supports observations.
Definition: gwf-maw.f90:2925
subroutine maw_read_dimensions(this)
Read the dimensions for this package.
Definition: gwf-maw.f90:1037
subroutine maw_read_options(this, option, found)
Set options specific to MawType.
Definition: gwf-maw.f90:1652
subroutine maw_allocate_arrays(this)
Allocate arrays.
Definition: gwf-maw.f90:521
subroutine maw_cfupdate(this)
Update MAW satcond and package rhs and hcof.
Definition: gwf-maw.f90:3992
subroutine maw_redflow_csv_write(this)
MAW reduced flows only when & where they occur.
Definition: gwf-maw.f90:3336
subroutine maw_redflow_csv_init(this, fname)
Initialize the auto flow reduce csv output file.
Definition: gwf-maw.f90:3316
subroutine maw_mc(this, moffset, matrix_sln)
Map package connection to matrix.
Definition: gwf-maw.f90:1592
subroutine maw_read_wells(this)
Read the packagedata for this package.
Definition: gwf-maw.f90:534
subroutine maw_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
Calculate under-relaxation of groundwater flow model MAW Package heads for current outer iteration us...
Definition: gwf-maw.f90:2478
subroutine maw_check_attributes(this)
Issue parameter errors for mawwells(imaw)
Definition: gwf-maw.f90:1491
subroutine maw_ac(this, moffset, sparse)
Add package connection to matrix.
Definition: gwf-maw.f90:1562
subroutine maw_ot_dv(this, idvsave, idvprint)
Save maw-calculated values to binary file.
Definition: gwf-maw.f90:2674
subroutine maw_fc(this, rhs, ia, idxglo, matrix_sln)
Copy rhs and hcof into solution rhs and amat.
Definition: gwf-maw.f90:2163
character(len=lenftype) ftype
Definition: gwf-maw.f90:39
subroutine maw_read_well_connections(this)
Read the dimensions for this package.
Definition: gwf-maw.f90:792
subroutine define_listlabel(this)
Define the list heading that is written to iout when PRINT_INPUT option is used.
Definition: gwf-maw.f90:2861
subroutine maw_setup_budobj(this)
Set up the budget object that stores all the maw flows The terms listed here must correspond in numbe...
Definition: gwf-maw.f90:4049
subroutine maw_cq(this, x, flowja, iadv)
Calculate flows.
Definition: gwf-maw.f90:2517
subroutine maw_df_obs(this)
Store observation type supported by MAW package.
Definition: gwf-maw.f90:2935
subroutine maw_calculate_satcond(this, i, j, node)
Calculate the appropriate saturated conductance to use based on aquifer and multi-aquifer well charac...
Definition: gwf-maw.f90:3364
subroutine maw_da(this)
Deallocate memory.
Definition: gwf-maw.f90:2744
subroutine maw_process_obsid(obsrv, dis, inunitobs, iout)
This procedure is pointed to by ObsDataTypeProcesssIdPtr. It processes the ID string of an observatio...
Definition: gwf-maw.f90:3264
subroutine maw_setup_tableobj(this)
Set up the table object that is used to write the maw head data.
Definition: gwf-maw.f90:4462
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains the derived types ObserveType and ObsDataType.
Definition: Observe.f90:15
This module contains the derived type ObsType.
Definition: Obs.f90:127
character(len=20) access
Definition: OpenSpec.f90:7
character(len=20) form
Definition: OpenSpec.f90:7
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_warning(msg, substring)
Store warning message.
Definition: Sim.f90:236
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
Definition: Sim.f90:168
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
character(len=maxcharlen) warnmsg
warning message string
real(dp) function squadraticsaturation(top, bot, x, eps)
@ brief sQuadraticSaturation
real(dp) function squadraticsaturationderivative(top, bot, x, eps)
@ brief Derivative of the quadratic saturation function
real(dp) function sqsaturationderivative(top, bot, x, c1, c2)
@ brief sQSaturationDerivative
real(dp) function squadratic0spderivative(x, xi, tomega)
@ brief sQuadratic0spDerivative
real(dp) function sqsaturation(top, bot, x, c1, c2)
@ brief sQSaturation
real(dp) function squadratic0sp(x, xi, tomega)
@ brief sQuadratic0sp
subroutine, public table_cr(this, name, title)
Definition: Table.f90:87
real(dp), pointer, public pertim
time relative to start of stress period
Definition: tdis.f90:30
real(dp), pointer, public totim
time relative to start of simulation
Definition: tdis.f90:32
integer(i4b), pointer, public kstp
current time step number
Definition: tdis.f90:24
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:23
real(dp), pointer, public delt
length of the current time step
Definition: tdis.f90:29
integer(i4b), pointer, public nper
number of stress period
Definition: tdis.f90:21
subroutine, public read_value_or_time_series_adv(textInput, ii, jj, bndElem, pkgName, auxOrBnd, tsManager, iprpak, varName)
Call this subroutine from advanced packages to define timeseries link for a variable (varName).
@ brief BndType
Derived type for the Budget object.
Definition: Budget.f90:39