MODFLOW 6  version 6.5.0.dev2
MODFLOW 6 Code Documentation
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  !
142  ! -- Return
143  return
144  end subroutine mwt_create
145 
146  !> @brief find corresponding mwt package
147  !<
148  subroutine find_mwt_package(this)
149  ! -- modules
151  ! -- dummy
152  class(gwtmwttype) :: this
153  ! -- local
154  character(len=LINELENGTH) :: errmsg
155  class(bndtype), pointer :: packobj
156  integer(I4B) :: ip, icount
157  integer(I4B) :: nbudterm
158  logical :: found
159  !
160  ! -- Initialize found to false, and error later if flow package cannot
161  ! be found
162  found = .false.
163  !
164  ! -- If user is specifying flows in a binary budget file, then set up
165  ! the budget file reader, otherwise set a pointer to the flow package
166  ! budobj
167  if (this%fmi%flows_from_file) then
168  call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
169  if (associated(this%flowbudptr)) found = .true.
170  !
171  else
172  if (associated(this%fmi%gwfbndlist)) then
173  ! -- Look through gwfbndlist for a flow package with the same name as
174  ! this transport package name
175  do ip = 1, this%fmi%gwfbndlist%Count()
176  packobj => getbndfromlist(this%fmi%gwfbndlist, ip)
177  if (packobj%packName == this%flowpackagename) then
178  found = .true.
179  !
180  ! -- store BndType pointer to packobj, and then
181  ! use the select type to point to the budobj in flow package
182  this%flowpackagebnd => packobj
183  select type (packobj)
184  type is (mawtype)
185  this%flowbudptr => packobj%budobj
186  end select
187  end if
188  if (found) exit
189  end do
190  end if
191  end if
192  !
193  ! -- error if flow package not found
194  if (.not. found) then
195  write (errmsg, '(a)') 'Could not find flow package with name '&
196  &//trim(adjustl(this%flowpackagename))//'.'
197  call store_error(errmsg)
198  call this%parser%StoreErrorUnit()
199  end if
200  !
201  ! -- allocate space for idxbudssm, which indicates whether this is a
202  ! special budget term or one that is a general source and sink
203  nbudterm = this%flowbudptr%nbudterm
204  call mem_allocate(this%idxbudssm, nbudterm, 'IDXBUDSSM', this%memoryPath)
205  !
206  ! -- Process budget terms and identify special budget terms
207  write (this%iout, '(/, a, a)') &
208  'PROCESSING '//ftype//' INFORMATION FOR ', this%packName
209  write (this%iout, '(a)') ' IDENTIFYING FLOW TERMS IN '//flowtype//' PACKAGE'
210  write (this%iout, '(a, i0)') &
211  ' NUMBER OF '//flowtype//' = ', this%flowbudptr%ncv
212  icount = 1
213  do ip = 1, this%flowbudptr%nbudterm
214  select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
215  case ('FLOW-JA-FACE')
216  this%idxbudfjf = ip
217  this%idxbudssm(ip) = 0
218  case ('GWF')
219  this%idxbudgwf = ip
220  this%idxbudssm(ip) = 0
221  case ('STORAGE')
222  this%idxbudsto = ip
223  this%idxbudssm(ip) = 0
224  case ('RATE')
225  this%idxbudrate = ip
226  this%idxbudssm(ip) = 0
227  case ('FW-RATE')
228  this%idxbudfwrt = ip
229  this%idxbudssm(ip) = 0
230  case ('RATE-TO-MVR')
231  this%idxbudrtmv = ip
232  this%idxbudssm(ip) = 0
233  case ('FW-RATE-TO-MVR')
234  this%idxbudfrtm = ip
235  this%idxbudssm(ip) = 0
236  case ('TO-MVR')
237  this%idxbudtmvr = ip
238  this%idxbudssm(ip) = 0
239  case ('FROM-MVR')
240  this%idxbudfmvr = ip
241  this%idxbudssm(ip) = 0
242  case ('AUXILIARY')
243  this%idxbudaux = ip
244  this%idxbudssm(ip) = 0
245  case default
246  !
247  ! -- set idxbudssm equal to a column index for where the concentrations
248  ! are stored in the concbud(nbudssm, ncv) array
249  this%idxbudssm(ip) = icount
250  icount = icount + 1
251  end select
252  write (this%iout, '(a, i0, " = ", a,/, a, i0)') &
253  ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
254  ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
255  end do
256  write (this%iout, '(a, //)') 'DONE PROCESSING '//ftype//' INFORMATION'
257  !
258  ! -- Return
259  return
260  end subroutine find_mwt_package
261 
262  !> @brief Add matrix terms related to MWT
263  !!
264  !! This routine is called from TspAptType%apt_fc_expanded() in
265  !! order to add matrix terms specifically for MWT
266  !<
267  subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
268  ! -- modules
269  ! -- dummy
270  class(gwtmwttype) :: this
271  real(DP), dimension(:), intent(inout) :: rhs
272  integer(I4B), dimension(:), intent(in) :: ia
273  integer(I4B), dimension(:), intent(in) :: idxglo
274  class(matrixbasetype), pointer :: matrix_sln
275  ! -- local
276  integer(I4B) :: j, n1, n2
277  integer(I4B) :: iloc
278  integer(I4B) :: iposd
279  real(DP) :: rrate
280  real(DP) :: rhsval
281  real(DP) :: hcofval
282  !
283  ! -- add puping rate contribution
284  if (this%idxbudrate /= 0) then
285  do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
286  call this%mwt_rate_term(j, n1, n2, rrate, rhsval, hcofval)
287  iloc = this%idxlocnode(n1)
288  iposd = this%idxpakdiag(n1)
289  call matrix_sln%add_value_pos(iposd, hcofval)
290  rhs(iloc) = rhs(iloc) + rhsval
291  end do
292  end if
293  !
294  ! -- add flowing well rate contribution
295  if (this%idxbudfwrt /= 0) then
296  do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
297  call this%mwt_fwrt_term(j, n1, n2, rrate, rhsval, hcofval)
298  iloc = this%idxlocnode(n1)
299  iposd = this%idxpakdiag(n1)
300  call matrix_sln%add_value_pos(iposd, hcofval)
301  rhs(iloc) = rhs(iloc) + rhsval
302  end do
303  end if
304  !
305  ! -- add rate to mover contribution
306  if (this%idxbudrtmv /= 0) then
307  do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
308  call this%mwt_rtmv_term(j, n1, n2, rrate, rhsval, hcofval)
309  iloc = this%idxlocnode(n1)
310  iposd = this%idxpakdiag(n1)
311  call matrix_sln%add_value_pos(iposd, hcofval)
312  rhs(iloc) = rhs(iloc) + rhsval
313  end do
314  end if
315  !
316  ! -- add puping rate contribution
317  if (this%idxbudfrtm /= 0) then
318  do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
319  call this%mwt_frtm_term(j, n1, n2, rrate, rhsval, hcofval)
320  iloc = this%idxlocnode(n1)
321  iposd = this%idxpakdiag(n1)
322  call matrix_sln%add_value_pos(iposd, hcofval)
323  rhs(iloc) = rhs(iloc) + rhsval
324  end do
325  end if
326  !
327  ! -- Return
328  return
329  end subroutine mwt_fc_expanded
330 
331  !> @ brief Add terms specific to multi-aquifer wells to the explicit multi-
332  !! aquifer well solute transport solve
333  !<
334  subroutine mwt_solve(this)
335  ! -- dummy
336  class(gwtmwttype) :: this
337  ! -- local
338  integer(I4B) :: j
339  integer(I4B) :: n1, n2
340  real(DP) :: rrate
341  !
342  ! -- add well pumping contribution
343  if (this%idxbudrate /= 0) then
344  do j = 1, this%flowbudptr%budterm(this%idxbudrate)%nlist
345  call this%mwt_rate_term(j, n1, n2, rrate)
346  this%dbuff(n1) = this%dbuff(n1) + rrate
347  end do
348  end if
349  !
350  ! -- add flowing well rate contribution
351  if (this%idxbudfwrt /= 0) then
352  do j = 1, this%flowbudptr%budterm(this%idxbudfwrt)%nlist
353  call this%mwt_fwrt_term(j, n1, n2, rrate)
354  this%dbuff(n1) = this%dbuff(n1) + rrate
355  end do
356  end if
357  !
358  ! -- add well pumping rate to mover contribution
359  if (this%idxbudrtmv /= 0) then
360  do j = 1, this%flowbudptr%budterm(this%idxbudrtmv)%nlist
361  call this%mwt_rtmv_term(j, n1, n2, rrate)
362  this%dbuff(n1) = this%dbuff(n1) + rrate
363  end do
364  end if
365  !
366  ! -- add flowing well rate to mover contribution
367  if (this%idxbudfrtm /= 0) then
368  do j = 1, this%flowbudptr%budterm(this%idxbudfrtm)%nlist
369  call this%mwt_frtm_term(j, n1, n2, rrate)
370  this%dbuff(n1) = this%dbuff(n1) + rrate
371  end do
372  end if
373  !
374  ! -- Return
375  return
376  end subroutine mwt_solve
377 
378  !> @brief Function to return the number of budget terms just for this package
379  !!
380  !! This overrides a function in the parent class.
381  !<
382  function mwt_get_nbudterms(this) result(nbudterms)
383  ! -- modules
384  ! -- dummy
385  class(gwtmwttype) :: this
386  ! -- Return
387  integer(I4B) :: nbudterms
388  ! -- local
389  !
390  ! -- Number of budget terms is 4
391  nbudterms = 1
392  if (this%idxbudfwrt /= 0) nbudterms = nbudterms + 1
393  if (this%idxbudrtmv /= 0) nbudterms = nbudterms + 1
394  if (this%idxbudfrtm /= 0) nbudterms = nbudterms + 1
395  !
396  ! -- Return
397  return
398  end function mwt_get_nbudterms
399 
400  !> @brief Set up the budget object that stores all the mwt flows
401  !<
402  subroutine mwt_setup_budobj(this, idx)
403  ! -- modules
404  use constantsmodule, only: lenbudtxt
405  ! -- dummy
406  class(gwtmwttype) :: this
407  integer(I4B), intent(inout) :: idx
408  ! -- local
409  integer(I4B) :: maxlist, naux
410  character(len=LENBUDTXT) :: text
411  !
412  ! --
413  text = ' RATE'
414  idx = idx + 1
415  maxlist = this%flowbudptr%budterm(this%idxbudrate)%maxlist
416  naux = 0
417  call this%budobj%budterm(idx)%initialize(text, &
418  this%name_model, &
419  this%packName, &
420  this%name_model, &
421  this%packName, &
422  maxlist, .false., .false., &
423  naux)
424  !
425  ! --
426  if (this%idxbudfwrt /= 0) then
427  text = ' FW-RATE'
428  idx = idx + 1
429  maxlist = this%flowbudptr%budterm(this%idxbudfwrt)%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%idxbudrtmv /= 0) then
442  text = ' RATE-TO-MVR'
443  idx = idx + 1
444  maxlist = this%flowbudptr%budterm(this%idxbudrtmv)%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  !
455  ! --
456  if (this%idxbudfrtm /= 0) then
457  text = ' FW-RATE-TO-MVR'
458  idx = idx + 1
459  maxlist = this%flowbudptr%budterm(this%idxbudfrtm)%maxlist
460  naux = 0
461  call this%budobj%budterm(idx)%initialize(text, &
462  this%name_model, &
463  this%packName, &
464  this%name_model, &
465  this%packName, &
466  maxlist, .false., .false., &
467  naux)
468  end if
469  !
470  ! -- Return
471  return
472  end subroutine mwt_setup_budobj
473 
474  !> @brief Copy flow terms into this%budobj
475  !<
476  subroutine mwt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
477  ! -- modules
478  ! -- dummy
479  class(gwtmwttype) :: this
480  integer(I4B), intent(inout) :: idx
481  real(DP), dimension(:), intent(in) :: x
482  real(DP), dimension(:), contiguous, intent(inout) :: flowja
483  real(DP), intent(inout) :: ccratin
484  real(DP), intent(inout) :: ccratout
485  ! -- local
486  integer(I4B) :: j, n1, n2
487  integer(I4B) :: nlist
488  real(DP) :: q
489  ! -- formats
490  !
491  ! -- RATE
492  idx = idx + 1
493  nlist = this%flowbudptr%budterm(this%idxbudrate)%nlist
494  call this%budobj%budterm(idx)%reset(nlist)
495  do j = 1, nlist
496  call this%mwt_rate_term(j, n1, n2, q)
497  call this%budobj%budterm(idx)%update_term(n1, n2, q)
498  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
499  end do
500  !
501  ! -- FW-RATE
502  if (this%idxbudfwrt /= 0) then
503  idx = idx + 1
504  nlist = this%flowbudptr%budterm(this%idxbudfwrt)%nlist
505  call this%budobj%budterm(idx)%reset(nlist)
506  do j = 1, nlist
507  call this%mwt_fwrt_term(j, n1, n2, q)
508  call this%budobj%budterm(idx)%update_term(n1, n2, q)
509  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
510  end do
511  end if
512  !
513  ! -- RATE-TO-MVR
514  if (this%idxbudrtmv /= 0) then
515  idx = idx + 1
516  nlist = this%flowbudptr%budterm(this%idxbudrtmv)%nlist
517  call this%budobj%budterm(idx)%reset(nlist)
518  do j = 1, nlist
519  call this%mwt_rtmv_term(j, n1, n2, q)
520  call this%budobj%budterm(idx)%update_term(n1, n2, q)
521  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
522  end do
523  end if
524  !
525  ! -- FW-RATE-TO-MVR
526  if (this%idxbudfrtm /= 0) then
527  idx = idx + 1
528  nlist = this%flowbudptr%budterm(this%idxbudfrtm)%nlist
529  call this%budobj%budterm(idx)%reset(nlist)
530  do j = 1, nlist
531  call this%mwt_frtm_term(j, n1, n2, q)
532  call this%budobj%budterm(idx)%update_term(n1, n2, q)
533  call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
534  end do
535  end if
536  !
537  ! -- Return
538  return
539  end subroutine mwt_fill_budobj
540 
541  !> @brief Allocate scalars specific to the streamflow mass transport (SFT)
542  !! package.
543  !<
544  subroutine allocate_scalars(this)
545  ! -- modules
547  ! -- dummy
548  class(gwtmwttype) :: this
549  ! -- local
550  !
551  ! -- allocate scalars in TspAptType
552  call this%TspAptType%allocate_scalars()
553  !
554  ! -- Allocate
555  call mem_allocate(this%idxbudrate, 'IDXBUDRATE', this%memoryPath)
556  call mem_allocate(this%idxbudfwrt, 'IDXBUDFWRT', this%memoryPath)
557  call mem_allocate(this%idxbudrtmv, 'IDXBUDRTMV', this%memoryPath)
558  call mem_allocate(this%idxbudfrtm, 'IDXBUDFRTM', this%memoryPath)
559  !
560  ! -- Initialize
561  this%idxbudrate = 0
562  this%idxbudfwrt = 0
563  this%idxbudrtmv = 0
564  this%idxbudfrtm = 0
565  !
566  ! -- Return
567  return
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  ! -- local
579  integer(I4B) :: n
580  !
581  ! -- time series
582  call mem_allocate(this%concrate, this%ncv, 'CONCRATE', this%memoryPath)
583  !
584  ! -- call standard TspAptType allocate arrays
585  call this%TspAptType%apt_allocate_arrays()
586  !
587  ! -- Initialize
588  do n = 1, this%ncv
589  this%concrate(n) = dzero
590  end do
591  !
592  !
593  ! -- Return
594  return
595  end subroutine mwt_allocate_arrays
596 
597  !> @brief Deallocate memory
598  !<
599  subroutine mwt_da(this)
600  ! -- modules
602  ! -- dummy
603  class(gwtmwttype) :: this
604  ! -- local
605  !
606  ! -- deallocate scalars
607  call mem_deallocate(this%idxbudrate)
608  call mem_deallocate(this%idxbudfwrt)
609  call mem_deallocate(this%idxbudrtmv)
610  call mem_deallocate(this%idxbudfrtm)
611  !
612  ! -- deallocate time series
613  call mem_deallocate(this%concrate)
614  !
615  ! -- deallocate scalars in TspAptType
616  call this%TspAptType%bnd_da()
617  !
618  ! -- Return
619  return
620  end subroutine mwt_da
621 
622  !> @brief Rate term associated with pumping (or injection)
623  !<
624  subroutine mwt_rate_term(this, ientry, n1, n2, rrate, &
625  rhsval, hcofval)
626  ! -- dummy
627  class(gwtmwttype) :: this
628  integer(I4B), intent(in) :: ientry
629  integer(I4B), intent(inout) :: n1
630  integer(I4B), intent(inout) :: n2
631  real(DP), intent(inout), optional :: rrate
632  real(DP), intent(inout), optional :: rhsval
633  real(DP), intent(inout), optional :: hcofval
634  ! -- local
635  real(DP) :: qbnd
636  real(DP) :: ctmp
637  real(DP) :: h, r
638  !
639  n1 = this%flowbudptr%budterm(this%idxbudrate)%id1(ientry)
640  n2 = this%flowbudptr%budterm(this%idxbudrate)%id2(ientry)
641  ! -- note that qbnd is negative for extracting well
642  qbnd = this%flowbudptr%budterm(this%idxbudrate)%flow(ientry)
643  if (qbnd < dzero) then
644  ctmp = this%xnewpak(n1)
645  h = qbnd
646  r = dzero
647  else
648  ctmp = this%concrate(n1)
649  h = dzero
650  r = -qbnd * ctmp
651  end if
652  if (present(rrate)) rrate = qbnd * ctmp
653  if (present(rhsval)) rhsval = r
654  if (present(hcofval)) hcofval = h
655  !
656  ! -- Return
657  return
658  end subroutine mwt_rate_term
659 
660  !> @brief Transport matrix term(s) associated with a flowing-
661  !! well rate term associated with pumping (or injection)
662  !<
663  subroutine mwt_fwrt_term(this, ientry, n1, n2, rrate, &
664  rhsval, hcofval)
665  ! -- dummy
666  class(gwtmwttype) :: this
667  integer(I4B), intent(in) :: ientry
668  integer(I4B), intent(inout) :: n1
669  integer(I4B), intent(inout) :: n2
670  real(DP), intent(inout), optional :: rrate
671  real(DP), intent(inout), optional :: rhsval
672  real(DP), intent(inout), optional :: hcofval
673  ! -- local
674  real(DP) :: qbnd
675  real(DP) :: ctmp
676  !
677  n1 = this%flowbudptr%budterm(this%idxbudfwrt)%id1(ientry)
678  n2 = this%flowbudptr%budterm(this%idxbudfwrt)%id2(ientry)
679  qbnd = this%flowbudptr%budterm(this%idxbudfwrt)%flow(ientry)
680  ctmp = this%xnewpak(n1)
681  if (present(rrate)) rrate = ctmp * qbnd
682  if (present(rhsval)) rhsval = dzero
683  if (present(hcofval)) hcofval = qbnd
684  !
685  ! -- Return
686  return
687  end subroutine mwt_fwrt_term
688 
689  !> @brief Rate-to-mvr term associated with pumping (or injection)
690  !!
691  !! Pumped water that is made available to the MVR package for transfer to
692  !! another advanced package
693  !<
694  subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, &
695  rhsval, hcofval)
696  ! -- dummy
697  class(gwtmwttype) :: this
698  integer(I4B), intent(in) :: ientry
699  integer(I4B), intent(inout) :: n1
700  integer(I4B), intent(inout) :: n2
701  real(DP), intent(inout), optional :: rrate
702  real(DP), intent(inout), optional :: rhsval
703  real(DP), intent(inout), optional :: hcofval
704  ! -- local
705  real(DP) :: qbnd
706  real(DP) :: ctmp
707  !
708  n1 = this%flowbudptr%budterm(this%idxbudrtmv)%id1(ientry)
709  n2 = this%flowbudptr%budterm(this%idxbudrtmv)%id2(ientry)
710  qbnd = this%flowbudptr%budterm(this%idxbudrtmv)%flow(ientry)
711  ctmp = this%xnewpak(n1)
712  if (present(rrate)) rrate = ctmp * qbnd
713  if (present(rhsval)) rhsval = dzero
714  if (present(hcofval)) hcofval = qbnd
715  !
716  ! -- Return
717  return
718  end subroutine mwt_rtmv_term
719 
720  !> @brief Flowing well rate-to-mvr term (or injection)
721  !!
722  !! Pumped water that is made available to the MVR package for transfer to
723  !! another advanced package
724  !<
725  subroutine mwt_frtm_term(this, ientry, n1, n2, rrate, &
726  rhsval, hcofval)
727  ! -- dummy
728  class(gwtmwttype) :: this
729  integer(I4B), intent(in) :: ientry
730  integer(I4B), intent(inout) :: n1
731  integer(I4B), intent(inout) :: n2
732  real(DP), intent(inout), optional :: rrate
733  real(DP), intent(inout), optional :: rhsval
734  real(DP), intent(inout), optional :: hcofval
735  ! -- local
736  real(DP) :: qbnd
737  real(DP) :: ctmp
738  !
739  n1 = this%flowbudptr%budterm(this%idxbudfrtm)%id1(ientry)
740  n2 = this%flowbudptr%budterm(this%idxbudfrtm)%id2(ientry)
741  qbnd = this%flowbudptr%budterm(this%idxbudfrtm)%flow(ientry)
742  ctmp = this%xnewpak(n1)
743  if (present(rrate)) rrate = ctmp * qbnd
744  if (present(rhsval)) rhsval = dzero
745  if (present(hcofval)) hcofval = qbnd
746  !
747  ! -- Return
748  return
749  end subroutine mwt_frtm_term
750 
751  !> @brief Observations
752  !!
753  !! Store the observation type supported by the APT package and override
754  !! BndType%bnd_df_obs
755  !<
756  subroutine mwt_df_obs(this)
757  ! -- modules
758  ! -- dummy
759  class(gwtmwttype) :: this
760  ! -- local
761  integer(I4B) :: indx
762  !
763  ! -- Store obs type and assign procedure pointer
764  ! for concentration observation type.
765  call this%obs%StoreObsType('concentration', .false., indx)
766  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
767  !
768  ! -- flow-ja-face not supported for MWT
769  !call this%obs%StoreObsType('flow-ja-face', .true., indx)
770  !this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
771  !
772  ! -- Store obs type and assign procedure pointer
773  ! for from-mvr observation type.
774  call this%obs%StoreObsType('from-mvr', .true., indx)
775  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
776  !
777  ! -- to-mvr not supported for mwt
778  !call this%obs%StoreObsType('to-mvr', .true., indx)
779  !this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsID
780  !
781  ! -- Store obs type and assign procedure pointer
782  ! for storage observation type.
783  call this%obs%StoreObsType('storage', .true., indx)
784  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
785  !
786  ! -- Store obs type and assign procedure pointer
787  ! for constant observation type.
788  call this%obs%StoreObsType('constant', .true., indx)
789  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
790  !
791  ! -- Store obs type and assign procedure pointer
792  ! for observation type: mwt
793  call this%obs%StoreObsType('mwt', .true., indx)
794  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid12
795  !
796  ! -- Store obs type and assign procedure pointer
797  ! for rate observation type.
798  call this%obs%StoreObsType('rate', .true., indx)
799  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
800  !
801  ! -- Store obs type and assign procedure pointer
802  ! for observation type.
803  call this%obs%StoreObsType('fw-rate', .true., indx)
804  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
805  !
806  ! -- Store obs type and assign procedure pointer
807  ! for observation type.
808  call this%obs%StoreObsType('rate-to-mvr', .true., indx)
809  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
810  !
811  ! -- Store obs type and assign procedure pointer
812  ! for observation type.
813  call this%obs%StoreObsType('fw-rate-to-mvr', .true., indx)
814  this%obs%obsData(indx)%ProcessIdPtr => apt_process_obsid
815  !
816  ! -- Return
817  return
818  end subroutine mwt_df_obs
819 
820  !> @brief Process package specific obs
821  !!
822  !! Method to process specific observations for this package.
823  !<
824  subroutine mwt_rp_obs(this, obsrv, found)
825  ! -- dummy
826  class(gwtmwttype), intent(inout) :: this !< package class
827  type(observetype), intent(inout) :: obsrv !< observation object
828  logical, intent(inout) :: found !< indicate whether observation was found
829  ! -- local
830  !
831  found = .true.
832  select case (obsrv%ObsTypeId)
833  case ('RATE')
834  call this%rp_obs_byfeature(obsrv)
835  case ('FW-RATE')
836  call this%rp_obs_byfeature(obsrv)
837  case ('RATE-TO-MVR')
838  call this%rp_obs_byfeature(obsrv)
839  case ('FW-RATE-TO-MVR')
840  call this%rp_obs_byfeature(obsrv)
841  case default
842  found = .false.
843  end select
844  !
845  ! -- Return
846  return
847  end subroutine mwt_rp_obs
848 
849  !> @brief Calculate observation value and pass it back to APT
850  !<
851  subroutine mwt_bd_obs(this, obstypeid, jj, v, found)
852  ! -- dummy
853  class(gwtmwttype), intent(inout) :: this
854  character(len=*), intent(in) :: obstypeid
855  real(DP), intent(inout) :: v
856  integer(I4B), intent(in) :: jj
857  logical, intent(inout) :: found
858  ! -- local
859  integer(I4B) :: n1, n2
860  !
861  found = .true.
862  select case (obstypeid)
863  case ('RATE')
864  if (this%iboundpak(jj) /= 0) then
865  call this%mwt_rate_term(jj, n1, n2, v)
866  end if
867  case ('FW-RATE')
868  if (this%iboundpak(jj) /= 0 .and. this%idxbudfwrt > 0) then
869  call this%mwt_fwrt_term(jj, n1, n2, v)
870  end if
871  case ('RATE-TO-MVR')
872  if (this%iboundpak(jj) /= 0 .and. this%idxbudrtmv > 0) then
873  call this%mwt_rtmv_term(jj, n1, n2, v)
874  end if
875  case ('FW-RATE-TO-MVR')
876  if (this%iboundpak(jj) /= 0 .and. this%idxbudfrtm > 0) then
877  call this%mwt_frtm_term(jj, n1, n2, v)
878  end if
879  case default
880  found = .false.
881  end select
882  !
883  ! -- Return
884  return
885  end subroutine mwt_bd_obs
886 
887  !> @brief Sets the stress period attributes for keyword use.
888  !<
889  subroutine mwt_set_stressperiod(this, itemno, keyword, found)
890  ! -- modules
892  ! -- dummy
893  class(gwtmwttype), intent(inout) :: this
894  integer(I4B), intent(in) :: itemno
895  character(len=*), intent(in) :: keyword
896  logical, intent(inout) :: found
897  ! -- local
898  character(len=LINELENGTH) :: text
899  integer(I4B) :: ierr
900  integer(I4B) :: jj
901  real(DP), pointer :: bndElem => null()
902  ! -- formats
903  !
904  ! RATE <rate>
905  !
906  found = .true.
907  select case (keyword)
908  case ('RATE')
909  ierr = this%apt_check_valid(itemno)
910  if (ierr /= 0) then
911  goto 999
912  end if
913  call this%parser%GetString(text)
914  jj = 1
915  bndelem => this%concrate(itemno)
916  call read_value_or_time_series_adv(text, itemno, jj, bndelem, &
917  this%packName, 'BND', this%tsManager, &
918  this%iprpak, 'RATE')
919  case default
920  !
921  ! -- keyword not recognized so return to caller with found = .false.
922  found = .false.
923  end select
924  !
925 999 continue
926  !
927  ! -- Return
928  return
929  end subroutine mwt_set_stressperiod
930 
931 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:44
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:64
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:36
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:852
subroutine find_mwt_package(this)
find corresponding mwt package
Definition: gwt-mwt.f90:149
subroutine mwt_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to MWT.
Definition: gwt-mwt.f90:268
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:665
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:727
subroutine mwt_setup_budobj(this, idx)
Set up the budget object that stores all the mwt flows.
Definition: gwt-mwt.f90:403
subroutine mwt_da(this)
Deallocate memory.
Definition: gwt-mwt.f90:600
character(len= *), parameter ftype
Definition: gwt-mwt.f90:52
subroutine mwt_rp_obs(this, obsrv, found)
Process package specific obs.
Definition: gwt-mwt.f90:825
subroutine allocate_scalars(this)
Allocate scalars specific to the streamflow mass transport (SFT) package.
Definition: gwt-mwt.f90:545
integer(i4b) function mwt_get_nbudterms(this)
Function to return the number of budget terms just for this package.
Definition: gwt-mwt.f90:383
subroutine mwt_solve(this)
@ brief Add terms specific to multi-aquifer wells to the explicit multi- aquifer well solute transpor...
Definition: gwt-mwt.f90:335
subroutine mwt_df_obs(this)
Observations.
Definition: gwt-mwt.f90:757
subroutine mwt_allocate_arrays(this)
Allocate arrays specific to the streamflow mass transport (SFT) package.
Definition: gwt-mwt.f90:574
subroutine mwt_rtmv_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rate-to-mvr term associated with pumping (or injection)
Definition: gwt-mwt.f90:696
subroutine mwt_rate_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rate term associated with pumping (or injection)
Definition: gwt-mwt.f90:626
subroutine mwt_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
Copy flow terms into thisbudobj.
Definition: gwt-mwt.f90:477
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:890
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:2998
subroutine, public apt_process_obsid12(obsrv, dis, inunitobs, iout)
Process observation IDs for a package.
Definition: tsp-apt.f90:3044
@ brief BndType