39 character(len=LENBUDTXT),
dimension(NBDITEMS) ::
budtxt
51 integer(I4B),
pointer :: infmi => null()
52 integer(I4B),
pointer :: inmip => null()
53 integer(I4B),
pointer :: inmvt => null()
54 integer(I4B),
pointer :: inmst => null()
55 integer(I4B),
pointer :: inadv => null()
56 integer(I4B),
pointer :: indsp => null()
57 integer(I4B),
pointer :: inssm => null()
58 integer(I4B),
pointer :: inoc => null()
59 integer(I4B),
pointer :: nprp => null()
60 real(dp),
dimension(:),
pointer,
contiguous :: masssto => null()
61 real(dp),
dimension(:),
pointer,
contiguous :: massstoold => null()
62 real(dp),
dimension(:),
pointer,
contiguous :: ratesto => null()
98 character(len=LENPACKAGETYPE),
dimension(PRT_NBASEPKG) ::
prt_basepkg
99 data prt_basepkg/
'DIS6 ',
'DISV6',
'DISU6',
'IC6 ',
'MST6 ', &
100 &
'ADV6 ',
'DSP6 ',
'SSM6 ',
'MIP6 ',
'CNC6 ', &
101 &
'OC6 ',
' ',
'FMI6 ',
' ',
'IST6 ', &
102 &
'LKT6 ',
'SFT6 ',
'MWT6 ',
'UZT6 ',
'MVT6 ', &
103 &
'API6 ',
' ',
' ',
' ',
' ', &
112 character(len=LENPACKAGETYPE),
dimension(PRT_NMULTIPKG) ::
prt_multipkg
122 subroutine prt_cr(filename, id, modelname)
133 character(len=*),
intent(in) :: filename
134 integer(I4B),
intent(in) :: id
135 character(len=*),
intent(in) :: modelname
139 character(len=LENMEMPATH) :: input_mempath
140 character(len=LINELENGTH) :: lst_fname
150 allocate (this%events)
151 allocate (this%tracks)
154 call this%allocate_scalars(modelname)
159 this%filename = filename
160 this%name = modelname
161 this%macronym =
'PRT'
168 call mem_set_value(this%iprpak,
'PRINT_INPUT', input_mempath, &
170 call mem_set_value(this%iprflow,
'PRINT_FLOWS', input_mempath, &
172 call mem_set_value(this%ipakcb,
'SAVE_FLOWS', input_mempath, &
176 call this%create_lstfile(lst_fname, filename, found%list, &
177 'PARTICLE TRACKING MODEL (PRT)')
180 if (found%save_flows)
then
185 call this%create_packages()
188 if (this%iout > 0)
then
189 call this%log_namfile_options(found)
206 class(
bndtype),
pointer :: packobj
209 call this%dis%dis_df()
210 call this%fmi%fmi_df(this%dis, 1)
212 call this%budget%budget_df(
niunit_prt,
'MASS',
'M')
215 do ip = 1, this%bndlist%Count()
217 call packobj%bnd_df(this%dis%nodes, this%dis)
218 packobj%TsManager%iout = this%iout
219 packobj%TasManager%iout = this%iout
223 call this%allocate_arrays()
241 integer(I4B) :: ip, nprp
242 class(
bndtype),
pointer :: packobj
245 call this%fmi%fmi_ar(this%ibound)
246 if (this%inmip > 0)
call this%mip%mip_ar()
249 call this%oc%oc_ar(this%dis,
dhnoflo)
250 call this%budget%set_ibudcsv(this%oc%ibudcsv)
253 call this%tracks%select_events( &
254 this%oc%trackrelease, &
255 this%oc%trackfeatexit, &
256 this%oc%tracktimestep, &
257 this%oc%trackterminate, &
258 this%oc%trackweaksink, &
259 this%oc%trackusertime, &
260 this%oc%tracksubfexit)
264 do ip = 1, this%bndlist%Count()
266 select type (packobj)
269 call packobj%prp_set_pointers(this%ibound, this%mip%izone)
270 call packobj%bnd_ar()
271 call packobj%bnd_ar()
272 if (packobj%itrkout > 0)
then
273 call this%tracks%init_file( &
277 if (packobj%itrkcsv > 0)
then
278 call this%tracks%init_file( &
284 call packobj%bnd_ar()
289 if (this%oc%itrkout > 0) &
290 call this%tracks%init_file(this%oc%itrkout)
291 if (this%oc%itrkcsv > 0) &
292 call this%tracks%init_file(this%oc%itrkcsv, csv=.true.)
295 select type (dis => this%dis)
299 events=this%events, &
300 izone=this%mip%izone, &
301 flowja=this%flowja, &
302 porosity=this%mip%porosity, &
303 retfactor=this%mip%retfactor, &
304 tracktimes=this%oc%tracktimes)
309 events=this%events, &
310 izone=this%mip%izone, &
311 flowja=this%flowja, &
312 porosity=this%mip%porosity, &
313 retfactor=this%mip%retfactor, &
314 tracktimes=this%oc%tracktimes)
319 call this%events%subscribe(this%tracks)
322 if (this%oc%dump_event_trace) this%tracks%iout = 0
331 class(
bndtype),
pointer :: packobj
338 if (this%inoc > 0)
call this%oc%oc_rp()
339 do ip = 1, this%bndlist%Count()
341 call packobj%bnd_rp()
351 class(
bndtype),
pointer :: packobj
353 integer(I4B) :: irestore
354 integer(I4B) :: ip, n, i
361 do n = 1, this%dis%nodes
362 this%massstoold(n) = this%masssto(n)
366 call this%fmi%fmi_ad()
369 do ip = 1, this%bndlist%Count()
371 call packobj%bnd_ad()
373 call packobj%bnd_ck()
383 do i = 1, this%dis%nja
384 this%flowja(i) =
dzero
389 subroutine prt_cq(this, icnvg, isuppress_output)
396 integer(I4B),
intent(in) :: icnvg
397 integer(I4B),
intent(in) :: isuppress_output
401 class(
bndtype),
pointer :: packobj
415 do i = 1, this%dis%nja
416 this%flowja(i) = this%flowja(i) * tled
420 call this%prt_cq_sto()
423 do ip = 1, this%bndlist%Count()
425 call packobj%bnd_cq(this%masssto, this%flowja)
443 class(
bndtype),
pointer :: packobj
446 integer(I4B) :: idiag
447 integer(I4B) :: istatus
455 do n = 1, this%dis%nodes
456 this%masssto(n) =
dzero
457 this%ratesto(n) =
dzero
459 do ip = 1, this%bndlist%Count()
461 select type (packobj)
463 do np = 1, packobj%nparticles
464 istatus = packobj%particles%istatus(np)
469 this%masssto(n) = this%masssto(n) +
done
474 do n = 1, this%dis%nodes
475 rate = -(this%masssto(n) - this%massstoold(n)) * tled
476 this%ratesto(n) = rate
477 idiag = this%dis%con%ia(n)
478 this%flowja(idiag) = this%flowja(idiag) + rate
488 subroutine prt_bd(this, icnvg, isuppress_output)
494 integer(I4B),
intent(in) :: icnvg
495 integer(I4B),
intent(in) :: isuppress_output
498 class(
bndtype),
pointer :: packobj
506 call this%budget%reset()
508 call this%budget%addentry(rin, rout,
delt,
budtxt(1), &
509 isuppress_output,
' PRT')
510 do ip = 1, this%bndlist%Count()
512 call packobj%bnd_bd(this%budget)
522 integer(I4B) :: idvsave
523 integer(I4B) :: idvprint
524 integer(I4B) :: icbcfl
525 integer(I4B) :: icbcun
526 integer(I4B) :: ibudfl
527 integer(I4B) :: ipflag
536 if (this%oc%oc_save(
'CONCENTRATION')) idvsave = 1
537 if (this%oc%oc_print(
'CONCENTRATION')) idvprint = 1
538 if (this%oc%oc_save(
'BUDGET')) icbcfl = 1
539 if (this%oc%oc_print(
'BUDGET')) ibudfl = 1
540 icbcun = this%oc%oc_save_unit(
'BUDGET')
544 ibudfl = this%oc%set_print_flag(
'BUDGET', 1,
endofperiod)
545 idvprint = this%oc%set_print_flag(
'CONCENTRATION', 1,
endofperiod)
548 call this%prt_ot_flow(icbcfl, ibudfl, icbcun)
551 call this%prt_ot_dv(idvsave, idvprint, ipflag)
554 call this%prt_ot_bdsummary(ibudfl, ipflag)
558 if (ipflag == 1)
call tdis_ot(this%iout)
565 integer(I4B),
intent(in) :: icbcfl
566 integer(I4B),
intent(in) :: ibudfl
567 integer(I4B),
intent(in) :: icbcun
568 class(
bndtype),
pointer :: packobj
572 call this%prt_ot_saveflow(this%dis%nja, this%flowja, icbcfl, icbcun)
573 do ip = 1, this%bndlist%Count()
575 call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
579 do ip = 1, this%bndlist%Count()
581 call packobj%bnd_ot_package_flows(icbcfl=icbcfl, ibudfl=0)
585 call this%prt_ot_printflow(ibudfl, this%flowja)
586 do ip = 1, this%bndlist%Count()
588 call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
592 do ip = 1, this%bndlist%Count()
594 call packobj%bnd_ot_package_flows(icbcfl=0, ibudfl=ibudfl)
602 integer(I4B),
intent(in) :: nja
603 real(DP),
dimension(nja),
intent(in) :: flowja
604 integer(I4B),
intent(in) :: icbcfl
605 integer(I4B),
intent(in) :: icbcun
607 integer(I4B) :: ibinun
610 if (this%ipakcb < 0)
then
612 elseif (this%ipakcb == 0)
then
617 if (icbcfl == 0) ibinun = 0
620 if (ibinun /= 0)
then
621 call this%dis%record_connection_array(flowja, ibinun, this%iout)
632 integer(I4B),
intent(in) :: ibudfl
633 real(DP),
intent(inout),
dimension(:) :: flowja
635 character(len=LENBIGLINE) :: line
636 character(len=30) :: tempstr
637 integer(I4B) :: n, ipos, m
640 character(len=*),
parameter :: fmtiprflow = &
641 "(/,4x,'CALCULATED INTERCELL FLOW &
642 &FOR PERIOD ', i0, ' STEP ', i0)"
645 if (ibudfl /= 0 .and. this%iprflow > 0)
then
646 write (this%iout, fmtiprflow)
kper,
kstp
647 do n = 1, this%dis%nodes
649 call this%dis%noder_to_string(n, tempstr)
650 line = trim(tempstr)//
':'
651 do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1
652 m = this%dis%con%ja(ipos)
653 call this%dis%noder_to_string(m, tempstr)
654 line = trim(line)//
' '//trim(tempstr)
656 write (tempstr,
'(1pg15.6)') qnm
657 line = trim(line)//
' '//trim(adjustl(tempstr))
659 write (this%iout,
'(a)') trim(line)
668 integer(I4B),
intent(in) :: idvsave
669 integer(I4B),
intent(in) :: idvprint
670 integer(I4B),
intent(inout) :: ipflag
672 class(
bndtype),
pointer :: packobj
676 do ip = 1, this%bndlist%Count()
678 call packobj%bnd_ot_dv(idvsave, idvprint)
682 call this%oc%oc_ot(ipflag)
691 integer(I4B),
intent(in) :: ibudfl
692 integer(I4B),
intent(inout) :: ipflag
694 class(
bndtype),
pointer :: packobj
698 do ip = 1, this%bndlist%Count()
700 call packobj%bnd_ot_bdsummary(
kstp,
kper, this%iout, ibudfl)
704 call this%budget%finalize_step(
delt)
705 if (ibudfl /= 0)
then
708 call this%budget%budget_ot(
kstp,
kper, this%iout)
712 call this%budget%writecsv(
totim)
728 class(
bndtype),
pointer :: packobj
735 call this%dis%dis_da()
736 call this%fmi%fmi_da()
737 call this%mip%mip_da()
738 call this%budget%budget_da()
740 deallocate (this%dis)
741 deallocate (this%fmi)
742 deallocate (this%mip)
743 deallocate (this%budget)
752 do ip = 1, this%bndlist%Count()
754 call packobj%bnd_da()
773 call this%tracks%destroy()
774 deallocate (this%events)
775 deallocate (this%tracks)
777 call this%NumericalModelType%model_da()
784 character(len=*),
intent(in) :: modelname
787 call this%NumericalModelType%allocate_scalars(modelname)
816 this%nja = this%dis%nja
817 call this%NumericalModelType%allocate_arrays()
821 'MASSSTO', this%memoryPath)
823 'MASSSTOOLD', this%memoryPath)
825 'RATESTO', this%memoryPath)
827 call mem_allocate(this%x, this%dis%nodes,
'X', this%memoryPath)
828 call mem_allocate(this%rhs, this%dis%nodes,
'RHS', this%memoryPath)
829 call mem_allocate(this%ibound, this%dis%nodes,
'IBOUND', this%memoryPath)
830 do n = 1, this%dis%nodes
831 this%masssto(n) =
dzero
832 this%massstoold(n) =
dzero
833 this%ratesto(n) =
dzero
849 character(len=*),
intent(in) :: filtyp
850 character(len=LINELENGTH) :: errmsg
851 integer(I4B),
intent(in) :: ipakid
852 integer(I4B),
intent(in) :: ipaknum
853 character(len=*),
intent(in) :: pakname
854 character(len=*),
intent(in) :: mempath
855 integer(I4B),
intent(in) :: inunit
856 integer(I4B),
intent(in) :: iout
858 class(
bndtype),
pointer :: packobj
859 class(
bndtype),
pointer :: packobj2
865 call prp_create(packobj, ipakid, ipaknum, inunit, iout, &
866 this%name, pakname, mempath, this%fmi)
868 call api_create(packobj, ipakid, ipaknum, inunit, iout, &
869 this%name, pakname, mempath)
871 write (errmsg, *)
'Invalid package type: ', filtyp
878 do ip = 1, this%bndlist%Count()
880 if (packobj2%packName == pakname)
then
881 write (errmsg,
'(a,a)')
'Cannot create package. Package name '// &
882 'already exists: ', trim(pakname)
893 integer(I4B),
intent(in) :: indis
895 character(len=LINELENGTH) :: errmsg
899 write (errmsg,
'(1x,a)') &
900 'Discretization (DIS6, DISV6, or DISU6) package not specified.'
903 if (this%inmip == 0)
then
904 write (errmsg,
'(1x,a)') &
905 'Model input (MIP6) package not specified.'
910 write (errmsg,
'(1x,a)')
'One or more required package(s) not specified.'
925 integer(I4B) :: np, ip
926 class(
bndtype),
pointer :: packobj
934 call create_particle(particle)
937 do ip = 1, this%bndlist%Count()
939 select type (packobj)
942 do np = 1, packobj%nparticles
944 call packobj%particles%get(particle, this%id, iprp, np)
954 call packobj%particles%put(particle, np)
956 if (particle%istatus >
active) cycle
959 if (particle%trelease >=
totimc)
call this%method%release(particle)
965 tmax = particle%tstop
970 call this%method%apply(particle, tmax)
983 if (particle%istatus <=
active .and. &
984 (particle%ttrack == particle%tstop .or. &
986 call this%method%terminate(particle, status=
term_timeout)
988 call packobj%particles%put(particle, np)
992 call particle%destroy()
993 deallocate (particle)
1004 integer(I4B),
dimension(:),
allocatable,
intent(inout) :: bndpkgs
1006 pointer,
intent(inout) :: pkgtypes
1008 pointer,
intent(inout) :: pkgnames
1010 pointer,
intent(inout) :: mempaths
1011 integer(I4B),
dimension(:),
contiguous, &
1012 pointer,
intent(inout) :: inunits
1014 integer(I4B) :: ipakid, ipaknum
1015 character(len=LENFTYPE) :: pkgtype, bndptype
1016 character(len=LENPACKAGENAME) :: pkgname
1017 character(len=LENMEMPATH) :: mempath
1018 integer(I4B),
pointer :: inunit
1021 if (
allocated(bndpkgs))
then
1025 do n = 1,
size(bndpkgs)
1026 pkgtype = pkgtypes(bndpkgs(n))
1027 pkgname = pkgnames(bndpkgs(n))
1028 mempath = mempaths(bndpkgs(n))
1029 inunit => inunits(bndpkgs(n))
1031 if (bndptype /= pkgtype)
then
1036 call this%package_create(pkgtype, ipakid, ipaknum, pkgname, mempath, &
1039 ipaknum = ipaknum + 1
1043 deallocate (bndpkgs)
1068 pointer :: pkgtypes => null()
1070 pointer :: pkgnames => null()
1072 pointer :: mempaths => null()
1073 integer(I4B),
dimension(:),
contiguous, &
1074 pointer :: inunits => null()
1075 character(len=LENMEMPATH) :: model_mempath
1076 character(len=LENFTYPE) :: pkgtype
1077 character(len=LENPACKAGENAME) :: pkgname
1078 character(len=LENMEMPATH) :: mempath
1079 integer(I4B),
pointer :: inunit
1080 integer(I4B),
dimension(:),
allocatable :: bndpkgs
1082 integer(I4B) :: indis = 0
1083 character(len=LENMEMPATH) :: mempathmip =
''
1084 character(len=LENMEMPATH) :: mempathfmi =
''
1090 call mem_setptr(pkgtypes,
'PKGTYPES', model_mempath)
1091 call mem_setptr(pkgnames,
'PKGNAMES', model_mempath)
1092 call mem_setptr(mempaths,
'MEMPATHS', model_mempath)
1093 call mem_setptr(inunits,
'INUNITS', model_mempath)
1095 do n = 1,
size(pkgtypes)
1097 pkgtype = pkgtypes(n)
1098 pkgname = pkgnames(n)
1099 mempath = mempaths(n)
1100 inunit => inunits(n)
1103 select case (pkgtype)
1106 call dis_cr(this%dis, this%name, mempath, indis, this%iout)
1109 call disv_cr(this%dis, this%name, mempath, indis, this%iout)
1112 call disu_cr(this%dis, this%name, mempath, indis, this%iout)
1115 mempathmip = mempath
1118 mempathfmi = mempath
1123 bndpkgs(
size(bndpkgs)) = n
1125 call pstop(1,
"Unrecognized package type: "//pkgtype)
1138 call mip_cr(this%mip, this%name, mempathmip, this%inmip, this%iout, this%dis)
1139 call fmi_cr(this%fmi, this%name, mempathfmi, this%infmi, this%iout)
1140 call oc_cr(this%oc, this%name, this%inoc, this%iout)
1143 call this%ftype_check(indis)
1146 call this%create_bndpkgs(bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
1155 write (this%iout,
'(1x,a)')
'NAMEFILE OPTIONS:'
1157 if (found%print_input)
then
1158 write (this%iout,
'(4x,a)')
'STRESS PACKAGE INPUT WILL BE PRINTED '// &
1159 'FOR ALL MODEL STRESS PACKAGES'
1162 if (found%print_flows)
then
1163 write (this%iout,
'(4x,a)')
'PACKAGE FLOWS WILL BE PRINTED '// &
1164 'FOR ALL MODEL PACKAGES'
1167 if (found%save_flows)
then
1168 write (this%iout,
'(4x,a)') &
1169 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL'
1172 write (this%iout,
'(1x,a)')
'END NAMEFILE OPTIONS:'
This module contains the API package methods.
subroutine, public api_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
@ 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
subroutine, public rate_accumulator(flow, rin, rout)
@ brief Rate accumulator subroutine
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
@ mnormal
normal output mode
integer(i4b), parameter lenpackagename
maximum length of the package name
integer(i4b), parameter lenpackagetype
maximum length of a package type (DIS6, SFR6, CSUB6, etc.)
integer(i4b), parameter lenbigline
maximum length of a big line
real(dp), parameter dhnoflo
real no flow constant
integer(i4b), parameter lenpakloc
maximum length of a package location
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 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.
subroutine pstop(status, message)
Stop the program, optionally specifying an error status code.
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 memorystore_remove(component, subcomponent, context)
Cell-level tracking methods.
subroutine, public create_method_cell_pool()
Create the cell method pool.
subroutine, public destroy_method_cell_pool()
Destroy the cell method pool.
Particle tracking strategies.
Model-level tracking methods.
type(methoddisvtype), pointer, public method_disv
type(methoddistype), pointer, public method_dis
subroutine, public create_method_pool()
Create the method pool.
subroutine, public destroy_method_pool()
Destroy the method pool.
Subcell-level tracking methods.
subroutine, public create_method_subcell_pool()
Create the subcell method pool.
subroutine, public destroy_method_subcell_pool()
Destroy the subcell method pool.
@, public release
particle was released
@, public terminate
particle terminated
@ term_timeout
terminated at stop time or end of simulation
@ term_unreleased
terminated permanently unreleased
subroutine create_particle(particle)
Create a new particle.
Particle track output module.
subroutine, public fmi_cr(fmiobj, name_model, input_mempath, inunit, iout)
Create a new PrtFmi object.
subroutine, public mip_cr(mip, name_model, input_mempath, inunit, iout, dis)
Create a model input object.
integer(i4b), parameter niunit_prt
subroutine prt_ot(this)
Print and/or save model output.
subroutine prt_rp(this)
Read and prepare (calls package read and prepare routines)
subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
Source package info and begin to process.
subroutine prt_ar(this)
Allocate and read.
subroutine ftype_check(this, indis)
Check to make sure required input files have been specified.
subroutine prt_ot_saveflow(this, nja, flowja, icbcfl, icbcun)
Save intercell flows.
subroutine prt_ad(this)
Time step advance (calls package advance subroutines)
subroutine prt_cq(this, icnvg, isuppress_output)
Calculate intercell flow (flowja)
subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, inunit, iout)
Create boundary condition packages for this model.
subroutine prt_ot_flow(this, icbcfl, ibudfl, icbcun)
Save flows.
subroutine allocate_scalars(this, modelname)
Allocate memory for scalars.
subroutine prt_ot_bdsummary(this, ibudfl, ipflag)
Print budget summary.
character(len=lenpackagetype), dimension(prt_nmultipkg), public prt_multipkg
subroutine create_packages(this)
Source package info and begin to process.
character(len=lenpackagetype), dimension(prt_nbasepkg), public prt_basepkg
integer(i4b), parameter, public prt_nmultipkg
PRT multi package array descriptors.
character(len=lenbudtxt), dimension(nbditems) budtxt
subroutine prt_da(this)
Deallocate.
subroutine prt_cq_sto(this)
Calculate particle mass storage.
subroutine, public prt_cr(filename, id, modelname)
Create a new particle tracking model object.
subroutine prt_ot_printflow(this, ibudfl, flowja)
Print intercell flows.
subroutine prt_bd(this, icnvg, isuppress_output)
Calculate flows and budget.
subroutine prt_df(this)
Define packages.
integer(i4b), parameter, public prt_nbasepkg
PRT base package array descriptors.
integer(i4b), parameter nbditems
subroutine allocate_arrays(this)
Allocate arrays.
subroutine log_namfile_options(this, found)
Write model namfile options to list file.
subroutine prt_ot_dv(this, idvsave, idvprint, ipflag)
Print dependent variables.
subroutine prt_solve(this)
Solve the model.
subroutine, public oc_cr(ocobj, name_model, inunit, iout)
@ brief Create an output control object
subroutine, public prp_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, input_mempath, fmi)
Create a new particle release point package.
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=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 endofperiod
flag indicating end of stress period
logical(lgp), pointer, public endofsimulation
flag indicating end of simulation
subroutine, public tdis_ot(iout)
Print simulation time.
real(dp), pointer, public totim
time relative to start of simulation
logical(lgp), pointer, public readnewdata
flag indicating time to read new data
real(dp), pointer, public totimc
simulation time at start of time step
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 version information.
subroutine write_listfile_header(iout, cmodel_type, write_sys_command, write_kind_info)
@ brief Write program header
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 ...
Structured grid discretization.
Unstructured grid discretization.
Vertex grid discretization.
A generic heterogeneous doubly-linked list.
Base type for particle tracking methods.
Particle tracked by the PRT model.
Output file containing all or some particle pathlines.
Manages particle track output (logging/writing).
Particle tracking (PRT) model.
@ brief Output control for particle tracking models
Particle release point (PRP) package.