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