MODFLOW 6  version 6.8.0.dev0
USGS Modular Hydrologic Model
mawmodule Module Reference

Data Types

type  mawtype
 

Functions/Subroutines

subroutine, public maw_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname)
 Create a New Multi-Aquifer Well (MAW) Package. More...
 
subroutine maw_allocate_scalars (this)
 Allocate scalar members. More...
 
subroutine maw_allocate_well_conn_arrays (this)
 Allocate well arrays. More...
 
subroutine maw_allocate_arrays (this)
 Allocate arrays. More...
 
subroutine maw_read_wells (this)
 Read the packagedata for this package. More...
 
subroutine maw_read_well_connections (this)
 Read the dimensions for this package. More...
 
subroutine maw_read_angledata (this)
 Read the optional ANGLEDATA block for non-vertical (slanted) MAW well connections. More...
 
real(dp) function maw_calc_lcorr (this, i, jpos)
 Calculate the length correction factor for a multi-aquifer well connection. More...
 
subroutine maw_read_dimensions (this)
 Read the dimensions for this package. More...
 
subroutine maw_read_initial_attr (this)
 Read the initial parameters for this package. More...
 
subroutine maw_set_stressperiod (this, imaw, iheadlimit_warning)
 Set a stress period attribute for mawweslls(imaw) using keywords. More...
 
subroutine maw_set_attribute_error (this, imaw, keyword, msg)
 Issue a parameter error for mawweslls(imaw) More...
 
subroutine maw_check_attributes (this)
 Issue parameter errors for mawwells(imaw) More...
 
subroutine maw_ac (this, moffset, sparse)
 Add package connection to matrix. More...
 
subroutine maw_mc (this, moffset, matrix_sln)
 Map package connection to matrix. More...
 
subroutine maw_read_options (this, option, found)
 Set options specific to MawType. More...
 
subroutine maw_ar (this)
 Allocate and Read. More...
 
subroutine maw_rp (this)
 Read and Prepare. More...
 
subroutine maw_ad (this)
 Add package connection to matrix. More...
 
subroutine maw_cf (this)
 Formulate the HCOF and RHS terms. More...
 
subroutine maw_fc (this, rhs, ia, idxglo, matrix_sln)
 Copy rhs and hcof into solution rhs and amat. More...
 
subroutine maw_fn (this, rhs, ia, idxglo, matrix_sln)
 Fill newton terms. More...
 
subroutine maw_nur (this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
 Apply Newton under-relaxation to the MAW Package well heads. More...
 
pure real(dp) function, public maw_damp_weight (dxprop, dxold, weight, damptheta, damptol, weightmin, recover)
 Update the oscillation-damping weight for a single MAW well head. More...
 
subroutine maw_cc (this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
 Extra convergence check for the MAW package. More...
 
subroutine maw_cq (this, x, flowja, iadv)
 Calculate flows. More...
 
subroutine maw_ot_model_flows (this, icbcfl, ibudfl, icbcun, imap)
 Write flows to binary file and/or print flows to budget. More...
 
subroutine maw_ot_package_flows (this, icbcfl, ibudfl)
 Output MAW package flow terms. More...
 
subroutine maw_ot_dv (this, idvsave, idvprint)
 Save maw-calculated values to binary file. More...
 
subroutine maw_ot_bdsummary (this, kstp, kper, iout, ibudfl)
 Write MAW budget to listing file. More...
 
subroutine maw_da (this)
 Deallocate memory. More...
 
subroutine define_listlabel (this)
 Define the list heading that is written to iout when PRINT_INPUT option is used. More...
 
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. More...
 
logical function maw_obs_supported (this)
 Return true because MAW package supports observations. More...
 
subroutine maw_df_obs (this)
 Store observation type supported by MAW package. More...
 
subroutine maw_bd_obs (this)
 Calculate observations this time step and call ObsTypeSaveOneSimval for each MawType observation. More...
 
subroutine maw_rp_obs (this)
 Process each observation. More...
 
subroutine maw_process_obsid (obsrv, dis, inunitobs, iout)
 This procedure is pointed to by ObsDataTypeProcesssIdPtr. It processes the ID string of an observation definition for MAW package observations. More...
 
subroutine maw_redflow_csv_init (this, fname)
 Initialize the auto flow reduce csv output file. More...
 
subroutine maw_redflow_csv_write (this)
 MAW reduced flows only when & where they occur. More...
 
subroutine maw_calculate_satcond (this, i, j, node)
 Calculate the appropriate saturated conductance to use based on aquifer and multi-aquifer well characteristics. More...
 
subroutine maw_calculate_saturation (this, n, j, node, sat, hwell_in)
 Calculate the saturation between the aquifer maw well_head. More...
 
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 calculated based on whether term2 is passed Arguments are as follows: n : maw well number j : connection number for well n icflow : flag indicating that flow should be corrected cmaw : maw-gwf conducance cterm : correction term for flow to dry cell term : xxx flow : calculated flow for this connection, positive into well term2 : xxx. More...
 
subroutine maw_calculate_wellq (this, n, hmaw, q)
 Calculate well pumping rate based on constraints. More...
 
subroutine maw_calculate_qpot (this, n, qnet)
 Calculate groundwater inflow to a maw well. More...
 
subroutine maw_cfupdate (this)
 Update MAW satcond and package rhs and hcof. More...
 
subroutine maw_setup_budobj (this)
 Set up the budget object that stores all the maw flows The terms listed here must correspond in number and order to the ones listed in the maw_fill_budobj routine. More...
 
subroutine maw_fill_budobj (this)
 Copy flow terms into thisbudobj. More...
 
subroutine maw_setup_tableobj (this)
 Set up the table object that is used to write the maw head data. More...
 
integer(i4b) function get_jpos (this, n, j)
 Get position of value in connection data. More...
 
integer(i4b) function get_gwfnode (this, n, j)
 Get the gwfnode for connection. More...
 
subroutine maw_activate_density (this)
 Activate density terms. More...
 
subroutine maw_activate_viscosity (this)
 Activate viscosity terms. More...
 
subroutine maw_calculate_density_exchange (this, iconn, hmaw, hgwf, cond, bmaw, flow, hcofterm, rhsterm)
 Calculate the groundwater-maw density exchange terms. More...
 

Variables

character(len=lenftype) ftype = 'MAW'
 
character(len=lenpackagename) text = ' MAW'
 

Function/Subroutine Documentation

◆ define_listlabel()

subroutine mawmodule::define_listlabel ( class(mawtype), intent(inout)  this)

Definition at line 3473 of file gwf-maw.f90.

3474  class(MawType), intent(inout) :: this
3475  !
3476  ! -- create the header list label
3477  this%listlabel = trim(this%filtyp)//' NO.'
3478  if (this%dis%ndim == 3) then
3479  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER'
3480  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'ROW'
3481  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'COL'
3482  elseif (this%dis%ndim == 2) then
3483  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER'
3484  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'CELL2D'
3485  else
3486  write (this%listlabel, '(a, a7)') trim(this%listlabel), 'NODE'
3487  end if
3488  write (this%listlabel, '(a, a16)') trim(this%listlabel), 'STRESS RATE'
3489  if (this%inamedbound == 1) then
3490  write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
3491  end if

◆ get_gwfnode()

integer(i4b) function mawmodule::get_gwfnode ( class(mawtype this,
integer(i4b), intent(in)  n,
integer(i4b), intent(in)  j 
)
private

Definition at line 5151 of file gwf-maw.f90.

5152  ! -- return variable
5153  integer(I4B) :: igwfnode
5154  ! -- dummy
5155  class(MawType) :: this
5156  integer(I4B), intent(in) :: n
5157  integer(I4B), intent(in) :: j
5158  ! -- local
5159  integer(I4B) :: jpos
5160  !
5161  ! -- set jpos
5162  jpos = this%get_jpos(n, j)
5163  igwfnode = this%gwfnodes(jpos)

◆ get_jpos()

integer(i4b) function mawmodule::get_jpos ( class(mawtype this,
integer(i4b), intent(in)  n,
integer(i4b), intent(in)  j 
)

Definition at line 5136 of file gwf-maw.f90.

5137  ! -- return variable
5138  integer(I4B) :: jpos
5139  ! -- dummy
5140  class(MawType) :: this
5141  integer(I4B), intent(in) :: n
5142  integer(I4B), intent(in) :: j
5143  ! -- local
5144  !
5145  ! -- set jpos
5146  jpos = this%iaconn(n) + j - 1

◆ maw_ac()

subroutine mawmodule::maw_ac ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  moffset,
type(sparsematrix), intent(inout)  sparse 
)

Definition at line 1911 of file gwf-maw.f90.

1912  use sparsemodule, only: sparsematrix
1913  ! -- dummy
1914  class(MawType), intent(inout) :: this
1915  integer(I4B), intent(in) :: moffset
1916  type(sparsematrix), intent(inout) :: sparse
1917  ! -- local
1918  integer(I4B) :: j
1919  integer(I4B) :: n
1920  integer(I4B) :: jj
1921  integer(I4B) :: jglo
1922  integer(I4B) :: nglo
1923  ! -- format
1924  !
1925  ! -- Add package rows to sparse
1926  do n = 1, this%nmawwells
1927  nglo = moffset + this%dis%nodes + this%ioffset + n
1928  call sparse%addconnection(nglo, nglo, 1)
1929  do j = 1, this%ngwfnodes(n)
1930  jj = this%get_gwfnode(n, j)
1931  jglo = jj + moffset
1932  call sparse%addconnection(nglo, jglo, 1)
1933  call sparse%addconnection(jglo, nglo, 1)
1934  end do
1935 
1936  end do

◆ maw_activate_density()

subroutine mawmodule::maw_activate_density ( class(mawtype), intent(inout)  this)
private

Definition at line 5168 of file gwf-maw.f90.

5169  ! -- dummy
5170  class(MawType), intent(inout) :: this
5171  ! -- local
5172  integer(I4B) :: i, j
5173  ! -- formats
5174  !
5175  ! -- Set idense and reallocate denseterms to be of size MAXBOUND
5176  this%idense = 1
5177  call mem_reallocate(this%denseterms, 3, this%MAXBOUND, 'DENSETERMS', &
5178  this%memoryPath)
5179  do i = 1, this%maxbound
5180  do j = 1, 3
5181  this%denseterms(j, i) = dzero
5182  end do
5183  end do
5184  write (this%iout, '(/1x,a)') 'DENSITY TERMS HAVE BEEN ACTIVATED FOR MAW &
5185  &PACKAGE: '//trim(adjustl(this%packName))

◆ maw_activate_viscosity()

subroutine mawmodule::maw_activate_viscosity ( class(mawtype), intent(inout)  this)
private

Method to activate addition of viscosity terms for a MAW package reach.

Parameters
[in,out]thisMawType object

Definition at line 5192 of file gwf-maw.f90.

5193  ! -- modules
5195  ! -- dummy variables
5196  class(MawType), intent(inout) :: this !< MawType object
5197  ! -- local variables
5198  integer(I4B) :: i
5199  integer(I4B) :: j
5200  !
5201  ! -- Set ivsc and reallocate viscratios to be of size MAXBOUND
5202  this%ivsc = 1
5203  call mem_reallocate(this%viscratios, 2, this%MAXBOUND, 'VISCRATIOS', &
5204  this%memoryPath)
5205  do i = 1, this%maxbound
5206  do j = 1, 2
5207  this%viscratios(j, i) = done
5208  end do
5209  end do
5210  write (this%iout, '(/1x,a)') 'VISCOSITY HAS BEEN ACTIVATED FOR MAW &
5211  &PACKAGE: '//trim(adjustl(this%packName))

◆ maw_ad()

subroutine mawmodule::maw_ad ( class(mawtype this)

Definition at line 2439 of file gwf-maw.f90.

2440  use tdismodule, only: kper, kstp
2441  ! -- dummy
2442  class(MawType) :: this
2443  ! -- local
2444  integer(I4B) :: n
2445  integer(I4B) :: j
2446  integer(I4B) :: jj
2447  integer(I4B) :: ibnd
2448  !
2449  ! -- Advance the time series
2450  call this%TsManager%ad()
2451  !
2452  ! -- update auxiliary variables by copying from the derived-type time
2453  ! series variable into the bndpackage auxvar variable so that this
2454  ! information is properly written to the GWF budget file
2455  if (this%naux > 0) then
2456  ibnd = 1
2457  do n = 1, this%nmawwells
2458  do j = 1, this%ngwfnodes(n)
2459  do jj = 1, this%naux
2460  if (this%noupdateauxvar(jj) /= 0) cycle
2461  this%auxvar(jj, ibnd) = this%mauxvar(jj, n)
2462  end do
2463  ibnd = ibnd + 1
2464  end do
2465  end do
2466  end if
2467  !
2468  ! -- copy xnew into xold
2469  do n = 1, this%nmawwells
2470  this%xoldpak(n) = this%xnewpak(n)
2471  this%xoldsto(n) = this%xsto(n)
2472  if (this%iboundpak(n) < 0) then
2473  this%xnewpak(n) = this%well_head(n)
2474  end if
2475  !
2476  ! -- start each time step with damping turned off. Clearing the weight
2477  ! and the previous head change stops a leftover value from the last
2478  ! time step from triggering damping on the first iteration.
2479  this%nurdxold(n) = dzero
2480  this%nurweight(n) = done
2481  end do
2482  !
2483  !--use the appropriate xoldsto if initial heads are above the
2484  ! specified flowing well discharge elevation
2485  if (kper == 1 .and. kstp == 1) then
2486  do n = 1, this%nmawwells
2487  if (this%fwcond(n) > dzero) then
2488  if (this%xoldsto(n) > this%fwelev(n)) then
2489  this%xoldsto(n) = this%fwelev(n)
2490  end if
2491  end if
2492  end do
2493  end if
2494  !
2495  ! -- reset ishutoffcnt (equivalent to kiter) to zero
2496  this%ishutoffcnt = 0
2497  !
2498  ! -- pakmvrobj ad
2499  if (this%imover == 1) then
2500  call this%pakmvrobj%ad()
2501  end if
2502  !
2503  ! -- For each observation, push simulated value and corresponding
2504  ! simulation time from "current" to "preceding" and reset
2505  ! "current" value.
2506  call this%obs%obs_ad()
integer(i4b), pointer, public kstp
current time step number
Definition: tdis.f90:27
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:26

◆ maw_allocate_arrays()

subroutine mawmodule::maw_allocate_arrays ( class(mawtype), intent(inout)  this)

Definition at line 553 of file gwf-maw.f90.

554  ! -- modules
556  ! -- dummy
557  class(MawType), intent(inout) :: this
558  ! -- local
559  !
560  ! -- call standard BndType allocate scalars
561  call this%BndType%allocate_arrays()

◆ maw_allocate_scalars()

subroutine mawmodule::maw_allocate_scalars ( class(mawtype), intent(inout)  this)
private

Definition at line 283 of file gwf-maw.f90.

284  ! -- modules
286  ! -- dummy
287  class(MawType), intent(inout) :: this
288  !
289  ! -- call standard BndType allocate scalars
290  call this%BndType%allocate_scalars()
291  !
292  ! -- allocate the object and assign values to object variables
293  call mem_allocate(this%correct_flow, 'CORRECT_FLOW', this%memoryPath)
294  call mem_allocate(this%iprhed, 'IPRHED', this%memoryPath)
295  call mem_allocate(this%iheadout, 'IHEADOUT', this%memoryPath)
296  call mem_allocate(this%ibudgetout, 'IBUDGETOUT', this%memoryPath)
297  call mem_allocate(this%ibudcsv, 'IBUDCSV', this%memoryPath)
298  call mem_allocate(this%iflowingwells, 'IFLOWINGWELLS', this%memoryPath)
299  call mem_allocate(this%imawiss, 'IMAWISS', this%memoryPath)
300  call mem_allocate(this%imawissopt, 'IMAWISSOPT', this%memoryPath)
301  call mem_allocate(this%nmawwells, 'NMAWWELLS', this%memoryPath)
302  call mem_allocate(this%check_attr, 'CHECK_ATTR', this%memoryPath)
303  call mem_allocate(this%ishutoffcnt, 'ISHUTOFFCNT', this%memoryPath)
304  call mem_allocate(this%ieffradopt, 'IEFFRADOPT', this%memoryPath)
305  call mem_allocate(this%inonvert, 'INONVERT', this%memoryPath)
306  call mem_allocate(this%ioutredflowcsv, 'IOUTREDFLOWCSV', this%memoryPath) !for writing reduced MAW flows to csv file
307  call mem_allocate(this%satomega, 'SATOMEGA', this%memoryPath)
308  call mem_allocate(this%bditems, 'BDITEMS', this%memoryPath)
309  call mem_allocate(this%theta, 'THETA', this%memoryPath)
310  call mem_allocate(this%kappa, 'KAPPA', this%memoryPath)
311  call mem_allocate(this%cbcauxitems, 'CBCAUXITEMS', this%memoryPath)
312  call mem_allocate(this%idense, 'IDENSE', this%memoryPath)
313  !
314  ! -- Set values
315  this%correct_flow = .false.
316  this%nmawwells = 0
317  this%iprhed = 0
318  this%iheadout = 0
319  this%ibudgetout = 0
320  this%ibudcsv = 0
321  this%iflowingwells = 0
322  this%imawiss = 0
323  this%imawissopt = 0
324  this%ieffradopt = 0
325  this%inonvert = 0
326  this%ioutredflowcsv = 0
327  this%satomega = dzero
328  this%bditems = 8
329  this%theta = dp7
330  this%kappa = dem4
331  this%cbcauxitems = 1
332  this%idense = 0
333  this%ivsc = 0

◆ maw_allocate_well_conn_arrays()

subroutine mawmodule::maw_allocate_well_conn_arrays ( class(mawtype), intent(inout)  this)

Definition at line 338 of file gwf-maw.f90.

339  ! -- modules
341  ! -- dummy
342  class(MawType), intent(inout) :: this
343  ! -- local
344  integer(I4B) :: j
345  integer(I4B) :: n
346  integer(I4B) :: jj
347  !
348  ! -- allocate character array for budget text
349  call mem_allocate(this%cmawbudget, lenbudtxt, this%bditems, 'CMAWBUDGET', &
350  this%memoryPath)
351  !
352  !-- fill cmawbudget
353  this%cmawbudget(1) = ' GWF'
354  this%cmawbudget(2) = ' RATE'
355  this%cmawbudget(3) = ' STORAGE'
356  this%cmawbudget(4) = ' CONSTANT'
357  this%cmawbudget(5) = ' FW-RATE'
358  this%cmawbudget(6) = ' FROM-MVR'
359  this%cmawbudget(7) = ' RATE-TO-MVR'
360  this%cmawbudget(8) = ' FW-RATE-TO-MVR'
361  !
362  ! -- allocate character arrays
363  call mem_allocate(this%cmawname, lenboundname, this%nmawwells, 'CMAWNAME', &
364  this%memoryPath)
365  call mem_allocate(this%status, 8, this%nmawwells, 'STATUS', this%memoryPath)
366  !
367  ! -- allocate well data pointers in memory manager
368  call mem_allocate(this%ngwfnodes, this%nmawwells, 'NGWFNODES', &
369  this%memoryPath)
370  call mem_allocate(this%ieqn, this%nmawwells, 'IEQN', this%memoryPath)
371  call mem_allocate(this%ishutoff, this%nmawwells, 'ISHUTOFF', this%memoryPath)
372  call mem_allocate(this%ifwdischarge, this%nmawwells, 'IFWDISCHARGE', &
373  this%memoryPath)
374  call mem_allocate(this%strt, this%nmawwells, 'STRT', this%memoryPath)
375  call mem_allocate(this%radius, this%nmawwells, 'RADIUS', this%memoryPath)
376  call mem_allocate(this%area, this%nmawwells, 'AREA', this%memoryPath)
377  call mem_allocate(this%pumpelev, this%nmawwells, 'PUMPELEV', this%memoryPath)
378  call mem_allocate(this%bot, this%nmawwells, 'BOT', this%memoryPath)
379  call mem_allocate(this%ratesim, this%nmawwells, 'RATESIM', this%memoryPath)
380  call mem_allocate(this%qsim0, this%nmawwells, 'QSIM0', this%memoryPath)
381  call mem_allocate(this%reduction_length, this%nmawwells, 'REDUCTION_LENGTH', &
382  this%memoryPath)
383  call mem_allocate(this%fwelev, this%nmawwells, 'FWELEV', this%memoryPath)
384  call mem_allocate(this%fwcond, this%nmawwells, 'FWCONDS', this%memoryPath)
385  call mem_allocate(this%fwrlen, this%nmawwells, 'FWRLEN', this%memoryPath)
386  call mem_allocate(this%fwcondsim, this%nmawwells, 'FWCONDSIM', &
387  this%memoryPath)
388  call mem_allocate(this%xsto, this%nmawwells, 'XSTO', this%memoryPath)
389  call mem_allocate(this%xoldsto, this%nmawwells, 'XOLDSTO', this%memoryPath)
390  call mem_allocate(this%shutoffmin, this%nmawwells, 'SHUTOFFMIN', &
391  this%memoryPath)
392  call mem_allocate(this%shutoffmax, this%nmawwells, 'SHUTOFFMAX', &
393  this%memoryPath)
394  call mem_allocate(this%shutofflevel, this%nmawwells, 'SHUTOFFLEVEL', &
395  this%memoryPath)
396  call mem_allocate(this%shutoffweight, this%nmawwells, 'SHUTOFFWEIGHT', &
397  this%memoryPath)
398  call mem_allocate(this%shutoffdq, this%nmawwells, 'SHUTOFFDQ', &
399  this%memoryPath)
400  call mem_allocate(this%shutoffqold, this%nmawwells, 'SHUTOFFQOLD', &
401  this%memoryPath)
402  call mem_allocate(this%nurdxold, this%nmawwells, 'NURDXOLD', &
403  this%memoryPath)
404  call mem_allocate(this%nurweight, this%nmawwells, 'NURWEIGHT', &
405  this%memoryPath)
406  !
407  ! -- timeseries aware variables
408  call mem_allocate(this%rate, this%nmawwells, 'RATE', this%memoryPath)
409  call mem_allocate(this%well_head, this%nmawwells, 'WELL_HEAD', &
410  this%memoryPath)
411  if (this%naux > 0) then
412  jj = this%naux
413  else
414  jj = 1
415  end if
416  call mem_allocate(this%mauxvar, jj, this%nmawwells, 'MAUXVAR', &
417  this%memoryPath)
418  !
419  ! -- allocate and initialize dbuff
420  if (this%iheadout > 0) then
421  call mem_allocate(this%dbuff, this%nmawwells, 'DBUFF', this%memoryPath)
422  else
423  call mem_allocate(this%dbuff, 0, 'DBUFF', this%memoryPath)
424  end if
425  !
426  ! -- allocate iaconn
427  call mem_allocate(this%iaconn, this%nmawwells + 1, 'IACONN', this%memoryPath)
428  !
429  ! -- allocate imap
430  call mem_allocate(this%imap, this%MAXBOUND, 'IMAP', this%memoryPath)
431  !
432  ! -- allocate connection data
433  call mem_allocate(this%gwfnodes, this%maxbound, 'GWFNODES', this%memoryPath)
434  call mem_allocate(this%sradius, this%maxbound, 'SRADIUS', this%memoryPath)
435  call mem_allocate(this%hk, this%maxbound, 'HK', this%memoryPath)
436  call mem_allocate(this%satcond, this%maxbound, 'SATCOND', this%memoryPath)
437  call mem_allocate(this%simcond, this%maxbound, 'SIMCOND', this%memoryPath)
438  call mem_allocate(this%topscrn, this%maxbound, 'TOPSCRN', this%memoryPath)
439  call mem_allocate(this%botscrn, this%maxbound, 'BOTSCRN', this%memoryPath)
440  call mem_allocate(this%angle, this%maxbound, 'ANGLE', this%memoryPath)
441  call mem_allocate(this%connlen, this%maxbound, 'CONNLEN', this%memoryPath)
442  call mem_allocate(this%usrtopscrn, this%maxbound, 'USRTOPSCRN', &
443  this%memoryPath)
444  call mem_allocate(this%usrbotscrn, this%maxbound, 'USRBOTSCRN', &
445  this%memoryPath)
446  !
447  ! -- allocate qleak
448  call mem_allocate(this%qleak, this%maxbound, 'QLEAK', this%memoryPath)
449  !
450  ! -- initialize well data
451  do n = 1, this%nmawwells
452  this%status(n) = 'ACTIVE'
453  this%ngwfnodes(n) = 0
454  this%ieqn(n) = 0
455  this%ishutoff(n) = 0
456  this%ifwdischarge(n) = 0
457  this%strt(n) = dep20
458  this%radius(n) = dep20
459  this%area(n) = dzero
460  this%pumpelev(n) = dep20
461  this%bot(n) = dep20
462  this%ratesim(n) = dzero
463  this%qsim0(n) = dzero
464  this%reduction_length(n) = dep20
465  this%fwelev(n) = dzero
466  this%fwcond(n) = dzero
467  this%fwrlen(n) = dzero
468  this%fwcondsim(n) = dzero
469  this%xsto(n) = dzero
470  this%xoldsto(n) = dzero
471  this%shutoffmin(n) = dzero
472  this%shutoffmax(n) = dzero
473  this%shutofflevel(n) = dep20
474  this%shutoffweight(n) = done
475  this%shutoffdq(n) = done
476  this%shutoffqold(n) = done
477  this%nurdxold(n) = dzero
478  this%nurweight(n) = done
479  !
480  ! -- timeseries aware variables
481  this%rate(n) = dzero
482  this%well_head(n) = dzero
483  do jj = 1, max(1, this%naux)
484  this%mauxvar(jj, n) = dzero
485  end do
486  !
487  ! -- dbuff
488  if (this%iheadout > 0) then
489  this%dbuff(n) = dzero
490  end if
491  end do
492  !
493  ! -- initialize iaconn
494  do n = 1, this%nmawwells + 1
495  this%iaconn(n) = 0
496  end do
497  !
498  ! -- allocate character array for budget text
499  call mem_allocate(this%cauxcbc, lenauxname, this%cbcauxitems, 'CAUXCBC', &
500  this%memoryPath)
501  !
502  ! -- allocate and initialize qauxcbc
503  call mem_allocate(this%qauxcbc, this%cbcauxitems, 'QAUXCBC', this%memoryPath)
504  do j = 1, this%cbcauxitems
505  this%qauxcbc(j) = dzero
506  end do
507  !
508  ! -- allocate flowing well data
509  if (this%iflowingwells /= 0) then
510  call mem_allocate(this%qfw, this%nmawwells, 'QFW', this%memoryPath)
511  else
512  call mem_allocate(this%qfw, 1, 'QFW', this%memoryPath)
513  end if
514  call mem_allocate(this%qout, this%nmawwells, 'QOUT', this%memoryPath)
515  call mem_allocate(this%qsto, this%nmawwells, 'QSTO', this%memoryPath)
516  call mem_allocate(this%qconst, this%nmawwells, 'QCONST', this%memoryPath)
517  !
518  ! -- initialize flowing well, storage, and constant flow terms
519  do n = 1, this%nmawwells
520  if (this%iflowingwells > 0) then
521  this%qfw(n) = dzero
522  end if
523  this%qsto(n) = dzero
524  this%qconst(n) = dzero
525  end do
526  !
527  ! -- initialize connection data
528  do j = 1, this%maxbound
529  this%imap(j) = 0
530  this%gwfnodes(j) = 0
531  this%sradius(j) = dzero
532  this%hk(j) = dzero
533  this%satcond(j) = dzero
534  this%simcond(j) = dzero
535  this%topscrn(j) = dzero
536  this%botscrn(j) = dzero
537  this%angle(j) = dzero
538  this%connlen(j) = dzero
539  this%usrtopscrn(j) = dzero
540  this%usrbotscrn(j) = dzero
541  this%qleak(j) = dzero
542  end do
543  !
544  ! -- allocate denseterms to size 0
545  call mem_allocate(this%denseterms, 3, 0, 'DENSETERMS', this%memoryPath)
546  !
547  ! -- allocate viscratios to size 0
548  call mem_allocate(this%viscratios, 2, 0, 'VISCRATIOS', this%memoryPath)

◆ maw_ar()

subroutine mawmodule::maw_ar ( class(mawtype), intent(inout)  this)

Create new MAW package and point bndobj to the new package

Definition at line 2125 of file gwf-maw.f90.

2126  ! -- dummy
2127  class(MawType), intent(inout) :: this
2128  ! -- local
2129  ! -- format
2130  !
2131  call this%obs%obs_ar()
2132  !
2133  ! -- set omega value used for saturation calculations
2134  if (this%inewton > 0) then
2135  this%satomega = dem6
2136  end if
2137  !
2138  ! -- Allocate connection arrays in MAW and in package superclass
2139  call this%maw_allocate_arrays()
2140  !
2141  ! -- read optional initial package parameters
2142  call this%read_initial_attr()
2143  !
2144  ! -- setup pakmvrobj
2145  if (this%imover /= 0) then
2146  allocate (this%pakmvrobj)
2147  call this%pakmvrobj%ar(this%nmawwells, this%nmawwells, this%memoryPath)
2148  end if

◆ maw_bd_obs()

subroutine mawmodule::maw_bd_obs ( class(mawtype this)
private

Definition at line 3612 of file gwf-maw.f90.

3613  ! -- dummy
3614  class(MawType) :: this
3615  ! -- local
3616  integer(I4B) :: i
3617  integer(I4B) :: j
3618  integer(I4B) :: jj
3619  integer(I4B) :: n
3620  integer(I4B) :: nn
3621  integer(I4B) :: jpos
3622  real(DP) :: cmaw
3623  real(DP) :: hmaw
3624  real(DP) :: v
3625  real(DP) :: qfact
3626  type(ObserveType), pointer :: obsrv => null()
3627  !
3628  ! Calculate, save, and write simulated values for all MAW observations
3629  if (this%obs%npakobs > 0) then
3630  call this%obs%obs_bd_clear()
3631  do i = 1, this%obs%npakobs
3632  obsrv => this%obs%pakobs(i)%obsrv
3633  do j = 1, obsrv%indxbnds_count
3634  v = dnodata
3635  jj = obsrv%indxbnds(j)
3636  select case (obsrv%ObsTypeId)
3637  case ('HEAD')
3638  if (this%iboundpak(jj) /= 0) then
3639  v = this%xnewpak(jj)
3640  end if
3641  case ('FROM-MVR')
3642  if (this%iboundpak(jj) /= 0) then
3643  if (this%imover == 1) then
3644  v = this%pakmvrobj%get_qfrommvr(jj)
3645  end if
3646  end if
3647  case ('MAW')
3648  n = this%imap(jj)
3649  if (this%iboundpak(n) /= 0) then
3650  v = this%qleak(jj)
3651  end if
3652  case ('RATE')
3653  if (this%iboundpak(jj) /= 0) then
3654  v = this%ratesim(jj)
3655  if (v < dzero .and. this%qout(jj) < dzero) then
3656  qfact = v / this%qout(jj)
3657  if (this%imover == 1) then
3658  v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3659  end if
3660  end if
3661  end if
3662  case ('RATE-TO-MVR')
3663  if (this%iboundpak(jj) /= 0) then
3664  if (this%imover == 1) then
3665  v = this%ratesim(jj)
3666  qfact = dzero
3667  if (v < dzero .and. this%qout(jj) < dzero) then
3668  qfact = v / this%qout(jj)
3669  end if
3670  v = this%pakmvrobj%get_qtomvr(jj) * qfact
3671  if (v > dzero) then
3672  v = -v
3673  end if
3674  end if
3675  end if
3676  case ('FW-RATE')
3677  if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0) then
3678  hmaw = this%xnewpak(jj)
3679  cmaw = this%fwcondsim(jj)
3680  v = cmaw * (this%fwelev(jj) - hmaw)
3681  if (v < dzero .and. this%qout(jj) < dzero) then
3682  qfact = v / this%qout(jj)
3683  if (this%imover == 1) then
3684  v = v + this%pakmvrobj%get_qtomvr(jj) * qfact
3685  end if
3686  end if
3687  end if
3688  case ('FW-TO-MVR')
3689  if (this%iboundpak(jj) /= 0 .and. this%iflowingwells > 0) then
3690  if (this%imover == 1) then
3691  hmaw = this%xnewpak(jj)
3692  cmaw = this%fwcondsim(jj)
3693  v = cmaw * (this%fwelev(jj) - hmaw)
3694  qfact = dzero
3695  if (v < dzero .and. this%qout(jj) < dzero) then
3696  qfact = v / this%qout(jj)
3697  end if
3698  v = this%pakmvrobj%get_qtomvr(jj) * qfact
3699  if (v > dzero) then
3700  v = -v
3701  end if
3702  end if
3703  end if
3704  case ('STORAGE')
3705  if (this%iboundpak(jj) /= 0 .and. this%imawissopt /= 1) then
3706  v = this%qsto(jj)
3707  end if
3708  case ('CONSTANT')
3709  if (this%iboundpak(jj) /= 0) then
3710  v = this%qconst(jj)
3711  end if
3712  case ('CONDUCTANCE')
3713  n = this%imap(jj)
3714  if (this%iboundpak(n) /= 0) then
3715  nn = jj - this%iaconn(n) + 1
3716  jpos = this%get_jpos(n, nn)
3717  v = this%simcond(jpos)
3718  end if
3719  case ('FW-CONDUCTANCE')
3720  if (this%iboundpak(jj) /= 0) then
3721  v = this%fwcondsim(jj)
3722  end if
3723  case default
3724  errmsg = 'Unrecognized observation type: '//trim(obsrv%ObsTypeId)
3725  call store_error(errmsg)
3726  end select
3727  call this%obs%SaveOneSimval(obsrv, v)
3728  end do
3729  end do
3730  !
3731  ! -- write summary of error messages
3732  if (count_errors() > 0) then
3733  call store_error_unit(this%inunit)
3734  end if
3735  end if
3736  !
3737  ! -- Write the MAW reduced flows to csv file entries for this step
3738  if (this%ioutredflowcsv > 0) then
3739  call this%maw_redflow_csv_write()
3740  end if
Here is the call graph for this function:

◆ maw_calc_lcorr()

real(dp) function mawmodule::maw_calc_lcorr ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  i,
integer(i4b), intent(in)  jpos 
)

The saturated conductance of a non-vertical (slanted) connection is scaled by the ratio of the in-cell screen length to the vertical screen thickness. The factor is 1.0 for vertical connections (angle = 0 and no connection length specified). The in-cell screen length is either specified directly (CONNLEN > 0) or derived from the screen elevations and the tilt angle, accounting for the vertical band occupied by the finite-radius borehole.

Parameters
[in]iwell number
[in]jposconnection position

Definition at line 1334 of file gwf-maw.f90.

1335  use constantsmodule, only: dzero, done, dtwo, dpio180
1336  ! -- dummy
1337  class(MawType), intent(inout) :: this
1338  integer(I4B), intent(in) :: i !< well number
1339  integer(I4B), intent(in) :: jpos !< connection position
1340  ! -- return
1341  real(DP) :: lcorr
1342  ! -- local
1343  real(DP) :: dz
1344  real(DP) :: omega
1345  real(DP) :: lw
1346  !
1347  ! -- default to no correction (vertical connection)
1348  lcorr = done
1349  if (this%angle(jpos) == dzero .and. this%connlen(jpos) <= dzero) then
1350  return
1351  end if
1352  !
1353  ! -- vertical screen thickness
1354  dz = this%topscrn(jpos) - this%botscrn(jpos)
1355  if (dz <= dzero) then
1356  return
1357  end if
1358  !
1359  ! -- in-cell screen length: specified directly or derived from the screen
1360  ! elevations and the tilt angle
1361  if (this%connlen(jpos) > dzero) then
1362  lw = this%connlen(jpos)
1363  else
1364  omega = this%angle(jpos) * dpio180
1365  lw = (dz - dtwo * this%radius(i) * sin(omega)) / cos(omega)
1366  end if
1367  !
1368  lcorr = lw / dz
This module contains simulation constants.
Definition: Constants.f90:9
real(dp), parameter dpio180
real constant
Definition: Constants.f90:130
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
real(dp), parameter dtwo
real constant 2
Definition: Constants.f90:79
real(dp), parameter done
real constant 1
Definition: Constants.f90:76

◆ maw_calculate_conn_terms()

subroutine mawmodule::maw_calculate_conn_terms ( class(mawtype this,
integer(i4b), intent(in)  n,
integer(i4b), intent(in)  j,
integer(i4b), intent(inout)  icflow,
real(dp), intent(inout)  cmaw,
real(dp), intent(inout)  cterm,
real(dp), intent(inout)  term,
real(dp), intent(inout)  flow,
real(dp), intent(inout), optional  term2 
)
private

Definition at line 4220 of file gwf-maw.f90.

4222  ! -- dummy
4223  class(MawType) :: this
4224  integer(I4B), intent(in) :: n
4225  integer(I4B), intent(in) :: j
4226  integer(I4B), intent(inout) :: icflow
4227  real(DP), intent(inout) :: cmaw
4228  real(DP), intent(inout) :: cterm
4229  real(DP), intent(inout) :: term
4230  real(DP), intent(inout) :: flow
4231  real(DP), intent(inout), optional :: term2
4232  ! -- local
4233  logical(LGP) :: correct_flow
4234  integer(I4B) :: inewton
4235  integer(I4B) :: jpos
4236  integer(I4B) :: igwfnode
4237  real(DP) :: hmaw
4238  real(DP) :: hgwf
4239  real(DP) :: hups
4240  real(DP) :: hdowns
4241  real(DP) :: sat
4242  real(DP) :: tmaw
4243  real(DP) :: bmaw
4244  real(DP) :: en
4245  real(DP) :: hbar
4246  real(DP) :: drterm
4247  real(DP) :: dhbarterm
4248  real(DP) :: vscratio
4249  !
4250  ! -- initialize terms
4251  cterm = dzero
4252  vscratio = done
4253  icflow = 0
4254  if (present(term2)) then
4255  inewton = 1
4256  else
4257  inewton = 0
4258  end if
4259  !
4260  ! -- set common terms
4261  jpos = this%get_jpos(n, j)
4262  igwfnode = this%get_gwfnode(n, j)
4263  hgwf = this%xnew(igwfnode)
4264  hmaw = this%xnewpak(n)
4265  tmaw = this%topscrn(jpos)
4266  bmaw = this%botscrn(jpos)
4267  !
4268  ! -- if vsc active, select appropriate viscosity ratio
4269  if (this%ivsc == 1) then
4270  ! flow out of well (flow is negative)
4271  if (flow < 0) then
4272  vscratio = this%viscratios(1, n)
4273  else
4274  vscratio = this%viscratios(2, n)
4275  end if
4276  end if
4277  !
4278  ! -- calculate saturation
4279  call this%maw_calculate_saturation(n, j, igwfnode, sat)
4280  cmaw = this%satcond(jpos) * vscratio * sat
4281  !
4282  ! -- set upstream head, term, and term2 if returning newton terms
4283  if (inewton == 1) then
4284  term = dzero
4285  term2 = dzero
4286  hups = hmaw
4287  if (hgwf > hups) then
4288  hups = hgwf
4289  end if
4290  !
4291  ! -- slope of the saturation with head. In a confined (non-convertible)
4292  ! cell the saturation is always one and does not change with head, so
4293  ! this slope must be zero. Otherwise the matrix terms would not match
4294  ! the flow that is actually calculated for the well.
4295  if (this%icelltype(igwfnode) /= 0) then
4296  drterm = squadraticsaturationderivative(tmaw, bmaw, hups, this%satomega)
4297  else
4298  drterm = dzero
4299  end if
4300  else
4301  term = cmaw
4302  end if
4303  !
4304  ! -- calculate correction term if flow_correction option specified
4305  if (this%correct_flow) then
4306  !
4307  ! -- set bmaw, determine en, and set correct_flow flag
4308  en = max(bmaw, this%dis%bot(igwfnode))
4309  correct_flow = .false.
4310  if (hmaw < en) then
4311  correct_flow = .true.
4312  end if
4313  if (hgwf < en .and. this%icelltype(igwfnode) /= 0) then
4314  correct_flow = .true.
4315  end if
4316  !
4317  ! -- if flow should be corrected because hgwf or hmaw is below bottom
4318  ! then calculate correction term (cterm)
4319  if (correct_flow) then
4320  icflow = 1
4321  hdowns = min(hmaw, hgwf)
4322  hbar = squadratic0sp(hdowns, en, this%satomega)
4323  if (hgwf > hmaw) then
4324  cterm = cmaw * (hmaw - hbar)
4325  else
4326  cterm = cmaw * (hbar - hgwf)
4327  end if
4328  end if
4329  !
4330  ! -- if newton formulation then calculate newton terms
4331  if (inewton /= 0) then
4332  !
4333  ! -- maw is upstream
4334  if (hmaw > hgwf) then
4335  hbar = squadratic0sp(hgwf, en, this%satomega)
4336  term = drterm * this%satcond(jpos) * vscratio * (hbar - hmaw)
4337  dhbarterm = squadratic0spderivative(hgwf, en, this%satomega)
4338  term2 = cmaw * (dhbarterm - done)
4339  !
4340  ! -- gwf is upstream
4341  else
4342  hbar = squadratic0sp(hmaw, en, this%satomega)
4343  term = -drterm * this%satcond(jpos) * vscratio * (hgwf - hbar)
4344  dhbarterm = squadratic0spderivative(hmaw, en, this%satomega)
4345  term2 = cmaw * (done - dhbarterm)
4346  end if
4347  end if
4348  else
4349  !
4350  ! -- flow is not corrected, so calculate term for newton formulation
4351  if (inewton /= 0) then
4352  term = drterm * this%satcond(jpos) * vscratio * (hgwf - hmaw)
4353  end if
4354  end if
4355  !
4356  ! -- calculate flow relative to maw for fc and bd
4357  flow = dzero
4358  if (inewton == 0) then
4359  flow = term * (hgwf - hmaw) + cterm
4360  end if
4361  !
4362  ! -- add density part here
4363  if (this%idense /= 0 .and. inewton == 0) then
4364  call this%maw_calculate_density_exchange(jpos, hmaw, hgwf, cmaw, &
4365  bmaw, flow, term, cterm)
4366  end if
Here is the call graph for this function:

◆ maw_calculate_density_exchange()

subroutine mawmodule::maw_calculate_density_exchange ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  iconn,
real(dp), intent(in)  hmaw,
real(dp), intent(in)  hgwf,
real(dp), intent(in)  cond,
real(dp), intent(in)  bmaw,
real(dp), intent(inout)  flow,
real(dp), intent(inout)  hcofterm,
real(dp), intent(inout)  rhsterm 
)

Arguments are as follows: iconn : maw-gwf connection number hmaw : maw head hgwf : gwf head cond : conductance bmaw : bottom elevation of this connection flow : calculated flow, updated here with density terms, + into maw hcofterm : head coefficient term rhsterm : right-hand-side value, updated here with density terms

Member variable used here denseterms : shape (3, MAXBOUND), filled by buoyancy package col 1 is relative density of maw (densemaw / denseref) col 2 is relative density of gwf cell (densegwf / denseref) col 3 is elevation of gwf cell

Upon return, amat and rhs for maw row should be updated as: amat(idiag) = amat(idiag) - hcofterm rhs(n) = rhs(n) + rhsterm

Definition at line 5236 of file gwf-maw.f90.

5238  ! -- dummy
5239  class(MawType), intent(inout) :: this
5240  integer(I4B), intent(in) :: iconn
5241  real(DP), intent(in) :: hmaw
5242  real(DP), intent(in) :: hgwf
5243  real(DP), intent(in) :: cond
5244  real(DP), intent(in) :: bmaw
5245  real(DP), intent(inout) :: flow
5246  real(DP), intent(inout) :: hcofterm
5247  real(DP), intent(inout) :: rhsterm
5248  ! -- local
5249  real(DP) :: t
5250  real(DP) :: havg
5251  real(DP) :: rdensemaw
5252  real(DP) :: rdensegwf
5253  real(DP) :: rdenseavg
5254  real(DP) :: elevavg
5255  ! -- formats
5256  !
5257  ! -- assign relative density terms, return if zero which means not avail yet
5258  rdensemaw = this%denseterms(1, iconn)
5259  rdensegwf = this%denseterms(2, iconn)
5260  if (rdensegwf == dzero) return
5261  !
5262  ! -- update rhsterm with density contribution
5263  if (hmaw > bmaw .and. hgwf > bmaw) then
5264  !
5265  ! -- hmaw and hgwf both above bmaw
5266  rdenseavg = dhalf * (rdensemaw + rdensegwf)
5267  !
5268  ! -- update rhsterm with first density term
5269  t = cond * (rdenseavg - done) * (hgwf - hmaw)
5270  rhsterm = rhsterm + t
5271  flow = flow + t
5272  !
5273  ! -- update rhterm with second density term
5274  havg = dhalf * (hgwf + hmaw)
5275  elevavg = this%denseterms(3, iconn)
5276  t = cond * (havg - elevavg) * (rdensegwf - rdensemaw)
5277  rhsterm = rhsterm + t
5278  flow = flow + t
5279  else if (hmaw > bmaw) then
5280  !
5281  ! -- if only hmaw is above bmaw, then increase correction term by density
5282  t = (rdensemaw - done) * rhsterm
5283  rhsterm = rhsterm + t
5284  !
5285  else if (hgwf > bmaw) then
5286  !
5287  ! -- if only hgwf is above bmaw, then increase correction term by density
5288  t = (rdensegwf - done) * rhsterm
5289  rhsterm = rhsterm + t
5290  !
5291  else
5292  !
5293  ! -- Flow should be zero so do nothing
5294  end if

◆ maw_calculate_qpot()

subroutine mawmodule::maw_calculate_qpot ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  n,
real(dp), intent(inout)  qnet 
)
private

Definition at line 4536 of file gwf-maw.f90.

4537  use tdismodule, only: delt
4538  ! -- dummy
4539  class(MawType), intent(inout) :: this
4540  integer(I4B), intent(in) :: n
4541  real(DP), intent(inout) :: qnet
4542  ! -- local
4543  integer(I4B) :: j
4544  integer(I4B) :: jpos
4545  integer(I4B) :: igwfnode
4546  real(DP) :: bt
4547  real(DP) :: tp
4548  real(DP) :: scale
4549  real(DP) :: cfw
4550  real(DP) :: hdterm
4551  real(DP) :: sat
4552  real(DP) :: cmaw
4553  real(DP) :: hgwf
4554  real(DP) :: bmaw
4555  real(DP) :: h_temp
4556  real(DP) :: hv
4557  real(DP) :: vscratio
4558  ! -- format
4559  !
4560  ! -- initialize qnet and h_temp
4561  qnet = dzero
4562  vscratio = done
4563  h_temp = this%shutofflevel(n)
4564  !
4565  ! -- if vsc active, select appropriate viscosity ratio
4566  if (this%ivsc == 1) then
4567  ! flow out of well (flow is negative)
4568  if (qnet < 0) then
4569  vscratio = this%viscratios(1, n)
4570  else
4571  vscratio = this%viscratios(2, n)
4572  end if
4573  end if
4574  !
4575  ! -- calculate discharge to flowing wells
4576  if (this%iflowingwells > 0) then
4577  if (this%fwcond(n) > dzero) then
4578  bt = this%fwelev(n)
4579  tp = bt + this%fwrlen(n)
4580  scale = sqsaturation(tp, bt, h_temp)
4581  cfw = scale * this%fwcond(n) * this%viscratios(2, n)
4582  this%ifwdischarge(n) = 0
4583  if (cfw > dzero) then
4584  this%ifwdischarge(n) = 1
4585  this%xsto(n) = bt
4586  end if
4587  qnet = qnet + cfw * (bt - h_temp)
4588  end if
4589  end if
4590  !
4591  ! -- calculate maw storage changes
4592  if (this%imawiss /= 1) then
4593  if (this%ifwdischarge(n) /= 1) then
4594  hdterm = this%xoldsto(n) - h_temp
4595  else
4596  hdterm = this%xoldsto(n) - this%fwelev(n)
4597  end if
4598  qnet = qnet - (this%area(n) * hdterm / delt)
4599  end if
4600  !
4601  ! -- calculate inflow from aquifer
4602  do j = 1, this%ngwfnodes(n)
4603  jpos = this%get_jpos(n, j)
4604  igwfnode = this%get_gwfnode(n, j)
4605  call this%maw_calculate_saturation(n, j, igwfnode, sat)
4606  cmaw = this%satcond(jpos) * vscratio * sat
4607  hgwf = this%xnew(igwfnode)
4608  bmaw = this%botscrn(jpos)
4609  hv = h_temp
4610  if (hv < bmaw) then
4611  hv = bmaw
4612  end if
4613  if (hgwf < bmaw) then
4614  hgwf = bmaw
4615  end if
4616  qnet = qnet + cmaw * (hgwf - hv)
4617  end do
real(dp), pointer, public delt
length of the current time step
Definition: tdis.f90:32
Here is the call graph for this function:

◆ maw_calculate_satcond()

subroutine mawmodule::maw_calculate_satcond ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  i,
integer(i4b), intent(in)  j,
integer(i4b), intent(in)  node 
)

Definition at line 3976 of file gwf-maw.f90.

3977  ! -- dummy
3978  class(MawType), intent(inout) :: this
3979  integer(I4B), intent(in) :: i
3980  integer(I4B), intent(in) :: j
3981  integer(I4B), intent(in) :: node
3982  ! -- local
3983  integer(I4B) :: iTcontrastErr
3984  integer(I4B) :: jpos
3985  real(DP) :: c
3986  real(DP) :: k11
3987  real(DP) :: k22
3988  real(DP) :: sqrtk11k22
3989  real(DP) :: hks
3990  real(DP) :: area
3991  real(DP) :: eradius
3992  real(DP) :: topw
3993  real(DP) :: botw
3994  real(DP) :: tthkw
3995  real(DP) :: tthka
3996  real(DP) :: Tcontrast
3997  real(DP) :: skin
3998  real(DP) :: ravg
3999  real(DP) :: slen
4000  real(DP) :: pavg
4001  real(DP) :: gwfsat
4002  real(DP) :: gwftop
4003  real(DP) :: gwfbot
4004  real(DP) :: lc1
4005  real(DP) :: lc2
4006  real(DP) :: dx
4007  real(DP) :: dy
4008  real(DP) :: Txx
4009  real(DP) :: Tyy
4010  real(DP) :: T2pi
4011  real(DP) :: yx4
4012  real(DP) :: xy4
4013  ! -- formats
4014  !
4015  ! -- initialize conductance variables
4016  itcontrasterr = 0
4017  lc1 = dzero
4018  lc2 = dzero
4019  !
4020  ! -- calculate connection position
4021  jpos = this%get_jpos(i, j)
4022  !
4023  ! -- set K11 and K22
4024  k11 = this%gwfk11(node)
4025  if (this%gwfik22 == 0) then
4026  k22 = this%gwfk11(node)
4027  else
4028  k22 = this%gwfk22(node)
4029  end if
4030  sqrtk11k22 = sqrt(k11 * k22)
4031  !
4032  ! -- set gwftop, gwfbot, and gwfsat
4033  gwftop = this%dis%top(node)
4034  gwfbot = this%dis%bot(node)
4035  tthka = gwftop - gwfbot
4036  gwfsat = this%gwfsat(node)
4037  !
4038  ! -- set top and bottom of well screen
4039  c = dzero
4040  topw = this%topscrn(jpos)
4041  botw = this%botscrn(jpos)
4042  tthkw = topw - botw
4043  !
4044  ! -- scale screen thickness using gwfsat (for NPF Package THICKSTRT)
4045  if (gwftop == topw .and. gwfbot == botw) then
4046  if (this%icelltype(node) == 0) then
4047  tthkw = tthkw * gwfsat
4048  tthka = tthka * gwfsat
4049  end if
4050  end if
4051  !
4052  ! -- calculate the aquifer transmissivity (T2pi)
4053  t2pi = dtwopi * tthka * sqrtk11k22
4054  !
4055  ! -- calculate effective radius
4056  if (this%dis%ndim == 3 .and. this%ieffradopt /= 0) then
4057  txx = k11 * tthka
4058  tyy = k22 * tthka
4059  dx = sqrt(this%dis%area(node))
4060  dy = dx
4061  yx4 = (tyy / txx)**dquarter
4062  xy4 = (txx / tyy)**dquarter
4063  eradius = 0.28_dp * ((yx4 * dx)**dtwo + &
4064  (xy4 * dy)**dtwo)**dhalf / (yx4 + xy4)
4065  else
4066  area = this%dis%area(node)
4067  eradius = sqrt(area / (deight * dpi))
4068  end if
4069  !
4070  ! -- conductance calculations
4071  ! -- Thiem equation (1) and cumulative Thiem and skin equations (3)
4072  if (this%ieqn(i) == 1 .or. this%ieqn(i) == 3) then
4073  lc1 = log(eradius / this%radius(i)) / t2pi
4074  end if
4075  !
4076  ! -- skin equation (2) and cumulative Thiem and skin equations (3)
4077  if (this%ieqn(i) == 2 .or. this%ieqn(i) == 3) then
4078  hks = this%hk(jpos)
4079  if (tthkw * hks > dzero) then
4080  tcontrast = (sqrtk11k22 * tthka) / (hks * tthkw)
4081  skin = (tcontrast - done) * log(this%sradius(jpos) / this%radius(i))
4082  !
4083  ! -- trap invalid transmissvity contrast if using skin equation (2).
4084  ! Not trapped for cumulative Thiem and skin equations (3)
4085  ! because the MNW2 package allowed this condition (for
4086  ! backward compatibility with the MNW2 package for
4087  ! MODFLOW-2005, MODFLOW-NWT, and MODFLOW-USG).
4088  if (tcontrast <= 1 .and. this%ieqn(i) == 2) then
4089  itcontrasterr = 1
4090  write (errmsg, '(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
4091  'Invalid calculated transmissivity contrast (', tcontrast, &
4092  ') for maw well', i, 'connection', j, '.', 'This happens when the', &
4093  'skin transmissivity equals or exceeds the aquifer transmissivity.', &
4094  'Consider decreasing HK_SKIN for the connection or using the', &
4095  'CUMULATIVE or MEAN conductance equations.'
4096  call store_error(errmsg)
4097  else
4098  lc2 = skin / t2pi
4099  end if
4100  end if
4101  end if
4102  ! -- conductance using screen elevations, hk, well radius,
4103  ! and screen radius
4104  if (this%ieqn(i) == 4) then
4105  hks = this%hk(jpos)
4106  ravg = dhalf * (this%radius(i) + this%sradius(jpos))
4107  slen = this%sradius(jpos) - this%radius(i)
4108  pavg = dtwopi * ravg
4109  c = hks * pavg * tthkw / slen
4110  end if
4111  !
4112  ! -- calculate final conductance for Thiem (1), Skin (2), and
4113  ! and cumulative Thiem and skin equations (3)
4114  if (this%ieqn(i) < 4) then
4115  if (lc1 + lc2 /= dzero) then
4116  c = done / (lc1 + lc2)
4117  else
4118  c = -dnodata
4119  end if
4120  end if
4121  !
4122  ! -- ensure that the conductance is not negative. Only write error message
4123  ! if error condition has not occurred for skin calculations (LC2)
4124  if (c < dzero .and. itcontrasterr == 0) then
4125  write (errmsg, '(a,g0,a,1x,i0,1x,a,1x,i0,a,4(1x,a))') &
4126  'Invalid calculated negative conductance (', c, &
4127  ') for maw well', i, 'connection', j, '.', 'this happens when the', &
4128  'skin transmissivity equals or exceeds the aquifer transmissivity.', &
4129  'consider decreasing hk_skin for the connection or using the', &
4130  'mean conductance equation.'
4131  call store_error(errmsg)
4132  end if
4133  !
4134  ! -- scale the saturated conductance by the length correction factor for
4135  ! non-vertical (slanted) connections. The factor is 1.0 for vertical
4136  ! connections, so this has no effect unless an ANGLEDATA block was read.
4137  if (this%inonvert /= 0) then
4138  c = c * this%maw_calc_lcorr(i, jpos)
4139  end if
4140  !
4141  ! -- set saturated conductance
4142  this%satcond(jpos) = c
Here is the call graph for this function:

◆ maw_calculate_saturation()

subroutine mawmodule::maw_calculate_saturation ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  n,
integer(i4b), intent(in)  j,
integer(i4b), intent(in)  node,
real(dp), intent(inout)  sat,
real(dp), intent(in), optional  hwell_in 
)
private

Definition at line 4147 of file gwf-maw.f90.

4148  ! -- dummy
4149  class(MawType), intent(inout) :: this
4150  integer(I4B), intent(in) :: n
4151  integer(I4B), intent(in) :: j
4152  integer(I4B), intent(in) :: node
4153  real(DP), intent(inout) :: sat
4154  real(DP), intent(in), optional :: hwell_in !well head to use instead of the current well head
4155  ! -- local
4156  integer(I4B) :: jpos
4157  real(DP) :: h_temp
4158  real(DP) :: hwell
4159  real(DP) :: topw
4160  real(DP) :: botw
4161  ! -- formats
4162  !
4163  ! -- initialize saturation
4164  sat = dzero
4165  !
4166  ! -- calculate current saturation for convertible cells
4167  if (this%icelltype(node) /= 0) then
4168  !
4169  ! -- set hwell (use the caller-supplied head if provided)
4170  hwell = this%xnewpak(n)
4171  if (present(hwell_in)) then
4172  hwell = hwell_in
4173  end if
4174  !
4175  ! -- set connection position
4176  jpos = this%get_jpos(n, j)
4177  !
4178  ! -- set top and bottom of the well connection
4179  topw = this%topscrn(jpos)
4180  botw = this%botscrn(jpos)
4181  !
4182  ! -- calculate appropriate saturation
4183  if (this%inewton /= 1) then
4184  h_temp = this%xnew(node)
4185  if (h_temp < botw) then
4186  h_temp = botw
4187  end if
4188  if (hwell < botw) then
4189  hwell = botw
4190  end if
4191  h_temp = dhalf * (h_temp + hwell)
4192  else
4193  h_temp = this%xnew(node)
4194  if (hwell > h_temp) then
4195  h_temp = hwell
4196  end if
4197  if (h_temp < botw) then
4198  h_temp = botw
4199  end if
4200  end if
4201  ! -- calculate saturation
4202  sat = squadraticsaturation(topw, botw, h_temp, this%satomega)
4203  else
4204  sat = done
4205  end if
Here is the call graph for this function:

◆ maw_calculate_wellq()

subroutine mawmodule::maw_calculate_wellq ( class(mawtype this,
integer(i4b), intent(in)  n,
real(dp), intent(in)  hmaw,
real(dp), intent(inout)  q 
)
private

Definition at line 4371 of file gwf-maw.f90.

4372  ! -- dummy
4373  class(MawType) :: this
4374  integer(I4B), intent(in) :: n
4375  real(DP), intent(in) :: hmaw
4376  real(DP), intent(inout) :: q
4377  ! -- local
4378  real(DP) :: scale
4379  real(DP) :: tp
4380  real(DP) :: bt
4381  real(DP) :: rate
4382  real(DP) :: weight
4383  real(DP) :: dq
4384  !
4385  ! -- Initialize q
4386  q = dzero
4387  !
4388  ! -- Assign rate as the user-provided base pumping rate
4389  rate = this%rate(n)
4390  !
4391  ! -- Assign q differently depending on whether this is an extraction well
4392  ! (rate < 0) or an injection well (rate > 0).
4393  if (rate < dzero) then
4394  !
4395  ! -- If well shut off is activated, then turn off well if necessary,
4396  ! or if shut off is not activated then check to see if rate scaling
4397  ! is on.
4398  if (this%shutofflevel(n) /= dep20) then
4399  call this%maw_calculate_qpot(n, q)
4400  if (q < dzero) q = dzero
4401  if (q > -rate) q = -rate
4402 
4403  if (this%ishutoffcnt == 1) then
4404  this%shutoffweight(n) = done
4405  this%shutoffdq(n) = dzero
4406  this%shutoffqold(n) = q
4407  end if
4408 
4409  dq = q - this%shutoffqold(n)
4410  weight = this%shutoffweight(n)
4411  !
4412  ! -- for oscillating condition, decrease factor
4413  if (this%shutoffdq(n) * dq < dzero) then
4414  weight = this%theta * this%shutoffweight(n)
4415  !
4416  ! -- when change is of same sign, increase factor
4417  else
4418  weight = this%shutoffweight(n) + this%kappa
4419  end if
4420  if (weight > done) weight = done
4421 
4422  q = this%shutoffqold(n) + weight * dq
4423 
4424  this%shutoffqold(n) = q
4425  this%shutoffdq(n) = dq
4426  this%shutoffweight(n) = weight
4427  !
4428  ! -- If shutoffmin and shutoffmax are specified then apply
4429  ! additional checks for when to shut off the well.
4430  if (this%shutoffmin(n) > dzero) then
4431  if (hmaw < this%shutofflevel(n)) then
4432  !
4433  ! -- calculate adjusted well rate subject to constraints
4434  ! -- well is shutoff
4435  if (this%ishutoff(n) /= 0) then
4436  q = dzero
4437  !
4438  ! --- well is not shut off
4439  else
4440  ! -- turn off well if q is less than the minimum rate and
4441  ! reset the ishutoff flag if at least on iteration 3
4442  if (q < this%shutoffmin(n)) then
4443  if (this%ishutoffcnt > 2) then
4444  this%ishutoff(n) = 1
4445  end if
4446  q = dzero
4447  !
4448  ! -- leave well on and use the specified rate
4449  ! or the potential rate
4450  end if
4451  end if
4452  !
4453  ! -- try to use the specified rate or the potential rate
4454  else
4455  if (q > this%shutoffmax(n)) then
4456  if (this%ishutoffcnt <= 2) then
4457  this%ishutoff(n) = 0
4458  end if
4459  end if
4460  if (this%ishutoff(n) /= 0) then
4461  q = dzero
4462  end if
4463  end if
4464  end if
4465 
4466  if (q /= dzero) q = -q
4467 
4468  else
4469  scale = done
4470  !
4471  ! -- Apply rate scaling by reducing pumpage when hmaw is less than the
4472  ! sum of maw pump elevation (pumpelev) and the specified reduction
4473  ! length. The rate will go to zero as hmaw drops to the pump
4474  ! elevation.
4475  if (this%reduction_length(n) /= dep20) then
4476  bt = this%pumpelev(n)
4477  tp = bt + this%reduction_length(n)
4478  scale = sqsaturation(tp, bt, hmaw)
4479  end if
4480  q = scale * rate
4481  end if
4482  !
4483  else
4484  !
4485  ! -- Handle the injection case (rate > 0) differently than extraction.
4486  q = rate
4487  if (this%shutofflevel(n) /= dep20) then
4488  call this%maw_calculate_qpot(n, q)
4489  q = -q
4490  if (q < dzero) q = dzero
4491  if (q > rate) q = rate
4492 
4493  if (this%ishutoffcnt == 1) then
4494  this%shutoffweight(n) = done
4495  this%shutoffdq(n) = dzero
4496  this%shutoffqold(n) = q
4497  end if
4498 
4499  dq = q - this%shutoffqold(n)
4500  weight = this%shutoffweight(n)
4501  !
4502  ! -- for oscillating condition, decrease factor
4503  if (this%shutoffdq(n) * dq < dzero) then
4504  weight = this%theta * this%shutoffweight(n)
4505  !
4506  ! -- when change is of same sign, increase factor
4507  else
4508  weight = this%shutoffweight(n) + this%kappa
4509  end if
4510  if (weight > done) weight = done
4511 
4512  q = this%shutoffqold(n) + weight * dq
4513 
4514  this%shutoffqold(n) = q
4515  this%shutoffdq(n) = dq
4516  this%shutoffweight(n) = weight
4517 
4518  else
4519  scale = done
4520  !
4521  ! -- Apply rate scaling for an injection well by reducing the
4522  ! injection rate as hmaw rises above the pump elevation. The rate
4523  ! will approach zero as hmaw approaches pumpelev + reduction_length.
4524  if (this%reduction_length(n) /= dep20) then
4525  bt = this%pumpelev(n)
4526  tp = bt + this%reduction_length(n)
4527  scale = done - sqsaturation(tp, bt, hmaw)
4528  end if
4529  q = scale * rate
4530  end if
4531  end if
Here is the call graph for this function:

◆ maw_cc()

subroutine mawmodule::maw_cc ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  innertot,
integer(i4b), intent(in)  kiter,
integer(i4b), intent(in)  iend,
integer(i4b), intent(in)  icnvgmod,
character(len=lenpakloc), intent(inout)  cpak,
integer(i4b), intent(inout)  ipak,
real(dp), intent(inout)  dpak 
)
private

This does two things:

  1. While a well is being damped by Newton under-relaxation, it keeps the model from converging until the well rate has also stopped changing (reported through dpak). Wells that are not being damped, and models that do not use Newton under-relaxation, are not affected.
  2. When the model fails to converge, it warns about any pumping well that is asking for more water than the aquifer can supply, a likely reason for the failure.

Definition at line 2981 of file gwf-maw.f90.

2982  ! -- modules
2983  use tdismodule, only: delt
2984  ! -- dummy
2985  class(MawType), intent(inout) :: this
2986  integer(I4B), intent(in) :: innertot
2987  integer(I4B), intent(in) :: kiter
2988  integer(I4B), intent(in) :: iend
2989  integer(I4B), intent(in) :: icnvgmod
2990  character(len=LENPAKLOC), intent(inout) :: cpak
2991  integer(I4B), intent(inout) :: ipak
2992  real(DP), intent(inout) :: dpak
2993  ! -- local
2994  integer(I4B) :: n
2995  integer(I4B) :: j
2996  integer(I4B) :: jpos
2997  integer(I4B) :: igwfnode
2998  integer(I4B) :: locdpak
2999  real(DP) :: botw
3000  real(DP) :: bmaw
3001  real(DP) :: hgwf
3002  real(DP) :: hv
3003  real(DP) :: sat
3004  real(DP) :: cmaw
3005  real(DP) :: qmax
3006  real(DP) :: qreq
3007  real(DP) :: qtolfact
3008  real(DP) :: dq
3009  real(DP) :: dpakmax
3010  character(len=LENPAKLOC) :: cloc
3011  ! -- parameters
3012  real(DP), parameter :: qtol = 1.001_dp !the request must exceed supply by this factor to warn
3013  ! -- formats
3014  character(len=*), parameter :: fmtwarn = &
3015  "('MAW well ', a, ' requests an extraction rate (', g0.5, &
3016  &') larger than the maximum rate (', g0.5, ') the aquifer can supply &
3017  &with the well head at its bottom. This may be preventing convergence. &
3018  &Consider reducing the requested rate, applying or widening RATE_SCALING, &
3019  &or reviewing the connection conductance (e.g. aquifer K).')"
3020  !
3021  ! -- rate convergence check. While a well is being damped (nurweight < 1)
3022  ! its head barely moves, so also require the well rate to stop changing
3023  ! before the model is allowed to converge. The rate change is turned
3024  ! into an equivalent head change (using the well area and time step) so
3025  ! it can be compared with the solver tolerance, and is passed back in
3026  ! dpak. Wells that are not being damped are left unchanged.
3027  dpakmax = dzero
3028  locdpak = 0
3029  do n = 1, this%nmawwells
3030  if (this%iboundpak(n) < 1) cycle
3031  if (this%nurweight(n) >= done) cycle
3032  if (this%area(n) > dzero) then
3033  qtolfact = delt / this%area(n)
3034  else
3035  qtolfact = dzero
3036  end if
3037  ! -- qsim0 and ratesim both come from maw_fc (before the solve), so dq is
3038  ! the rate change from the previous outer iteration -- one step behind
3039  ! the newest heads. That is fine here: a lagged rate can only delay
3040  ! convergence, never accept a bad answer, because the solver already
3041  ! checks the heads and steady heads mean a steady rate. The up-to-date
3042  ! rate is not used because recomputing it would change the well's
3043  ! shutoff and RATE_SCALING state.
3044  dq = (this%qsim0(n) - this%ratesim(n)) * qtolfact
3045  if (abs(dq) > abs(dpakmax)) then
3046  dpakmax = dq
3047  locdpak = n
3048  end if
3049  end do
3050  if (locdpak > 0 .and. abs(dpakmax) > abs(dpak)) then
3051  ipak = locdpak
3052  dpak = dpakmax
3053  write (cloc, "(a,'-',a)") trim(this%packName), 'rate'
3054  cpak = trim(cloc)
3055  end if
3056  !
3057  ! -- the over-demand warning is only written on the last outer iteration of
3058  ! a model that did not converge
3059  if (iend == 0) return
3060  if (icnvgmod /= 0) return
3061  !
3062  ! -- look at each active pumping (extraction) well
3063  do n = 1, this%nmawwells
3064  if (this%iboundpak(n) < 1) cycle
3065  if (this%rate(n) >= dzero) cycle
3066  botw = this%bot(n)
3067  !
3068  ! -- largest rate the aquifer could supply if the well head dropped all
3069  ! the way to the bottom of the well
3070  qmax = dzero
3071  do j = 1, this%ngwfnodes(n)
3072  jpos = this%get_jpos(n, j)
3073  igwfnode = this%get_gwfnode(n, j)
3074  hgwf = this%xnew(igwfnode)
3075  bmaw = this%botscrn(jpos)
3076  hv = max(botw, bmaw)
3077  !
3078  ! -- connection saturation evaluated with the well head at the bottom of
3079  ! the well (hv), consistent with this maximum-supply estimate, rather
3080  ! than at the current well head
3081  call this%maw_calculate_saturation(n, j, igwfnode, sat, hv)
3082  cmaw = this%satcond(jpos) * sat
3083  !
3084  ! -- only count connections that can supply water. A connection whose
3085  ! aquifer head is below the well bottom would take water in, so skip
3086  ! it instead of letting it lower the maximum supply.
3087  qmax = qmax + cmaw * max(hgwf - hv, dzero)
3088  end do
3089  !
3090  ! -- warn if the well is asking for more than the aquifer can supply
3091  qreq = -this%rate(n)
3092  if (qmax >= dzero .and. qreq > qtol * qmax) then
3093  write (cloc, '(a, a, a, a, i0, a, i0, a)') trim(this%name_model), '-(', &
3094  trim(this%filtyp), '_', this%ibcnum, '-', n, ')'
3095  write (warnmsg, fmtwarn) trim(cloc), qreq, qmax
3096  call store_warning(warnmsg)
3097  end if
3098  end do
Here is the call graph for this function:

◆ maw_cf()

subroutine mawmodule::maw_cf ( class(mawtype this)

Skip if no multi-aquifer wells, otherwise, calculate hcof and rhs

Definition at line 2513 of file gwf-maw.f90.

2514  ! -- dummy
2515  class(MawType) :: this
2516  ! -- local
2517  !
2518  ! -- Calculate maw conductance and update package RHS and HCOF
2519  call this%maw_cfupdate()

◆ maw_cfupdate()

subroutine mawmodule::maw_cfupdate ( class(mawtype this)

Definition at line 4622 of file gwf-maw.f90.

4623  class(MawType) :: this
4624  ! -- dummy
4625  ! -- local
4626  integer(I4B) :: j
4627  integer(I4B) :: n
4628  integer(I4B) :: jpos
4629  integer(I4B) :: icflow
4630  integer(I4B) :: ibnd
4631  real(DP) :: flow
4632  real(DP) :: cmaw
4633  real(DP) :: hmaw
4634  real(DP) :: cterm
4635  real(DP) :: term
4636  !
4637  ! -- Return if no maw wells
4638  if (this%nbound .eq. 0) return
4639  !
4640  ! -- Update shutoff count
4641  this%ishutoffcnt = this%ishutoffcnt + 1
4642  !
4643  ! -- Calculate hcof and rhs for each maw entry
4644  ibnd = 1
4645  do n = 1, this%nmawwells
4646  hmaw = this%xnewpak(n)
4647  do j = 1, this%ngwfnodes(n)
4648  jpos = this%get_jpos(n, j)
4649  this%hcof(ibnd) = dzero
4650  this%rhs(ibnd) = dzero
4651  !
4652  ! -- set bound, hcof, and rhs components
4653  !
4654  ! -- use connection method so the gwf-maw budget flows
4655  ! are consistent with the maw-gwf budget flows
4656  if (this%iboundpak(n) == 0) then
4657  cmaw = dzero
4658  term = dzero
4659  cterm = dzero
4660  else
4661  call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, &
4662  term, flow)
4663  end if
4664  this%simcond(jpos) = cmaw
4665  this%bound(2, ibnd) = cmaw
4666  this%hcof(ibnd) = -term
4667  this%rhs(ibnd) = -term * hmaw + cterm
4668  !
4669  ! -- increment boundary number
4670  ibnd = ibnd + 1
4671  end do
4672  end do

◆ maw_check_attributes()

subroutine mawmodule::maw_check_attributes ( class(mawtype), intent(inout)  this)

Definition at line 1840 of file gwf-maw.f90.

1841  use simmodule, only: store_error
1842  ! -- dummy
1843  class(MawType), intent(inout) :: this
1844  ! -- local
1845  character(len=LINELENGTH) :: cgwfnode
1846  integer(I4B) :: idx
1847  integer(I4B) :: n
1848  integer(I4B) :: j
1849  integer(I4B) :: jpos
1850  ! -- formats
1851  !
1852  idx = 1
1853  do n = 1, this%nmawwells
1854  if (this%ngwfnodes(n) < 1) then
1855  call this%maw_set_attribute_error(n, 'NGWFNODES', 'must be greater '// &
1856  'than 0.')
1857  end if
1858  if (this%radius(n) == dep20) then
1859  call this%maw_set_attribute_error(n, 'RADIUS', 'has not been specified.')
1860  end if
1861  if (this%shutoffmin(n) > dzero) then
1862  if (this%shutoffmin(n) >= this%shutoffmax(n)) then
1863  call this%maw_set_attribute_error(n, 'SHUT_OFF', 'shutoffmax must '// &
1864  'be greater than shutoffmin.')
1865  end if
1866  end if
1867  do j = 1, this%ngwfnodes(n)
1868  !
1869  ! -- calculate jpos
1870  jpos = this%get_jpos(n, j)
1871  !
1872  ! -- write gwfnode number
1873  write (cgwfnode, '(a,i0,a)') 'gwfnode(', j, ')'
1874  !
1875  ! -- connection screen data
1876  if (this%botscrn(jpos) >= this%topscrn(jpos)) then
1877  call this%maw_set_attribute_error(n, 'SCREEN_TOP', 'screen bottom '// &
1878  'must be less than screen top. '// &
1879  trim(cgwfnode))
1880  end if
1881  !
1882  ! -- connection skin hydraulic conductivity
1883  if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
1884  this%ieqn(n) == 4) then
1885  if (this%hk(jpos) <= dzero) then
1886  call this%maw_set_attribute_error(n, 'HK_SKIN', 'skin hyraulic '// &
1887  'conductivity must be greater '// &
1888  'than zero. '//trim(cgwfnode))
1889  end if
1890  else if (this%ieqn(n) == 0) then
1891  !
1892  ! -- saturated conductance
1893  if (this%satcond(jpos) < dzero) then
1894  call this%maw_set_attribute_error(n, 'HK_SKIN', &
1895  'skin hyraulic conductivity '// &
1896  'must be greater than or '// &
1897  'equal to zero when using '// &
1898  'SPECIFIED condeqn. '// &
1899  trim(cgwfnode))
1900  end if
1901  end if
1902  idx = idx + 1
1903  end do
1904  end do
1905  ! -- reset check_attr
1906  this%check_attr = 0
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
Here is the call graph for this function:

◆ maw_cq()

subroutine mawmodule::maw_cq ( class(mawtype), intent(inout)  this,
real(dp), dimension(:), intent(in)  x,
real(dp), dimension(:), intent(inout), contiguous  flowja,
integer(i4b), intent(in), optional  iadv 
)

Definition at line 3103 of file gwf-maw.f90.

3104  ! -- modules
3105  use tdismodule, only: delt
3106  use constantsmodule, only: lenboundname
3107  use budgetmodule, only: budgettype
3108  ! -- dummy
3109  class(MawType), intent(inout) :: this
3110  real(DP), dimension(:), intent(in) :: x
3111  real(DP), dimension(:), contiguous, intent(inout) :: flowja
3112  integer(I4B), optional, intent(in) :: iadv
3113  ! -- local
3114  real(DP) :: rrate
3115  real(DP) :: ss
3116  real(DP) :: ssold
3117  ! -- for budget
3118  integer(I4B) :: j
3119  integer(I4B) :: n
3120  integer(I4B) :: ibnd
3121  real(DP) :: hmaw
3122  real(DP) :: cfw
3123  ! -- for observations
3124  ! -- formats
3125  !
3126  ! -- recalculate package HCOF and RHS terms with latest groundwater and
3127  ! maw heads prior to calling base budget functionality
3128  call this%maw_cfupdate()
3129  !
3130  ! -- call base functionality in bnd_cq. This will calculate maw-gwf flows
3131  ! and put them into this%simvals
3132  call this%BndType%bnd_cq(x, flowja, iadv=1)
3133  !
3134  ! -- calculate maw budget flow and storage terms
3135  do n = 1, this%nmawwells
3136  this%qout(n) = dzero
3137  this%qsto(n) = dzero
3138  if (this%iflowingwells > 0) then
3139  this%qfw(n) = dzero
3140  end if
3141  if (this%iboundpak(n) == 0) then
3142  cycle
3143  end if
3144  !
3145  ! -- set hmaw and xsto
3146  hmaw = this%xnewpak(n)
3147  this%xsto(n) = hmaw
3148  !
3149  ! -- add pumping rate to active maw well
3150  rrate = this%ratesim(n)
3151  !
3152  ! -- If flow is out of maw set qout to rrate.
3153  if (rrate < dzero) then
3154  this%qout(n) = rrate
3155  end if
3156  !
3157  ! -- add flowing well
3158  if (this%iflowingwells > 0) then
3159  if (this%fwcond(n) > dzero) then
3160  cfw = this%fwcondsim(n)
3161  ! -- only raise the storage level to the flowing-well elevation when
3162  ! the well is actually discharging (ifwdischarge == 1), matching
3163  ! the storage term assembled in maw_fc
3164  if (this%ifwdischarge(n) == 1) then
3165  this%xsto(n) = this%fwelev(n)
3166  end if
3167  rrate = cfw * (this%fwelev(n) - hmaw)
3168  this%qfw(n) = rrate
3169  !
3170  ! -- Subtract flowing well rrate from qout.
3171  this%qout(n) = this%qout(n) + rrate
3172  end if
3173  end if
3174  !
3175  ! -- Calculate qsto so it matches the storage term built in maw_fc. A
3176  ! flowing well that is actively discharging (ifwdischarge == 1) uses
3177  ! the flowing-well elevation (xsto = fwelev). Otherwise the storage
3178  ! water level is not allowed to drop below the bottom of the well.
3179  ! Testing ifwdischarge (not fwcond) keeps the budget in step with the
3180  ! matrix when a flowing well is at or below its discharge elevation.
3181  if (this%imawiss /= 1) then
3182  if (this%iflowingwells > 0 .and. this%ifwdischarge(n) == 1) then
3183  rrate = -this%area(n) * (this%xsto(n) - this%xoldsto(n)) / delt
3184  else
3185  ss = squadratic0sp(hmaw, this%bot(n), this%satomega)
3186  ssold = squadratic0sp(this%xoldsto(n), this%bot(n), this%satomega)
3187  rrate = -this%area(n) * (ss - ssold) / delt
3188  end if
3189  this%qsto(n) = rrate
3190  end if
3191  end do
3192  !
3193  ! -- gwf and constant flow
3194  ibnd = 1
3195  do n = 1, this%nmawwells
3196  hmaw = this%xnewpak(n)
3197  this%qconst(n) = dzero
3198  do j = 1, this%ngwfnodes(n)
3199  rrate = -this%simvals(ibnd)
3200  this%qleak(ibnd) = rrate
3201  if (this%iboundpak(n) < 0) then
3202  this%qconst(n) = this%qconst(n) - rrate
3203  !
3204  ! -- If flow is out increment qout by -rrate.
3205  if (-rrate < dzero) then
3206  this%qout(n) = this%qout(n) - rrate
3207  end if
3208  end if
3209  !
3210  ! -- increment ibnd counter
3211  ibnd = ibnd + 1
3212  end do
3213  !
3214  ! -- add additional flow terms to constant head term
3215  if (this%iboundpak(n) < 0) then
3216  !
3217  ! -- add well pumping rate
3218  this%qconst(n) = this%qconst(n) - this%ratesim(n)
3219  !
3220  ! -- add flowing well rate
3221  if (this%iflowingwells > 0) then
3222  this%qconst(n) = this%qconst(n) - this%qfw(n)
3223  end if
3224  !
3225  ! -- add storage term
3226  if (this%imawiss /= 1) then
3227  this%qconst(n) = this%qconst(n) - this%qsto(n)
3228  end if
3229  end if
3230  end do
3231  !
3232  ! -- fill the budget object
3233  call this%maw_fill_budobj()
This module contains the BudgetModule.
Definition: Budget.f90:20
integer(i4b), parameter lenboundname
maximum length of a bound name
Definition: Constants.f90:36
Derived type for the Budget object.
Definition: Budget.f90:39
Here is the call graph for this function:

◆ maw_create()

subroutine, public mawmodule::maw_create ( class(bndtype), pointer  packobj,
integer(i4b), intent(in)  id,
integer(i4b), intent(in)  ibcnum,
integer(i4b), intent(in)  inunit,
integer(i4b), intent(in)  iout,
character(len=*), intent(in)  namemodel,
character(len=*), intent(in)  pakname 
)

After creating the package object point bndobj to the new package

Definition at line 246 of file gwf-maw.f90.

247  ! -- dummy
248  class(BndType), pointer :: packobj
249  integer(I4B), intent(in) :: id
250  integer(I4B), intent(in) :: ibcnum
251  integer(I4B), intent(in) :: inunit
252  integer(I4B), intent(in) :: iout
253  character(len=*), intent(in) :: namemodel
254  character(len=*), intent(in) :: pakname
255  type(MawType), pointer :: mawobj
256  !
257  ! -- allocate the object and assign values to object variables
258  allocate (mawobj)
259  packobj => mawobj
260  !
261  ! -- create name and memory path
262  call packobj%set_names(ibcnum, namemodel, pakname, ftype)
263  packobj%text = text
264  !
265  ! -- allocate scalars
266  call mawobj%maw_allocate_scalars()
267  !
268  ! -- initialize package
269  call packobj%pack_initialize()
270  !
271  packobj%inunit = inunit
272  packobj%iout = iout
273  packobj%id = id
274  packobj%ibcnum = ibcnum
275  packobj%ncolbnd = 4
276  packobj%iscloc = 0 ! not supported
277  packobj%isadvpak = 1
278  packobj%ictMemPath = create_mem_path(namemodel, 'NPF')
Here is the call graph for this function:
Here is the caller graph for this function:

◆ maw_da()

subroutine mawmodule::maw_da ( class(mawtype this)

Definition at line 3348 of file gwf-maw.f90.

3349  ! -- modules
3351  ! -- dummy
3352  class(MawType) :: this
3353  ! -- local
3354  !
3355  ! -- budobj
3356  call this%budobj%budgetobject_da()
3357  deallocate (this%budobj)
3358  nullify (this%budobj)
3359  !
3360  ! -- head table
3361  if (this%iprhed > 0) then
3362  call this%headtab%table_da()
3363  deallocate (this%headtab)
3364  nullify (this%headtab)
3365  end if
3366  !
3367  ! -- character arrays
3368  call mem_deallocate(this%cmawbudget, 'CMAWBUDGET', this%memoryPath)
3369  call mem_deallocate(this%cmawname, 'CMAWNAME', this%memoryPath)
3370  call mem_deallocate(this%status, 'STATUS', this%memoryPath)
3371  !
3372  ! -- deallocate well data pointers in memory manager
3373  call mem_deallocate(this%ngwfnodes)
3374  call mem_deallocate(this%ieqn)
3375  call mem_deallocate(this%ishutoff)
3376  call mem_deallocate(this%ifwdischarge)
3377  call mem_deallocate(this%strt)
3378  call mem_deallocate(this%radius)
3379  call mem_deallocate(this%area)
3380  call mem_deallocate(this%pumpelev)
3381  call mem_deallocate(this%bot)
3382  call mem_deallocate(this%ratesim)
3383  call mem_deallocate(this%qsim0)
3384  call mem_deallocate(this%reduction_length)
3385  call mem_deallocate(this%fwelev)
3386  call mem_deallocate(this%fwcond)
3387  call mem_deallocate(this%fwrlen)
3388  call mem_deallocate(this%fwcondsim)
3389  call mem_deallocate(this%xsto)
3390  call mem_deallocate(this%xoldsto)
3391  call mem_deallocate(this%shutoffmin)
3392  call mem_deallocate(this%shutoffmax)
3393  call mem_deallocate(this%shutofflevel)
3394  call mem_deallocate(this%shutoffweight)
3395  call mem_deallocate(this%shutoffdq)
3396  call mem_deallocate(this%shutoffqold)
3397  call mem_deallocate(this%nurdxold)
3398  call mem_deallocate(this%nurweight)
3399  !
3400  ! -- timeseries aware variables
3401  call mem_deallocate(this%mauxvar)
3402  call mem_deallocate(this%rate)
3403  call mem_deallocate(this%well_head)
3404  !
3405  ! -- connection data
3406  call mem_deallocate(this%iaconn)
3407  call mem_deallocate(this%gwfnodes)
3408  call mem_deallocate(this%sradius)
3409  call mem_deallocate(this%hk)
3410  call mem_deallocate(this%satcond)
3411  call mem_deallocate(this%simcond)
3412  call mem_deallocate(this%topscrn)
3413  call mem_deallocate(this%botscrn)
3414  call mem_deallocate(this%angle)
3415  call mem_deallocate(this%connlen)
3416  call mem_deallocate(this%usrtopscrn)
3417  call mem_deallocate(this%usrbotscrn)
3418  !
3419  ! -- imap vector
3420  call mem_deallocate(this%imap)
3421  call mem_deallocate(this%dbuff)
3422  call mem_deallocate(this%cauxcbc, 'CAUXCBC', this%memoryPath)
3423  call mem_deallocate(this%qauxcbc)
3424  call mem_deallocate(this%qleak)
3425  call mem_deallocate(this%qfw)
3426  call mem_deallocate(this%qout)
3427  call mem_deallocate(this%qsto)
3428  call mem_deallocate(this%qconst)
3429  call mem_deallocate(this%denseterms)
3430  call mem_deallocate(this%viscratios)
3431  call mem_deallocate(this%idxlocnode)
3432  call mem_deallocate(this%idxdglo)
3433  call mem_deallocate(this%idxoffdglo)
3434  call mem_deallocate(this%idxsymdglo)
3435  call mem_deallocate(this%idxsymoffdglo)
3436  call mem_deallocate(this%xoldpak)
3437  !
3438  ! -- nullify pointers
3439  call mem_deallocate(this%xnewpak, 'HEAD', this%memoryPath)
3440  !
3441  ! -- scalars
3442  call mem_deallocate(this%correct_flow)
3443  call mem_deallocate(this%iprhed)
3444  call mem_deallocate(this%iheadout)
3445  call mem_deallocate(this%ibudgetout)
3446  call mem_deallocate(this%ibudcsv)
3447  call mem_deallocate(this%iflowingwells)
3448  call mem_deallocate(this%imawiss)
3449  call mem_deallocate(this%imawissopt)
3450  call mem_deallocate(this%nmawwells)
3451  call mem_deallocate(this%check_attr)
3452  call mem_deallocate(this%ishutoffcnt)
3453  call mem_deallocate(this%ieffradopt)
3454  call mem_deallocate(this%inonvert)
3455  call mem_deallocate(this%ioutredflowcsv)
3456  call mem_deallocate(this%satomega)
3457  call mem_deallocate(this%bditems)
3458  call mem_deallocate(this%theta)
3459  call mem_deallocate(this%kappa)
3460  call mem_deallocate(this%cbcauxitems)
3461  call mem_deallocate(this%idense)
3462  !
3463  ! -- pointers to gwf variables
3464  nullify (this%gwfiss)
3465  !
3466  ! -- call standard BndType deallocate
3467  call this%BndType%bnd_da()

◆ maw_damp_weight()

pure real(dp) function, public mawmodule::maw_damp_weight ( real(dp), intent(in)  dxprop,
real(dp), intent(in)  dxold,
real(dp), intent(in)  weight,
real(dp), intent(in)  damptheta,
real(dp), intent(in)  damptol,
real(dp), intent(in)  weightmin,
real(dp), intent(in)  recover 
)

This is the decision used by maw_nur. The weight is cut back (multiplied by damptheta, but never below weightmin) only when the proposed head change reversed direction and is not already getting smaller (its size is at least damptol times the previous change). Otherwise the weight grows back toward one by recover. It is a pure function so the logic can be unit tested.

Definition at line 2950 of file gwf-maw.f90.

2952  ! -- dummy
2953  real(DP), intent(in) :: dxprop !proposed well head change this outer iteration
2954  real(DP), intent(in) :: dxold !well head change applied last outer iteration
2955  real(DP), intent(in) :: weight !current damping weight
2956  real(DP), intent(in) :: damptheta !factor the weight is cut by when oscillating
2957  real(DP), intent(in) :: damptol !smallest |dxprop|/|dxold| ratio that is damped
2958  real(DP), intent(in) :: weightmin !smallest allowed weight
2959  real(DP), intent(in) :: recover !amount the weight grows back each iteration
2960  ! -- return
2961  real(DP) :: new_weight
2962  !
2963  if (dxprop * dxold < dzero .and. abs(dxprop) > damptol * abs(dxold)) then
2964  new_weight = max(damptheta * weight, weightmin)
2965  else
2966  new_weight = min(weight + recover, done)
2967  end if
Here is the caller graph for this function:

◆ maw_df_obs()

subroutine mawmodule::maw_df_obs ( class(mawtype this)
private

Overrides BndTypebnd_df_obs

Definition at line 3547 of file gwf-maw.f90.

3548  ! -- dummy
3549  class(MawType) :: this
3550  ! -- local
3551  integer(I4B) :: indx
3552  !
3553  ! -- Store obs type and assign procedure pointer
3554  ! for head observation type.
3555  call this%obs%StoreObsType('head', .false., indx)
3556  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
3557  !
3558  ! -- Store obs type and assign procedure pointer
3559  ! for frommvr observation type.
3560  call this%obs%StoreObsType('from-mvr', .false., indx)
3561  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
3562  !
3563  ! -- Store obs type and assign procedure pointer
3564  ! for conn-rate observation type.
3565  call this%obs%StoreObsType('maw', .true., indx)
3566  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
3567  !
3568  ! -- Store obs type and assign procedure pointer
3569  ! for rate observation type.
3570  call this%obs%StoreObsType('rate', .true., indx)
3571  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
3572  !
3573  ! -- Store obs type and assign procedure pointer
3574  ! for rate-to-mvr observation type.
3575  call this%obs%StoreObsType('rate-to-mvr', .true., indx)
3576  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
3577  !
3578  ! -- Store obs type and assign procedure pointer
3579  ! for fw-rate observation type.
3580  call this%obs%StoreObsType('fw-rate', .true., indx)
3581  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
3582  !
3583  ! -- Store obs type and assign procedure pointer
3584  ! for rate-to-mvr observation type.
3585  call this%obs%StoreObsType('fw-to-mvr', .true., indx)
3586  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
3587  !
3588  ! -- Store obs type and assign procedure pointer
3589  ! for storage observation type.
3590  call this%obs%StoreObsType('storage', .true., indx)
3591  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
3592  !
3593  ! -- Store obs type and assign procedure pointer
3594  ! for constant observation type.
3595  call this%obs%StoreObsType('constant', .true., indx)
3596  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
3597  !
3598  ! -- Store obs type and assign procedure pointer
3599  ! for cond observation type.
3600  call this%obs%StoreObsType('conductance', .true., indx)
3601  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
3602  !
3603  ! -- Store obs type and assign procedure pointer
3604  ! for fw-conductance observation type.
3605  call this%obs%StoreObsType('fw-conductance', .true., indx)
3606  this%obs%obsData(indx)%ProcessIdPtr => maw_process_obsid
Here is the call graph for this function:

◆ maw_fc()

subroutine mawmodule::maw_fc ( class(mawtype this,
real(dp), dimension(:), intent(inout)  rhs,
integer(i4b), dimension(:), intent(in)  ia,
integer(i4b), dimension(:), intent(in)  idxglo,
class(matrixbasetype), pointer  matrix_sln 
)
private

Definition at line 2524 of file gwf-maw.f90.

2525  ! -- modules
2526  use tdismodule, only: delt
2527  ! -- dummy
2528  class(MawType) :: this
2529  real(DP), dimension(:), intent(inout) :: rhs
2530  integer(I4B), dimension(:), intent(in) :: ia
2531  integer(I4B), dimension(:), intent(in) :: idxglo
2532  class(MatrixBaseType), pointer :: matrix_sln
2533  ! -- local
2534  integer(I4B) :: j
2535  integer(I4B) :: n
2536  integer(I4B) :: idx
2537  integer(I4B) :: iloc
2538  integer(I4B) :: isymloc
2539  integer(I4B) :: igwfnode
2540  integer(I4B) :: iposd
2541  integer(I4B) :: iposoffd
2542  integer(I4B) :: isymnode
2543  integer(I4B) :: ipossymd
2544  integer(I4B) :: ipossymoffd
2545  integer(I4B) :: jpos
2546  integer(I4B) :: icflow
2547  real(DP) :: hmaw
2548  real(DP) :: hgwf
2549  real(DP) :: cfw
2550  real(DP) :: cmaw
2551  real(DP) :: cterm
2552  real(DP) :: term
2553  real(DP) :: scale
2554  real(DP) :: tp
2555  real(DP) :: bt
2556  real(DP) :: rate
2557  real(DP) :: ratefw
2558  real(DP) :: flow
2559  real(DP) :: tled
2560  real(DP) :: sd
2561  real(DP) :: ss
2562  real(DP) :: ssold
2563  !
2564  ! -- pakmvrobj fc
2565  if (this%imover == 1) then
2566  call this%pakmvrobj%fc()
2567  end if
2568  !
2569  ! -- Copy package rhs and hcof into solution rhs and amat
2570  idx = 1
2571  do n = 1, this%nmawwells
2572  iloc = this%idxlocnode(n)
2573  !
2574  ! -- save the well rate from the previous outer iteration before it is
2575  ! recalculated below, for the rate convergence check in maw_cc
2576  this%qsim0(n) = this%ratesim(n)
2577  !
2578  ! -- update head value for constant head maw wells
2579  if (this%iboundpak(n) < 0) then
2580  this%xnewpak(n) = this%well_head(n)
2581  end if
2582  hmaw = this%xnewpak(n)
2583  !
2584  ! -- add pumping rate to active or constant maw well
2585  if (this%iboundpak(n) == 0) then
2586  this%ratesim(n) = dzero
2587  else
2588  call this%maw_calculate_wellq(n, hmaw, rate)
2589  this%ratesim(n) = rate
2590  rhs(iloc) = rhs(iloc) - rate
2591  !
2592  ! -- location of diagonal for maw row
2593  iposd = this%idxdglo(idx)
2594  !
2595  ! -- add flowing well
2596  this%xsto(n) = hmaw
2597  ratefw = dzero
2598  if (this%iflowingwells > 0) then
2599  if (this%fwcond(n) > dzero) then
2600  bt = this%fwelev(n)
2601  tp = bt + this%fwrlen(n)
2602  scale = sqsaturation(tp, bt, hmaw)
2603  cfw = scale * this%fwcond(n)
2604  this%ifwdischarge(n) = 0
2605  if (cfw > dzero) then
2606  this%ifwdischarge(n) = 1
2607  this%xsto(n) = bt
2608  end if
2609  this%fwcondsim(n) = cfw
2610  call matrix_sln%add_value_pos(iposd, -cfw)
2611  rhs(iloc) = rhs(iloc) - cfw * bt
2612  ratefw = cfw * (bt - hmaw)
2613  end if
2614  end if
2615  !
2616  ! -- add maw storage changes
2617  if (this%imawiss /= 1) then
2618  if (this%ifwdischarge(n) /= 1) then
2619  ! -- well storage. The storage water level is not allowed to drop
2620  ! below the bottom of the well: ss is a smooth version of
2621  ! max(hmaw, well bottom). The storage release then fades out as
2622  ! the well empties instead of drawing water from below the well
2623  ! bottom. While the head is above the bottom this is the original
2624  ! term (sd = 1, ss = hmaw, giving -area/delt).
2625  tled = this%area(n) / delt
2626  sd = squadratic0spderivative(hmaw, this%bot(n), this%satomega)
2627  ss = squadratic0sp(hmaw, this%bot(n), this%satomega)
2628  ssold = squadratic0sp(this%xoldsto(n), this%bot(n), this%satomega)
2629  call matrix_sln%add_value_pos(iposd, -tled * sd)
2630  rhs(iloc) = rhs(iloc) - tled * (sd * hmaw - ss + ssold)
2631  else
2632  cterm = this%xoldsto(n) - this%fwelev(n)
2633  rhs(iloc) = rhs(iloc) - (this%area(n) * cterm / delt)
2634  end if
2635  end if
2636  !
2637  ! -- If mover is active, add receiver water to rhs and
2638  ! store available water (as positive value)
2639  if (this%imover == 1) then
2640  rhs(iloc) = rhs(iloc) - this%pakmvrobj%get_qfrommvr(n)
2641  !
2642  ! -- add pumping rate to mover if not injection
2643  if (rate < 0) then
2644  call this%pakmvrobj%accumulate_qformvr(n, -rate) !pumped water
2645  end if
2646  !
2647  ! -- add flowing well flow to mover
2648  call this%pakmvrobj%accumulate_qformvr(n, -ratefw) !flowing water
2649  end if
2650  !
2651  end if
2652  !
2653  ! -- process each maw/gwf connection
2654  do j = 1, this%ngwfnodes(n)
2655  if (this%iboundpak(n) /= 0) then
2656  jpos = this%get_jpos(n, j)
2657  igwfnode = this%get_gwfnode(n, j)
2658  hgwf = this%xnew(igwfnode)
2659  !
2660  ! -- calculate connection terms
2661  call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2662  flow)
2663  this%simcond(jpos) = cmaw
2664  !
2665  ! -- add to maw row
2666  iposd = this%idxdglo(idx)
2667  iposoffd = this%idxoffdglo(idx)
2668  call matrix_sln%add_value_pos(iposd, -term)
2669  call matrix_sln%set_value_pos(iposoffd, term)
2670  !
2671  ! -- add correction term
2672  rhs(iloc) = rhs(iloc) - cterm
2673  !
2674  ! -- add to gwf row for maw connection
2675  isymnode = this%get_gwfnode(n, j)
2676  isymloc = ia(isymnode)
2677  ipossymd = this%idxsymdglo(idx)
2678  ipossymoffd = this%idxsymoffdglo(idx)
2679  call matrix_sln%add_value_pos(ipossymd, -term)
2680  call matrix_sln%set_value_pos(ipossymoffd, term)
2681  !
2682  ! -- add correction term to gwf row
2683  rhs(isymnode) = rhs(isymnode) + cterm
2684  end if
2685  !
2686  ! -- increment maw connection counter
2687  idx = idx + 1
2688  end do
2689  end do
Here is the call graph for this function:

◆ maw_fill_budobj()

subroutine mawmodule::maw_fill_budobj ( class(mawtype this)

terms include a combination of the following: gwf rate [flowing_well] [storage] constant_flow [frommvr tomvr tomvrcf [tomvrfw]] [aux]

Definition at line 4881 of file gwf-maw.f90.

4882  ! -- modules
4883  ! -- dummy
4884  class(MawType) :: this
4885  ! -- local
4886  integer(I4B) :: naux
4887  integer(I4B) :: j
4888  integer(I4B) :: n
4889  integer(I4B) :: n2
4890  integer(I4B) :: jpos
4891  integer(I4B) :: idx
4892  integer(I4B) :: ibnd
4893  real(DP) :: q
4894  real(DP) :: tmaw
4895  real(DP) :: bmaw
4896  real(DP) :: sat
4897  real(DP) :: qfact
4898  real(DP) :: q2
4899  real(DP) :: b
4900  real(DP) :: v
4901  ! -- formats
4902  !
4903  ! -- initialize counter
4904  idx = 0
4905  !
4906  ! -- GWF (LEAKAGE) and connection surface area (aux)
4907  idx = idx + 1
4908  call this%budobj%budterm(idx)%reset(this%maxbound)
4909  ibnd = 1
4910  do n = 1, this%nmawwells
4911  do j = 1, this%ngwfnodes(n)
4912  jpos = this%get_jpos(n, j)
4913  n2 = this%get_gwfnode(n, j)
4914  tmaw = this%topscrn(jpos)
4915  bmaw = this%botscrn(jpos)
4916  call this%maw_calculate_saturation(n, j, n2, sat)
4917  this%qauxcbc(1) = dtwo * dpi * this%radius(n) * sat * (tmaw - bmaw)
4918  q = this%qleak(ibnd)
4919  call this%budobj%budterm(idx)%update_term(n, n2, q, this%qauxcbc)
4920  ibnd = ibnd + 1
4921  end do
4922  end do
4923  !
4924  ! -- RATE (WITHDRAWAL RATE)
4925  idx = idx + 1
4926  call this%budobj%budterm(idx)%reset(this%nmawwells)
4927  do n = 1, this%nmawwells
4928  q = this%ratesim(n)
4929  !
4930  ! -- adjust if well rate is an outflow
4931  if (this%imover == 1 .and. q < dzero) then
4932  qfact = done
4933  if (this%qout(n) < dzero) then
4934  qfact = q / this%qout(n)
4935  end if
4936  q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4937  end if
4938  call this%budobj%budterm(idx)%update_term(n, n, q)
4939  end do
4940  !
4941  ! -- FLOWING WELL
4942  if (this%iflowingwells > 0) then
4943  idx = idx + 1
4944  call this%budobj%budterm(idx)%reset(this%nmawwells)
4945  do n = 1, this%nmawwells
4946  q = this%qfw(n)
4947  if (this%imover == 1) then
4948  qfact = done
4949  !
4950  ! -- adjust if well rate is an outflow
4951  if (this%qout(n) < dzero) then
4952  qfact = q / this%qout(n)
4953  end if
4954  q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4955  end if
4956  call this%budobj%budterm(idx)%update_term(n, n, q)
4957  end do
4958  end if
4959  !
4960  ! -- STORAGE (AND VOLUME AS AUX)
4961  idx = idx + 1
4962  call this%budobj%budterm(idx)%reset(this%nmawwells)
4963  do n = 1, this%nmawwells
4964  b = this%xsto(n) - this%bot(n)
4965  if (b < dzero) then
4966  b = dzero
4967  end if
4968  v = this%area(n) * b
4969  if (this%imawissopt /= 1) then
4970  q = this%qsto(n)
4971  else
4972  q = dzero
4973  end if
4974  this%qauxcbc(1) = v
4975  call this%budobj%budterm(idx)%update_term(n, n, q, this%qauxcbc)
4976  end do
4977  !
4978  ! -- CONSTANT FLOW
4979  idx = idx + 1
4980  call this%budobj%budterm(idx)%reset(this%nmawwells)
4981  do n = 1, this%nmawwells
4982  q = this%qconst(n)
4983  !
4984  ! -- adjust if constant-flow rate is an outflow
4985  if (this%imover == 1 .and. q < dzero) then
4986  qfact = done
4987  if (this%qout(n) < dzero) then
4988  qfact = q / this%qout(n)
4989  end if
4990  q = q + qfact * this%pakmvrobj%get_qtomvr(n)
4991  end if
4992  call this%budobj%budterm(idx)%update_term(n, n, q)
4993  end do
4994  !
4995  ! -- MOVER
4996  if (this%imover == 1) then
4997  !
4998  ! -- FROM MOVER
4999  idx = idx + 1
5000  call this%budobj%budterm(idx)%reset(this%nmawwells)
5001  do n = 1, this%nmawwells
5002  if (this%iboundpak(n) == 0) then
5003  q = dzero
5004  else
5005  q = this%pakmvrobj%get_qfrommvr(n)
5006  end if
5007  call this%budobj%budterm(idx)%update_term(n, n, q)
5008  end do
5009  !
5010  ! -- RATE TO MOVER
5011  idx = idx + 1
5012  call this%budobj%budterm(idx)%reset(this%nmawwells)
5013  do n = 1, this%nmawwells
5014  q = this%pakmvrobj%get_qtomvr(n)
5015  if (q > dzero) then
5016  q = -q
5017  q2 = this%ratesim(n)
5018  !
5019  ! -- adjust TO MOVER if well rate is outflow
5020  if (q2 < dzero) then
5021  qfact = q2 / this%qout(n)
5022  q = q * qfact
5023  else
5024  q = dzero
5025  end if
5026  end if
5027  call this%budobj%budterm(idx)%update_term(n, n, q)
5028  end do
5029  !
5030  ! -- CONSTANT TO MOVER
5031  idx = idx + 1
5032  call this%budobj%budterm(idx)%reset(this%nmawwells)
5033  do n = 1, this%nmawwells
5034  q = this%pakmvrobj%get_qtomvr(n)
5035  if (q > dzero) then
5036  q = -q
5037  q2 = this%qconst(n)
5038  ! -- adjust TO MOVER if well rate is outflow
5039  if (q2 < dzero) then
5040  qfact = q2 / this%qout(n)
5041  q = q * qfact
5042  else
5043  q = dzero
5044  end if
5045  end if
5046  call this%budobj%budterm(idx)%update_term(n, n, q)
5047  end do
5048  !
5049  ! -- FLOWING WELL TO MOVER
5050  if (this%iflowingwells > 0) then
5051  idx = idx + 1
5052  call this%budobj%budterm(idx)%reset(this%nmawwells)
5053  do n = 1, this%nmawwells
5054  q = this%pakmvrobj%get_qtomvr(n)
5055  if (q > dzero) then
5056  q = -q
5057  q2 = this%ratesim(n)
5058  !
5059  ! -- adjust TO MOVER if well rate is outflow
5060  qfact = done
5061  if (this%qout(n) < dzero) then
5062  qfact = this%qfw(n) / this%qout(n)
5063  end if
5064  q = q * qfact
5065  end if
5066  call this%budobj%budterm(idx)%update_term(n, n, q)
5067  end do
5068  end if
5069 
5070  end if
5071  !
5072  ! -- AUXILIARY VARIABLES
5073  naux = this%naux
5074  if (naux > 0) then
5075  idx = idx + 1
5076  call this%budobj%budterm(idx)%reset(this%nmawwells)
5077  do n = 1, this%nmawwells
5078  q = dzero
5079  call this%budobj%budterm(idx)%update_term(n, n, q, this%auxvar(:, n))
5080  end do
5081  end if
5082  !
5083  ! --Terms are filled, now accumulate them for this time step
5084  call this%budobj%accumulate_terms()

◆ maw_fn()

subroutine mawmodule::maw_fn ( class(mawtype this,
real(dp), dimension(:), intent(inout)  rhs,
integer(i4b), dimension(:), intent(in)  ia,
integer(i4b), dimension(:), intent(in)  idxglo,
class(matrixbasetype), pointer  matrix_sln 
)

Definition at line 2694 of file gwf-maw.f90.

2695  ! -- dummy
2696  class(MawType) :: this
2697  real(DP), dimension(:), intent(inout) :: rhs
2698  integer(I4B), dimension(:), intent(in) :: ia
2699  integer(I4B), dimension(:), intent(in) :: idxglo
2700  class(MatrixBaseType), pointer :: matrix_sln
2701  ! -- local
2702  integer(I4B) :: j
2703  integer(I4B) :: n
2704  integer(I4B) :: idx
2705  integer(I4B) :: iloc
2706  integer(I4B) :: isymloc
2707  integer(I4B) :: igwfnode
2708  integer(I4B) :: iposd
2709  integer(I4B) :: iposoffd
2710  integer(I4B) :: isymnode
2711  integer(I4B) :: ipossymd
2712  integer(I4B) :: ipossymoffd
2713  integer(I4B) :: jpos
2714  integer(I4B) :: icflow
2715  real(DP) :: hmaw
2716  real(DP) :: hgwf
2717  real(DP) :: scale
2718  real(DP) :: tp
2719  real(DP) :: bt
2720  real(DP) :: cfw
2721  real(DP) :: rate
2722  real(DP) :: rate2
2723  real(DP) :: rterm
2724  real(DP) :: derv
2725  real(DP) :: drterm
2726  real(DP) :: cmaw
2727  real(DP) :: cterm
2728  real(DP) :: term
2729  real(DP) :: flow
2730  real(DP) :: term2
2731  real(DP) :: rhsterm
2732  !
2733  ! -- Calculate Newton-Raphson corrections
2734  idx = 1
2735  do n = 1, this%nmawwells
2736  iloc = this%idxlocnode(n)
2737  hmaw = this%xnewpak(n)
2738  !
2739  ! -- add pumping rate to active or constant maw well
2740  if (this%iboundpak(n) /= 0) then
2741  iposd = this%idxdglo(idx)
2742  scale = done
2743  drterm = dzero
2744  rate = this%ratesim(n)
2745  !
2746  !-- calculate final derivative for pumping rate
2747  call this%maw_calculate_wellq(n, hmaw + dem4, rate2)
2748  drterm = (rate2 - rate) / dem4
2749  !
2750  !-- fill amat and rhs with newton-raphson terms
2751  call matrix_sln%add_value_pos(iposd, drterm)
2752  rhs(iloc) = rhs(iloc) + drterm * hmaw
2753  !
2754  ! -- add flowing well
2755  if (this%iflowingwells > 0) then
2756  if (this%fwcond(n) > dzero) then
2757  bt = this%fwelev(n)
2758  tp = bt + this%fwrlen(n)
2759  scale = sqsaturation(tp, bt, hmaw)
2760  cfw = scale * this%fwcond(n)
2761  this%ifwdischarge(n) = 0
2762  if (cfw > dzero) then
2763  this%ifwdischarge(n) = 1
2764  end if
2765  this%fwcondsim(n) = cfw
2766  rate = cfw * (bt - hmaw)
2767  rterm = -cfw * hmaw
2768  !
2769  ! --calculate derivative for flowing well
2770  if (hmaw < tp) then
2771  derv = sqsaturationderivative(tp, bt, hmaw)
2772  drterm = -(cfw + this%fwcond(n) * derv * (hmaw - bt))
2773  !
2774  ! -- fill amat and rhs with newton-raphson terms
2775  call matrix_sln%add_value_pos(iposd, &
2776  -this%fwcond(n) * derv * (hmaw - bt))
2777  rhs(iloc) = rhs(iloc) - rterm + drterm * hmaw
2778  end if
2779  end if
2780  end if
2781  end if
2782  !
2783  ! -- process each maw/gwf connection
2784  do j = 1, this%ngwfnodes(n)
2785  if (this%iboundpak(n) /= 0) then
2786  jpos = this%get_jpos(n, j)
2787  igwfnode = this%get_gwfnode(n, j)
2788  hgwf = this%xnew(igwfnode)
2789  !
2790  ! -- add to maw row
2791  iposd = this%idxdglo(idx)
2792  iposoffd = this%idxoffdglo(idx)
2793  !
2794  ! -- add to gwf row for maw connection
2795  isymnode = this%get_gwfnode(n, j)
2796  isymloc = ia(isymnode)
2797  ipossymd = this%idxsymdglo(idx)
2798  ipossymoffd = this%idxsymoffdglo(idx)
2799  !
2800  ! -- calculate newton terms
2801  call this%maw_calculate_conn_terms(n, j, icflow, cmaw, cterm, term, &
2802  flow, term2)
2803  !
2804  ! -- maw is upstream
2805  if (hmaw > hgwf) then
2806  if (icflow /= 0) then
2807  rhsterm = term2 * hgwf + term * hmaw
2808  rhs(iloc) = rhs(iloc) + rhsterm
2809  rhs(isymnode) = rhs(isymnode) - rhsterm
2810  if (this%iboundpak(n) > 0) then
2811  call matrix_sln%add_value_pos(iposd, term)
2812  call matrix_sln%add_value_pos(iposoffd, term2)
2813  end if
2814  call matrix_sln%add_value_pos(ipossymd, -term2)
2815  call matrix_sln%add_value_pos(ipossymoffd, -term)
2816  else
2817  rhs(iloc) = rhs(iloc) + term * hmaw
2818  rhs(isymnode) = rhs(isymnode) - term * hmaw
2819  call matrix_sln%add_value_pos(iposd, term)
2820  if (this%ibound(igwfnode) > 0) then
2821  call matrix_sln%add_value_pos(ipossymoffd, -term)
2822  end if
2823  end if
2824  !
2825  ! -- gwf is upstream
2826  else
2827  if (icflow /= 0) then
2828  rhsterm = term2 * hmaw + term * hgwf
2829  rhs(iloc) = rhs(iloc) + rhsterm
2830  rhs(isymnode) = rhs(isymnode) - rhsterm
2831  if (this%iboundpak(n) > 0) then
2832  call matrix_sln%add_value_pos(iposd, term2)
2833  call matrix_sln%add_value_pos(iposoffd, term)
2834  end if
2835  call matrix_sln%add_value_pos(ipossymd, -term)
2836  call matrix_sln%add_value_pos(ipossymoffd, -term2)
2837  else
2838  rhs(iloc) = rhs(iloc) + term * hgwf
2839  rhs(isymnode) = rhs(isymnode) - term * hgwf
2840  if (this%iboundpak(n) > 0) then
2841  call matrix_sln%add_value_pos(iposoffd, term)
2842  end if
2843  call matrix_sln%add_value_pos(ipossymd, -term)
2844  end if
2845  end if
2846  end if
2847  !
2848  ! -- increment maw connection counter
2849  idx = idx + 1
2850  end do
2851  end do
Here is the call graph for this function:

◆ maw_mc()

subroutine mawmodule::maw_mc ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  moffset,
class(matrixbasetype), pointer  matrix_sln 
)

Definition at line 1941 of file gwf-maw.f90.

1942  use sparsemodule, only: sparsematrix
1944  ! -- dummy
1945  class(MawType), intent(inout) :: this
1946  integer(I4B), intent(in) :: moffset
1947  class(MatrixBaseType), pointer :: matrix_sln
1948  ! -- local
1949  integer(I4B) :: n
1950  integer(I4B) :: j
1951  integer(I4B) :: ii
1952  integer(I4B) :: iglo
1953  integer(I4B) :: jglo
1954  integer(I4B) :: ipos
1955  ! -- format
1956  !
1957  ! -- allocate connection mapping vectors
1958  call mem_allocate(this%idxlocnode, this%nmawwells, 'IDXLOCNODE', &
1959  this%memoryPath)
1960  call mem_allocate(this%idxdglo, this%maxbound, 'IDXDGLO', this%memoryPath)
1961  call mem_allocate(this%idxoffdglo, this%maxbound, 'IDXOFFDGLO', &
1962  this%memoryPath)
1963  call mem_allocate(this%idxsymdglo, this%maxbound, 'IDXSYMDGLO', &
1964  this%memoryPath)
1965  call mem_allocate(this%idxsymoffdglo, this%maxbound, 'IDXSYMOFFDGLO', &
1966  this%memoryPath)
1967  !
1968  ! -- Find the position of each connection in the global ia, ja structure
1969  ! and store them in idxglo. idxglo allows this model to insert or
1970  ! retrieve values into or from the global A matrix
1971  ! -- maw rows
1972  ipos = 1
1973  do n = 1, this%nmawwells
1974  iglo = moffset + this%dis%nodes + this%ioffset + n
1975  this%idxlocnode(n) = this%dis%nodes + this%ioffset + n
1976  do ii = 1, this%ngwfnodes(n)
1977  j = this%get_gwfnode(n, ii)
1978  jglo = j + moffset
1979  this%idxdglo(ipos) = matrix_sln%get_position_diag(iglo)
1980  this%idxoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
1981  ipos = ipos + 1
1982  end do
1983  end do
1984  ! -- maw contributions gwf portion of global matrix
1985  ipos = 1
1986  do n = 1, this%nmawwells
1987  do ii = 1, this%ngwfnodes(n)
1988  iglo = this%get_gwfnode(n, ii) + moffset
1989  jglo = moffset + this%dis%nodes + this%ioffset + n
1990  this%idxsymdglo(ipos) = matrix_sln%get_position_diag(iglo)
1991  this%idxsymoffdglo(ipos) = matrix_sln%get_position(iglo, jglo)
1992  ipos = ipos + 1
1993  end do
1994  end do

◆ maw_nur()

subroutine mawmodule::maw_nur ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  neqpak,
real(dp), dimension(neqpak), intent(inout)  x,
real(dp), dimension(neqpak), intent(in)  xtemp,
real(dp), dimension(neqpak), intent(inout)  dx,
integer(i4b), intent(inout)  inewtonur,
real(dp), intent(inout)  dxmax,
integer(i4b), intent(inout)  locmax 
)
private

Two corrections are applied to each well head, in order:

  1. Oscillation damping. If the well head change reverses direction and is not getting smaller, it is cut back by a per-well weight. The weight shrinks while the head oscillates and grows back when the head moves steadily in one direction. This settles poorly connected wells (for example a low-K cell or a single connection) whose full Newton step is too large.
  2. Bottom limit. If the head is still below the well bottom, it is moved back up toward the well bottom (the original behavior).

Definition at line 2866 of file gwf-maw.f90.

2867  ! -- dummy
2868  class(MawType), intent(inout) :: this
2869  integer(I4B), intent(in) :: neqpak
2870  real(DP), dimension(neqpak), intent(inout) :: x
2871  real(DP), dimension(neqpak), intent(in) :: xtemp
2872  real(DP), dimension(neqpak), intent(inout) :: dx
2873  integer(I4B), intent(inout) :: inewtonur
2874  real(DP), intent(inout) :: dxmax
2875  integer(I4B), intent(inout) :: locmax
2876  ! -- local
2877  integer(I4B) :: n
2878  real(DP) :: botw
2879  real(DP) :: xx
2880  real(DP) :: dxx
2881  real(DP) :: dxprop
2882  real(DP) :: weight
2883  ! -- parameters
2884  real(DP), parameter :: damptheta = dp7 !factor the weight is cut by when the head oscillates
2885  real(DP), parameter :: damptol = dhalf !only damp if the change is at least this fraction of the last one
2886  real(DP), parameter :: weightmin = dem2 !smallest allowed weight
2887  real(DP), parameter :: recover = 0.2_dp !amount the weight grows back each iteration
2888  !
2889  ! -- Newton-Raphson under-relaxation
2890  do n = 1, this%nmawwells
2891  if (this%iboundpak(n) < 1) cycle
2892  botw = this%bot(n)
2893  !
2894  ! -- full Newton head change proposed for this outer iteration
2895  dxprop = x(n) - xtemp(n)
2896  !
2897  ! -- oscillation damping. Cut the weight only when the head change flips
2898  ! direction and is not already shrinking on its own (it is still at
2899  ! least damptol times the previous change). Otherwise let the weight
2900  ! grow back toward one, so a normal, converging well is not slowed
2901  ! down. This catches oscillations above the well bottom, which the
2902  ! bottom limit below cannot.
2903  weight = maw_damp_weight(dxprop, this%nurdxold(n), this%nurweight(n), &
2904  damptheta, damptol, weightmin, recover)
2905  this%nurweight(n) = weight
2906  !
2907  ! -- apply the reduced step when damping is turned on
2908  if (weight < done) then
2909  inewtonur = 1
2910  xx = xtemp(n) + weight * dxprop
2911  dxx = x(n) - xx
2912  if (abs(dxx) > abs(dxmax)) then
2913  locmax = n
2914  dxmax = dxx
2915  end if
2916  x(n) = xx
2917  dx(n) = weight * dxprop
2918  end if
2919  !
2920  ! -- bottom limit: if the (reduced) head is still below the bottom of the
2921  ! well, move it back up toward the well bottom
2922  if (x(n) < botw) then
2923  inewtonur = 1
2924  xx = xtemp(n) * (done - dp9) + botw * dp9
2925  dxx = x(n) - xx
2926  if (abs(dxx) > abs(dxmax)) then
2927  locmax = n
2928  dxmax = dxx
2929  end if
2930  x(n) = xx
2931  dx(n) = dzero
2932  end if
2933  !
2934  ! -- save the head change actually applied this iteration (after damping
2935  ! and the bottom limit). Saving it after the bottom limit lets the
2936  ! next iteration see the downward push from the limit, so the upward
2937  ! swing that follows can be damped.
2938  this%nurdxold(n) = x(n) - xtemp(n)
2939  end do
Here is the call graph for this function:

◆ maw_obs_supported()

logical function mawmodule::maw_obs_supported ( class(mawtype this)

Overrides BndTypebnd_obs_supported()

Definition at line 3537 of file gwf-maw.f90.

3538  class(MawType) :: this
3539  !
3540  maw_obs_supported = .true.

◆ maw_ot_bdsummary()

subroutine mawmodule::maw_ot_bdsummary ( class(mawtype this,
integer(i4b), intent(in)  kstp,
integer(i4b), intent(in)  kper,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  ibudfl 
)
Parameters
thisMawType object
[in]kstptime step number
[in]kperperiod number
[in]ioutflag and unit number for the model listing file
[in]ibudflflag indicating budget should be written

Definition at line 3333 of file gwf-maw.f90.

3334  ! -- module
3335  use tdismodule, only: totim, delt
3336  ! -- dummy
3337  class(MawType) :: this !< MawType object
3338  integer(I4B), intent(in) :: kstp !< time step number
3339  integer(I4B), intent(in) :: kper !< period number
3340  integer(I4B), intent(in) :: iout !< flag and unit number for the model listing file
3341  integer(I4B), intent(in) :: ibudfl !< flag indicating budget should be written
3342  !
3343  call this%budobj%write_budtable(kstp, kper, iout, ibudfl, totim, delt)
real(dp), pointer, public totim
time relative to start of simulation
Definition: tdis.f90:35

◆ maw_ot_dv()

subroutine mawmodule::maw_ot_dv ( class(mawtype this,
integer(i4b), intent(in)  idvsave,
integer(i4b), intent(in)  idvprint 
)

Definition at line 3278 of file gwf-maw.f90.

3279  use tdismodule, only: kstp, kper, pertim, totim
3280  use constantsmodule, only: dhnoflo, dhdry
3281  use inputoutputmodule, only: ulasav
3282  class(MawType) :: this
3283  integer(I4B), intent(in) :: idvsave
3284  integer(I4B), intent(in) :: idvprint
3285  integer(I4B) :: ibinun
3286  integer(I4B) :: n
3287  real(DP) :: v
3288  real(DP) :: d
3289  !
3290  ! -- set unit number for binary dependent variable output
3291  ibinun = 0
3292  if (this%iheadout /= 0) then
3293  ibinun = this%iheadout
3294  end if
3295  if (idvsave == 0) ibinun = 0
3296  !
3297  ! -- write maw binary output
3298  if (ibinun > 0) then
3299  do n = 1, this%nmawwells
3300  v = this%xnewpak(n)
3301  d = v - this%bot(n)
3302  if (this%iboundpak(n) == 0) then
3303  v = dhnoflo
3304  else if (d <= dzero) then
3305  v = dhdry
3306  end if
3307  this%dbuff(n) = v
3308  end do
3309  call ulasav(this%dbuff, ' HEAD', &
3310  kstp, kper, pertim, totim, &
3311  this%nmawwells, 1, 1, ibinun)
3312  end if
3313  !
3314  ! -- write maw head table
3315  if (idvprint /= 0 .and. this%iprhed /= 0) then
3316  !
3317  ! -- set table kstp and kper
3318  call this%headtab%set_kstpkper(kstp, kper)
3319  !
3320  ! -- fill stage data
3321  do n = 1, this%nmawwells
3322  if (this%inamedbound == 1) then
3323  call this%headtab%add_term(this%cmawname(n))
3324  end if
3325  call this%headtab%add_term(n)
3326  call this%headtab%add_term(this%xnewpak(n))
3327  end do
3328  end if
real(dp), parameter dhdry
real dry cell constant
Definition: Constants.f90:94
real(dp), parameter dhnoflo
real no flow constant
Definition: Constants.f90:93
subroutine, public ulasav(buf, text, kstp, kper, pertim, totim, ncol, nrow, ilay, ichn)
Save 1 layer array on disk.
real(dp), pointer, public pertim
time relative to start of stress period
Definition: tdis.f90:33
Here is the call graph for this function:

◆ maw_ot_model_flows()

subroutine mawmodule::maw_ot_model_flows ( class(mawtype this,
integer(i4b), intent(in)  icbcfl,
integer(i4b), intent(in)  ibudfl,
integer(i4b), intent(in)  icbcun,
integer(i4b), dimension(:), intent(in), optional  imap 
)

Definition at line 3238 of file gwf-maw.f90.

3239  ! -- dummy
3240  class(MawType) :: this
3241  integer(I4B), intent(in) :: icbcfl
3242  integer(I4B), intent(in) :: ibudfl
3243  integer(I4B), intent(in) :: icbcun
3244  integer(I4B), dimension(:), optional, intent(in) :: imap
3245  !
3246  ! -- write the flows from the budobj
3247  call this%BndType%bnd_ot_model_flows(icbcfl, ibudfl, icbcun, this%imap)

◆ maw_ot_package_flows()

subroutine mawmodule::maw_ot_package_flows ( class(mawtype this,
integer(i4b), intent(in)  icbcfl,
integer(i4b), intent(in)  ibudfl 
)
private

Definition at line 3252 of file gwf-maw.f90.

3253  use tdismodule, only: kstp, kper, delt, pertim, totim
3254  class(MawType) :: this
3255  integer(I4B), intent(in) :: icbcfl
3256  integer(I4B), intent(in) :: ibudfl
3257  integer(I4B) :: ibinun
3258  !
3259  ! -- write the flows from the budobj
3260  ibinun = 0
3261  if (this%ibudgetout /= 0) then
3262  ibinun = this%ibudgetout
3263  end if
3264  if (icbcfl == 0) ibinun = 0
3265  if (ibinun > 0) then
3266  call this%budobj%save_flows(this%dis, ibinun, kstp, kper, delt, &
3267  pertim, totim, this%iout)
3268  end if
3269  !
3270  ! -- Print maw flows table
3271  if (ibudfl /= 0 .and. this%iprflow /= 0) then
3272  call this%budobj%write_flowtable(this%dis, kstp, kper)
3273  end if

◆ maw_process_obsid()

subroutine mawmodule::maw_process_obsid ( type(observetype), intent(inout)  obsrv,
class(disbasetype), intent(in)  dis,
integer(i4b), intent(in)  inunitobs,
integer(i4b), intent(in)  iout 
)

Definition at line 3876 of file gwf-maw.f90.

3877  ! -- dummy
3878  type(ObserveType), intent(inout) :: obsrv
3879  class(DisBaseType), intent(in) :: dis
3880  integer(I4B), intent(in) :: inunitobs
3881  integer(I4B), intent(in) :: iout
3882  ! -- local
3883  integer(I4B) :: nn1, nn2
3884  integer(I4B) :: icol, istart, istop
3885  character(len=LINELENGTH) :: string
3886  character(len=LENBOUNDNAME) :: bndname
3887  ! formats
3888  !
3889  string = obsrv%IDstring
3890  ! -- Extract multi-aquifer well number from string and store it.
3891  ! If 1st item is not an integer(I4B), it should be a
3892  ! maw name--deal with it.
3893  icol = 1
3894  ! -- get multi-aquifer well number or boundary name
3895  call extract_idnum_or_bndname(string, icol, istart, istop, nn1, bndname)
3896  if (nn1 == namedboundflag) then
3897  obsrv%FeatureName = bndname
3898  else
3899  if (obsrv%ObsTypeId == 'MAW' .or. &
3900  obsrv%ObsTypeId == 'CONDUCTANCE') then
3901  call extract_idnum_or_bndname(string, icol, istart, istop, nn2, bndname)
3902  if (len_trim(bndname) < 1 .and. nn2 < 0) then
3903  write (errmsg, '(a,1x,a,a,1x,a,1x,a)') &
3904  'For observation type', trim(adjustl(obsrv%ObsTypeId)), &
3905  ', ID given as an integer and not as boundname,', &
3906  'but ID2 (icon) is missing. Either change ID to valid', &
3907  'boundname or supply valid entry for ID2.'
3908  call store_error(errmsg)
3909  end if
3910  if (nn2 == namedboundflag) then
3911  obsrv%FeatureName = bndname
3912  ! -- reset nn1
3913  nn1 = nn2
3914  else
3915  obsrv%NodeNumber2 = nn2
3916  end if
3917  end if
3918  end if
3919  ! -- store multi-aquifer well number (NodeNumber)
3920  obsrv%NodeNumber = nn1
Here is the call graph for this function:
Here is the caller graph for this function:

◆ maw_read_angledata()

subroutine mawmodule::maw_read_angledata ( class(mawtype), intent(inout)  this)

Each row identifies a non-vertical multi-aquifer well connection and the tilt angle (deviation from vertical, in degrees) used to calculate the in-cell screen length. An optional connection length can be specified to set the in-cell screen length directly; the connection length is required for horizontal connections (angle close to 90 degrees). Connections that are not listed in the ANGLEDATA block are assumed to be vertical.

Definition at line 1083 of file gwf-maw.f90.

1085  use mathutilmodule, only: is_close
1086  ! -- dummy
1087  class(MawType), intent(inout) :: this
1088  ! -- local
1089  logical :: isfound
1090  logical :: endOfBlock
1091  logical(LGP) :: success
1092  integer(I4B) :: ierr
1093  integer(I4B) :: ival
1094  integer(I4B) :: n
1095  integer(I4B) :: j
1096  integer(I4B) :: jpos
1097  integer(I4B) :: ipos
1098  integer(I4B) :: node
1099  real(DP) :: angle
1100  real(DP) :: conn_len
1101  real(DP) :: dz
1102  real(DP) :: omega
1103  real(DP) :: lw
1104  real(DP) :: topexp
1105  integer(I4B), dimension(:), pointer, contiguous :: nboundchk
1106  integer(I4B), dimension(:), pointer, contiguous :: iachk
1107  ! -- minimum cosine of the tilt angle for which the in-cell screen length
1108  ! can be derived from the screen elevations (i.e., the connection is not
1109  ! treated as horizontal); connections steeper than this require a
1110  ! connection length to be specified.
1111  real(DP), parameter :: coszero = dem6
1112  ! -- maximum tilt angle (degrees from vertical)
1113  real(DP), parameter :: dninety = 9.0d1
1114  !
1115  ! -- get angledata block
1116  call this%parser%GetBlock('ANGLEDATA', isfound, ierr, &
1117  supportopenclose=.true., blockrequired=.false.)
1118  !
1119  ! -- parse angledata block if detected
1120  if (isfound) then
1121  !
1122  ! -- the angledata block is only valid when the NON_VERTICAL_WELLS option
1123  ! has been specified
1124  if (this%inonvert == 0) then
1125  call store_error('An ANGLEDATA block was specified but the '// &
1126  'NON_VERTICAL_WELLS option was not specified in the '// &
1127  'OPTIONS block.')
1128  call this%parser%StoreErrorUnit()
1129  end if
1130  !
1131  ! -- allocate and initialize local storage used to check for duplicate
1132  ! connection entries
1133  allocate (iachk(this%nmawwells + 1))
1134  iachk(1) = 1
1135  do n = 1, this%nmawwells
1136  iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
1137  end do
1138  allocate (nboundchk(this%maxbound))
1139  do n = 1, this%maxbound
1140  nboundchk(n) = 0
1141  end do
1142  !
1143  write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// &
1144  ' ANGLEDATA'
1145  do
1146  call this%parser%GetNextLine(endofblock)
1147  if (endofblock) exit
1148  !
1149  ! -- well number
1150  ival = this%parser%GetInteger()
1151  n = ival
1152  if (n < 1 .or. n > this%nmawwells) then
1153  write (errmsg, '(a,1x,i0,a)') &
1154  'IFNO must be greater than 0 and less than or equal to ', &
1155  this%nmawwells, '.'
1156  call store_error(errmsg)
1157  cycle
1158  end if
1159  !
1160  ! -- connection number
1161  ival = this%parser%GetInteger()
1162  if (ival < 1 .or. ival > this%ngwfnodes(n)) then
1163  write (errmsg, '(a,1x,i0,1x,a,1x,i0,a)') &
1164  'ICON for well ', n, &
1165  'must be greater than 0 and less than or equal to ', &
1166  this%ngwfnodes(n), '.'
1167  call store_error(errmsg)
1168  cycle
1169  end if
1170  j = ival
1171  jpos = this%get_jpos(n, j)
1172  !
1173  ! -- check for duplicate entries
1174  ipos = iachk(n) + j - 1
1175  nboundchk(ipos) = nboundchk(ipos) + 1
1176  if (nboundchk(ipos) > 1) then
1177  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') &
1178  'ANGLEDATA for maw well', n, 'connection', j, &
1179  'is specified more than once.'
1180  call store_error(errmsg)
1181  end if
1182  !
1183  ! -- tilt angle (degrees from vertical)
1184  angle = this%parser%GetDouble()
1185  !
1186  ! -- optional in-cell screen length
1187  call this%parser%TryGetDouble(conn_len, success)
1188  if (.not. success) then
1189  conn_len = dzero
1190  end if
1191  !
1192  ! -- store the angle and connection length
1193  this%angle(jpos) = angle
1194  this%connlen(jpos) = conn_len
1195  !
1196  ! -- the tilt angle must be between 0 and 90 degrees
1197  if (angle < dzero .or. angle > dninety) then
1198  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1199  'ANGLE for maw well', n, 'connection', j, '(', angle, &
1200  ') must be greater than or equal to 0.0 and less than or '// &
1201  'equal to 90.0 degrees.'
1202  call store_error(errmsg)
1203  cycle
1204  end if
1205  !
1206  ! -- a SPECIFIED connection provides the saturated conductance directly,
1207  ! so the length correction is not applied; the user-specified screen
1208  ! elevations (which are otherwise reset to the cell top and bottom)
1209  ! are restored here, clamped to the cell, so the connection
1210  ! saturation is calculated over the correct interval. It is the
1211  ! user's responsibility to calculate the correct conductance.
1212  if (this%ieqn(n) == 0) then
1213  node = this%get_gwfnode(n, j)
1214  this%topscrn(jpos) = min(this%usrtopscrn(jpos), this%dis%top(node))
1215  this%botscrn(jpos) = max(this%usrbotscrn(jpos), this%dis%bot(node))
1216  end if
1217  !
1218  ! -- screen thickness (vertical extent of the connection)
1219  dz = this%topscrn(jpos) - this%botscrn(jpos)
1220  if (dz <= dzero) then
1221  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') &
1222  'The screen top must be greater than the screen bottom for maw '// &
1223  'well', n, 'connection', j, 'listed in the ANGLEDATA block.'
1224  call store_error(errmsg)
1225  cycle
1226  end if
1227  !
1228  omega = angle * dpio180
1229  !
1230  ! -- the in-cell screen length is used only by the conductance
1231  ! equations calculated by the program (it is not used by the
1232  ! SPECIFIED equation). For those equations a (near) horizontal
1233  ! connection requires a connection length, because the length cannot
1234  ! be derived from the screen elevations, and the calculated length
1235  ! must be positive.
1236  if (this%ieqn(n) /= 0) then
1237  if (cos(omega) <= coszero .and. conn_len <= dzero) then
1238  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') &
1239  'A connection length must be specified for the (near) '// &
1240  'horizontal maw well', n, 'connection', j, &
1241  'listed in the ANGLEDATA block.'
1242  call store_error(errmsg)
1243  cycle
1244  end if
1245  if (conn_len > dzero) then
1246  lw = conn_len
1247  else
1248  lw = (dz - dtwo * this%radius(n) * sin(omega)) / cos(omega)
1249  end if
1250  if (lw <= dzero) then
1251  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1252  'The calculated in-cell screen length for maw well', n, &
1253  'connection', j, '(', lw, &
1254  ') is not greater than zero. Specify a connection length in '// &
1255  'the ANGLEDATA block.'
1256  call store_error(errmsg)
1257  cycle
1258  end if
1259  end if
1260  !
1261  ! -- the radial (THIEM, SKIN, and CUMULATIVE) conductance equations use
1262  ! the horizontal-plane flow geometry, so a (near) horizontal
1263  ! connection is an approximation; recommend the MEAN equation
1264  if (cos(omega) <= coszero .and. &
1265  this%ieqn(n) /= 4 .and. this%ieqn(n) /= 0) then
1266  write (warnmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') &
1267  'The (near) horizontal maw well', n, 'connection', j, &
1268  'uses a radial conductance equation (THIEM, SKIN, or '// &
1269  'CUMULATIVE). The calculated conductance is an approximation '// &
1270  'for horizontal connections; the MEAN conductance equation is '// &
1271  'recommended for horizontal connections.'
1272  call store_warning(warnmsg)
1273  end if
1274  !
1275  ! -- for a (near) horizontal connection using the MEAN or SPECIFIED
1276  ! conductance equation, the vertical screen extent (SCRN_TOP -
1277  ! SCRN_BOT) should equal the well diameter (2 * RADIUS) because it is
1278  ! used to determine the saturation of the connection. Snap the screen
1279  ! top to the well diameter if the specified extent is essentially
1280  ! equal to it; otherwise warn the user.
1281  if (cos(omega) <= coszero .and. &
1282  (this%ieqn(n) == 4 .or. this%ieqn(n) == 0)) then
1283  topexp = this%botscrn(jpos) + dtwo * this%radius(n)
1284  if (is_close(this%topscrn(jpos), topexp)) then
1285  this%topscrn(jpos) = topexp
1286  else
1287  write (warnmsg, '(a,1x,i0,1x,a,1x,i0,1x,a,g0,a)') &
1288  'The vertical screen extent (SCRN_TOP - SCRN_BOT) for the '// &
1289  '(near) horizontal maw well', n, 'connection', j, &
1290  'is not equal to the well diameter (2 * RADIUS = ', &
1291  dtwo * this%radius(n), &
1292  '). The vertical screen extent is used to determine the '// &
1293  'saturation of a connection and should equal the well '// &
1294  'diameter for a horizontal connection.'
1295  call store_warning(warnmsg)
1296  end if
1297  end if
1298  end do
1299  write (this%iout, '(1x,a)') &
1300  'END OF '//trim(adjustl(this%text))//' ANGLEDATA'
1301  !
1302  ! -- deallocate local storage
1303  deallocate (iachk)
1304  deallocate (nboundchk)
1305  else
1306  !
1307  ! -- the NON_VERTICAL_WELLS option was specified but no ANGLEDATA block
1308  ! was found; warn that all connections will be treated as vertical
1309  if (this%inonvert /= 0) then
1310  write (warnmsg, '(a)') &
1311  'The NON_VERTICAL_WELLS option was specified but an ANGLEDATA '// &
1312  'block was not found. All multi-aquifer well connections will be '// &
1313  'treated as vertical.'
1314  call store_warning(warnmsg)
1315  end if
1316  end if
1317  !
1318  ! -- terminate if errors were encountered in the angledata block
1319  if (count_errors() > 0) then
1320  call this%parser%StoreErrorUnit()
1321  end if
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
real(dp), parameter dem6
real constant 1e-6
Definition: Constants.f90:109
pure logical function, public is_close(a, b, rtol, atol, symmetric)
Check if a real value is approximately equal to another.
Definition: MathUtil.f90:46
Here is the call graph for this function:

◆ maw_read_dimensions()

subroutine mawmodule::maw_read_dimensions ( class(mawtype), intent(inout)  this)

Definition at line 1373 of file gwf-maw.f90.

1374  use constantsmodule, only: linelength
1375  ! -- dummy
1376  class(MawType), intent(inout) :: this
1377  ! -- local
1378  character(len=LENBOUNDNAME) :: keyword
1379  integer(I4B) :: ierr
1380  logical :: isfound, endOfBlock
1381  ! -- format
1382  !
1383  ! -- initialize dimensions to -1
1384  this%nmawwells = -1
1385  this%maxbound = -1
1386  !
1387  ! -- get dimensions block
1388  call this%parser%GetBlock('DIMENSIONS', isfound, ierr, &
1389  supportopenclose=.true.)
1390  !
1391  ! -- parse dimensions block if detected
1392  if (isfound) then
1393  write (this%iout, '(/1x,a)') &
1394  'PROCESSING '//trim(adjustl(this%text))//' DIMENSIONS'
1395  do
1396  call this%parser%GetNextLine(endofblock)
1397  if (endofblock) exit
1398  call this%parser%GetStringCaps(keyword)
1399  select case (keyword)
1400  case ('NMAWWELLS')
1401  this%nmawwells = this%parser%GetInteger()
1402  write (this%iout, '(4x,a,i0)') 'NMAWWELLS = ', this%nmawwells
1403  case default
1404  write (errmsg, '(3a)') &
1405  'Unknown '//trim(this%text)//' dimension: ', trim(keyword), '.'
1406  call store_error(errmsg)
1407  end select
1408  end do
1409  write (this%iout, '(1x,a)') &
1410  'END OF '//trim(adjustl(this%text))//' DIMENSIONS'
1411  else
1412  call store_error('Required dimensions block not found.', terminate=.true.)
1413  end if
1414  !
1415  ! -- verify dimensions were set correctly
1416  if (this%nmawwells < 0) then
1417  write (errmsg, '(a)') &
1418  'NMAWWELLS was not specified or was specified incorrectly.'
1419  call store_error(errmsg)
1420  end if
1421  !
1422  ! -- stop if errors were encountered in the DIMENSIONS block
1423  if (count_errors() > 0) then
1424  call this%parser%StoreErrorUnit()
1425  end if
1426  !
1427  ! -- read wells block
1428  call this%maw_read_wells()
1429  !
1430  ! -- read well_connections block
1431  call this%maw_read_well_connections()
1432  !
1433  ! -- read optional angledata block (non-vertical well connections)
1434  call this%maw_read_angledata()
1435  !
1436  ! -- Call define_listlabel to construct the list label that is written
1437  ! when PRINT_INPUT option is used.
1438  call this%define_listlabel()
1439  !
1440  ! -- setup the budget object
1441  call this%maw_setup_budobj()
1442  !
1443  ! -- setup the head table object
1444  call this%maw_setup_tableobj()
Here is the call graph for this function:

◆ maw_read_initial_attr()

subroutine mawmodule::maw_read_initial_attr ( class(mawtype), intent(inout)  this)

Definition at line 1449 of file gwf-maw.f90.

1450  ! -- modules
1451  use constantsmodule, only: linelength
1452  use memorymanagermodule, only: mem_setptr
1453  ! -- dummy
1454  class(MawType), intent(inout) :: this
1455  ! -- local
1456  character(len=LINELENGTH) :: title
1457  character(len=LINELENGTH) :: text
1458  integer(I4B) :: ntabcols
1459  integer(I4B) :: j
1460  integer(I4B) :: n
1461  integer(I4B) :: nn
1462  integer(I4B) :: jpos
1463  integer(I4B) :: inode
1464  integer(I4B) :: idx
1465  real(DP) :: k11
1466  real(DP) :: k22
1467  character(len=10), dimension(0:4) :: ccond
1468  character(len=30) :: nodestr
1469  ! -- data
1470  data ccond(0)/'SPECIFIED '/
1471  data ccond(1)/'THIEM '/
1472  data ccond(2)/'SKIN '/
1473  data ccond(3)/'CUMULATIVE'/
1474  data ccond(4)/'MEAN '/
1475  ! -- format
1476  character(len=*), parameter :: fmtwelln = &
1477  "(1X,//43X,'MULTI-AQUIFER WELL DATA'&
1478  &/1X,109('-'),&
1479  &/1X,7(A10,1X),A16)"
1480  character(len=*), parameter :: fmtwelld = &
1481  &"(1X,I10,1X,4(G10.3,1X),I10,1X,A10,1X,A16)"
1482  character(len=*), parameter :: fmtline = &
1483  &"(1X,119('-'),//)"
1484  character(len=*), parameter :: fmtwellcn = &
1485  "(1X,//37X,'MULTI-AQUIFER WELL CONNECTION DATA'&
1486  &/1X,119('-'),&
1487  &/1X,2(A10,1X),A20,7(A10,1X))"
1488  character(len=*), parameter :: fmtwellcd = &
1489  &"(1X,2(I10,1X),A20,1X,2(G10.3,1X),2(A10,1X),3(G10.3,1X))"
1490  !
1491  ! -- initialize xnewpak
1492  do n = 1, this%nmawwells
1493  this%xnewpak(n) = this%strt(n)
1494  this%xsto(n) = this%strt(n)
1495  end do
1496  !
1497  ! -- initialize status (iboundpak) of maw wells to active
1498  do n = 1, this%nmawwells
1499  select case (this%status(n))
1500  case ('CONSTANT')
1501  this%iboundpak(n) = -1
1502  case ('INACTIVE')
1503  this%iboundpak(n) = 0
1504  case ('ACTIVE')
1505  this%iboundpak(n) = 1
1506  end select
1507  end do
1508  !
1509  ! -- set imap and boundname for each connection
1510  if (this%inamedbound /= 0) then
1511  idx = 0
1512  do n = 1, this%nmawwells
1513  do j = 1, this%ngwfnodes(n)
1514  idx = idx + 1
1515  this%boundname(idx) = this%cmawname(n)
1516  this%imap(idx) = n
1517  end do
1518  end do
1519  else
1520  do n = 1, this%nmawwells
1521  this%cmawname(n) = ''
1522  end do
1523  end if
1524  !
1525  ! -- copy boundname into boundname_cst
1526  call this%copy_boundname()
1527  !
1528  ! -- set pointer to gwf iss and gwf hk
1529  call mem_setptr(this%gwfiss, 'ISS', create_mem_path(this%name_model))
1530  call mem_setptr(this%gwfk11, 'K11', create_mem_path(this%name_model, 'NPF'))
1531  call mem_setptr(this%gwfk22, 'K22', create_mem_path(this%name_model, 'NPF'))
1532  call mem_setptr(this%gwfik22, 'IK22', create_mem_path(this%name_model, 'NPF'))
1533  call mem_setptr(this%gwfsat, 'SAT', create_mem_path(this%name_model, 'NPF'))
1534  !
1535  ! -- qa data
1536  call this%maw_check_attributes()
1537  !
1538  ! -- Calculate the saturated conductance
1539  do n = 1, this%nmawwells
1540  !
1541  ! -- calculate saturated conductance only if CONDUCTANCE was not
1542  ! specified for each maw-gwf connection (CONDUCTANCE keyword).
1543  do j = 1, this%ngwfnodes(n)
1544  if (this%ieqn(n) /= 0) then
1545  inode = this%get_gwfnode(n, j)
1546  call this%maw_calculate_satcond(n, j, inode)
1547  end if
1548  end do
1549  end do
1550  !
1551  ! -- write summary of static well data
1552  ! -- write well data
1553  if (this%iprpak /= 0) then
1554  ntabcols = 7
1555  if (this%inamedbound /= 0) then
1556  ntabcols = ntabcols + 1
1557  end if
1558  title = trim(adjustl(this%text))//' PACKAGE ('// &
1559  trim(adjustl(this%packName))//') STATIC WELL DATA'
1560  call table_cr(this%inputtab, this%packName, title)
1561  call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
1562  text = 'NUMBER'
1563  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1564  text = 'RADIUS'
1565  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1566  text = 'AREA'
1567  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1568  text = 'WELL BOTTOM'
1569  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1570  text = 'STARTING HEAD'
1571  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1572  text = 'NUMBER OF GWF NODES'
1573  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1574  text = 'CONDUCT. EQUATION'
1575  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1576  if (this%inamedbound /= 0) then
1577  text = 'NAME'
1578  call this%inputtab%initialize_column(text, 20, alignment=tableft)
1579  end if
1580  do n = 1, this%nmawwells
1581  call this%inputtab%add_term(n)
1582  call this%inputtab%add_term(this%radius(n))
1583  call this%inputtab%add_term(this%area(n))
1584  call this%inputtab%add_term(this%bot(n))
1585  call this%inputtab%add_term(this%strt(n))
1586  call this%inputtab%add_term(this%ngwfnodes(n))
1587  call this%inputtab%add_term(ccond(this%ieqn(n)))
1588  if (this%inamedbound /= 0) then
1589  call this%inputtab%add_term(this%cmawname(n))
1590  end if
1591  end do
1592  end if
1593  !
1594  ! -- write well connection data
1595  if (this%iprpak /= 0) then
1596  ntabcols = 10
1597  if (this%inonvert /= 0) then
1598  ntabcols = ntabcols + 1
1599  end if
1600  title = trim(adjustl(this%text))//' PACKAGE ('// &
1601  trim(adjustl(this%packName))//') STATIC WELL CONNECTION DATA'
1602  call table_cr(this%inputtab, this%packName, title)
1603  call this%inputtab%table_df(this%maxbound, ntabcols, this%iout)
1604  text = 'NUMBER'
1605  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1606  text = 'WELL CONNECTION'
1607  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1608  text = 'CELLID'
1609  call this%inputtab%initialize_column(text, 20, alignment=tableft)
1610  text = 'TOP OF SCREEN'
1611  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1612  text = 'BOTTOM OF SCREEN'
1613  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1614  text = 'SKIN RADIUS'
1615  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1616  text = 'SKIN K'
1617  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1618  text = 'K11'
1619  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1620  text = 'K22'
1621  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1622  text = 'SATURATED WELL CONDUCT.'
1623  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1624  if (this%inonvert /= 0) then
1625  text = 'ANGLE (DEG)'
1626  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
1627  end if
1628  !
1629  ! -- write the data to the table
1630  do n = 1, this%nmawwells
1631  do j = 1, this%ngwfnodes(n)
1632  call this%inputtab%add_term(n)
1633  call this%inputtab%add_term(j)
1634  jpos = this%get_jpos(n, j)
1635  nn = this%get_gwfnode(n, j)
1636  call this%dis%noder_to_string(nn, nodestr)
1637  call this%inputtab%add_term(nodestr)
1638  call this%inputtab%add_term(this%topscrn(jpos))
1639  call this%inputtab%add_term(this%botscrn(jpos))
1640  if (this%ieqn(n) == 2 .or. &
1641  this%ieqn(n) == 3 .or. &
1642  this%ieqn(n) == 4) then
1643  call this%inputtab%add_term(this%sradius(jpos))
1644  call this%inputtab%add_term(this%hk(jpos))
1645  else
1646  call this%inputtab%add_term(' ')
1647  call this%inputtab%add_term(' ')
1648  end if
1649  if (this%ieqn(n) == 1 .or. &
1650  this%ieqn(n) == 2 .or. &
1651  this%ieqn(n) == 3) then
1652  k11 = this%gwfk11(nn)
1653  if (this%gwfik22 == 0) then
1654  k22 = this%gwfk11(nn)
1655  else
1656  k22 = this%gwfk22(nn)
1657  end if
1658  call this%inputtab%add_term(k11)
1659  call this%inputtab%add_term(k22)
1660  else
1661  call this%inputtab%add_term(' ')
1662  call this%inputtab%add_term(' ')
1663  end if
1664  call this%inputtab%add_term(this%satcond(jpos))
1665  if (this%inonvert /= 0) then
1666  call this%inputtab%add_term(this%angle(jpos))
1667  end if
1668  end do
1669  end do
1670  end if
1671  !
1672  ! -- finished with pointer to gwf hydraulic conductivity
1673  this%gwfk11 => null()
1674  this%gwfk22 => null()
1675  this%gwfik22 => null()
1676  this%gwfsat => null()
1677  !
1678  ! -- check for any error conditions
1679  if (count_errors() > 0) then
1680  call store_error_unit(this%inunit)
1681  end if
Here is the call graph for this function:

◆ maw_read_options()

subroutine mawmodule::maw_read_options ( class(mawtype), intent(inout)  this,
character(len=*), intent(inout)  option,
logical, intent(inout)  found 
)

Overrides BndTypebnd_options

Definition at line 2001 of file gwf-maw.f90.

2003  use openspecmodule, only: access, form
2005  ! -- dummy
2006  class(MawType), intent(inout) :: this
2007  character(len=*), intent(inout) :: option
2008  logical, intent(inout) :: found
2009  ! -- local
2010  character(len=MAXCHARLEN) :: fname, keyword
2011  ! -- formats
2012  character(len=*), parameter :: fmtflowingwells = &
2013  &"(4x, 'FLOWING WELLS WILL BE SIMULATED.')"
2014  character(len=*), parameter :: fmtshutdown = &
2015  &"(4x, 'SHUTDOWN ', a, ' VALUE (',g15.7,') SPECIFIED.')"
2016  character(len=*), parameter :: fmtnostoragewells = &
2017  &"(4x, 'WELL STORAGE WILL NOT BE SIMULATED.')"
2018  character(len=*), parameter :: fmtmawbin = &
2019  "(4x, 'MAW ', 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, /4x, &
2020  &'OPENED ON UNIT: ', I0)"
2021  !
2022  ! -- Check for 'FLOWING_WELLS' and set this%iflowingwells
2023  found = .true.
2024  select case (option)
2025  case ('PRINT_HEAD')
2026  this%iprhed = 1
2027  write (this%iout, '(4x,a)') &
2028  trim(adjustl(this%text))//' heads will be printed to listing file.'
2029  case ('HEAD')
2030  call this%parser%GetStringCaps(keyword)
2031  if (keyword == 'FILEOUT') then
2032  call this%parser%GetString(fname)
2033  call assign_iounit(this%iheadout, this%inunit, "HEAD fileout")
2034  call openfile(this%iheadout, this%iout, fname, 'DATA(BINARY)', &
2035  form, access, 'REPLACE', mode_opt=mnormal)
2036  write (this%iout, fmtmawbin) 'HEAD', trim(adjustl(fname)), &
2037  this%iheadout
2038  else
2039  call store_error('Optional maw stage keyword must be '// &
2040  'followed by fileout.')
2041  end if
2042  case ('BUDGET')
2043  call this%parser%GetStringCaps(keyword)
2044  if (keyword == 'FILEOUT') then
2045  call this%parser%GetString(fname)
2046  call assign_iounit(this%ibudgetout, this%inunit, "BUDGET fileout")
2047  call openfile(this%ibudgetout, this%iout, fname, 'DATA(BINARY)', &
2048  form, access, 'REPLACE', mode_opt=mnormal)
2049  write (this%iout, fmtmawbin) 'BUDGET', trim(adjustl(fname)), &
2050  this%ibudgetout
2051  else
2052  call store_error('Optional maw budget keyword must be '// &
2053  'followed by fileout.')
2054  end if
2055  case ('BUDGETCSV')
2056  call this%parser%GetStringCaps(keyword)
2057  if (keyword == 'FILEOUT') then
2058  call this%parser%GetString(fname)
2059  call assign_iounit(this%ibudcsv, this%inunit, "BUDGETCSV fileout")
2060  call openfile(this%ibudcsv, this%iout, fname, 'CSV', &
2061  filstat_opt='REPLACE')
2062  write (this%iout, fmtmawbin) 'BUDGET CSV', trim(adjustl(fname)), &
2063  this%ibudcsv
2064  else
2065  call store_error('OPTIONAL BUDGETCSV KEYWORD MUST BE FOLLOWED BY &
2066  &FILEOUT')
2067  end if
2068  case ('FLOWING_WELLS')
2069  this%iflowingwells = 1
2070  write (this%iout, fmtflowingwells)
2071  case ('SHUTDOWN_THETA')
2072  this%theta = this%parser%GetDouble()
2073  write (this%iout, fmtshutdown) 'THETA', this%theta
2074  case ('SHUTDOWN_KAPPA')
2075  this%kappa = this%parser%GetDouble()
2076  write (this%iout, fmtshutdown) 'KAPPA', this%kappa
2077  case ('MOVER')
2078  this%imover = 1
2079  write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED'
2080  case ('NO_WELL_STORAGE')
2081  this%imawissopt = 1
2082  write (this%iout, fmtnostoragewells)
2083  case ('NON_VERTICAL_WELLS')
2084  this%inonvert = 1
2085  write (this%iout, '(4x,a)') &
2086  'NON-VERTICAL (SLANTED) MULTI-AQUIFER WELL CONNECTIONS WILL BE '// &
2087  'SIMULATED. SCREEN LENGTHS FOR CONNECTIONS LISTED IN THE ANGLEDATA '// &
2088  'BLOCK WILL BE USED TO CALCULATE THE SATURATED CONDUCTANCE.'
2089  case ('FLOW_CORRECTION')
2090  this%correct_flow = .true.
2091  write (this%iout, '(4x,a,/,4x,a)') &
2092  'MAW-GWF FLOW CORRECTIONS WILL BE APPLIED WHEN MAW HEADS ARE BELOW', &
2093  'OR GWF HEADS IN CONNECTED CELLS ARE BELOW THE CELL BOTTOM.'
2094  case ('MAW_FLOW_REDUCE_CSV')
2095  call this%parser%GetStringCaps(keyword)
2096  if (keyword == 'FILEOUT') then
2097  call this%parser%GetString(fname)
2098  call this%maw_redflow_csv_init(fname)
2099  else
2100  call store_error('OPTIONAL MAW_FLOW_REDUCE_CSV KEYWORD MUST BE &
2101  &FOLLOWED BY FILEOUT')
2102  end if
2103  !
2104  ! -- right now these are options that are only available in the
2105  ! development version and are not included in the documentation.
2106  ! These options are only available when IDEVELOPMODE in
2107  ! constants module is set to 1
2108  case ('DEV_PEACEMAN_EFFECTIVE_RADIUS')
2109  call this%parser%DevOpt()
2110  this%ieffradopt = 1
2111  write (this%iout, '(4x,a)') &
2112  'EFFECTIVE RADIUS FOR STRUCTURED GRIDS WILL BE CALCULATED &
2113  &USING PEACEMAN 1983'
2114  case default
2115  !
2116  ! -- No options found
2117  found = .false.
2118  end select
@ mnormal
normal output mode
Definition: Constants.f90:206
integer(i4b), parameter maxcharlen
maximum length of char string
Definition: Constants.f90:47
subroutine, public assign_iounit(iounit, errunit, description)
@ brief assign io unit number
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.
character(len=20) access
Definition: OpenSpec.f90:7
character(len=20) form
Definition: OpenSpec.f90:7
Here is the call graph for this function:

◆ maw_read_well_connections()

subroutine mawmodule::maw_read_well_connections ( class(mawtype), intent(inout)  this)

Definition at line 824 of file gwf-maw.f90.

825  use constantsmodule, only: linelength
826  ! -- dummy
827  class(MawType), intent(inout) :: this
828  ! -- local
829  character(len=LINELENGTH) :: cellid
830  character(len=30) :: nodestr
831  logical :: isfound
832  logical :: endOfBlock
833  integer(I4B) :: ierr
834  integer(I4B) :: ival
835  integer(I4B) :: j
836  integer(I4B) :: jj
837  integer(I4B) :: n
838  integer(I4B) :: nn
839  integer(I4B) :: nn2
840  integer(I4B) :: ipos
841  integer(I4B) :: jpos
842  integer(I4B) :: ireset_scrntop
843  integer(I4B) :: ireset_scrnbot
844  integer(I4B) :: ireset_wellbot
845  real(DP) :: rval
846  real(DP) :: topnn
847  real(DP) :: botnn
848  real(DP) :: botw
849  integer(I4B), dimension(:), pointer, contiguous :: nboundchk
850  integer(I4B), dimension(:), pointer, contiguous :: iachk
851  !
852  ! -- initialize counters
853  ireset_scrntop = 0
854  ireset_scrnbot = 0
855  ireset_wellbot = 0
856  !
857  ! -- allocate and initialize local storage
858  allocate (iachk(this%nmawwells + 1))
859  iachk(1) = 1
860  do n = 1, this%nmawwells
861  iachk(n + 1) = iachk(n) + this%ngwfnodes(n)
862  end do
863  allocate (nboundchk(this%maxbound))
864  do n = 1, this%maxbound
865  nboundchk(n) = 0
866  end do
867  !
868  ! -- get well_connections block
869  call this%parser%GetBlock('CONNECTIONDATA', isfound, ierr, &
870  supportopenclose=.true.)
871  !
872  ! -- parse well_connections block if detected
873  if (isfound) then
874  write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// &
875  ' CONNECTIONDATA'
876  do
877  call this%parser%GetNextLine(endofblock)
878  if (endofblock) exit
879  !
880  ! -- well number
881  ival = this%parser%GetInteger()
882  n = ival
883  !
884  ! -- check for error condition
885  if (n < 1 .or. n > this%nmawwells) then
886  write (errmsg, '(a,1x,i0,a)') &
887  'IMAW must be greater than 0 and less than or equal to ', &
888  this%nmawwells, '.'
889  call store_error(errmsg)
890  cycle
891  end if
892  !
893  ! -- read connection number
894  ival = this%parser%GetInteger()
895  if (ival < 1 .or. ival > this%ngwfnodes(n)) then
896  write (errmsg, '(a,1x,i0,1x,a,1x,i0,a)') &
897  'JCONN for well ', n, &
898  'must be greater than 1 and less than or equal to ', &
899  this%ngwfnodes(n), '.'
900  call store_error(errmsg)
901  cycle
902  end if
903 
904  ipos = iachk(n) + ival - 1
905  nboundchk(ipos) = nboundchk(ipos) + 1
906 
907  j = ival
908  jpos = this%get_jpos(n, ival)
909  !
910  ! -- read gwfnodes from the line
911  call this%parser%GetCellid(this%dis%ndim, cellid)
912  nn = this%dis%noder_from_cellid(cellid, this%inunit, this%iout)
913  topnn = this%dis%top(nn)
914  botnn = this%dis%bot(nn)
915  botw = this%bot(n)
916  !
917  ! -- set gwf node number for connection
918  this%gwfnodes(jpos) = nn
919  !
920  ! -- top of screen
921  rval = this%parser%GetDouble()
922  ! -- retain the user-specified screen top so a non-vertical SPECIFIED
923  ! connection can honor it (it is otherwise reset to the cell top)
924  this%usrtopscrn(jpos) = rval
925  if (this%ieqn(n) /= 4) then
926  rval = topnn
927  else
928  if (rval > topnn) then
929  ireset_scrntop = ireset_scrntop + 1
930  rval = topnn
931  end if
932  end if
933  this%topscrn(jpos) = rval
934  !
935  ! -- bottom of screen
936  rval = this%parser%GetDouble()
937  ! -- retain the user-specified screen bottom so a non-vertical SPECIFIED
938  ! connection can honor it (it is otherwise reset to the cell bottom)
939  this%usrbotscrn(jpos) = rval
940  if (this%ieqn(n) /= 4) then
941  rval = botnn
942  else
943  if (rval < botnn) then
944  ireset_scrnbot = ireset_scrnbot + 1
945  rval = botnn
946  end if
947  end if
948  this%botscrn(jpos) = rval
949  !
950  ! -- adjust the bottom of the well for all conductance approaches
951  ! except for "mean"
952  if (rval < botw) then
953  if (this%ieqn(n) /= 4) then
954  ireset_wellbot = ireset_wellbot + 1
955  botw = rval
956  this%bot(n) = rval
957  else
958  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
959  'Screen bottom for maw well', n, 'connection', j, '(', &
960  this%botscrn(jpos), ') is less than the well bottom (', &
961  this%bot(n), ').'
962  call store_error(errmsg)
963  end if
964  end if
965  !
966  ! -- hydraulic conductivity or conductance
967  rval = this%parser%GetDouble()
968  if (this%ieqn(n) == 0) then
969  this%satcond(jpos) = rval
970  else if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
971  this%ieqn(n) == 4) then
972  this%hk(jpos) = rval
973  end if
974  !
975  ! -- skin radius
976  rval = this%parser%GetDouble()
977  if (this%ieqn(n) == 2 .OR. this%ieqn(n) == 3 .OR. &
978  this%ieqn(n) == 4) then
979  this%sradius(jpos) = rval
980  if (this%sradius(jpos) <= this%radius(n)) then
981  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a,g0,a,g0,a)') &
982  'Screen radius for maw well', n, 'connection', j, '(', &
983  this%sradius(jpos), &
984  ') is less than or equal to the well radius (', &
985  this%radius(n), ').'
986  call store_error(errmsg)
987  end if
988  end if
989  end do
990  write (this%iout, '(1x,a)') &
991  'END OF '//trim(adjustl(this%text))//' CONNECTIONDATA'
992 
993  ipos = 0
994  do n = 1, this%nmawwells
995  do j = 1, this%ngwfnodes(n)
996  ipos = ipos + 1
997  !
998  ! -- check for missing or duplicate maw well connections
999  if (nboundchk(ipos) == 0) then
1000  write (errmsg, '(a,1x,i0,1x,a,1x,i0,a)') &
1001  'No data specified for maw well', n, 'connection', j, '.'
1002  call store_error(errmsg)
1003  else if (nboundchk(ipos) > 1) then
1004  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a,1x,i0,1x,a)') &
1005  'Data for maw well', n, 'connection', j, &
1006  'specified', nboundchk(n), 'times.'
1007  call store_error(errmsg)
1008  end if
1009  end do
1010  end do
1011  !
1012  ! -- make sure that more than one connection per cell is only specified
1013  ! wells using the mean conducance type
1014  do n = 1, this%nmawwells
1015  if (this%ieqn(n) /= 4) then
1016  do j = 1, this%ngwfnodes(n)
1017  nn = this%get_gwfnode(n, j)
1018  do jj = 1, this%ngwfnodes(n)
1019  !
1020  ! -- skip current maw node
1021  if (jj == j) then
1022  cycle
1023  end if
1024  nn2 = this%get_gwfnode(n, jj)
1025  if (nn2 == nn) then
1026  call this%dis%noder_to_string(nn, nodestr)
1027  write (errmsg, '(a,1x,i0,1x,a,1x,i0,3(1x,a))') &
1028  'Only one connection can be specified for maw well', &
1029  n, 'connection', j, 'to gwf cell', trim(adjustl(nodestr)), &
1030  'unless the mean condeqn is specified.'
1031  call store_error(errmsg)
1032  end if
1033  end do
1034  end do
1035  end if
1036  end do
1037  else
1038  call store_error('Required connectiondata block not found.')
1039  end if
1040  !
1041  ! -- deallocate local variable
1042  deallocate (iachk)
1043  deallocate (nboundchk)
1044  !
1045  ! -- add warning messages
1046  if (ireset_scrntop > 0) then
1047  write (warnmsg, '(a,1x,a,1x,a,1x,i0,1x,a)') &
1048  'The screen tops in multi-aquifer well package', trim(this%packName), &
1049  'were reset to the top of the connected cell', ireset_scrntop, 'times.'
1050  call store_warning(warnmsg)
1051  end if
1052  if (ireset_scrnbot > 0) then
1053  write (warnmsg, '(a,1x,a,1x,a,1x,i0,1x,a)') &
1054  'The screen bottoms in multi-aquifer well package', trim(this%packName), &
1055  'were reset to the bottom of the connected cell', ireset_scrnbot, &
1056  'times.'
1057  call store_warning(warnmsg)
1058  end if
1059  if (ireset_wellbot > 0) then
1060  write (warnmsg, '(a,1x,a,1x,a,1x,i0,1x,a)') &
1061  'The well bottoms in multi-aquifer well package', trim(this%packName), &
1062  'were reset to the bottom of the connected cell', ireset_wellbot, &
1063  'times.'
1064  call store_warning(warnmsg)
1065  end if
1066  !
1067  ! -- write summary of maw well_connection error messages
1068  if (count_errors() > 0) then
1069  call this%parser%StoreErrorUnit()
1070  end if
Here is the call graph for this function:

◆ maw_read_wells()

subroutine mawmodule::maw_read_wells ( class(mawtype), intent(inout)  this)

Definition at line 566 of file gwf-maw.f90.

567  use constantsmodule, only: linelength
569  ! -- dummy
570  class(MawType), intent(inout) :: this
571  ! -- local
572  character(len=LINELENGTH) :: text
573  character(len=LINELENGTH) :: keyword
574  character(len=LINELENGTH) :: cstr
575  character(len=LENBOUNDNAME) :: bndName
576  character(len=LENBOUNDNAME) :: bndNameTemp
577  character(len=9) :: cno
578  logical :: isfound
579  logical :: endOfBlock
580  integer(I4B) :: ival
581  integer(I4B) :: n
582  integer(I4B) :: j
583  integer(I4B) :: ii
584  integer(I4B) :: jj
585  integer(I4B) :: ieqn
586  integer(I4B) :: itmp
587  integer(I4B) :: ierr
588  integer(I4B) :: idx
589  real(DP) :: rval
590  real(DP), pointer :: bndElem => null()
591  ! -- local allocatable arrays
592  character(len=LINELENGTH), dimension(:), allocatable :: strttext
593  character(len=LENBOUNDNAME), dimension(:), allocatable :: nametxt
594  character(len=50), dimension(:, :), allocatable :: caux
595  integer(I4B), dimension(:), allocatable :: nboundchk
596  integer(I4B), dimension(:), allocatable :: wellieqn
597  integer(I4B), dimension(:), allocatable :: ngwfnodes
598  real(DP), dimension(:), allocatable :: radius
599  real(DP), dimension(:), allocatable :: bottom
600  ! -- format
601  character(len=*), parameter :: fmthdbot = &
602  "('well head (', G0, ') must be greater than or equal to the &
603  &BOTTOM_ELEVATION (', G0, ').')"
604  !
605  ! -- allocate and initialize temporary variables
606  allocate (strttext(this%nmawwells))
607  allocate (nametxt(this%nmawwells))
608  if (this%naux > 0) then
609  allocate (caux(this%naux, this%nmawwells))
610  end if
611  allocate (nboundchk(this%nmawwells))
612  allocate (wellieqn(this%nmawwells))
613  allocate (ngwfnodes(this%nmawwells))
614  allocate (radius(this%nmawwells))
615  allocate (bottom(this%nmawwells))
616  !
617  ! -- initialize temporary variables
618  do n = 1, this%nmawwells
619  nboundchk(n) = 0
620  end do
621  !
622  ! -- initialize itmp
623  itmp = 0
624  !
625  ! -- set npakeq to nmawwells
626  this%npakeq = this%nmawwells
627  !
628  ! -- read maw well data
629  ! -- get wells block
630  call this%parser%GetBlock('PACKAGEDATA', isfound, ierr, &
631  supportopenclose=.true.)
632  !
633  ! -- parse locations block if detected
634  if (isfound) then
635  write (this%iout, '(/1x,a)') &
636  'PROCESSING '//trim(adjustl(this%text))//' PACKAGEDATA'
637  do
638  call this%parser%GetNextLine(endofblock)
639  if (endofblock) exit
640  ival = this%parser%GetInteger()
641  n = ival
642 
643  if (n < 1 .or. n > this%nmawwells) then
644  write (errmsg, '(a,1x,i0,a)') &
645  'IMAW must be greater than 0 and less than or equal to', &
646  this%nmawwells, '.'
647  call store_error(errmsg)
648  cycle
649  end if
650  !
651  ! -- increment nboundchk
652  nboundchk(n) = nboundchk(n) + 1
653  !
654  ! -- radius
655  rval = this%parser%GetDouble()
656  if (rval <= dzero) then
657  write (errmsg, '(a,1x,i0,1x,a)') &
658  'Radius for well', n, 'must be greater than zero.'
659  call store_error(errmsg)
660  end if
661  radius(n) = rval
662  !
663  ! -- well bottom
664  bottom(n) = this%parser%GetDouble()
665  !
666  ! -- strt
667  call this%parser%GetString(strttext(n))
668  !
669  ! -- ieqn
670  call this%parser%GetStringCaps(keyword)
671  if (keyword == 'SPECIFIED') then
672  ieqn = 0
673  else if (keyword == 'THIEM') then
674  ieqn = 1
675  else if (keyword == 'THEIM') then ! # codespell:ignore
676  ieqn = 1
677  write (warnmsg, '(a,a,a,a,a,a)') &
678  "CONDEQN in '", trim(this%packName), "' should be ", &
679  "corrected from '", trim(keyword), "' to 'THIEM'."
680  call store_warning(warnmsg)
681  else if (keyword == 'SKIN') then
682  ieqn = 2
683  else if (keyword == 'CUMULATIVE') then
684  ieqn = 3
685  else if (keyword == 'MEAN') then
686  ieqn = 4
687  else
688  write (errmsg, '(a,1x,i0,1x,a)') &
689  'CONDEQN for well', n, &
690  "must be 'CUMULATIVE', 'THIEM', 'MEAN', or 'SKIN'."
691  end if
692  wellieqn(n) = ieqn
693  !
694  ! -- ngwnodes
695  ival = this%parser%GetInteger()
696  if (ival < 1) then
697  ival = 0
698  write (errmsg, '(a,1x,i0,1x,a)') &
699  'NGWFNODES for well', n, 'must be greater than zero.'
700  call store_error(errmsg)
701  end if
702 
703  if (ival > 0) then
704  ngwfnodes(n) = ival
705  end if
706  !
707  ! -- increment maxbound
708  itmp = itmp + ival
709  !
710  ! -- get aux data
711  do jj = 1, this%naux
712  call this%parser%GetString(caux(jj, n))
713  end do
714  !
715  ! -- set default bndName
716  write (cno, '(i9.9)') n
717  bndname = 'MAWWELL'//cno
718  !
719  ! -- read well name
720  if (this%inamedbound /= 0) then
721  call this%parser%GetStringCaps(bndnametemp)
722  if (bndnametemp /= '') then
723  bndname = bndnametemp
724  end if
725  end if
726  nametxt(n) = bndname
727  end do
728 
729  write (this%iout, '(1x,a)') &
730  'END OF '//trim(adjustl(this%text))//' PACKAGEDATA'
731  !
732  ! -- check for duplicate or missing wells
733  do n = 1, this%nmawwells
734  if (nboundchk(n) == 0) then
735  write (errmsg, '(a,1x,i0,a)') 'No data specified for maw well', n, '.'
736  call store_error(errmsg)
737  else if (nboundchk(n) > 1) then
738  write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') &
739  'Data for maw well', n, 'specified', nboundchk(n), 'times.'
740  call store_error(errmsg)
741  end if
742  end do
743  else
744  call store_error('Required packagedata block not found.')
745  end if
746  !
747  ! -- terminate if any errors were detected
748  if (count_errors() > 0) then
749  call this%parser%StoreErrorUnit()
750  end if
751  !
752  ! -- set MAXBOUND
753  this%maxbound = itmp
754  write (this%iout, '(//4x,a,i7)') 'MAXBOUND = ', this%maxbound
755  !
756  ! -- allocate well and connection data
757  call this%maw_allocate_well_conn_arrays()
758  !
759  ! -- fill well data with data stored in temporary local arrays
760  do n = 1, this%nmawwells
761  rval = radius(n)
762  this%radius(n) = rval
763  this%area(n) = dpi * rval**dtwo
764  this%bot(n) = bottom(n)
765  this%ieqn(n) = wellieqn(n)
766  this%ngwfnodes(n) = ngwfnodes(n)
767  this%cmawname(n) = nametxt(n)
768  !
769  ! fill timeseries aware data
770  !
771  ! -- well_head and strt
772  jj = 1 ! For WELL_HEAD
773  bndelem => this%well_head(n)
774  call read_value_or_time_series_adv(strttext(n), n, jj, bndelem, &
775  this%packName, 'BND', this%tsManager, &
776  this%iprpak, 'WELL_HEAD')
777  !
778  ! -- set starting head value
779  this%strt(n) = this%well_head(n)
780  !
781  ! -- check for error condition
782  if (this%strt(n) < this%bot(n)) then
783  write (cstr, fmthdbot) this%strt(n), this%bot(n)
784  call this%maw_set_attribute_error(n, 'STRT', trim(cstr))
785  end if
786  !
787  ! -- fill aux data
788  do jj = 1, this%naux
789  text = caux(jj, n)
790  ii = n
791  bndelem => this%mauxvar(jj, ii)
792  call read_value_or_time_series_adv(text, ii, jj, bndelem, this%packName, &
793  'AUX', this%tsManager, this%iprpak, &
794  this%auxname(jj))
795  end do
796  end do
797  !
798  ! -- set iaconn and imap for each connection
799  idx = 0
800  this%iaconn(1) = 1
801  do n = 1, this%nmawwells
802  do j = 1, this%ngwfnodes(n)
803  idx = idx + 1
804  this%imap(idx) = n
805  end do
806  this%iaconn(n + 1) = idx + 1
807  end do
808  !
809  ! -- deallocate local storage
810  deallocate (strttext)
811  deallocate (nametxt)
812  if (this%naux > 0) then
813  deallocate (caux)
814  end if
815  deallocate (nboundchk)
816  deallocate (wellieqn)
817  deallocate (ngwfnodes)
818  deallocate (radius)
819  deallocate (bottom)
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).
Here is the call graph for this function:

◆ maw_redflow_csv_init()

subroutine mawmodule::maw_redflow_csv_init ( class(mawtype), intent(inout)  this,
character(len=*), intent(in)  fname 
)
private
Parameters
[in,out]thisMawType object

Definition at line 3928 of file gwf-maw.f90.

3929  ! -- dummy variables
3930  class(MawType), intent(inout) :: this !< MawType object
3931  character(len=*), intent(in) :: fname
3932  ! -- format
3933  character(len=*), parameter :: fmtredflowcsv = &
3934  "(4x, 'MAW REDUCED FLOW INFORMATION WILL BE SAVED TO FILE: ', a, /4x, &
3935  &'OPENED ON UNIT: ', I0)"
3936 
3937  this%ioutredflowcsv = getunit()
3938  call openfile(this%ioutredflowcsv, this%iout, fname, 'CSV', &
3939  filstat_opt='REPLACE')
3940  write (this%iout, fmtredflowcsv) trim(adjustl(fname)), &
3941  this%ioutredflowcsv
3942  write (this%ioutredflowcsv, '(a)') &
3943  'time,period,step,MAWnumber,rate-requested,rate-actual,maw-reduction'
Here is the call graph for this function:

◆ maw_redflow_csv_write()

subroutine mawmodule::maw_redflow_csv_write ( class(mawtype), intent(inout)  this)
private
Parameters
[in,out]thisMawType object

Definition at line 3948 of file gwf-maw.f90.

3949  ! -- modules
3950  use tdismodule, only: totim, kstp, kper
3951  ! -- dummy variables
3952  class(MawType), intent(inout) :: this !< MawType object
3953  ! -- local
3954  integer(I4B) :: n
3955  !integer(I4B) :: nodereduced
3956  !integer(I4B) :: nodeuser
3957  real(DP) :: v
3958  ! -- format
3959  do n = 1, this%nmawwells
3960  !
3961  ! -- test if node is constant or inactive
3962  if (this%status(n) .ne. 'ACTIVE') then
3963  cycle
3964  end if
3965  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
3966  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
3967  write (this%ioutredflowcsv, '(*(G0,:,","))') &
3968  totim, kper, kstp, n, this%rate(n), this%ratesim(n), v
3969  end if
3970  end do

◆ maw_rp()

subroutine mawmodule::maw_rp ( class(mawtype), intent(inout)  this)
private

Read itmp and new boundaries if itmp > 0

Definition at line 2155 of file gwf-maw.f90.

2156  use constantsmodule, only: linelength
2157  use tdismodule, only: kper, nper
2158  ! -- dummy
2159  class(MawType), intent(inout) :: this
2160  ! -- local
2161  character(len=LINELENGTH) :: title
2162  character(len=LINELENGTH) :: line
2163  character(len=LINELENGTH) :: text
2164  character(len=16) :: csteady
2165  logical :: isfound
2166  logical :: endOfBlock
2167  integer(I4B) :: ierr
2168  integer(I4B) :: node
2169  integer(I4B) :: n
2170  integer(I4B) :: ntabcols
2171  integer(I4B) :: ntabrows
2172  integer(I4B) :: imaw
2173  integer(I4B) :: ibnd
2174  integer(I4B) :: j
2175  integer(I4B) :: jpos
2176  integer(I4B) :: iheadlimit_warning
2177  ! -- formats
2178  character(len=*), parameter :: fmtblkerr = &
2179  &"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
2180  character(len=*), parameter :: fmtlsp = &
2181  &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
2182  !
2183  ! -- initialize counters
2184  iheadlimit_warning = 0
2185  !
2186  ! -- set steady-state flag based on gwfiss
2187  this%imawiss = this%gwfiss
2188  !
2189  ! -- reset maw steady flag if 'STEADY-STATE' specified in the OPTIONS block
2190  if (this%imawissopt == 1) then
2191  this%imawiss = 1
2192  end if
2193  !
2194  ! -- set nbound to maxbound
2195  this%nbound = this%maxbound
2196  !
2197  ! -- Set ionper to the stress period number for which a new block of data
2198  ! will be read.
2199  if (this%inunit == 0) return
2200  !
2201  ! -- get stress period data
2202  if (this%ionper < kper) then
2203  !
2204  ! -- get period block
2205  call this%parser%GetBlock('PERIOD', isfound, ierr, &
2206  supportopenclose=.true., &
2207  blockrequired=.false.)
2208  if (isfound) then
2209  !
2210  ! -- read ionper and check for increasing period numbers
2211  call this%read_check_ionper()
2212  else
2213  !
2214  ! -- PERIOD block not found
2215  if (ierr < 0) then
2216  ! -- End of file found; data applies for remainder of simulation.
2217  this%ionper = nper + 1
2218  else
2219  ! -- Found invalid block
2220  call this%parser%GetCurrentLine(line)
2221  write (errmsg, fmtblkerr) adjustl(trim(line))
2222  call store_error(errmsg, terminate=.true.)
2223  end if
2224  end if
2225  end if
2226  !
2227  ! -- Read data if ionper == kper
2228  if (this%ionper == kper) then
2229  !
2230  ! -- setup table for period data
2231  if (this%iprpak /= 0) then
2232  !
2233  ! -- reset the input table object
2234  title = trim(adjustl(this%text))//' PACKAGE ('// &
2235  trim(adjustl(this%packName))//') DATA FOR PERIOD'
2236  write (title, '(a,1x,i6)') trim(adjustl(title)), kper
2237  call table_cr(this%inputtab, this%packName, title)
2238  call this%inputtab%table_df(1, 5, this%iout, finalize=.false.)
2239  text = 'NUMBER'
2240  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2241  text = 'KEYWORD'
2242  call this%inputtab%initialize_column(text, 20, alignment=tableft)
2243  do n = 1, 3
2244  write (text, '(a,1x,i6)') 'VALUE', n
2245  call this%inputtab%initialize_column(text, 15, alignment=tabcenter)
2246  end do
2247  end if
2248  !
2249  ! -- set flag to check attributes
2250  this%check_attr = 1
2251  do
2252  call this%parser%GetNextLine(endofblock)
2253  if (endofblock) exit
2254 
2255  imaw = this%parser%GetInteger()
2256  if (imaw < 1 .or. imaw > this%nmawwells) then
2257  write (errmsg, '(2(a,1x),i0,a)') &
2258  'IMAW must be greater than 0 and', &
2259  'less than or equal to ', this%nmawwells, '.'
2260  call store_error(errmsg)
2261  cycle
2262  end if
2263  !
2264  ! -- set stress period data
2265  call this%maw_set_stressperiod(imaw, iheadlimit_warning)
2266  !
2267  ! -- write line to table
2268  if (this%iprpak /= 0) then
2269  call this%parser%GetCurrentLine(line)
2270  call this%inputtab%line_to_columns(line)
2271  end if
2272  end do
2273  if (this%iprpak /= 0) then
2274  call this%inputtab%finalize_table()
2275  end if
2276  !
2277  ! -- using data from the last stress period
2278  else
2279  write (this%iout, fmtlsp) trim(this%filtyp)
2280  end if
2281  !
2282  ! -- issue warning messages
2283  if (iheadlimit_warning > 0) then
2284  write (warnmsg, '(a,a,a,1x,a,1x,a)') &
2285  "HEAD_LIMIT in '", trim(this%packName), "' was below the well bottom", &
2286  "for one or more multi-aquifer well(s). This may result in", &
2287  "convergence failures for some models."
2288  call store_warning(warnmsg, substring=warnmsg(:50))
2289  end if
2290  !
2291  ! -- write summary of maw well stress period error messages
2292  if (count_errors() > 0) then
2293  call this%parser%StoreErrorUnit()
2294  end if
2295  !
2296  ! -- qa data if necessary
2297  if (this%check_attr /= 0) then
2298  call this%maw_check_attributes()
2299 
2300  ! -- write summary of stress period data for MAW
2301  if (this%iprpak == 1) then
2302  if (this%imawiss /= 0) then
2303  csteady = 'STEADY-STATE '
2304  else
2305  csteady = 'TRANSIENT '
2306  end if
2307  !
2308  ! -- reset the input table object for rate data
2309  title = trim(adjustl(this%text))//' PACKAGE ('// &
2310  trim(adjustl(this%packName))//') '//trim(adjustl(csteady))// &
2311  ' RATE DATA FOR PERIOD'
2312  write (title, '(a,1x,i6)') trim(adjustl(title)), kper
2313  ntabcols = 6
2314  call table_cr(this%inputtab, this%packName, title)
2315  call this%inputtab%table_df(this%nmawwells, ntabcols, this%iout)
2316  text = 'NUMBER'
2317  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2318  text = 'STATUS'
2319  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2320  text = 'RATE'
2321  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2322  text = 'SPECIFIED HEAD'
2323  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2324  text = 'PUMP ELEVATION'
2325  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2326  text = 'REDUCTION LENGTH'
2327  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2328  do n = 1, this%nmawwells
2329  call this%inputtab%add_term(n)
2330  call this%inputtab%add_term(this%status(n))
2331  call this%inputtab%add_term(this%rate(n))
2332  if (this%iboundpak(n) < 0) then
2333  call this%inputtab%add_term(this%well_head(n))
2334  else
2335  call this%inputtab%add_term(' ')
2336  end if
2337  call this%inputtab%add_term(this%pumpelev(n))
2338  if (this%reduction_length(n) /= dep20) then
2339  call this%inputtab%add_term(this%reduction_length(n))
2340  else
2341  call this%inputtab%add_term(' ')
2342  end if
2343  end do
2344  !
2345  ! -- flowing wells
2346  if (this%iflowingwells > 0) then
2347  !
2348  ! -- reset the input table object for flowing well data
2349  title = trim(adjustl(this%text))//' PACKAGE ('// &
2350  trim(adjustl(this%packName))//') '//trim(adjustl(csteady))// &
2351  ' FLOWING WELL DATA FOR PERIOD'
2352  write (title, '(a,1x,i6)') trim(adjustl(title)), kper
2353  ntabcols = 4
2354  ntabrows = 0
2355  do n = 1, this%nmawwells
2356  if (this%fwcond(n) > dzero) then
2357  ntabrows = ntabrows + 1
2358  end if
2359  end do
2360  if (ntabrows > 0) then
2361  call table_cr(this%inputtab, this%packName, title)
2362  call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2363  text = 'NUMBER'
2364  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2365  text = 'ELEVATION'
2366  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2367  text = 'CONDUCT.'
2368  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2369  text = 'REDUCTION LENGTH'
2370  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2371  do n = 1, this%nmawwells
2372  if (this%fwcond(n) > dzero) then
2373  call this%inputtab%add_term(n)
2374  call this%inputtab%add_term(this%fwelev(n))
2375  call this%inputtab%add_term(this%fwcond(n))
2376  call this%inputtab%add_term(this%fwrlen(n))
2377  end if
2378  end do
2379  end if
2380  end if
2381  !
2382  ! -- reset the input table object for shutoff data
2383  title = trim(adjustl(this%text))//' PACKAGE ('// &
2384  trim(adjustl(this%packName))//') '//trim(adjustl(csteady))// &
2385  ' WELL SHUTOFF DATA FOR PERIOD'
2386  write (title, '(a,1x,i6)') trim(adjustl(title)), kper
2387  ntabcols = 4
2388  ntabrows = 0
2389  do n = 1, this%nmawwells
2390  if (this%shutofflevel(n) /= dep20) then
2391  ntabrows = ntabrows + 1
2392  end if
2393  end do
2394  if (ntabrows > 0) then
2395  call table_cr(this%inputtab, this%packName, title)
2396  call this%inputtab%table_df(ntabrows, ntabcols, this%iout)
2397  text = 'NUMBER'
2398  call this%inputtab%initialize_column(text, 10, alignment=tabcenter)
2399  text = 'ELEVATION'
2400  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2401  text = 'MINIMUM. Q'
2402  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2403  text = 'MAXIMUM Q'
2404  call this%inputtab%initialize_column(text, 12, alignment=tabcenter)
2405  do n = 1, this%nmawwells
2406  if (this%shutofflevel(n) /= dep20) then
2407  call this%inputtab%add_term(n)
2408  call this%inputtab%add_term(this%shutofflevel(n))
2409  call this%inputtab%add_term(this%shutoffmin(n))
2410  call this%inputtab%add_term(this%shutoffmax(n))
2411  end if
2412  end do
2413  end if
2414  end if
2415  end if
2416  !
2417  ! -- fill arrays
2418  ibnd = 1
2419  do n = 1, this%nmawwells
2420  do j = 1, this%ngwfnodes(n)
2421  jpos = this%get_jpos(n, j)
2422  node = this%get_gwfnode(n, j)
2423  this%nodelist(ibnd) = node
2424  this%bound(1, ibnd) = this%xnewpak(n)
2425  this%bound(2, ibnd) = this%satcond(jpos)
2426  this%bound(3, ibnd) = this%botscrn(jpos)
2427  if (this%iboundpak(n) > 0) then
2428  this%bound(4, ibnd) = this%rate(n)
2429  else
2430  this%bound(4, ibnd) = dzero
2431  end if
2432  ibnd = ibnd + 1
2433  end do
2434  end do
integer(i4b), pointer, public nper
number of stress period
Definition: tdis.f90:24
Here is the call graph for this function:

◆ maw_rp_obs()

subroutine mawmodule::maw_rp_obs ( class(mawtype), intent(inout)  this)
private

Only done the first stress period since boundaries are fixed for the simulation

Definition at line 3748 of file gwf-maw.f90.

3749  use tdismodule, only: kper
3750  ! -- dummy
3751  class(MawType), intent(inout) :: this
3752  ! -- local
3753  integer(I4B) :: i
3754  integer(I4B) :: j
3755  integer(I4B) :: n
3756  integer(I4B) :: nn1
3757  integer(I4B) :: nn2
3758  integer(I4B) :: jj
3759  character(len=LENBOUNDNAME) :: bname
3760  logical :: jfound
3761  class(ObserveType), pointer :: obsrv => null()
3762  ! -- formats
3763 10 format('Boundary "', a, '" for observation "', a, &
3764  '" is invalid in package "', a, '"')
3765  !
3766  if (kper == 1) then
3767  do i = 1, this%obs%npakobs
3768  obsrv => this%obs%pakobs(i)%obsrv
3769  !
3770  ! -- get node number 1
3771  nn1 = obsrv%NodeNumber
3772  if (nn1 == namedboundflag) then
3773  bname = obsrv%FeatureName
3774  if (bname /= '') then
3775  ! -- Observation maw is based on a boundary name.
3776  ! Iterate through all multi-aquifer wells to identify and store
3777  ! corresponding index in bound array.
3778  jfound = .false.
3779  if (obsrv%ObsTypeId == 'MAW' .or. &
3780  obsrv%ObsTypeId == 'CONDUCTANCE') then
3781  do j = 1, this%nmawwells
3782  do jj = this%iaconn(j), this%iaconn(j + 1) - 1
3783  if (this%boundname(jj) == bname) then
3784  jfound = .true.
3785  call obsrv%AddObsIndex(jj)
3786  end if
3787  end do
3788  end do
3789  else
3790  do j = 1, this%nmawwells
3791  if (this%cmawname(j) == bname) then
3792  jfound = .true.
3793  call obsrv%AddObsIndex(j)
3794  end if
3795  end do
3796  end if
3797  if (.not. jfound) then
3798  write (errmsg, 10) &
3799  trim(bname), trim(obsrv%Name), trim(this%packName)
3800  call store_error(errmsg)
3801  end if
3802  end if
3803  else
3804  if (obsrv%indxbnds_count == 0) then
3805  if (obsrv%ObsTypeId == 'MAW' .or. &
3806  obsrv%ObsTypeId == 'CONDUCTANCE') then
3807  nn2 = obsrv%NodeNumber2
3808  j = this%iaconn(nn1) + nn2 - 1
3809  call obsrv%AddObsIndex(j)
3810  else
3811  call obsrv%AddObsIndex(nn1)
3812  end if
3813  else
3814  errmsg = 'Programming error in maw_rp_obs'
3815  call store_error(errmsg)
3816  end if
3817  end if
3818  !
3819  ! -- catch non-cumulative observation assigned to observation defined
3820  ! by a boundname that is assigned to more than one element
3821  if (obsrv%ObsTypeId == 'HEAD') then
3822  if (obsrv%indxbnds_count > 1) then
3823  write (errmsg, '(a,3(1x,a))') &
3824  trim(adjustl(obsrv%ObsTypeId)), &
3825  'for observation', trim(adjustl(obsrv%Name)), &
3826  'must be assigned to a multi-aquifer well with a unique boundname.'
3827  call store_error(errmsg)
3828  end if
3829  end if
3830  !
3831  ! -- check that index values are valid
3832  if (obsrv%ObsTypeId == 'MAW' .or. &
3833  obsrv%ObsTypeId == 'CONDUCTANCE') then
3834  do j = 1, obsrv%indxbnds_count
3835  nn1 = obsrv%indxbnds(j)
3836  n = this%imap(nn1)
3837  nn2 = nn1 - this%iaconn(n) + 1
3838  jj = this%iaconn(n + 1) - this%iaconn(n)
3839  if (nn1 < 1 .or. nn1 > this%maxbound) then
3840  write (errmsg, '(3(a,1x),i0,1x,a,i0,a)') &
3841  trim(adjustl(obsrv%ObsTypeId)), &
3842  'multi-aquifer well connection number must be greater than 0', &
3843  'and less than', jj, '(specified value is ', nn2, ').'
3844  call store_error(errmsg)
3845  end if
3846  end do
3847  else
3848  do j = 1, obsrv%indxbnds_count
3849  nn1 = obsrv%indxbnds(j)
3850  if (nn1 < 1 .or. nn1 > this%nmawwells) then
3851  write (errmsg, '(3(a,1x),i0,1x,a,i0,a)') &
3852  trim(adjustl(obsrv%ObsTypeId)), &
3853  'multi-aquifer well must be greater than 0 ', &
3854  'and less than or equal to', this%nmawwells, &
3855  '(specified value is ', nn1, ').'
3856  call store_error(errmsg)
3857  end if
3858  end do
3859  end if
3860  end do
3861  !
3862  ! -- evaluate if there are any observation errors
3863  if (count_errors() > 0) then
3864  call store_error_unit(this%inunit)
3865  end if
3866  end if
Here is the call graph for this function:

◆ maw_set_attribute_error()

subroutine mawmodule::maw_set_attribute_error ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  imaw,
character(len=*), intent(in)  keyword,
character(len=*), intent(in)  msg 
)

Definition at line 1818 of file gwf-maw.f90.

1819  use simmodule, only: store_error
1820  ! -- dummy
1821  class(MawType), intent(inout) :: this
1822  integer(I4B), intent(in) :: imaw
1823  character(len=*), intent(in) :: keyword
1824  character(len=*), intent(in) :: msg
1825  ! -- local
1826  ! -- formats
1827  !
1828  if (len(msg) == 0) then
1829  write (errmsg, '(a,1x,a,1x,i0,1x,a)') &
1830  keyword, ' for MAW well', imaw, 'has already been set.'
1831  else
1832  write (errmsg, '(a,1x,a,1x,i0,1x,a)') &
1833  keyword, ' for MAW well', imaw, msg
1834  end if
1835  call store_error(errmsg)
Here is the call graph for this function:

◆ maw_set_pointers()

subroutine mawmodule::maw_set_pointers ( class(mawtype this,
integer(i4b), pointer  neq,
integer(i4b), dimension(:), pointer, contiguous  ibound,
real(dp), dimension(:), pointer, contiguous  xnew,
real(dp), dimension(:), pointer, contiguous  xold,
real(dp), dimension(:), pointer, contiguous  flowja 
)
private

Definition at line 3497 of file gwf-maw.f90.

3498  ! -- modules
3500  ! -- dummy
3501  class(MawType) :: this
3502  integer(I4B), pointer :: neq
3503  integer(I4B), dimension(:), pointer, contiguous :: ibound
3504  real(DP), dimension(:), pointer, contiguous :: xnew
3505  real(DP), dimension(:), pointer, contiguous :: xold
3506  real(DP), dimension(:), pointer, contiguous :: flowja
3507  ! -- local
3508  integer(I4B) :: n
3509  integer(I4B) :: istart, iend
3510  !
3511  ! -- call base BndType set_pointers
3512  call this%BndType%set_pointers(neq, ibound, xnew, xold, flowja)
3513  !
3514  ! -- Set the MAW pointers
3515  !
3516  ! -- set package pointers
3517  istart = this%dis%nodes + this%ioffset + 1
3518  iend = istart + this%nmawwells - 1
3519  this%iboundpak => this%ibound(istart:iend)
3520  this%xnewpak => this%xnew(istart:iend)
3521  call mem_checkin(this%xnewpak, 'HEAD', this%memoryPath, 'X', &
3522  this%memoryPathModel)
3523  call mem_allocate(this%xoldpak, this%nmawwells, 'XOLDPAK', this%memoryPath)
3524  !
3525  ! -- initialize xnewpak
3526  do n = 1, this%nmawwells
3527  this%xnewpak(n) = dep20
3528  end do

◆ maw_set_stressperiod()

subroutine mawmodule::maw_set_stressperiod ( class(mawtype), intent(inout)  this,
integer(i4b), intent(in)  imaw,
integer(i4b), intent(inout)  iheadlimit_warning 
)

Definition at line 1686 of file gwf-maw.f90.

1687  ! -- modules
1689  ! -- dummy
1690  class(MawType), intent(inout) :: this
1691  integer(I4B), intent(in) :: imaw
1692  integer(I4B), intent(inout) :: iheadlimit_warning
1693  ! -- local
1694  character(len=LINELENGTH) :: errmsgr
1695  character(len=LINELENGTH) :: text
1696  character(len=LINELENGTH) :: cstr
1697  character(len=LINELENGTH) :: caux
1698  character(len=LINELENGTH) :: keyword
1699  integer(I4B) :: ii
1700  integer(I4B) :: jj
1701  real(DP) :: rval
1702  real(DP), pointer :: bndElem => null()
1703  integer(I4B) :: istat
1704  ! -- formats
1705  character(len=*), parameter :: fmthdbot = &
1706  &"('well head (',G0,') must be >= BOTTOM_ELEVATION (',G0, ').')"
1707  !
1708  ! -- read remainder of variables on the line
1709  call this%parser%GetStringCaps(keyword)
1710  select case (keyword)
1711  case ('STATUS')
1712  call this%parser%GetStringCaps(text)
1713  this%status(imaw) = text(1:8)
1714  select case (text)
1715  case ('CONSTANT')
1716  this%iboundpak(imaw) = -1
1717  case ('INACTIVE')
1718  this%iboundpak(imaw) = 0
1719  case ('ACTIVE')
1720  this%iboundpak(imaw) = 1
1721  case default
1722  write (errmsg, '(2a)') &
1723  'Unknown '//trim(this%text)//" maw status keyword: '", &
1724  trim(text)//"'."
1725  call store_error(errmsg)
1726  end select
1727  case ('RATE')
1728  call this%parser%GetString(text)
1729  jj = 1 ! For RATE
1730  bndelem => this%rate(imaw)
1731  call read_value_or_time_series_adv(text, imaw, jj, bndelem, &
1732  this%packName, 'BND', this%tsManager, &
1733  this%iprpak, 'RATE')
1734  case ('WELL_HEAD')
1735  call this%parser%GetString(text)
1736  jj = 1 ! For WELL_HEAD
1737  bndelem => this%well_head(imaw)
1738  call read_value_or_time_series_adv(text, imaw, jj, bndelem, &
1739  this%packName, 'BND', this%tsManager, &
1740  this%iprpak, 'WELL_HEAD')
1741  !
1742  ! -- set xnewpak to well_head
1743  this%xnewpak(imaw) = this%well_head(imaw)
1744  !
1745  ! -- check for error condition
1746  if (this%well_head(imaw) < this%bot(imaw)) then
1747  write (cstr, fmthdbot) &
1748  this%well_head(imaw), this%bot(imaw)
1749  call this%maw_set_attribute_error(imaw, 'WELL HEAD', trim(cstr))
1750  end if
1751  case ('FLOWING_WELL')
1752  this%fwelev(imaw) = this%parser%GetDouble()
1753  this%fwcond(imaw) = this%parser%GetDouble()
1754  this%fwrlen(imaw) = this%parser%GetDouble()
1755  !
1756  ! -- test for condition where flowing well data is specified but
1757  ! flowing_wells is not specified in the options block
1758  if (this%iflowingwells == 0) then
1759  this%iflowingwells = -1
1760  text = 'Flowing well data is specified in the '//trim(this%packName)// &
1761  ' package but FLOWING_WELL was not specified in the '// &
1762  'OPTIONS block.'
1763  call store_warning(text)
1764  end if
1765  case ('RATE_SCALING')
1766  rval = this%parser%GetDouble()
1767  this%pumpelev(imaw) = rval
1768  rval = this%parser%GetDouble()
1769  this%reduction_length(imaw) = rval
1770  if (rval < dzero) then
1771  call this%maw_set_attribute_error(imaw, trim(keyword), &
1772  'must be greater than or equal to 0.')
1773  end if
1774  case ('HEAD_LIMIT')
1775  call this%parser%GetString(text)
1776  if (trim(text) == 'OFF') then
1777  this%shutofflevel(imaw) = dep20
1778  else
1779  read (text, *, iostat=istat, iomsg=errmsgr) &
1780  this%shutofflevel(imaw)
1781  if (istat /= 0) then
1782  errmsg = 'Could not read HEAD_LIMIT value. '//trim(errmsgr)
1783  call store_error(errmsg)
1784  end if
1785  if (this%shutofflevel(imaw) <= this%bot(imaw)) then
1786  iheadlimit_warning = iheadlimit_warning + 1
1787  end if
1788  end if
1789  case ('SHUT_OFF')
1790  rval = this%parser%GetDouble()
1791  this%shutoffmin(imaw) = rval
1792  rval = this%parser%GetDouble()
1793  this%shutoffmax(imaw) = rval
1794  case ('AUXILIARY')
1795  call this%parser%GetStringCaps(caux)
1796  do jj = 1, this%naux
1797  if (trim(adjustl(caux)) /= trim(adjustl(this%auxname(jj)))) cycle
1798  call this%parser%GetString(text)
1799  ii = imaw
1800  bndelem => this%mauxvar(jj, ii)
1801  call read_value_or_time_series_adv(text, ii, jj, bndelem, &
1802  this%packName, 'AUX', &
1803  this%tsManager, this%iprpak, &
1804  this%auxname(jj))
1805  exit
1806  end do
1807  case default
1808  write (errmsg, '(2a)') &
1809  'Unknown '//trim(this%text)//" maw data keyword: '", &
1810  trim(keyword)//"'."
1811  call store_error(errmsg)
1812  end select
1813 
Here is the call graph for this function:

◆ maw_setup_budobj()

subroutine mawmodule::maw_setup_budobj ( class(mawtype this)
private

Definition at line 4679 of file gwf-maw.f90.

4680  ! -- modules
4681  use constantsmodule, only: lenbudtxt
4682  ! -- dummy
4683  class(MawType) :: this
4684  ! -- local
4685  integer(I4B) :: nbudterm
4686  integer(I4B) :: n, j, n2
4687  real(DP) :: q
4688  integer(I4B) :: maxlist, naux
4689  integer(I4B) :: idx
4690  character(len=LENBUDTXT) :: text
4691  character(len=LENBUDTXT), dimension(1) :: auxtxt
4692  !
4693  ! -- Determine the number of maw budget terms. These are fixed for
4694  ! the simulation and cannot change.
4695  ! gwf rate [flowing_well] storage constant_flow [frommvr tomvr tomvrcf [tomvrfw]] [aux]
4696  nbudterm = 4
4697  if (this%iflowingwells > 0) then
4698  nbudterm = nbudterm + 1
4699  end if
4700  if (this%imover == 1) then
4701  nbudterm = nbudterm + 3
4702  if (this%iflowingwells > 0) then
4703  nbudterm = nbudterm + 1
4704  end if
4705  end if
4706  if (this%naux > 0) nbudterm = nbudterm + 1
4707  !
4708  ! -- set up budobj
4709  call budgetobject_cr(this%budobj, this%packName)
4710  call this%budobj%budgetobject_df(this%nmawwells, nbudterm, 0, 0, &
4711  ibudcsv=this%ibudcsv)
4712  idx = 0
4713  !
4714  ! -- Go through and set up each budget term
4715  !
4716  ! --
4717  text = ' GWF'
4718  idx = idx + 1
4719  maxlist = this%maxbound
4720  naux = 1
4721  auxtxt(1) = ' FLOW-AREA'
4722  call this%budobj%budterm(idx)%initialize(text, &
4723  this%name_model, &
4724  this%packName, &
4725  this%name_model, &
4726  this%name_model, &
4727  maxlist, .false., .true., &
4728  naux, auxtxt)
4729  call this%budobj%budterm(idx)%reset(this%maxbound)
4730  q = dzero
4731  do n = 1, this%nmawwells
4732  do j = 1, this%ngwfnodes(n)
4733  n2 = this%get_gwfnode(n, j)
4734  call this%budobj%budterm(idx)%update_term(n, n2, q)
4735  end do
4736  end do
4737  !
4738  ! --
4739  text = ' RATE'
4740  idx = idx + 1
4741  maxlist = this%nmawwells
4742  naux = 0
4743  call this%budobj%budterm(idx)%initialize(text, &
4744  this%name_model, &
4745  this%packName, &
4746  this%name_model, &
4747  this%packName, &
4748  maxlist, .false., .false., &
4749  naux)
4750  !
4751  ! --
4752  if (this%iflowingwells > 0) then
4753  text = ' FW-RATE'
4754  idx = idx + 1
4755  maxlist = this%nmawwells
4756  naux = 0
4757  call this%budobj%budterm(idx)%initialize(text, &
4758  this%name_model, &
4759  this%packName, &
4760  this%name_model, &
4761  this%packName, &
4762  maxlist, .false., .false., &
4763  naux)
4764  end if
4765  !
4766  ! --
4767  text = ' STORAGE'
4768  idx = idx + 1
4769  maxlist = this%nmawwells
4770  naux = 1
4771  auxtxt(1) = ' VOLUME'
4772  call this%budobj%budterm(idx)%initialize(text, &
4773  this%name_model, &
4774  this%packName, &
4775  this%name_model, &
4776  this%name_model, &
4777  maxlist, .false., .true., &
4778  naux, auxtxt)
4779  !
4780  ! --
4781  text = ' CONSTANT'
4782  idx = idx + 1
4783  maxlist = this%nmawwells
4784  naux = 0
4785  call this%budobj%budterm(idx)%initialize(text, &
4786  this%name_model, &
4787  this%packName, &
4788  this%name_model, &
4789  this%packName, &
4790  maxlist, .false., .false., &
4791  naux)
4792  !
4793  ! --
4794  if (this%imover == 1) then
4795  !
4796  ! --
4797  text = ' FROM-MVR'
4798  idx = idx + 1
4799  maxlist = this%nmawwells
4800  naux = 0
4801  call this%budobj%budterm(idx)%initialize(text, &
4802  this%name_model, &
4803  this%packName, &
4804  this%name_model, &
4805  this%packName, &
4806  maxlist, .false., .false., &
4807  naux)
4808  !
4809  ! --
4810  text = ' RATE-TO-MVR'
4811  idx = idx + 1
4812  maxlist = this%nmawwells
4813  naux = 0
4814  call this%budobj%budterm(idx)%initialize(text, &
4815  this%name_model, &
4816  this%packName, &
4817  this%name_model, &
4818  this%packName, &
4819  maxlist, .false., .false., &
4820  naux)
4821  !
4822  ! -- constant-head flow to mover
4823  text = ' CONSTANT-TO-MVR'
4824  idx = idx + 1
4825  maxlist = this%nmawwells
4826  naux = 0
4827  call this%budobj%budterm(idx)%initialize(text, &
4828  this%name_model, &
4829  this%packName, &
4830  this%name_model, &
4831  this%packName, &
4832  maxlist, .false., .false., &
4833  naux)
4834  !
4835  ! -- flowing-well flow to mover
4836  if (this%iflowingwells > 0) then
4837  !
4838  ! --
4839  text = ' FW-RATE-TO-MVR'
4840  idx = idx + 1
4841  maxlist = this%nmawwells
4842  naux = 0
4843  call this%budobj%budterm(idx)%initialize(text, &
4844  this%name_model, &
4845  this%packName, &
4846  this%name_model, &
4847  this%packName, &
4848  maxlist, .false., .false., &
4849  naux)
4850  end if
4851  end if
4852  !
4853  ! -- auxiliary variable
4854  naux = this%naux
4855  if (naux > 0) then
4856  !
4857  ! --
4858  text = ' AUXILIARY'
4859  idx = idx + 1
4860  maxlist = this%maxbound
4861  call this%budobj%budterm(idx)%initialize(text, &
4862  this%name_model, &
4863  this%packName, &
4864  this%name_model, &
4865  this%packName, &
4866  maxlist, .false., .false., &
4867  naux, this%auxname)
4868  end if
4869  !
4870  ! -- if maw flow for each reach are written to the listing file
4871  if (this%iprflow /= 0) then
4872  call this%budobj%flowtable_df(this%iout)
4873  end if
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:37
Here is the call graph for this function:

◆ maw_setup_tableobj()

subroutine mawmodule::maw_setup_tableobj ( class(mawtype this)
private

The terms listed here must correspond in number and order to the ones written to the head table in the maw_ot method.

Definition at line 5092 of file gwf-maw.f90.

5093  ! -- modules
5095  ! -- dummy
5096  class(MawType) :: this
5097  ! -- local
5098  integer(I4B) :: nterms
5099  character(len=LINELENGTH) :: title
5100  character(len=LINELENGTH) :: text
5101  !
5102  ! -- setup well head table
5103  if (this%iprhed > 0) then
5104  !
5105  ! -- Determine the number of head table columns
5106  nterms = 2
5107  if (this%inamedbound == 1) nterms = nterms + 1
5108  !
5109  ! -- set up table title
5110  title = trim(adjustl(this%text))//' PACKAGE ('// &
5111  trim(adjustl(this%packName))//') HEADS FOR EACH CONTROL VOLUME'
5112  !
5113  ! -- set up head tableobj
5114  call table_cr(this%headtab, this%packName, title)
5115  call this%headtab%table_df(this%nmawwells, nterms, this%iout, &
5116  transient=.true.)
5117  !
5118  ! -- Go through and set up table budget term
5119  if (this%inamedbound == 1) then
5120  text = 'NAME'
5121  call this%headtab%initialize_column(text, 20, alignment=tableft)
5122  end if
5123  !
5124  ! -- reach number
5125  text = 'NUMBER'
5126  call this%headtab%initialize_column(text, 10, alignment=tabcenter)
5127  !
5128  ! -- reach stage
5129  text = 'HEAD'
5130  call this%headtab%initialize_column(text, 12, alignment=tabcenter)
5131  end if
Here is the call graph for this function:

Variable Documentation

◆ ftype

character(len=lenftype) mawmodule::ftype = 'MAW'

Definition at line 40 of file gwf-maw.f90.

40  character(len=LENFTYPE) :: ftype = 'MAW'

◆ text

character(len=lenpackagename) mawmodule::text = ' MAW'

Definition at line 41 of file gwf-maw.f90.

41  character(len=LENPACKAGENAME) :: text = ' MAW'