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