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