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