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