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