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