MODFLOW 6  version 6.7.0.dev3
USGS Modular Hydrologic Model
tspadvmodule Module Reference

Data Types

type  tspadvtype
 

Functions/Subroutines

subroutine, public adv_cr (advobj, name_model, input_mempath, inunit, iout, fmi, eqnsclfac)
 @ brief Create a new ADV object More...
 
subroutine adv_df (this, adv_options)
 Define ADV object. More...
 
subroutine adv_ar (this, dis, ibound)
 Allocate and read method for package. More...
 
subroutine adv_dt (this, dtmax, msg, thetam)
 Calculate maximum time step length. More...
 
subroutine adv_fc (this, nodes, matrix_sln, idxglo, cnew, rhs)
 Fill coefficient method for ADV package. More...
 
subroutine adv_cq (this, cnew, flowja)
 Calculate advection contribution to flowja. More...
 
subroutine adv_da (this)
 Deallocate memory. More...
 
subroutine allocate_scalars (this)
 Allocate scalars specific to the streamflow energy transport (SFE) package. More...
 
subroutine source_options (this)
 Source input options. More...
 

Function/Subroutine Documentation

◆ adv_ar()

subroutine tspadvmodule::adv_ar ( class(tspadvtype this,
class(disbasetype), intent(in), pointer  dis,
integer(i4b), dimension(:), intent(in), pointer, contiguous  ibound 
)
private

Method to allocate and read static data for the ADV package.

Definition at line 117 of file tsp-adv.f90.

118  ! -- modules
119  use simmodule, only: store_error
120  ! -- dummy
121  class(TspAdvType) :: this
122  class(DisBaseType), pointer, intent(in) :: dis
123  integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ibound
124  ! -- local
125  integer(I4B) :: iadvwt_value
126  class(IGradientType), allocatable :: gradient
127  ! -- adv pointers to arguments that were passed in
128  this%dis => dis
129  this%ibound => ibound
130  !
131  ! -- Create interpolation scheme
132  iadvwt_value = this%iadvwt ! Dereference iadvwt to work with case statement
133  select case (iadvwt_value)
134  case (adv_scheme_upstream)
135  this%face_interpolation = &
136  upstreamschemetype(this%dis, this%fmi)
137  case (adv_scheme_central)
138  this%face_interpolation = &
139  centraldifferenceschemetype(this%dis, this%fmi)
140  case (adv_scheme_tvd)
141  this%face_interpolation = &
142  tvdschemetype(this%dis, this%fmi, this%ibound)
143  case (adv_scheme_utvd)
144  gradient = leastsquaresgradienttype(this%dis)
145  this%gradient = cachedgradienttype(gradient, this%dis)
146  this%face_interpolation = &
147  utvdschemetype(this%dis, this%fmi, this%gradient)
148  case default
149  call store_error("Unknown advection scheme", terminate=.true.)
150  end select
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
Here is the call graph for this function:

◆ adv_cq()

subroutine tspadvmodule::adv_cq ( class(tspadvtype this,
real(dp), dimension(:), intent(in), target  cnew,
real(dp), dimension(:), intent(inout)  flowja 
)
private

Definition at line 258 of file tsp-adv.f90.

259  ! -- modules
260  ! -- dummy
261  class(TspAdvType) :: this
262  real(DP), intent(in), dimension(:), target :: cnew
263  real(DP), intent(inout), dimension(:) :: flowja
264  ! -- local
265  integer(I4B) :: nodes
266  integer(I4B) :: n, m, ipos
267  real(DP) :: qnm
268  type(CoefficientsType) :: coefficients
269  !
270  ! -- Calculate advection and add to flowja. qnm is the volumetric flow
271  ! rate and has dimensions of L^/T.
272  nodes = this%dis%nodes
273 
274  call this%face_interpolation%set_field(cnew)
275  do n = 1, nodes
276  if (this%ibound(n) == 0) cycle
277  do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1
278  m = this%dis%con%ja(ipos)
279  if (this%ibound(m) == 0) cycle
280  qnm = this%fmi%gwfflowja(ipos) * this%eqnsclfac
281 
282  coefficients = this%face_interpolation%compute(n, m, ipos)
283  flowja(ipos) = flowja(ipos) &
284  + qnm * coefficients%c_n * cnew(n) &
285  + qnm * coefficients%c_m * cnew(m) &
286  - qnm * coefficients%rhs
287  end do
288  end do
289 

◆ adv_cr()

subroutine, public tspadvmodule::adv_cr ( type(tspadvtype), pointer  advobj,
character(len=*), intent(in)  name_model,
character(len=*), intent(in)  input_mempath,
integer(i4b), intent(in)  inunit,
integer(i4b), intent(in)  iout,
type(tspfmitype), intent(in), target  fmi,
real(dp), intent(in), pointer  eqnsclfac 
)

Create a new ADV package

Parameters
[in]eqnsclfacgoverning equation scale factor

Definition at line 58 of file tsp-adv.f90.

60  ! -- dummy
61  type(TspAdvType), pointer :: advobj
62  character(len=*), intent(in) :: name_model
63  character(len=*), intent(in) :: input_mempath
64  integer(I4B), intent(in) :: inunit
65  integer(I4B), intent(in) :: iout
66  type(TspFmiType), intent(in), target :: fmi
67  real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
68  !
69  ! -- Create the object
70  allocate (advobj)
71  !
72  ! -- create name and memory path
73  call advobj%set_names(1, name_model, 'ADV', 'ADV', input_mempath)
74  !
75  ! -- Allocate scalars
76  call advobj%allocate_scalars()
77  !
78  ! -- Set variables
79  advobj%inunit = inunit
80  advobj%iout = iout
81  advobj%fmi => fmi
82  advobj%eqnsclfac => eqnsclfac
Here is the caller graph for this function:

◆ adv_da()

subroutine tspadvmodule::adv_da ( class(tspadvtype this)
private

Definition at line 294 of file tsp-adv.f90.

295  ! -- modules
297  ! -- dummy
298  class(TspAdvType) :: this
299  !
300  ! -- Deallocate arrays if package was active
301  if (this%inunit > 0) then
302  end if
303  !
304  ! -- nullify pointers
305  this%ibound => null()
306  !
307  ! -- Scalars
308  call mem_deallocate(this%iadvwt)
309  call mem_deallocate(this%ats_percel)
310  !
311  ! -- deallocate parent
312  call this%NumericalPackageType%da()

◆ adv_df()

subroutine tspadvmodule::adv_df ( class(tspadvtype this,
type(tspadvoptionstype), intent(in), optional  adv_options 
)
private

Define the ADV package

Parameters
[in]adv_optionsthe optional options, for when not constructing from file

Definition at line 89 of file tsp-adv.f90.

90  ! -- dummy
91  class(TspAdvType) :: this
92  type(TspAdvOptionsType), optional, intent(in) :: adv_options !< the optional options, for when not constructing from file
93  ! -- local
94  character(len=*), parameter :: fmtadv = &
95  "(1x,/1x,'ADV -- ADVECTION PACKAGE, VERSION 1, 8/25/2017', &
96  &' INPUT READ FROM MEMPATH: ', A, //)"
97  !
98  ! -- Read or set advection options
99  if (.not. present(adv_options)) then
100  !
101  ! --print a message identifying the advection package.
102  write (this%iout, fmtadv) this%input_mempath
103  !
104  ! --read options from file
105  call this%source_options()
106  else
107  !
108  ! --set options from input arg
109  this%iadvwt = adv_options%iAdvScheme
110  end if

◆ adv_dt()

subroutine tspadvmodule::adv_dt ( class(tspadvtype this,
real(dp), intent(out)  dtmax,
character(len=*), intent(inout)  msg,
real(dp), dimension(:), intent(in)  thetam 
)

Return the largest time step that meets stability constraints

Parameters
thisthis instance
[out]dtmaxmaximum allowable dt subject to stability constraint
[in,out]msgpackage/cell dt constraint message
[in]thetamporosity

Definition at line 157 of file tsp-adv.f90.

158  ! dummy
159  class(TspAdvType) :: this !< this instance
160  real(DP), intent(out) :: dtmax !< maximum allowable dt subject to stability constraint
161  character(len=*), intent(inout) :: msg !< package/cell dt constraint message
162  real(DP), dimension(:), intent(in) :: thetam !< porosity
163  ! local
164  integer(I4B) :: n
165  integer(I4B) :: m
166  integer(I4B) :: ipos
167  integer(I4B) :: nrmax
168  character(len=LINELENGTH) :: cellstr
169  real(DP) :: dt
170  real(DP) :: flowmax
171  real(DP) :: flowsumpos
172  real(DP) :: flowsumneg
173  real(DP) :: flownm
174  real(DP) :: cell_volume
175  dtmax = dnodata
176  nrmax = 0
177  msg = ''
178 
179  ! If ats_percel not specified by user, then return without making
180  ! the courant time step calculation
181  if (this%ats_percel == dnodata) then
182  return
183  end if
184 
185  ! Calculate time step lengths based on stability constraint for each cell
186  ! and store the smallest one
187  do n = 1, this%dis%nodes
188  if (this%ibound(n) == 0) cycle
189  flowsumneg = dzero
190  flowsumpos = dzero
191  do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1
192  if (this%dis%con%mask(ipos) == 0) cycle
193  m = this%dis%con%ja(ipos)
194  if (this%ibound(m) == 0) cycle
195  flownm = this%fmi%gwfflowja(ipos)
196  if (flownm < dzero) then
197  flowsumneg = flowsumneg - flownm
198  else
199  flowsumpos = flowsumpos + flownm
200  end if
201  end do
202  flowmax = max(flowsumneg, flowsumpos)
203  if (flowmax < dprec) cycle
204  cell_volume = this%dis%get_cell_volume(n, this%dis%top(n))
205  dt = cell_volume * this%fmi%gwfsat(n) * thetam(n) / flowmax
206  dt = dt * this%ats_percel
207  if (dt < dtmax) then
208  dtmax = dt
209  nrmax = n
210  end if
211  end do
212  if (nrmax > 0) then
213  call this%dis%noder_to_string(nrmax, cellstr)
214  write (msg, *) adjustl(trim(this%memoryPath))//'-'//trim(cellstr)
215  end if

◆ adv_fc()

subroutine tspadvmodule::adv_fc ( class(tspadvtype this,
integer(i4b), intent(in)  nodes,
class(matrixbasetype), pointer  matrix_sln,
integer(i4b), dimension(:), intent(in)  idxglo,
real(dp), dimension(:), intent(in), target  cnew,
real(dp), dimension(:), intent(inout)  rhs 
)
private

Method to calculate coefficients and fill amat and rhs.

Parameters
thisthis instance
[in]nodesnumber of nodes
matrix_slnpointer to solution matrix
[in]idxgloglobal indices for matrix
[in]cnewnew concentration/temperature values
[in,out]rhsright-hand side vector

Definition at line 222 of file tsp-adv.f90.

223  ! -- modules
224  ! -- dummy
225  class(TspAdvType) :: this !< this instance
226  integer(I4B), intent(in) :: nodes !< number of nodes
227  class(MatrixBaseType), pointer :: matrix_sln !< pointer to solution matrix
228  integer(I4B), intent(in), dimension(:) :: idxglo !< global indices for matrix
229  real(DP), intent(in), dimension(:), target :: cnew !< new concentration/temperature values
230  real(DP), dimension(:), intent(inout) :: rhs !< right-hand side vector
231  ! -- local
232  integer(I4B) :: n, m, idiag, ipos
233  real(DP) :: qnm !< volumetric flow rate
234  type(CoefficientsType) :: coefficients
235 
236  ! Calculate internal domain fluxes and add to matrix_sln and rhs.
237  call this%face_interpolation%set_field(cnew)
238  do n = 1, nodes
239  if (this%ibound(n) == 0) cycle ! skip inactive nodes
240  idiag = this%dis%con%ia(n)
241  do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1
242  m = this%dis%con%ja(ipos)
243  if (this%ibound(m) == 0) cycle ! skip inactive nodes
244  if (this%dis%con%mask(ipos) == 0) cycle ! skip masked connections
245 
246  qnm = this%fmi%gwfflowja(ipos) * this%eqnsclfac
247  coefficients = this%face_interpolation%compute(n, m, ipos)
248 
249  call matrix_sln%add_value_pos(idxglo(idiag), qnm * coefficients%c_n)
250  call matrix_sln%add_value_pos(idxglo(ipos), qnm * coefficients%c_m)
251  rhs(n) = rhs(n) + qnm * coefficients%rhs
252  end do
253  end do

◆ allocate_scalars()

subroutine tspadvmodule::allocate_scalars ( class(tspadvtype this)

Definition at line 318 of file tsp-adv.f90.

319  ! -- modules
321  ! -- dummy
322  class(TspAdvType) :: this
323  ! -- local
324  !
325  ! -- allocate scalars in NumericalPackageType
326  call this%NumericalPackageType%allocate_scalars()
327  !
328  ! -- Allocate
329  call mem_allocate(this%iadvwt, 'IADVWT', this%memoryPath)
330  call mem_allocate(this%ats_percel, 'ATS_PERCEL', this%memoryPath)
331  !
332  ! -- Initialize
333  this%iadvwt = adv_scheme_upstream
334  this%ats_percel = dnodata
335  !
336  ! -- Advection creates an asymmetric coefficient matrix
337  this%iasym = 1

◆ source_options()

subroutine tspadvmodule::source_options ( class(tspadvtype this)

Definition at line 342 of file tsp-adv.f90.

343  ! -- modules
344  use kindmodule, only: lgp
345  use constantsmodule, only: lenvarname
346  use simvariablesmodule, only: errmsg
349  ! -- dummy
350  class(TspAdvType) :: this
351  ! -- locals
352  character(len=LENVARNAME), dimension(4) :: scheme = &
353  &[character(len=LENVARNAME) :: 'UPSTREAM', 'CENTRAL', 'TVD', 'UTVD']
354  logical(lgp) :: found_scheme, found_atspercel
355  ! -- formats
356  character(len=*), parameter :: fmtiadvwt = &
357  &"(4x,'ADVECTION WEIGHTING SCHEME HAS BEEN SET TO: ', a)"
358 
359  ! update defaults with input sourced values
360  call mem_set_value(this%iadvwt, 'SCHEME', this%input_mempath, &
361  scheme, found_scheme)
362  call mem_set_value(this%ats_percel, 'ATS_PERCEL', this%input_mempath, &
363  found_atspercel)
364 
365  if (found_scheme) then
366  ! should currently be set to index of scheme names
367  if (this%iadvwt == 0) then
368  write (errmsg, '(a, a)') &
369  'Unknown scheme, must be "UPSTREAM", "CENTRAL", "TVD" or "UTVD"'
370  call store_error(errmsg)
371  call store_error_filename(this%input_fname)
372  else
373  ! scheme parameters are 0 based
374  this%iadvwt = this%iadvwt - 1
375  end if
376  end if
377 
378  if (this%iadvwt == adv_scheme_utvd) then
379  call dev_feature('UTVD is still under development, install the &
380  &nightly build or compile from source with IDEVELOPMODE = 1.')
381  end if
382 
383  if (found_atspercel) then
384  if (this%ats_percel == dzero) this%ats_percel = dnodata
385  end if
386 
387  ! log options
388  write (this%iout, '(1x,a)') 'PROCESSING ADVECTION OPTIONS'
389  if (found_scheme) then
390  write (this%iout, fmtiadvwt) trim(scheme(this%iadvwt + 1))
391  end if
392  if (found_atspercel) then
393  write (this%iout, '(4x,a,1pg15.6)') &
394  'User-specified fractional cell distance for adaptive time &
395  &steps: ', this%ats_percel
396  end if
397  write (this%iout, '(1x,a)') 'END OF ADVECTION OPTIONS'
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
This module defines variable data types.
Definition: kind.f90:8
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
Definition: Sim.f90:203
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
Here is the call graph for this function: