MODFLOW 6 version 6.9.0.dev0
USGS Modular Hydrologic Model
Loading...
Searching...
No Matches
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!<
8
9 use kindmodule, only: dp, lgp, i4b
11 dzero, done, &
16 use simvariablesmodule, only: errmsg
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
34
35 implicit none
36
37 private
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
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
171contains
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
1991 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 if (this%inamedbound == 0) then
1611 ! -- boundname has no elements without BOUNDNAMES
1612 write (errmsg, '(a,1x,a,1x,a,1x,a,1x,a,1x,a)') &
1613 'Observation', trim(obsrv%Name), 'uses boundary name', trim(bname), &
1614 'but BOUNDNAMES is not specified in package', trim(this%packName)
1615 call store_error(errmsg)
1616 cycle
1617 end if
1618 do j = 1, this%nbound
1619 if (this%boundname(j) == bname) then
1620 jfound = .true.
1621 obsrv%BndFound = .true.
1622 obsrv%CurrentTimeStepEndValue = dzero
1623 call obsrv%AddObsIndex(j)
1624 end if
1625 end do
1626 else
1627 !
1628 ! -- Observation location is a single node number
1629 jfound = .false.
1630 jloop: do j = 1, this%nbound
1631 if (this%nodelist(j) == obsrv%NodeNumber) then
1632 jfound = .true.
1633 obsrv%BndFound = .true.
1634 obsrv%CurrentTimeStepEndValue = dzero
1635 call obsrv%AddObsIndex(j)
1636 end if
1637 end do jloop
1638 end if
1639 end do
1640 !
1641 if (count_errors() > 0) then
1642 call store_error_filename(this%input_fname)
1643 end if
1644 end subroutine bnd_rp_obs
1645
1646 !> @brief Save observations for the package
1647 !!
1648 !! Method to save simulated values for the boundary package.
1649 !! This method will need to be overridden for boundary packages
1650 !! with more observations than the calculate flow term (simvals)
1651 !! and to-mover.
1652 !<
1653 subroutine bnd_bd_obs(this)
1654 ! -- dummy
1655 class(bndtype) :: this !< BndType object
1656 ! -- local
1657 integer(I4B) :: i
1658 integer(I4B) :: n
1659 real(DP) :: v
1660 type(observetype), pointer :: obsrv => null()
1661 !
1662 ! -- clear the observations
1663 call this%obs%obs_bd_clear()
1664 !
1665 ! -- Save simulated values for all of package's observations.
1666 do i = 1, this%obs%npakobs
1667 obsrv => this%obs%pakobs(i)%obsrv
1668 if (obsrv%BndFound) then
1669 do n = 1, obsrv%indxbnds_count
1670 if (obsrv%ObsTypeId == 'TO-MVR') then
1671 if (this%imover == 1) then
1672 v = this%pakmvrobj%get_qtomvr(obsrv%indxbnds(n))
1673 if (v > dzero) then
1674 v = -v
1675 end if
1676 else
1677 v = dnodata
1678 end if
1679 else
1680 v = this%simvals(obsrv%indxbnds(n))
1681 end if
1682 call this%obs%SaveOneSimval(obsrv, v)
1683 end do
1684 else
1685 call this%obs%SaveOneSimval(obsrv, dnodata)
1686 end if
1687 end do
1688 end subroutine bnd_bd_obs
1689
1690 !> @brief Output observations for the package
1691 !!
1692 !! Method to output simulated values for the boundary package.
1693 !! This method should not need to be overridden.
1694 !<
1695 subroutine bnd_ot_obs(this)
1696 ! -- dummy
1697 class(bndtype) :: this !< BndType object
1698 !
1699 ! -- call the observation output method
1700 call this%obs%obs_ot()
1701 end subroutine bnd_ot_obs
1702
1703 ! -- Procedures related to time series
1704
1705 !> @brief Assign time series links for the package
1706 !!
1707 !! Assign the time series links for the boundary package. This
1708 !! method will need to be overridden for boundary packages that
1709 !! support time series.
1710 !<
1711 subroutine bnd_rp_ts(this)
1712 ! -- dummy
1713 class(bndtype), intent(inout) :: this
1714 end subroutine bnd_rp_ts
1715
1716 !> @brief Log period input for a boundary package
1717 !!
1718 !! Write stress period input to the listing file if requested. This
1719 !! default implementation is a no-op; BndExtType overrides it.
1720 !<
1721 subroutine bnd_rp_log(this)
1722 ! -- dummy
1723 class(bndtype), intent(inout) :: this
1724 end subroutine bnd_rp_log
1725
1726 ! -- Procedures related to casting
1727
1728 !> @brief Cast as a boundary type
1729 !!
1730 !! Subroutine to cast an object as a boundary package type.
1731 !<
1732 function castasbndclass(obj) result(res)
1733 class(*), pointer, intent(inout) :: obj !< input object
1734 class(bndtype), pointer :: res !< output class of type BndType
1735 !
1736 ! -- initialize res
1737 res => null()
1738 !
1739 ! -- make sure obj is associated
1740 if (.not. associated(obj)) return
1741 !
1742 ! -- point res to obj
1743 select type (obj)
1744 class is (bndtype)
1745 res => obj
1746 end select
1747 end function castasbndclass
1748
1749 !> @brief Add boundary to package list
1750 !!
1751 !! Subroutine to add a boundary package to a package list.
1752 !<
1753 subroutine addbndtolist(list, bnd)
1754 ! -- dummy
1755 type(listtype), intent(inout) :: list !< package list
1756 class(bndtype), pointer, intent(inout) :: bnd !< boundary package
1757 ! -- local
1758 class(*), pointer :: obj
1759 !
1760 obj => bnd
1761 call list%Add(obj)
1762 end subroutine addbndtolist
1763
1764 !> @brief Get boundary from package list
1765 !!
1766 !! Function to get a boundary package from a package list.
1767 !!
1768 !! @return res boundary package object
1769 !<
1770 function getbndfromlist(list, idx) result(res)
1771 ! -- dummy
1772 type(listtype), intent(inout) :: list !< package list
1773 integer(I4B), intent(in) :: idx !< package number
1774 class(bndtype), pointer :: res !< boundary package idx
1775 ! -- local
1776 class(*), pointer :: obj
1777 !
1778 ! -- get the package from the list
1779 obj => list%GetItem(idx)
1780 res => castasbndclass(obj)
1781 end function getbndfromlist
1782
1783 !> @brief Save and/or print flows for a package
1784 !!
1785 !! Subroutine to save and/or print package flows to a model to a
1786 !! binary cell-by-cell flow file and the model listing file.
1787 !<
1788 subroutine save_print_model_flows(icbcfl, ibudfl, icbcun, iprflow, &
1789 outputtab, nbound, nodelist, flow, ibound, &
1790 title, text, ipakcb, dis, naux, textmodel, &
1791 textpackage, dstmodel, dstpackage, &
1792 auxname, auxvar, iout, inamedbound, &
1793 boundname, imap)
1794 ! -- modules
1795 use tdismodule, only: kstp, kper
1796 ! -- dummy
1797 integer(I4B), intent(in) :: icbcfl !< flag indicating if the flow should be saved to the binary cell-by-cell flow file
1798 integer(I4B), intent(in) :: ibudfl !< flag indicating if the flow should be saved or printed
1799 integer(I4B), intent(in) :: icbcun !< file unit number for the binary cell-by-cell file
1800 integer(I4B), intent(in) :: iprflow !< print flows to list file
1801 type(tabletype), pointer, intent(inout) :: outputtab !< output table object
1802 integer(I4B), intent(in) :: nbound !< number of boundaries this stress period
1803 integer(I4B), dimension(:), contiguous, intent(in) :: nodelist !< boundary node list
1804 real(dp), dimension(:), contiguous, intent(in) :: flow !< boundary flow terms
1805 integer(I4B), dimension(:), contiguous, intent(in) :: ibound !< ibound array for the model
1806 character(len=*), intent(in) :: title !< title for the output table
1807 character(len=*), intent(in) :: text !< flow term description
1808 integer(I4B), intent(in) :: ipakcb !< flag indicating if flows will be saved
1809 class(disbasetype), intent(in) :: dis !< model discretization object
1810 integer(I4B), intent(in) :: naux !< number of aux variables
1811 character(len=*), intent(in) :: textmodel !< model name
1812 character(len=*), intent(in) :: textpackage !< package name
1813 character(len=*), intent(in) :: dstmodel !< mover destination model
1814 character(len=*), intent(in) :: dstpackage !< mover destination package
1815 character(len=*), dimension(:), intent(in) :: auxname !< aux variable name
1816 real(dp), dimension(:, :), intent(in) :: auxvar !< aux variable
1817 integer(I4B), intent(in) :: iout !< model listing file unit
1818 integer(I4B), intent(in) :: inamedbound !< flag indicating if boundnames are defined for the boundary entries
1819 character(len=LENBOUNDNAME), dimension(:), contiguous :: boundname !< bound names
1820 integer(I4B), dimension(:), optional, intent(in) :: imap !< mapping array
1821 ! -- local
1822 character(len=20) :: nodestr
1823 integer(I4B) :: nodeu
1824 integer(I4B) :: maxrows
1825 integer(I4B) :: i
1826 integer(I4B) :: node
1827 integer(I4B) :: n2
1828 integer(I4B) :: ibinun
1829 integer(I4B) :: nboundcount
1830 real(dp) :: rrate
1831 real(dp), dimension(naux) :: auxrow
1832 ! -- for observations
1833 character(len=LENBOUNDNAME) :: bname
1834 !
1835 ! -- set table kstp and kper
1836 if (iprflow /= 0) then
1837 call outputtab%set_kstpkper(kstp, kper)
1838 end if
1839 !
1840 ! -- set maxrows
1841 maxrows = 0
1842 if (ibudfl /= 0 .and. iprflow /= 0) then
1843 do i = 1, nbound
1844 node = nodelist(i)
1845 if (node > 0) then
1846 maxrows = maxrows + 1
1847 end if
1848 end do
1849 if (maxrows > 0) then
1850 call outputtab%set_maxbound(maxrows)
1851 end if
1852 call outputtab%set_title(title)
1853 end if
1854 !
1855 ! -- Set unit number for binary output
1856 if (ipakcb < 0) then
1857 ibinun = icbcun
1858 else if (ipakcb == 0) then
1859 ibinun = 0
1860 else
1861 ibinun = ipakcb
1862 end if
1863 if (icbcfl == 0) then
1864 ibinun = 0
1865 end if
1866 !
1867 ! -- If cell-by-cell flows will be saved as a list, write header.
1868 if (ibinun /= 0) then
1869 !
1870 ! -- Count nbound as the number of entries with node > 0
1871 ! SFR, for example, can have a 'none' connection, which
1872 ! means it should be excluded from budget file
1873 nboundcount = 0
1874 do i = 1, nbound
1875 node = nodelist(i)
1876 if (node > 0) nboundcount = nboundcount + 1
1877 end do
1878 call dis%record_srcdst_list_header(text, textmodel, textpackage, &
1879 dstmodel, dstpackage, naux, &
1880 auxname, ibinun, nboundcount, iout)
1881 end if
1882 !
1883 ! -- If no boundaries, skip flow calculations.
1884 if (nbound > 0) then
1885 !
1886 ! -- Loop through each boundary calculating flow.
1887 do i = 1, nbound
1888 node = nodelist(i)
1889 ! -- assign boundary name
1890 if (inamedbound > 0) then
1891 bname = boundname(i)
1892 else
1893 bname = ''
1894 end if
1895 !
1896 ! -- If cell is no-flow or constant-head, then ignore it.
1897 rrate = dzero
1898 if (node > 0) then
1899 !
1900 ! -- Use simval, which was calculated in cq()
1901 rrate = flow(i)
1902 !
1903 ! -- Print the individual rates if the budget is being printed
1904 ! and PRINT_FLOWS was specified (iprflow < 0). Rates are
1905 ! printed even if ibound < 1.
1906 if (ibudfl /= 0) then
1907 if (iprflow /= 0) then
1908 !
1909 ! -- set nodestr and write outputtab table
1910 nodeu = dis%get_nodeuser(node)
1911 call dis%nodeu_to_string(nodeu, nodestr)
1912 call outputtab%print_list_entry(i, trim(adjustl(nodestr)), &
1913 rrate, bname)
1914 end if
1915 end if
1916 !
1917 ! -- If saving cell-by-cell flows in list, write flow
1918 if (ibinun /= 0) then
1919 n2 = i
1920 if (present(imap)) n2 = imap(i)
1921 if (naux > 0) then
1922 auxrow(:) = auxvar(:, i)
1923 end if
1924 call dis%record_mf6_list_entry(ibinun, node, n2, rrate, naux, &
1925 auxrow, olconv2=.false.)
1926 end if
1927 end if
1928 !
1929 end do
1930 if (ibudfl /= 0) then
1931 if (iprflow /= 0) then
1932 write (iout, '(1x)')
1933 end if
1934 end if
1935
1936 end if
1937 end subroutine save_print_model_flows
1938
1939 !> @brief Activate viscosity terms
1940 !!
1941 !! Method to activate addition of viscosity terms when package type
1942 !! is DRN, GHB, or RIV (method not needed by other packages at this point)
1943 !<
1944 subroutine bnd_activate_viscosity(this)
1945 ! -- modules
1947 ! -- dummy
1948 class(bndtype), intent(inout) :: this !< BndType object
1949 ! -- local
1950 integer(I4B) :: i
1951 !
1952 ! -- Set ivsc and reallocate viscratios to be of size MAXBOUND
1953 this%ivsc = 1
1954 !
1955 ! -- Allocate array for storing user-specified conductances
1956 ! modified by updated viscosity values
1957 call mem_reallocate(this%condinput, this%maxbound, 'CONDINPUT', &
1958 this%memoryPath)
1959 do i = 1, this%maxbound
1960 this%condinput(i) = dzero
1961 end do
1962 !
1963 ! -- Notify user via listing file viscosity accounted for by standard
1964 ! boundary package.
1965 write (this%iout, '(/1x,a,a)') 'VISCOSITY ACTIVE IN ', &
1966 trim(this%filtyp)//' PACKAGE CALCULATIONS: '//trim(adjustl(this%packName))
1967 end subroutine bnd_activate_viscosity
1968
1969end module bndmodule
This module contains block parser methods.
integer(i4b) function getunit(this)
@ brief Get the unit number
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:634
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
@ tableft
left justified table column
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
@ dis
DIS6 discretization.
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.
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_filename(filename, terminate)
Store the erroring file name.
Definition Sim.f90:204
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
integer(i4b) iout
file unit number for simulation output
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.
Derived type for the Budget object.
Definition Budget.f90:40
This class is used to store a single deferred-length character string. It was designed to work in an ...
A generic heterogeneous doubly-linked list.
Definition List.f90:14