MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
BoundaryPackage.f90
Go to the documentation of this file.
1 !> @brief This module contains the base boundary package
2 !!
3 !! This module contains the base model boundary package class that is
4 !! extended by all model boundary packages. The base model boundary
5 !! package extends the NumericalPackageType.
6 !!
7 !<
8 module bndmodule
9 
10  use kindmodule, only: dp, lgp, i4b
12  dzero, done, &
17  use simvariablesmodule, only: errmsg
18  use simmodule, only: count_errors, store_error, &
21  use obsmodule, only: obstype, obs_cr
22  use tdismodule, only: delt, totimc
23  use observemodule, only: observetype
28  use listmodule, only: listtype
30  use basedismodule, only: disbasetype
32  use tablemodule, only: tabletype, table_cr
35 
36  implicit none
37 
38  private
40  public :: save_print_model_flows
41  private :: castasbndclass
42 
43  !> @ brief BndType
44  !!
45  !! Generic boundary package type. This derived type can be overridden to
46  !! become concrete boundary package types.
47  !<
48  type, extends(numericalpackagetype) :: bndtype
49  ! -- characters
50  character(len=LENLISTLABEL), pointer :: listlabel => null() !< title of table written for RP
51  character(len=LENPACKAGENAME) :: text = '' !< text string for package flow term
52  character(len=LENAUXNAME), dimension(:), pointer, &
53  contiguous :: auxname => null() !< vector of auxname
54  type(characterstringtype), dimension(:), pointer, &
55  contiguous :: auxname_cst => null() !< copy of vector auxname that can be stored in memory manager
56  character(len=LENBOUNDNAME), dimension(:), pointer, &
57  contiguous :: boundname => null() !< vector of boundnames
58  type(characterstringtype), dimension(:), pointer, &
59  contiguous :: boundname_cst => null() !< copy of vector boundname that can be stored in memory manager
60  !
61  ! -- scalars
62  integer(I4B), pointer :: isadvpak => null() !< flag indicating package is advanced (1) or not (0)
63  integer(I4B), pointer :: ibcnum => null() !< consecutive package number for this boundary condition
64  integer(I4B), pointer :: maxbound => null() !< max number of boundaries
65  integer(I4B), pointer :: nbound => null() !< number of boundaries for current stress period
66  integer(I4B), pointer :: ncolbnd => null() !< number of columns of the bound array
67  integer(I4B), pointer :: iscloc => null() !< bound column to scale with SFAC
68  integer(I4B), pointer :: naux => null() !< number of auxiliary variables
69  integer(I4B), pointer :: inamedbound => null() !< flag to read boundnames
70  integer(I4B), pointer :: iauxmultcol => null() !< column to use as multiplier for column iscloc
71  integer(I4B), pointer :: npakeq => null() !< number of equations in this package (normally 0 unless package adds rows to matrix)
72  integer(I4B), pointer :: ioffset => null() !< offset of this package in the model
73  ! -- arrays
74  integer(I4B), dimension(:), pointer, contiguous :: nodelist => null() !< vector of reduced node numbers
75  integer(I4B), dimension(:), pointer, contiguous :: noupdateauxvar => null() !< override auxvars from being updated
76  real(dp), dimension(:, :), pointer, contiguous :: bound => null() !< array of package specific boundary numbers
77  real(dp), dimension(:), pointer, contiguous :: hcof => null() !< diagonal contribution
78  real(dp), dimension(:), pointer, contiguous :: rhs => null() !< right-hand side contribution
79  real(dp), dimension(:, :), pointer, contiguous :: auxvar => null() !< auxiliary variable array
80  real(dp), dimension(:), pointer, contiguous :: simvals => null() !< simulated values
81  real(dp), dimension(:), pointer, contiguous :: simtomvr => null() !< simulated to mover values
82  !
83  ! -- water mover flag and object
84  integer(I4B), pointer :: imover => null() !< flag indicating if the mover is active in the package
85  type(packagemovertype), pointer :: pakmvrobj => null() !< mover object for package
86  !
87  ! -- viscosity flag and safe-copy of conductance array
88  integer(I4B), pointer :: ivsc => null() !< flag indicating if viscosity is active in the model
89  real(dp), dimension(:), pointer, contiguous :: condinput => null() !< stores user-specified conductance values
90  !
91  ! -- timeseries
92  type(timeseriesmanagertype), pointer :: tsmanager => null() !< time series manager
93  type(timearrayseriesmanagertype), pointer :: tasmanager => null() !< time array series manager
94  integer(I4B) :: indxconvertflux = 0 !< indxconvertflux is column of bound to multiply by area to convert flux to rate
95  logical(LGP) :: allowtimearrayseries = .false.
96  !
97  ! -- pointers for observations
98  integer(I4B), pointer :: inobspkg => null() !< unit number for obs package
99  type(obstype), pointer :: obs => null() !< observation package
100  !
101  ! -- pointers to model/solution variables
102  integer(I4B), pointer :: neq !< number of equations for model
103  integer(I4B), dimension(:), pointer, contiguous :: ibound => null() !< model ibound array
104  real(dp), dimension(:), pointer, contiguous :: xnew => null() !< model dependent variable (head) for this time step
105  real(dp), dimension(:), pointer, contiguous :: xold => null() !< model dependent variable for last time step
106  real(dp), dimension(:), pointer, contiguous :: flowja => null() !< model intercell flows
107  integer(I4B), dimension(:), pointer, contiguous :: icelltype => null() !< pointer to icelltype array in NPF
108  character(len=LENMEMPATH) :: ictmempath = '' !< memory path to the icelltype data (for GWF this is in NPF)
109  !
110  ! -- table objects
111  type(tabletype), pointer :: inputtab => null() !< input table object
112  type(tabletype), pointer :: outputtab => null() !< output table object for package flows writtent to the model listing file
113  type(tabletype), pointer :: errortab => null() !< package error table
114 
115  contains
116  procedure :: bnd_df
117  procedure :: bnd_ac
118  procedure :: bnd_mc
119  procedure :: bnd_ar
120  procedure :: bnd_rp
121  procedure :: bnd_ad
122  procedure :: bnd_ck
123  procedure :: bnd_reset
124  procedure :: bnd_cf
125  procedure :: bnd_fc
126  procedure :: bnd_fn
127  procedure :: bnd_nur
128  procedure :: bnd_cc
129  procedure :: bnd_cq
130  procedure :: bnd_bd
131  procedure :: bnd_ot_model_flows
132  procedure :: bnd_ot_package_flows
133  procedure :: bnd_ot_dv
134  procedure :: bnd_ot_bdsummary
135  procedure :: bnd_da
136 
137  procedure :: allocate_scalars
138  procedure :: allocate_arrays
139  procedure :: pack_initialize
140  procedure :: read_options => bnd_read_options
141  procedure :: read_dimensions => bnd_read_dimensions
142  procedure :: read_initial_attr => bnd_read_initial_attr
143  procedure :: bnd_options
144  procedure :: bnd_cq_simrate
145  procedure :: bnd_cq_simtomvr
146  procedure :: set_pointers
147  procedure :: define_listlabel
148  procedure :: copy_boundname
149  procedure, private :: pak_setup_outputtab
150  !
151  ! -- procedures to support observations
152  procedure, public :: bnd_obs_supported
153  procedure, public :: bnd_df_obs
154  procedure, public :: bnd_bd_obs
155  procedure, public :: bnd_ot_obs
156  procedure, public :: bnd_rp_obs
157  !
158  ! -- procedure to support time series
159  procedure, public :: bnd_rp_ts
160  !
161  ! -- procedure to inform package that viscosity active
162  procedure, public :: bnd_activate_viscosity
163  !
164  ! -- procedure to backup user-specified conductance
165  procedure, private :: bnd_store_user_cond
166  !
167  end type bndtype
168 
169 contains
170 
171  !> @ brief Define boundary package options and dimensions
172  !!
173  !! Define base boundary package options and dimensions for
174  !! a model boundary package.
175  !!
176  !<
177  subroutine bnd_df(this, neq, dis)
178  ! -- modules
181  ! -- dummy variables
182  class(bndtype), intent(inout) :: this !< BndType object
183  integer(I4B), intent(inout) :: neq !< number of equations
184  class(disbasetype), pointer :: dis !< discretization object
185  !
186  ! -- set pointer to dis object for the model
187  this%dis => dis
188  !
189  ! -- Create time series managers
190  call tsmanager_cr(this%TsManager, this%iout)
191  call tasmanager_cr(this%TasManager, dis, this%name_model, this%iout)
192  !
193  ! -- create obs package
194  call obs_cr(this%obs, this%inobspkg)
195  !
196  ! -- Write information to model list file
197  write (this%iout, 1) this%filtyp, trim(adjustl(this%text)), this%inunit
198 1 format(1x, /1x, a, ' -- ', a, ' PACKAGE, VERSION 8, 2/22/2014', &
199  ' INPUT READ FROM UNIT ', i0)
200  !
201  ! -- Initialize block parser
202  call this%parser%Initialize(this%inunit, this%iout)
203  !
204  ! -- set and read options
205  call this%read_options()
206  !
207  ! -- Now that time series will have been read, need to call the df
208  ! routine to define the manager
209  call this%tsmanager%tsmanager_df()
210  call this%tasmanager%tasmanager_df()
211  !
212  ! -- read the package dimensions block
213  call this%read_dimensions()
214  !
215  ! -- update package moffset for packages that add rows
216  if (this%npakeq > 0) then
217  this%ioffset = neq - this%dis%nodes
218  end if
219  !
220  ! -- update neq
221  neq = neq + this%npakeq
222  !
223  ! -- Store information needed for observations
224  if (this%bnd_obs_supported()) then
225  call this%obs%obs_df(this%iout, this%packName, this%filtyp, this%dis)
226  call this%bnd_df_obs()
227  end if
228  end subroutine bnd_df
229 
230  !> @ brief Add boundary package connection to matrix
231  !!
232  !! Add boundary package connection to the matrix for packages that add
233  !! connections to the coefficient matrix. An example would be the GWF model
234  !! MAW package. Base implementation that must be extended.
235  !!
236  !<
237  subroutine bnd_ac(this, moffset, sparse)
238  ! -- modules
239  use sparsemodule, only: sparsematrix
240  use simmodule, only: store_error
241  ! -- dummy variables
242  class(bndtype), intent(inout) :: this !< BndType object
243  integer(I4B), intent(in) :: moffset !< solution matrix model offset
244  type(sparsematrix), intent(inout) :: sparse !< sparse object
245  end subroutine bnd_ac
246 
247  !> @ brief Map boundary package connection to matrix
248  !!
249  !! Map boundary package connection to the matrix for packages that add
250  !! connections to the coefficient matrix. An example would be the GWF model
251  !! MAW package. Base implementation that must be extended.
252  !!
253  !<
254  subroutine bnd_mc(this, moffset, matrix_sln)
255  ! -- dummy variables
256  class(bndtype), intent(inout) :: this !< BndType object
257  integer(I4B), intent(in) :: moffset !< solution matrix model offset
258  class(matrixbasetype), pointer :: matrix_sln !< global system matrix
259  end subroutine bnd_mc
260 
261  !> @ brief Allocate and read method for boundary package
262  !!
263  !! Generic method to allocate and read static data for model boundary
264  !! packages. A boundary package only needs to override this method if
265  !! input data varies from the standard boundary package.
266  !!
267  !<
268  subroutine bnd_ar(this)
269  ! -- modules
271  ! -- dummy variables
272  class(bndtype), intent(inout) :: this !< BndType object
273  !
274  ! -- allocate and read observations
275  call this%obs%obs_ar()
276  !
277  ! -- Allocate arrays in package superclass
278  call this%allocate_arrays()
279  !
280  ! -- read optional initial package parameters
281  call this%read_initial_attr()
282  !
283  ! -- setup pakmvrobj for standard stress packages
284  if (this%imover == 1) then
285  allocate (this%pakmvrobj)
286  call this%pakmvrobj%ar(this%maxbound, 0, this%memoryPath)
287  end if
288  end subroutine bnd_ar
289 
290  !> @ brief Allocate and read method for package
291  !!
292  !! Generic method to read and prepare period data for model boundary
293  !! packages. A boundary package only needs to override this method if
294  !! period data varies from the standard boundary package.
295  !!
296  !<
297  subroutine bnd_rp(this)
298  ! -- modules
299  use tdismodule, only: kper, nper
300  ! -- dummy variables
301  class(bndtype), intent(inout) :: this !< BndType object
302  ! -- local variables
303  integer(I4B) :: ierr
304  integer(I4B) :: nlist
305  logical(LGP) :: isfound
306  character(len=LINELENGTH) :: line
307  ! -- formats
308  character(len=*), parameter :: fmtblkerr = &
309  &"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
310  character(len=*), parameter :: fmtlsp = &
311  &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
312  character(len=*), parameter :: fmtnbd = &
313  "(1X,/1X,'THE NUMBER OF ACTIVE ',A,'S (',I6, &
314  &') IS GREATER THAN MAXIMUM(',I6,')')"
315  !
316  ! -- Set ionper to the stress period number for which a new block of data
317  ! will be read.
318  if (this%inunit == 0) return
319  !
320  ! -- get stress period data
321  if (this%ionper < kper) then
322  !
323  ! -- get period block
324  call this%parser%GetBlock('PERIOD', isfound, ierr, &
325  supportopenclose=.true., &
326  blockrequired=.false.)
327  if (isfound) then
328  !
329  ! -- read ionper and check for increasing period numbers
330  call this%read_check_ionper()
331  else
332  !
333  ! -- PERIOD block not found
334  if (ierr < 0) then
335  ! -- End of file found; data applies for remainder of simulation.
336  this%ionper = nper + 1
337  else
338  ! -- Found invalid block
339  call this%parser%GetCurrentLine(line)
340  write (errmsg, fmtblkerr) adjustl(trim(line))
341  call store_error(errmsg)
342  call this%parser%StoreErrorUnit()
343  end if
344  end if
345  end if
346  !
347  ! -- read data if ionper == kper
348  if (this%ionper == kper) then
349  nlist = -1
350  ! -- Remove all time-series and time-array-series links associated with
351  ! this package.
352  call this%TsManager%Reset(this%packName)
353  call this%TasManager%Reset(this%packName)
354  !
355  ! -- Read data as a list
356  call this%dis%read_list(this%parser%line_reader, &
357  this%parser%iuactive, this%iout, &
358  this%iprpak, nlist, this%inamedbound, &
359  this%iauxmultcol, this%nodelist, &
360  this%bound, this%auxvar, this%auxname, &
361  this%boundname, this%listlabel, &
362  this%packName, this%tsManager, this%iscloc)
363  this%nbound = nlist
364  !
365  ! -- save user-specified conductance if vsc package is active
366  if (this%ivsc == 1) then
367  call this%bnd_store_user_cond(nlist, this%bound, this%condinput)
368  end if
369  !
370  ! Define the tsLink%Text value(s) appropriately.
371  ! E.g. for WEL package, entry 1, assign tsLink%Text = 'Q'
372  ! For RIV package, entry 1 text = 'STAGE', entry 2 text = 'COND',
373  ! entry 3 text = 'RBOT'; etc.
374  call this%bnd_rp_ts()
375  !
376  ! -- Terminate the block
377  call this%parser%terminateblock()
378  !
379  ! -- Copy boundname into boundname_cst
380  call this%copy_boundname()
381  !
382  else
383  write (this%iout, fmtlsp) trim(this%filtyp)
384  end if
385  end subroutine bnd_rp
386 
387  !> @ brief Advance the boundary package
388  !!
389  !! Advance data in the boundary package. The method sets advances
390  !! time series, time array series, and observation data. A boundary
391  !! package only needs to override this method if additional data
392  !! needs to be advanced.
393  !!
394  !<
395  subroutine bnd_ad(this)
396  ! -- dummy variables
397  class(bndtype) :: this !< BndType object
398  ! -- local variables
399  real(DP) :: begintime, endtime
400  !
401  ! -- Initialize time variables
402  begintime = totimc
403  endtime = begintime + delt
404  !
405  ! -- Advance the time series managers
406  call this%TsManager%ad()
407  call this%TasManager%ad()
408  !
409  ! -- For each observation, push simulated value and corresponding
410  ! simulation time from "current" to "preceding" and reset
411  ! "current" value.
412  call this%obs%obs_ad()
413  end subroutine bnd_ad
414 
415  !> @ brief Check boundary package period data
416  !!
417  !! Check the boundary package period data. Base implementation that
418  !! must be extended by each model boundary package.
419  !!
420  !<
421  subroutine bnd_ck(this)
422  ! -- dummy variables
423  class(bndtype), intent(inout) :: this !< BndType object
424  !
425  ! -- check stress period data
426  ! -- each package must override generic functionality
427  end subroutine bnd_ck
428 
429  !> @ brief Reset bnd package before formulating
430  !<
431  subroutine bnd_reset(this)
432  class(bndtype) :: this !< BndType object
433 
434  if (this%imover == 1) then
435  call this%pakmvrobj%reset()
436  end if
437 
438  end subroutine bnd_reset
439 
440  !> @ brief Formulate the package hcof and rhs terms.
441  !!
442  !! Formulate the hcof and rhs terms for the package that will be
443  !! added to the coefficient matrix and right-hand side vector.
444  !! Base implementation that must be extended by each model
445  !! boundary package.
446  !!
447  !<
448  subroutine bnd_cf(this)
449  ! -- modules
450  class(bndtype) :: this !< BndType object
451  !
452  ! -- bnd has no cf routine
453  end subroutine bnd_cf
454 
455  !> @ brief Copy hcof and rhs terms into solution.
456  !!
457  !! Add the hcof and rhs terms for the boundary package to the
458  !! coefficient matrix and right-hand side vector. A boundary
459  !! package only needs to override this method if it is different for
460  !! a specific boundary package.
461  !!
462  !<
463  subroutine bnd_fc(this, rhs, ia, idxglo, matrix_sln)
464  ! -- dummy variables
465  class(bndtype) :: this !< BndType object
466  real(DP), dimension(:), intent(inout) :: rhs !< right-hand side vector for model
467  integer(I4B), dimension(:), intent(in) :: ia !< solution CRS row pointers
468  integer(I4B), dimension(:), intent(in) :: idxglo !< mapping vector for model (local) to solution (global)
469  class(matrixbasetype), pointer :: matrix_sln !< solution coefficient matrix
470  ! -- local variables
471  integer(I4B) :: i
472  integer(I4B) :: n
473  integer(I4B) :: ipos
474  !
475  ! -- Copy package rhs and hcof into solution rhs and amat
476  do i = 1, this%nbound
477  n = this%nodelist(i)
478  rhs(n) = rhs(n) + this%rhs(i)
479  ipos = ia(n)
480  call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i))
481  end do
482  end subroutine bnd_fc
483 
484  !> @ brief Add Newton-Raphson terms for package into solution.
485  !!
486  !! Calculate and add the Newton-Raphson terms for the boundary package
487  !! to the coefficient matrix and right-hand side vector. A boundary
488  !! package only needs to override this method if a specific boundary
489  !! package needs to add Newton-Raphson terms.
490  !!
491  !<
492  subroutine bnd_fn(this, rhs, ia, idxglo, matrix_sln)
493  ! -- dummy variables
494  class(bndtype) :: this !< BndType object
495  real(DP), dimension(:), intent(inout) :: rhs !< right-hand side vector for model
496  integer(I4B), dimension(:), intent(in) :: ia !< solution CRS row pointers
497  integer(I4B), dimension(:), intent(in) :: idxglo !< mapping vector for model (local) to solution (global)
498  class(matrixbasetype), pointer :: matrix_sln !< solution coefficient matrix
499  !
500  ! -- No addition terms for Newton-Raphson with constant conductance
501  ! boundary conditions
502  end subroutine bnd_fn
503 
504  !> @ brief Apply Newton-Raphson under-relaxation for package.
505  !!
506  !! Apply Newton-Raphson under-relaxation for a boundary package. A boundary
507  !! package only needs to override this method if a specific boundary
508  !! package needs to apply Newton-Raphson under-relaxation. An example is
509  !! the MAW package which adds rows to the system of equations and may need
510  !! to have the dependent-variable constrained by the bottom of the model.
511  !!
512  !<
513  subroutine bnd_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
514  ! -- dummy variables
515  class(bndtype), intent(inout) :: this !< BndType object
516  integer(I4B), intent(in) :: neqpak !< number of equations in the package
517  real(DP), dimension(neqpak), intent(inout) :: x !< dependent variable
518  real(DP), dimension(neqpak), intent(in) :: xtemp !< previous dependent variable
519  real(DP), dimension(neqpak), intent(inout) :: dx !< change in dependent variable
520  integer(I4B), intent(inout) :: inewtonur !< flag indicating if newton-raphson under-relaxation should be applied
521  real(DP), intent(inout) :: dxmax !< maximum change in the dependent variable
522  integer(I4B), intent(inout) :: locmax !< location of the maximum change in the dependent variable
523  ! -- local variables
524  !
525  ! -- Newton-Raphson under-relaxation
526  end subroutine bnd_nur
527 
528  !> @ brief Convergence check for package.
529  !!
530  !! Perform additional convergence checks on the flow between the package
531  !! and the model it is attached to. This additional convergence check is
532  !! applied to packages that solve their own continuity equation as
533  !! part of the formulate step at the beginning of a Picard iteration.
534  !! A boundary package only needs to override this method if a specific boundary
535  !! package solves its own continuity equation. Example packages that implement
536  !! this additional convergence check is the CSUB, SFR, LAK, and UZF packages.
537  !!
538  !<
539  subroutine bnd_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
540  ! -- dummy variables
541  class(bndtype), intent(inout) :: this !< BndType object
542  integer(I4B), intent(in) :: innertot !< total number of inner iterations
543  integer(I4B), intent(in) :: kiter !< Picard iteration number
544  integer(I4B), intent(in) :: iend !< flag indicating if this is the last Picard iteration
545  integer(I4B), intent(in) :: icnvgmod !< flag inficating if the model has met specific convergence criteria
546  character(len=LENPAKLOC), intent(inout) :: cpak !< string for user node
547  integer(I4B), intent(inout) :: ipak !< location of the maximum dependent variable change
548  real(DP), intent(inout) :: dpak !< maximum dependent variable change
549  !
550  ! -- No addition convergence check for boundary conditions
551  end subroutine bnd_cc
552 
553  !> @ brief Calculate advanced package flows.
554  !!
555  !! Calculate the flow between connected advanced package control volumes.
556  !! Only advanced boundary packages need to override this method.
557  !!
558  !<
559  subroutine bnd_cq(this, x, flowja, iadv)
560  ! -- dummy variables
561  class(bndtype), intent(inout) :: this !< BndType object
562  real(DP), dimension(:), intent(in) :: x !< current dependent-variable value
563  real(DP), dimension(:), contiguous, intent(inout) :: flowja !< flow between two connected control volumes
564  integer(I4B), optional, intent(in) :: iadv !< flag that indicates if this is an advance package
565  ! -- local variables
566  integer(I4B) :: imover
567  !
568  ! -- check for iadv optional variable to indicate this is an advanced
569  ! package and that mover calculations should not be done here
570  if (present(iadv)) then
571  if (iadv == 1) then
572  imover = 0
573  else
574  imover = 1
575  end if
576  else
577  imover = this%imover
578  end if
579  !
580  ! -- Calculate package flows. In the first call, simval is calculated
581  ! from hcof, rhs, and head. The second call may reduce the value in
582  ! simval by what is sent to the mover. The mover rate is stored in
583  ! simtomvr. imover is set to zero here for advanced packages, which
584  ! handle and store mover quantities separately.
585  call this%bnd_cq_simrate(x, flowja, imover)
586  if (imover == 1) then
587  call this%bnd_cq_simtomvr(flowja)
588  end if
589  end subroutine bnd_cq
590 
591  !> @ brief Calculate simrate.
592  !!
593  !! Calculate the flow between package and the model (for example, GHB and
594  !! groundwater cell) and store in the simvals variable. This method only
595  !! needs to be overridden if a different calculation needs to be made.
596  !!
597  !<
598  subroutine bnd_cq_simrate(this, hnew, flowja, imover)
599  ! -- dummy variables
600  class(bndtype) :: this !< BndType object
601  real(DP), dimension(:), intent(in) :: hnew !< current dependent-variable value
602  real(DP), dimension(:), intent(inout) :: flowja !< flow between package and model
603  integer(I4B), intent(in) :: imover !< flag indicating if the mover package is active
604  ! -- local variables
605  integer(I4B) :: i
606  integer(I4B) :: node
607  integer(I4B) :: idiag
608  real(DP) :: rrate
609  !
610  ! -- If no boundaries, skip flow calculations.
611  if (this%nbound > 0) then
612  !
613  ! -- Loop through each boundary calculating flow.
614  do i = 1, this%nbound
615  node = this%nodelist(i)
616  !
617  ! -- If cell is no-flow or constant-head, then ignore it.
618  rrate = dzero
619  if (node > 0) then
620  idiag = this%dis%con%ia(node)
621  if (this%ibound(node) > 0) then
622  !
623  ! -- Calculate the flow rate into the cell.
624  rrate = this%hcof(i) * hnew(node) - this%rhs(i)
625  end if
626  flowja(idiag) = flowja(idiag) + rrate
627  end if
628  !
629  ! -- Save simulated value to simvals array.
630  this%simvals(i) = rrate
631  !
632  end do
633  end if
634  end subroutine bnd_cq_simrate
635 
636  !> @ brief Calculate flow to the mover.
637  !!
638  !! Calculate the flow between package and the model that is sent to the
639  !! mover package and store in the simtomvr variable. This method only
640  !! needs to be overridden if a different calculation needs to be made.
641  !!
642  !<
643  subroutine bnd_cq_simtomvr(this, flowja)
644  ! -- dummy variables
645  class(bndtype) :: this !< BndType object
646  real(DP), dimension(:), intent(inout) :: flowja !< flow between package and model
647  ! -- local variables
648  integer(I4B) :: i
649  integer(I4B) :: node
650  real(DP) :: q
651  real(DP) :: fact
652  real(DP) :: rrate
653  !
654  ! -- If no boundaries, skip flow calculations.
655  if (this%nbound > 0) then
656  !
657  ! -- Loop through each boundary calculating flow.
658  do i = 1, this%nbound
659  node = this%nodelist(i)
660  !
661  ! -- If cell is no-flow or constant-head, then ignore it.
662  rrate = dzero
663  if (node > 0) then
664  if (this%ibound(node) > 0) then
665  !
666  ! -- Calculate the flow rate into the cell.
667  q = this%simvals(i)
668 
669  if (q < dzero) then
670  rrate = this%pakmvrobj%get_qtomvr(i)
671  !
672  ! -- Evaluate if qtomvr exceeds the calculated rrate.
673  ! When fact is greater than 1, qtomvr is numerically
674  ! larger than rrate (which should never happen) and
675  ! represents a water budget error. When this happens,
676  ! rrate is set to 0. so that the water budget error is
677  ! correctly accounted for in the listing water budget.
678  fact = -rrate / q
679  if (fact > done) then
680  ! -- all flow goes to mover
681  q = dzero
682  else
683  ! -- magnitude of rrate (which is negative) is reduced by
684  ! qtomvr (which is positive)
685  q = q + rrate
686  end if
687  this%simvals(i) = q
688 
689  if (rrate > dzero) then
690  rrate = -rrate
691  end if
692  end if
693  end if
694  end if
695  !
696  ! -- Save simulated value to simtomvr array.
697  this%simtomvr(i) = rrate
698  !
699  end do
700  end if
701  end subroutine bnd_cq_simtomvr
702 
703  !> @ brief Add package flows to model budget.
704  !!
705  !! Add the flow between package and the model (ratin and ratout) to the
706  !! model budget. This method only needs to be overridden if a different
707  !! calculation needs to be made.
708  !!
709  !<
710  subroutine bnd_bd(this, model_budget)
711  ! -- modules
712  use tdismodule, only: delt
714  ! -- dummy variables
715  class(bndtype) :: this !< BndType object
716  type(budgettype), intent(inout) :: model_budget !< model budget object
717  ! -- local variables
718  character(len=LENPACKAGENAME) :: text
719  real(DP) :: ratin
720  real(DP) :: ratout
721  integer(I4B) :: isuppress_output
722  !
723  ! -- initialize local variables
724  isuppress_output = 0
725  !
726  ! -- call accumulator and add to the model budget
727  call rate_accumulator(this%simvals(1:this%nbound), ratin, ratout)
728  call model_budget%addentry(ratin, ratout, delt, this%text, &
729  isuppress_output, this%packName)
730  if (this%imover == 1 .and. this%isadvpak == 0) then
731  text = trim(adjustl(this%text))//'-TO-MVR'
732  text = adjustr(text)
733  call rate_accumulator(this%simtomvr(1:this%nbound), ratin, ratout)
734  call model_budget%addentry(ratin, ratout, delt, text, &
735  isuppress_output, this%packName)
736  end if
737  end subroutine bnd_bd
738 
739  !> @ brief Output advanced package flow terms.
740  !!
741  !! Output advanced boundary package flow terms. This method only needs to
742  !! be overridden for advanced packages that save flow terms than contribute
743  !! to the continuity equation for each control volume.
744  !!
745  !<
746  subroutine bnd_ot_package_flows(this, icbcfl, ibudfl)
747  ! -- dummy variables
748  class(bndtype) :: this !< BndType object
749  integer(I4B), intent(in) :: icbcfl !< flag and unit number for cell-by-cell output
750  integer(I4B), intent(in) :: ibudfl !< flag indication if cell-by-cell data should be saved
751  !
752  ! -- override for advanced packages
753  end subroutine bnd_ot_package_flows
754 
755  !> @ brief Output advanced package dependent-variable terms.
756  !!
757  !! Output advanced boundary package dependent-variable terms. This method only needs
758  !! to be overridden for advanced packages that save dependent variable terms
759  !! for each control volume.
760  !!
761  !<
762  subroutine bnd_ot_dv(this, idvsave, idvprint)
763  ! -- dummy variables
764  class(bndtype) :: this !< BndType object
765  integer(I4B), intent(in) :: idvsave !< flag and unit number for dependent-variable output
766  integer(I4B), intent(in) :: idvprint !< flag indicating if dependent-variable should be written to the model listing file
767  !
768  ! -- override for advanced packages
769  end subroutine bnd_ot_dv
770 
771  !> @ brief Output advanced package budget summary.
772  !!
773  !! Output advanced boundary package budget summary. This method only needs
774  !! to be overridden for advanced packages that save budget summaries
775  !! to the model listing file.
776  !!
777  !<
778  subroutine bnd_ot_bdsummary(this, kstp, kper, iout, ibudfl)
779  ! -- dummy variables
780  class(bndtype) :: this !< BndType object
781  integer(I4B), intent(in) :: kstp !< time step number
782  integer(I4B), intent(in) :: kper !< period number
783  integer(I4B), intent(in) :: iout !< flag and unit number for the model listing file
784  integer(I4B), intent(in) :: ibudfl !< flag indicating budget should be written
785  !
786  ! -- override for advanced packages
787  end subroutine bnd_ot_bdsummary
788 
789  !> @ brief Output package flow terms.
790  !!
791  !! Output flow terms between the boundary package and model to a binary file and/or
792  !! print flows to the model listing file. This method should not need to
793  !! be overridden.
794  !!
795  !<
796  subroutine bnd_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap)
797  ! -- dummy variables
798  class(bndtype) :: this !< BndType object
799  integer(I4B), intent(in) :: icbcfl !< flag for cell-by-cell output
800  integer(I4B), intent(in) :: ibudfl !< flag indication if cell-by-cell data should be saved
801  integer(I4B), intent(in) :: icbcun !< unit number for cell-by-cell output
802  integer(I4B), dimension(:), optional, intent(in) :: imap !< mapping vector that converts the 1 to nbound values to lake number, maw number, etc.
803  ! -- local variables
804  character(len=LINELENGTH) :: title
805  character(len=LENPACKAGENAME) :: text
806  integer(I4B) :: imover
807  !
808  ! -- Call generic subroutine to save and print simvals and simtomvr
809  title = trim(adjustl(this%text))//' PACKAGE ('//trim(this%packName)// &
810  ') FLOW RATES'
811  if (present(imap)) then
812  call save_print_model_flows(icbcfl, ibudfl, icbcun, this%iprflow, &
813  this%outputtab, this%nbound, this%nodelist, &
814  this%simvals, this%ibound, title, this%text, &
815  this%ipakcb, this%dis, this%naux, &
816  this%name_model, this%name_model, &
817  this%name_model, this%packName, &
818  this%auxname, this%auxvar, this%iout, &
819  this%inamedbound, this%boundname, imap)
820  else
821  call save_print_model_flows(icbcfl, ibudfl, icbcun, this%iprflow, &
822  this%outputtab, this%nbound, this%nodelist, &
823  this%simvals, this%ibound, title, this%text, &
824  this%ipakcb, this%dis, this%naux, &
825  this%name_model, this%name_model, &
826  this%name_model, this%packName, &
827  this%auxname, this%auxvar, this%iout, &
828  this%inamedbound, this%boundname)
829  end if
830  !
831  ! -- Set mover flag, and shut off if this is an advanced package. Advanced
832  ! packages must handle mover flows differently by including them in
833  ! their balance equations. These simtomvr flows are the general
834  ! flow to mover terms calculated by bnd_cq_simtomvr()
835  imover = this%imover
836  if (this%isadvpak /= 0) imover = 0
837  if (imover == 1) then
838  text = trim(adjustl(this%text))//'-TO-MVR'
839  text = adjustr(text)
840  title = trim(adjustl(this%text))//' PACKAGE ('// &
841  trim(this%packName)//') FLOW RATES TO-MVR'
842  call save_print_model_flows(icbcfl, ibudfl, icbcun, this%iprflow, &
843  this%outputtab, this%nbound, this%nodelist, &
844  this%simtomvr, this%ibound, title, text, &
845  this%ipakcb, this%dis, this%naux, &
846  this%name_model, this%name_model, &
847  this%name_model, this%packName, &
848  this%auxname, this%auxvar, this%iout, &
849  this%inamedbound, this%boundname)
850  end if
851  end subroutine bnd_ot_model_flows
852 
853  !> @ brief Deallocate package memory
854  !!
855  !! Deallocate base boundary package scalars and arrays. This method
856  !! only needs to be overridden if additional variables are defined
857  !! for a specific package.
858  !!
859  !<
860  subroutine bnd_da(this)
861  ! -- modules
863  ! -- dummy variables
864  class(bndtype) :: this !< BndType object
865  !
866  ! -- deallocate arrays
867  call mem_deallocate(this%nodelist, 'NODELIST', this%memoryPath)
868  call mem_deallocate(this%noupdateauxvar, 'NOUPDATEAUXVAR', this%memoryPath)
869  call mem_deallocate(this%bound, 'BOUND', this%memoryPath)
870  call mem_deallocate(this%condinput, 'CONDINPUT', this%memoryPath)
871  call mem_deallocate(this%hcof, 'HCOF', this%memoryPath)
872  call mem_deallocate(this%rhs, 'RHS', this%memoryPath)
873  call mem_deallocate(this%simvals, 'SIMVALS', this%memoryPath)
874  call mem_deallocate(this%simtomvr, 'SIMTOMVR', this%memoryPath)
875  call mem_deallocate(this%auxvar, 'AUXVAR', this%memoryPath)
876  call mem_deallocate(this%boundname, 'BOUNDNAME', this%memoryPath)
877  call mem_deallocate(this%boundname_cst, 'BOUNDNAME_CST', this%memoryPath)
878  call mem_deallocate(this%auxname, 'AUXNAME', this%memoryPath)
879  call mem_deallocate(this%auxname_cst, 'AUXNAME_CST', this%memoryPath)
880  nullify (this%icelltype)
881  !
882  ! -- pakmvrobj
883  if (this%imover /= 0) then
884  call this%pakmvrobj%da()
885  deallocate (this%pakmvrobj)
886  nullify (this%pakmvrobj)
887  end if
888  !
889  ! -- input table object
890  if (associated(this%inputtab)) then
891  call this%inputtab%table_da()
892  deallocate (this%inputtab)
893  nullify (this%inputtab)
894  end if
895  !
896  ! -- output table object
897  if (associated(this%outputtab)) then
898  call this%outputtab%table_da()
899  deallocate (this%outputtab)
900  nullify (this%outputtab)
901  end if
902  !
903  ! -- error table object
904  if (associated(this%errortab)) then
905  call this%errortab%table_da()
906  deallocate (this%errortab)
907  nullify (this%errortab)
908  end if
909  !
910  ! -- deallocate character variables
911  call mem_deallocate(this%listlabel, 'LISTLABEL', this%memoryPath)
912  !
913  ! -- Deallocate scalars
914  call mem_deallocate(this%isadvpak)
915  call mem_deallocate(this%ibcnum)
916  call mem_deallocate(this%maxbound)
917  call mem_deallocate(this%nbound)
918  call mem_deallocate(this%ncolbnd)
919  call mem_deallocate(this%iscloc)
920  call mem_deallocate(this%naux)
921  call mem_deallocate(this%inamedbound)
922  call mem_deallocate(this%iauxmultcol)
923  call mem_deallocate(this%inobspkg)
924  call mem_deallocate(this%imover)
925  call mem_deallocate(this%npakeq)
926  call mem_deallocate(this%ioffset)
927  call mem_deallocate(this%ivsc)
928  !
929  ! -- deallocate methods on objects
930  call this%obs%obs_da()
931  call this%TsManager%da()
932  call this%TasManager%da()
933  !
934  ! -- deallocate objects
935  deallocate (this%obs)
936  deallocate (this%TsManager)
937  deallocate (this%TasManager)
938  nullify (this%TsManager)
939  nullify (this%TasManager)
940  !
941  ! -- Deallocate parent object
942  call this%NumericalPackageType%da()
943  end subroutine bnd_da
944 
945  !> @ brief Allocate package scalars
946  !!
947  !! Allocate and initialize base boundary package scalars. This method
948  !! only needs to be overridden if additional scalars are defined
949  !! for a specific package.
950  !!
951  !<
952  subroutine allocate_scalars(this)
953  ! -- modules
956  ! -- dummy variables
957  class(bndtype) :: this !< BndType object
958  ! -- local variables
959  integer(I4B), pointer :: imodelnewton => null()
960  !
961  ! -- allocate scalars in NumericalPackageType
962  call this%NumericalPackageType%allocate_scalars()
963  !
964  ! -- allocate character variables
965  call mem_allocate(this%listlabel, lenlistlabel, 'LISTLABEL', &
966  this%memoryPath)
967  !
968  ! -- allocate integer variables
969  call mem_allocate(this%isadvpak, 'ISADVPAK', this%memoryPath)
970  call mem_allocate(this%ibcnum, 'IBCNUM', this%memoryPath)
971  call mem_allocate(this%maxbound, 'MAXBOUND', this%memoryPath)
972  call mem_allocate(this%nbound, 'NBOUND', this%memoryPath)
973  call mem_allocate(this%ncolbnd, 'NCOLBND', this%memoryPath)
974  call mem_allocate(this%iscloc, 'ISCLOC', this%memoryPath)
975  call mem_allocate(this%naux, 'NAUX', this%memoryPath)
976  call mem_allocate(this%inamedbound, 'INAMEDBOUND', this%memoryPath)
977  call mem_allocate(this%iauxmultcol, 'IAUXMULTCOL', this%memoryPath)
978  call mem_allocate(this%inobspkg, 'INOBSPKG', this%memoryPath)
979  !
980  ! -- allocate the object and assign values to object variables
981  call mem_allocate(this%imover, 'IMOVER', this%memoryPath)
982  !
983  ! -- allocate flag for determining if vsc active
984  call mem_allocate(this%ivsc, 'IVSC', this%memoryPath)
985  !
986  ! -- allocate scalars for packages that add rows to the matrix (e.g. MAW)
987  call mem_allocate(this%npakeq, 'NPAKEQ', this%memoryPath)
988  call mem_allocate(this%ioffset, 'IOFFSET', this%memoryPath)
989  !
990  ! -- allocate TS objects
991  allocate (this%TsManager)
992  allocate (this%TasManager)
993  !
994  ! -- allocate text strings
995  call mem_allocate(this%auxname, lenauxname, 0, 'AUXNAME', this%memoryPath)
996  call mem_allocate(this%auxname_cst, lenauxname, 0, 'AUXNAME_CST', &
997  this%memoryPath)
998  !
999  ! -- Initialize variables
1000  this%isadvpak = 0
1001  this%ibcnum = 0
1002  this%maxbound = 0
1003  this%nbound = 0
1004  this%ncolbnd = 0
1005  this%iscloc = 0
1006  this%naux = 0
1007  this%inamedbound = 0
1008  this%iauxmultcol = 0
1009  this%inobspkg = 0
1010  this%imover = 0
1011  this%npakeq = 0
1012  this%ioffset = 0
1013  this%ivsc = 0
1014  !
1015  ! -- Set pointer to model inewton variable
1016  call mem_setptr(imodelnewton, 'INEWTON', create_mem_path(this%name_model))
1017  this%inewton = imodelnewton
1018  imodelnewton => null()
1019  end subroutine allocate_scalars
1020 
1021  !> @ brief Allocate package arrays
1022  !!
1023  !! Allocate and initialize base boundary package arrays. This method
1024  !! only needs to be overridden if additional arrays are defined
1025  !! for a specific package.
1026  !!
1027  !<
1028  subroutine allocate_arrays(this, nodelist, auxvar)
1029  ! -- modules
1031  ! -- dummy variables
1032  class(bndtype) :: this !< BndType object
1033  integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist !< package nodelist
1034  real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar !< package aux variable array
1035  ! -- local variables
1036  integer(I4B) :: i
1037  integer(I4B) :: j
1038  !
1039  ! -- Point nodelist if it is passed in, otherwise allocate
1040  if (present(nodelist)) then
1041  this%nodelist => nodelist
1042  else
1043  call mem_allocate(this%nodelist, this%maxbound, 'NODELIST', &
1044  this%memoryPath)
1045  do j = 1, this%maxbound
1046  this%nodelist(j) = 0
1047  end do
1048  end if
1049  !
1050  ! -- noupdateauxvar (allows an external caller to stop auxvars from being
1051  ! recalculated
1052  call mem_allocate(this%noupdateauxvar, this%naux, 'NOUPDATEAUXVAR', &
1053  this%memoryPath)
1054  this%noupdateauxvar(:) = 0
1055  !
1056  ! -- Allocate the bound array
1057  call mem_allocate(this%bound, this%ncolbnd, this%maxbound, 'BOUND', &
1058  this%memoryPath)
1059  !
1060  !-- Allocate array for storing user-specified conductances
1061  ! Will be reallocated to size maxbound if vsc active
1062  call mem_allocate(this%condinput, 0, 'CONDINPUT', this%memoryPath)
1063  !
1064  ! -- Allocate hcof and rhs
1065  call mem_allocate(this%hcof, this%maxbound, 'HCOF', this%memoryPath)
1066  call mem_allocate(this%rhs, this%maxbound, 'RHS', this%memoryPath)
1067  !
1068  ! -- Allocate the simvals array
1069  call mem_allocate(this%simvals, this%maxbound, 'SIMVALS', this%memoryPath)
1070  if (this%imover == 1) then
1071  call mem_allocate(this%simtomvr, this%maxbound, 'SIMTOMVR', &
1072  this%memoryPath)
1073  do i = 1, this%maxbound
1074  this%simtomvr(i) = dzero
1075  end do
1076  else
1077  call mem_allocate(this%simtomvr, 0, 'SIMTOMVR', this%memoryPath)
1078  end if
1079  !
1080  ! -- Point or allocate auxvar
1081  if (present(auxvar)) then
1082  this%auxvar => auxvar
1083  else
1084  call mem_allocate(this%auxvar, this%naux, this%maxbound, 'AUXVAR', &
1085  this%memoryPath)
1086  do i = 1, this%maxbound
1087  do j = 1, this%naux
1088  this%auxvar(j, i) = dzero
1089  end do
1090  end do
1091  end if
1092  !
1093  ! -- Allocate boundname
1094  if (this%inamedbound /= 0) then
1095  call mem_allocate(this%boundname, lenboundname, this%maxbound, &
1096  'BOUNDNAME', this%memoryPath)
1097  call mem_allocate(this%boundname_cst, lenboundname, this%maxbound, &
1098  'BOUNDNAME_CST', this%memoryPath)
1099  else
1100  call mem_allocate(this%boundname, lenboundname, 0, &
1101  'BOUNDNAME', this%memoryPath)
1102  call mem_allocate(this%boundname_cst, lenboundname, 0, &
1103  'BOUNDNAME_CST', this%memoryPath)
1104  end if
1105  !
1106  ! -- Set pointer to ICELLTYPE. For GWF boundary packages,
1107  ! this%ictMemPath will be 'NPF'. If boundary packages do not set
1108  ! this%ictMemPath, then icelltype will remain as null()
1109  if (this%ictMemPath /= '') then
1110  call mem_setptr(this%icelltype, 'ICELLTYPE', this%ictMemPath)
1111  end if
1112  !
1113  ! -- Initialize values
1114  do j = 1, this%maxbound
1115  do i = 1, this%ncolbnd
1116  this%bound(i, j) = dzero
1117  end do
1118  end do
1119  do i = 1, this%maxbound
1120  this%hcof(i) = dzero
1121  this%rhs(i) = dzero
1122  end do
1123  !
1124  ! -- setup the output table
1125  call this%pak_setup_outputtab()
1126  end subroutine allocate_arrays
1127 
1128  !> @ brief Allocate and initialize select package members
1129  !!
1130  !! Allocate and initialize select base boundary package members.
1131  !! This method needs to be overridden by a package if it is
1132  !! needed for a specific package.
1133  !!
1134  !<
1135  subroutine pack_initialize(this)
1136  ! -- dummy variables
1137  class(bndtype) :: this !< BndType object
1138  end subroutine pack_initialize
1139 
1140  !> @ brief Set pointers to model variables
1141  !!
1142  !! Set pointers to model variables so that a package has access to these
1143  !! variables. This base method should not need to be overridden.
1144  !!
1145  !<
1146  subroutine set_pointers(this, neq, ibound, xnew, xold, flowja)
1147  ! -- dummy variables
1148  class(bndtype) :: this !< BndType object
1149  integer(I4B), pointer :: neq !< number of equations in the model
1150  integer(I4B), dimension(:), pointer, contiguous :: ibound !< model idomain
1151  real(DP), dimension(:), pointer, contiguous :: xnew !< current dependent variable
1152  real(DP), dimension(:), pointer, contiguous :: xold !< previous dependent variable
1153  real(DP), dimension(:), pointer, contiguous :: flowja !< connection flow terms
1154  !
1155  ! -- Set the pointers
1156  this%neq => neq
1157  this%ibound => ibound
1158  this%xnew => xnew
1159  this%xold => xold
1160  this%flowja => flowja
1161  end subroutine set_pointers
1162 
1163  !> @ brief Read additional options for package
1164  !!
1165  !! Read base options for boundary packages.
1166  !!
1167  !<
1168  subroutine bnd_read_options(this)
1169  ! -- modules
1170  use inputoutputmodule, only: urdaux
1172  ! -- dummy variables
1173  class(bndtype), intent(inout) :: this !< BndType object
1174  ! -- local variables
1175  character(len=:), allocatable :: line
1176  character(len=LINELENGTH) :: fname
1177  character(len=LINELENGTH) :: keyword
1178  character(len=LENAUXNAME) :: sfacauxname
1179  character(len=LENAUXNAME), dimension(:), allocatable :: caux
1180  integer(I4B) :: lloc
1181  integer(I4B) :: istart
1182  integer(I4B) :: istop
1183  integer(I4B) :: n
1184  integer(I4B) :: ierr
1185  integer(I4B) :: inobs
1186  logical(LGP) :: isfound
1187  logical(LGP) :: endOfBlock
1188  logical(LGP) :: foundchildclassoption
1189  ! -- format
1190  character(len=*), parameter :: fmtflow = &
1191  &"(4x, 'FLOWS WILL BE SAVED TO FILE: ', a, /4x, 'OPENED ON UNIT: ', I7)"
1192  character(len=*), parameter :: fmtflow2 = &
1193  &"(4x, 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL')"
1194  character(len=*), parameter :: fmttas = &
1195  &"(4x, 'TIME-ARRAY SERIES DATA WILL BE READ FROM FILE: ', a)"
1196  character(len=*), parameter :: fmtts = &
1197  &"(4x, 'TIME-SERIES DATA WILL BE READ FROM FILE: ', a)"
1198  character(len=*), parameter :: fmtnme = &
1199  &"(a, i0, a)"
1200  !
1201  ! -- set default options
1202  !
1203  ! -- get options block
1204  call this%parser%GetBlock('OPTIONS', isfound, ierr, &
1205  supportopenclose=.true., blockrequired=.false.)
1206  !
1207  ! -- parse options block if detected
1208  if (isfound) then
1209  write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) &
1210  //' OPTIONS'
1211  do
1212  call this%parser%GetNextLine(endofblock)
1213  if (endofblock) then
1214  exit
1215  end if
1216  call this%parser%GetStringCaps(keyword)
1217  select case (keyword)
1218  case ('AUX', 'AUXILIARY')
1219  call this%parser%GetRemainingLine(line)
1220  lloc = 1
1221  call urdaux(this%naux, this%parser%iuactive, this%iout, lloc, &
1222  istart, istop, caux, line, this%text)
1223  call mem_reallocate(this%auxname, lenauxname, this%naux, &
1224  'AUXNAME', this%memoryPath)
1225  call mem_reallocate(this%auxname_cst, lenauxname, this%naux, &
1226  'AUXNAME_CST', this%memoryPath)
1227  do n = 1, this%naux
1228  this%auxname(n) = caux(n)
1229  this%auxname_cst(n) = caux(n)
1230  end do
1231  deallocate (caux)
1232  case ('SAVE_FLOWS')
1233  this%ipakcb = -1
1234  write (this%iout, fmtflow2)
1235  case ('PRINT_INPUT')
1236  this%iprpak = 1
1237  write (this%iout, '(4x,a)') &
1238  'LISTS OF '//trim(adjustl(this%text))//' CELLS WILL BE PRINTED.'
1239  case ('PRINT_FLOWS')
1240  this%iprflow = 1
1241  write (this%iout, '(4x,a)') trim(adjustl(this%text))// &
1242  ' FLOWS WILL BE PRINTED TO LISTING FILE.'
1243  case ('BOUNDNAMES')
1244  this%inamedbound = 1
1245  write (this%iout, '(4x,a)') trim(adjustl(this%text))// &
1246  ' BOUNDARIES HAVE NAMES IN LAST COLUMN.'
1247  case ('TS6')
1248  call this%parser%GetStringCaps(keyword)
1249  if (trim(adjustl(keyword)) /= 'FILEIN') then
1250  errmsg = 'TS6 keyword must be followed by "FILEIN" '// &
1251  'then by filename.'
1252  call store_error(errmsg)
1253  end if
1254  call this%parser%GetString(fname)
1255  write (this%iout, fmtts) trim(fname)
1256  call this%TsManager%add_tsfile(fname, this%inunit)
1257  case ('TAS6')
1258  if (this%AllowTimeArraySeries) then
1259  if (.not. this%dis%supports_layers()) then
1260  errmsg = 'TAS6 FILE cannot be used '// &
1261  'with selected discretization type.'
1262  call store_error(errmsg)
1263  end if
1264  else
1265  errmsg = 'The '//trim(this%filtyp)// &
1266  ' package does not support TIMEARRAYSERIESFILE'
1267  call store_error(errmsg)
1268  call this%parser%StoreErrorUnit()
1269  end if
1270  call this%parser%GetStringCaps(keyword)
1271  if (trim(adjustl(keyword)) /= 'FILEIN') then
1272  errmsg = 'TAS6 keyword must be followed by "FILEIN" '// &
1273  'then by filename.'
1274  call store_error(errmsg)
1275  call this%parser%StoreErrorUnit()
1276  end if
1277  call this%parser%GetString(fname)
1278  write (this%iout, fmttas) trim(fname)
1279  call this%TasManager%add_tasfile(fname)
1280  case ('AUXMULTNAME')
1281  call this%parser%GetStringCaps(sfacauxname)
1282  this%iauxmultcol = -1
1283  write (this%iout, '(4x,a,a)') &
1284  'AUXILIARY MULTIPLIER NAME: ', sfacauxname
1285  case ('OBS6')
1286  call this%parser%GetStringCaps(keyword)
1287  if (trim(adjustl(keyword)) /= 'FILEIN') then
1288  errmsg = 'OBS6 keyword must be followed by "FILEIN" '// &
1289  'then by filename.'
1290  call store_error(errmsg)
1291  call this%parser%StoreErrorUnit()
1292  end if
1293  if (this%obs%active) then
1294  errmsg = 'Multiple OBS6 keywords detected in OPTIONS block. '// &
1295  'Only one OBS6 entry allowed for a package.'
1296  call store_error(errmsg)
1297  end if
1298  this%obs%active = .true.
1299  call this%parser%GetString(this%obs%inputFilename)
1300  inobs = getunit()
1301  call openfile(inobs, this%iout, this%obs%inputFilename, 'OBS')
1302  this%obs%inUnitObs = inobs
1303  !
1304  ! -- right now these are options that are only available in the
1305  ! development version and are not included in the documentation.
1306  ! These options are only available when IDEVELOPMODE in
1307  ! constants module is set to 1
1308  case ('DEV_NO_NEWTON')
1309  call this%parser%DevOpt()
1310  this%inewton = 0
1311  write (this%iout, '(4x,a)') &
1312  'NEWTON-RAPHSON method disabled for unconfined cells'
1313  case default
1314  !
1315  ! -- Check for child class options
1316  call this%bnd_options(keyword, foundchildclassoption)
1317  !
1318  ! -- No child class options found, so print error message
1319  if (.not. foundchildclassoption) then
1320  write (errmsg, '(a,3(1x,a))') &
1321  'UNKNOWN', trim(adjustl(this%text)), 'OPTION:', trim(keyword)
1322  call store_error(errmsg)
1323  end if
1324  end select
1325  end do
1326  write (this%iout, '(1x,a)') &
1327  'END OF '//trim(adjustl(this%text))//' OPTIONS'
1328  else
1329  write (this%iout, '(1x,a)') 'NO '//trim(adjustl(this%text))// &
1330  ' OPTION BLOCK DETECTED.'
1331  end if
1332  !
1333  ! -- AUXMULTNAME was specified, so find column of auxvar that will be multiplier
1334  if (this%iauxmultcol < 0) then
1335  !
1336  ! -- Error if no aux variable specified
1337  if (this%naux == 0) then
1338  write (errmsg, '(a,2(1x,a))') &
1339  'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
1340  'but no AUX variables specified.'
1341  call store_error(errmsg)
1342  end if
1343  !
1344  ! -- Assign mult column
1345  this%iauxmultcol = 0
1346  do n = 1, this%naux
1347  if (sfacauxname == this%auxname(n)) then
1348  this%iauxmultcol = n
1349  exit
1350  end if
1351  end do
1352  !
1353  ! -- Error if aux variable cannot be found
1354  if (this%iauxmultcol == 0) then
1355  write (errmsg, '(a,2(1x,a))') &
1356  'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
1357  'but no AUX variable found with this name.'
1358  call store_error(errmsg)
1359  end if
1360  end if
1361  !
1362  ! -- terminate if errors were detected
1363  if (count_errors() > 0) then
1364  call this%parser%StoreErrorUnit()
1365  end if
1366  end subroutine bnd_read_options
1367 
1368  !> @ brief Read dimensions for package
1369  !!
1370  !! Read base dimensions for boundary packages. This method should not
1371  !! need to be overridden unless more than MAXBOUND is specified in the
1372  !! DIMENSIONS block.
1373  !!
1374  !<
1375  subroutine bnd_read_dimensions(this)
1376  ! -- dummy variables
1377  class(bndtype), intent(inout) :: this !< BndType object
1378  ! -- local variables
1379  character(len=LINELENGTH) :: keyword
1380  logical(LGP) :: isfound
1381  logical(LGP) :: endOfBlock
1382  integer(I4B) :: ierr
1383  !
1384  ! -- get dimensions block
1385  call this%parser%GetBlock('DIMENSIONS', isfound, ierr, &
1386  supportopenclose=.true.)
1387  !
1388  ! -- parse dimensions block if detected
1389  if (isfound) then
1390  write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// &
1391  ' DIMENSIONS'
1392  do
1393  call this%parser%GetNextLine(endofblock)
1394  if (endofblock) exit
1395  call this%parser%GetStringCaps(keyword)
1396  select case (keyword)
1397  case ('MAXBOUND')
1398  this%maxbound = this%parser%GetInteger()
1399  write (this%iout, '(4x,a,i7)') 'MAXBOUND = ', this%maxbound
1400  case default
1401  write (errmsg, '(a,3(1x,a))') &
1402  'Unknown', trim(this%text), 'dimension:', trim(keyword)
1403  call store_error(errmsg)
1404  end select
1405  end do
1406  !
1407  write (this%iout, '(1x,a)') &
1408  'END OF '//trim(adjustl(this%text))//' DIMENSIONS'
1409  else
1410  call store_error('Required DIMENSIONS block not found.')
1411  call this%parser%StoreErrorUnit()
1412  end if
1413  !
1414  ! -- verify dimensions were set
1415  if (this%maxbound <= 0) then
1416  write (errmsg, '(a)') 'MAXBOUND must be an integer greater than zero.'
1417  call store_error(errmsg)
1418  end if
1419  !
1420  ! -- terminate if there are errors
1421  if (count_errors() > 0) then
1422  call this%parser%StoreErrorUnit()
1423  end if
1424  !
1425  ! -- Call define_listlabel to construct the list label that is written
1426  ! when PRINT_INPUT option is used.
1427  call this%define_listlabel()
1428  end subroutine bnd_read_dimensions
1429 
1430  !> @ brief Store user-specified conductances when vsc is active
1431  !!
1432  !! VSC will update boundary package conductance values. Because
1433  !! viscosity can change every stress period, but user-specified
1434  !! conductances may not, the base user-input should be stored in
1435  !! backup array so that viscosity-updated conductances may be
1436  !! recalculated every stress period/time step
1437  !!
1438  !<
1439  subroutine bnd_store_user_cond(this, nlist, rlist, condinput)
1440  ! -- modules
1441  use simmodule, only: store_error
1442  ! -- dummy variables
1443  class(bndtype), intent(inout) :: this !< BndType object
1444  integer(I4B), intent(in) :: nlist
1445  real(DP), dimension(:, :), pointer, contiguous, intent(in) :: rlist
1446  real(DP), dimension(:), pointer, contiguous, intent(inout) :: condinput
1447  ! -- local variables
1448  integer(I4B) :: l
1449  !
1450  ! -- store backup copy of conductance values
1451  do l = 1, nlist
1452  condinput(l) = rlist(2, l)
1453  end do
1454  end subroutine bnd_store_user_cond
1455 
1456  !> @ brief Read initial parameters for package
1457  !!
1458  !! Read initial parameters for a boundary package. This method is not
1459  !! needed for most boundary packages. The SFR package is an example of a
1460  !! package that has overridden this method.
1461  !!
1462  !<
1463  subroutine bnd_read_initial_attr(this)
1464  ! -- dummy
1465  class(bndtype), intent(inout) :: this !< BndType object
1466  end subroutine bnd_read_initial_attr
1467 
1468  !> @ brief Read additional options for package
1469  !!
1470  !! Read additional options for a boundary package. This method should
1471  !! be overridden options in addition to the base options are implemented
1472  !! in a boundary package.
1473  !!
1474  !<
1475  subroutine bnd_options(this, option, found)
1476  ! -- dummy
1477  class(bndtype), intent(inout) :: this !< BndType object
1478  character(len=*), intent(inout) :: option !< option keyword string
1479  logical(LGP), intent(inout) :: found !< boolean indicating if the option was found
1480  !
1481  ! Return with found = .false.
1482  found = .false.
1483  end subroutine bnd_options
1484 
1485  !> @ brief Copy boundnames into boundnames_cst
1486  !!
1487  !! boundnames_cst is an array of type(CharacterStringType),
1488  !! which can be stored in the MemoryManager.
1489  !!
1490  !<
1491  subroutine copy_boundname(this)
1492  ! -- dummy
1493  class(bndtype), intent(inout) :: this !< BndType object
1494  ! -- local
1495  integer(I4B) :: i
1496  !
1497  ! copy from boundname to boundname_cst, which can be
1498  ! stored in the memory manager
1499  if (this%inamedbound /= 0) then
1500  do i = 1, size(this%boundname)
1501  this%boundname_cst(i) = this%boundname(i)
1502  end do
1503  end if
1504  end subroutine copy_boundname
1505 
1506  !> @ brief Setup output table for package
1507  !!
1508  !! Setup output table for a boundary package that is used to output
1509  !! package to model flow terms to the model listing file.
1510  !!
1511  !<
1512  subroutine pak_setup_outputtab(this)
1513  ! -- dummy variables
1514  class(bndtype), intent(inout) :: this !< BndType object
1515  ! -- local variables
1516  character(len=LINELENGTH) :: title
1517  character(len=LINELENGTH) :: text
1518  integer(I4B) :: ntabcol
1519  !
1520  ! -- allocate and initialize the output table
1521  if (this%iprflow /= 0) then
1522  !
1523  ! -- dimension table
1524  ntabcol = 3
1525  if (this%inamedbound > 0) then
1526  ntabcol = ntabcol + 1
1527  end if
1528  !
1529  ! -- initialize the output table object
1530  title = trim(adjustl(this%text))//' PACKAGE ('//trim(this%packName)// &
1531  ') FLOW RATES'
1532  call table_cr(this%outputtab, this%packName, title)
1533  call this%outputtab%table_df(this%maxbound, ntabcol, this%iout, &
1534  transient=.true.)
1535  text = 'NUMBER'
1536  call this%outputtab%initialize_column(text, 10, alignment=tabcenter)
1537  text = 'CELLID'
1538  call this%outputtab%initialize_column(text, 20, alignment=tableft)
1539  text = 'RATE'
1540  call this%outputtab%initialize_column(text, 15, alignment=tabcenter)
1541  if (this%inamedbound > 0) then
1542  text = 'NAME'
1543  call this%outputtab%initialize_column(text, lenboundname, &
1544  alignment=tableft)
1545  end if
1546  end if
1547  end subroutine pak_setup_outputtab
1548 
1549  !> @ brief Define the list label for the package
1550  !!
1551  !! Method defined the list label for the boundary package. This method
1552  !! needs to be overridden by each boundary package.
1553  !!
1554  !<
1555  subroutine define_listlabel(this)
1556  ! -- dummy variables
1557  class(bndtype), intent(inout) :: this !< BndType object
1558  end subroutine define_listlabel
1559 
1560  ! -- Procedures related to observations
1561 
1562  !> @brief Determine if observations are supported.
1563  !!
1564  !! Function to determine if observations are supported by the boundary package.
1565  !! By default, observations are not supported. This method should be overridden
1566  !! if observations are supported in a boundary package.
1567  !!
1568  !! @return supported boolean indicating if observations are supported
1569  !!
1570  !<
1571  function bnd_obs_supported(this) result(supported)
1572  ! -- return variable
1573  logical(LGP) :: supported !< boolean indicating if observations are supported
1574  ! -- dummy variables
1575  class(bndtype) :: this !< BndType object
1576  !
1577  ! -- initialize return variables
1578  supported = .false.
1579  end function bnd_obs_supported
1580 
1581  !> @brief Define the observation types available in the package
1582  !!
1583  !! Method to define the observation types available in a boundary
1584  !! package. This method should be overridden if observations are
1585  !! supported in a boundary package.
1586  !!
1587  !<
1588  subroutine bnd_df_obs(this)
1589  !
1590  ! -- dummy variables
1591  class(bndtype) :: this !< BndType object
1592  !
1593  ! -- do nothing here. Override as needed.
1594  end subroutine bnd_df_obs
1595 
1596  !> @brief Read and prepare observations for a package
1597  !!
1598  !! Method to read and prepare observations for a boundary package
1599  !! This method should not need to be overridden for most boundary
1600  !! packages.
1601  !!
1602  !<
1603  subroutine bnd_rp_obs(this)
1604  ! -- dummy variables
1605  class(bndtype), intent(inout) :: this !< BndType object
1606  ! -- local variables
1607  integer(I4B) :: i
1608  integer(I4B) :: j
1609  class(observetype), pointer :: obsrv => null()
1610  character(len=LENBOUNDNAME) :: bname
1611  logical(LGP) :: jfound
1612  !
1613  if (.not. this%bnd_obs_supported()) return
1614  !
1615  do i = 1, this%obs%npakobs
1616  obsrv => this%obs%pakobs(i)%obsrv
1617  !
1618  ! -- indxbnds needs to be reset each stress period because
1619  ! list of boundaries can change each stress period.
1620  call obsrv%ResetObsIndex()
1621  obsrv%BndFound = .false.
1622  !
1623  bname = obsrv%FeatureName
1624  if (bname /= '') then
1625  !
1626  ! -- Observation location(s) is(are) based on a boundary name.
1627  ! Iterate through all boundaries to identify and store
1628  ! corresponding index(indices) in bound array.
1629  jfound = .false.
1630  do j = 1, this%nbound
1631  if (this%boundname(j) == bname) then
1632  jfound = .true.
1633  obsrv%BndFound = .true.
1634  obsrv%CurrentTimeStepEndValue = dzero
1635  call obsrv%AddObsIndex(j)
1636  end if
1637  end do
1638  else
1639  !
1640  ! -- Observation location is a single node number
1641  jfound = .false.
1642  jloop: do j = 1, this%nbound
1643  if (this%nodelist(j) == obsrv%NodeNumber) then
1644  jfound = .true.
1645  obsrv%BndFound = .true.
1646  obsrv%CurrentTimeStepEndValue = dzero
1647  call obsrv%AddObsIndex(j)
1648  end if
1649  end do jloop
1650  end if
1651  end do
1652  !
1653  if (count_errors() > 0) then
1654  call store_error_unit(this%inunit)
1655  end if
1656  end subroutine bnd_rp_obs
1657 
1658  !> @brief Save observations for the package
1659  !!
1660  !! Method to save simulated values for the boundary package.
1661  !! This method will need to be overridden for boundary packages
1662  !! with more observations than the calculate flow term (simvals)
1663  !! and to-mover.
1664  !!
1665  !<
1666  subroutine bnd_bd_obs(this)
1667  ! -- dummy variables
1668  class(bndtype) :: this !< BndType object
1669  ! -- local variables
1670  integer(I4B) :: i
1671  integer(I4B) :: n
1672  real(DP) :: v
1673  type(observetype), pointer :: obsrv => null()
1674  !
1675  ! -- clear the observations
1676  call this%obs%obs_bd_clear()
1677  !
1678  ! -- Save simulated values for all of package's observations.
1679  do i = 1, this%obs%npakobs
1680  obsrv => this%obs%pakobs(i)%obsrv
1681  if (obsrv%BndFound) then
1682  do n = 1, obsrv%indxbnds_count
1683  if (obsrv%ObsTypeId == 'TO-MVR') then
1684  if (this%imover == 1) then
1685  v = this%pakmvrobj%get_qtomvr(obsrv%indxbnds(n))
1686  if (v > dzero) then
1687  v = -v
1688  end if
1689  else
1690  v = dnodata
1691  end if
1692  else
1693  v = this%simvals(obsrv%indxbnds(n))
1694  end if
1695  call this%obs%SaveOneSimval(obsrv, v)
1696  end do
1697  else
1698  call this%obs%SaveOneSimval(obsrv, dnodata)
1699  end if
1700  end do
1701  end subroutine bnd_bd_obs
1702 
1703  !> @brief Output observations for the package
1704  !!
1705  !! Method to output simulated values for the boundary package.
1706  !! This method should not need to be overridden.
1707  !!
1708  !<
1709  subroutine bnd_ot_obs(this)
1710  ! -- dummy variables
1711  class(bndtype) :: this !< BndType object
1712  !
1713  ! -- call the observation output method
1714  call this%obs%obs_ot()
1715  end subroutine bnd_ot_obs
1716 
1717  ! -- Procedures related to time series
1718 
1719  !> @brief Assign time series links for the package
1720  !!
1721  !! Assign the time series links for the boundary package. This
1722  !! method will need to be overridden for boundary packages that
1723  !! support time series.
1724  !!
1725  !<
1726  subroutine bnd_rp_ts(this)
1727  ! -- dummy variables
1728  class(bndtype), intent(inout) :: this
1729  end subroutine bnd_rp_ts
1730 
1731  ! -- Procedures related to casting
1732 
1733  !> @brief Cast as a boundary type
1734  !!
1735  !! Subroutine to cast an object as a boundary package type.
1736  !!
1737  !<
1738  function castasbndclass(obj) result(res)
1739  class(*), pointer, intent(inout) :: obj !< input object
1740  class(bndtype), pointer :: res !< output class of type BndType
1741  !
1742  ! -- initialize res
1743  res => null()
1744  !
1745  ! -- make sure obj is associated
1746  if (.not. associated(obj)) return
1747  !
1748  ! -- point res to obj
1749  select type (obj)
1750  class is (bndtype)
1751  res => obj
1752  end select
1753  end function castasbndclass
1754 
1755  !> @brief Add boundary to package list
1756  !!
1757  !! Subroutine to add a boundary package to a package list.
1758  !!
1759  !<
1760  subroutine addbndtolist(list, bnd)
1761  ! -- dummy variables
1762  type(listtype), intent(inout) :: list !< package list
1763  class(bndtype), pointer, intent(inout) :: bnd !< boundary package
1764  ! -- local variables
1765  class(*), pointer :: obj
1766  !
1767  obj => bnd
1768  call list%Add(obj)
1769  end subroutine addbndtolist
1770 
1771  !> @brief Get boundary from package list
1772  !!
1773  !! Function to get a boundary package from a package list.
1774  !!
1775  !! @return res boundary package object
1776  !!
1777  !<
1778  function getbndfromlist(list, idx) result(res)
1779  ! -- dummy variables
1780  type(listtype), intent(inout) :: list !< package list
1781  integer(I4B), intent(in) :: idx !< package number
1782  class(bndtype), pointer :: res !< boundary package idx
1783  ! -- local variables
1784  class(*), pointer :: obj
1785  !
1786  ! -- get the package from the list
1787  obj => list%GetItem(idx)
1788  res => castasbndclass(obj)
1789  end function getbndfromlist
1790 
1791  !> @brief Save and/or print flows for a package
1792  !!
1793  !! Subroutine to save and/or print package flows to a model to a
1794  !! binary cell-by-cell flow file and the model listing file.
1795  !!
1796  !<
1797  subroutine save_print_model_flows(icbcfl, ibudfl, icbcun, iprflow, &
1798  outputtab, nbound, nodelist, flow, ibound, &
1799  title, text, ipakcb, dis, naux, textmodel, &
1800  textpackage, dstmodel, dstpackage, &
1801  auxname, auxvar, iout, inamedbound, &
1802  boundname, imap)
1803  ! -- modules
1804  use tdismodule, only: kstp, kper
1805  ! -- dummy variables
1806  integer(I4B), intent(in) :: icbcfl !< flag indicating if the flow should be saved to the binary cell-by-cell flow file
1807  integer(I4B), intent(in) :: ibudfl !< flag indicating if the flow should be saved or printed
1808  integer(I4B), intent(in) :: icbcun !< file unit number for the binary cell-by-cell file
1809  integer(I4B), intent(in) :: iprflow !< print flows to list file
1810  type(tabletype), pointer, intent(inout) :: outputtab !< output table object
1811  integer(I4B), intent(in) :: nbound !< number of boundaries this stress period
1812  integer(I4B), dimension(:), contiguous, intent(in) :: nodelist !< boundary node list
1813  real(dp), dimension(:), contiguous, intent(in) :: flow !< boundary flow terms
1814  integer(I4B), dimension(:), contiguous, intent(in) :: ibound !< ibound array for the model
1815  character(len=*), intent(in) :: title !< title for the output table
1816  character(len=*), intent(in) :: text !< flow term description
1817  integer(I4B), intent(in) :: ipakcb !< flag indicating if flows will be saved
1818  class(disbasetype), intent(in) :: dis !< model discretization object
1819  integer(I4B), intent(in) :: naux !< number of aux variables
1820  character(len=*), intent(in) :: textmodel !< model name
1821  character(len=*), intent(in) :: textpackage !< package name
1822  character(len=*), intent(in) :: dstmodel !< mover destination model
1823  character(len=*), intent(in) :: dstpackage !< mover destination package
1824  character(len=*), dimension(:), intent(in) :: auxname !< aux variable name
1825  real(dp), dimension(:, :), intent(in) :: auxvar !< aux variable
1826  integer(I4B), intent(in) :: iout !< model listing file unit
1827  integer(I4B), intent(in) :: inamedbound !< flag indicating if boundnames are defined for the boundary entries
1828  character(len=LENBOUNDNAME), dimension(:), contiguous :: boundname !< bound names
1829  integer(I4B), dimension(:), optional, intent(in) :: imap !< mapping array
1830  ! -- local variables
1831  character(len=20) :: nodestr
1832  integer(I4B) :: nodeu
1833  integer(I4B) :: maxrows
1834  integer(I4B) :: i
1835  integer(I4B) :: node
1836  integer(I4B) :: n2
1837  integer(I4B) :: ibinun
1838  integer(I4B) :: nboundcount
1839  real(dp) :: rrate
1840  real(dp), dimension(naux) :: auxrow
1841  ! -- for observations
1842  character(len=LENBOUNDNAME) :: bname
1843  !
1844  ! -- set table kstp and kper
1845  if (iprflow /= 0) then
1846  call outputtab%set_kstpkper(kstp, kper)
1847  end if
1848  !
1849  ! -- set maxrows
1850  maxrows = 0
1851  if (ibudfl /= 0 .and. iprflow /= 0) then
1852  do i = 1, nbound
1853  node = nodelist(i)
1854  if (node > 0) then
1855  maxrows = maxrows + 1
1856  end if
1857  end do
1858  if (maxrows > 0) then
1859  call outputtab%set_maxbound(maxrows)
1860  end if
1861  call outputtab%set_title(title)
1862  end if
1863  !
1864  ! -- Set unit number for binary output
1865  if (ipakcb < 0) then
1866  ibinun = icbcun
1867  else if (ipakcb == 0) then
1868  ibinun = 0
1869  else
1870  ibinun = ipakcb
1871  end if
1872  if (icbcfl == 0) then
1873  ibinun = 0
1874  end if
1875  !
1876  ! -- If cell-by-cell flows will be saved as a list, write header.
1877  if (ibinun /= 0) then
1878  !
1879  ! -- Count nbound as the number of entries with node > 0
1880  ! SFR, for example, can have a 'none' connection, which
1881  ! means it should be excluded from budget file
1882  nboundcount = 0
1883  do i = 1, nbound
1884  node = nodelist(i)
1885  if (node > 0) nboundcount = nboundcount + 1
1886  end do
1887  call dis%record_srcdst_list_header(text, textmodel, textpackage, &
1888  dstmodel, dstpackage, naux, &
1889  auxname, ibinun, nboundcount, iout)
1890  end if
1891  !
1892  ! -- If no boundaries, skip flow calculations.
1893  if (nbound > 0) then
1894  !
1895  ! -- Loop through each boundary calculating flow.
1896  do i = 1, nbound
1897  node = nodelist(i)
1898  ! -- assign boundary name
1899  if (inamedbound > 0) then
1900  bname = boundname(i)
1901  else
1902  bname = ''
1903  end if
1904  !
1905  ! -- If cell is no-flow or constant-head, then ignore it.
1906  rrate = dzero
1907  if (node > 0) then
1908  !
1909  ! -- Use simval, which was calculated in cq()
1910  rrate = flow(i)
1911  !
1912  ! -- Print the individual rates if the budget is being printed
1913  ! and PRINT_FLOWS was specified (iprflow < 0). Rates are
1914  ! printed even if ibound < 1.
1915  if (ibudfl /= 0) then
1916  if (iprflow /= 0) then
1917  !
1918  ! -- set nodestr and write outputtab table
1919  nodeu = dis%get_nodeuser(node)
1920  call dis%nodeu_to_string(nodeu, nodestr)
1921  call outputtab%print_list_entry(i, trim(adjustl(nodestr)), &
1922  rrate, bname)
1923  end if
1924  end if
1925  !
1926  ! -- If saving cell-by-cell flows in list, write flow
1927  if (ibinun /= 0) then
1928  n2 = i
1929  if (present(imap)) n2 = imap(i)
1930  if (naux > 0) then
1931  auxrow(:) = auxvar(:, i)
1932  end if
1933  call dis%record_mf6_list_entry(ibinun, node, n2, rrate, naux, &
1934  auxrow, olconv2=.false.)
1935  end if
1936  end if
1937  !
1938  end do
1939  if (ibudfl /= 0) then
1940  if (iprflow /= 0) then
1941  write (iout, '(1x)')
1942  end if
1943  end if
1944 
1945  end if
1946  end subroutine save_print_model_flows
1947 
1948  !> @brief Activate viscosity terms
1949  !!
1950  !! Method to activate addition of viscosity terms when package type
1951  !! is DRN, GHB, or RIV (method not needed by other packages at this point)
1952  !!
1953  !<
1954  subroutine bnd_activate_viscosity(this)
1955  ! -- modules
1957  ! -- dummy variables
1958  class(bndtype), intent(inout) :: this !< BndType object
1959  ! -- local variables
1960  integer(I4B) :: i
1961  !
1962  ! -- Set ivsc and reallocate viscratios to be of size MAXBOUND
1963  this%ivsc = 1
1964  !
1965  ! -- Allocate array for storing user-specified conductances
1966  ! modified by updated viscosity values
1967  call mem_reallocate(this%condinput, this%maxbound, 'CONDINPUT', &
1968  this%memoryPath)
1969  do i = 1, this%maxbound
1970  this%condinput(i) = dzero
1971  end do
1972  !
1973  ! -- Notify user via listing file viscosity accounted for by standard
1974  ! boundary package.
1975  write (this%iout, '(/1x,a,a)') 'VISCOSITY ACTIVE IN ', &
1976  trim(this%filtyp)//' PACKAGE CALCULATIONS: '//trim(adjustl(this%packName))
1977  end subroutine bnd_activate_viscosity
1978 
1979 end module bndmodule
This module contains block parser methods.
Definition: BlockParser.f90:7
This module contains the base boundary package.
subroutine bnd_read_dimensions(this)
@ brief Read dimensions for package
logical(lgp) function bnd_obs_supported(this)
Determine if observations are supported.
subroutine bnd_ar(this)
@ brief Allocate and read method for boundary package
subroutine bnd_rp(this)
@ brief Allocate and read method for package
subroutine allocate_scalars(this)
@ brief Allocate package scalars
subroutine bnd_ot_dv(this, idvsave, idvprint)
@ brief Output advanced package dependent-variable terms.
subroutine bnd_store_user_cond(this, nlist, rlist, condinput)
@ brief Store user-specified conductances when vsc is active
subroutine bnd_ot_obs(this)
Output observations for the package.
subroutine bnd_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
@ brief Apply Newton-Raphson under-relaxation for package.
subroutine bnd_ot_package_flows(this, icbcfl, ibudfl)
@ brief Output advanced package flow terms.
subroutine bnd_read_options(this)
@ brief Read additional options for package
subroutine bnd_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap)
@ brief Output package flow terms.
subroutine bnd_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
@ brief Convergence check for package.
subroutine bnd_rp_ts(this)
Assign time series links for the package.
subroutine bnd_bd_obs(this)
Save observations for the package.
subroutine bnd_options(this, option, found)
@ brief Read additional options for package
subroutine bnd_da(this)
@ brief Deallocate package memory
subroutine bnd_bd(this, model_budget)
@ brief Add package flows to model budget.
subroutine, public addbndtolist(list, bnd)
Add boundary to package list.
subroutine bnd_cq_simrate(this, hnew, flowja, imover)
@ brief Calculate simrate.
subroutine bnd_mc(this, moffset, matrix_sln)
@ brief Map boundary package connection to matrix
class(bndtype) function, pointer, public getbndfromlist(list, idx)
Get boundary from package list.
subroutine bnd_fc(this, rhs, ia, idxglo, matrix_sln)
@ brief Copy hcof and rhs terms into solution.
subroutine allocate_arrays(this, nodelist, auxvar)
@ brief Allocate package arrays
subroutine bnd_ck(this)
@ brief Check boundary package period data
subroutine pak_setup_outputtab(this)
@ brief Setup output table for package
subroutine bnd_ac(this, moffset, sparse)
@ brief Add boundary package connection to matrix
subroutine bnd_ot_bdsummary(this, kstp, kper, iout, ibudfl)
@ brief Output advanced package budget summary.
subroutine copy_boundname(this)
@ brief Copy boundnames into boundnames_cst
subroutine bnd_df_obs(this)
Define the observation types available in the package.
subroutine bnd_reset(this)
@ brief Reset bnd package before formulating
subroutine bnd_activate_viscosity(this)
Activate viscosity terms.
subroutine bnd_cq_simtomvr(this, flowja)
@ brief Calculate flow to the mover.
subroutine bnd_read_initial_attr(this)
@ brief Read initial parameters for package
subroutine, public save_print_model_flows(icbcfl, ibudfl, icbcun, iprflow, outputtab, nbound, nodelist, flow, ibound, title, text, ipakcb, dis, naux, textmodel, textpackage, dstmodel, dstpackage, auxname, auxvar, iout, inamedbound, boundname, imap)
Save and/or print flows for a package.
subroutine set_pointers(this, neq, ibound, xnew, xold, flowja)
@ brief Set pointers to model variables
subroutine bnd_rp_obs(this)
Read and prepare observations for a package.
subroutine bnd_cf(this)
@ brief Formulate the package hcof and rhs terms.
subroutine bnd_fn(this, rhs, ia, idxglo, matrix_sln)
@ brief Add Newton-Raphson terms for package into solution.
subroutine bnd_ad(this)
@ brief Advance the boundary package
class(bndtype) function, pointer, private castasbndclass(obj)
Cast as a boundary type.
subroutine bnd_cq(this, x, flowja, iadv)
@ brief Calculate advanced package flows.
subroutine define_listlabel(this)
@ brief Define the list label for the package
subroutine pack_initialize(this)
@ brief Allocate and initialize select package members
subroutine bnd_df(this, neq, dis)
@ brief Define boundary package options and dimensions
This module contains the BudgetModule.
Definition: Budget.f90:20
subroutine, public rate_accumulator(flow, rin, rout)
@ brief Rate accumulator subroutine
Definition: Budget.f90:632
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
@ tabcenter
centered table column
Definition: Constants.f90:172
@ tableft
left justified table column
Definition: Constants.f90:171
integer(i4b), parameter lenmodelname
maximum length of the model name
Definition: Constants.f90:22
integer(i4b), parameter lenpackagename
maximum length of the package name
Definition: Constants.f90:23
real(dp), parameter dnodata
real no data constant
Definition: Constants.f90:95
integer(i4b), parameter lenlistlabel
maximum length of a llist label
Definition: Constants.f90:46
integer(i4b), parameter lenpakloc
maximum length of a package location
Definition: Constants.f90:50
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
Definition: Constants.f90:39
integer(i4b), parameter lenauxname
maximum length of a aux variable
Definition: Constants.f90:35
integer(i4b), parameter lenboundname
maximum length of a bound name
Definition: Constants.f90:36
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
integer(i4b), parameter maxcharlen
maximum length of char string
Definition: Constants.f90:47
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
real(dp), parameter done
real constant 1
Definition: Constants.f90:76
subroutine, public urdaux(naux, inunit, iout, lloc, istart, istop, auxname, line, text)
Read auxiliary variables from an input line.
integer(i4b) function, public getunit()
Get a free unit number.
subroutine, public openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, filstat_opt, mode_opt)
Open a file.
Definition: InputOutput.f90:30
This module defines variable data types.
Definition: kind.f90:8
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains the base numerical package type.
This module contains the derived types ObserveType and ObsDataType.
Definition: Observe.f90:15
This module contains the derived type ObsType.
Definition: Obs.f90:127
subroutine, public obs_cr(obs, inobs)
@ brief Create a new ObsType object
Definition: Obs.f90:225
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
Definition: Sim.f90:168
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
subroutine, public table_cr(this, name, title)
Definition: Table.f90:87
real(dp), pointer, public totimc
simulation time at start of time step
Definition: tdis.f90:33
integer(i4b), pointer, public kstp
current time step number
Definition: tdis.f90:24
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:23
real(dp), pointer, public delt
length of the current time step
Definition: tdis.f90:29
integer(i4b), pointer, public nper
number of stress period
Definition: tdis.f90:21
subroutine, public tasmanager_cr(this, dis, modelname, iout)
Create the time-array series manager.
subroutine, public tsmanager_cr(this, iout, removeTsLinksOnCompletion, extendTsToEndOfSimulation)
Create the tsmanager.
@ brief BndType
Derived type for the Budget object.
Definition: Budget.f90:39
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23
A generic heterogeneous doubly-linked list.
Definition: List.f90:14