31 character(len=LENVARNAME),
parameter ::
dvt =
'CONCENTRATION '
32 character(len=LENVARNAME),
parameter ::
dvu =
'MASS '
33 character(len=LENVARNAME),
parameter ::
dvua =
'M '
39 integer(I4B),
pointer :: inmst => null()
40 integer(I4B),
pointer :: indsp => null()
72 character(len=LENPACKAGETYPE),
dimension(GWT_NBASEPKG) ::
gwt_basepkg
73 data gwt_basepkg/
'DIS6 ',
'DISV6',
'DISU6',
' ',
' ', &
74 &
'IC6 ',
'FMI6 ',
'MST6 ',
'ADV6 ',
' ', &
75 &
'DSP6 ',
'SSM6 ',
'MVT6 ',
'OC6 ',
' ', &
76 &
'OBS6 ',
' ',
' ',
' ',
' ', &
85 character(len=LENPACKAGETYPE),
dimension(GWT_NMULTIPKG) ::
gwt_multipkg
86 data gwt_multipkg/
'CNC6 ',
'SRC6 ',
'LKT6 ',
'IST6 ',
' ', &
87 &
'SFT6 ',
'MWT6 ',
'UZT6 ',
'API6 ',
' ', &
97 subroutine gwt_cr(filename, id, modelname)
107 character(len=*),
intent(in) :: filename
108 integer(I4B),
intent(in) :: id
109 character(len=*),
intent(in) :: modelname
111 integer(I4B) :: indis
122 call this%allocate_scalars(modelname)
125 call this%set_tsp_labels(this%macronym,
dvt,
dvu,
dvua)
131 call this%tsp_cr(filename, id, modelname,
'GWT', indis)
134 call this%create_packages(indis)
153 class(
bndtype),
pointer :: packobj
156 call this%dis%dis_df()
157 call this%fmi%fmi_df(this%dis, 1)
158 if (this%inmvt > 0)
call this%mvt%mvt_df(this%dis)
159 if (this%inadv > 0)
call this%adv%adv_df()
160 if (this%indsp > 0)
call this%dsp%dsp_df(this%dis)
161 if (this%inssm > 0)
call this%ssm%ssm_df()
163 call this%budget%budget_df(
niunit_gwt, this%depvarunit, &
164 this%depvarunitabbrev)
167 if (this%inssm == 0)
then
168 if (this%fmi%nflowpack > 0)
then
169 call store_error(
'Flow model has boundary packages, but there &
170 &is no SSM package. The SSM package must be activated.', &
176 this%neq = this%dis%nodes
177 this%nja = this%dis%nja
178 this%ia => this%dis%con%ia
179 this%ja => this%dis%con%ja
182 call this%allocate_arrays()
185 do ip = 1, this%bndlist%Count()
187 call packobj%bnd_df(this%neq, this%dis)
188 packobj%TsManager%iout = this%iout
189 packobj%TasManager%iout = this%iout
193 call this%obs%obs_df(this%iout, this%name,
'GWT', this%dis)
208 class(
bndtype),
pointer :: packobj
212 call this%dis%dis_ac(this%moffset, sparse)
213 if (this%indsp > 0) &
214 call this%dsp%dsp_ac(this%moffset, sparse)
217 do ip = 1, this%bndlist%Count()
219 call packobj%bnd_ac(this%moffset, sparse)
234 class(
bndtype),
pointer :: packobj
239 call this%dis%dis_mc(this%moffset, this%idxglo, matrix_sln)
241 if (this%indsp > 0)
call this%dsp%dsp_mc(this%moffset, matrix_sln)
244 do ip = 1, this%bndlist%Count()
246 call packobj%bnd_mc(this%moffset, matrix_sln)
266 class(
bndtype),
pointer :: packobj
269 call this%fmi%fmi_ar(this%ibound)
270 if (this%inmvt > 0)
call this%mvt%mvt_ar()
271 if (this%inic > 0)
call this%ic%ic_ar(this%x)
272 if (this%inmst > 0)
call this%mst%mst_ar(this%dis, this%ibound)
273 if (this%inadv > 0)
call this%adv%adv_ar(this%dis, this%ibound)
274 if (this%indsp > 0)
call this%dsp%dsp_ar(this%ibound, this%mst%thetam)
275 if (this%inssm > 0)
call this%ssm%ssm_ar(this%dis, this%ibound, this%x)
276 if (this%inobs > 0)
call this%obs%tsp_obs_ar(this%ic, this%x, this%flowja)
285 this%eqnsclfac = done
291 call this%oc%oc_ar(this%x, this%dis,
dhnoflo, this%depvartype)
292 call this%budget%set_ibudcsv(this%oc%ibudcsv)
295 do ip = 1, this%bndlist%Count()
297 call packobj%set_pointers(this%dis%nodes, this%ibound, this%x, &
298 this%xold, this%flowja)
300 call packobj%bnd_ar()
317 class(
bndtype),
pointer :: packobj
321 call this%fmi%fmi_rp(this%inmvt)
322 if (this%inmvt > 0)
call this%mvt%mvt_rp()
328 if (this%inoc > 0)
call this%oc%oc_rp()
329 if (this%inssm > 0)
call this%ssm%ssm_rp()
330 do ip = 1, this%bndlist%Count()
332 call packobj%bnd_rp()
333 call packobj%bnd_rp_obs()
349 class(
bndtype),
pointer :: packobj
351 integer(I4B) :: irestore
352 integer(I4B) :: ip, n
357 if (irestore == 0)
then
360 do n = 1, this%dis%nodes
361 if (this%ibound(n) == 0)
then
364 this%xold(n) = this%x(n)
370 do n = 1, this%dis%nodes
371 this%x(n) = this%xold(n)
376 call this%fmi%fmi_ad(this%x)
379 if (this%indsp > 0)
call this%dsp%dsp_ad()
380 if (this%inssm > 0)
call this%ssm%ssm_ad()
381 do ip = 1, this%bndlist%Count()
383 call packobj%bnd_ad()
385 call packobj%bnd_ck()
390 call this%obs%obs_ad()
404 integer(I4B),
intent(in) :: kiter
406 class(
bndtype),
pointer :: packobj
410 do ip = 1, this%bndlist%Count()
412 call packobj%bnd_cf()
423 subroutine gwt_fc(this, kiter, matrix_sln, inwtflag)
427 integer(I4B),
intent(in) :: kiter
429 integer(I4B),
intent(in) :: inwtflag
431 class(
bndtype),
pointer :: packobj
435 call this%fmi%fmi_fc(this%dis%nodes, this%xold, this%nja, matrix_sln, &
436 this%idxglo, this%rhs)
437 if (this%inmvt > 0)
then
438 call this%mvt%mvt_fc(this%x, this%x)
440 if (this%inmst > 0)
then
441 call this%mst%mst_fc(this%dis%nodes, this%xold, this%nja, matrix_sln, &
442 this%idxglo, this%x, this%rhs, kiter)
444 if (this%inadv > 0)
then
445 call this%adv%adv_fc(this%dis%nodes, matrix_sln, this%idxglo, this%x, &
448 if (this%indsp > 0)
then
449 call this%dsp%dsp_fc(kiter, this%dis%nodes, this%nja, matrix_sln, &
450 this%idxglo, this%rhs, this%x)
452 if (this%inssm > 0)
then
453 call this%ssm%ssm_fc(matrix_sln, this%idxglo, this%rhs)
457 do ip = 1, this%bndlist%Count()
459 call packobj%bnd_fc(this%rhs, this%ia, this%idxglo, matrix_sln)
475 subroutine gwt_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
478 integer(I4B),
intent(in) :: innertot
479 integer(I4B),
intent(in) :: kiter
480 integer(I4B),
intent(in) :: iend
481 integer(I4B),
intent(in) :: icnvgmod
482 character(len=LENPAKLOC),
intent(inout) :: cpak
483 integer(I4B),
intent(inout) :: ipak
484 real(DP),
intent(inout) :: dpak
489 if (this%inmvt > 0)
call this%mvt%mvt_cc(kiter, iend, icnvgmod, cpak, dpak)
499 subroutine gwt_cq(this, icnvg, isuppress_output)
504 integer(I4B),
intent(in) :: icnvg
505 integer(I4B),
intent(in) :: isuppress_output
509 class(
bndtype),
pointer :: packobj
517 this%flowja(i) =
dzero
519 if (this%inadv > 0)
call this%adv%adv_cq(this%x, this%flowja)
520 if (this%indsp > 0)
call this%dsp%dsp_cq(this%x, this%flowja)
521 if (this%inmst > 0)
call this%mst%mst_cq(this%dis%nodes, this%x, this%xold, &
523 if (this%inssm > 0)
call this%ssm%ssm_cq(this%flowja)
524 if (this%infmi > 0)
call this%fmi%fmi_cq(this%x, this%flowja)
529 do ip = 1, this%bndlist%Count()
531 call packobj%bnd_cf()
532 call packobj%bnd_cq(this%x, this%flowja)
550 subroutine gwt_bd(this, icnvg, isuppress_output)
554 integer(I4B),
intent(in) :: icnvg
555 integer(I4B),
intent(in) :: isuppress_output
558 class(
bndtype),
pointer :: packobj
567 call this%budget%reset()
568 if (this%inmst > 0)
call this%mst%mst_bd(isuppress_output, this%budget)
569 if (this%inssm > 0)
call this%ssm%ssm_bd(isuppress_output, this%budget)
570 if (this%infmi > 0)
call this%fmi%fmi_bd(isuppress_output, this%budget)
571 if (this%inmvt > 0)
call this%mvt%mvt_bd(this%x, this%x)
572 do ip = 1, this%bndlist%Count()
574 call packobj%bnd_bd(this%budget)
589 integer(I4B) :: icbcfl
590 integer(I4B) :: icbcun
597 if (this%oc%oc_save(
'BUDGET')) icbcfl = 1
598 icbcun = this%oc%oc_save_unit(
'BUDGET')
599 if (this%inmst > 0)
call this%mst%mst_ot_flow(icbcfl, icbcun)
602 call this%tsp_ot(this%inmst)
621 class(
bndtype),
pointer :: packobj
628 call this%dis%dis_da()
630 call this%fmi%fmi_da()
631 call this%adv%adv_da()
632 call this%dsp%dsp_da()
633 call this%ssm%ssm_da()
634 call this%mst%mst_da()
635 call this%mvt%mvt_da()
636 call this%budget%budget_da()
638 call this%obs%obs_da()
641 deallocate (this%dis)
643 deallocate (this%dsp)
644 deallocate (this%ssm)
645 deallocate (this%mst)
646 deallocate (this%adv)
647 deallocate (this%mvt)
648 deallocate (this%budget)
650 deallocate (this%obs)
653 do ip = 1, this%bndlist%Count()
655 call packobj%bnd_da()
664 call this%TransportModelType%tsp_da()
667 call this%NumericalModelType%model_da()
685 real(DP),
dimension(:, :),
intent(in) :: budterm
686 character(len=LENBUDTXT),
dimension(:),
intent(in) :: budtxt
687 character(len=*),
intent(in) :: rowlabel
689 call this%budget%addentry(budterm,
delt, budtxt, rowlabel=rowlabel)
701 integer(I4B) :: iasym
703 class(
bndtype),
pointer :: packobj
709 if (this%inadv > 0)
then
710 if (this%adv%iasym /= 0) iasym = 1
714 if (this%indsp > 0)
then
715 if (this%dsp%ixt3d /= 0) iasym = 1
719 do ip = 1, this%bndlist%Count()
721 if (packobj%iasym /= 0) iasym = 1
739 character(len=*),
intent(in) :: modelname
742 call this%allocate_tsp_scalars(modelname)
774 character(len=*),
intent(in) :: filtyp
775 character(len=LINELENGTH) :: errmsg
776 integer(I4B),
intent(in) :: ipakid
777 integer(I4B),
intent(in) :: ipaknum
778 character(len=*),
intent(in) :: pakname
779 character(len=*),
intent(in) :: mempath
780 integer(I4B),
intent(in) :: inunit
781 integer(I4B),
intent(in) :: iout
783 class(
bndtype),
pointer :: packobj
784 class(
bndtype),
pointer :: packobj2
790 call cnc_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
791 pakname,
dvt, mempath)
793 call src_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
794 this%depvartype, pakname)
796 call lkt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
797 pakname, this%fmi, this%eqnsclfac, this%depvartype, &
798 this%depvarunit, this%depvarunitabbrev)
800 call sft_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
801 pakname, this%fmi, this%eqnsclfac, this%depvartype, &
802 this%depvarunit, this%depvarunitabbrev)
804 call mwt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
805 pakname, this%fmi, this%eqnsclfac, this%depvartype, &
806 this%depvarunit, this%depvarunitabbrev)
808 call uzt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
809 pakname, this%fmi, this%eqnsclfac, this%depvartype, &
810 this%depvarunit, this%depvarunitabbrev)
812 call ist_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
813 pakname, this%fmi, this%mst)
815 call api_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
817 write (errmsg, *)
'Invalid package type: ', filtyp
824 do ip = 1, this%bndlist%Count()
826 if (packobj2%packName == pakname)
then
827 write (errmsg,
'(a,a)')
'Cannot create package. Package name '// &
828 'already exists: ', trim(pakname)
841 class(*),
pointer :: model
845 if (.not.
associated(model))
return
864 integer(I4B),
dimension(:),
allocatable,
intent(inout) :: bndpkgs
866 pointer,
intent(inout) :: pkgtypes
868 pointer,
intent(inout) :: pkgnames
870 pointer,
intent(inout) :: mempaths
871 integer(I4B),
dimension(:),
contiguous, &
872 pointer,
intent(inout) :: inunits
874 integer(I4B) :: ipakid, ipaknum
875 character(len=LENFTYPE) :: pkgtype, bndptype
876 character(len=LENPACKAGENAME) :: pkgname
877 character(len=LENMEMPATH) :: mempath
878 integer(I4B),
pointer :: inunit
881 if (
allocated(bndpkgs))
then
886 do n = 1,
size(bndpkgs)
888 pkgtype = pkgtypes(bndpkgs(n))
889 pkgname = pkgnames(bndpkgs(n))
890 mempath = mempaths(bndpkgs(n))
891 inunit => inunits(bndpkgs(n))
893 if (bndptype /= pkgtype)
then
898 call this%package_create(pkgtype, ipakid, ipaknum, pkgname, mempath, &
901 ipaknum = ipaknum + 1
926 integer(I4B),
intent(in) :: indis
929 pointer :: pkgtypes => null()
931 pointer :: pkgnames => null()
933 pointer :: mempaths => null()
934 integer(I4B),
dimension(:),
contiguous, &
935 pointer :: inunits => null()
936 character(len=LENMEMPATH) :: model_mempath
937 character(len=LENFTYPE) :: pkgtype
938 character(len=LENPACKAGENAME) :: pkgname
939 character(len=LENMEMPATH) :: mempath
940 integer(I4B),
pointer :: inunit
941 integer(I4B),
dimension(:),
allocatable :: bndpkgs
943 character(len=LENMEMPATH) :: mempathdsp =
''
949 call mem_setptr(pkgtypes,
'PKGTYPES', model_mempath)
950 call mem_setptr(pkgnames,
'PKGNAMES', model_mempath)
951 call mem_setptr(mempaths,
'MEMPATHS', model_mempath)
952 call mem_setptr(inunits,
'INUNITS', model_mempath)
954 do n = 1,
size(pkgtypes)
957 pkgtype = pkgtypes(n)
958 pkgname = pkgnames(n)
959 mempath = mempaths(n)
963 select case (pkgtype)
969 case (
'CNC6',
'SRC6',
'LKT6',
'SFT6', &
970 'MWT6',
'UZT6',
'IST6',
'API6')
972 bndpkgs(
size(bndpkgs)) = n
979 call mst_cr(this%mst, this%name, this%inmst, this%iout, this%fmi)
980 call dsp_cr(this%dsp, this%name, mempathdsp, this%indsp, this%iout, &
984 call this%ftype_check(indis, this%inmst)
986 call this%create_bndpkgs(bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
This module contains the API package methods.
subroutine, public api_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
@ brief Create a new package object
subroutine, public addbasemodeltolist(list, model)
This module contains the base boundary package.
subroutine, public addbndtolist(list, bnd)
Add boundary to package list.
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 lenpackagetype
maximum length of a package type (DIS6, SFR6, CSUB6, etc.)
real(dp), parameter dhnoflo
real no flow constant
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 lenbudtxt
maximum length of a budget component names
integer(i4b), parameter lenmempath
maximum length of the memory path
real(dp), parameter done
real constant 1
subroutine, public cnc_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, depvartype, mempath)
Create a new constant concentration or temperature package.
subroutine, public dsp_cr(dspobj, name_model, input_mempath, inunit, iout, fmi)
Create a DSP object.
– @ brief Immobile Storage and Transfer (IST) Module
subroutine, public ist_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, mst)
@ brief Create a new package object
subroutine, public lkt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, dvt, dvu, dvua)
Create a new lkt package.
subroutine gwt_ar(this)
GWT Model Allocate and Read.
subroutine gwt_fc(this, kiter, matrix_sln, inwtflag)
GWT Model fill coefficients.
subroutine gwt_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
GWT Model Final Convergence Check.
character(len=lenvarname), parameter dvu
dependent variable unit of measure, either "mass" or "energy"
integer(i4b), parameter niunit_gwt
subroutine create_gwt_packages(this, indis)
Source package info and begin to process.
subroutine gwt_mc(this, matrix_sln)
Map the positions of the GWT model connections in the numerical solution coefficient matrix.
character(len=lenvarname), parameter dvua
abbreviation of the dependent variable unit of measure, either "M" or "E"
subroutine gwt_cq(this, icnvg, isuppress_output)
GWT Model calculate flow.
subroutine gwt_bd(this, icnvg, isuppress_output)
GWT Model Budget.
subroutine allocate_scalars(this, modelname)
Allocate memory for non-allocatable members.
subroutine gwt_ot(this)
Print and/or save model output.
subroutine gwt_da(this)
Deallocate.
class(gwtmodeltype) function, pointer, public castasgwtmodel(model)
Cast to GwtModelType.
integer(i4b), parameter, public gwt_nbasepkg
GWT base package array descriptors.
subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
Source package info and begin to process.
character(len=lenpackagetype), dimension(gwt_nmultipkg), public gwt_multipkg
subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, inunit, iout)
Create boundary condition packages for this model.
subroutine gwt_ac(this, sparse)
Add the internal connections of this model to the sparse matrix.
integer(i4b) function gwt_get_iasym(this)
return 1 if any package causes the matrix to be asymmetric. Otherwise return 0.
subroutine gwt_df(this)
Define packages of the GWT model.
subroutine gwt_ad(this)
GWT Model Time Step Advance.
subroutine gwt_cf(this, kiter)
GWT Model calculate coefficients.
subroutine gwt_rp(this)
GWT Model Read and Prepare.
subroutine, public gwt_cr(filename, id, modelname)
Create a new groundwater transport model object.
character(len=lenpackagetype), dimension(gwt_nbasepkg), public gwt_basepkg
character(len=lenvarname), parameter dvt
dependent variable type, varies based on model type
subroutine gwt_bdentry(this, budterm, budtxt, rowlabel)
GroundWater Transport Model Budget Entry.
integer(i4b), parameter, public gwt_nmultipkg
GWT multi package array descriptors.
– @ brief Mobile Storage and Transfer (MST) Module
subroutine, public mst_cr(mstobj, name_model, inunit, iout, fmi)
@ brief Create a new package object
subroutine, public mwt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, dvt, dvu, dvua)
Create new MWT package.
subroutine, public sft_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, dvt, dvu, dvua)
Create a new sft package.
subroutine, public src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, depvartype)
Create a source loading package.
subroutine, public uzt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, dvt, dvu, dvua)
Create a new UZT package.
This module defines variable data types.
type(listtype), public basemodellist
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
subroutine, public memorylist_remove(component, subcomponent, context)
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
This module contains simulation variables.
character(len=linelength) idm_context
integer(i4b) isimcheck
simulation input check flag (1) to check input, (0) to ignore checks
integer(i4b) ifailedstepretry
current retry for this time step
subroutine csr_diagsum(ia, flowja)
logical(lgp), pointer, public readnewdata
flag indicating time to read new data
real(dp), pointer, public delt
length of the current time step
This module contains the base transport model type.
Highest level model type. All models extend this parent type.
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 ...
@ brief Mobile storage and transfer