41 integer(I4B),
pointer :: infmi => null()
42 integer(I4B),
pointer :: inadv => null()
43 integer(I4B),
pointer :: inic => null()
44 integer(I4B),
pointer :: inmvt => null()
45 integer(I4B),
pointer :: inoc => null()
46 integer(I4B),
pointer :: inobs => null()
48 integer(I4B),
pointer :: inssm => null()
49 real(dp),
pointer :: eqnsclfac => null()
51 character(len=LENVARNAME) :: tsptype =
''
52 character(len=LENVARNAME) :: depvartype =
''
53 character(len=LENVARNAME) :: depvarunit =
''
54 character(len=LENVARNAME) :: depvarunitabbrev =
''
56 integer(I4B),
pointer :: idv_scale => null()
73 procedure,
public :: model_ot =>
tsp_ot
95 subroutine tsp_cr(this, filename, id, modelname, macronym, indis)
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
110 character(len=LENMEMPATH) :: input_mempath
111 character(len=LINELENGTH) :: lst_fname
115 this%filename = filename
116 this%name = modelname
118 this%macronym = macronym
124 call mem_set_value(lst_fname,
'LIST', input_mempath, found%list)
125 call mem_set_value(this%iprpak,
'PRINT_INPUT', input_mempath, &
127 call mem_set_value(this%iprflow,
'PRINT_FLOWS', input_mempath, &
129 call mem_set_value(this%ipakcb,
'SAVE_FLOWS', input_mempath, &
131 call mem_set_value(this%idv_scale,
'IDV_SCALE', input_mempath, &
135 call this%create_lstfile(lst_fname, filename, found%list, &
136 'TRANSPORT MODEL ('//trim(macronym)//
')')
139 if (found%save_flows)
then
144 if (this%iout > 0)
then
145 call this%log_namfile_options(found)
152 call this%create_tsp_packages(indis)
227 subroutine tsp_fc(this, kiter, matrix_sln, inwtflag)
230 integer(I4B),
intent(in) :: kiter
232 integer(I4B),
intent(in) :: inwtflag
240 subroutine tsp_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
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
257 subroutine tsp_cq(this, icnvg, isuppress_output)
260 integer(I4B),
intent(in) :: icnvg
261 integer(I4B),
intent(in) :: isuppress_output
269 subroutine tsp_bd(this, icnvg, isuppress_output)
272 integer(I4B),
intent(in) :: icnvg
273 integer(I4B),
intent(in) :: isuppress_output
286 integer(I4B) :: idvsave
287 integer(I4B) :: idvprint
288 integer(I4B) :: icbcfl
289 integer(I4B) :: icbcun
290 integer(I4B) :: ibudfl
291 integer(I4B) :: ipflag
293 character(len=*),
parameter :: fmtnocnvg = &
294 "(1X,/9X,'****FAILED TO MEET SOLVER CONVERGENCE CRITERIA IN TIME STEP ', &
295 &I0,' OF STRESS PERIOD ',I0,'****')"
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')
310 ibudfl = this%oc%set_print_flag(
'BUDGET', this%icnvg,
endofperiod)
311 idvprint = this%oc%set_print_flag(trim(this%depvartype), &
315 call this%tsp_ot_obs()
318 call this%tsp_ot_flow(icbcfl, ibudfl, icbcun)
321 call this%tsp_ot_dv(idvsave, idvprint, ipflag)
324 call this%tsp_ot_bdsummary(ibudfl, ipflag)
328 if (ipflag == 1)
call tdis_ot(this%iout)
331 if (this%icnvg == 0)
then
332 write (this%iout, fmtnocnvg)
kstp,
kper
342 class(
bndtype),
pointer :: packobj
345 call this%obs%obs_bd()
346 call this%obs%obs_ot()
349 do ip = 1, this%bndlist%Count()
351 call packobj%bnd_bd_obs()
352 call packobj%bnd_ot_obs()
364 integer(I4B),
intent(in) :: icbcfl
365 integer(I4B),
intent(in) :: ibudfl
366 integer(I4B),
intent(in) :: icbcun
368 class(
bndtype),
pointer :: packobj
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)
378 do ip = 1, this%bndlist%Count()
380 call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
384 do ip = 1, this%bndlist%Count()
386 call packobj%bnd_ot_package_flows(icbcfl=icbcfl, ibudfl=0)
388 if (this%inmvt > 0)
then
389 call this%mvt%mvt_ot_saveflow(icbcfl, ibudfl)
396 if (this%inssm > 0)
then
397 call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
399 do ip = 1, this%bndlist%Count()
401 call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
405 do ip = 1, this%bndlist%Count()
407 call packobj%bnd_ot_package_flows(icbcfl=0, ibudfl=ibudfl)
410 if (this%inmvt > 0)
then
411 call this%mvt%mvt_ot_printflow(icbcfl, ibudfl)
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
428 integer(I4B) :: ibinun
432 if (this%ipakcb < 0)
then
434 elseif (this%ipakcb == 0)
then
439 if (icbcfl == 0) ibinun = 0
442 if (ibinun /= 0)
then
443 call this%dis%record_connection_array(flowja, ibinun, this%iout)
453 integer(I4B),
intent(in) :: idvsave
454 integer(I4B),
intent(in) :: idvprint
455 integer(I4B),
intent(inout) :: ipflag
456 class(
bndtype),
pointer :: packobj
460 do ip = 1, this%bndlist%Count()
462 call packobj%bnd_ot_dv(idvsave, idvprint)
466 call this%oc%oc_ot(ipflag)
476 integer(I4B),
intent(in) :: ibudfl
477 integer(I4B),
intent(inout) :: ipflag
478 class(
bndtype),
pointer :: packobj
482 do ip = 1, this%bndlist%Count()
484 call packobj%bnd_ot_bdsummary(
kstp,
kper, this%iout, ibudfl)
488 if (this%inmvt > 0)
then
489 call this%mvt%mvt_ot_bdsummary(ibudfl)
493 call this%budget%finalize_step(
delt)
494 if (ibudfl /= 0)
then
496 call this%budget%budget_ot(
kstp,
kper, this%iout)
500 call this%budget%writecsv(
totim)
512 character(len=*),
intent(in) :: modelname
515 call this%NumericalModelType%allocate_scalars(modelname)
525 call mem_allocate(this%eqnsclfac,
'EQNSCLFAC', this%memoryPath)
526 call mem_allocate(this%idv_scale,
'IDV_SCALE', this%memoryPath)
535 this%eqnsclfac =
dzero
547 character(len=*),
intent(in),
pointer :: tsptype
548 character(len=*),
intent(in) :: depvartype
549 character(len=*),
intent(in) :: depvarunit
550 character(len=*),
intent(in) :: depvarunitabbrev
553 this%tsptype = tsptype
556 this%depvartype = depvartype
559 this%depvarunit = depvarunit
562 this%depvarunitabbrev = depvarunitabbrev
597 integer(I4B),
intent(in) :: indis
598 integer(I4B),
intent(in) :: inmst
600 character(len=LINELENGTH) :: errmsg
603 if (this%inic == 0)
then
604 write (errmsg,
'(a)') &
605 'Initial conditions (IC6) package not specified.'
609 write (errmsg,
'(a)') &
610 'Discretization (DIS6 or DISU6) package not specified.'
614 write (errmsg,
'(a)')
'Mass storage and transfer (MST6) &
615 &package not specified.'
620 write (errmsg,
'(a)')
'Required package(s) not specified.'
635 write (this%iout,
'(1x,a)')
'NAMEFILE OPTIONS:'
638 if (found%print_input)
then
639 write (this%iout,
'(4x,a)')
'STRESS PACKAGE INPUT WILL BE PRINTED '// &
640 'FOR ALL MODEL STRESS PACKAGES'
643 if (found%print_flows)
then
644 write (this%iout,
'(4x,a)')
'PACKAGE FLOWS WILL BE PRINTED '// &
645 'FOR ALL MODEL PACKAGES'
648 if (found%save_flows)
then
649 write (this%iout,
'(4x,a)') &
650 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL'
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.'
661 write (this%iout,
'(1x,a)')
'END NAMEFILE OPTIONS:'
685 integer(I4B),
intent(inout) :: indis
688 pointer :: pkgtypes => null()
690 pointer :: pkgnames => null()
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
701 character(len=LENMEMPATH) :: mempathadv =
''
702 character(len=LENMEMPATH) :: mempathfmi =
''
703 character(len=LENMEMPATH) :: mempathic =
''
704 character(len=LENMEMPATH) :: mempathssm =
''
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)
718 do n = 1,
size(pkgtypes)
721 pkgtype = pkgtypes(n)
722 pkgname = pkgnames(n)
723 mempath = mempaths(n)
727 select case (pkgtype)
730 call dis_cr(this%dis, this%name, mempath, indis, this%iout)
733 call disv_cr(this%dis, this%name, mempath, indis, this%iout)
736 call disu_cr(this%dis, this%name, mempath, indis, this%iout)
743 case (
'MVT6',
'MVE6')
761 call ic_cr(this%ic, this%name, mempathic, this%inic, this%iout, this%dis, &
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)
781 integer(I4B) :: idv_scale
784 idv_scale = this%idv_scale
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.
subroutine, public budget_cr(this, name_model)
@ brief Create a new budget object
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenpackagename
maximum length of the package name
integer(i4b), parameter lenpakloc
maximum length of a package location
integer(i4b), parameter lenvarname
maximum length of a variable name
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenmempath
maximum length of the memory path
subroutine, public dis_cr(dis, name_model, input_mempath, inunit, iout)
Create a new structured discretization object.
subroutine, public disu_cr(dis, name_model, input_mempath, inunit, iout)
Create a new unstructured discretization object.
subroutine, public disv_cr(dis, name_model, input_mempath, inunit, iout)
Create a new discretization by vertices object.
This module defines variable data types.
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
character(len=linelength) idm_context
logical(lgp), pointer, public endofperiod
flag indicating end of stress period
subroutine, public tdis_ot(iout)
Print simulation time.
real(dp), pointer, public totim
time relative to start of simulation
integer(i4b), pointer, public kstp
current time step number
integer(i4b), pointer, public kper
current stress period number
real(dp), pointer, public delt
length of the current time step
This module contains the base transport model type.
subroutine tsp_ot_flowja(this, nja, flowja, icbcfl, icbcun)
Generalized transport model output routine.
subroutine tsp_bd(this, icnvg, isuppress_output)
Generalized transport model budget.
subroutine tsp_cr(this, filename, id, modelname, macronym, indis)
Create a new generalized transport model object.
integer(i4b) function tsp_get_idv_scale(this)
return 1 if option to normalize the x and rhs has been specified. Otherwise return 0.
subroutine tsp_da(this)
Deallocate memory.
subroutine tsp_ac(this, sparse)
Generalized transport model add connections.
subroutine tsp_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
Generalized transport model final convergence check.
subroutine tsp_ot(this)
Generalized transport model output routine.
subroutine tsp_rp(this)
Generalized transport model read and prepare.
subroutine tsp_ot_dv(this, idvsave, idvprint, ipflag)
Generalized transport model output routine.
subroutine tsp_ad(this)
Generalized transport model time step advance.
subroutine allocate_tsp_scalars(this, modelname)
Allocate scalar variables for transport model.
subroutine tsp_mc(this, matrix_sln)
Generalized transport model map coefficients.
subroutine tsp_ot_bdsummary(this, ibudfl, ipflag)
Generalized transport model output budget summary.
subroutine tsp_ot_obs(this)
Generalized transport model output routine.
subroutine tsp_ot_flow(this, icbcfl, ibudfl, icbcun)
Generalized transport model output routine.
subroutine tsp_ar(this)
Generalized transport model allocate and read.
subroutine log_namfile_options(this, found)
Write model name file options to list file.
subroutine create_tsp_packages(this, indis)
Source package info and begin to process.
subroutine tsp_cq(this, icnvg, isuppress_output)
Generalized transport model calculate flows.
subroutine tsp_df(this)
Generalized transport model define model.
subroutine tsp_fc(this, kiter, matrix_sln, inwtflag)
Generalized transport model fill coefficients.
subroutine set_tsp_labels(this, tsptype, depvartype, depvarunit, depvarunitabbrev)
Define the labels corresponding to the flavor of transport model.
subroutine ftype_check(this, indis, inmst)
Generalized transport model routine.
subroutine, public adv_cr(advobj, name_model, input_mempath, inunit, iout, fmi, eqnsclfac)
@ brief Create a new ADV object
subroutine, public fmi_cr(fmiobj, name_model, input_mempath, inunit, iout, eqnsclfac, depvartype)
Create a new FMI object.
subroutine, public ic_cr(ic, name_model, input_mempath, inunit, iout, dis, depvartype)
Create a new initial conditions object.
subroutine, public mvt_cr(mvt, name_model, inunit, iout, fmi1, eqnsclfac, depvartype, gwfmodelname1, gwfmodelname2, fmi2)
Create a new mover transport object.
subroutine, public tsp_obs_cr(obs, inobs, dvt)
Create a new TspObsType object.
subroutine, public oc_cr(ocobj, name_model, inunit, iout)
@ brief Create TspOcType
This module contains the TspSsm Module.
subroutine, public ssm_cr(ssmobj, name_model, input_mempath, inunit, iout, fmi, eqnsclfac, depvartype)
@ brief Create a new SSM package
Derived type for the Budget object.
This class is used to store a single deferred-length character string. It was designed to work in an ...
Derived type for the SSM Package.