MODFLOW 6  version 6.9.0.dev0
USGS Modular Hydrologic Model
gwt-mwt.f90
Go to the documentation of this file.
1 ! -- Multi-Aquifer Well Transport Module
2 ! -- todo: what to do about reactions in maw? Decay?
3 ! -- todo: save the mwt concentration into the mwt aux variable?
4 ! -- todo: calculate the maw DENSE aux variable using concentration?
5 !
6 ! MAW flows (flowbudptr) index var MWT term Transport Type
7 !---------------------------------------------------------------------------------
8 
9 ! -- terms from MAW that will be handled by parent APT Package
10 ! FLOW-JA-FACE idxbudfjf FLOW-JA-FACE cv2cv (note that this doesn't exist for MAW)
11 ! GWF (aux FLOW-AREA) idxbudgwf GWF cv2gwf
12 ! STORAGE (aux VOLUME) idxbudsto none used for cv volumes
13 ! FROM-MVR idxbudfmvr FROM-MVR q * cext = this%qfrommvr(:)
14 ! TO-MVR idxbudtmvr TO-MVR q * cfeat
15 
16 ! -- MAW terms
17 ! RATE idxbudrate RATE q < 0: q * cwell, else q * cuser
18 ! FW-RATE idxbudfwrt FW-RATE q * cwell
19 ! RATE-TO-MVR idxbudrtmv RATE-TO-MVR q * cwell
20 ! FW-RATE-TO-MVR idxbudfrtm FW-RATE-TO-MVR q * cwell
21 
22 ! -- terms from MAW that should be skipped
23 ! CONSTANT-TO-MVR ? CONSTANT-TO-MVR q * cwell
24 
25 ! -- terms from a flow file that should be skipped
26 ! CONSTANT none none none
27 ! AUXILIARY none none none
28 
29 ! -- terms that are written to the transport budget file
30 ! none none STORAGE (aux MASS) dM/dt
31 ! none none AUXILIARY none
32 ! none none CONSTANT accumulate
33 !
34 !
36 
37  use kindmodule, only: dp, i4b
42  use bndmodule, only: bndtype, getbndfromlist
43  use tspfmimodule, only: tspfmitype
44  use mawmodule, only: mawtype
45  use observemodule, only: observetype
49 
50  implicit none
51 
52  public mwt_create
53 
54  character(len=*), parameter :: ftype = 'MWT'
55  character(len=*), parameter :: flowtype = 'MAW'
56  character(len=16) :: text = ' MWT'
57 
58  type, extends(tspapttype) :: gwtmwttype
59 
60  integer(I4B), pointer :: idxbudrate => null() ! index of well rate terms in flowbudptr
61  integer(I4B), pointer :: idxbudfwrt => null() ! index of flowing well rate terms in flowbudptr
62  integer(I4B), pointer :: idxbudrtmv => null() ! index of rate to mover terms in flowbudptr
63  integer(I4B), pointer :: idxbudfrtm => null() ! index of flowing well rate to mover terms in flowbudptr
64  real(dp), dimension(:), pointer, contiguous :: concrate => null() ! well rate concentration
65 
66  contains
67 
68  procedure :: bnd_da => mwt_da
69  procedure :: allocate_scalars
70  procedure :: apt_allocate_arrays => mwt_allocate_arrays
71  procedure :: apt_checkin_deprecated_names => mwt_checkin_deprecated_names
72  procedure :: find_apt_package => find_mwt_package
73  procedure :: apt_setting_value => mwt_setting_value
74  procedure :: pak_fc_expanded => mwt_fc_expanded
75  procedure :: pak_solve => mwt_solve
76  procedure :: pak_get_nbudterms => mwt_get_nbudterms
77  procedure :: pak_setup_budobj => mwt_setup_budobj
78  procedure :: pak_fill_budobj => mwt_fill_budobj
79  procedure :: mwt_rate_term
80  procedure :: mwt_fwrt_term
81  procedure :: mwt_rtmv_term
82  procedure :: mwt_frtm_term
83  procedure :: pak_df_obs => mwt_df_obs
84  procedure :: pak_rp_obs => mwt_rp_obs
85  procedure :: pak_bd_obs => mwt_bd_obs
86 
87  end type gwtmwttype
88 
89 contains
90 
91  !> Create new MWT package
92  !<
93  subroutine mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
94  mempath, fmi, eqnsclfac, dvt, dvu, dvua)
95  ! -- dummy
96  class(bndtype), pointer :: packobj
97  integer(I4B), intent(in) :: id
98  integer(I4B), intent(in) :: ibcnum
99  integer(I4B), intent(in) :: inunit
100  integer(I4B), intent(in) :: iout
101  character(len=*), intent(in) :: namemodel
102  character(len=*), intent(in) :: pakname
103  character(len=*), intent(in) :: mempath !< input memory path
104  type(tspfmitype), pointer :: fmi
105  real(dp), intent(in), pointer :: eqnsclfac !< governing equation scale factor
106  character(len=*), intent(in) :: dvt !< For GWT, set to "CONCENTRATION" in TspAptType
107  character(len=*), intent(in) :: dvu !< For GWT, set to "mass" in TspAptType
108  character(len=*), intent(in) :: dvua !< For GWT, set to "M" in TspAptType
109  ! -- local
110  type(gwtmwttype), pointer :: mwtobj
111  !
112  ! -- allocate the object and assign values to object variables
113  allocate (mwtobj)
114  packobj => mwtobj
115  !
116  ! -- create name and memory path
117  call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
118  packobj%text = text
119  !
120  ! -- allocate scalars
121  call mwtobj%allocate_scalars()
122  !
123  ! -- initialize package
124  call packobj%pack_initialize()
125 
126  packobj%inunit = inunit
127  packobj%iout = iout
128  packobj%id = id
129  packobj%ibcnum = ibcnum
130  packobj%ncolbnd = 1
131  packobj%iscloc = 1
132  packobj%isadvpak = 1
133 
134  ! -- Store pointer to flow model interface. When the GwfGwt exchange is
135  ! created, it sets fmi%bndlist so that the GWT model has access to all
136  ! the flow packages
137  mwtobj%fmi => fmi
138  !
139  ! -- Store pointer to governing equation scale factor
140  mwtobj%eqnsclfac => eqnsclfac
141  !
142  ! -- Set labels that will be used in generalized APT class
143  mwtobj%depvartype = dvt
144  mwtobj%depvarunit = dvu
145  mwtobj%depvarunitabbrev = dvua
146  end subroutine mwt_create
147 
148  !> @brief find corresponding mwt package
149  !<
150  subroutine find_mwt_package(this)
151  ! -- modules
153  ! -- dummy
154  class(gwtmwttype) :: this
155  ! -- local
156  character(len=LINELENGTH) :: errmsg
157  class(bndtype), pointer :: packobj
158  integer(I4B) :: ip, icount
159  integer(I4B) :: nbudterm
160  logical :: found
161  !
162  ! -- Initialize found to false, and error later if flow package cannot
163  ! be found
164  found = .false.
165  !
166  ! -- If user is specifying flows in a binary budget file, then set up
167  ! the budget file reader, otherwise set a pointer to the flow package
168  ! budobj
169  if (this%fmi%flows_from_file) then
170  call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
171  if (associated(this%flowbudptr)) found = .true.
172  !
173  else
174  if (associated(this%fmi%gwfbndlist)) then
175  ! -- Look through gwfbndlist for a flow package with the same name as
176  ! this transport package name
177  do ip = 1, this%fmi%gwfbndlist%Count()
178  packobj => getbndfromlist(this%fmi%gwfbndlist, ip)
179  if (packobj%packName == this%flowpackagename) then
180  found = .true.
181  !
182  ! -- store BndType pointer to packobj, and then
183  ! use the select type to point to the budobj in flow package
184  this%flowpackagebnd => packobj
185  select type (packobj)
186  type is (mawtype)
187  this%flowbudptr => packobj%budobj
188  end select
189  end if
190  if (found) exit
191  end do
192  end if
193  end if
194  !
195  ! -- error if flow package not found
196  if (.not. found) then
197  write (errmsg, '(a)') 'Could not find flow package with name '&
198  &//trim(adjustl(this%flowpackagename))//'.'
199  call store_error(errmsg)
200  call store_error_filename(this%input_fname)
201  end if
202  !
203  ! -- allocate space for idxbudssm, which indicates whether this is a
204  ! special budget term or one that is a general source and sink
205  nbudterm = this%flowbudptr%nbudterm
206  call mem_allocate(this%idxbudssm, nbudterm, 'IDXBUDSSM', this%memoryPath)
207  !
208  ! -- Process budget terms and identify special budget terms
209  write (this%iout, '(/, a, a)') &
210  'PROCESSING '//ftype//' INFORMATION FOR ', this%packName
211  write (this%iout, '(a)') ' IDENTIFYING FLOW TERMS IN '//flowtype//' PACKAGE'
212  write (this%iout, '(a, i0)') &
213  ' NUMBER OF '//flowtype//' = ', this%flowbudptr%ncv
214  icount = 1
215  do ip = 1, this%flowbudptr%nbudterm
216  select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
217  case ('FLOW-JA-FACE')
218  this%idxbudfjf = ip
219  this%idxbudssm(ip) = 0
220  case ('GWF')
221  this%idxbudgwf = ip
222  this%idxbudssm(ip) = 0
223  case ('STORAGE')
224  this%idxbudsto = ip
225  this%idxbudssm(ip) = 0
226  case ('RATE')
227  this%idxbudrate = ip
228  this%idxbudssm(ip) = 0
229  case ('FW-RATE')
230  this%idxbudfwrt = ip
231  this%idxbudssm(ip) = 0
232  case ('RATE-TO-MVR')
233  this%idxbudrtmv = ip
234  this%idxbudssm(ip) = 0
235  case ('FW-RATE-TO-MVR')
236  this%idxbudfrtm = ip
237  this%idxbudssm(ip) = 0
238  case ('TO-MVR')
239  this%idxbudtmvr = ip
240  this%idxbudssm(ip) = 0
241  case ('FROM-MVR')
242  this%idxbudfmvr = ip
243  this%idxbudssm(ip) = 0
244  case ('AUXILIARY')
245  this%idxbudaux = ip
246  this%idxbudssm(ip) = 0
247  case default
248  !
249  ! -- set idxbudssm equal to a column index for where the concentrations
250  ! are stored in the concbud(nbudssm, ncv) array
251  this%idxbudssm(ip) = icount
252  icount = icount + 1
253  end select
254  write (this%iout, '(a, i0, " = ", a,/, a, i0)') &
255  ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
256  ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
257  end do
258  write (this%iout, '(a, //)') 'DONE PROCESSING '//ftype//' INFORMATION'
259  end subroutine find_mwt_package
260 
261  !> @brief Value for a package-specific PERIOD setting
262  !!
263  !! Already resolved by the input context; this only supplies it for
264  !! the shared apt_rp table echo.
265  !<
266  function mwt_setting_value(this, itemno, key) result(val)
267  ! -- dummy
268  class(gwtmwttype), intent(inout) :: this
269  integer(I4B), intent(in) :: itemno
270  character(len=*), intent(in) :: key
271  real(dp) :: val
272  !
273  val = dzero
274  select case (trim(key))
275  case ('RATE')
276  val = this%concrate(itemno)
277  end select
278  end function mwt_setting_value
279 
280  !> @brief Add matrix terms related to MWT
281  !!
282  !! This routine is called from TspAptType%apt_fc_expanded() in
283  !! order to add matrix terms specifically for MWT
284  !<
285  subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
286  ! -- modules
287  ! -- dummy
288  class(gwtmwttype) :: this
289  real(DP), dimension(:), intent(inout) :: rhs
290  integer(I4B), dimension(:), intent(in) :: ia
291  integer(I4B), dimension(:), intent(in) :: idxglo
292  class(matrixbasetype), pointer :: matrix_sln
293  ! -- local
294  integer(I4B) :: j, n1, n2
295  integer(I4B) :: iloc
296  integer(I4B) :: iposd
297  real(DP) :: rrate
298  real(DP) :: rhsval
299  real(DP) :: hcofval
300  !
301  ! -- add puping rate contribution
302  if (this%idxbudrate /= 0) then
303  do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
304  call this%mwt_rate_term(j, n1, n2, rrate, rhsval, hcofval)
305  iloc = this%idxlocnode(n1)
306  iposd = this%idxpakdiag(n1)
307  call matrix_sln%add_value_pos(iposd, hcofval)
308  rhs(iloc) = rhs(iloc) + rhsval
309  end do
310  end if
311  !
312  ! -- add flowing well rate contribution
313  if (this%idxbudfwrt /= 0) then
314  do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
315  call this%mwt_fwrt_term(j, n1, n2, rrate, rhsval, hcofval)
316  iloc = this%idxlocnode(n1)
317  iposd = this%idxpakdiag(n1)
318  call matrix_sln%add_value_pos(iposd, hcofval)
319  rhs(iloc) = rhs(iloc) + rhsval
320  end do
321  end if
322  !
323  ! -- add rate to mover contribution
324  if (this%idxbudrtmv /= 0) then
325  do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
326  call this%mwt_rtmv_term(j, n1, n2, rrate, rhsval, hcofval)
327  iloc = this%idxlocnode(n1)
328  iposd = this%idxpakdiag(n1)
329  call matrix_sln%add_value_pos(iposd, hcofval)
330  rhs(iloc) = rhs(iloc) + rhsval
331  end do
332  end if
333  !
334  ! -- add puping rate contribution
335  if (this%idxbudfrtm /= 0) then
336  do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
337  call this%mwt_frtm_term(j, n1, n2, rrate, rhsval, hcofval)
338  iloc = this%idxlocnode(n1)
339  iposd = this%idxpakdiag(n1)
340  call matrix_sln%add_value_pos(iposd, hcofval)
341  rhs(iloc) = rhs(iloc) + rhsval
342  end do
343  end if
344  end subroutine mwt_fc_expanded
345 
346  !> @ brief Add terms specific to multi-aquifer wells to the explicit multi-
347  !! aquifer well solute transport solve
348  !<
349  subroutine mwt_solve(this)
350  ! -- dummy
351  class(gwtmwttype) :: this
352  ! -- local
353  integer(I4B) :: j
354  integer(I4B) :: n1, n2
355  real(DP) :: rrate
356  !
357  ! -- add well pumping contribution
358  if (this%idxbudrate /= 0) then
359  do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
360  call this%mwt_rate_term(j, n1, n2, rrate)
361  this%dbuff(n1) = this%dbuff(n1) + rrate
362  end do
363  end if
364  !
365  ! -- add flowing well rate contribution
366  if (this%idxbudfwrt /= 0) then
367  do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
368  call this%mwt_fwrt_term(j, n1, n2, rrate)
369  this%dbuff(n1) = this%dbuff(n1) + rrate
370  end do
371  end if
372  !
373  ! -- add well pumping rate to mover contribution
374  if (this%idxbudrtmv /= 0) then
375  do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
376  call this%mwt_rtmv_term(j, n1, n2, rrate)
377  this%dbuff(n1) = this%dbuff(n1) + rrate
378  end do
379  end if
380  !
381  ! -- add flowing well rate to mover contribution
382  if (this%idxbudfrtm /= 0) then
383  do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
384  call this%mwt_frtm_term(j, n1, n2, rrate)
385  this%dbuff(n1) = this%dbuff(n1) + rrate
386  end do
387  end if
388  end subroutine mwt_solve
389 
390  !> @brief Function to return the number of budget terms just for this package
391  !!
392  !! This overrides a function in the parent class.
393  !<
394  function mwt_get_nbudterms(this) result(nbudterms)
395  ! -- modules
396  ! -- dummy
397  class(gwtmwttype) :: this
398  ! -- Return
399  integer(I4B) :: nbudterms
400  ! -- local
401  !
402  ! -- Number of budget terms is 4
403  nbudterms = 1
404  if (this%idxbudfwrt /= 0) nbudterms = nbudterms + 1
405  if (this%idxbudrtmv /= 0) nbudterms = nbudterms + 1
406  if (this%idxbudfrtm /= 0) nbudterms = nbudterms + 1
407  end function mwt_get_nbudterms
408 
409  !> @brief Set up the budget object that stores all the mwt flows
410  !<
411  subroutine mwt_setup_budobj(this, idx)
412  ! -- modules
413  use constantsmodule, only: lenbudtxt
414  ! -- dummy
415  class(gwtmwttype) :: this
416  integer(I4B), intent(inout) :: idx
417  ! -- local
418  integer(I4B) :: maxlist, naux
419  character(len=LENBUDTXT) :: text
420  !
421  ! --
422  text = ' RATE'
423  idx = idx + 1
424  maxlist = this%flowbudptr%budterm(this%idxbudrate)%maxlist
425  naux = 0
426  call this%budobj%budterm(idx)%initialize(text, &
427  this%name_model, &
428  this%packName, &
429  this%name_model, &
430  this%packName, &
431  maxlist, .false., .false., &
432  naux)
433  !
434  ! --
435  if (this%idxbudfwrt /= 0) then
436  text = ' FW-RATE'
437  idx = idx + 1
438  maxlist = this%flowbudptr%budterm(this%idxbudfwrt)%maxlist
439  naux = 0
440  call this%budobj%budterm(idx)%initialize(text, &
441  this%name_model, &
442  this%packName, &
443  this%name_model, &
444  this%packName, &
445  maxlist, .false., .false., &
446  naux)
447  end if
448  !
449  ! --
450  if (this%idxbudrtmv /= 0) then
451  text = ' RATE-TO-MVR'
452  idx = idx + 1
453  maxlist = this%flowbudptr%budterm(this%idxbudrtmv)%maxlist
454  naux = 0
455  call this%budobj%budterm(idx)%initialize(text, &
456  this%name_model, &
457  this%packName, &
458  this%name_model, &
459  this%packName, &
460  maxlist, .false., .false., &
461  naux)
462  end if
463  !
464  ! --
465  if (this%idxbudfrtm /= 0) then
466  text = ' FW-RATE-TO-MVR'
467  idx = idx + 1
468  maxlist = this%flowbudptr%budterm(this%idxbudfrtm)%maxlist
469  naux = 0
470  call this%budobj%budterm(idx)%initialize(text, &
471  this%name_model, &
472  this%packName, &
473  this%name_model, &
474  this%packName, &
475  maxlist, .false., .false., &
476  naux)
477  end if
478  end subroutine mwt_setup_budobj
479 
480  !> @brief Copy flow terms into this%budobj
481  !<
482  subroutine mwt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
483  ! -- modules
484  ! -- dummy
485  class(gwtmwttype) :: this
486  integer(I4B), intent(inout) :: idx
487  real(DP), dimension(:), intent(in) :: x
488  real(DP), dimension(:), contiguous, intent(inout) :: flowja
489  real(DP), intent(inout) :: ccratin
490  real(DP), intent(inout) :: ccratout
491  ! -- local
492  integer(I4B) :: j, n1, n2
493  integer(I4B) :: nlist
494  real(DP) :: q
495  ! -- formats
496  !
497  ! -- RATE
498  idx = idx + 1
499  nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist
500  call this%budobj%budterm(idx)%reset(nlist)
501  do j = 1, nlist
502  call this%mwt_rate_term(j, n1, n2, q)
503  call this%budobj%budterm(idx)%update_term(n1, n2, q)
504  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
505  end do
506  !
507  ! -- FW-RATE
508  if (this%idxbudfwrt /= 0) then
509  idx = idx + 1
510  nlist = this%flowbudptr%budterm(this%idxbudfwrt)%nlist
511  call this%budobj%budterm(idx)%reset(nlist)
512  do j = 1, nlist
513  call this%mwt_fwrt_term(j, n1, n2, q)
514  call this%budobj%budterm(idx)%update_term(n1, n2, q)
515  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
516  end do
517  end if
518  !
519  ! -- RATE-TO-MVR
520  if (this%idxbudrtmv /= 0) then
521  idx = idx + 1
522  nlist = this%flowbudptr%budterm(this%idxbudrtmv)%nlist
523  call this%budobj%budterm(idx)%reset(nlist)
524  do j = 1, nlist
525  call this%mwt_rtmv_term(j, n1, n2, q)
526  call this%budobj%budterm(idx)%update_term(n1, n2, q)
527  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
528  end do
529  end if
530  !
531  ! -- FW-RATE-TO-MVR
532  if (this%idxbudfrtm /= 0) then
533  idx = idx + 1
534  nlist = this%flowbudptr%budterm(this%idxbudfrtm)%nlist
535  call this%budobj%budterm(idx)%reset(nlist)
536  do j = 1, nlist
537  call this%mwt_frtm_term(j, n1, n2, q)
538  call this%budobj%budterm(idx)%update_term(n1, n2, q)
539  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
540  end do
541  end if
542  end subroutine mwt_fill_budobj
543 
544  !> @brief Allocate scalars specific to the streamflow mass transport (SFT)
545  !! package.
546  !<
547  subroutine allocate_scalars(this)
548  ! -- modules
550  ! -- dummy
551  class(gwtmwttype) :: this
552  ! -- local
553  !
554  ! -- allocate scalars in TspAptType
555  call this%TspAptType%allocate_scalars()
556  !
557  ! -- Allocate
558  call mem_allocate(this%idxbudrate, 'IDXBUDRATE', this%memoryPath)
559  call mem_allocate(this%idxbudfwrt, 'IDXBUDFWRT', this%memoryPath)
560  call mem_allocate(this%idxbudrtmv, 'IDXBUDRTMV', this%memoryPath)
561  call mem_allocate(this%idxbudfrtm, 'IDXBUDFRTM', this%memoryPath)
562  !
563  ! -- Initialize
564  this%idxbudrate = 0
565  this%idxbudfwrt = 0
566  this%idxbudrtmv = 0
567  this%idxbudfrtm = 0
568  end subroutine allocate_scalars
569 
570  !> @brief Allocate arrays specific to the streamflow mass transport (SFT)
571  !! package.
572  !<
573  subroutine mwt_allocate_arrays(this)
574  ! -- modules
576  ! -- dummy
577  class(gwtmwttype), intent(inout) :: this
578  !
579  ! -- alias into the input context's permanent, feature-indexed RATE
580  ! array (allocated and DZERO-initialized by the input context)
581  call mem_setptr(this%concrate, 'RATE', this%input_mempath)
582  !
583  ! -- call standard TspAptType allocate arrays
584  call this%TspAptType%apt_allocate_arrays()
585  !
586  end subroutine mwt_allocate_arrays
587 
588  !> @brief Alias deprecated MWT variable names to their current storage
589  !<
591  ! -- modules
593  ! -- dummy
594  class(gwtmwttype), intent(inout) :: this
595  ! -- code
596  !
597  ! -- names common to all advanced transport packages
598  call this%TspAptType%apt_checkin_deprecated_names()
599  !
600  call mem_alias_deprecated(this%concrate, 'CONCRATE', this%memoryPath, &
601  'RATE', this%input_mempath, '6.8.2')
602  end subroutine mwt_checkin_deprecated_names
603 
604  !> @brief Deallocate memory
605  !<
606  subroutine mwt_da(this)
607  ! -- modules
609  ! -- dummy
610  class(gwtmwttype) :: this
611  ! -- local
612  !
613  ! -- deallocate scalars
614  call mem_deallocate(this%idxbudrate)
615  call mem_deallocate(this%idxbudfwrt)
616  call mem_deallocate(this%idxbudrtmv)
617  call mem_deallocate(this%idxbudfrtm)
618  !
619  ! -- input-context-owned alias, not package-allocated
620  nullify (this%concrate)
621  !
622  ! -- deallocate scalars in TspAptType
623  call this%TspAptType%bnd_da()
624  end subroutine mwt_da
625 
626  !> @brief Rate term associated with pumping (or injection)
627  !<
628  subroutine mwt_rate_term(this, ientry, n1, n2, rrate, &
629  rhsval, hcofval)
630  ! -- dummy
631  class(gwtmwttype) :: this
632  integer(I4B), intent(in) :: ientry
633  integer(I4B), intent(inout) :: n1
634  integer(I4B), intent(inout) :: n2
635  real(DP), intent(inout), optional :: rrate
636  real(DP), intent(inout), optional :: rhsval
637  real(DP), intent(inout), optional :: hcofval
638  ! -- local
639  real(DP) :: qbnd
640  real(DP) :: ctmp
641  real(DP) :: h, r
642  !
643  n1 = this%flowbudptr%budterm(this%idxbudrate)%id1(ientry)
644  n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry)
645  ! -- note that qbnd is negative for extracting well
646  qbnd = this%flowbudptr%budterm(this%idxbudrate)%flow(ientry)
647  if (qbnd < dzero) then
648  ctmp = this%xnewpak(n1)
649  h = qbnd
650  r = dzero
651  else
652  ctmp = this%concrate(n1)
653  h = dzero
654  r = -qbnd * ctmp
655  end if
656  if (present(rrate)) rrate = qbnd * ctmp
657  if (present(rhsval)) rhsval = r
658  if (present(hcofval)) hcofval = h
659  end subroutine mwt_rate_term
660 
661  !> @brief Transport matrix term(s) associated with a flowing-
662  !! well rate term associated with pumping (or injection)
663  !<
664  subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, &
665  rhsval, hcofval)
666  ! -- dummy
667  class(gwtmwttype) :: this
668  integer(I4B), intent(in) :: ientry
669  integer(I4B), intent(inout) :: n1
670  integer(I4B), intent(inout) :: n2
671  real(DP), intent(inout), optional :: rrate
672  real(DP), intent(inout), optional :: rhsval
673  real(DP), intent(inout), optional :: hcofval
674  ! -- local
675  real(DP) :: qbnd
676  real(DP) :: ctmp
677  !
678  n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry)
679  n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry)
680  qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry)
681  ctmp = this%xnewpak(n1)
682  if (present(rrate)) rrate = ctmp * qbnd
683  if (present(rhsval)) rhsval = dzero
684  if (present(hcofval)) hcofval = qbnd
685  end subroutine mwt_fwrt_term
686 
687  !> @brief Rate-to-mvr term associated with pumping (or injection)
688  !!
689  !! Pumped water that is made available to the MVR package for transfer to
690  !! another advanced package
691  !<
692  subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, &
693  rhsval, hcofval)
694  ! -- dummy
695  class(gwtmwttype) :: this
696  integer(I4B), intent(in) :: ientry
697  integer(I4B), intent(inout) :: n1
698  integer(I4B), intent(inout) :: n2
699  real(DP), intent(inout), optional :: rrate
700  real(DP), intent(inout), optional :: rhsval
701  real(DP), intent(inout), optional :: hcofval
702  ! -- local
703  real(DP) :: qbnd
704  real(DP) :: ctmp
705  !
706  n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry)
707  n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry)
708  qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry)
709  ctmp = this%xnewpak(n1)
710  if (present(rrate)) rrate = ctmp * qbnd
711  if (present(rhsval)) rhsval = dzero
712  if (present(hcofval)) hcofval = qbnd
713  end subroutine mwt_rtmv_term
714 
715  !> @brief Flowing well rate-to-mvr term (or injection)
716  !!
717  !! Pumped water that is made available to the MVR package for transfer to
718  !! another advanced package
719  !<
720  subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, &
721  rhsval, hcofval)
722  ! -- dummy
723  class(gwtmwttype) :: this
724  integer(I4B), intent(in) :: ientry
725  integer(I4B), intent(inout) :: n1
726  integer(I4B), intent(inout) :: n2
727  real(DP), intent(inout), optional :: rrate
728  real(DP), intent(inout), optional :: rhsval
729  real(DP), intent(inout), optional :: hcofval
730  ! -- local
731  real(DP) :: qbnd
732  real(DP) :: ctmp
733  !
734  n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry)
735  n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry)
736  qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry)
737  ctmp = this%xnewpak(n1)
738  if (present(rrate)) rrate = ctmp * qbnd
739  if (present(rhsval)) rhsval = dzero
740  if (present(hcofval)) hcofval = qbnd
741  end subroutine mwt_frtm_term
742 
743  !> @brief Observations
744  !!
745  !! Store the observation type supported by the APT package and override
746  !! BndType%bnd_df_obs
747  !<
748  subroutine mwt_df_obs(this)
749  ! -- modules
750  ! -- dummy
751  class(gwtmwttype) :: this
752  ! -- local
753  integer(I4B) :: indx
754  !
755  ! -- Store obs type and assign procedure pointer
756  ! for concentration observation type.
757  call this%obs%StoreObsType('concentration', .false., indx)
758  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
759  !
760  ! -- flow-ja-face not supported for MWT
761  !call this%obs%StoreObsType('flow-ja-face', .true., indx)
762  !this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
763  !
764  ! -- Store obs type and assign procedure pointer
765  ! for from-mvr observation type.
766  call this%obs%StoreObsType('from-mvr', .true., indx)
767  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
768  !
769  ! -- to-mvr not supported for mwt
770  !call this%obs%StoreObsType('to-mvr', .true., indx)
771  !this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
772  !
773  ! -- Store obs type and assign procedure pointer
774  ! for storage observation type.
775  call this%obs%StoreObsType('storage', .true., indx)
776  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
777  !
778  ! -- Store obs type and assign procedure pointer
779  ! for constant observation type.
780  call this%obs%StoreObsType('constant', .true., indx)
781  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
782  !
783  ! -- Store obs type and assign procedure pointer
784  ! for observation type: mwt
785  call this%obs%StoreObsType('mwt', .true., indx)
786  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid12
787  !
788  ! -- Store obs type and assign procedure pointer
789  ! for rate observation type.
790  call this%obs%StoreObsType('rate', .true., indx)
791  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
792  !
793  ! -- Store obs type and assign procedure pointer
794  ! for observation type.
795  call this%obs%StoreObsType('fw-rate', .true., indx)
796  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
797  !
798  ! -- Store obs type and assign procedure pointer
799  ! for observation type.
800  call this%obs%StoreObsType('rate-to-mvr', .true., indx)
801  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
802  !
803  ! -- Store obs type and assign procedure pointer
804  ! for observation type.
805  call this%obs%StoreObsType('fw-rate-to-mvr', .true., indx)
806  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
807  end subroutine mwt_df_obs
808 
809  !> @brief Process package specific obs
810  !!
811  !! Method to process specific observations for this package.
812  !<
813  subroutine mwt_rp_obs(this, obsrv, found)
814  ! -- dummy
815  class(gwtmwttype), intent(inout) :: this !< package class
816  type(observetype), intent(inout) :: obsrv !< observation object
817  logical, intent(inout) :: found !< indicate whether observation was found
818  ! -- local
819  !
820  found = .true.
821  select case (obsrv%ObsTypeId)
822  case ('RATE')
823  call this%rp_obs_byfeature(obsrv)
824  case ('FW-RATE')
825  call this%rp_obs_byfeature(obsrv)
826  case ('RATE-TO-MVR')
827  call this%rp_obs_byfeature(obsrv)
828  case ('FW-RATE-TO-MVR')
829  call this%rp_obs_byfeature(obsrv)
830  case default
831  found = .false.
832  end select
833  end subroutine mwt_rp_obs
834 
835  !> @brief Calculate observation value and pass it back to APT
836  !<
837  subroutine mwt_bd_obs(this, obstypeid, jj, v, found)
838  ! -- dummy
839  class(gwtmwttype), intent(inout) :: this
840  character(len=*), intent(in) :: obstypeid
841  real(DP), intent(inout) :: v
842  integer(I4B), intent(in) :: jj
843  logical, intent(inout) :: found
844  ! -- local
845  integer(I4B) :: n1, n2
846  !
847  found = .true.
848  select case (obstypeid)
849  case ('RATE')
850  if (this%iboundpak(jj) /= 0) then
851  call this%mwt_rate_term(jj, n1, n2, v)
852  end if
853  case ('FW-RATE')
854  if (this%iboundpak(jj) /= 0 .and. this%idxbudfwrt > 0) then
855  call this%mwt_fwrt_term(jj, n1, n2, v)
856  end if
857  case ('RATE-TO-MVR')
858  if (this%iboundpak(jj) /= 0 .and. this%idxbudrtmv > 0) then
859  call this%mwt_rtmv_term(jj, n1, n2, v)
860  end if
861  case ('FW-RATE-TO-MVR')
862  if (this%iboundpak(jj) /= 0 .and. this%idxbudfrtm > 0) then
863  call this%mwt_frtm_term(jj, n1, n2, v)
864  end if
865  case default
866  found = .false.
867  end select
868  end subroutine mwt_bd_obs
869 
870 end module gwtmwtmodule
This module contains the base boundary package.
class(bndtype) function, pointer, public getbndfromlist(list, idx)
Get boundary from package list.
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
real(dp), parameter dnodata
real no data constant
Definition: Constants.f90:95
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:37
character(len= *), parameter flowtype
Definition: gwt-mwt.f90:55
subroutine mwt_bd_obs(this, obstypeid, jj, v, found)
Calculate observation value and pass it back to APT.
Definition: gwt-mwt.f90:838
subroutine find_mwt_package(this)
find corresponding mwt package
Definition: gwt-mwt.f90:151
subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to MWT.
Definition: gwt-mwt.f90:286
subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Transport matrix term(s) associated with a flowing- well rate term associated with pumping (or inject...
Definition: gwt-mwt.f90:666
character(len=16) text
Definition: gwt-mwt.f90:56
subroutine, public mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, fmi, eqnsclfac, dvt, dvu, dvua)
Create new MWT package.
Definition: gwt-mwt.f90:95
subroutine mwt_checkin_deprecated_names(this)
Alias deprecated MWT variable names to their current storage.
Definition: gwt-mwt.f90:591
subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Flowing well rate-to-mvr term (or injection)
Definition: gwt-mwt.f90:722
subroutine mwt_setup_budobj(this, idx)
Set up the budget object that stores all the mwt flows.
Definition: gwt-mwt.f90:412
subroutine mwt_da(this)
Deallocate memory.
Definition: gwt-mwt.f90:607
character(len= *), parameter ftype
Definition: gwt-mwt.f90:54
subroutine mwt_rp_obs(this, obsrv, found)
Process package specific obs.
Definition: gwt-mwt.f90:814
subroutine allocate_scalars(this)
Allocate scalars specific to the streamflow mass transport (SFT) package.
Definition: gwt-mwt.f90:548
integer(i4b) function mwt_get_nbudterms(this)
Function to return the number of budget terms just for this package.
Definition: gwt-mwt.f90:395
subroutine mwt_solve(this)
@ brief Add terms specific to multi-aquifer wells to the explicit multi- aquifer well solute transpor...
Definition: gwt-mwt.f90:350
subroutine mwt_df_obs(this)
Observations.
Definition: gwt-mwt.f90:749
subroutine mwt_allocate_arrays(this)
Allocate arrays specific to the streamflow mass transport (SFT) package.
Definition: gwt-mwt.f90:574
real(dp) function mwt_setting_value(this, itemno, key)
Value for a package-specific PERIOD setting.
Definition: gwt-mwt.f90:267
subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rate-to-mvr term associated with pumping (or injection)
Definition: gwt-mwt.f90:694
subroutine mwt_rate_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rate term associated with pumping (or injection)
Definition: gwt-mwt.f90:630
subroutine mwt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
Copy flow terms into thisbudobj.
Definition: gwt-mwt.f90:483
This module defines variable data types.
Definition: kind.f90:8
Previous variable names checked in as deprecated aliases.
Definition: MemoryAlias.f90:7
This module contains the derived types ObserveType and ObsDataType.
Definition: Observe.f90:15
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
Definition: Sim.f90:204
subroutine, public apt_process_obsid(obsrv, dis, inunitobs, iout)
Process observation IDs for an advanced package.
Definition: tsp-apt.f90:2729
subroutine, public apt_process_obsid12(obsrv, dis, inunitobs, iout)
Process observation IDs for a package.
Definition: tsp-apt.f90:2772
@ brief BndType
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23