MODFLOW 6  version 6.5.0.dev2
MODFLOW 6 Code Documentation
prt.f90
Go to the documentation of this file.
1 module prtmodule
2  use kindmodule, only: dp, i4b, lgp
3  use errorutilmodule, only: pstop
12  use dismodule, only: distype, dis_cr
13  use disvmodule, only: disvtype, disv_cr
14  use disumodule, only: disutype, disu_cr
15  use prtprpmodule, only: prtprptype
16  use prtfmimodule, only: prtfmitype
17  use prtmipmodule, only: prtmiptype
18  use prtocmodule, only: prtoctype
19  use prtobsmodule, only: prtobstype
20  use budgetmodule, only: budgettype
21  use listmodule, only: listtype
26  use methodmodule, only: methodtype
27 
28  implicit none
29 
30  private
31  public :: prt_cr
32  public :: prtmodeltype
33  public :: prt_nbasepkg, prt_nmultipkg
34  public :: prt_basepkg, prt_multipkg
35 
36  integer(I4B), parameter :: nbditems = 1
37  character(len=LENBUDTXT), dimension(NBDITEMS) :: budtxt
38  data budtxt/' STORAGE'/
39 
40  !> @brief Particle tracking (PRT) model
41  type, extends(numericalmodeltype) :: prtmodeltype
42  type(prtfmitype), pointer :: fmi => null() ! flow model interface
43  type(prtmiptype), pointer :: mip => null() ! model input package
44  type(prtoctype), pointer :: oc => null() ! output control package
45  type(prtobstype), pointer :: obs => null() ! observation package
46  type(budgettype), pointer :: budget => null() ! budget object
47  class(methodtype), pointer :: method => null() ! tracking method
48  type(trackfilecontroltype), pointer :: trackfilectl ! track file control
49  integer(I4B), pointer :: infmi => null() ! unit number FMI
50  integer(I4B), pointer :: inmip => null() ! unit number MIP
51  integer(I4B), pointer :: inmvt => null() ! unit number MVT
52  integer(I4B), pointer :: inmst => null() ! unit number MST
53  integer(I4B), pointer :: inadv => null() ! unit number ADV
54  integer(I4B), pointer :: indsp => null() ! unit number DSP
55  integer(I4B), pointer :: inssm => null() ! unit number SSM
56  integer(I4B), pointer :: inoc => null() ! unit number OC
57  integer(I4B), pointer :: inobs => null() ! unit number OBS
58  integer(I4B), pointer :: nprp => null() ! number of PRP packages in the model
59  real(dp), dimension(:), pointer, contiguous :: masssto => null() !< particle mass storage in cells, new value
60  real(dp), dimension(:), pointer, contiguous :: massstoold => null() !< particle mass storage in cells, old value
61  real(dp), dimension(:), pointer, contiguous :: ratesto => null() !< particle mass storage rate in cells
62  contains
63  ! -- Override BaseModelType procs
64  procedure :: model_df => prt_df
65  procedure :: model_ar => prt_ar
66  procedure :: model_rp => prt_rp
67  procedure :: model_ad => prt_ad
68  procedure :: model_cq => prt_cq
69  procedure :: model_bd => prt_bd
70  procedure :: model_ot => prt_ot
71  procedure :: model_da => prt_da
72  procedure :: model_solve => prt_solve
73 
74  ! -- Private utilities
75  procedure :: allocate_scalars
76  procedure :: allocate_arrays
77  procedure, private :: package_create
78  procedure, private :: ftype_check
79  procedure, private :: prt_ot_flow
80  procedure, private :: prt_ot_saveflow
81  procedure, private :: prt_ot_printflow
82  procedure, private :: prt_ot_dv
83  procedure, private :: prt_ot_bdsummary
84  procedure, private :: prt_ot_obs
85  procedure, private :: prt_cq_sto
86  procedure, private :: create_packages
87  procedure, private :: create_bndpkgs
88  procedure, private :: log_namfile_options
89 
90  end type prtmodeltype
91 
92  !> @brief PRT base package array descriptors
93  !!
94  !! PRT6 model base package types. Only listed packages are candidates
95  !! for input and these will be loaded in the order specified.
96  !<
97  integer(I4B), parameter :: prt_nbasepkg = 50
98  character(len=LENPACKAGETYPE), dimension(PRT_NBASEPKG) :: prt_basepkg
99  data prt_basepkg/'DIS6 ', 'DISV6', 'DISU6', 'IC6 ', 'MST6 ', & ! 5
100  &'ADV6 ', 'DSP6 ', 'SSM6 ', 'MIP6 ', 'CNC6 ', & ! 10
101  &'OC6 ', 'OBS6 ', 'FMI6 ', ' ', 'IST6 ', & ! 15
102  &'LKT6 ', 'SFT6 ', 'MWT6 ', 'UZT6 ', 'MVT6 ', & ! 20
103  &'API6 ', ' ', ' ', ' ', ' ', & ! 25
104  25*' '/ ! 50
105 
106  !> @brief PRT multi package array descriptors
107  !!
108  !! PRT6 model multi-instance package types. Only listed packages are
109  !! candidates for input and these will be loaded in the order specified.
110  !<
111  integer(I4B), parameter :: prt_nmultipkg = 50
112  character(len=LENPACKAGETYPE), dimension(PRT_NMULTIPKG) :: prt_multipkg
113  data prt_multipkg/'PRP6 ', ' ', ' ', ' ', ' ', & ! 5
114  &45*' '/ ! 50
115 
116  ! -- size of supported model package arrays
117  integer(I4B), parameter :: niunit_prt = prt_nbasepkg + prt_nmultipkg
118 
119 contains
120 
121  !> @brief Create a new particle tracking model object
122  subroutine prt_cr(filename, id, modelname)
123  ! -- modules
124  use listsmodule, only: basemodellist
127  use compilerversion
132  ! -- dummy
133  character(len=*), intent(in) :: filename
134  integer(I4B), intent(in) :: id
135  character(len=*), intent(in) :: modelname
136  ! -- local
137  type(prtmodeltype), pointer :: this
138  class(basemodeltype), pointer :: model
139  character(len=LENMEMPATH) :: input_mempath
140  character(len=LINELENGTH) :: lst_fname
141  type(gwfnamparamfoundtype) :: found
142 
143  ! -- Allocate a new PRT Model (this)
144  allocate (this)
145 
146  ! -- Set this before any allocs in the memory manager can be done
147  this%memoryPath = create_mem_path(modelname)
148 
149  ! -- Allocate track control object
150  allocate (this%trackfilectl)
151 
152  ! -- Allocate scalars and add model to basemodellist
153  call this%allocate_scalars(modelname)
154  model => this
155  call addbasemodeltolist(basemodellist, model)
156 
157  ! -- Assign variables
158  this%filename = filename
159  this%name = modelname
160  this%macronym = 'PRT'
161  this%id = id
162 
163  ! -- Set input model namfile memory path
164  input_mempath = create_mem_path(modelname, 'NAM', idm_context)
165 
166  ! -- Copy options from input context
167  call mem_set_value(this%iprpak, 'PRINT_INPUT', input_mempath, &
168  found%print_input)
169  call mem_set_value(this%iprflow, 'PRINT_FLOWS', input_mempath, &
170  found%print_flows)
171  call mem_set_value(this%ipakcb, 'SAVE_FLOWS', input_mempath, &
172  found%save_flows)
173 
174  ! -- Create the list file
175  call this%create_lstfile(lst_fname, filename, found%list, &
176  'PARTICLE TRACKING MODEL (PRT)')
177 
178  ! -- Activate save_flows if found
179  if (found%save_flows) then
180  this%ipakcb = -1
181  end if
182 
183  ! -- Log options
184  if (this%iout > 0) then
185  call this%log_namfile_options(found)
186  end if
187 
188  ! -- Create model packages
189  call this%create_packages()
190  end subroutine prt_cr
191 
192  !> @brief Define packages
193  !!
194  !! (1) call df routines for each package
195  !! (2) set variables and pointers
196  !<
197  subroutine prt_df(this)
198  ! -- modules
199  use prtprpmodule, only: prtprptype
200  ! -- dummy
201  class(prtmodeltype) :: this
202  ! -- local
203  integer(I4B) :: ip
204  class(bndtype), pointer :: packobj
205 
206  ! -- Define packages and utility objects
207  call this%dis%dis_df()
208  call this%fmi%fmi_df(this%dis, 1)
209  call this%oc%oc_df()
210  call this%budget%budget_df(niunit_prt, 'MASS', 'M')
211 
212  ! -- Define packages and assign iout for time series managers
213  do ip = 1, this%bndlist%Count()
214  packobj => getbndfromlist(this%bndlist, ip)
215  call packobj%bnd_df(this%dis%nodes, this%dis)
216  packobj%TsManager%iout = this%iout
217  packobj%TasManager%iout = this%iout
218  end do
219 
220  ! -- Allocate model arrays
221  call this%allocate_arrays()
222 
223  ! -- Store information needed for observations
224  call this%obs%obs_df(this%iout, this%name, 'PRT', this%dis)
225  end subroutine prt_df
226 
227  !> @brief Allocate and read
228  !!
229  !! (1) allocates and reads packages part of this model,
230  !! (2) allocates memory for arrays part of this model object
231  !<
232  subroutine prt_ar(this)
233  ! -- modules
234  use constantsmodule, only: dhnoflo
235  use prtprpmodule, only: prtprptype
236  use prtmipmodule, only: prtmiptype
238  ! -- dummy
239  class(prtmodeltype) :: this
240  ! -- locals
241  integer(I4B) :: ip
242  class(bndtype), pointer :: packobj
243 
244  ! -- Allocate and read modules attached to model
245  call this%fmi%fmi_ar(this%ibound)
246  if (this%inmip > 0) call this%mip%mip_ar()
247 
248  ! -- set up output control
249  call this%oc%oc_ar(this%masssto, this%dis, dhnoflo)
250  call this%budget%set_ibudcsv(this%oc%ibudcsv)
251 
252  ! -- Package input files now open, so allocate and read
253  do ip = 1, this%bndlist%Count()
254  packobj => getbndfromlist(this%bndlist, ip)
255  select type (packobj)
256  type is (prtprptype)
257  call packobj%prp_set_pointers(this%ibound, this%mip%izone, &
258  this%trackfilectl)
259  end select
260  ! -- Read and allocate package
261  call packobj%bnd_ar()
262  end do
263 
264  ! -- Initialize tracking method
265  select type (dis => this%dis)
266  type is (distype)
267  call method_dis%init( &
268  fmi=this%fmi, &
269  trackfilectl=this%trackfilectl, &
270  izone=this%mip%izone, &
271  flowja=this%flowja, &
272  porosity=this%mip%porosity, &
273  retfactor=this%mip%retfactor, &
274  tracktimes=this%oc%tracktimes)
275  this%method => method_dis
276  type is (disvtype)
277  call method_disv%init( &
278  fmi=this%fmi, &
279  trackfilectl=this%trackfilectl, &
280  izone=this%mip%izone, &
281  flowja=this%flowja, &
282  porosity=this%mip%porosity, &
283  retfactor=this%mip%retfactor, &
284  tracktimes=this%oc%tracktimes)
285  this%method => method_disv
286  method_disv%zeromethod = this%mip%zeromethod
287  end select
288 
289  ! -- Initialize track output files and reporting options
290  if (this%oc%itrkout > 0) &
291  call this%trackfilectl%init_track_file(this%oc%itrkout)
292  if (this%oc%itrkcsv > 0) &
293  call this%trackfilectl%init_track_file(this%oc%itrkcsv, csv=.true.)
294  call this%trackfilectl%set_track_events( &
295  this%oc%trackrelease, &
296  this%oc%tracktransit, &
297  this%oc%tracktimestep, &
298  this%oc%trackterminate, &
299  this%oc%trackweaksink, &
300  this%oc%trackusertime)
301  end subroutine prt_ar
302 
303  !> @brief Read and prepare (calls package read and prepare routines)
304  subroutine prt_rp(this)
305  use tdismodule, only: readnewdata
306  ! -- dummy
307  class(prtmodeltype) :: this
308  ! -- local
309  class(bndtype), pointer :: packobj
310  integer(I4B) :: ip
311 
312  ! -- Check with TDIS on whether or not it is time to RP
313  if (.not. readnewdata) return
314 
315  ! -- Read and prepare
316  if (this%inoc > 0) call this%oc%oc_rp()
317  do ip = 1, this%bndlist%Count()
318  packobj => getbndfromlist(this%bndlist, ip)
319  call packobj%bnd_rp()
320  call packobj%bnd_rp_obs()
321  end do
322  end subroutine prt_rp
323 
324  !> @brief Time step advance (calls package advance subroutines)
325  subroutine prt_ad(this)
326  ! -- modules
328  ! -- dummy
329  class(prtmodeltype) :: this
330  class(bndtype), pointer :: packobj
331  ! -- local
332  integer(I4B) :: irestore
333  integer(I4B) :: ip, n, i
334 
335  ! -- Reset state variable
336  irestore = 0
337  if (ifailedstepretry > 0) irestore = 1
338 
339  ! -- Copy masssto into massstoold
340  do n = 1, this%dis%nodes
341  this%massstoold(n) = this%masssto(n)
342  end do
343 
344  ! -- Advance fmi
345  call this%fmi%fmi_ad()
346 
347  ! -- Advance
348  do ip = 1, this%bndlist%Count()
349  packobj => getbndfromlist(this%bndlist, ip)
350  call packobj%bnd_ad()
351  if (isimcheck > 0) then
352  call packobj%bnd_ck()
353  end if
354  end do
355 
356  ! -- Push simulated values to preceding time/subtime step
357  call this%obs%obs_ad()
358  !
359  ! -- Initialize the flowja array. Flowja is calculated each time,
360  ! even if output is suppressed. (Flowja represents flow of particle
361  ! mass and is positive into a cell. Currently, each particle is assigned
362  ! unit mass.) Flowja is updated continually as particles are tracked
363  ! over the time step and at the end of the time step. The diagonal
364  ! position of the flowja array will contain the flow residual.
365  do i = 1, this%dis%nja
366  this%flowja(i) = dzero
367  end do
368  end subroutine prt_ad
369 
370  !> @brief Calculate intercell flow (flowja)
371  subroutine prt_cq(this, icnvg, isuppress_output)
372  ! -- modules
373  use sparsemodule, only: csr_diagsum
374  use tdismodule, only: delt
375  use prtprpmodule, only: prtprptype
376  ! -- dummy
377  class(prtmodeltype) :: this
378  integer(I4B), intent(in) :: icnvg
379  integer(I4B), intent(in) :: isuppress_output
380  ! -- local
381  integer(I4B) :: i
382  integer(I4B) :: ip
383  class(bndtype), pointer :: packobj
384  real(DP) :: tled
385 
386  ! -- Flowja is calculated each time, even if output is suppressed.
387  ! Flowja represents flow of particle mass and is positive into a cell.
388  ! Currently, each particle is assigned unit mass.
389  !
390  ! -- Reciprocal of time step size.
391  tled = done / delt
392  !
393  ! -- Flowja was updated continually as particles were tracked over the
394  ! time step. At this point, flowja contains the net particle mass
395  ! exchanged between cells during the time step. To convert these to
396  ! flow rates (particle mass per time), divide by the time step size.
397  do i = 1, this%dis%nja
398  this%flowja(i) = this%flowja(i) * tled
399  end do
400 
401  ! -- Particle mass storage
402  call this%prt_cq_sto()
403 
404  ! -- Go through packages and call cq routines. Just a formality.
405  do ip = 1, this%bndlist%Count()
406  packobj => getbndfromlist(this%bndlist, ip)
407  call packobj%bnd_cq(this%masssto, this%flowja)
408  end do
409 
410  ! -- Finalize calculation of flowja by adding face flows to the diagonal.
411  ! This results in the flow residual being stored in the diagonal
412  ! position for each cell.
413  call csr_diagsum(this%dis%con%ia, this%flowja)
414  end subroutine prt_cq
415 
416  !> @brief Calculate particle mass storage
417  subroutine prt_cq_sto(this)
418  ! -- modules
419  use tdismodule, only: delt
420  use prtprpmodule, only: prtprptype
421  ! -- dummy
422  class(prtmodeltype) :: this
423  ! -- local
424  integer(I4B) :: ip
425  class(bndtype), pointer :: packobj
426  integer(I4B) :: n
427  integer(I4B) :: np
428  integer(I4B) :: idiag
429  integer(I4B) :: istatus
430  real(DP) :: tled
431  real(DP) :: rate
432 
433  ! -- Reciprocal of time step size.
434  tled = done / delt
435 
436  ! -- Particle mass storage rate
437  do n = 1, this%dis%nodes
438  this%masssto(n) = dzero
439  this%ratesto(n) = dzero
440  end do
441  do ip = 1, this%bndlist%Count() ! kluge note: could accumulate masssto on the fly in prt_solve instead
442  packobj => getbndfromlist(this%bndlist, ip)
443  select type (packobj)
444  type is (prtprptype)
445  do np = 1, packobj%nparticles
446  istatus = packobj%particles%istatus(np)
447  ! refine these conditions as necessary
448  ! (status 8 is permanently unreleased)
449  if ((istatus > 0) .and. (istatus /= 8)) then
450  n = packobj%particles%idomain(np, 2)
451  ! -- Each particle currently assigned unit mass
452  this%masssto(n) = this%masssto(n) + done
453  end if
454  end do
455  end select
456  end do
457  do n = 1, this%dis%nodes ! kluge note: set rate to zero and skip inactive nodes?
458  rate = -(this%masssto(n) - this%massstoold(n)) * tled
459  this%ratesto(n) = rate
460  idiag = this%dis%con%ia(n)
461  this%flowja(idiag) = this%flowja(idiag) + rate
462  end do
463  end subroutine prt_cq_sto
464 
465  !> @brief Calculate flows and budget
466  !!
467  !! (1) Calculate intercell flows (flowja)
468  !! (2) Calculate package contributions to model budget
469  !!
470  !<
471  subroutine prt_bd(this, icnvg, isuppress_output)
472  ! -- modules
473  use tdismodule, only: delt
474  use budgetmodule, only: rate_accumulator
475  ! -- dummy
476  class(prtmodeltype) :: this
477  integer(I4B), intent(in) :: icnvg
478  integer(I4B), intent(in) :: isuppress_output
479  ! -- local
480  integer(I4B) :: ip
481  class(bndtype), pointer :: packobj
482  real(DP) :: rin
483  real(DP) :: rout
484 
485  ! -- Budget routines (start by resetting). Sole purpose of this section
486  ! is to add in and outs to model budget. All ins and out for a model
487  ! should be added here to this%budget. In a subsequent exchange call,
488  ! exchange flows might also be added.
489  call this%budget%reset()
490  call rate_accumulator(this%ratesto, rin, rout)
491  call this%budget%addentry(rin, rout, delt, budtxt(1), &
492  isuppress_output, ' PRT')
493  do ip = 1, this%bndlist%Count()
494  packobj => getbndfromlist(this%bndlist, ip)
495  call packobj%bnd_bd(this%budget)
496  end do
497  end subroutine prt_bd
498 
499  !> @brief Print and/or save model output
500  subroutine prt_ot(this)
501  use tdismodule, only: tdis_ot, endofperiod
502  ! -- dummy
503  class(prtmodeltype) :: this
504  ! -- local
505  integer(I4B) :: idvsave
506  integer(I4B) :: idvprint
507  integer(I4B) :: icbcfl
508  integer(I4B) :: icbcun
509  integer(I4B) :: ibudfl
510  integer(I4B) :: ipflag
511 
512  ! -- Note: particle tracking output is handled elsewhere
513 
514  ! -- Set write and print flags
515  idvsave = 0
516  idvprint = 0
517  icbcfl = 0
518  ibudfl = 0
519  if (this%oc%oc_save('CONCENTRATION')) idvsave = 1
520  if (this%oc%oc_print('CONCENTRATION')) idvprint = 1
521  if (this%oc%oc_save('BUDGET')) icbcfl = 1
522  if (this%oc%oc_print('BUDGET')) ibudfl = 1
523  icbcun = this%oc%oc_save_unit('BUDGET')
524 
525  ! -- Override ibudfl and idvprint flags for nonconvergence
526  ! and end of period
527  ibudfl = this%oc%set_print_flag('BUDGET', 1, endofperiod)
528  idvprint = this%oc%set_print_flag('CONCENTRATION', 1, endofperiod)
529 
530  ! -- Calculate and save observations
531  call this%prt_ot_obs()
532 
533  ! -- Save and print flows
534  call this%prt_ot_flow(icbcfl, ibudfl, icbcun)
535 
536  ! -- Save and print dependent variables
537  call this%prt_ot_dv(idvsave, idvprint, ipflag)
538 
539  ! -- Print budget summaries
540  call this%prt_ot_bdsummary(ibudfl, ipflag)
541 
542  ! -- Timing Output; if any dependent variables or budgets
543  ! are printed, then ipflag is set to 1.
544  if (ipflag == 1) call tdis_ot(this%iout)
545  end subroutine prt_ot
546 
547  !> @brief Calculate and save observations
548  subroutine prt_ot_obs(this)
549  class(prtmodeltype) :: this
550  class(bndtype), pointer :: packobj
551  integer(I4B) :: ip
552 
553  ! -- Calculate and save observations
554  call this%obs%obs_bd()
555  call this%obs%obs_ot()
556 
557  ! -- Calculate and save package obserations
558  do ip = 1, this%bndlist%Count()
559  packobj => getbndfromlist(this%bndlist, ip)
560  call packobj%bnd_bd_obs()
561  call packobj%bnd_ot_obs()
562  end do
563  end subroutine prt_ot_obs
564 
565  !> @brief Save flows
566  subroutine prt_ot_flow(this, icbcfl, ibudfl, icbcun)
567  use prtprpmodule, only: prtprptype
568  class(prtmodeltype) :: this
569  integer(I4B), intent(in) :: icbcfl
570  integer(I4B), intent(in) :: ibudfl
571  integer(I4B), intent(in) :: icbcun
572  class(bndtype), pointer :: packobj
573  integer(I4B) :: ip
574 
575  ! -- Save PRT flows
576  call this%prt_ot_saveflow(this%dis%nja, this%flowja, icbcfl, icbcun)
577  do ip = 1, this%bndlist%Count()
578  packobj => getbndfromlist(this%bndlist, ip)
579  call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
580  end do
581 
582  ! -- Save advanced package flows
583  do ip = 1, this%bndlist%Count()
584  packobj => getbndfromlist(this%bndlist, ip)
585  call packobj%bnd_ot_package_flows(icbcfl=icbcfl, ibudfl=0)
586  end do
587 
588  ! -- Print PRT flows
589  call this%prt_ot_printflow(ibudfl, this%flowja)
590  do ip = 1, this%bndlist%Count()
591  packobj => getbndfromlist(this%bndlist, ip)
592  call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
593  end do
594 
595  ! -- Print advanced package flows
596  do ip = 1, this%bndlist%Count()
597  packobj => getbndfromlist(this%bndlist, ip)
598  call packobj%bnd_ot_package_flows(icbcfl=0, ibudfl=ibudfl)
599  end do
600  end subroutine prt_ot_flow
601 
602  !> @brief Save intercell flows
603  subroutine prt_ot_saveflow(this, nja, flowja, icbcfl, icbcun)
604  ! -- dummy
605  class(prtmodeltype) :: this
606  integer(I4B), intent(in) :: nja
607  real(DP), dimension(nja), intent(in) :: flowja
608  integer(I4B), intent(in) :: icbcfl
609  integer(I4B), intent(in) :: icbcun
610  ! -- local
611  integer(I4B) :: ibinun
612 
613  ! -- Set unit number for binary output
614  if (this%ipakcb < 0) then
615  ibinun = icbcun
616  elseif (this%ipakcb == 0) then
617  ibinun = 0
618  else
619  ibinun = this%ipakcb
620  end if
621  if (icbcfl == 0) ibinun = 0
622 
623  ! -- Write the face flows if requested
624  if (ibinun /= 0) then
625  call this%dis%record_connection_array(flowja, ibinun, this%iout)
626  end if
627  end subroutine prt_ot_saveflow
628 
629  !> @brief Print intercell flows
630  subroutine prt_ot_printflow(this, ibudfl, flowja)
631  ! -- modules
632  use tdismodule, only: kper, kstp
633  use constantsmodule, only: lenbigline
634  ! -- dummy
635  class(prtmodeltype) :: this
636  integer(I4B), intent(in) :: ibudfl
637  real(DP), intent(inout), dimension(:) :: flowja
638  ! -- local
639  character(len=LENBIGLINE) :: line
640  character(len=30) :: tempstr
641  integer(I4B) :: n, ipos, m
642  real(DP) :: qnm
643  ! -- formats
644  character(len=*), parameter :: fmtiprflow = &
645  "(/,4x,'CALCULATED INTERCELL FLOW &
646  &FOR PERIOD ', i0, ' STEP ', i0)"
647 
648  ! -- Write flowja to list file if requested
649  if (ibudfl /= 0 .and. this%iprflow > 0) then
650  write (this%iout, fmtiprflow) kper, kstp
651  do n = 1, this%dis%nodes
652  line = ''
653  call this%dis%noder_to_string(n, tempstr)
654  line = trim(tempstr)//':'
655  do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1
656  m = this%dis%con%ja(ipos)
657  call this%dis%noder_to_string(m, tempstr)
658  line = trim(line)//' '//trim(tempstr)
659  qnm = flowja(ipos)
660  write (tempstr, '(1pg15.6)') qnm
661  line = trim(line)//' '//trim(adjustl(tempstr))
662  end do
663  write (this%iout, '(a)') trim(line)
664  end do
665  end if
666  end subroutine prt_ot_printflow
667 
668  !> @brief Print dependent variables
669  subroutine prt_ot_dv(this, idvsave, idvprint, ipflag)
670  ! -- dummy
671  class(prtmodeltype) :: this
672  integer(I4B), intent(in) :: idvsave
673  integer(I4B), intent(in) :: idvprint
674  integer(I4B), intent(inout) :: ipflag
675  ! -- local
676  class(bndtype), pointer :: packobj
677  integer(I4B) :: ip
678 
679  ! -- Print advanced package dependent variables
680  do ip = 1, this%bndlist%Count()
681  packobj => getbndfromlist(this%bndlist, ip)
682  call packobj%bnd_ot_dv(idvsave, idvprint)
683  end do
684 
685  ! -- save head and print head
686  call this%oc%oc_ot(ipflag)
687  end subroutine prt_ot_dv
688 
689  !> @brief Print budget summary
690  subroutine prt_ot_bdsummary(this, ibudfl, ipflag)
691  ! -- modules
692  use tdismodule, only: kstp, kper, totim, delt
693  ! -- dummy
694  class(prtmodeltype) :: this
695  integer(I4B), intent(in) :: ibudfl
696  integer(I4B), intent(inout) :: ipflag
697  ! -- local
698  class(bndtype), pointer :: packobj
699  integer(I4B) :: ip
700 
701  ! -- Package budget summary
702  do ip = 1, this%bndlist%Count()
703  packobj => getbndfromlist(this%bndlist, ip)
704  call packobj%bnd_ot_bdsummary(kstp, kper, this%iout, ibudfl)
705  end do
706 
707  ! -- model budget summary
708  call this%budget%finalize_step(delt)
709  if (ibudfl /= 0) then
710  ipflag = 1
711  ! -- model budget summary
712  call this%budget%budget_ot(kstp, kper, this%iout)
713  end if
714 
715  ! -- Write to budget csv
716  call this%budget%writecsv(totim)
717  end subroutine prt_ot_bdsummary
718 
719  !> @brief Deallocate
720  subroutine prt_da(this)
721  ! -- modules
728  ! -- dummy
729  class(prtmodeltype) :: this
730  ! -- local
731  integer(I4B) :: ip
732  class(bndtype), pointer :: packobj
733 
734  ! -- Deallocate idm memory
735  call memorylist_remove(this%name, 'NAM', idm_context)
736  call memorylist_remove(component=this%name, context=idm_context)
737 
738  ! -- Internal packages
739  call this%dis%dis_da()
740  call this%fmi%fmi_da()
741  call this%mip%mip_da()
742  call this%budget%budget_da()
743  call this%oc%oc_da()
744  call this%obs%obs_da()
745  deallocate (this%dis)
746  deallocate (this%fmi)
747  deallocate (this%mip)
748  deallocate (this%budget)
749  deallocate (this%oc)
750  deallocate (this%obs)
751 
752  ! -- Method objects
755  call destroy_method_pool()
756 
757  ! -- Boundary packages
758  do ip = 1, this%bndlist%Count()
759  packobj => getbndfromlist(this%bndlist, ip)
760  call packobj%bnd_da()
761  deallocate (packobj)
762  end do
763 
764  ! -- Scalars
765  call mem_deallocate(this%infmi)
766  call mem_deallocate(this%inmip)
767  call mem_deallocate(this%inadv)
768  call mem_deallocate(this%indsp)
769  call mem_deallocate(this%inssm)
770  call mem_deallocate(this%inmst)
771  call mem_deallocate(this%inmvt)
772  call mem_deallocate(this%inoc)
773  call mem_deallocate(this%inobs)
774  call mem_deallocate(this%nprp)
775 
776  ! -- Arrays
777  call mem_deallocate(this%masssto)
778  call mem_deallocate(this%massstoold)
779  call mem_deallocate(this%ratesto)
780 
781  ! -- Track file control
782  deallocate (this%trackfilectl)
783 
784  ! -- Parent type
785  call this%NumericalModelType%model_da()
786  end subroutine prt_da
787 
788  !> @brief Allocate memory for non-allocatable members
789  subroutine allocate_scalars(this, modelname)
790  ! -- dummy
791  class(prtmodeltype) :: this
792  character(len=*), intent(in) :: modelname
793 
794  ! -- allocate members from parent class
795  call this%NumericalModelType%allocate_scalars(modelname)
796 
797  ! -- allocate members that are part of model class
798  call mem_allocate(this%infmi, 'INFMI', this%memoryPath)
799  call mem_allocate(this%inmip, 'INMIP', this%memoryPath)
800  call mem_allocate(this%inmvt, 'INMVT', this%memoryPath)
801  call mem_allocate(this%inmst, 'INMST', this%memoryPath)
802  call mem_allocate(this%inadv, 'INADV', this%memoryPath)
803  call mem_allocate(this%indsp, 'INDSP', this%memoryPath)
804  call mem_allocate(this%inssm, 'INSSM', this%memoryPath)
805  call mem_allocate(this%inoc, 'INOC ', this%memoryPath)
806  call mem_allocate(this%inobs, 'INOBS', this%memoryPath)
807  call mem_allocate(this%nprp, 'NPRP', this%memoryPath) ! kluge?
808 
809  this%infmi = 0
810  this%inmip = 0
811  this%inmvt = 0
812  this%inmst = 0
813  this%inadv = 0
814  this%indsp = 0
815  this%inssm = 0
816  this%inoc = 0
817  this%inobs = 0
818  this%nprp = 0
819  end subroutine allocate_scalars
820 
821  !> @brief Allocate arrays
822  subroutine allocate_arrays(this)
824  class(prtmodeltype) :: this
825  integer(I4B) :: n
826 
827  ! -- Allocate arrays in parent type
828  this%nja = this%dis%nja
829  call this%NumericalModelType%allocate_arrays()
830 
831  ! -- Allocate and initialize arrays
832  call mem_allocate(this%masssto, this%dis%nodes, &
833  'MASSSTO', this%memoryPath)
834  call mem_allocate(this%massstoold, this%dis%nodes, &
835  'MASSSTOOLD', this%memoryPath)
836  call mem_allocate(this%ratesto, this%dis%nodes, &
837  'RATESTO', this%memoryPath)
838  ! -- explicit model, so these must be manually allocated
839  call mem_allocate(this%x, this%dis%nodes, 'X', this%memoryPath)
840  call mem_allocate(this%rhs, this%dis%nodes, 'RHS', this%memoryPath)
841  call mem_allocate(this%ibound, this%dis%nodes, 'IBOUND', this%memoryPath)
842  do n = 1, this%dis%nodes
843  this%masssto(n) = dzero
844  this%massstoold(n) = dzero
845  this%ratesto(n) = dzero
846  this%x(n) = dzero
847  this%rhs(n) = dzero
848  this%ibound(n) = 1
849  end do
850  end subroutine allocate_arrays
851 
852  !> @brief Create boundary condition packages for this model
853  subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, &
854  inunit, iout)
855  ! -- modules
856  use constantsmodule, only: linelength
857  use prtprpmodule, only: prp_create
858  use apimodule, only: api_create
859  ! -- dummy
860  class(prtmodeltype) :: this
861  character(len=*), intent(in) :: filtyp
862  character(len=LINELENGTH) :: errmsg
863  integer(I4B), intent(in) :: ipakid
864  integer(I4B), intent(in) :: ipaknum
865  character(len=*), intent(in) :: pakname
866  character(len=*), intent(in) :: mempath
867  integer(I4B), intent(in) :: inunit
868  integer(I4B), intent(in) :: iout
869  ! -- local
870  class(bndtype), pointer :: packobj
871  class(bndtype), pointer :: packobj2
872  integer(I4B) :: ip
873 
874  ! -- This part creates the package object
875  select case (filtyp)
876  case ('PRP6')
877  this%nprp = this%nprp + 1
878  call prp_create(packobj, ipakid, ipaknum, inunit, iout, &
879  this%name, pakname, mempath, this%fmi)
880  case ('API6')
881  call api_create(packobj, ipakid, ipaknum, inunit, iout, &
882  this%name, pakname)
883  case default
884  write (errmsg, *) 'Invalid package type: ', filtyp
885  call store_error(errmsg, terminate=.true.)
886  end select
887 
888  ! -- Packages is the bndlist that is associated with the parent model
889  ! -- The following statement puts a pointer to this package in the ipakid
890  ! -- position of packages.
891  do ip = 1, this%bndlist%Count()
892  packobj2 => getbndfromlist(this%bndlist, ip)
893  if (packobj2%packName == pakname) then
894  write (errmsg, '(a,a)') 'Cannot create package. Package name '// &
895  'already exists: ', trim(pakname)
896  call store_error(errmsg, terminate=.true.)
897  end if
898  end do
899  call addbndtolist(this%bndlist, packobj)
900  end subroutine package_create
901 
902  !> @brief Check to make sure required input files have been specified
903  subroutine ftype_check(this, indis)
904  ! -- dummy
905  class(prtmodeltype) :: this
906  integer(I4B), intent(in) :: indis
907  ! -- local
908  character(len=LINELENGTH) :: errmsg
909 
910  ! -- Check for DIS(u) and MIP. Stop if not present.
911  if (indis == 0) then
912  write (errmsg, '(1x,a)') &
913  'Discretization (DIS6, DISV6, or DISU6) package not specified.'
914  call store_error(errmsg)
915  end if
916  if (this%inmip == 0) then
917  write (errmsg, '(1x,a)') &
918  'Model input (MIP6) package not specified.'
919  call store_error(errmsg)
920  end if
921 
922  if (count_errors() > 0) then
923  write (errmsg, '(1x,a)') 'One or more required package(s) not specified.'
924  call store_error(errmsg)
925  call store_error_filename(this%filename)
926  end if
927  end subroutine ftype_check
928 
929  !> @brief Solve the model
930  subroutine prt_solve(this)
931  ! -- modules
932  use tdismodule, only: kper, kstp, totimc, nper, nstp, delt
933  use prtprpmodule, only: prtprptype
934  ! -- dummy variables
935  class(prtmodeltype) :: this
936  ! -- local variables
937  integer(I4B) :: np, ip
938  class(bndtype), pointer :: packobj
939  type(particletype), pointer :: particle
940  real(DP) :: tmax
941  integer(I4B) :: iprp
942 
943  ! -- Initialize particle
944  call create_particle(particle)
945 
946  ! -- Loop over PRP packages
947  iprp = 0
948  do ip = 1, this%bndlist%Count()
949  packobj => getbndfromlist(this%bndlist, ip)
950  select type (packobj)
951  type is (prtprptype)
952  ! -- Update PRP index
953  iprp = iprp + 1
954 
955  ! -- Initialize PRP-specific track files, if enabled
956  if (packobj%itrkout > 0) then
957  call this%trackfilectl%init_track_file( &
958  packobj%itrkout, &
959  iprp=iprp)
960  end if
961  if (packobj%itrkcsv > 0) then
962  call this%trackfilectl%init_track_file( &
963  packobj%itrkcsv, &
964  csv=.true., &
965  iprp=iprp)
966  end if
967 
968  ! -- Loop over particles in package
969  do np = 1, packobj%nparticles
970  ! -- Load particle from storage
971  call particle%load_from_store(packobj%particles, &
972  this%id, iprp, np)
973 
974  ! -- If particle is permanently unreleased, record its initial/terminal state
975  if (particle%istatus == 8) &
976  call this%method%save(particle, reason=3) ! reason=3: termination
977 
978  ! -- If particle is inactive or not yet to be released, cycle
979  if (particle%istatus > 1) cycle
980 
981  ! -- If particle released this time step, record its initial state
982  particle%istatus = 1
983  if (particle%trelease >= totimc) &
984  call this%method%save(particle, reason=0) ! reason=0: release
985 
986  ! -- Maximum time is end of time step unless this is the last
987  ! time step in the simulation, which case it's the particle
988  ! stop time.
989  tmax = totimc + delt
990  if (nper == kper .and. nstp(kper) == kstp) &
991  tmax = particle%tstop
992 
993  ! -- Get and apply the tracking method
994  call this%method%apply(particle, tmax)
995 
996  ! -- Update particle storage
997  call packobj%particles%load_from_particle(particle, np)
998  end do
999  end select
1000  end do
1001 
1002  ! -- Deallocate particle
1003  deallocate (particle)
1004  end subroutine prt_solve
1005 
1006  !> @brief Source package info and begin to process
1007  subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, &
1008  mempaths, inunits)
1009  ! -- modules
1012  ! -- dummy
1013  class(prtmodeltype) :: this
1014  integer(I4B), dimension(:), allocatable, intent(inout) :: bndpkgs
1015  type(characterstringtype), dimension(:), contiguous, &
1016  pointer, intent(inout) :: pkgtypes
1017  type(characterstringtype), dimension(:), contiguous, &
1018  pointer, intent(inout) :: pkgnames
1019  type(characterstringtype), dimension(:), contiguous, &
1020  pointer, intent(inout) :: mempaths
1021  integer(I4B), dimension(:), contiguous, &
1022  pointer, intent(inout) :: inunits
1023  ! -- local
1024  integer(I4B) :: ipakid, ipaknum
1025  character(len=LENFTYPE) :: pkgtype, bndptype
1026  character(len=LENPACKAGENAME) :: pkgname
1027  character(len=LENMEMPATH) :: mempath
1028  integer(I4B), pointer :: inunit
1029  integer(I4B) :: n
1030 
1031  if (allocated(bndpkgs)) then
1032  !
1033  ! -- create stress packages
1034  ipakid = 1
1035  bndptype = ''
1036  do n = 1, size(bndpkgs)
1037  !
1038  pkgtype = pkgtypes(bndpkgs(n))
1039  pkgname = pkgnames(bndpkgs(n))
1040  mempath = mempaths(bndpkgs(n))
1041  inunit => inunits(bndpkgs(n))
1042  !
1043  if (bndptype /= pkgtype) then
1044  ipaknum = 1
1045  bndptype = pkgtype
1046  end if
1047  !
1048  call this%package_create(pkgtype, ipakid, ipaknum, pkgname, mempath, &
1049  inunit, this%iout)
1050  ipakid = ipakid + 1
1051  ipaknum = ipaknum + 1
1052  end do
1053  !
1054  ! -- cleanup
1055  deallocate (bndpkgs)
1056  end if
1057 
1058  end subroutine create_bndpkgs
1059 
1060  !> @brief Source package info and begin to process
1061  subroutine create_packages(this)
1062  ! -- modules
1065  use arrayhandlersmodule, only: expandarray
1066  use memorymanagermodule, only: mem_setptr
1068  use simvariablesmodule, only: idm_context
1069  use budgetmodule, only: budget_cr
1073  use prtmipmodule, only: mip_cr
1074  use prtfmimodule, only: fmi_cr
1075  use prtocmodule, only: oc_cr
1076  use prtobsmodule, only: prt_obs_cr
1077  ! -- dummy
1078  class(prtmodeltype) :: this
1079  ! -- local
1080  type(characterstringtype), dimension(:), contiguous, &
1081  pointer :: pkgtypes => null()
1082  type(characterstringtype), dimension(:), contiguous, &
1083  pointer :: pkgnames => null()
1084  type(characterstringtype), dimension(:), contiguous, &
1085  pointer :: mempaths => null()
1086  integer(I4B), dimension(:), contiguous, &
1087  pointer :: inunits => null()
1088  character(len=LENMEMPATH) :: model_mempath
1089  character(len=LENFTYPE) :: pkgtype
1090  character(len=LENPACKAGENAME) :: pkgname
1091  character(len=LENMEMPATH) :: mempath
1092  integer(I4B), pointer :: inunit
1093  integer(I4B), dimension(:), allocatable :: bndpkgs
1094  integer(I4B) :: n
1095  integer(I4B) :: indis = 0 ! DIS enabled flag
1096  character(len=LENMEMPATH) :: mempathmip = ''
1097 
1098  ! -- set input memory paths, input/model and input/model/namfile
1099  model_mempath = create_mem_path(component=this%name, context=idm_context)
1100 
1101  ! -- set pointers to model path package info
1102  call mem_setptr(pkgtypes, 'PKGTYPES', model_mempath)
1103  call mem_setptr(pkgnames, 'PKGNAMES', model_mempath)
1104  call mem_setptr(mempaths, 'MEMPATHS', model_mempath)
1105  call mem_setptr(inunits, 'INUNITS', model_mempath)
1106 
1107  do n = 1, size(pkgtypes)
1108  ! attributes for this input package
1109  pkgtype = pkgtypes(n)
1110  pkgname = pkgnames(n)
1111  mempath = mempaths(n)
1112  inunit => inunits(n)
1113 
1114  ! -- create dis package first as it is a prerequisite for other packages
1115  select case (pkgtype)
1116  case ('DIS6')
1117  indis = 1
1118  call dis_cr(this%dis, this%name, mempath, indis, this%iout)
1119  case ('DISV6')
1120  indis = 1
1121  call disv_cr(this%dis, this%name, mempath, indis, this%iout)
1122  case ('DISU6')
1123  indis = 1
1124  call disu_cr(this%dis, this%name, mempath, indis, this%iout)
1125  case ('MIP6')
1126  this%inmip = 1
1127  mempathmip = mempath
1128  case ('FMI6')
1129  this%infmi = inunit
1130  case ('OC6')
1131  this%inoc = inunit
1132  case ('OBS6')
1133  this%inobs = inunit
1134  case ('PRP6')
1135  call expandarray(bndpkgs)
1136  bndpkgs(size(bndpkgs)) = n
1137  case default
1138  call pstop(1, "Unrecognized package type: "//pkgtype)
1139  end select
1140  end do
1141 
1142  ! -- Create budget manager
1143  call budget_cr(this%budget, this%name)
1144 
1145  ! -- Create tracking method pools
1146  call create_method_pool()
1149 
1150  ! -- Create packages that are tied directly to model
1151  call mip_cr(this%mip, this%name, mempathmip, this%inmip, this%iout, this%dis)
1152  call fmi_cr(this%fmi, this%name, this%infmi, this%iout)
1153  call oc_cr(this%oc, this%name, this%inoc, this%iout)
1154  call prt_obs_cr(this%obs, this%inobs)
1155 
1156  ! -- Check to make sure that required ftype's have been specified
1157  call this%ftype_check(indis)
1158 
1159  ! -- Create boundary packages
1160  call this%create_bndpkgs(bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
1161  end subroutine create_packages
1162 
1163  !> @brief Write model namfile options to list file
1164  subroutine log_namfile_options(this, found)
1166  class(prtmodeltype) :: this
1167  type(gwfnamparamfoundtype), intent(in) :: found
1168 
1169  write (this%iout, '(1x,a)') 'NAMEFILE OPTIONS:'
1170 
1171  if (found%newton) then
1172  write (this%iout, '(4x,a)') &
1173  'NEWTON-RAPHSON method enabled for the model.'
1174  if (found%under_relaxation) then
1175  write (this%iout, '(4x,a,a)') &
1176  'NEWTON-RAPHSON UNDER-RELAXATION based on the bottom ', &
1177  'elevation of the model will be applied to the model.'
1178  end if
1179  end if
1180 
1181  if (found%print_input) then
1182  write (this%iout, '(4x,a)') 'STRESS PACKAGE INPUT WILL BE PRINTED '// &
1183  'FOR ALL MODEL STRESS PACKAGES'
1184  end if
1185 
1186  if (found%print_flows) then
1187  write (this%iout, '(4x,a)') 'PACKAGE FLOWS WILL BE PRINTED '// &
1188  'FOR ALL MODEL PACKAGES'
1189  end if
1190 
1191  if (found%save_flows) then
1192  write (this%iout, '(4x,a)') &
1193  'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL'
1194  end if
1195 
1196  write (this%iout, '(1x,a)') 'END NAMEFILE OPTIONS:'
1197  end subroutine log_namfile_options
1198 
1199 end module prtmodule
This module contains the API package methods.
Definition: gwf-api.f90:12
subroutine, public api_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
@ brief Create a new package object
Definition: gwf-api.f90:49
subroutine, public addbasemodeltolist(list, model)
Definition: BaseModel.f90:161
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.
Definition: Budget.f90:20
subroutine, public budget_cr(this, name_model)
@ brief Create a new budget object
Definition: Budget.f90:84
subroutine, public rate_accumulator(flow, rin, rout)
@ brief Rate accumulator subroutine
Definition: Budget.f90:664
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:44
@ mnormal
normal output mode
Definition: Constants.f90:205
integer(i4b), parameter lenpackagename
maximum length of the package name
Definition: Constants.f90:22
integer(i4b), parameter lenpackagetype
maximum length of a package type (DIS6, SFR6, CSUB6, etc.)
Definition: Constants.f90:37
integer(i4b), parameter lenbigline
maximum length of a big line
Definition: Constants.f90:15
real(dp), parameter dhnoflo
real no flow constant
Definition: Constants.f90:92
integer(i4b), parameter lenpakloc
maximum length of a package location
Definition: Constants.f90:49
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
Definition: Constants.f90:38
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:64
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:36
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:26
real(dp), parameter done
real constant 1
Definition: Constants.f90:75
Definition: Dis.f90:1
subroutine, public dis_cr(dis, name_model, input_mempath, inunit, iout)
Create a new structured discretization object.
Definition: Dis.f90:97
subroutine, public disu_cr(dis, name_model, input_mempath, inunit, iout)
Create a new unstructured discretization object.
Definition: Disu.f90:127
subroutine, public disv_cr(dis, name_model, input_mempath, inunit, iout)
Create a new discretization by vertices object.
Definition: Disv.f90:109
subroutine pstop(status, message)
Stop the program, optionally specifying an error status code.
Definition: ErrorUtil.f90:24
subroutine, public lowcase(word)
Convert to lower case.
subroutine, public parseline(line, nwords, words, inunit, filename)
Parse a line into words.
subroutine, public upcase(word)
Convert to upper case.
This module defines variable data types.
Definition: kind.f90:8
type(listtype), public basemodellist
Definition: mf6lists.f90:16
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
subroutine, public memorylist_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.
Definition: Method.f90:2
Model-level tracking methods.
Definition: MethodPool.f90:2
type(methoddisvtype), pointer, public method_disv
Definition: MethodPool.f90:12
type(methoddistype), pointer, public method_dis
Definition: MethodPool.f90:11
subroutine, public create_method_pool()
Create the method pool.
Definition: MethodPool.f90:18
subroutine, public destroy_method_pool()
Destroy the method pool.
Definition: MethodPool.f90:24
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.
subroutine, public create_particle(particle)
Create a new particle.
Definition: Particle.f90:101
subroutine, public fmi_cr(fmiobj, name_model, inunit, iout)
Create a new PrtFmi object.
Definition: prt-fmi.f90:37
subroutine, public mip_cr(mip, name_model, input_mempath, inunit, iout, dis)
Create a model input object.
Definition: prt-mip.f90:35
Definition: prt.f90:1
integer(i4b), parameter niunit_prt
Definition: prt.f90:117
subroutine prt_ot(this)
Print and/or save model output.
Definition: prt.f90:501
subroutine prt_rp(this)
Read and prepare (calls package read and prepare routines)
Definition: prt.f90:305
subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
Source package info and begin to process.
Definition: prt.f90:1009
subroutine prt_ar(this)
Allocate and read.
Definition: prt.f90:233
subroutine ftype_check(this, indis)
Check to make sure required input files have been specified.
Definition: prt.f90:904
subroutine prt_ot_saveflow(this, nja, flowja, icbcfl, icbcun)
Save intercell flows.
Definition: prt.f90:604
subroutine prt_ad(this)
Time step advance (calls package advance subroutines)
Definition: prt.f90:326
subroutine prt_cq(this, icnvg, isuppress_output)
Calculate intercell flow (flowja)
Definition: prt.f90:372
subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, inunit, iout)
Create boundary condition packages for this model.
Definition: prt.f90:855
subroutine prt_ot_flow(this, icbcfl, ibudfl, icbcun)
Save flows.
Definition: prt.f90:567
subroutine allocate_scalars(this, modelname)
Allocate memory for non-allocatable members.
Definition: prt.f90:790
subroutine prt_ot_bdsummary(this, ibudfl, ipflag)
Print budget summary.
Definition: prt.f90:691
character(len=lenpackagetype), dimension(prt_nmultipkg), public prt_multipkg
Definition: prt.f90:112
subroutine create_packages(this)
Source package info and begin to process.
Definition: prt.f90:1062
character(len=lenpackagetype), dimension(prt_nbasepkg), public prt_basepkg
Definition: prt.f90:98
integer(i4b), parameter, public prt_nmultipkg
PRT multi package array descriptors.
Definition: prt.f90:111
character(len=lenbudtxt), dimension(nbditems) budtxt
Definition: prt.f90:37
subroutine prt_da(this)
Deallocate.
Definition: prt.f90:721
subroutine prt_cq_sto(this)
Calculate particle mass storage.
Definition: prt.f90:418
subroutine, public prt_cr(filename, id, modelname)
Create a new particle tracking model object.
Definition: prt.f90:123
subroutine prt_ot_obs(this)
Calculate and save observations.
Definition: prt.f90:549
subroutine prt_ot_printflow(this, ibudfl, flowja)
Print intercell flows.
Definition: prt.f90:631
subroutine prt_bd(this, icnvg, isuppress_output)
Calculate flows and budget.
Definition: prt.f90:472
subroutine prt_df(this)
Define packages.
Definition: prt.f90:198
integer(i4b), parameter, public prt_nbasepkg
PRT base package array descriptors.
Definition: prt.f90:97
integer(i4b), parameter nbditems
Definition: prt.f90:36
subroutine allocate_arrays(this)
Allocate arrays.
Definition: prt.f90:823
subroutine log_namfile_options(this, found)
Write model namfile options to list file.
Definition: prt.f90:1165
subroutine prt_ot_dv(this, idvsave, idvprint, ipflag)
Print dependent variables.
Definition: prt.f90:670
subroutine prt_solve(this)
Solve the model.
Definition: prt.f90:931
subroutine, public prt_obs_cr(obs, inobs)
Create a new PrtObsType object.
Definition: prt-obs.f90:34
subroutine, public oc_cr(ocobj, name_model, inunit, iout)
@ brief Create an output control object
Definition: prt-oc.f90:46
subroutine, public prp_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, fmi)
Create a new particle release point package.
Definition: prt-prp.f90:89
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
Definition: Sim.f90:203
This module contains simulation variables.
Definition: SimVariables.f90:9
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)
Definition: Sparse.f90:281
logical(lgp), pointer, public endofperiod
flag indicating end of stress period
Definition: tdis.f90:27
subroutine, public tdis_ot(iout)
Print simulation time.
Definition: tdis.f90:349
integer(i4b), dimension(:), pointer, public, contiguous nstp
number of time steps in each stress period
Definition: tdis.f90:39
real(dp), pointer, public totim
time relative to start of simulation
Definition: tdis.f90:32
logical(lgp), pointer, public readnewdata
flag indicating time to read new data
Definition: tdis.f90:26
real(dp), pointer, public totimc
simulation time at start of time step
Definition: tdis.f90:33
integer(i4b), pointer, public kstp
current time step number
Definition: tdis.f90:24
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:23
real(dp), pointer, public delt
length of the current time step
Definition: tdis.f90:29
integer(i4b), pointer, public nper
number of stress period
Definition: tdis.f90:21
This module contains version information.
Definition: version.f90:7
subroutine write_listfile_header(iout, cmodel_type, write_sys_command, write_kind_info)
@ brief Write program header
Definition: version.f90:98
Highest level model type. All models extend this parent type.
Definition: BaseModel.f90:13
@ brief BndType
Derived type for the Budget object.
Definition: Budget.f90:39
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23
Structured grid discretization.
Definition: Dis.f90:23
Unstructured grid discretization.
Definition: Disu.f90:28
Vertex grid discretization.
Definition: Disv.f90:24
A generic heterogeneous doubly-linked list.
Definition: List.f90:10
Base type for particle tracking methods.
Definition: Method.f90:29
A particle tracked by the PRT model.
Definition: Particle.f90:31
Particle tracking (PRT) model.
Definition: prt.f90:41
@ brief Output control for particle tracking models
Definition: prt-oc.f90:20
Particle release point (PRP) package.
Definition: prt-prp.f90:36
Manages particle track (i.e. pathline) files.
Definition: TrackData.f90:38
Output file containing all or some particle pathlines.
Definition: TrackData.f90:18