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 =
''
92 subroutine tsp_cr(this, filename, id, modelname, macronym, indis)
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
107 character(len=LENMEMPATH) :: input_mempath
108 character(len=LINELENGTH) :: lst_fname
112 this%filename = filename
113 this%name = modelname
115 this%macronym = macronym
121 call mem_set_value(lst_fname,
'LIST', input_mempath, found%list)
122 call mem_set_value(this%iprpak,
'PRINT_INPUT', input_mempath, &
124 call mem_set_value(this%iprflow,
'PRINT_FLOWS', input_mempath, &
126 call mem_set_value(this%ipakcb,
'SAVE_FLOWS', input_mempath, found%save_flows)
129 call this%create_lstfile(lst_fname, filename, found%list, &
130 'TRANSPORT MODEL ('//trim(macronym)//
')')
133 if (found%save_flows)
then
138 if (this%iout > 0)
then
139 call this%log_namfile_options(found)
146 call this%create_tsp_packages(indis)
242 subroutine tsp_fc(this, kiter, matrix_sln, inwtflag)
245 integer(I4B),
intent(in) :: kiter
247 integer(I4B),
intent(in) :: inwtflag
258 subroutine tsp_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
261 integer(I4B),
intent(in) :: innertot
262 integer(I4B),
intent(in) :: kiter
263 integer(I4B),
intent(in) :: iend
264 integer(I4B),
intent(in) :: icnvgmod
265 character(len=LENPAKLOC),
intent(inout) :: cpak
266 integer(I4B),
intent(inout) :: ipak
267 real(DP),
intent(inout) :: dpak
278 subroutine tsp_cq(this, icnvg, isuppress_output)
281 integer(I4B),
intent(in) :: icnvg
282 integer(I4B),
intent(in) :: isuppress_output
293 subroutine tsp_bd(this, icnvg, isuppress_output)
296 integer(I4B),
intent(in) :: icnvg
297 integer(I4B),
intent(in) :: isuppress_output
312 integer(I4B),
intent(in) :: inmst
314 integer(I4B) :: idvsave
315 integer(I4B) :: idvprint
316 integer(I4B) :: icbcfl
317 integer(I4B) :: icbcun
318 integer(I4B) :: ibudfl
319 integer(I4B) :: ipflag
321 character(len=*),
parameter :: fmtnocnvg = &
322 "(1X,/9X,'****FAILED TO MEET SOLVER CONVERGENCE CRITERIA IN TIME STEP ', &
323 &I0,' OF STRESS PERIOD ',I0,'****')"
330 if (this%oc%oc_save(trim(this%depvartype))) idvsave = 1
331 if (this%oc%oc_print(trim(this%depvartype))) idvprint = 1
332 if (this%oc%oc_save(
'BUDGET')) icbcfl = 1
333 if (this%oc%oc_print(
'BUDGET')) ibudfl = 1
334 icbcun = this%oc%oc_save_unit(
'BUDGET')
338 ibudfl = this%oc%set_print_flag(
'BUDGET', this%icnvg,
endofperiod)
339 idvprint = this%oc%set_print_flag(trim(this%depvartype), &
343 call this%tsp_ot_obs()
346 call this%tsp_ot_flow(icbcfl, ibudfl, icbcun, inmst)
349 call this%tsp_ot_dv(idvsave, idvprint, ipflag)
352 call this%tsp_ot_bdsummary(ibudfl, ipflag)
356 if (ipflag == 1)
call tdis_ot(this%iout)
359 if (this%icnvg == 0)
then
360 write (this%iout, fmtnocnvg)
kstp,
kper
373 class(
bndtype),
pointer :: packobj
376 call this%obs%obs_bd()
377 call this%obs%obs_ot()
380 do ip = 1, this%bndlist%Count()
382 call packobj%bnd_bd_obs()
383 call packobj%bnd_ot_obs()
395 integer(I4B),
intent(in) :: icbcfl
396 integer(I4B),
intent(in) :: ibudfl
397 integer(I4B),
intent(in) :: icbcun
398 integer(I4B),
intent(in) :: inmst
400 class(
bndtype),
pointer :: packobj
404 call this%tsp_ot_flowja(this%nja, this%flowja, icbcfl, icbcun)
405 if (this%infmi > 0)
call this%fmi%fmi_ot_flow(icbcfl, icbcun)
406 if (this%inssm > 0)
then
407 call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
410 do ip = 1, this%bndlist%Count()
412 call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
416 do ip = 1, this%bndlist%Count()
418 call packobj%bnd_ot_package_flows(icbcfl=icbcfl, ibudfl=0)
420 if (this%inmvt > 0)
then
421 call this%mvt%mvt_ot_saveflow(icbcfl, ibudfl)
428 if (this%inssm > 0)
then
429 call this%ssm%ssm_ot_flow(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
431 do ip = 1, this%bndlist%Count()
433 call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
437 do ip = 1, this%bndlist%Count()
439 call packobj%bnd_ot_package_flows(icbcfl=0, ibudfl=ibudfl)
442 if (this%inmvt > 0)
then
443 call this%mvt%mvt_ot_printflow(icbcfl, ibudfl)
455 integer(I4B),
intent(in) :: nja
456 real(DP),
dimension(nja),
intent(in) :: flowja
457 integer(I4B),
intent(in) :: icbcfl
458 integer(I4B),
intent(in) :: icbcun
460 integer(I4B) :: ibinun
464 if (this%ipakcb < 0)
then
466 elseif (this%ipakcb == 0)
then
471 if (icbcfl == 0) ibinun = 0
474 if (ibinun /= 0)
then
475 call this%dis%record_connection_array(flowja, ibinun, this%iout)
488 integer(I4B),
intent(in) :: idvsave
489 integer(I4B),
intent(in) :: idvprint
490 integer(I4B),
intent(inout) :: ipflag
491 class(
bndtype),
pointer :: packobj
495 do ip = 1, this%bndlist%Count()
497 call packobj%bnd_ot_dv(idvsave, idvprint)
501 call this%oc%oc_ot(ipflag)
514 integer(I4B),
intent(in) :: ibudfl
515 integer(I4B),
intent(inout) :: ipflag
516 class(
bndtype),
pointer :: packobj
520 do ip = 1, this%bndlist%Count()
522 call packobj%bnd_ot_bdsummary(
kstp,
kper, this%iout, ibudfl)
526 if (this%inmvt > 0)
then
527 call this%mvt%mvt_ot_bdsummary(ibudfl)
531 call this%budget%finalize_step(
delt)
532 if (ibudfl /= 0)
then
534 call this%budget%budget_ot(
kstp,
kper, this%iout)
538 call this%budget%writecsv(
totim)
553 character(len=*),
intent(in) :: modelname
556 call this%NumericalModelType%allocate_scalars(modelname)
566 call mem_allocate(this%eqnsclfac,
'EQNSCLFAC', this%memoryPath)
575 this%eqnsclfac =
dzero
589 character(len=*),
intent(in),
pointer :: tsptype
590 character(len=*),
intent(in) :: depvartype
591 character(len=*),
intent(in) :: depvarunit
592 character(len=*),
intent(in) :: depvarunitabbrev
595 this%tsptype = tsptype
598 this%depvartype = depvartype
601 this%depvarunit = depvarunit
604 this%depvarunitabbrev = depvarunitabbrev
645 integer(I4B),
intent(in) :: indis
646 integer(I4B),
intent(in) :: inmst
648 character(len=LINELENGTH) :: errmsg
651 if (this%inic == 0)
then
652 write (errmsg,
'(a)') &
653 'Initial conditions (IC6) package not specified.'
657 write (errmsg,
'(a)') &
658 'Discretization (DIS6 or DISU6) package not specified.'
662 write (errmsg,
'(a)')
'Mass storage and transfer (MST6) &
663 &package not specified.'
668 write (errmsg,
'(a)')
'Required package(s) not specified.'
686 write (this%iout,
'(1x,a)')
'NAMEFILE OPTIONS:'
688 if (found%newton)
then
689 write (this%iout,
'(4x,a)') &
690 'NEWTON-RAPHSON method enabled for the model.'
691 if (found%under_relaxation)
then
692 write (this%iout,
'(4x,a,a)') &
693 'NEWTON-RAPHSON UNDER-RELAXATION based on the bottom ', &
694 'elevation of the model will be applied to the model.'
698 if (found%print_input)
then
699 write (this%iout,
'(4x,a)')
'STRESS PACKAGE INPUT WILL BE PRINTED '// &
700 'FOR ALL MODEL STRESS PACKAGES'
703 if (found%print_flows)
then
704 write (this%iout,
'(4x,a)')
'PACKAGE FLOWS WILL BE PRINTED '// &
705 'FOR ALL MODEL PACKAGES'
708 if (found%save_flows)
then
709 write (this%iout,
'(4x,a)') &
710 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL'
713 write (this%iout,
'(1x,a)')
'END NAMEFILE OPTIONS:'
740 integer(I4B),
intent(inout) :: indis
743 pointer :: pkgtypes => null()
745 pointer :: pkgnames => null()
747 pointer :: mempaths => null()
748 integer(I4B),
dimension(:),
contiguous, &
749 pointer :: inunits => null()
750 character(len=LENMEMPATH) :: model_mempath
751 character(len=LENFTYPE) :: pkgtype
752 character(len=LENPACKAGENAME) :: pkgname
753 character(len=LENMEMPATH) :: mempath
754 integer(I4B),
pointer :: inunit
756 character(len=LENMEMPATH) :: mempathic =
''
765 call mem_setptr(pkgtypes,
'PKGTYPES', model_mempath)
766 call mem_setptr(pkgnames,
'PKGNAMES', model_mempath)
767 call mem_setptr(mempaths,
'MEMPATHS', model_mempath)
768 call mem_setptr(inunits,
'INUNITS', model_mempath)
770 do n = 1,
size(pkgtypes)
773 pkgtype = pkgtypes(n)
774 pkgname = pkgnames(n)
775 mempath = mempaths(n)
779 select case (pkgtype)
782 call dis_cr(this%dis, this%name, mempath, indis, this%iout)
785 call disv_cr(this%dis, this%name, mempath, indis, this%iout)
788 call disu_cr(this%dis, this%name, mempath, indis, this%iout)
794 case (
'MVT6',
'MVE6')
810 call ic_cr(this%ic, this%name, mempathic, this%inic, this%iout, this%dis, &
812 call fmi_cr(this%fmi, this%name, this%infmi, this%iout, this%eqnsclfac, &
814 call adv_cr(this%adv, this%name, this%inadv, this%iout, this%fmi, &
816 call ssm_cr(this%ssm, this%name, this%inssm, this%iout, this%fmi, &
817 this%eqnsclfac, this%depvartype)
818 call mvt_cr(this%mvt, this%name, this%inmvt, this%iout, this%fmi, &
819 this%eqnsclfac, this%depvartype)
820 call oc_cr(this%oc, this%name, this%inoc, this%iout)
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_ot(this, inmst)
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.
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_rp(this)
Generalized transport model read and prepare.
subroutine tsp_ot_dv(this, idvsave, idvprint, ipflag)
Generalized tranpsort 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 tranpsort model output budget summary.
subroutine tsp_ot_obs(this)
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_ot_flow(this, icbcfl, ibudfl, icbcun, inmst)
Generalized transport model output routine.
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 tranpsort model routine.
subroutine, public adv_cr(advobj, name_model, inunit, iout, fmi, eqnsclfac)
@ brief Create a new ADV object
subroutine, public fmi_cr(fmiobj, name_model, 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)
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, 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.