MODFLOW 6  version 6.7.0.dev2
USGS Modular Hydrologic Model
tsp.f90
Go to the documentation of this file.
1 !> @brief This module contains the base transport model type
2 !!
3 !! This module contains the base class for transport models.
4 !!
5 !<
6 
8  use kindmodule, only: dp, i4b
11  use simvariablesmodule, only: errmsg
13  use bndmodule, only: bndtype, getbndfromlist
14  use tspicmodule, only: tspictype
15  use tspfmimodule, only: tspfmitype
16  use tspadvmodule, only: tspadvtype
17  use tspssmmodule, only: tspssmtype
18  use tspmvtmodule, only: tspmvttype
19  use tspocmodule, only: tspoctype
20  use tspobsmodule, only: tspobstype
21  use budgetmodule, only: budgettype
23 
24  implicit none
25 
26  private
27 
28  public :: transportmodeltype
29 
31 
32  ! Generalized transport package types common to either GWT or GWE
33  type(tspadvtype), pointer :: adv => null() !< advection package
34  type(tspfmitype), pointer :: fmi => null() !< flow model interface
35  type(tspictype), pointer :: ic => null() !< initial conditions package
36  type(tspmvttype), pointer :: mvt => null() !< mover transport package
37  type(tspobstype), pointer :: obs => null() !< observation package
38  type(tspoctype), pointer :: oc => null() !< output control package
39  type(tspssmtype), pointer :: ssm => null() !< source sink mixing package
40  type(budgettype), pointer :: budget => null() !< budget object
41  integer(I4B), pointer :: infmi => null() ! unit number FMI
42  integer(I4B), pointer :: inadv => null() !< unit number ADV
43  integer(I4B), pointer :: inic => null() !< unit number IC
44  integer(I4B), pointer :: inmvt => null() !< unit number MVT
45  integer(I4B), pointer :: inoc => null() !< unit number OC
46  integer(I4B), pointer :: inobs => null() !< unit number OBS
47 
48  integer(I4B), pointer :: inssm => null() !< unit number SSM
49  real(dp), pointer :: eqnsclfac => null() !< constant factor by which all terms in the model's governing equation are scaled (divided) for formulation and solution
50  ! Labels that will be defined
51  character(len=LENVARNAME) :: tsptype = '' !< "solute" or "heat"
52  character(len=LENVARNAME) :: depvartype = '' !< "concentration" or "temperature"
53  character(len=LENVARNAME) :: depvarunit = '' !< "mass" or "energy"
54  character(len=LENVARNAME) :: depvarunitabbrev = '' !< "M" or "E"
55 
56  integer(I4B), pointer :: idv_scale => null() ! x and rhs scaling flag
57 
58  contains
59 
60  ! -- public
61  procedure, public :: tsp_cr
62  procedure, public :: tsp_df
63  procedure, public :: tsp_da
64  procedure, public :: tsp_ac
65  procedure, public :: tsp_mc
66  procedure, public :: tsp_ar
67  procedure, public :: tsp_rp
68  procedure, public :: tsp_ad
69  procedure, public :: tsp_fc
70  procedure, public :: tsp_cc
71  procedure, public :: tsp_cq
72  procedure, public :: tsp_bd
73  procedure, public :: model_ot => tsp_ot
74  procedure, public :: tsp_ot_flow
75  procedure, public :: tsp_ot_dv
76  procedure, public :: allocate_tsp_scalars
77  procedure, public :: set_tsp_labels
78  procedure, public :: ftype_check
79  procedure, public :: get_idv_scale => tsp_get_idv_scale
80  ! -- private
81  procedure, private :: tsp_ot_obs
82  procedure, private :: tsp_ot_flowja
83  procedure, private :: tsp_ot_bdsummary
84  procedure, private :: create_tsp_packages
85  procedure, private :: log_namfile_options
86 
87  end type transportmodeltype
88 
89 contains
90 
91  !> @brief Create a new generalized transport model object
92  !!
93  !! Create a new transport model that will be further refined into GWT or GWE
94  !<
95  subroutine tsp_cr(this, filename, id, modelname, macronym, indis)
96  ! -- modules
101  use budgetmodule, only: budget_cr
102  ! -- dummy
103  class(transportmodeltype) :: this
104  character(len=*), intent(in) :: filename
105  integer(I4B), intent(in) :: id
106  integer(I4B), intent(inout) :: indis
107  character(len=*), intent(in) :: modelname
108  character(len=*), intent(in) :: macronym
109  ! -- local
110  character(len=LENMEMPATH) :: input_mempath
111  character(len=LINELENGTH) :: lst_fname
112  type(gwtnamparamfoundtype) :: found
113  !
114  ! -- Assign values
115  this%filename = filename
116  this%name = modelname
117  this%id = id
118  this%macronym = macronym
119  !
120  ! -- set input model namfile memory path
121  input_mempath = create_mem_path(modelname, 'NAM', idm_context)
122  !
123  ! -- copy option params from input context
124  call mem_set_value(lst_fname, 'LIST', input_mempath, found%list)
125  call mem_set_value(this%iprpak, 'PRINT_INPUT', input_mempath, &
126  found%print_input)
127  call mem_set_value(this%iprflow, 'PRINT_FLOWS', input_mempath, &
128  found%print_flows)
129  call mem_set_value(this%ipakcb, 'SAVE_FLOWS', input_mempath, &
130  found%save_flows)
131  call mem_set_value(this%idv_scale, 'IDV_SCALE', input_mempath, &
132  found%idv_scale)
133  !
134  ! -- create the list file
135  call this%create_lstfile(lst_fname, filename, found%list, &
136  'TRANSPORT MODEL ('//trim(macronym)//')')
137  !
138  ! -- activate save_flows if found
139  if (found%save_flows) then
140  this%ipakcb = -1
141  end if
142  !
143  ! -- log set options
144  if (this%iout > 0) then
145  call this%log_namfile_options(found)
146  end if
147  !
148  ! -- Create utility objects
149  call budget_cr(this%budget, this%name)
150  !
151  ! -- create model packages
152  call this%create_tsp_packages(indis)
153  end subroutine tsp_cr
154 
155  !> @brief Generalized transport model define model
156  !!
157  !! This subroutine extended by either GWT or GWE. This routine calls the
158  !! define (df) routines for each attached package and sets variables and
159  !! pointers.
160  !<
161  subroutine tsp_df(this)
162  ! -- dummy
163  class(transportmodeltype) :: this
164  end subroutine tsp_df
165 
166  !> @brief Generalized transport model add connections
167  !!
168  !! This subroutine extended by either GWT or GWE. This routine adds the
169  !! internal connections of this model to the sparse matrix
170  !<
171  subroutine tsp_ac(this, sparse)
172  ! -- modules
173  use sparsemodule, only: sparsematrix
174  ! -- dummy
175  class(transportmodeltype) :: this
176  type(sparsematrix), intent(inout) :: sparse
177  end subroutine tsp_ac
178 
179  !> @brief Generalized transport model map coefficients
180  !!
181  !! This subroutine extended by either GWT or GWE. This routine maps the
182  !! positions of this models connections in the numerical solution coefficient
183  !! matrix.
184  !<
185  subroutine tsp_mc(this, matrix_sln)
186  ! -- dummy
187  class(transportmodeltype) :: this
188  class(matrixbasetype), pointer :: matrix_sln !< global system matrix
189  end subroutine tsp_mc
190 
191  !> @brief Generalized transport model allocate and read
192  !!
193  !! This subroutine extended by either GWT or GWE. This routine calls
194  !! the allocate and reads (ar) routines of attached packages and allocates
195  !! memory for arrays required by the model object.
196  !<
197  subroutine tsp_ar(this)
198  ! -- dummy
199  class(transportmodeltype) :: this
200  end subroutine tsp_ar
201 
202  !> @brief Generalized transport model read and prepare
203  !!
204  !! This subroutine extended by either GWT or GWE. This routine calls
205  !! the read and prepare (rp) routines of attached packages.
206  !<
207  subroutine tsp_rp(this)
208  ! -- dummy
209  class(transportmodeltype) :: this
210  end subroutine tsp_rp
211 
212  !> @brief Generalized transport model time step advance
213  !!
214  !! This subroutine extended by either GWT or GWE. This routine calls
215  !! the advance time step (ad) routines of attached packages.
216  !<
217  subroutine tsp_ad(this)
218  ! -- dummy
219  class(transportmodeltype) :: this
220  end subroutine tsp_ad
221 
222  !> @brief Generalized transport model fill coefficients
223  !!
224  !! This subroutine extended by either GWT or GWE. This routine calls
225  !! the fill coefficients (fc) routines of attached packages.
226  !<
227  subroutine tsp_fc(this, kiter, matrix_sln, inwtflag)
228  ! -- dummy
229  class(transportmodeltype) :: this
230  integer(I4B), intent(in) :: kiter
231  class(matrixbasetype), pointer :: matrix_sln
232  integer(I4B), intent(in) :: inwtflag
233  end subroutine tsp_fc
234 
235  !> @brief Generalized transport model final convergence check
236  !!
237  !! This subroutine extended by either GWT or GWE. This routine calls
238  !! the convergence check (cc) routines of attached packages.
239  !<
240  subroutine tsp_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
241  ! -- dummy
242  class(transportmodeltype) :: this
243  integer(I4B), intent(in) :: innertot
244  integer(I4B), intent(in) :: kiter
245  integer(I4B), intent(in) :: iend
246  integer(I4B), intent(in) :: icnvgmod
247  character(len=LENPAKLOC), intent(inout) :: cpak
248  integer(I4B), intent(inout) :: ipak
249  real(DP), intent(inout) :: dpak
250  end subroutine tsp_cc
251 
252  !> @brief Generalized transport model calculate flows
253  !!
254  !! This subroutine extended by either GWT or GWE. This routine calculates
255  !! intercell flows (flowja)
256  !<
257  subroutine tsp_cq(this, icnvg, isuppress_output)
258  ! -- dummy
259  class(transportmodeltype) :: this
260  integer(I4B), intent(in) :: icnvg
261  integer(I4B), intent(in) :: isuppress_output
262  end subroutine tsp_cq
263 
264  !> @brief Generalized transport model budget
265  !!
266  !! This subroutine extended by either GWT or GWE. This routine calculates
267  !! package contributions to model budget
268  !<
269  subroutine tsp_bd(this, icnvg, isuppress_output)
270  ! -- dummy
271  class(transportmodeltype) :: this
272  integer(I4B), intent(in) :: icnvg
273  integer(I4B), intent(in) :: isuppress_output
274  end subroutine tsp_bd
275 
276  !> @brief Generalized transport model output routine
277  !!
278  !! Generalized transport model output
279  !<
280  subroutine tsp_ot(this)
281  ! -- modules
282  use tdismodule, only: kstp, kper, tdis_ot, endofperiod
283  ! -- dummy
284  class(transportmodeltype) :: this
285  ! -- local
286  integer(I4B) :: idvsave
287  integer(I4B) :: idvprint
288  integer(I4B) :: icbcfl
289  integer(I4B) :: icbcun
290  integer(I4B) :: ibudfl
291  integer(I4B) :: ipflag
292  ! -- formats
293  character(len=*), parameter :: fmtnocnvg = &
294  "(1X,/9X,'****FAILED TO MEET SOLVER CONVERGENCE CRITERIA IN TIME STEP ', &
295  &I0,' OF STRESS PERIOD ',I0,'****')"
296  !
297  ! -- Set write and print flags
298  idvsave = 0
299  idvprint = 0
300  icbcfl = 0
301  ibudfl = 0
302  if (this%oc%oc_save(trim(this%depvartype))) idvsave = 1
303  if (this%oc%oc_print(trim(this%depvartype))) idvprint = 1
304  if (this%oc%oc_save('BUDGET')) icbcfl = 1
305  if (this%oc%oc_print('BUDGET')) ibudfl = 1
306  icbcun = this%oc%oc_save_unit('BUDGET')
307  !
308  ! -- Override ibudfl and idvprint flags for nonconvergence
309  ! and end of period
310  ibudfl = this%oc%set_print_flag('BUDGET', this%icnvg, endofperiod)
311  idvprint = this%oc%set_print_flag(trim(this%depvartype), &
312  this%icnvg, endofperiod)
313  !
314  ! -- Calculate and save observations
315  call this%tsp_ot_obs()
316  !
317  ! -- Save and print flows
318  call this%tsp_ot_flow(icbcfl, ibudfl, icbcun)
319  !
320  ! -- Save and print dependent variables
321  call this%tsp_ot_dv(idvsave, idvprint, ipflag)
322  !
323  ! -- Print budget summaries
324  call this%tsp_ot_bdsummary(ibudfl, ipflag)
325  !
326  ! -- Timing Output; if any dependent variables or budgets
327  ! are printed, then ipflag is set to 1.
328  if (ipflag == 1) call tdis_ot(this%iout)
329  !
330  ! -- Write non-convergence message
331  if (this%icnvg == 0) then
332  write (this%iout, fmtnocnvg) kstp, kper
333  end if
334  end subroutine tsp_ot
335 
336  !> @brief Generalized transport model output routine
337  !!
338  !! Calculate and save observations
339  !<
340  subroutine tsp_ot_obs(this)
341  class(transportmodeltype) :: this
342  class(bndtype), pointer :: packobj
343  integer(I4B) :: ip
344  ! -- Calculate and save observations
345  call this%obs%obs_bd()
346  call this%obs%obs_ot()
347  !
348  ! -- Calculate and save package obserations
349  do ip = 1, this%bndlist%Count()
350  packobj => getbndfromlist(this%bndlist, ip)
351  call packobj%bnd_bd_obs()
352  call packobj%bnd_ot_obs()
353  end do
354  !
355  end subroutine tsp_ot_obs
356 
357  !> @brief Generalized transport model output routine
358  !!
359  !! Save and print flows
360  !<
361  subroutine tsp_ot_flow(this, icbcfl, ibudfl, icbcun)
362  ! -- dummy
363  class(transportmodeltype) :: this
364  integer(I4B), intent(in) :: icbcfl
365  integer(I4B), intent(in) :: ibudfl
366  integer(I4B), intent(in) :: icbcun
367  ! -- local
368  class(bndtype), pointer :: packobj
369  integer(I4B) :: ip
370  !
371  ! -- Save TSP flows
372  call this%tsp_ot_flowja(this%nja, this%flowja, icbcfl, icbcun)
373  if (this%infmi > 0) call this%fmi%fmi_ot_flow(icbcfl, icbcun)
374  if (this%inssm > 0) then
375  call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
376  end if
377  !
378  do ip = 1, this%bndlist%Count()
379  packobj => getbndfromlist(this%bndlist, ip)
380  call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
381  end do
382  !
383  ! -- Save advanced package flows
384  do ip = 1, this%bndlist%Count()
385  packobj => getbndfromlist(this%bndlist, ip)
386  call packobj%bnd_ot_package_flows(icbcfl=icbcfl, ibudfl=0)
387  end do
388  if (this%inmvt > 0) then
389  call this%mvt%mvt_ot_saveflow(icbcfl, ibudfl)
390  end if
391  !
392  ! -- Print Model (GWT or GWE) flows
393  ! no need to print flowja
394  ! no need to print mst
395  ! no need to print fmi
396  if (this%inssm > 0) then
397  call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
398  end if
399  do ip = 1, this%bndlist%Count()
400  packobj => getbndfromlist(this%bndlist, ip)
401  call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
402  end do
403  !
404  ! -- Print advanced package flows
405  do ip = 1, this%bndlist%Count()
406  packobj => getbndfromlist(this%bndlist, ip)
407  call packobj%bnd_ot_package_flows(icbcfl=0, ibudfl=ibudfl)
408  end do
409  !
410  if (this%inmvt > 0) then
411  call this%mvt%mvt_ot_printflow(icbcfl, ibudfl)
412  end if
413  !
414  end subroutine tsp_ot_flow
415 
416  !> @brief Generalized transport model output routine
417  !!
418  !! Write intercell flows for the transport model
419  !<
420  subroutine tsp_ot_flowja(this, nja, flowja, icbcfl, icbcun)
421  ! -- dummy
422  class(transportmodeltype) :: this
423  integer(I4B), intent(in) :: nja
424  real(DP), dimension(nja), intent(in) :: flowja
425  integer(I4B), intent(in) :: icbcfl
426  integer(I4B), intent(in) :: icbcun
427  ! -- local
428  integer(I4B) :: ibinun
429  ! -- formats
430  !
431  ! -- Set unit number for binary output
432  if (this%ipakcb < 0) then
433  ibinun = icbcun
434  elseif (this%ipakcb == 0) then
435  ibinun = 0
436  else
437  ibinun = this%ipakcb
438  end if
439  if (icbcfl == 0) ibinun = 0
440  !
441  ! -- Write the face flows if requested
442  if (ibinun /= 0) then
443  call this%dis%record_connection_array(flowja, ibinun, this%iout)
444  end if
445  end subroutine tsp_ot_flowja
446 
447  !> @brief Generalized transport model output routine
448  !!
449  !! Loop through attached packages saving and printing dependent variables
450  !<
451  subroutine tsp_ot_dv(this, idvsave, idvprint, ipflag)
452  class(transportmodeltype) :: this
453  integer(I4B), intent(in) :: idvsave
454  integer(I4B), intent(in) :: idvprint
455  integer(I4B), intent(inout) :: ipflag
456  class(bndtype), pointer :: packobj
457  integer(I4B) :: ip
458  !
459  ! -- Print advanced package dependent variables
460  do ip = 1, this%bndlist%Count()
461  packobj => getbndfromlist(this%bndlist, ip)
462  call packobj%bnd_ot_dv(idvsave, idvprint)
463  end do
464  !
465  ! -- Save head and print head
466  call this%oc%oc_ot(ipflag)
467  end subroutine tsp_ot_dv
468 
469  !> @brief Generalized transport model output budget summary
470  !!
471  !! Loop through attached packages and write budget summaries
472  !<
473  subroutine tsp_ot_bdsummary(this, ibudfl, ipflag)
474  use tdismodule, only: kstp, kper, totim, delt
475  class(transportmodeltype) :: this
476  integer(I4B), intent(in) :: ibudfl
477  integer(I4B), intent(inout) :: ipflag
478  class(bndtype), pointer :: packobj
479  integer(I4B) :: ip
480  !
481  ! -- Package budget summary
482  do ip = 1, this%bndlist%Count()
483  packobj => getbndfromlist(this%bndlist, ip)
484  call packobj%bnd_ot_bdsummary(kstp, kper, this%iout, ibudfl)
485  end do
486  !
487  ! -- Mover budget summary
488  if (this%inmvt > 0) then
489  call this%mvt%mvt_ot_bdsummary(ibudfl)
490  end if
491  !
492  ! -- Model budget summary
493  call this%budget%finalize_step(delt)
494  if (ibudfl /= 0) then
495  ipflag = 1
496  call this%budget%budget_ot(kstp, kper, this%iout)
497  end if
498  !
499  ! -- Write to budget csv
500  call this%budget%writecsv(totim)
501  end subroutine tsp_ot_bdsummary
502 
503  !> @brief Allocate scalar variables for transport model
504  !!
505  !! Method to allocate memory for non-allocatable members.
506  !<
507  subroutine allocate_tsp_scalars(this, modelname)
508  ! -- modules
510  ! -- dummy
511  class(transportmodeltype) :: this
512  character(len=*), intent(in) :: modelname
513  !
514  ! -- allocate members from (grand)parent class
515  call this%NumericalModelType%allocate_scalars(modelname)
516  !
517  ! -- allocate members that are part of model class
518  call mem_allocate(this%inic, 'INIC', this%memoryPath)
519  call mem_allocate(this%infmi, 'INFMI', this%memoryPath)
520  call mem_allocate(this%inmvt, 'INMVT', this%memoryPath)
521  call mem_allocate(this%inadv, 'INADV', this%memoryPath)
522  call mem_allocate(this%inssm, 'INSSM', this%memoryPath)
523  call mem_allocate(this%inoc, 'INOC ', this%memoryPath)
524  call mem_allocate(this%inobs, 'INOBS', this%memoryPath)
525  call mem_allocate(this%eqnsclfac, 'EQNSCLFAC', this%memoryPath)
526  call mem_allocate(this%idv_scale, 'IDV_SCALE', this%memoryPath)
527 
528  this%inic = 0
529  this%infmi = 0
530  this%inmvt = 0
531  this%inadv = 0
532  this%inssm = 0
533  this%inoc = 0
534  this%inobs = 0
535  this%eqnsclfac = dzero
536  this%idv_scale = 0
537  end subroutine allocate_tsp_scalars
538 
539  !> @brief Define the labels corresponding to the flavor of
540  !! transport model
541  !!
542  !! Set variable names according to type of transport model
543  !<
544  subroutine set_tsp_labels(this, tsptype, depvartype, depvarunit, &
545  depvarunitabbrev)
546  class(transportmodeltype) :: this
547  character(len=*), intent(in), pointer :: tsptype !< type of model, default is GWT (alternative is GWE)
548  character(len=*), intent(in) :: depvartype !< dependent variable type, default is "CONCENTRATION"
549  character(len=*), intent(in) :: depvarunit !< units of dependent variable for writing to list file
550  character(len=*), intent(in) :: depvarunitabbrev !< abbreviation of associated units
551  !
552  ! -- Set the model type
553  this%tsptype = tsptype
554  !
555  ! -- Set the type of dependent variable being solved for
556  this%depvartype = depvartype
557  !
558  ! -- Set the units associated with the dependent variable
559  this%depvarunit = depvarunit
560  !
561  ! -- Set the units abbreviation
562  this%depvarunitabbrev = depvarunitabbrev
563  end subroutine set_tsp_labels
564 
565  !> @brief Deallocate memory
566  !!
567  !! Deallocate memory at conclusion of model run
568  !<
569  subroutine tsp_da(this)
570  ! -- modules
572  ! -- dummy
573  class(transportmodeltype) :: this
574  ! -- local
575  !
576  ! -- Scalars
577  call mem_deallocate(this%inic)
578  call mem_deallocate(this%infmi)
579  call mem_deallocate(this%inadv)
580  call mem_deallocate(this%inssm)
581  call mem_deallocate(this%inmvt)
582  call mem_deallocate(this%inoc)
583  call mem_deallocate(this%inobs)
584  call mem_deallocate(this%eqnsclfac)
585  end subroutine tsp_da
586 
587  !> @brief Generalized transport model routine
588  !!
589  !! Check to make sure required input files have been specified
590  !<
591  subroutine ftype_check(this, indis, inmst)
592  ! -- modules
593  use constantsmodule, only: linelength
595  ! -- dummy
596  class(transportmodeltype) :: this
597  integer(I4B), intent(in) :: indis
598  integer(I4B), intent(in) :: inmst !< representative of both inmst and inest depending on model type
599  ! -- local
600  character(len=LINELENGTH) :: errmsg
601  !
602  ! -- Check for IC6, DIS(u), and MST. Stop if not present.
603  if (this%inic == 0) then
604  write (errmsg, '(a)') &
605  'Initial conditions (IC6) package not specified.'
606  call store_error(errmsg)
607  end if
608  if (indis == 0) then
609  write (errmsg, '(a)') &
610  'Discretization (DIS6 or DISU6) package not specified.'
611  call store_error(errmsg)
612  end if
613  if (inmst == 0) then
614  write (errmsg, '(a)') 'Mass storage and transfer (MST6) &
615  &package not specified.'
616  call store_error(errmsg)
617  end if
618  !
619  if (count_errors() > 0) then
620  write (errmsg, '(a)') 'Required package(s) not specified.'
621  call store_error(errmsg)
622  call store_error_filename(this%filename)
623  end if
624  end subroutine ftype_check
625 
626  !> @brief Write model name file options to list file
627  !<
628  subroutine log_namfile_options(this, found)
629  ! -- modules
631  ! -- dummy
632  class(transportmodeltype) :: this
633  type(gwtnamparamfoundtype), intent(in) :: found
634  !
635  write (this%iout, '(1x,a)') 'NAMEFILE OPTIONS:'
636  !
637  !
638  if (found%print_input) then
639  write (this%iout, '(4x,a)') 'STRESS PACKAGE INPUT WILL BE PRINTED '// &
640  'FOR ALL MODEL STRESS PACKAGES'
641  end if
642  !
643  if (found%print_flows) then
644  write (this%iout, '(4x,a)') 'PACKAGE FLOWS WILL BE PRINTED '// &
645  'FOR ALL MODEL PACKAGES'
646  end if
647  !
648  if (found%save_flows) then
649  write (this%iout, '(4x,a)') &
650  'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL'
651  end if
652 
653  if (found%idv_scale) then
654  write (this%iout, '(2(3x,a,/),3x,a,/,9x,a,/)') &
655  'X and RHS will be scaled to avoid very large positive or negative', &
656  'dependent variable values in the model IMS package.', &
657  'NOTE: Specified outer and inner DVCLOSE values in the model IMS &
658  &package', 'will be relative closure criteria.'
659  end if
660  !
661  write (this%iout, '(1x,a)') 'END NAMEFILE OPTIONS:'
662  end subroutine log_namfile_options
663 
664  !> @brief Source package info and begin to process
665  !<
666  subroutine create_tsp_packages(this, indis)
667  ! -- modules
673  use dismodule, only: dis_cr
674  use disvmodule, only: disv_cr
675  use disumodule, only: disu_cr
676  use tspicmodule, only: ic_cr
677  use tspfmimodule, only: fmi_cr
678  use tspadvmodule, only: adv_cr
679  use tspssmmodule, only: ssm_cr
680  use tspmvtmodule, only: mvt_cr
681  use tspocmodule, only: oc_cr
682  use tspobsmodule, only: tsp_obs_cr
683  ! -- dummy
684  class(transportmodeltype) :: this
685  integer(I4B), intent(inout) :: indis ! DIS enabled flag
686  ! -- local
687  type(characterstringtype), dimension(:), contiguous, &
688  pointer :: pkgtypes => null()
689  type(characterstringtype), dimension(:), contiguous, &
690  pointer :: pkgnames => null()
691  type(characterstringtype), dimension(:), contiguous, &
692  pointer :: mempaths => null()
693  integer(I4B), dimension(:), contiguous, &
694  pointer :: inunits => null()
695  character(len=LENMEMPATH) :: model_mempath
696  character(len=LENFTYPE) :: pkgtype
697  character(len=LENPACKAGENAME) :: pkgname
698  character(len=LENMEMPATH) :: mempath
699  integer(I4B), pointer :: inunit
700  integer(I4B) :: n
701  character(len=LENMEMPATH) :: mempathadv = ''
702  character(len=LENMEMPATH) :: mempathfmi = ''
703  character(len=LENMEMPATH) :: mempathic = ''
704  character(len=LENMEMPATH) :: mempathssm = ''
705  !
706  ! -- Initialize
707  indis = 0
708  !
709  ! -- Set input memory paths, input/model and input/model/namfile
710  model_mempath = create_mem_path(component=this%name, context=idm_context)
711  !
712  ! -- Set pointers to model path package info
713  call mem_setptr(pkgtypes, 'PKGTYPES', model_mempath)
714  call mem_setptr(pkgnames, 'PKGNAMES', model_mempath)
715  call mem_setptr(mempaths, 'MEMPATHS', model_mempath)
716  call mem_setptr(inunits, 'INUNITS', model_mempath)
717  !
718  do n = 1, size(pkgtypes)
719  !
720  ! -- Attributes for this input package
721  pkgtype = pkgtypes(n)
722  pkgname = pkgnames(n)
723  mempath = mempaths(n)
724  inunit => inunits(n)
725  !
726  ! -- Create dis package as it is a prerequisite for other packages
727  select case (pkgtype)
728  case ('DIS6')
729  indis = 1
730  call dis_cr(this%dis, this%name, mempath, indis, this%iout)
731  case ('DISV6')
732  indis = 1
733  call disv_cr(this%dis, this%name, mempath, indis, this%iout)
734  case ('DISU6')
735  indis = 1
736  call disu_cr(this%dis, this%name, mempath, indis, this%iout)
737  case ('IC6')
738  this%inic = 1
739  mempathic = mempath
740  case ('FMI6')
741  this%infmi = 1
742  mempathfmi = mempath
743  case ('MVT6', 'MVE6')
744  this%inmvt = inunit
745  case ('ADV6')
746  this%inadv = 1
747  mempathadv = mempath
748  case ('SSM6')
749  this%inssm = 1
750  mempathssm = mempath
751  case ('OC6')
752  this%inoc = inunit
753  case ('OBS6')
754  this%inobs = inunit
755  !case default
756  ! TODO
757  end select
758  end do
759  !
760  ! -- Create packages that are tied directly to model
761  call ic_cr(this%ic, this%name, mempathic, this%inic, this%iout, this%dis, &
762  this%depvartype)
763  call fmi_cr(this%fmi, this%name, mempathfmi, this%infmi, this%iout, &
764  this%eqnsclfac, this%depvartype)
765  call adv_cr(this%adv, this%name, mempathadv, this%inadv, this%iout, &
766  this%fmi, this%eqnsclfac)
767  call ssm_cr(this%ssm, this%name, mempathssm, this%inssm, this%iout, &
768  this%fmi, this%eqnsclfac, this%depvartype)
769  call mvt_cr(this%mvt, this%name, this%inmvt, this%iout, this%fmi, &
770  this%eqnsclfac, this%depvartype)
771  call oc_cr(this%oc, this%name, this%inoc, this%iout)
772  call tsp_obs_cr(this%obs, this%inobs, this%depvartype)
773  end subroutine create_tsp_packages
774 
775  !> @brief return 1 if option to normalize the x and rhs has been specified.
776  !! Otherwise return 0.
777  !<
778  function tsp_get_idv_scale(this) result(idv_scale)
779  class(transportmodeltype) :: this
780  ! -- local
781  integer(I4B) :: idv_scale
782  !
783  ! -- Start by setting iasym to zero
784  idv_scale = this%idv_scale
785  end function tsp_get_idv_scale
786 
787 end module transportmodelmodule
This module contains the base boundary package.
class(bndtype) function, pointer, public getbndfromlist(list, idx)
Get boundary from package list.
This module contains the BudgetModule.
Definition: Budget.f90:20
subroutine, public budget_cr(this, name_model)
@ brief Create a new budget object
Definition: Budget.f90:84
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
integer(i4b), parameter lenpackagename
maximum length of the package name
Definition: Constants.f90:23
integer(i4b), parameter lenpakloc
maximum length of a package location
Definition: Constants.f90:50
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
Definition: Constants.f90:39
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
Definition: Dis.f90:1
subroutine, public dis_cr(dis, name_model, input_mempath, inunit, iout)
Create a new structured discretization object.
Definition: Dis.f90:99
subroutine, public disu_cr(dis, name_model, input_mempath, inunit, iout)
Create a new unstructured discretization object.
Definition: Disu.f90:127
subroutine, public disv_cr(dis, name_model, input_mempath, inunit, iout)
Create a new discretization by vertices object.
Definition: Disv.f90:111
This module defines variable data types.
Definition: kind.f90:8
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
Definition: Sim.f90:203
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
character(len=linelength) idm_context
logical(lgp), pointer, public endofperiod
flag indicating end of stress period
Definition: tdis.f90:27
subroutine, public tdis_ot(iout)
Print simulation time.
Definition: tdis.f90:274
real(dp), pointer, public totim
time relative to start of simulation
Definition: tdis.f90:32
integer(i4b), pointer, public kstp
current time step number
Definition: tdis.f90:24
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:23
real(dp), pointer, public delt
length of the current time step
Definition: tdis.f90:29
This module contains the base transport model type.
Definition: tsp.f90:7
subroutine tsp_ot_flowja(this, nja, flowja, icbcfl, icbcun)
Generalized transport model output routine.
Definition: tsp.f90:421
subroutine tsp_bd(this, icnvg, isuppress_output)
Generalized transport model budget.
Definition: tsp.f90:270
subroutine tsp_cr(this, filename, id, modelname, macronym, indis)
Create a new generalized transport model object.
Definition: tsp.f90:96
integer(i4b) function tsp_get_idv_scale(this)
return 1 if option to normalize the x and rhs has been specified. Otherwise return 0.
Definition: tsp.f90:779
subroutine tsp_da(this)
Deallocate memory.
Definition: tsp.f90:570
subroutine tsp_ac(this, sparse)
Generalized transport model add connections.
Definition: tsp.f90:172
subroutine tsp_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
Generalized transport model final convergence check.
Definition: tsp.f90:241
subroutine tsp_ot(this)
Generalized transport model output routine.
Definition: tsp.f90:281
subroutine tsp_rp(this)
Generalized transport model read and prepare.
Definition: tsp.f90:208
subroutine tsp_ot_dv(this, idvsave, idvprint, ipflag)
Generalized transport model output routine.
Definition: tsp.f90:452
subroutine tsp_ad(this)
Generalized transport model time step advance.
Definition: tsp.f90:218
subroutine allocate_tsp_scalars(this, modelname)
Allocate scalar variables for transport model.
Definition: tsp.f90:508
subroutine tsp_mc(this, matrix_sln)
Generalized transport model map coefficients.
Definition: tsp.f90:186
subroutine tsp_ot_bdsummary(this, ibudfl, ipflag)
Generalized transport model output budget summary.
Definition: tsp.f90:474
subroutine tsp_ot_obs(this)
Generalized transport model output routine.
Definition: tsp.f90:341
subroutine tsp_ot_flow(this, icbcfl, ibudfl, icbcun)
Generalized transport model output routine.
Definition: tsp.f90:362
subroutine tsp_ar(this)
Generalized transport model allocate and read.
Definition: tsp.f90:198
subroutine log_namfile_options(this, found)
Write model name file options to list file.
Definition: tsp.f90:629
subroutine create_tsp_packages(this, indis)
Source package info and begin to process.
Definition: tsp.f90:667
subroutine tsp_cq(this, icnvg, isuppress_output)
Generalized transport model calculate flows.
Definition: tsp.f90:258
subroutine tsp_df(this)
Generalized transport model define model.
Definition: tsp.f90:162
subroutine tsp_fc(this, kiter, matrix_sln, inwtflag)
Generalized transport model fill coefficients.
Definition: tsp.f90:228
subroutine set_tsp_labels(this, tsptype, depvartype, depvarunit, depvarunitabbrev)
Define the labels corresponding to the flavor of transport model.
Definition: tsp.f90:546
subroutine ftype_check(this, indis, inmst)
Generalized transport model routine.
Definition: tsp.f90:592
subroutine, public adv_cr(advobj, name_model, input_mempath, inunit, iout, fmi, eqnsclfac)
@ brief Create a new ADV object
Definition: tsp-adv.f90:58
subroutine, public fmi_cr(fmiobj, name_model, input_mempath, inunit, iout, eqnsclfac, depvartype)
Create a new FMI object.
Definition: tsp-fmi.f90:76
subroutine, public ic_cr(ic, name_model, input_mempath, inunit, iout, dis, depvartype)
Create a new initial conditions object.
Definition: tsp-ic.f90:25
subroutine, public mvt_cr(mvt, name_model, inunit, iout, fmi1, eqnsclfac, depvartype, gwfmodelname1, gwfmodelname2, fmi2)
Create a new mover transport object.
Definition: tsp-mvt.f90:75
subroutine, public tsp_obs_cr(obs, inobs, dvt)
Create a new TspObsType object.
Definition: tsp-obs.f90:44
subroutine, public oc_cr(ocobj, name_model, inunit, iout)
@ brief Create TspOcType
Definition: tsp-oc.f90:31
This module contains the TspSsm Module.
Definition: tsp-ssm.f90:8
subroutine, public ssm_cr(ssmobj, name_model, input_mempath, inunit, iout, fmi, eqnsclfac, depvartype)
@ brief Create a new SSM package
Definition: tsp-ssm.f90:82
@ brief BndType
Derived type for the Budget object.
Definition: Budget.f90:39
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23
@ brief Output control
Definition: tsp-oc.f90:18
Derived type for the SSM Package.
Definition: tsp-ssm.f90:37