28 character(len=LENVARNAME),
parameter ::
dvt =
'TEMPERATURE '
29 character(len=LENVARNAME),
parameter ::
dvu =
'ENERGY '
30 character(len=LENVARNAME),
parameter ::
dvua =
'E '
37 integer(I4B),
pointer :: inest => null()
38 integer(I4B),
pointer :: incnd => null()
70 character(len=LENPACKAGETYPE),
dimension(GWE_NBASEPKG) ::
gwe_basepkg
71 data gwe_basepkg/
'DIS6 ',
'DISV6',
'DISU6',
' ',
' ', &
72 &
'IC6 ',
'FMI6 ',
'EST6 ',
'ADV6 ',
' ', &
73 &
'CND6 ',
'SSM6 ',
'MVE6 ',
'OC6 ',
' ', &
74 &
'OBS6 ',
' ',
' ',
' ',
' ', &
83 character(len=LENPACKAGETYPE),
dimension(GWE_NMULTIPKG) ::
gwe_multipkg
84 data gwe_multipkg/
'CTP6 ',
'ESL6 ',
'LKE6 ',
'SFE6 ',
' ', &
85 &
'MWE6 ',
'UZE6 ',
'API6 ',
' ',
' ', &
95 subroutine gwe_cr(filename, id, modelname)
106 character(len=*),
intent(in) :: filename
107 integer(I4B),
intent(in) :: id
108 character(len=*),
intent(in) :: modelname
110 integer(I4B) :: indis
121 call this%allocate_scalars(modelname)
124 call this%set_tsp_labels(this%macronym,
dvt,
dvu,
dvua)
133 call this%tsp_cr(filename, id, modelname,
'GWE', indis)
136 call this%create_packages(indis)
156 class(
bndtype),
pointer :: packobj
159 call this%dis%dis_df()
160 call this%fmi%fmi_df(this%dis, 0)
161 if (this%inmvt > 0)
call this%mvt%mvt_df(this%dis)
162 if (this%inadv > 0)
call this%adv%adv_df()
163 if (this%incnd > 0)
call this%cnd%cnd_df(this%dis)
164 if (this%inssm > 0)
call this%ssm%ssm_df()
166 call this%budget%budget_df(
niunit_gwe, this%depvarunit, &
167 this%depvarunitabbrev)
170 if (this%inssm == 0)
then
171 if (this%fmi%nflowpack > 0)
then
172 call store_error(
'Flow model has boundary packages, but there &
173 &is no SSM package. The SSM package must be activated.', &
179 this%neq = this%dis%nodes
180 this%nja = this%dis%nja
181 this%ia => this%dis%con%ia
182 this%ja => this%dis%con%ja
185 call this%gwecommon%gweshared_dat_df(this%neq)
188 call this%allocate_arrays()
191 do ip = 1, this%bndlist%Count()
193 call packobj%bnd_df(this%neq, this%dis)
194 packobj%TsManager%iout = this%iout
195 packobj%TasManager%iout = this%iout
199 call this%obs%obs_df(this%iout, this%name,
'GWE', this%dis)
214 class(
bndtype),
pointer :: packobj
218 call this%dis%dis_ac(this%moffset, sparse)
219 if (this%incnd > 0) &
220 call this%cnd%cnd_ac(this%moffset, sparse)
223 do ip = 1, this%bndlist%Count()
225 call packobj%bnd_ac(this%moffset, sparse)
240 class(
bndtype),
pointer :: packobj
245 call this%dis%dis_mc(this%moffset, this%idxglo, matrix_sln)
247 if (this%incnd > 0)
call this%cnd%cnd_mc(this%moffset, matrix_sln)
250 do ip = 1, this%bndlist%Count()
252 call packobj%bnd_mc(this%moffset, matrix_sln)
272 class(
bndtype),
pointer :: packobj
275 call this%fmi%fmi_ar(this%ibound)
276 if (this%inmvt > 0)
call this%mvt%mvt_ar()
277 if (this%inic > 0)
call this%ic%ic_ar(this%x)
278 if (this%inest > 0)
call this%est%est_ar(this%dis, this%ibound)
279 if (this%inadv > 0)
call this%adv%adv_ar(this%dis, this%ibound)
280 if (this%incnd > 0)
call this%cnd%cnd_ar(this%ibound, this%est%porosity)
281 if (this%inssm > 0)
call this%ssm%ssm_ar(this%dis, this%ibound, this%x)
282 if (this%inobs > 0)
call this%obs%tsp_obs_ar(this%ic, this%x, this%flowja)
285 this%eqnsclfac = this%gwecommon%gwerhow * this%gwecommon%gwecpw
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%incnd > 0)
call this%cnd%cnd_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()
424 subroutine gwe_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%inest > 0)
then
441 call this%est%est_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%incnd > 0)
then
449 call this%cnd%cnd_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)
471 subroutine gwe_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
474 integer(I4B),
intent(in) :: innertot
475 integer(I4B),
intent(in) :: kiter
476 integer(I4B),
intent(in) :: iend
477 integer(I4B),
intent(in) :: icnvgmod
478 character(len=LENPAKLOC),
intent(inout) :: cpak
479 integer(I4B),
intent(inout) :: ipak
480 real(DP),
intent(inout) :: dpak
483 if (this%inmvt > 0)
call this%mvt%mvt_cc(kiter, iend, icnvgmod, cpak, dpak)
493 subroutine gwe_cq(this, icnvg, isuppress_output)
498 integer(I4B),
intent(in) :: icnvg
499 integer(I4B),
intent(in) :: isuppress_output
503 class(
bndtype),
pointer :: packobj
511 this%flowja(i) =
dzero
513 if (this%inadv > 0)
call this%adv%adv_cq(this%x, this%flowja)
514 if (this%incnd > 0)
call this%cnd%cnd_cq(this%x, this%flowja)
515 if (this%inest > 0)
call this%est%est_cq(this%dis%nodes, this%x, this%xold, &
517 if (this%inssm > 0)
call this%ssm%ssm_cq(this%flowja)
518 if (this%infmi > 0)
call this%fmi%fmi_cq(this%x, this%flowja)
523 do ip = 1, this%bndlist%Count()
525 call packobj%bnd_cf()
526 call packobj%bnd_cq(this%x, this%flowja)
544 subroutine gwe_bd(this, icnvg, isuppress_output)
548 integer(I4B),
intent(in) :: icnvg
549 integer(I4B),
intent(in) :: isuppress_output
552 class(
bndtype),
pointer :: packobj
561 call this%budget%reset()
562 if (this%inest > 0)
call this%est%est_bd(isuppress_output, this%budget)
563 if (this%inssm > 0)
call this%ssm%ssm_bd(isuppress_output, this%budget)
564 if (this%infmi > 0)
call this%fmi%fmi_bd(isuppress_output, this%budget)
565 if (this%inmvt > 0)
call this%mvt%mvt_bd(this%x, this%x)
566 do ip = 1, this%bndlist%Count()
568 call packobj%bnd_bd(this%budget)
583 integer(I4B) :: icbcfl
584 integer(I4B) :: icbcun
591 if (this%oc%oc_save(
'BUDGET')) icbcfl = 1
592 icbcun = this%oc%oc_save_unit(
'BUDGET')
593 if (this%inest > 0)
call this%est%est_ot_flow(icbcfl, icbcun)
596 call this%tsp_ot(this%inest)
615 class(
bndtype),
pointer :: packobj
622 call this%dis%dis_da()
624 call this%fmi%fmi_da()
625 call this%adv%adv_da()
626 call this%cnd%cnd_da()
627 call this%ssm%ssm_da()
628 call this%est%est_da()
629 call this%mvt%mvt_da()
630 call this%budget%budget_da()
632 call this%obs%obs_da()
633 call this%gwecommon%gweshared_dat_da()
636 deallocate (this%dis)
638 deallocate (this%fmi)
639 deallocate (this%adv)
640 deallocate (this%cnd)
641 deallocate (this%ssm)
642 deallocate (this%est)
643 deallocate (this%mvt)
644 deallocate (this%budget)
646 deallocate (this%obs)
647 nullify (this%gwecommon)
650 do ip = 1, this%bndlist%Count()
652 call packobj%bnd_da()
661 call this%TransportModelType%tsp_da()
664 call this%NumericalModelType%model_da()
682 real(DP),
dimension(:, :),
intent(in) :: budterm
683 character(len=LENBUDTXT),
dimension(:),
intent(in) :: budtxt
684 character(len=*),
intent(in) :: rowlabel
686 call this%budget%addentry(budterm,
delt, budtxt, rowlabel=rowlabel)
698 integer(I4B) :: iasym
700 class(
bndtype),
pointer :: packobj
706 if (this%inadv > 0)
then
707 if (this%adv%iasym /= 0) iasym = 1
711 if (this%incnd > 0)
then
712 if (this%cnd%ixt3d /= 0) iasym = 1
716 do ip = 1, this%bndlist%Count()
718 if (packobj%iasym /= 0) iasym = 1
736 character(len=*),
intent(in) :: modelname
739 call this%allocate_tsp_scalars(modelname)
771 character(len=*),
intent(in) :: filtyp
772 character(len=LINELENGTH) :: errmsg
773 integer(I4B),
intent(in) :: ipakid
774 integer(I4B),
intent(in) :: ipaknum
775 character(len=*),
intent(in) :: pakname
776 character(len=*),
intent(in) :: mempath
777 integer(I4B),
intent(in) :: inunit
778 integer(I4B),
intent(in) :: iout
780 class(
bndtype),
pointer :: packobj
781 class(
bndtype),
pointer :: packobj2
787 call ctp_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
788 pakname, this%depvartype, mempath)
790 call esl_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
791 pakname, this%gwecommon)
793 call lke_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
794 pakname, this%fmi, this%eqnsclfac, this%gwecommon, &
795 this%depvartype, this%depvarunit, this%depvarunitabbrev)
797 call sfe_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
798 pakname, this%fmi, this%eqnsclfac, this%gwecommon, &
799 this%depvartype, this%depvarunit, this%depvarunitabbrev)
801 call mwe_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
802 pakname, this%fmi, this%eqnsclfac, this%gwecommon, &
803 this%depvartype, this%depvarunit, this%depvarunitabbrev)
805 call uze_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
806 pakname, this%fmi, this%eqnsclfac, this%gwecommon, &
807 this%depvartype, this%depvarunit, this%depvarunitabbrev)
812 write (errmsg, *)
'Invalid package type: ', filtyp
819 do ip = 1, this%bndlist%Count()
821 if (packobj2%packName == pakname)
then
822 write (errmsg,
'(a,a)')
'Cannot create package. Package name '// &
823 'already exists: ', trim(pakname)
837 class(*),
pointer :: model
842 if (.not.
associated(model))
return
861 integer(I4B),
dimension(:),
allocatable,
intent(inout) :: bndpkgs
863 pointer,
intent(inout) :: pkgtypes
865 pointer,
intent(inout) :: pkgnames
867 pointer,
intent(inout) :: mempaths
868 integer(I4B),
dimension(:),
contiguous, &
869 pointer,
intent(inout) :: inunits
871 integer(I4B) :: ipakid, ipaknum
872 character(len=LENFTYPE) :: pkgtype, bndptype
873 character(len=LENPACKAGENAME) :: pkgname
874 character(len=LENMEMPATH) :: mempath
875 integer(I4B),
pointer :: inunit
878 if (
allocated(bndpkgs))
then
883 do n = 1,
size(bndpkgs)
885 pkgtype = pkgtypes(bndpkgs(n))
886 pkgname = pkgnames(bndpkgs(n))
887 mempath = mempaths(bndpkgs(n))
888 inunit => inunits(bndpkgs(n))
890 if (bndptype /= pkgtype)
then
895 call this%package_create(pkgtype, ipakid, ipaknum, pkgname, mempath, &
898 ipaknum = ipaknum + 1
923 integer(I4B),
intent(in) :: indis
926 pointer :: pkgtypes => null()
928 pointer :: pkgnames => null()
930 pointer :: mempaths => null()
931 integer(I4B),
dimension(:),
contiguous, &
932 pointer :: inunits => null()
933 character(len=LENMEMPATH) :: model_mempath
934 character(len=LENFTYPE) :: pkgtype
935 character(len=LENPACKAGENAME) :: pkgname
936 character(len=LENMEMPATH) :: mempath
937 integer(I4B),
pointer :: inunit
938 integer(I4B),
dimension(:),
allocatable :: bndpkgs
940 character(len=LENMEMPATH) :: mempathcnd =
''
946 call mem_setptr(pkgtypes,
'PKGTYPES', model_mempath)
947 call mem_setptr(pkgnames,
'PKGNAMES', model_mempath)
948 call mem_setptr(mempaths,
'MEMPATHS', model_mempath)
949 call mem_setptr(inunits,
'INUNITS', model_mempath)
951 do n = 1,
size(pkgtypes)
954 pkgtype = pkgtypes(n)
955 pkgname = pkgnames(n)
956 mempath = mempaths(n)
960 select case (pkgtype)
966 case (
'CTP6',
'ESL6',
'LKE6',
'SFE6', &
967 'MWE6',
'UZE6',
'API6')
969 bndpkgs(
size(bndpkgs)) = n
976 call est_cr(this%est, this%name, this%inest, this%iout, this%fmi, &
977 this%eqnsclfac, this%gwecommon)
978 call cnd_cr(this%cnd, this%name, mempathcnd, this%incnd, this%iout, &
979 this%fmi, this%eqnsclfac, this%gwecommon)
982 call this%ftype_check(indis, this%inest)
984 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
subroutine, public cnd_cr(cndobj, name_model, input_mempath, inunit, iout, fmi, eqnsclfac, gwecommon)
Create a new CND object.
subroutine, public ctp_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, depvartype, mempath)
Create a new constant temperature package.
subroutine, public esl_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, gwecommon)
Create an energy source loading package.
– @ brief Energy Storage and Transfer (EST) Module
subroutine, public est_cr(estobj, name_model, inunit, iout, fmi, eqnsclfac, gwecommon)
@ brief Create a new EST package object
subroutine, public lke_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
Create a new lke package.
subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
Source package info and begin to process.
character(len=lenpackagetype), dimension(gwe_nmultipkg), public gwe_multipkg
subroutine gwe_cf(this, kiter)
GWE Model calculate coefficients.
subroutine gwe_bd(this, icnvg, isuppress_output)
GWE Model Budget.
subroutine gwe_bdentry(this, budterm, budtxt, rowlabel)
GroundWater Energy Transport Model Budget Entry.
integer(i4b), parameter, public gwe_nbasepkg
GWE base package array descriptors.
subroutine gwe_ad(this)
GWE Model Time Step Advance.
subroutine gwe_cq(this, icnvg, isuppress_output)
GWE Model calculate flow.
subroutine gwe_mc(this, matrix_sln)
Map the positions of the GWE model connections in the numerical solution coefficient matrix.
subroutine gwe_da(this)
Deallocate.
character(len=lenvarname), parameter dvt
dependent variable type, varies based on model type
subroutine gwe_df(this)
Define packages of the GWE model.
subroutine gwe_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
GWE Model Final Convergence Check.
subroutine allocate_scalars(this, modelname)
Allocate memory for non-allocatable members.
subroutine gwe_ot(this)
GWE Model Output.
subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, inunit, iout)
Create boundary condition packages for this model.
subroutine gwe_ac(this, sparse)
Add the internal connections of this model to the sparse matrix.
subroutine gwe_rp(this)
GWE Model Read and Prepare.
integer(i4b), parameter niunit_gwe
subroutine, public gwe_cr(filename, id, modelname)
Create a new groundwater energy transport model object.
subroutine gwe_fc(this, kiter, matrix_sln, inwtflag)
GWE Model fill coefficients.
integer(i4b) function gwe_get_iasym(this)
return 1 if any package causes the matrix to be asymmetric. Otherwise return 0.
character(len=lenvarname), parameter dvu
dependent variable unit of measure, either "mass" or "energy"
subroutine gwe_ar(this)
GWE Model Allocate and Read.
character(len=lenpackagetype), dimension(gwe_nbasepkg), public gwe_basepkg
integer(i4b), parameter, public gwe_nmultipkg
GWE multi package array descriptors.
subroutine create_gwe_packages(this, indis)
Source package info and begin to process.
class(gwemodeltype) function, pointer, public castasgwemodel(model)
Cast to GweModelType.
character(len=lenvarname), parameter dvua
abbreviation of the dependent variable unit of measure, either "M" or "E"
subroutine, public mwe_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
Create new MWE package.
subroutine, public sfe_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
Create a new sfe package.
subroutine, public uze_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
Create a new UZE 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 Energy storage and transfer