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